mirror of
https://codeberg.org/cage/tinmop/
synced 2025-02-17 08:10:36 +01:00
- automatically add a tour mode to browse the contents when opening a gempub.
This commit is contained in:
parent
6a91bd4da7
commit
4a81fad940
@ -2659,6 +2659,9 @@
|
|||||||
:gemlog-cancel-subscription
|
:gemlog-cancel-subscription
|
||||||
:send-to-pipe
|
:send-to-pipe
|
||||||
:send-message-to-pipe
|
:send-message-to-pipe
|
||||||
|
:clean-all-tour
|
||||||
|
:clean-tour
|
||||||
|
:add-links-to-tour
|
||||||
:tour-mode-link
|
:tour-mode-link
|
||||||
:next-tour-link
|
:next-tour-link
|
||||||
:show-tour-links
|
:show-tour-links
|
||||||
|
@ -1059,6 +1059,11 @@
|
|||||||
:initarg :give-focus-to-message-window
|
:initarg :give-focus-to-message-window
|
||||||
:reader give-focus-to-message-window-p
|
:reader give-focus-to-message-window-p
|
||||||
:writer (setf give-focus-to-message-window))
|
:writer (setf give-focus-to-message-window))
|
||||||
|
(opening-gempub-file
|
||||||
|
:initform nil
|
||||||
|
:initarg :opening-gempub-file
|
||||||
|
:reader opening-gempub-file-p
|
||||||
|
:writer (setf opening-gempub-file))
|
||||||
(enqueue
|
(enqueue
|
||||||
:initform nil
|
:initform nil
|
||||||
:initarg :enqueue
|
:initarg :enqueue
|
||||||
@ -1140,14 +1145,33 @@
|
|||||||
(if index-file
|
(if index-file
|
||||||
(setf (url object) (fs:cat-parent-dir temp-directory index-file))
|
(setf (url object) (fs:cat-parent-dir temp-directory index-file))
|
||||||
(setf (url object) temp-directory))
|
(setf (url object) temp-directory))
|
||||||
|
(setf (opening-gempub-file object) t)
|
||||||
(push-event object))))
|
(push-event object))))
|
||||||
|
((opening-gempub-file-p object)
|
||||||
|
(let* ((file-string (fs:slurp-file local-path))
|
||||||
|
(parsed (gemini-parser:parse-gemini-file file-string))
|
||||||
|
(parent-dir (fs:parent-dir-path local-path))
|
||||||
|
(links (gemini-parser:sexp->links parsed
|
||||||
|
nil
|
||||||
|
nil
|
||||||
|
parent-dir
|
||||||
|
:comes-from-local-file t))
|
||||||
|
(event (make-instance 'gemini-display-data-page
|
||||||
|
:local-path parent-dir
|
||||||
|
:window window
|
||||||
|
:payload file-string)))
|
||||||
|
(let ((*process-events-immediately* t))
|
||||||
|
(push-event event))
|
||||||
|
(ui:clean-all-tour)
|
||||||
|
(ui:add-links-to-tour links)
|
||||||
|
(gemini-viewer:push-url-to-history window local-path)))
|
||||||
(t
|
(t
|
||||||
(let* ((file-string (fs:slurp-file local-path))
|
(let* ((file-string (fs:slurp-file local-path))
|
||||||
(parent-dir (fs:parent-dir-path local-path))
|
(parent-dir (fs:parent-dir-path local-path))
|
||||||
(event (make-instance 'gemini-display-data-page
|
(event (make-instance 'gemini-display-data-page
|
||||||
:local-path parent-dir
|
:local-path parent-dir
|
||||||
:window window
|
:window window
|
||||||
:payload file-string)))
|
:payload file-string)))
|
||||||
(let ((*process-events-immediately* t))
|
(let ((*process-events-immediately* t))
|
||||||
(push-event event))
|
(push-event event))
|
||||||
(gemini-viewer:push-url-to-history window local-path))))))))
|
(gemini-viewer:push-url-to-history window local-path))))))))
|
||||||
|
@ -1924,6 +1924,20 @@ gemini://gemini.circumlunar.space/docs/companion/subscription.gmi
|
|||||||
|
|
||||||
(let ((tour ()))
|
(let ((tour ()))
|
||||||
|
|
||||||
|
(defun clean-tour (regex)
|
||||||
|
(let ((scanner (create-scanner regex :case-insensitive-mode t)))
|
||||||
|
(setf tour
|
||||||
|
(remove-if (lambda (a)
|
||||||
|
(or (scan scanner (gemini-parser:name a))
|
||||||
|
(scan scanner (gemini-parser:target a))))
|
||||||
|
tour))))
|
||||||
|
|
||||||
|
(defun clean-all-tour ()
|
||||||
|
(clean-tour ".*"))
|
||||||
|
|
||||||
|
(defun add-links-to-tour (links)
|
||||||
|
(funcall (tour-mode-on-input-completed-clsr links) ".*"))
|
||||||
|
|
||||||
(defun tour-mode-on-input-completed-clsr (links)
|
(defun tour-mode-on-input-completed-clsr (links)
|
||||||
(lambda (data)
|
(lambda (data)
|
||||||
(when (string-not-empty-p data)
|
(when (string-not-empty-p data)
|
||||||
|
Loading…
x
Reference in New Issue
Block a user