- [GUI] added button to refresh the gemlogs subcriptions.

src/gemini/package.lisp

@@ -210,4 +210,5 @@
   (:shadowing-import-from :misc :random-elt :shuffle)
   (:export
    :subscribe
+   :refresh-subscription-low-level
    :refresh))

src/gemini/subscription.lisp

@@ -63,27 +63,33 @@ This function return the 'post-title' substring."
           (db:gemini-subscribe-url url title subtitle))
         t))))
 
+(defun refresh-subscription-low-level (url)
+  (when-let* ((data       (slurp-gemini-url url))
+              (page       (text-utils:to-s data))
+              (parsed     (parse-gemini-file page :initialize-parser t))
+              (gemlog-iri (iri:iri-parse url)))
+    (let ((links (remove-if-not (lambda (a) (link-post-timestamp-p (name a)))
+                                (sexp->links parsed
+                                             (uri:host  gemlog-iri)
+                                             (uri:port  gemlog-iri)
+                                             (uri:path  gemlog-iri)
+                                             (uri:query gemlog-iri))))
+          (new-posts-count 0))
+      (loop for link in links do
+        (when (not (db:find-gemlog-entry (to-s (target link))))
+          (incf new-posts-count)
+          (let ((date (link-post-timestamp (name link))))
+            (db:add-gemlog-entries (to-s gemlog-iri)
+                                   (target link)
+                                   (link-post-title (name link))
+                                   date
+                                   nil))))
+      new-posts-count)))
+
 (defun refresh (url)
   "Refresh gemlog entries that can be  found at 'url'. The gemlog must
 be subscribed before (see: 'gemini-subscription:subcribe'"
   (handler-case
-      (when-let* ((data       (slurp-gemini-url url))
+      (refresh-subscription-low-level url)
-                  (page       (text-utils:to-s data))
-                  (parsed     (parse-gemini-file page :initialize-parser t))
-                  (gemlog-iri (iri:iri-parse url)))
-        (let ((links (remove-if-not (lambda (a) (link-post-timestamp-p (name a)))
-                                    (sexp->links parsed
-                                                 (uri:host  gemlog-iri)
-                                                 (uri:port  gemlog-iri)
-                                                 (uri:path  gemlog-iri)
-                                                 (uri:query gemlog-iri)))))
-          (loop for link in links do
-            (when (not (db:find-gemlog-entry (to-s (target link))))
-              (let ((date (link-post-timestamp (name link))))
-                (db:add-gemlog-entries (to-s gemlog-iri)
-                                       (target link)
-                                       (link-post-title (name link))
-                                       date
-                                       nil))))))
     (gemini-client:gemini-tofu-error (e)
       (ui:ask-input-on-tofu-error e (lambda () (refresh url))))))

src/gui/client/certificates-window.lisp

@@ -116,7 +116,7 @@
               (resync-rows certificate-frame (all-rows))
               (gui:exit-from-toplevel (gui:master import-window)))
           (error (e)
-            (client-main-window::notify-request-error e)))))))
+            (gui-goodies:notify-request-error e)))))))
 
 (defmethod initialize-instance :after ((object import-window) &key (certificate-frame nil)
                                        &allow-other-keys)

src/gui/client/gemlog-window.lisp

@@ -82,6 +82,15 @@
           (let ((new-rows (all-rows)))
             (resync-rows gemlog-frame new-rows)))))))
 
