- [GUI] added a button thet acs as a shortcut to open the TOC of the last opened gempub.

ChangeLog

@@ -1,12 +1,54 @@
+2024-09-28 cage
+
+	* data/scripts/gemget.lisp,
+	* etc/init.lisp,
+	* src/command-line.lisp,
+	* src/constants.lisp,
+	* src/gemini/dummy-server.lisp,
+	* src/gui/client/main-window.lisp:
+
+	- [script] passed command line arguments to gemget;
+	- update documentation.
+	- fixed keychord for 'clear-cache' command.
+	- simulated a server that send data slowly (but not slow enough to
+	trigger a timeout).
+	- [GUI] rewritten 'loop-fetch' in iterative style to prevent a stack
+	overflow when the server is too slow providing response's data.
+
 2024-09-27 cage
 
+	* .gitignore,
+	* ChangeLog,
+	* NEWS.org,
+	* configure,
+	* configure.ac,
+	* etc/shared.conf,
+	* po/ca.po,
+	* po/de.po,
+	* po/es.po,
+	* po/fr.po,
+	* po/it.po,
+	* po/pl.po,
+	* po/tinmop.pot,
 	* src/db.lisp,
 	* src/gui/server/json-rpc-communication.lisp,
-	* src/text-utils.lisp:
+	* src/package.lisp,
+	* src/scheduled-events.lisp,
+	* src/software-configuration.lisp,
+	* src/text-utils.lisp,
+	* tinmop.asd:
 
 	- [GUI] ensured cleaning of temporary files on exit.
 	- [fediverse] ensured the posts do not contains non printable
 	characters.
+	- update version number building scrips and changelog.
+	- updated NEWS.org.
+	- updated reference lines number in PO files.
+	- added purging of unused mentions from database;
+	- fixed function to clean configuration directives relate dto purging
+	entries from database (history, mentions etc.).
+	- added 'rc1' to version numeber.
+	Merge branch 'master' into development
 
 2024-09-26 cage
 

Makefile.am

@@ -75,6 +75,7 @@ data/icons/fmw_search.png \
 data/icons/fmw_star-blue.png \
 data/icons/fmw_star-yellow.png \
 data/icons/fmw_text.png \
+data/icons/fmw_toc.png \
 data/icons/fmw_two-pictures.png \
 data/icons/fmw_uparrow.png \
 data/modules/delete-by-regex.lisp \

Makefile.in

@@ -442,6 +442,7 @@ data/icons/fmw_search.png \
 data/icons/fmw_star-blue.png \
 data/icons/fmw_star-yellow.png \
 data/icons/fmw_text.png \
+data/icons/fmw_toc.png \
 data/icons/fmw_two-pictures.png \
 data/icons/fmw_uparrow.png \
 data/modules/delete-by-regex.lisp \

etc/init.lisp

