From b437e2846b9ebbc6ffdf89de0a7c31f7698e949b Mon Sep 17 00:00:00 2001 From: cage Date: Sun, 10 Oct 2021 12:38:37 +0200 Subject: [PATCH] - added 'gemini-all-unread-posts', 'shuffle-tour', 'gemlog-add-unread-posts-tour', 'clear-tour' 'gemini-all-unread-posts' give user the choice to add all the currently unread post to the link tour. --- etc/init.lisp | 10 ++++++++++ src/db.lisp | 7 +++++++ src/gemini/gemini-parser.lisp | 5 ++++- src/gemini/package.lisp | 3 ++- src/main.lisp | 1 + src/package.lisp | 5 ++++- src/program-events.lisp | 4 ++-- src/ui-goodies.lisp | 18 +++++++++++++++++- 8 files changed, 47 insertions(+), 6 deletions(-) diff --git a/etc/init.lisp b/etc/init.lisp index d1da7fa..5a54748 100644 --- a/etc/init.lisp +++ b/etc/init.lisp @@ -157,6 +157,8 @@ (define-key "M-g s r" #'gemlog-refresh-all) +(define-key "M-g s t a" #'gemlog-add-unread-posts-tour) + (define-key "M-g c i" #'import-gemini-certificate) (define-key "M-g c s" #'gemini-open-certificates-window) @@ -165,6 +167,14 @@ (define-key "M-g g b s" #'display-bookmark) +(define-key "M-t t" #'next-tour-link) + +(define-key "M-t s" #'show-tour-links) + +(define-key "M-t S" #'shuffle-tour) + +(define-key "M-t c" #'clean-all-tour) + (define-key "M-right" #'pass-focus-on-right) (define-key "M-left" #'pass-focus-on-left) diff --git a/src/db.lisp b/src/db.lisp index 207972c..08c88b4 100644 --- a/src/db.lisp +++ b/src/db.lisp @@ -3055,6 +3055,13 @@ than `days-in-the-past' days (default: `(swconf:config-purge-cache-days-offset)' (rows (fetch-all-rows query))) rows)) +(defun gemini-all-unread-posts () + (when-let* ((query (select (:title :url) + (from +table-gemlog-entries+) + (where (:= :seenp (prepare-for-db nil :to-integer t))))) + (rows (fetch-all-rows query))) + rows)) + (defun gemini-cancel-subscription (gemlog-url) (query (delete-from +table-gemini-subscription+ (where (:= :url gemlog-url))))) diff --git a/src/gemini/gemini-parser.lisp b/src/gemini/gemini-parser.lisp index 4a1bd83..34cb077 100644 --- a/src/gemini/gemini-parser.lisp +++ b/src/gemini/gemini-parser.lisp @@ -87,7 +87,7 @@ text +preformatted-prefix+)) -(defun make-gemini-link (url title) +(defun render-gemini-link (url title) (format nil "~a ~a" (geminize-link url) title)) @@ -233,6 +233,9 @@ :initarg :name :accessor name))) +(defun make-gemini-link (target link-name) + (make-instance 'gemini-link :target target :name link-name)) + (defmethod print-object ((object gemini-link) stream) (print-unreadable-object (object stream :type t :identity t) (with-accessors ((target target) diff --git a/src/gemini/package.lisp b/src/gemini/package.lisp index fa17a54..7feadd2 100644 --- a/src/gemini/package.lisp +++ b/src/gemini/package.lisp @@ -49,10 +49,11 @@ :geminize-quote :geminize-link :geminize-preformatted - :make-gemini-link + :render-gemini-link :gemini-link :target :name + :make-gemini-link :path-last-dir :gemini-response :status-code diff --git a/src/main.lisp b/src/main.lisp index 33137da..97e198b 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -114,6 +114,7 @@ etc.) happened" (swconf:load-config-file swconf:+conf-filename+))) (defun shared-init () + (num:lcg-set-seed) (load-configuration-files) (init-db)) diff --git a/src/package.lisp b/src/package.lisp index 47368cf..5947d93 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -1041,6 +1041,7 @@ :row-seen-count :row-unseen-count :find-gemlog-entry + :gemini-all-unread-posts :gemini-cancel-subscription :add-gemlog-entries :gemlog-mark-as-seen @@ -2675,13 +2676,15 @@ :gemlog-cancel-subscription :send-to-pipe :send-message-to-pipe - :clean-all-tour + :shuffle-tour :clean-tour + :clean-all-tour :add-links-to-tour :tour-mode-link :next-tour-link :show-tour-links :save-selected-message-in-tour + :gemlog-add-unread-posts-tour :open-gemini-toc :gemini-toc-scroll-up :gemini-toc-scroll-down diff --git a/src/program-events.lisp b/src/program-events.lisp index c3e6d60..30e521d 100644 --- a/src/program-events.lisp +++ b/src/program-events.lisp @@ -1102,7 +1102,7 @@ (text-utils:strcat path " " dir-symbol) path)) (encoded-path (gemini-client::percent-encode-path path)) - (link (gemini-parser:make-gemini-link encoded-path link-label))) + (link (gemini-parser:render-gemini-link encoded-path link-label))) (push link link-lines))) (setf link-lines (sort link-lines #'string<)) (text-utils:join-with-strings (append (list raw-text) link-lines) @@ -1354,7 +1354,7 @@ (seenp (db-utils:db-not-nil-p (db:row-post-seenp entry)))) (format stream (_ "~a ~:[(not opened)~;(opened)~]~%") - (gemini-parser:make-gemini-link link + (gemini-parser:render-gemini-link link title) seenp))))) (url (iri:iri-parse gemlog-url)) diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp index db2afe8..e363bb8 100644 --- a/src/ui-goodies.lisp +++ b/src/ui-goodies.lisp @@ -1986,7 +1986,12 @@ gemini://gemini.circumlunar.space/docs/companion/subscription.gmi (let ((tour ())) + (defun shuffle-tour () + "Shuffle the links in the tour" + (setf tour (shuffle tour))) + (defun clean-tour (regex) + "Remove links from the tour matching `regex'" (let ((scanner (create-scanner regex :case-insensitive-mode t))) (setf tour (remove-if (lambda (a) @@ -1995,6 +2000,7 @@ gemini://gemini.circumlunar.space/docs/companion/subscription.gmi tour)))) (defun clean-all-tour () + "Remove all links from the tour" (clean-tour ".*")) (defun add-links-to-tour (links) @@ -2056,6 +2062,7 @@ gemini://gemini.circumlunar.space/docs/companion/subscription.gmi (error-message (_ "Tour completed")) (let ((url (gemini-parser:target link))) (setf tour (reverse (rest queue))) + (focus-to-message-window) (open-message-link-window:open-message-link url nil))))) (defun show-tour-links () @@ -2073,7 +2080,16 @@ gemini://gemini.circumlunar.space/docs/companion/subscription.gmi (label (or (gemini-parser:name selected-link) (gemini-parser:target selected-link)))) (push selected-link tour) - (info-message (format nil (_ "~s saved in tour") label)))))))) + (info-message (format nil (_ "~s saved in tour") label))))))) + + (defun gemlog-add-unread-posts-tour () + "Add all the unread gemlog posts to the tour" + (when-let* ((unread-posts (db:gemini-all-unread-posts)) + (links (mapcar (lambda (row) + (gemini-parser:make-gemini-link (db:row-url row) + (db:row-title row))) + unread-posts))) + (add-links-to-tour links)))) (defun open-gemini-toc () "Opend a windows that contains a generated table of contents of the