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,18 +362,18 @@ 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
recover-from-skipped-statuses recover-from-skipped-statuses
local local
only-media only-media
max-id max-id
since-id since-id
min-id min-id
(recover-count 0) (recover-count 0)
(limit 20)) (limit 20))
"Update a timeline, this function will fetch new messages and generate and event to "Update a timeline, this function will fetch new messages and generate and event to
update the program reflectings the changes in the timeline (saves update the program reflectings the changes in the timeline (saves
messages in the database etc.)" messages in the database etc.)"
@ -385,8 +385,9 @@ 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
(expand-status-tree node-status))) collect
(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
:payload trees :payload trees

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)