- [gemini] added subscription command to gemlog.

etc/init.lisp

@@ -335,6 +335,8 @@
 
 (define-key "r"         #'gemini-refresh-page                        *gemini-message-keymap*)
 
+(define-key "s"         #'gemini-subscribe-gemlog                    *gemini-message-keymap*)
+
 ;; gemini stream window keymap
 
 (define-key "a"         #'gemini-abort-download                      *gemini-downloads-keymap*)

src/gemini/package.lisp

@@ -124,4 +124,5 @@
    :gemini-client)
   (:shadowing-import-from :misc :random-elt :shuffle)
   (:export
-   :subscribe))
+   :subscribe
+   :refresh))

src/gemini/subscription.lisp

@@ -75,14 +75,16 @@ This function return the 'post-title' substring."
     (when-let* ((data   (slurp-gemini-url url))
                 (page   (babel:octets-to-string data))
                 (parsed (parse-gemini-file page))
-                (iri    (iri:iri-parse url)))
-      (let* ((title                   (first (html-utils:children (html-utils:find-tag :h1
-                                                                                       parsed))))
-             (maybe-subtitle-pos (html-utils:position-tag :h2 parsed))
+                (iri    (iri:iri-parse url))
+                (title  (first (html-utils:children (html-utils:find-tag :h1
+                                                                         parsed)))))
+      (let* ((maybe-subtitle-pos (html-utils:position-tag :h2 parsed))
              (subtitle           (when (subtitle-p parsed maybe-subtitle-pos)
                                    (first (html-utils:children (elt parsed
                                                                     maybe-subtitle-pos))))))
-        (db:gemini-subscribe-url url title subtitle)))))
+        (when (not (db:gemini-find-subscription url))
+          (db:gemini-subscribe-url url title subtitle))
+        t))))
 
 (defun refresh (url)
   "Refresh gemlog entries that can be  found at 'url'. The gemlog must

src/package.lisp

@@ -1339,6 +1339,7 @@
    :gemini-abort-downloading-event
    :gemini-compact-lines-event
    :gemini-enqueue-download-event
+   :gemini-gemlog-subscribe-event
    :get-chat-messages-event
    :get-chats-event
    :chat-show-event
@@ -2351,6 +2352,7 @@
    :gemini-streams-window-close
    :gemini-streams-window-open-stream
    :gemini-refresh-page
+   :gemini-subscribe-gemlog
    :send-to-pipe
    :send-message-to-pipe))
 

src/program-events.lisp

@@ -1138,6 +1138,19 @@
   (with-accessors ((stream-object payload)) object
     (gemini-viewer:push-db-stream stream-object)))
 
+(defclass gemini-gemlog-subscribe-event (program-event) ())
+
+(defmethod process-event ((object gemini-gemlog-subscribe-event))
+  (with-accessors ((url payload)) object
+    (let ((subscribedp (gemini-subscription:subscribe url)))
+      (when (not subscribedp)
+        (gemini-subscription:refresh url)
+        (ui:notify (format nil
+                           (_ "Unable to subscribe to ~s")
+                           url)
+                   :as-error t)))))
+
+
 ;;;; pleroma
 
 (defclass get-chat-messages-event (program-event)

src/ui-goodies.lisp

@@ -1783,6 +1783,20 @@ mot recent updated to least recent"
     (push-event event-abort)
     (push-event event-open)))
 
+(defun gemini-subscribe-gemlog ()
+  "Subscribe to the gemlog shown in the main window.
+
+The page must be formatted according to gemini subscription specifications:
+
+gemini://gemini.circumlunar.space/docs/companion/subscription.gmi
+
+"
+  (when-let ((url (gemini-viewer:current-gemini-url)))
+    (with-blocking-notify-procedure ((format nil (_ "Subscribing to ~s") url))
+      (let ((event (make-instance 'gemini-gemlog-subscribe-event
+                                  :payload url)))
+        (push-event event)))))
+
 (defun send-to-pipe ()
   "Send contents of window to a command"
   (flet ((on-input-complete (command)