mirror of
https://codeberg.org/cage/tinmop/
synced 2025-03-10 11:00:04 +01:00
- added a basic gopher implementation.
This commit is contained in:
cage
parent
a393b0ba88
commit
d3e36f8efd
@ -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
|
||||
|
||||
@ -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
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))))
|
||||
@ -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)))))
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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)))))
|
||||
|
||||
@ -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
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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")
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user