cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- added a basic gopher implementation.

This commit is contained in:
cage 2022-08-28 13:22:08 +02:00
parent a393b0ba88
commit d3e36f8efd
13 changed files with 536 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
etc/default-theme.conf
View File

@ -108,21 +108,21 @@ notify-window.width = 1/6
# centered notification window
# notify-window.position.x = 7/16
# notify-window.position.x = 7/16
# notify-window.position.y = 1/2
# notify-window.position.y = 1/2
# top right corner notification window
# notify-window.position.x = -1/6
# notify-window.position.x = -1/6
# notify-window.position.y = 0
# notify-window.position.y = 0
# top left corner notification window
# notify-window.position.x = 0
# notify-window.position.x = 0
# notify-window.position.y = 0
# notify-window.position.y = 0
# bottom left corner notification window
@ -516,7 +516,7 @@ gemini.downloading.animation = "⠇ ⠋ ⠙ ⠸ ⠴ ⠦"
gemini.favicon = "🌍"
#gemini.link.background = white
#gemini.link.background = white
gemini.link.foreground = magenta
@ -635,30 +635,54 @@ gemini-toc-window.padding = "⋅"
# this is the message that shows an hierarchical filesystem
file-explorer.background = black
file-explorer.background = black
file-explorer.foreground = #E2BE6F
file-explorer.foreground = #E2BE6F
file-explorer.height = 1/2
file-explorer.height = 1/2
# see configuration for tree in thread window above
file-explorer.tree.branch.foreground = red
file-explorer.tree.branch.foreground = red
file-explorer.tree.arrow.foreground = magenta
file-explorer.tree.arrow.foreground = magenta
file-explorer.tree.root.foreground = #ffff00
file-explorer.tree.root.foreground = #ffff00
file-explorer.tree.data.foreground = white
file-explorer.tree.data.foreground = white
file-explorer.tree.data-leaf.foreground = cyan
file-explorer.tree.data-leaf.foreground = cyan
file-explorer.tree.arrow.value = "🞂"
file-explorer.tree.arrow.value = "🞂"
file-explorer.tree.leaf.value = "╰"
file-explorer.tree.leaf.value = "╰"
file-explorer.tree.branch.value = "├"
file-explorer.tree.branch.value = "├"
file-explorer.tree.spacer.value = "─"
file-explorer.tree.spacer.value = "─"
file-explorer.tree.vertical-line.value = "│"
file-explorer.tree.vertical-line.value = "│"
# this is the window that show the content of a gopher response
gopher-window.background = black
gopher-window.foreground = #c9c0c0
gopher-window.line.prefix.uri = "🕸 "
gopher-window.line.prefix.directory = "🗀 "
gopher-window.line.prefix.unknown = "❌"
gopher-window.line.prefix.binary-file = "⁽¹⁰¹⁾ "
gopher-window.line.prefix.text-file = "🖹 "
gopher-window.line.prefix.image-file = "🖼 "
gopher-window.line.prefix.gif-file = "🖼 "
gopher-window.line.prefix.foreground = cyan
gopher-window.line.prefix.attribute = bold

16
etc/init.lisp
View File

