- changed all recursive lock with the non-recursive type;

- prevented opening another connection when deleting cache;

- improved rendering of html blockquote.

src/api-client.lisp

@@ -23,7 +23,7 @@
   "An istance of 'credentials' used to holds the intormation needed to
   access a mastodon instance")
 
-(defparameter *client-lock* (bt:make-recursive-lock)
+(defparameter *client-lock* (bt:make-lock)
   "The Lock for prevent race conditions when accessing the mastodon server")
 
 (define-constant +credentials-filename+ "client"    :test #'string=
@@ -362,7 +362,7 @@ Returns nil if the user did not provided a server in the configuration file"
                                                :folder    folder)))
          (program-events:push-event add-fetched-event))))
 
-(defun-api-call update-timeline (timeline
+(defun update-timeline (timeline
                         kind
                         folder
                         &key
@@ -385,7 +385,8 @@ Returns nil if the user did not provided a server in the configuration file"
                                           :min-id     min-id
                                           :limit      limit))
          (trees             (if command-line:*update-timeline-climb-message-tree*
-                                (flatten (loop for node-status in timeline-statuses collect
+                                (flatten (loop for node-status in timeline-statuses
+                                               collect
                                                (expand-status-tree node-status)))
                                 timeline-statuses))
          (event             (make-instance 'program-events:save-timeline-in-db-event

src/gemini-viewer.lisp

@@ -17,7 +17,7 @@
 
 (in-package :gemini-viewer)
 
-(defparameter *gemini-db-streams-lock* (bt:make-recursive-lock))
+(defparameter *gemini-db-streams-lock* (bt:make-lock))
 
 (define-constant +read-buffer-size+ 2048 :test #'=
   :documentation "Chunk's size of the buffer when reading non gemini contents from stream")
@@ -107,7 +107,7 @@
 
 (defclass gemini-stream ()
   ((download-thread-lock
-    :initform (bt:make-recursive-lock "download-gemini")
+    :initform (bt:make-lock "download-gemini")
     :initarg  :download-thread-lock
     :accessor download-thread-lock)
    (download-thread-blocked

src/gemini/gemini-parser.lisp

@@ -21,7 +21,7 @@
 
 (defparameter *list-detected* nil)
 
-(defparameter *parser-lock* (bt:make-recursive-lock))
+(defparameter *parser-lock* (bt:make-lock))
 
 (defparameter *pre-group-id* -1)
 

src/html-utils.lisp

@@ -104,6 +104,8 @@
 
 (defparameter *block-tag* nil)
 
+(defparameter *quote-level* 0)
+
 (defun html->text (html &key
                           (add-link-footnotes t) (body-footnotes-separator "")
                           (quote-prefix "> ") (list-item-prefix "* "))
@@ -132,9 +134,7 @@ Some convenience functions are provided to works with these structures.
                      (when node
                        (cond
                          ((stringp node)
-                          (if *block-tag*
+                          (princ node body-stream))
-                              (princ (strcat *prefix-text-line* node) body-stream)
-                              (princ node body-stream)))
                          ((consp (car node))
                           (descend (car node)))
                          ((tag= +tag-link+ node)
@@ -161,6 +161,9 @@ Some convenience functions are provided to works with these structures.
                               (tag= +tag-div+       node))
                           (let ((*block-tag* t))
                             (format body-stream "~%")
+                            (when *block-tag*
+                              (loop for i from 0 below *quote-level* do
+                                (princ *prefix-text-line* body-stream)))
                             (descend-children node)
                             (format body-stream "~%")))
                          ((tag= +tag-list-item+ node)
@@ -170,9 +173,9 @@ Some convenience functions are provided to works with these structures.
                             (format body-stream "~%")))
                          ((tag= +tag-blockquote+ node)
                           (let ((*prefix-text-line* quote-prefix)
+                                (*quote-level* (1+ *quote-level*))
                                 (*block-tag* t))
-                            (descend-children node)
+                            (descend-children node)))
-                            (format body-stream "~%")))
                          (t
                           (descend-children node))))))
             (descend root)

src/misc-utils.lisp

@@ -991,7 +991,7 @@ to the array"
 ;; threads
 
 (defmacro with-lock ((lock) &body body)
-  `(bt:with-recursive-lock-held (,lock)
+  `(bt:with-lock-held (,lock)
      ,@body))
 
 (defmacro defun-w-lock (name parameters lock &body body)
@@ -1003,6 +1003,34 @@ to the array"
        (with-lock (,lock)
          ,@remaining-forms))))
 
+(defparameter *thread-default-special-bindings* bt:*default-special-bindings*)
+
+(definline make-thread (function &key (name nil) (initial-bindings *thread-default-special-bindings*))
+  (bt:make-thread function :name name :initial-bindings initial-bindings))
+
+(definline make-lock (&optional name)
+  (bt:make-lock name))
+
+(defmacro with-lock-held ((lock) &body body)
+  `(bt:with-lock-held (,lock)
+     ,@body))
+
+(definline make-condition-variable (&key (name nil))
+  (bt:make-condition-variable :name name))
+
+(definline condition-wait (condition-variable lock &key (timeout nil))
+  (bt:condition-wait condition-variable lock :timeout timeout))
+
+(definline condition-notify (condition-variable)
+  (bt:condition-notify condition-variable))
+
+(definline join-thread (thread)
+  (bt:join-thread thread))
+
+(definline destroy-thread (thread)
+  (bt:destroy-thread thread))
+
+
 ;; http
 
 (defun get-url-content (url)

src/package.lisp

@@ -260,6 +260,15 @@
    :binary-search
    :defun-w-lock
    :with-lock
+   :*thread-default-special-bindings*
+   :make-thread
+   :make-lock
+   :with-lock-held
+   :make-condition-variable
+   :condition-wait
+   :condition-notify
+   :join-thread
+   :destroy-thread
    :get-url-content
    :with-profile-time
    :with-debug-print-profile-time

src/program-events.lisp

@@ -23,7 +23,7 @@
 
 (define-constant +maximum-event-priority+   -2 :test #'=)
 
-(defparameter *id-lock* (bt:make-recursive-lock))
+(defparameter *id-lock* (bt:make-lock))
 
 (defparameter *event-id* 0)
 
@@ -100,7 +100,7 @@
 
 (defclass events-queue (priority-queue)
   ((lock
-    :initform (bt:make-recursive-lock)
+    :initform (bt:make-lock)
     :initarg  :lock
     :accessor lock)
    (blocking-lock
@@ -222,7 +222,7 @@
 
 (defclass event-on-own-thread (program-event)
   ((lock
-    :initform (bt:make-recursive-lock)
+    :initform (bt:make-lock)
     :initarg  :lock
     :accessor lock)
    (condition-variable

src/ui-goodies.lisp

@@ -3460,7 +3460,7 @@ gemini client certificates!)."
            (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-utils:with-ready-database (:connect nil)
                    (db:cache-delete-all)
                    (let ((children (remove-if (lambda (a)
                                                 (or (fs:backreference-dir-p      a)