- automatically add a tour mode to browse the contents when opening a gempub.

src/package.lisp

@@ -2659,6 +2659,9 @@
    :gemlog-cancel-subscription
    :send-to-pipe
    :send-message-to-pipe
+   :clean-all-tour
+   :clean-tour
+   :add-links-to-tour
    :tour-mode-link
    :next-tour-link
    :show-tour-links

src/program-events.lisp

@@ -1059,6 +1059,11 @@
     :initarg :give-focus-to-message-window
     :reader  give-focus-to-message-window-p
     :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
     :initform nil
     :initarg :enqueue
@@ -1140,7 +1145,26 @@
                (if index-file
                    (setf (url object) (fs:cat-parent-dir temp-directory index-file))
                    (setf (url object) temp-directory))
+               (setf (opening-gempub-file object) t)
                (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
            (let* ((file-string (fs:slurp-file local-path))
                   (parent-dir  (fs:parent-dir-path local-path))

src/ui-goodies.lisp

@@ -1924,6 +1924,20 @@ gemini://gemini.circumlunar.space/docs/companion/subscription.gmi
 
 (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)
     (lambda (data)
       (when (string-not-empty-p data)