@@ -159,7 +159,7 @@
 
 (define-key "?"         #'print-quick-help)
 
-(define-key "C d"       #'clear-cache)
+(define-key "C-d"       #'clear-cache)
 
 (define-key "C-I"       #'pass-focus-next)
 

src/command-line.lisp

@@ -143,7 +143,6 @@
 
 (defparameter *free-arguments*                     nil)
 
-
 (defun exit-on-error (e)
   (format *error-output* "~a~%" e)
   (os-utils:exit-program 1))

src/gemini/dummy-server.lisp

@@ -59,6 +59,23 @@ and  key   stored  in  the   file  pointed  by  the   filesystem  path
                                                     request
                                                     client-cert-fingerprint)
                                             (cond
+                                              ((cl-ppcre:scan "slow" request)
+                                               (format t "slow...~%")
+                                               (let ((response (format nil
+                                                                       "~a text/gemini~a~a"
+                                                                       (code gemini-client::+20+)
+                                                                       #\return #\newline)))
+                                                 (format t "sending: ~a~%" response)
+                                                 (write-sequence (text-utils:string->octets response)
+                                                                 stream)
+                                                 (loop for i from 0 below 100 do
+                                                   (sleep 1)
+                                                   (write-sequence (text-utils:string->octets (format nil "~a~%" i))
+                                                                   stream)
+                                                   (finish-output stream)
+                                                   (format t "sent ~a~%" i))
+                                                 (close stream)
+                                                 (get-data)))
                                               ((cl-ppcre:scan "timeout" request)
                                                (format t "timeout...~%")
                                                (sleep 3600))

src/gui/client/gempub-window.lisp

@@ -129,6 +129,15 @@
         gempub-content-directory))
      (fs:cat-parent-dir gempub-content-directory "/"))))
 
+(defun open-gemini-toc (main-window gempub-metadata)
+  (client-main-window::set-address-bar-text main-window
+                                            (getf gempub-metadata :book-directory))
+  (client-main-window::open-iri (getf gempub-metadata :index-file)
+                                main-window
+                                nil)
+  (ev:with-enqueued-process-and-unblock ()
+    (client-main-window::inline-all-images main-window)))
+
 (defun open-gempub-clsr (main-window gempub-frame)
   (lambda (e)
     (declare (ignore e))
@@ -142,10 +151,10 @@
                                                                      id)))
         (multiple-value-bind (path book-directory)
             (make-gempub-index row)
-          (client-main-window::set-address-bar-text main-window book-directory)
-          (client-main-window::open-iri path main-window nil)
-          (ev:with-enqueued-process-and-unblock ()
-            (client-main-window::inline-all-images main-window)))))))
+          (setf (getf row :index-file) path)
+          (setf (getf row :book-directory) book-directory)
+          (client-main-window:set-gempub-mode main-window row)
+          (open-gemini-toc main-window row))))))
 
 (defun init-window (master main-window query-results)
   (client-main-window:hide-autocomplete-candidates main-window)

src/gui/client/icons.lisp

@@ -48,6 +48,8 @@
 
 (a:define-constant +profile+            "fmw_profile.png"          :test #'string=)
 
+(a:define-constant +toc+                "fmw_toc.png"              :test #'string=)
+
 (defparameter *search*             nil)
 
 (defparameter *back*               nil)
@@ -96,6 +98,10 @@
 
 (defparameter *profile-disabled*   nil)
 
+(defparameter *toc*                nil)
+
+(defparameter *toc-disabled*       nil)
+
 (defun icon-filename->filepath (filename)
   (if (not (re:scan "(?i)png$" filename))
       (res:get-data-file (fs:cat-parent-dir +icon-dir+
@@ -141,4 +147,6 @@
     (setf *inline-images*      (load-icon +inline-images+))
     (setf *text*               (load-icon +text+))
     (setf *profile*            (load-icon +profile+))
-    (setf *profile-disabled*   (disable-icon +profile+))))
+    (setf *profile-disabled*   (disable-icon +profile+))
+    (setf *toc*                (load-icon +toc+))
+    (setf *toc-disabled*       (disable-icon +toc+))))

src/gui/client/main-window.lisp

@@ -134,6 +134,7 @@
                               (process-function  #'identity)
                               (aborting-function (constantly nil))
                               (ignore-certificate-expiration nil))
+  "This code runs in a different thread spawned in `start-streaming-thread'."
   (ev:with-enqueued-process-and-unblock ()
     (set-focus-to-gemtext main-window))
   (enqueue-request-notify-error :gemini-request
@@ -161,23 +162,33 @@
                                                                 (gemtext-widget main-window)
                                                                 nil)
                         nil)))
+           (fetch-latest-lines (iri last-lines-fetched-count)
+             (gui-goodies:with-notify-errors
+               (cev:enqueue-request-and-wait-results :gemini-stream-parsed-line-slice
+                                                     1
+                                                     ev:+standard-event-priority+
+                                                     iri
+                                                     last-lines-fetched-count ; start slice
+                                                     nil))) ; end slice
            (loop-fetch (&optional (last-lines-fetched-count 0))
-             (ev:with-enqueued-process-and-unblock ()
-               (gui-goodies:with-notify-errors
-                 (let* ((last-lines-fetched (comm:make-request :gemini-stream-parsed-line-slice
-                                                               1
-                                                               iri
-                                                               last-lines-fetched-count
-                                                               nil))
-                        (next-start-fetching (length last-lines-fetched)))
-                   (when last-lines-fetched
-                     (funcall process-function stream-wrapper last-lines-fetched))
-                   (if (not (or (funcall aborting-function)
-                                  (and (stream-exausted-p)
-                                       (<= next-start-fetching 0))))
-                       (loop-fetch (+ last-lines-fetched-count
-                                      next-start-fetching))
-                       (perform-after-stream-exausted-actions)))))))
+             (let* ((last-lines-fetched (fetch-latest-lines iri last-lines-fetched-count))
+                    (next-start-fetching (length last-lines-fetched)))
+               (misc:dbg "loop fetch ~a ~a" iri last-lines-fetched-count)
+               (loop while (not (or (funcall aborting-function)
+                                (and (stream-exausted-p)
+                                     (<= next-start-fetching 0))))
+                     do
+                        (progn
+                          (when last-lines-fetched
+                            (ev:with-enqueued-process-and-unblock ()
+                              (gui-goodies:with-notify-errors
+                                (funcall process-function stream-wrapper last-lines-fetched))))
+                          (setf last-lines-fetched (fetch-latest-lines iri last-lines-fetched-count))
+                          (setf next-start-fetching (length last-lines-fetched))
+                          (incf last-lines-fetched-count next-start-fetching)))
+               (ev:with-enqueued-process-and-unblock ()
+                 (gui-goodies:with-notify-errors
+                   (perform-after-stream-exausted-actions))))))
     (loop-fetch)
     (if (cev:enqueue-request-and-wait-results :gemini-bookmarked-p
                                               1
@@ -353,7 +364,11 @@
    (inline-images-button
     :initform nil
     :initarg  :inline-images-button
-    :accessor inline-images-button)))
+    :accessor inline-images-button)
+   (toc-button
+    :initform nil
+    :initarg  :toc-button
+    :accessor toc-button)))
 
 (defun autocomplete-iri-clsr (toolbar)
   (declare (ignore toolbar))
@@ -1346,7 +1361,9 @@ local file paths."
                                                    1
                                                    ev:+maximum-event-priority+
                                                    iri)
