From d3e36f8efd1cd151ca6546b11d4f63989a3557dd Mon Sep 17 00:00:00 2001 From: cage Date: Sun, 28 Aug 2022 13:22:08 +0200 Subject: [PATCH] - added a basic gopher implementation. --- etc/default-theme.conf | 64 +++++--- etc/init.lisp | 16 ++ src/gemini-viewer.lisp | 5 +- src/gopher-window.lisp | 257 ++++++++++++++++++++++++++++++++ src/gopher/client.lisp | 34 +++-- src/gopher/package.lisp | 43 ++++-- src/gopher/parser.lisp | 38 +++-- src/keybindings.lisp | 6 +- src/package.lisp | 44 +++++- src/software-configuration.lisp | 73 ++++++++- src/specials.lisp | 2 + src/ui-goodies.lisp | 26 +++- tinmop.asd | 1 + 13 files changed, 536 insertions(+), 73 deletions(-) create mode 100644 src/gopher-window.lisp diff --git a/etc/default-theme.conf b/etc/default-theme.conf index fd3d0e0..35e5d17 100644 --- a/etc/default-theme.conf +++ b/etc/default-theme.conf @@ -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 diff --git a/etc/init.lisp b/etc/init.lisp index bae1690..ae77d27 100644 --- a/etc/init.lisp +++ b/etc/init.lisp @@ -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 diff --git a/src/gemini-viewer.lisp b/src/gemini-viewer.lisp index 2cadc72..0ee5fc2 100644 --- a/src/gemini-viewer.lisp +++ b/src/gemini-viewer.lisp @@ -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)) diff --git a/src/gopher-window.lisp b/src/gopher-window.lisp new file mode 100644 index 0000000..ba6f264 --- /dev/null +++ b/src/gopher-window.lisp @@ -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 . + +(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)))) diff --git a/src/gopher/client.lisp b/src/gopher/client.lisp index f34d4a5..231c09d 100644 --- a/src/gopher/client.lisp +++ b/src/gopher/client.lisp @@ -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))))) diff --git a/src/gopher/package.lisp b/src/gopher/package.lisp index d7595cc..115cd31 100644 --- a/src/gopher/package.lisp +++ b/src/gopher/package.lisp @@ -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)) diff --git a/src/gopher/parser.lisp b/src/gopher/parser.lisp index d5d13bb..8e21a89 100644 --- a/src/gopher/parser.lisp +++ b/src/gopher/parser.lisp @@ -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))))) diff --git a/src/keybindings.lisp b/src/keybindings.lisp index 43f7ebb..1257aa2 100644 --- a/src/keybindings.lisp +++ b/src/keybindings.lisp @@ -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: diff --git a/src/package.lisp b/src/package.lisp index 99b8dd4..614bd2f 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -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 diff --git a/src/software-configuration.lisp b/src/software-configuration.lisp index 4c4d97a..1fb6027 100644 --- a/src/software-configuration.lisp +++ b/src/software-configuration.lisp @@ -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))) diff --git a/src/specials.lisp b/src/specials.lisp index 4c99f33..8f705d0 100644 --- a/src/specials.lisp +++ b/src/specials.lisp @@ -71,3 +71,5 @@ "The window that shows the gempub library.") (defparameter *filesystem-explorer-window* nil) + +(defparameter *gopher-window* nil) diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp index 466b3e9..4527fd4 100644 --- a/src/ui-goodies.lisp +++ b/src/ui-goodies.lisp @@ -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 diff --git a/tinmop.asd b/tinmop.asd index 0d0f4c4..dca8701 100644 --- a/tinmop.asd +++ b/tinmop.asd @@ -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")