1
0
Fork 0

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

- prevented opening another connection when deleting cache;

- improved rendering of html blockquote.
This commit is contained in:
cage 2023-12-02 17:17:50 +01:00
parent 8c6c69c667
commit 8f9d83fa0e
8 changed files with 69 additions and 28 deletions

View File

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

View File

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

View File

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

View File

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

View File

@ -991,7 +991,7 @@ to the array"
;; threads ;; threads
(defmacro with-lock ((lock) &body body) (defmacro with-lock ((lock) &body body)
`(bt:with-recursive-lock-held (,lock) `(bt:with-lock-held (,lock)
,@body)) ,@body))
(defmacro defun-w-lock (name parameters lock &body body) (defmacro defun-w-lock (name parameters lock &body body)
@ -1003,6 +1003,34 @@ to the array"
(with-lock (,lock) (with-lock (,lock)
,@remaining-forms)))) ,@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 ;; http
(defun get-url-content (url) (defun get-url-content (url)

View File

@ -260,6 +260,15 @@
:binary-search :binary-search
:defun-w-lock :defun-w-lock
:with-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 :get-url-content
:with-profile-time :with-profile-time
:with-debug-print-profile-time :with-debug-print-profile-time

View File

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

View File

@ -3460,7 +3460,7 @@ gemini client certificates!)."
(with-valid-yes-at-prompt (input-text y-pressed-p) (with-valid-yes-at-prompt (input-text y-pressed-p)
(when y-pressed-p (when y-pressed-p
(with-enqueued-process () (with-enqueued-process ()
(db-utils:with-ready-database (:connect t) (db-utils:with-ready-database (:connect nil)
(db:cache-delete-all) (db:cache-delete-all)
(let ((children (remove-if (lambda (a) (let ((children (remove-if (lambda (a)
(or (fs:backreference-dir-p a) (or (fs:backreference-dir-p a)