@ -256,6 +256,8 @@
;; thread window keymap
(define-key "Q" #'gopher-window::tt *thread-keymap*)
(define-key "up" #'thread-go-up *thread-keymap*)
(define-key "down" #'thread-go-down *thread-keymap*)
@ -752,6 +754,20 @@
(define-key "M d" #'file-explorer-download-mirror *filesystem-explorer-keymap*)
;; gopher viewer keymap
(define-key "up" #'gopher-window:go-to-previous-link *gopher-keymap*)
(define-key "down" #'gopher-window:go-to-next-link *gopher-keymap*)
(define-key "k" #'gopher-window:go-to-previous-link *gopher-keymap*)
(define-key "j" #'gopher-window:go-to-next-link *gopher-keymap*)
(define-key "C-J" #'gopher-window:open-menu-link *gopher-keymap*)
(define-key "b" #'gemini-history-back *gopher-keymap*)
;;;; hooks
;; this module will install an hook to rewrite urls; By default it

5
src/gemini-viewer.lisp
View File

@ -760,13 +760,12 @@
(when-let* ((metadata (message-window:metadata window))
(history (misc:safe-all-but-last-elt (gemini-metadata-history metadata)))
(last (last-elt history)))
(setf (gemini-metadata-history metadata)
history)
(setf (gemini-metadata-history metadata) history)
(ui:info-message (format nil (_ "Going back to: ~a") last))
(let ((found (find-db-stream-url last)))
(if found
(db-entry-to-foreground last)
(load-gemini-url last))))) ; this happens if navigating in a local tree
(ui:open-net-address last))))) ; this happens history kept a non gemini iri
(defun view-source (window)
(when-let* ((metadata (message-window:metadata window))

257
src/gopher-window.lisp Normal file
View File

@ -0,0 +1,257 @@
;; tinmop: an humble gemini and pleroma client
;; Copyright (C) 2020 cage
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(in-package :gopher-window)
(defclass gopher-window (wrapper-window
focus-marked-window
title-window
border-window
row-oriented-widget)
((page-type
:initarg :page-type
:initform nil
:accessor page-type
:documentation "The type of the page , 0,1,2,i etc.")))
(defmethod refresh-config :after ((object gopher-window))
(refresh-config-colors object swconf:+key-gopher-window+)
(let* ((height (win-height *message-window*))
(width (win-width *message-window*))
(x (win-x *message-window*))
(y (win-y *message-window*)))
(win-resize object width height)
(win-move object x y)))
(defmethod draw :after ((object gopher-window))
(with-accessors ((uses-border-p uses-border-p)) object
(when-window-shown (object)
(let ((max-line-size (if uses-border-p
(win-width-no-border object)
(win-width object))))
(let ((rows (renderizable-rows-data object))
(x (if (uses-border-p object)
1
0))
(y-start (if (uses-border-p object)
1
0)))
(loop
for y from y-start
for ct from 0
for row in rows do
(let ((tui-text (if (selectedp row)
(tui:apply-attributes (selected-text row)
:all
(tui:combine-attributes (tui:attribute-reverse)
(tui:attribute-bold)))
(normal-text row))))
(print-text object (right-pad-text (text-ellipsis tui-text max-line-size)
max-line-size)
x y)))
(when (> (rows-length object) 0)
(let* ((current-selected (1+ (row-selected-index object)))
(pages-count-line (format nil
(_ "line ~a of ~a")
current-selected
(rows-length object)))
(x-count-line (- (win-width object)
(length pages-count-line)
1))
(y-count-line (1- (win-height object))))
(print-text object
(text-ellipsis pages-count-line (win-width-no-border object))
x-count-line
y-count-line))))))))
(defgeneric gopher-line->text (line))
(defun %gemline->text-simple (line prefix)
(let* ((prefix-color (swconf:config-gopher-line-prefix-foreground))
(prefix-attribute (swconf:config-gopher-line-prefix-attribute))
(colorized (message-window::colorize-lines (gopher-parser:username line)))
(colorized-prefix (tui:make-tui-string prefix
:attributes prefix-attribute
:fgcolor prefix-color)))
(tui:cat-tui-string colorized-prefix
(tui:apply-attributes colorized :all (tui:attribute-bold))
:color-attributes-contagion nil)))
(defmethod gopher-line->text ((line gopher-parser:line-file))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-text-file)))
(defmethod gopher-line->text ((line gopher-parser:line-dir))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-directory)))
(defmethod gopher-line->text ((line gopher-parser:line-cso))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-unknown)))
(defmethod gopher-line->text ((line gopher-parser:line-error))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-unknown)))
(defmethod gopher-line->text ((line gopher-parser:line-mac-hex-file))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-binary-file)))
(defmethod gopher-line->text ((line gopher-parser:line-dos-archive-file))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-binary-file)))
(defmethod gopher-line->text ((line gopher-parser:line-uuencoded-file))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-binary-file)))
(defmethod gopher-line->text ((line gopher-parser:line-index-search))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-search-index)))
(defmethod gopher-line->text ((line gopher-parser:line-telnet-session))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-unknown)))
(defmethod gopher-line->text ((line gopher-parser:line-binary-file))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-binary-file)))
(defmethod gopher-line->text ((line gopher-parser:line-redundant-server))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-directory)))
(defmethod gopher-line->text ((line gopher-parser:line-tn3270-session))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-unknown)))
(defmethod gopher-line->text ((line gopher-parser:line-gif-file))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-gif-file)))
(defmethod gopher-line->text ((line gopher-parser:line-image-file))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-image-file)))
(defmethod gopher-line->text ((line gopher-parser:line-info))
(message-window::colorize-lines (gopher-parser:username line)))
(defmethod gopher-line->text ((line gopher-parser:line-uri))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-uri)))
(defmethod gopher-line->text ((line gopher-parser:line-unknown))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-unknown)))
(defun print-response-rows (window gopher-lines)
(flet ((make-rows (lines)
(mapcar (lambda (line)
(make-instance 'line
:fields (list :original-object line)
:normal-text (gopher-line->text line)
:selected-text (gopher-line->text line)))
lines)))
(line-oriented-window:update-all-rows window (make-rows gopher-lines))))
(defun init ()
(maybe-close-window *gopher-window*)
(let* ((low-level-window (make-croatoan-window :enable-function-keys t)))
(setf *gopher-window*
(make-instance 'gopher-window
:uses-border-p t
:title (_ "Gopher menu")
:keybindings keybindings:*gopher-keymap*
:key-config swconf:+key-gopher-window+
:croatoan-window low-level-window))
(refresh-config *gopher-window*)
(draw *gopher-window*)
*gopher-window*))
(defun not-link-line-p (line)
(let ((original-object (message-window:extract-original-object line)))
(not (or (gopher-parser:line-type-info-p original-object)
(gopher-parser:line-type-error-p original-object)))))
(defun go-to-next-link ()
(a:when-let* ((win *gopher-window*)
(1+selected-row-pos (1+ (line-oriented-window:row-selected-index win)))
(link-line-pos (rows-position-if win
#'not-link-line-p
:start 1+selected-row-pos)))
(line-oriented-window:unselect-all win)
(line-oriented-window:row-move win (- link-line-pos (1- 1+selected-row-pos)))
(win-clear win)
(windows:draw win)))
(defun go-to-previous-link ()
(a:when-let* ((win *gopher-window*)
(selected-row-pos (line-oriented-window:row-selected-index win))
(link-line-pos (rows-position-if win
#'not-link-line-p
:from-end t
:end selected-row-pos)))
(line-oriented-window:unselect-all win)
(line-oriented-window:row-move win (- link-line-pos selected-row-pos))
(win-clear win)
(windows:draw win)))
(defun make-request (host port type selector)
(let ((message-win specials:*message-window*))
(gemini-viewer:maybe-initialize-metadata message-win)
(let ((link (format nil "~a://~a:~a/~a/~a"
gopher-parser:+gopher-scheme+
host
port
type
selector)))
(gemini-viewer:push-url-to-history message-win link)))
(cond
((gopher-parser::%line-type-dir-p type)
(let ((data (misc:make-fresh-array 0 :type '(unsigned-int 8))))
(gopher-client:request host
type
:port port
:selector selector
:collect-fn (gopher-client:make-collect-fn data))
(init)
(ui:focus-to-gopher-window)
(print-response-rows *gopher-window*
(gopher-parser:parse-menu (text-utils:to-s data)))
(select-row *gopher-window* 0)
(draw *gopher-window*)))
((gopher-parser::%line-type-file-p type)
(win-close *gopher-window*)
(let ((data (misc:make-fresh-array 0 :type '(unsigned-int 8))))
(gopher-client:request host
type
:port port
:selector selector
:collect-fn (gopher-client:make-collect-fn data))
(let* ((text (to-s data))
(raw-lines (split-lines (gopher-parser:parse-text-file text)))
(lines (mapcar (lambda (a)
(message-window:text->rendered-lines-rows *message-window*
a))
raw-lines)))
(line-oriented-window:update-all-rows *message-window* (a:flatten lines))
(draw *message-window*)
(ui:focus-to-message-window))))
(t
(fs:with-anaphoric-temp-file (stream)
(gopher-client:request host
type
:port port
:selector selector
:collect-fn (lambda (buffer)
(write-sequence buffer stream)))
(finish-output stream)
(os-utils:open-resource-with-external-program filesystem-utils:temp-file
nil)))))
(defun open-menu-link ()
(a:when-let* ((win *gopher-window*)
(selected-row (selected-row win))
(line (message-window:extract-original-object selected-row)))
(with-accessors ((line-type-id gopher-parser:line-type-id)
(selector gopher-parser:selector)
(host gopher-parser:host)
(port gopher-parser:port)) line
(make-request host port line-type-id selector))))

34
src/gopher/client.lisp
View File

@ -30,8 +30,10 @@
(defun %request (host &key
(port 70)
(selector "")
(terminate-strategy :response-teminal)
(terminate-strategy :response-terminal)
(collect-fn (lambda (data) (format t "~a" (to-s data)))))
(assert (or (null terminate-strategy)
(eq terminate-strategy :response-terminal)))
(flet ((open-socket (hostname port)
(usocket:socket-connect hostname
port
@ -59,12 +61,12 @@
'(unsigned-byte 8)
t))
(first-chunk-size (read-sequence buffer stream)))
(funcall collect-fn (subseq buffer 0 first-chunk-size))
(loop for read-so-far = first-chunk-size
while (not (end-response-p read-so-far buffer))
do
(format t "~a~%" read-so-far)
(funcall collect-fn (subseq buffer 0 read-so-far)))))))
(labels ((read-all (buffer read-so-far)
(funcall collect-fn (subseq buffer 0 read-so-far))
(when (not (end-response-p read-so-far buffer))
(let ((new-chunk-size (read-sequence buffer stream)))
(read-all buffer new-chunk-size)))))
(read-all buffer first-chunk-size))))))
(defmacro gen-request-function (return-types strategies)
`(defun ,(format-fn-symbol t "request")
@ -72,7 +74,7 @@
&key
(port 70)
(selector "")
(collect-fn (lambda (data) (format t "~a" (to-s data)))))
(collect-fn (lambda (data) (format t "~s" (to-s data)))))
(cond
,@(append
(loop for return-type in return-types
@ -87,8 +89,10 @@
`(((string= response-type +line-type-uri+)
(open-message-link-window:open-message-link selector nil)))
`((t
(error 'conditions:not-implemented-error
:text (format nil (_ "This line type ~s in not supported") response-type))))))))
(%request host :port port
:selector selector
:terminate-strategy nil
:collect-fn collect-fn)))))))
(gen-request-function (+line-type-file+
+line-type-dir+
@ -101,17 +105,17 @@
+line-type-gif-image-file+
+line-type-image-file+
+line-type-info+)
(:response-teminal
:response-teminal
:response-teminal
(:response-terminal
:response-terminal
:response-terminal
nil
nil
nil
:response-teminal
:response-terminal
nil
nil
nil
:response-teminal))
:response-terminal))
(defun request-from-iri (iri &optional (collect-function (lambda (data)
(format t "~a" (to-s data)))))

43
src/gopher/package.lisp
View File

@ -40,13 +40,18 @@
:+line-type-image-file+
:+line-type-info+
:+line-type-uri+
:line-type-id
:selector
:username
:port
:host
:line-file
:line-dir
:line-cso
:line-error
:line-mac-hex-file
:line-dos-archive-file
:line-dos-uuencoded-file
:line-uuencoded-file
:line-index-search
:line-telnet-session
:line-binary-file
@ -54,23 +59,28 @@
:line-tn3270-session
:line-gif-file
:line-image-file
:line-info
:line-uri
:line-file-p
:line-dir-p
:line-cso-p
:line-error-p
:line-mac-hex-file-p
:line-dos-archive-file-p
:line-uuencoded-file-p
:line-index-search-p
:line-telnet-session-p
:line-binary-file-p
:line-redundant-server-p
:line-tn3270-session-p
:line-gif-file-p
:line-image-file-p
:line-image-uri-p
:line-unknown
:line-type-file-p
:line-type-info-p
:line-type-dir-p
:line-type-cso-p
:line-type-error-p
:line-type-mac-hex-file-p
:line-type-dos-archive-file-p
:line-type-uuencoded-file-p
:line-type-index-search-p
:line-type-telnet-session-p
:line-type-binary-file-p
:line-type-redundant-server-p
:line-type-tn3270-session-p
:line-type-gif-file-p
:line-type-image-file-p
:line-type-image-uri-p
:line-unknown-p
:parse-menu
:parse-text-file
:parse-iri))
(defpackage gopher-client
@ -85,5 +95,6 @@
(:local-nicknames (:a :alexandria)
(:parser :gopher-parser))
(:export
:make-collect-fn
:request
:request-from-iri))

38
src/gopher/parser.lisp
View File

@ -87,7 +87,12 @@
(%gen-check-line-predicate uri +line-type-uri+)
(defclass gopher-line ()
((username
((line-type-id
:initarg :line-type-id
:initform ""
:accessor line-type-id
:type string)
(username
:initarg :username
:initform ""
:accessor username
@ -153,6 +158,8 @@
(gen-selector-class line-uri)
(gen-selector-class line-unknown)
(defun check-line-type (data reference)
(typep data reference))
@ -193,6 +200,8 @@
(gen-check-line-predicate uri 'line-uri)
(gen-check-line-predicate unknown 'unknown)
(defrule line-separator (and #\Return #\Newline)
(:constant :line-separator))
@ -208,9 +217,6 @@
(defrule last-line (and #\. line-separator)
(:constant :last-line))
(defrule text-block (+ (not last-line))
(:text t))
(defrule line-type unascii
(:text t))
@ -291,17 +297,29 @@
((%line-type-info-p line-type)
(make-instance 'line-info))
((%line-type-uri-p line-type)
(make-instance 'line-uri)))))
(setf (username instance) (getf entry :user-name)
(selector instance) (getf entry :selector)
(host instance) (getf entry :host)
(port instance) (getf entry :port))
(make-instance 'line-uri))
(t
(make-instance 'line-unknown)))))
(setf (line-type-id instance) (getf entry :type)
(username instance) (getf entry :user-name)
(selector instance) (getf entry :selector)
(host instance) (getf entry :host)
(port instance) (getf entry :port))
instance))))
(defrule text-block (+ (not (and #\Newline #\. #\Return #\Newline)))
(:text t))
(defrule text-file (and (* text-block) (and #\Newline #\. #\Return #\Newline))
(:function caar))
(defun parse-text-file (data)
(parse 'text-file data))
(defun parse-iri (iri)
(let* ((parsed (iri:iri-parse iri))
(host (uri:host parsed))
(port (uri:port parsed))
(port (or (uri:port parsed) 70))
(path (uri:path parsed))
(type (second (fs:split-path-elements path)))
(selector (subseq path (+ 2 (length type)))))

6
src/keybindings.lisp
View File

@ -276,6 +276,9 @@ produces a tree and graft the latter on `existing-tree'"
(defparameter *filesystem-explorer-keymap* (make-starting-comand-tree)
"The keymap for gempub library of publication.")
(defparameter *gopher-keymap* (make-starting-comand-tree)
"The keymap for gempub library of publication.")
(defparameter *all-keymaps* '(*global-keymap*
*thread-keymap*
*message-keymap*
@ -294,7 +297,8 @@ produces a tree and graft the latter on `existing-tree'"
*gemlog-subscription-keymap*
*gemini-toc-keymap*
*gempub-library-keymap*
*filesystem-explorer-keymap*))
*filesystem-explorer-keymap*
*gopher-keymap*))
(defun define-key (key-sequence function &optional (existing-keymap *global-keymap*))
"Define a key sequence that trigger a function:

44
src/package.lisp
View File

@ -1155,6 +1155,7 @@
:+key-main-window+
:+key-thread-window+
:+key-message-window+
:+key-gopher-window+
:+key-chat-window+
:+key-chats-list-window+
:+key-gemini-subscription-window+
@ -1262,6 +1263,16 @@
:config-username
:config-password-echo-character
:config-win-focus-mark
:config-gopher-line-prefix-directory
:config-gopher-line-prefix-uri
:config-gopher-line-prefix-unknown
:config-gopher-line-prefix-binary-file
:config-gopher-line-prefix-text-file
:config-gopher-line-prefix-image-file
:config-gopher-line-prefix-gif-file
:config-gopher-line-prefix-search-index
:config-gopher-line-prefix-attribute
:config-gopher-line-prefix-foreground
:link-regex->program-to-use
:link-regex->program-to-use-buffer-size
:use-tinmop-as-external-program-p
@ -1397,7 +1408,8 @@
:*gemini-toc-window*
:*chats-list-window*
:*gempub-library-window*
:*filesystem-explorer-window*))
:*filesystem-explorer-window*
:*gopher-window*))
(defpackage :complete
(:use
@ -1717,6 +1729,7 @@
:*gemini-toc-keymap*
:*gempub-library-keymap*
:*filesystem-explorer-keymap*
:*gopher-keymap*
:define-key
:init-keyboard-mapping
:find-keymap-node
@ -2257,6 +2270,32 @@
:init
:search-gemini-fragment))
(defpackage :gopher-window
(:use
:cl
:cl-ppcre
:config
:constants
:text-utils
:misc
:mtree
:keybindings
:specials
:windows
:modeline-window
:line-oriented-window
:tui-utils)
(:shadowing-import-from :text-utils :split-lines)
(:shadowing-import-from :misc :random-elt :shuffle)
(:local-nicknames (:c :croatoan)
(:a :alexandria))
(:export
:gopher-window
:go-to-next-link
:go-to-previous-link
:open-menu-link
:init))
(defpackage :open-attach-window
(:use
:cl
@ -2705,6 +2744,8 @@
:message-scroll-end
:message-scroll-next-page
:message-scroll-previous-page
:message-window-go-up
:message-window-go-down
:message-search-regex
:message-toggle-preformatted-block
:focus-to-message-window
@ -2713,6 +2754,7 @@
:focus-to-follow-requests-window
:focus-to-tags-window
:focus-to-conversations-window
:focus-to-gopher-window
:print-quick-help
:apropos-help
:apropos-help-global

73
src/software-configuration.lisp
View File

@ -463,7 +463,8 @@
,@(loop for name in names collect
`(gen-key-constant ,name))))
(gen-key-constants experimental
(gen-key-constants unknown
experimental
regex
background
foreground
@ -478,6 +479,7 @@
height
position
exclusive
search
mode
count
toc
@ -492,6 +494,7 @@
focus
prefix
postfix
line
padding
value
scheme
@ -543,6 +546,7 @@
chats-list-window
gemini-subscription-window
gemini-toc-window
gopher-window
attachment-header
max-numbers-allowed-attachments
max-message-length
@ -591,6 +595,11 @@
unread
directory-symbol
directory
file
binary-file
text-file
image-file
gif-file
fetch
update
iri
@ -926,7 +935,6 @@
+key-library+)
(res:home-datadir)))
(defun external-editor ()
(access:access *software-configuration*
+key-editor+))
@ -1045,6 +1053,67 @@
(gen-simple-access (all-link-open-program) +key-open-link-helper+)
(gen-simple-access (gopher-line-prefix-directory)
+key-gopher-window+
+key-line+
+key-prefix+
+key-directory+)
(gen-simple-access (gopher-line-prefix-uri)
+key-gopher-window+
+key-line+
+key-prefix+
+key-uri+)
(gen-simple-access (gopher-line-prefix-unknown)
+key-gopher-window+
+key-line+
+key-prefix+
+key-unknown+)
(gen-simple-access (gopher-line-prefix-binary-file)
+key-gopher-window+
+key-line+
+key-prefix+
+key-binary-file+)
(gen-simple-access (gopher-line-prefix-text-file)
+key-gopher-window+
+key-line+
+key-prefix+
+key-text-file+)
(gen-simple-access (gopher-line-prefix-image-file)
+key-gopher-window+
+key-line+
+key-prefix+
+key-image-file+)
(gen-simple-access (gopher-line-prefix-gif-file)
+key-gopher-window+
+key-line+
+key-prefix+
+key-gif-file+)
(gen-simple-access (gopher-line-prefix-search-index)
+key-gopher-window+
+key-line+
+key-prefix+
+key-search+)
(gen-simple-access (gopher-line-prefix-foreground)
+key-gopher-window+
+key-line+
+key-prefix+
+key-foreground+)
(gen-simple-access (gopher-line-prefix-attribute
:transform-value-fn tui-utils:text->tui-attribute)
+key-gopher-window+
+key-line+
+key-prefix+
+key-attribute+)
(defun link-regex->program-to-use-parameters (link)
(find-if (lambda (a) (cl-ppcre:scan (re a) link))
(config-all-link-open-program)))