-             (start-stream-iri iri main-window use-cache
+             (start-stream-iri iri
+                               main-window
+                               use-cache
                                :status status
                                :ignore-certificate-expiration ignore-certificate-expiration)))
           ((or (gemini-client:header-temporary-failure-p   status-code)
@@ -1511,6 +1528,17 @@ local file paths."
   (gui:configure (certificate-button (tool-bar main-window)) :state :disabled)
   (set-certificate-button-image main-window icons:*profile-disabled*))
 
+(defun set-toc-button-image (main-window image)
+  (set-toolbar-button-image main-window 'toc-button image))
+
+(defun set-toc-button-active (main-window)
+  (gui:configure (toc-button (tool-bar main-window)) :state :normal)
+  (set-toc-button-image main-window icons:*toc*))
+
+(defun set-toc-button-inactive (main-window)
+  (gui:configure (toc-button (tool-bar main-window)) :state :disabled)
+  (set-toc-button-image main-window icons:*toc-disabled*))
+
 (defun toggle-bookmark-iri-clsr (main-window)
   (lambda ()
     (with-accessors ((tool-bar tool-bar)) main-window
@@ -1591,6 +1619,16 @@ local file paths."
                                                         (get-address-bar-text main-window))))
       (change-client-certificate-key-passphrase main-window key-path))))
 