+(defun refresh-gemlogs-clsr (gemlog-frame)
+  (lambda ()
+    (when (gui:children (gui-goodies:tree gemlog-frame) gui:+treeview-root+)
+      (ev:with-enqueued-process-and-unblock ()
+        (gui-goodies::with-notify-errors
+          (comm:make-request :gemini-gemlog-refresh-all-subscriptions 1)
+          (let ((new-rows (all-rows)))
+            (resync-rows gemlog-frame new-rows)))))))
+
 (defun open-gemlog-clsr (main-window treeview-gemlogs)
   (lambda (e)
     (declare (ignore e))
@@ -110,11 +119,17 @@
            (unsubscribe-button (make-instance 'gui:button
                                               :master  buttons-frame
                                               :image   icons:*document-delete*
-                                              :command (unsubscribe-gemlog-clsr table))))
+                                              :command (unsubscribe-gemlog-clsr table)))
-      (gui-goodies:attach-tooltips (unsubscribe-button (_ "unsubscribe from selected gemlog")))
+           (refresh-button     (make-instance 'gui:button
+                                              :master  buttons-frame
+                                              :image   icons:*refresh*
+                                              :command (refresh-gemlogs-clsr table))))
+      (gui-goodies:attach-tooltips (unsubscribe-button (_ "unsubscribe from selected gemlog"))
+                                   (refresh-button     (_ "refresh all subscription")))
       (gui:grid table              0 0 :sticky :nwe)
       (gui:grid buttons-frame      1 0 :sticky :s)
       (gui:grid unsubscribe-button 0 0 :sticky :s)
+      (gui:grid refresh-button 0 1 :sticky :s)
       (gui:bind (gui:treeview (gui-goodies:tree table))
                 #$<<TreeviewSelect>>$
                 (open-gemlog-clsr main-window table)))

src/gui/client/gui-goodies.lisp

@@ -133,3 +133,19 @@
       (truncate (min (/ (gui:screen-width) 2
                         (gui:font-measure gui:+tk-text-font+ "0"))))
       (truncate (/ (gui:screen-width) 2))))
