From bce702465c02cf0727b5ced5a2cb95501b08d361 Mon Sep 17 00:00:00 2001
From: cage <cage@invalid>
Date: Sun, 17 Oct 2021 17:40:18 +0200
Subject: [PATCH] - [experimental][gemini] used URI's fragment as a search
 criteria for the gemini page (disabled by default).

---
 etc/shared.conf                 | 13 +++++++++++++
 src/gemini-viewer.lisp          | 10 +++++++++-
 src/package.lisp                |  1 +
 src/software-configuration.lisp | 14 +++++++++++++-
 src/ui-goodies.lisp             | 14 ++++++++------
 5 files changed, 44 insertions(+), 8 deletions(-)

diff --git a/etc/shared.conf b/etc/shared.conf
index 1b47d07..cd8bf3c 100644
--- a/etc/shared.conf
+++ b/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
\ No newline at end of file
diff --git a/src/gemini-viewer.lisp b/src/gemini-viewer.lisp
index b361be6..3e77634 100644
--- a/src/gemini-viewer.lisp
+++ b/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)))))
diff --git a/src/package.lisp b/src/package.lisp
index ce47b94..e5daa11 100644
--- a/src/package.lisp
+++ b/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
diff --git a/src/software-configuration.lisp b/src/software-configuration.lisp
index 07f9fcc..bc2c258 100644
--- a/src/software-configuration.lisp
+++ b/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+
diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp
index e363bb8..61290d9 100644
--- a/src/ui-goodies.lisp
+++ b/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"