mirror of
https://codeberg.org/cage/tinmop/
synced 2025-02-17 08:10:36 +01:00
Merge branch 'gopher-support'
This commit is contained in:
cage
commit
b55eaccba4
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -251,15 +251,16 @@
|
||||
(nix:s-isdir (nix:stat-mode (nix:stat path))))))
|
||||
|
||||
(defun split-path-elements (path)
|
||||
(cl-ppcre:split *directory-sep-regexp* path))
|
||||
(let ((splitted (cl-ppcre:split *directory-sep-regexp* path)))
|
||||
(substitute *directory-sep* "" splitted :test #'string=)))
|
||||
|
||||
(defun path-last-element (path)
|
||||
(let ((elements (cl-ppcre:split *directory-sep-regexp* path)))
|
||||
(let ((elements (split-path-elements path)))
|
||||
(and elements
|
||||
(last-elt elements))))
|
||||
|
||||
(defun path-first-element (path)
|
||||
(let ((elements (cl-ppcre:split *directory-sep-regexp* path)))
|
||||
(let ((elements (split-path-elements path)))
|
||||
(and elements
|
||||
(first-elt elements))))
|
||||
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
;; tinmop: an humble gemini and pleroma client
|
||||
;; Copyright (C) 2020 cage
|
||||
;; tinmop: an humble gemini kami and pleroma client
|
||||
;; Copyright © 2022 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
|
||||
|
||||
257
src/gopher-window.lisp
Normal file
257
src/gopher-window.lisp
Normal 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))))
|
||||
128
src/gopher/client.lisp
Normal file
128
src/gopher/client.lisp
Normal file
@ -0,0 +1,128 @@
|
||||
;; tinmop: an humble gemini kami and pleroma client
|
||||
;; Copyright © 2022 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-client)
|
||||
|
||||
(a:define-constant +request-terminal+ (format nil "~a~a" #\Return #\Newline) :test #'string=)
|
||||
|
||||
(a:define-constant +response-terminal+ (format nil ".~a~a" #\Return #\Newline) :test #'string=)
|
||||
|
||||
(a:define-constant +response-read-buffer-size+ 4096 :test #'=)
|
||||
|
||||
(defun make-collect-fn (collected)
|
||||
(lambda (buffer)
|
||||
(loop for b across buffer do
|
||||
(vector-push-extend b collected 1024))))
|
||||
|
||||
(defun %request (host &key
|
||||
(port 70)
|
||||
(selector "")
|
||||
(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
|
||||
:element-type '(unsigned-byte 8)))
|
||||
(end-response-p (read-so-far buffer)
|
||||
(if (< read-so-far (length buffer))
|
||||
t
|
||||
(let ((maybe-terminal-data (subseq buffer
|
||||
(- read-so-far
|
||||
(length +response-terminal+))
|
||||
read-so-far)))
|
||||
(and (eq terminate-strategy :response-terminal)
|
||||
(string= (to-s maybe-terminal-data)
|
||||
+response-terminal+))))))
|
||||
(let* ((socket (open-socket host port))
|
||||
(stream (usocket:socket-stream socket)))
|
||||
(write-sequence (babel:string-to-octets (format nil
|
||||
"~a~a"
|
||||
selector
|
||||
+request-terminal+))
|
||||
stream)
|
||||
(finish-output stream)
|
||||
(let* ((buffer (misc:make-fresh-array +response-read-buffer-size+
|
||||
0
|
||||
'(unsigned-byte 8)
|
||||
t))
|
||||
(first-chunk-size (read-sequence buffer stream)))
|
||||
(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")
|
||||
(host response-type
|
||||
&key
|
||||
(port 70)
|
||||
(selector "")
|
||||
(collect-fn (lambda (data) (format t "~s" (to-s data)))))
|
||||
(cond
|
||||
,@(append
|
||||
(loop for return-type in return-types
|
||||
for strategy in strategies
|
||||
collect
|
||||
`((string= response-type ,return-type)
|
||||
(%request host
|
||||
:port port
|
||||
:selector selector
|
||||
:terminate-strategy ,strategy
|
||||
:collect-fn collect-fn)))
|
||||
`(((string= response-type +line-type-uri+)
|
||||
(open-message-link-window:open-message-link selector nil)))
|
||||
`((t
|
||||
(%request host :port port
|
||||
:selector selector
|
||||
:terminate-strategy nil
|
||||
:collect-fn collect-fn)))))))
|
||||
|
||||
(gen-request-function (+line-type-file+
|
||||
+line-type-dir+
|
||||
+line-type-error+
|
||||
+line-type-mac-hex-file+
|
||||
+line-type-dos-archive-file+
|
||||
+line-type-uuencoded-file+
|
||||
+line-type-index-search+
|
||||
+line-type-binary-file+
|
||||
+line-type-gif-image-file+
|
||||
+line-type-image-file+
|
||||
+line-type-info+)
|
||||
(:response-terminal
|
||||
:response-terminal
|
||||
:response-terminal
|
||||
nil
|
||||
nil
|
||||
nil
|
||||
:response-terminal
|
||||
nil
|
||||
nil
|
||||
nil
|
||||
:response-terminal))
|
||||
|
||||
(defun request-from-iri (iri &optional (collect-function (lambda (data)
|
||||
(format t "~a" (to-s data)))))
|
||||
(multiple-value-bind (host port type selector)
|
||||
(parse-iri iri)
|
||||
(request host
|
||||
type
|
||||
:port port
|
||||
:selector selector
|
||||
:collect-fn collect-function)))
|
||||
100
src/gopher/package.lisp
Normal file
100
src/gopher/package.lisp
Normal file
@ -0,0 +1,100 @@
|
||||
;; tinmop: an humble gemini kami and pleroma client
|
||||
;; Copyright © 2022 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/>.
|
||||
|
||||
(defpackage gopher-parser
|
||||
(:use
|
||||
:cl
|
||||
:cl-ppcre
|
||||
:esrap
|
||||
:config
|
||||
:constants
|
||||
:text-utils
|
||||
:misc)
|
||||
(:local-nicknames (:a :alexandria))
|
||||
(:export
|
||||
:+gopher-scheme+
|
||||
:+line-type-file+
|
||||
:+line-type-dir+
|
||||
:+line-type-cso+
|
||||
:+line-type-error+
|
||||
:+line-type-mac-hex-file+
|
||||
:+line-type-dos-archive-file+
|
||||
:+line-type-uuencoded-file+
|
||||
:+line-type-index-search+
|
||||
:+line-type-telnet-session+
|
||||
:+line-type-binary-file+
|
||||
:+line-type-gif-image-file+
|
||||
:+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-uuencoded-file
|
||||
:line-index-search
|
||||
:line-telnet-session
|
||||
:line-binary-file
|
||||
:line-redundant-server
|
||||
:line-tn3270-session
|
||||
:line-gif-file
|
||||
:line-image-file
|
||||
:line-info
|
||||
:line-uri
|
||||
: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
|
||||
(:use
|
||||
:cl
|
||||
:cl-ppcre
|
||||
:config
|
||||
:constants
|
||||
:text-utils
|
||||
:misc
|
||||
:gopher-parser)
|
||||
(:local-nicknames (:a :alexandria)
|
||||
(:parser :gopher-parser))
|
||||
(:export
|
||||
:make-collect-fn
|
||||
:request
|
||||
:request-from-iri))
|
||||
326
src/gopher/parser.lisp
Normal file
326
src/gopher/parser.lisp
Normal file
@ -0,0 +1,326 @@
|
||||
;; tinmop: an humble gemini kami and pleroma client
|
||||
;; Copyright © 2022 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-parser)
|
||||
|
||||
(defmacro def-line-type-constant (name value documentation)
|
||||
`(a:define-constant ,(format-fn-symbol t "+line-type-~a+" name) ,value
|
||||
:test #'string=
|
||||
:documentation ,documentation))
|
||||
|
||||
(defmacro gen-line-constants (name-values-doc-list)
|
||||
`(progn
|
||||
,@(loop for data in name-values-doc-list
|
||||
collect
|
||||
`(def-line-type-constant ,(first data) ,(second data) ,(third data)))))
|
||||
|
||||
(gen-line-constants ((file "0" "identifier for a file")
|
||||
(dir "1" "identifier for a directory")
|
||||
(cso "2" "identifier for a CSO phone-book server")
|
||||
(error "3" "identifier for an error")
|
||||
(mac-hex-file "4" "identifier for a BinHexed Macintosh file")
|
||||
(dos-archive-file "5" "identifier for a DOS binary archive of some sort")
|
||||
(uuencoded-file "6" "identifier for a UNIX uuencoded file")
|
||||
(index-search "7" "identifier for Index-Search server")
|
||||
(telnet-session "8" "identifier for a text-based telnet session.")
|
||||
(binary-file "9" "identifier for a binary file")
|
||||
(redundant-server "+" "identifier for a redundant server")
|
||||
(tn3270-session "T" "identifier for a tn3270 session")
|
||||
(gif-image-file "g" "identifier for an image in GIF")
|
||||
(image-file "I" "identifier for an image file")
|
||||
(info "i" "information line")
|
||||
(uri "h" "hyperlink")))
|
||||
|
||||
(a:define-constant +gopher-scheme+ "gopher" :test #'string=)
|
||||
|
||||
(defun %check-line-type (data reference)
|
||||
(string= data reference))
|
||||
|
||||
(defmacro %gen-check-line-predicate (name reference)
|
||||
(a:with-gensyms (data)
|
||||
`(defun ,(format-fn-symbol t "%line-type-~a-p" name) (,data)
|
||||
(%check-line-type ,data ,reference))))
|
||||
|
||||
(%gen-check-line-predicate file +line-type-file+)
|
||||
|
||||
(%gen-check-line-predicate dir +line-type-dir+)
|
||||
|
||||
(%gen-check-line-predicate cso +line-type-cso+)
|
||||
|
||||
(%gen-check-line-predicate error +line-type-error+)
|
||||
|
||||
(%gen-check-line-predicate mac-hex-file +line-type-mac-hex-file+)
|
||||
|
||||
(%gen-check-line-predicate dos-archive-file +line-type-dos-archive-file+)
|
||||
|
||||
(%gen-check-line-predicate uuencoded-file +line-type-uuencoded-file+)
|
||||
|
||||
(%gen-check-line-predicate index-search +line-type-index-search+)
|
||||
|
||||
(%gen-check-line-predicate telnet-session +line-type-telnet-session+)
|
||||
|
||||
(%gen-check-line-predicate binary-file +line-type-binary-file+)
|
||||
|
||||
(%gen-check-line-predicate redundant-server +line-type-redundant-server+)
|
||||
|
||||
(%gen-check-line-predicate tn3270-session +line-type-tn3270-session+)
|
||||
|
||||
(%gen-check-line-predicate gif-file +line-type-gif-image-file+)
|
||||
|
||||
(%gen-check-line-predicate image-file +line-type-image-file+)
|
||||
|
||||
(%gen-check-line-predicate info +line-type-info+)
|
||||
|
||||
(%gen-check-line-predicate uri +line-type-uri+)
|
||||
|
||||
(defclass gopher-line ()
|
||||
((line-type-id
|
||||
:initarg :line-type-id
|
||||
:initform ""
|
||||
:accessor line-type-id
|
||||
:type string)
|
||||
(username
|
||||
:initarg :username
|
||||
:initform ""
|
||||
:accessor username
|
||||
:type string)
|
||||
(selector
|
||||
:initarg :selector
|
||||
:initform ""
|
||||
:accessor selector
|
||||
:type string)
|
||||
(host
|
||||
:initarg :host
|
||||
:initform ""
|
||||
:accessor host
|
||||
:type string)
|
||||
(port
|
||||
:initarg :port
|
||||
:initform -1
|
||||
:accessor port
|
||||
:type number)))
|
||||
|
||||
(defmethod print-object ((object gopher-line) stream)
|
||||
(with-accessors ((username username)
|
||||
(selector selector)
|
||||
(host host)
|
||||
(port port)) object
|
||||
(print-unreadable-object (object stream :type t)
|
||||
(format stream
|
||||
"username: ~s selector: ~s host: ~s port ~a"
|
||||
username selector host port))))
|
||||
|
||||
(defmacro gen-selector-class (name)
|
||||
`(defclass ,name (gopher-line) ()))
|
||||
|
||||
(gen-selector-class line-file)
|
||||
|
||||
(gen-selector-class line-dir)
|
||||
|
||||
(gen-selector-class line-cso)
|
||||
|
||||
(gen-selector-class line-error)
|
||||
|
||||
(gen-selector-class line-mac-hex-file)
|
||||
|
||||
(gen-selector-class line-dos-archive-file)
|
||||
|
||||
(gen-selector-class line-uuencoded-file)
|
||||
|
||||
(gen-selector-class line-index-search)
|
||||
|
||||
(gen-selector-class line-telnet-session)
|
||||
|
||||
(gen-selector-class line-binary-file)
|
||||
|
||||
(gen-selector-class line-redundant-server)
|
||||
|
||||
(gen-selector-class line-tn3270-session)
|
||||
|
||||
(gen-selector-class line-gif-file)
|
||||
|
||||
(gen-selector-class line-image-file)
|
||||
|
||||
(gen-selector-class line-info)
|
||||
|
||||
(gen-selector-class line-uri)
|
||||
|
||||
(gen-selector-class line-unknown)
|
||||
|
||||
(defun check-line-type (data reference)
|
||||
(typep data reference))
|
||||
|
||||
(defmacro gen-check-line-predicate (name reference)
|
||||
(a:with-gensyms (data)
|
||||
`(defun ,(format-fn-symbol t "line-type-~a-p" name) (,data)
|
||||
(check-line-type ,data ,reference))))
|
||||
|
||||
(gen-check-line-predicate file 'line-file)
|
||||
|
||||
(gen-check-line-predicate dir 'line-dir)
|
||||
|
||||
(gen-check-line-predicate cso 'line-cso)
|
||||
|
||||
(gen-check-line-predicate error 'line-error)
|
||||
|
||||
(gen-check-line-predicate mac-hex-file 'line-mac-hex-file)
|
||||
|
||||
(gen-check-line-predicate dos-archive-file 'line-dos-archive-file)
|
||||
|
||||
(gen-check-line-predicate uuencoded-file 'line-uuencoded-file)
|
||||
|
||||
(gen-check-line-predicate index-search 'line-index-search)
|
||||
|
||||
(gen-check-line-predicate telnet-session 'line-telnet-session)
|
||||
|
||||
(gen-check-line-predicate binary-file 'line-binary-file)
|
||||
|
||||
(gen-check-line-predicate redundant-server 'line-redundant-server)
|
||||
|
||||
(gen-check-line-predicate tn3270-session 'line-tn3270-session)
|
||||
|
||||
(gen-check-line-predicate gif-file 'line-gif-image-file)
|
||||
|
||||
(gen-check-line-predicate image-file 'line-image-file)
|
||||
|
||||
(gen-check-line-predicate info 'line-info)
|
||||
|
||||
(gen-check-line-predicate uri 'line-uri)
|
||||
|
||||
(gen-check-line-predicate unknown 'unknown)
|
||||
|
||||
(defrule line-separator (and #\Return #\Newline)
|
||||
(:constant :line-separator))
|
||||
|
||||
(defrule field-separator #\tab
|
||||
(:constant :field-separator))
|
||||
|
||||
(defrule null-char #\Nul
|
||||
(:constant :field-separator))
|
||||
|
||||
(defrule unascii (not (or field-separator line-separator null-char))
|
||||
(:text t))
|
||||
|
||||
(defrule last-line (and #\. line-separator)
|
||||
(:constant :last-line))
|
||||
|
||||
(defrule line-type unascii
|
||||
(:text t))
|
||||
|
||||
(defrule red-type (and #\+ #\.)
|
||||
(:constant :red-type))
|
||||
|
||||
(defrule user-name (* unascii)
|
||||
(:text t))
|
||||
|
||||
(defrule selector (* unascii)
|
||||
(:text t))
|
||||
|
||||
(defrule hostname-component (* (not (or field-separator line-separator null-char
|
||||
#\.)))
|
||||
(:text t))
|
||||
|
||||
(defrule host (and (* (and hostname-component #\.))
|
||||
hostname-component)
|
||||
(:text t))
|
||||
|
||||
(defrule digit (character-ranges #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
|
||||
(:text t))
|
||||
|
||||
(defrule digit-sequence (and digit (* digit))
|
||||
(:text t))
|
||||
|
||||
(defrule port digit-sequence
|
||||
(:function parse-integer))
|
||||
|
||||
(defrule dir-entity (and line-type user-name field-separator
|
||||
selector field-separator
|
||||
host field-separator
|
||||
port line-separator)
|
||||
(:function (lambda (line)
|
||||
(list :type (first line)
|
||||
:user-name (second line)
|
||||
:selector (fourth line)
|
||||
:host (sixth line)
|
||||
:port (elt line 7)))))
|
||||
|
||||
(defrule menu (and (* dir-entity) last-line)
|
||||
(:function first))
|
||||
|
||||
(defun parse-menu (data)
|
||||
(let ((menu (parse 'menu data)))
|
||||
(loop for entry in menu
|
||||
collect
|
||||
(let* ((line-type (getf entry :type))
|
||||
(instance (cond
|
||||
((%line-type-file-p line-type)
|
||||
(make-instance 'line-file))
|
||||
((%line-type-dir-p line-type)
|
||||
(make-instance 'line-dir))
|
||||
((%line-type-cso-p line-type)
|
||||
(make-instance 'line-cso))
|
||||
((%line-type-error-p line-type)
|
||||
(make-instance 'line-error))
|
||||
((%line-type-mac-hex-file-p line-type)
|
||||
(make-instance 'line-mac-hex-file))
|
||||
((%line-type-dos-archive-file-p line-type)
|
||||
(make-instance 'line-dos-archive-file))
|
||||
((%line-type-uuencoded-file-p line-type)
|
||||
(make-instance 'line-uuencoded-file))
|
||||
((%line-type-index-search-p line-type)
|
||||
(make-instance 'line-index-search))
|
||||
((%line-type-telnet-session-p line-type)
|
||||
(make-instance 'line-telnet-session))
|
||||
((%line-type-binary-file-p line-type)
|
||||
(make-instance 'line-binary-file))
|
||||
((%line-type-redundant-server-p line-type)
|
||||
(make-instance 'line-redundant-server))
|
||||
((%line-type-tn3270-session-p line-type)
|
||||
(make-instance 'line-tn3270-session))
|
||||
((%line-type-gif-file-p line-type)
|
||||
(make-instance 'line-gif-file))
|
||||
((%line-type-image-file-p line-type)
|
||||
(make-instance 'line-image-file))
|
||||
((%line-type-info-p line-type)
|
||||
(make-instance 'line-info))
|
||||
((%line-type-uri-p line-type)
|
||||
(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 (or (uri:port parsed) 70))
|
||||
(path (uri:path parsed))
|
||||
(type (second (fs:split-path-elements path)))
|
||||
(selector (subseq path (+ 2 (length type)))))
|
||||
(values host port type selector)))
|
||||
@ -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:
|
||||
|
||||
@ -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
|
||||
@ -1718,6 +1730,7 @@
|
||||
:*gemini-toc-keymap*
|
||||
:*gempub-library-keymap*
|
||||
:*filesystem-explorer-keymap*
|
||||
:*gopher-keymap*
|
||||
:define-key
|
||||
:init-keyboard-mapping
|
||||
:find-keymap-node
|
||||
@ -2258,6 +2271,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
|
||||
@ -2706,6 +2745,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
|
||||
@ -2714,6 +2755,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
|
||||
|
||||
@ -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)))
|
||||
|
||||
@ -71,3 +71,5 @@
|
||||
"The window that shows the gempub library.")
|
||||
|
||||
(defparameter *filesystem-explorer-window* nil)
|
||||
|
||||
(defparameter *gopher-window* nil)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -100,6 +100,10 @@
|
||||
(:module kami
|
||||
:components ((:file "package")
|
||||
(:file "client")))
|
||||
(:module gopher
|
||||
:components ((:file "package")
|
||||
(:file "parser")
|
||||
(:file "client")))
|
||||
(:file "command-line")
|
||||
(:file "specials")
|
||||
(:file "keybindings")
|
||||
@ -122,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")
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user