- added a command to clear the cache;

- fixed 'cat-parent-dir'.

etc/init.lisp

@@ -145,6 +145,8 @@
 
 (define-key "C-a"       #'show-about-window)
 
+(define-key "C d"       #'clear-cache)
+
 (define-key "?"         #'print-quick-help)
 
 (define-key "C-h h"     #'print-quick-help)

src/db-utils.lisp

@@ -325,7 +325,7 @@ example
                 for value in values append
                   (list name value)))))
 
-(defmacro make-delete (table-name where-clause)
+(defmacro make-delete (table-name &optional (where-clause nil))
   "Generate an sxql delete statement
 
 example
@@ -334,8 +334,10 @@ example
              (:and (:= col-a 1)
                    (:= col-b 2)))
 "
-  `(delete-from ,table-name
-     (where ,where-clause)))
+  (if where-clause
+      `(delete-from ,table-name
+         (where ,where-clause))
+      `(delete-from ,table-name)))
 
 (defmacro make-update (table-name names values where-clause)
  "Generate an sxql update statement

src/db.lisp

@@ -2995,6 +2995,9 @@ than `days-in-the-past' days (default: `(swconf:config-purge-cache-days-offset)'
          (local-time:timestamp< access-time
                                 offset)))))
 
+(defun cache-delete-all ()
+  (query (make-delete +table-cache+)))
+
 (defun tofu-passes-p (host hash)
   (let ((known-host (fetch-single (select :*
                                     (from +table-gemini-tofu-cert+)

src/filesystem-utils.lisp

@@ -120,24 +120,31 @@
   (text-utils:strcat file "." extension))
 
 (defun cat-parent-dir (parent direntry)
-  (cond
-    ((or (backreference-dir-p direntry)
-         (loopback-reference-dir-p direntry))
-     (format nil "~a~a" parent direntry))
-    ((string= (string (alexandria:last-elt parent)) *directory-sep*)
-     (format nil "~a~a" parent direntry))
-    (t
-      (format nil "~a~a~a" parent *directory-sep* direntry))))
+  (labels ((cat (&rest args)
+             (reduce (lambda (a b) (concatenate 'string a b)) args))
+           (delete-slash  (a)
+             (cl-ppcre:regex-replace (cat "^" *directory-sep*) a "")))
+    (let* ((slashed-parent    (if (cl-ppcre:scan (cat *directory-sep* "$") parent)
+                                  parent
+                                  (cat parent *directory-sep*)))
+           (sequence-slash-re (cat *directory-sep* *directory-sep* "+")))
+      (cl-ppcre:regex-replace-all sequence-slash-re
+                                  (cat slashed-parent
+                                       (delete-slash direntry))
+                                  *directory-sep*))))
 
 (defmacro do-directory ((var) root &body body)
-  (with-gensyms (dir)
+  (with-gensyms (dir dir-name new-path)
     `(let ((,dir (nix:opendir ,root)))
        (unwind-protect
             (handler-case
-                (do ((,var (cat-parent-dir ,root (nix:readdir ,dir))
-                           (cat-parent-dir ,root (nix:readdir ,dir))))
-                    ((cl-ppcre:scan "NIL$" ,var))
-                  ,@body)
+                (flet ((read-dir ()
+                         (when-let* ((,dir-name (nix:readdir ,dir))
+                                     (,new-path (cat-parent-dir ,root  ,dir-name)))
+                           ,new-path)))
+                  (do ((,var (read-dir) (read-dir)))
+                      ((not ,var) ())
+                    ,@body))
               (nix::enotdir () 0)
               (nix:eacces () 0)
               (nix:eloop () 0))

src/package.lisp

@@ -1057,6 +1057,7 @@
    :cache-get
    :cache-get-value
    :cache-expired-p
+   :cache-delete-all
    :tofu-passes-p
    :tofu-delete
    :find-tls-certificates-rows
@@ -2853,7 +2854,8 @@
    :file-explorer-node-details
    :file-explorer-edit-file
    :file-explorer-upload-mirror
-   :file-explorer-download-mirror))
+   :file-explorer-download-mirror
+   :clear-cache))
 
 (defpackage :scheduled-events
   (:use

src/ui-goodies.lisp

@@ -2997,3 +2997,27 @@ Note: existing file will be overwritten."
                         :prompt        (_ "Download in: ")
                         :initial-value local-dir
                         :complete-fn   #'complete:directory-complete))))
+
+(defun clear-cache ()
+  "Delete  permanently cached  data  (note: this  command remove  also
+gemini client certificates!)."
+  (flet ((on-input-complete (input-text)
+           (with-valid-yes-at-prompt (input-text y-pressed-p)
+             (when y-pressed-p
+               (with-enqueued-process ()
+                 (db-utils:with-ready-database (:connect t)
+                   (db:cache-delete-all)
+                   (let ((children (remove-if (lambda (a)
+                                                (or (fs:backreference-dir-p      a)
+                                                    (fs:loopback-reference-dir-p a)))
+                                              (fs:collect-children (os-utils:user-cache-dir)))))
+                     (mapcar (lambda (path)
+                               (info-message (format nil
+                                                     (_ "Deleting cache directory ~a")
+                                                     path))
+                               (with-enqueued-process ()
+                                 (tui:with-notify-errors
+                                   (fs:recursive-delete path))))
+                             children))))))))
+    (ask-string-input #'on-input-complete
+                      :prompt (format nil (_ "Delete cache? [y/N] ")))))