- [experimental][gemini] used URI's fragment as a search criteria for the gemini page (disabled by default).

etc/shared.conf

@@ -201,3 +201,16 @@ open "^((gemini://)|(\\.)|(/)).+gmi$"  with "tinmop"
 open "^((gemini://)|(\\.)|(/)).+txt$"  with "tinmop"
 open "^((gemini://)|(\\.)|(/)).+sh$"   with "tinmop"
 open ".gpub$"                          with "tinmop"
+
+######################
+# EXPERIMENTAL ZONE  #
+######################
+
+# use fragment of a gemini IRI/URI as a searching criteria for the downloaded page
+# E.g. gemini://foo/bar.gmi#baz will jump to the first occurence of "baz"
+# the fragment is used as a regular expressions
+
+# Note: incomplete implementation, works fine for headers, preformatted text,
+# and likely links, broken for the rest.
+
+experimental.gemini.iri.fragment.regex = no

src/gemini-viewer.lisp

@@ -441,7 +441,15 @@
                   (progn
                     (maybe-render-toc)
                     (ui:notify (_ "Gemini document downloading completed"))
-                    (setf (stream-status wrapper-object) :completed)))
+                    (setf (stream-status wrapper-object) :completed)
+                    (when (and fragment
+                               (swconf:config-gemini-fragment-as-regex-p))
+                      (let ((regex    (if (text-utils:percent-encoded-p fragment)
+                                          (text-utils:percent-encode    fragment)
+                                          fragment))
+                            (priority program-events:+standard-event-priority+))
+                        (ui::message-search-regex-callback regex
+                                                           :priority priority)))))
               ;; (allow-downloading wrapper-object)
               (gemini-client:close-ssl-socket download-socket))))))))
 ;;        (fs:delete-file-if-exists support-file)))))

src/package.lisp

@@ -1218,6 +1218,7 @@
    :config-purge-history-days-offset
    :config-purge-cage-days-offset
    :config-notification-life
+   :config-gemini-fragment-as-regex-p
    :config-notify-window-geometry
    :config-notification-icon
    :config-server-name

src/software-configuration.lisp

@@ -421,7 +421,9 @@
      ,@(loop for name in names collect
              `(gen-key-constant ,name))))
 
-(gen-key-constants background
+(gen-key-constants experimental
+                   regex
+                   background
                    foreground
                    title
                    start
@@ -541,6 +543,8 @@
                    directory
                    fetch
                    update
+                   iri
+                   fragment
                    close-after-select
                    password-echo-character
                    color-re
@@ -922,6 +926,14 @@
                    +key-notify-window+
                    +key-life+)
 
+(gen-simple-access (gemini-fragment-as-regex-p
+                    :transform-value-fn (lambda (a) (not (false-value-p a))))
+                   +key-experimental+
+                   +key-gemini+
+                   +key-iri+
+                   +key-fragment+
+                   +key-regex+)
+
 (defun config-notify-window-geometry ()
   (values (access:accesses  *software-configuration*
                             +key-notify-window+

src/ui-goodies.lisp

@@ -394,14 +394,16 @@ Metadata includes:
 (defun message-scroll-previous-page ()
   (message-window:scroll-previous-page *message-window*))
 
+(defun message-search-regex-callback (regex &key (priority +maximum-event-priority+))
+  (let ((event (make-instance 'search-regex-message-content-event
+                              :priority priority
+                              :payload  regex)))
+    (push-event event)))
+
 (defun message-search-regex ()
   "Search regular expression in message"
-  (flet ((on-input-complete (regex)
-           (let ((event (make-instance 'search-regex-message-content-event
-                                       :priority +maximum-event-priority+
-                                       :payload  regex)))
-             (push-event event))))
-    (ask-string-input #'on-input-complete :prompt (_ "Search key: "))))
+  (ask-string-input #'message-search-regex-callback
+                    :prompt (_ "Search key: ")))
 
 (defun message-toggle-preformatted-block ()
   "Toggles on/of preformatted block from text and shows alt text, if exists"