From 864dc959e6a856e301404d412a3ccdc0f913e9b3 Mon Sep 17 00:00:00 2001 From: cage Date: Sat, 1 May 2021 13:44:50 +0200 Subject: [PATCH] - added tour mode to explore geminispace. --- etc/init.lisp | 10 +++++++- src/open-message-link-window.lisp | 6 +++-- src/package.lisp | 2 ++ src/ui-goodies.lisp | 41 ++++++++++++++++++++++++++++--- 4 files changed, 52 insertions(+), 7 deletions(-) diff --git a/etc/init.lisp b/etc/init.lisp index db76f0f..621568c 100644 --- a/etc/init.lisp +++ b/etc/init.lisp @@ -349,10 +349,14 @@ (define-key "s" #'gemini-subscribe-gemlog *gemini-message-keymap*) -(define-key "t" #'message-toggle-preformatted-block *gemini-message-keymap*) +(define-key "T" #'message-toggle-preformatted-block *gemini-message-keymap*) + +(define-key "t" #'next-tour-link *gemini-message-keymap*) (define-key "|" #'send-to-pipe *gemini-message-keymap*) + + ;; gemini stream window keymap (define-key "a" #'gemini-abort-download *gemini-downloads-keymap*) @@ -439,6 +443,10 @@ (define-key "N" #'repeat-search *open-message-link-keymap*) +(define-key "t" #'tour-mode-link *open-message-link-keymap*) + + + ;; chats list window (define-key "r" #'refresh-chat-messages *chats-list-keymap*) diff --git a/src/open-message-link-window.lisp b/src/open-message-link-window.lisp index 61724de..5c0fa81 100644 --- a/src/open-message-link-window.lisp +++ b/src/open-message-link-window.lisp @@ -163,9 +163,11 @@ (with-croatoan-window (croatoan-window object) (loop for link in (safe-subseq links top-rows-slice bottom-rows-slice) - for y from (+ y-start top-row-padding) by single-row-height do + for y from (+ y-start top-row-padding) by single-row-height + for index from top-rows-slice + do (print-text object - (gemini-parser:name link) + (format nil "[~a] ~a" index (gemini-parser:name link)) 1 y :bgcolor (bgcolor croatoan-window) :fgcolor (fgcolor croatoan-window))))))) diff --git a/src/package.lisp b/src/package.lisp index 5a676eb..4f7520f 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -2471,6 +2471,8 @@ :gemlog-cancel-subscription :send-to-pipe :send-message-to-pipe + :tour-mode-link + :next-tour-link :pass-focus-on-left :pass-focus-on-right :pass-focus-on-bottom diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp index b4dc1ad..5a7d8ee 100644 --- a/src/ui-goodies.lisp +++ b/src/ui-goodies.lisp @@ -1180,7 +1180,7 @@ authenticate this client on a gemini server." "Delete a gemini certificate, this could makes all user data on the server unreachable as the server will not be able to identify the client. -Of course could be possible to generate a new identit (i.e. a new +Of course could be possible to generate a new identity (i.e. a new certificate). " (flet ((on-input-complete (answer) @@ -1545,7 +1545,7 @@ certificate). (defun reset-timeline-pagination () "Removes the pagination data for current timeline and folder -For each timeline the software keep tracks of the oldest and newes toot fetched from the instance, This way we can expand the messages thread from the point we left after the latest update. +For each timeline the software keep tracks of the oldest and newest toot fetched from the instance, This way we can expand the messages thread from the point we left after the latest update. This command will remove those limits so that we can just jump to the last messages posted on the instance and start expanding toots from there." (let* ((timeline (thread-window:timeline-type *thread-window*)) @@ -1569,7 +1569,7 @@ This command will remove those limits so that we can just jump to the last messa (>= idx 0)))) choices-list)) (error-message - (_ "Invalid choices, usa a space separated list of positive integers.")) + (_ "Invalid choices, use a space separated list of positive integers.")) (db-utils:with-ready-database (:connect nil) (when-let* ((fields (line-oriented-window:selected-row-fields *thread-window*)) @@ -1735,7 +1735,7 @@ mot recent updated to least recent" ;;;; gemini (defun gemini-open-url-prompt () - "This is used when oppening gemini link too, see: + "This is used when opening gemini link too, see: open-message-link-window:open-message-link" (_ "Open Gemini url: ")) @@ -1861,3 +1861,36 @@ gemini://gemini.circumlunar.space/docs/companion/subscription.gmi (send-to-pipe-on-input-complete command message))) (ask-string-input #'on-input-complete :prompt (format nil (_ "Send message to command: ")))))) + + +(let ((tour ())) + (defun tour-mode-link () + "Enable \"tour mode\". Ask for link indices, each link + corresponding to the index will be saved in a special queue that + can be opened using `next-tour-link' in a last-in last-out way." + (when-let* ((rows (line-oriented-window:map-rows *open-message-link-window* + #'identity))) + (flet ((on-input-complete (indices) + (when (string-not-empty-p indices) + (let ((indices-list (mapcar + #'num:safe-parse-number + (split-words indices)))) + (loop for index in indices-list when index do + (if (<= 0 index (length rows)) + (push (elt rows index) + tour) + (notify (format nil (_ "Index ~a out of range") index) + :as-error t))) + (info-message (_ "Tour saved")))))) + (ask-string-input #'on-input-complete + :prompt (format nil (_ "link indices: ")))))) + + (defun next-tour-link () + "Open the next link in the tour queue." + (let* ((queue (reverse tour)) + (link (first queue))) + (if (null queue) + (error-message (_ "Tour completed")) + (let ((url (line-oriented-window:normal-text link))) + (setf tour (reverse (rest queue))) + (open-message-link-window:open-message-link url nil))))))