2
src/specials.lisp
View File

@ -71,3 +71,5 @@
"The window that shows the gempub library.")
(defparameter *filesystem-explorer-window* nil)
(defparameter *gopher-window* nil)

26
src/ui-goodies.lisp
View File

@ -412,6 +412,12 @@ Metadata includes:
(defun message-scroll-previous-page ()
(message-window:scroll-previous-page *message-window*))
(defun message-window-go-down ()
(line-window-go-down *gemini-certificates-window*))
(defun message-window-go-up ()
(line-window-go-up *gemini-certificates-window*))
(defun message-search-regex-callback (regex &key (priority +maximum-event-priority+))
(let ((event (make-instance 'search-regex-message-content-event
:priority priority
@ -737,6 +743,11 @@ along the focused window."
:documentation "Move focus on filesystem explorer window"
:info-change-focus-message (_ "Focus passed on file explorer window"))
(gen-focus-to-window gopher-window
*gopher-window*
:documentation "Move focus on gopher window"
:info-change-focus-message (_ "Focus passed on gopher window"))
(defun print-quick-help ()
"Print a quick help"
(keybindings:print-help *main-window*))
@ -2164,11 +2175,16 @@ open-message-link-window:open-message-link"
Currently the only recognized protocols are gemini and kami."
(flet ((on-input-complete (url)
(let ((trimmed-url (trim-blanks url)))
(if (text-utils:string-starts-with-p kami:+kami-scheme+ trimmed-url)
(progn
(file-explorer-close-window)
(open-kami-address trimmed-url))
(open-gemini-address trimmed-url)))))
(cond
((text-utils:string-starts-with-p kami:+kami-scheme+ trimmed-url)
(file-explorer-close-window)
(open-kami-address trimmed-url))
((text-utils:string-starts-with-p gopher-parser:+gopher-scheme+ trimmed-url)
(multiple-value-bind (host port type selector)
(gopher-parser:parse-iri address)
(gopher-window::make-request host port type selector)))
(t
(open-gemini-address trimmed-url))))))
(if (null address)
(let ((prompt (open-url-prompt)))
(ask-string-input #'on-input-complete

1
tinmop.asd
View File

@ -126,6 +126,7 @@
(:file "message-rendering-utils")
(:file "thread-window")
(:file "message-window")
(:file "gopher-window")
(:file "open-attach-window")
(:file "open-message-link-window")
(:file "gemini-client-certificates-window")