+
+(defun notify-request-error (error)
+  (error-dialog gui-goodies:*toplevel* error))
+
+(defmacro with-notify-errors (&body body)
+  `(handler-case
+       (progn ,@body)
+     (comm:rpc-error-response (e)
+       #+debug-mode (misc:dbg "backend comunication RPC error ~a" e)
+       (notify-request-error (format nil
+                                     (_ "~a: ~a")
+                                     (comm:code e)
+                                     (conditions:text e))))
+     (error (e)
+       #+debug-mode (misc:dbg "backend comunication error ~a" e)
+       (notify-request-error e))))

src/gui/client/main-window.lisp

@@ -64,9 +64,6 @@
 (defun find-streaming-stream-url ()
   (find-db-stream-if (lambda (a) (eq (status a) +stream-status-streaming+))))
 
-(defun notify-request-error (error)
-  (gui-goodies:error-dialog gui-goodies:*toplevel* error))
-
 (defgeneric stop-stream-thread (object))
 
 (defmethod stop-stream-thread ((object gemini-stream))
@@ -89,26 +86,13 @@
   (a:when-let ((stream-wrapper (find-streaming-stream-url)))
     (stop-stream-thread stream-wrapper)))
 
-(defmacro with-notify-errors (&body body)
-  `(handler-case
-       (progn ,@body)
-     (comm:rpc-error-response (e)
-       #+debug-mode (misc:dbg "backend comunication RPC error ~a" e)
-       (notify-request-error (format nil
-                                     (_ "~a: ~a")
-                                     (comm:code e)
-                                     (conditions:text e))))
-     (error (e)
-       #+debug-mode (misc:dbg "backend comunication error ~a" e)
-       (notify-request-error e))))
-
 (defun enqueue-request-notify-error (method-name id &rest args)
   (ev:with-enqueued-process-and-unblock ()
-    (with-notify-errors
+    (gui-goodies:with-notify-errors
       (apply #'comm:make-request method-name id args))))
 
 (defun render-toc (main-window iri)
-  (with-notify-errors
+  (gui-goodies:with-notify-errors
     (toc-clear main-window)
     (let* ((toc-max-width (gui-conf:config-toc-maximum-width))
            (toc           (comm:make-request :gemini-table-of-contents
@@ -141,7 +125,7 @@
                status-completed))
            (loop-fetch (&optional (last-lines-fetched-count 0))
              (ev:with-enqueued-process-and-unblock ()
-               (with-notify-errors
+               (gui-goodies:with-notify-errors
                  (let* ((last-lines-fetched (comm:make-request :gemini-stream-parsed-line-slice
                                                                1
                                                                iri
@@ -303,7 +287,7 @@
   (lambda (hint)
     (if (or (complete:expand-iri-as-local-path-p hint)
             (> (length hint) 2))
-        (with-notify-errors
+        (gui-goodies:with-notify-errors
           (let ((match-results (cev:enqueue-request-and-wait-results :complete-net-address
                                                                      1
                                                                      ev:+maximum-event-priority+
@@ -384,11 +368,11 @@
         ((or (gemini-client:header-temporary-failure-p   status-code)
              (gemini-client:header-permanent-failure-p   status-code)
              (gemini-client:header-certificate-failure-p status-code))
-         (notify-request-error (format nil
+         (gui-goodies:notify-request-error (format nil
-                                       "Error getting ~a (~a ~a)"
+                                                   "Error getting ~a (~a ~a)"
-                                       iri
+                                                   iri
-                                        status-code
+                                                   status-code
-                                        status-description)))
+                                                   status-description)))
         ((gemini-client:header-redirect-p status-code)
          (when (gui:ask-yesno (format nil (_ "Follow redirection to ~a?") meta)
                               :title (_ "Redirection")
@@ -807,7 +791,7 @@
     ((fs:directory-exists-p path)
      (gui:choose-directory :initial-dir path :parent main-window :mustexist t))
     (t
-     (notify-request-error (format nil (_ "No such file or directory: ~a") path)))))
+     (gui-goodies:notify-request-error (format nil (_ "No such file or directory: ~a") path)))))
 
 (defun render-gemtext-string (main-window parsed-lines &key (links-path-prefix ""))
   (ev:with-enqueued-process-and-unblock ()
@@ -843,7 +827,7 @@
           (t
            (client-os-utils:open-resource-with-external-program main-window iri))))
     (error (e)
-      (notify-request-error e))))
+      (gui-goodies:notify-request-error e))))
 
 (defun get-user-request-query (iri meta main-window &key (sensitive nil))
   (let* ((parsed-iri    (iri:iri-parse iri))

src/gui/server/public-api-gemini-gemlog.lisp

@@ -46,3 +46,18 @@
                                                    subtitle
                                                    table)))
     (gemini-parse-string page)))
+
+(defun gemini-gemlog-refresh-subscription (gemlog-url)
+  (list (cons "url" gemlog-url)
+        (cons "new-posts" (gemini-subscription:refresh-subscription-low-level gemlog-url))))
+
+(defclass gemini-gemlog-subscriptions-refreshed (box) ())
+
+(defmethod yason:encode ((object gemini-gemlog-subscriptions-refreshed) &optional (stream *standard-output*))
+  (encode-flat-array-of-plists (unbox object) stream))
+
+(defun gemini-gemlog-refresh-all-subscriptions ()
+  (let ((all-subscribed-gemlogs (mapcar #'db:row-url (db:gemini-all-subscriptions))))
+    (loop for subscription in all-subscribed-gemlogs
+          collect
+          (gemini-gemlog-refresh-subscription subscription))))

src/gui/server/public-api.lisp

@@ -121,6 +121,8 @@
      (gen-rpc "gemini-gemlog-subscribe" 'gemini-gemlog-subscribe "iri" 0)
      (gen-rpc "gemini-gemlog-subscribed-p" 'gemini-gemlog-subscribed-p "iri" 0)
      (gen-rpc "gemini-gemlog-all-subscription" 'gemini-gemlog-all-subscription)
+     (gen-rpc "gemini-gemlog-refresh-all-subscriptions"
+              'gemini-gemlog-refresh-all-subscriptions)
      (gen-rpc "gemini-gemlog-unsubscribe" 'gemini-gemlog-unsubscribe "iri" 0)
      (gen-rpc "gemini-gemlog-entries"     'gemini-gemlog-entries
               "iri" 0

src/package.lisp

@@ -3417,7 +3417,9 @@
    :table-frame
    :tree
    :rows
-   :quite-good-dialog-width))
+   :quite-good-dialog-width
+   :notify-request-error
+   :with-notify-errors))
 
 (defpackage :client-menu-command
   (:use