+(defun open-index-gempub-clsr (main-window)
+  (lambda ()
+    (with-accessors ((gempub-metadata gempub-metadata)) main-window
+      (when (gempub-mode-p main-window)
+        (let ((iri (getf gempub-metadata :index-file)))
+          (if (string-not-empty-p iri)
+              (ev:with-enqueued-process-and-unblock ()
+                (client-gempub-window::open-gemini-toc main-window gempub-metadata))
+              (gui-goodies:notify-request-error (_ "Index file not found"))))))))
+
 (defun setup-main-window-events (main-window)
   (with-accessors ((tool-bar       tool-bar)
                    (toc-frame      toc-frame)
@@ -1605,7 +1643,8 @@ local file paths."
                      (bookmark-button      bookmark-button)
                      (tour-button          tour-button)
                      (subscribe-button     subscribe-button)
-                     (inline-images-button inline-images-button)) tool-bar
+                     (inline-images-button inline-images-button)
+                     (toc-button           toc-button)) tool-bar
       (let ((entry-autocomplete (gui-mw:autocomplete-entry-widget iri-entry))
             (toc-listbox        (gui:listbox (toc-listbox toc-frame))))
         (gui:bind entry-autocomplete
@@ -1630,7 +1669,8 @@ local file paths."
         (setf (gui:command bookmark-button)      (toggle-bookmark-iri-clsr main-window))
         (setf (gui:command tour-button)          (tour-visit-next-iri-clsr main-window))
         (setf (gui:command subscribe-button)     (toggle-subscribtion-iri-clsr main-window))
-        (setf (gui:command inline-images-button) (inline-all-images-clsr main-window))))))
+        (setf (gui:command inline-images-button) (inline-all-images-clsr main-window))
+        (setf (gui:command toc-button)           (open-index-gempub-clsr main-window))))))
 
 (defmethod initialize-instance :after ((object tool-bar) &key &allow-other-keys)
   (with-accessors ((iri-entry            iri-entry)
@@ -1642,7 +1682,8 @@ local file paths."
                    (bookmark-button      bookmark-button)
                    (tour-button          tour-button)
                    (subscribe-button     subscribe-button)
-                   (inline-images-button inline-images-button)) object
+                   (inline-images-button inline-images-button)
+                   (toc-button           toc-button)) object
     (gui:configure object :relief :raised)
     (setf iri-entry (make-instance 'gui-mw:autocomplete-entry
                                    :master                object
@@ -1652,6 +1693,9 @@ local file paths."
     (setf go-button          (make-instance 'gui:button :master object :image icons:*open-iri*))
     (setf up-button          (make-instance 'gui:button :master object :image icons:*up*))
     (setf certificate-button (make-instance 'gui:button :master object :image icons:*profile-disabled*))
+    (setf toc-button         (make-instance 'gui:button
+                                            :master object
+                                            :image icons:*toc-disabled*))
     (setf bookmark-button    (make-instance 'gui:button :master object))
     (setf tour-button        (make-instance 'gui:button :master object :image icons:*bus-go*))
     (setf subscribe-button   (make-instance 'gui:button
@@ -1668,16 +1712,17 @@ local file paths."
                                  (tour-button          (_ "go to the next link in tour"))
                                  (subscribe-button     (_ "subscribe/unsubscribe to this gemlog"))
                                  (inline-images-button (_ "inline images")))
-    (gui:grid back-button          0 0 :sticky :nsw)
-    (gui:grid reload-button        0 1 :sticky :nsw)
-    (gui:grid up-button            0 2 :sticky :nsw)
-    (gui:grid certificate-button   0 3 :sticky :nsw)
-    (gui:grid iri-entry            0 4 :sticky :nswe :padx +minimum-padding+)
-    (gui:grid go-button            0 5 :sticky :nsw)
-    (gui:grid bookmark-button      0 6 :sticky :nsw)
-    (gui:grid subscribe-button     0 7 :sticky :nsw)
-    (gui:grid tour-button          0 8 :sticky :nsw)
-    (gui:grid inline-images-button 0 9 :sticky :nsw)
+    (gui:grid back-button          0  0 :sticky :nsw)
+    (gui:grid reload-button        0  1 :sticky :nsw)
+    (gui:grid up-button            0  2 :sticky :nsw)
+    (gui:grid certificate-button   0  3 :sticky :nsw)
+    (gui:grid iri-entry            0  4 :sticky :nswe :padx +minimum-padding+)
+    (gui:grid go-button            0  5 :sticky :nsw)
+    (gui:grid bookmark-button      0  6 :sticky :nsw)
+    (gui:grid subscribe-button     0  7 :sticky :nsw)
+    (gui:grid tour-button          0  8 :sticky :nsw)
+    (gui:grid inline-images-button 0  9 :sticky :nsw)
+    (gui:grid toc-button           0 10 :sticky :nsw)
     (gui:grid-columnconfigure object 4 :weight 2)
     object))
 
@@ -1726,9 +1771,13 @@ local file paths."
   main-window)
 
 (defclass main-frame (gui:frame)
-  ((gemtext-widget
+  ((gempub-metadata
     :initform nil
-    :initarg :gemtext-widget
+    :initarg  :gempub-metadata
+    :accessor gempub-metadata)
+   (gemtext-widget
+    :initform nil
+    :initarg  :gemtext-widget
     :accessor gemtext-widget)
    (gemtext-font-scaling
     :initform 1.0
@@ -2142,3 +2191,14 @@ local file paths."
 
 (defun hide-autocomplete-candidates (main-window)
   (gui-mw:hide-candidates (iri-entry (tool-bar main-window))))
+
+(defun gempub-mode-p (main-window)
+  (gempub-metadata main-window))
+
+(defun unset-gempub-mode (main-window)
+  (setf (gempub-metadata main-window) nil)
+  (set-toc-button-inactive main-window))
+
+(defun set-gempub-mode (main-window metadata)
+  (setf (gempub-metadata main-window) metadata)
+  (set-toc-button-active main-window))

src/package.lisp

@@ -3536,7 +3536,9 @@
    :*inline-images*
    :*text*
    :*profile*
-   :*profile-disabled*))
+   :*profile-disabled*
+   :*toc*
+   :*toc-disabled*))
 
 (defpackage :validation
   (:use
@@ -3835,7 +3837,11 @@
    :make-internal-iri
    :internal-iri-bookmark
    :show-bookmarks-page
-   :hide-autocomplete-candidates))
+   :hide-autocomplete-candidates
+   :gempub-metadata
+   :gempub-mode-p
+   :unset-gempub-mode
+   :set-gempub-mode))
 
 (defpackage :main
   (:use