diff --git a/src/api-client.lisp b/src/api-client.lisp index 1c5edef..bc17050 100644 --- a/src/api-client.lisp +++ b/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,18 +362,18 @@ 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 - kind - folder - &key - recover-from-skipped-statuses - local - only-media - max-id - since-id - min-id - (recover-count 0) - (limit 20)) +(defun update-timeline (timeline + kind + folder + &key + recover-from-skipped-statuses + local + only-media + max-id + since-id + min-id + (recover-count 0) + (limit 20)) "Update a timeline, this function will fetch new messages and generate and event to update the program reflectings the changes in the timeline (saves 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 :limit limit)) (trees (if command-line:*update-timeline-climb-message-tree* - (flatten (loop for node-status in timeline-statuses collect - (expand-status-tree node-status))) + (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 :payload trees diff --git a/src/gemini-viewer.lisp b/src/gemini-viewer.lisp index 2b557e5..b09578f 100644 --- a/src/gemini-viewer.lisp +++ b/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 diff --git a/src/gemini/gemini-parser.lisp b/src/gemini/gemini-parser.lisp index 70ccf6f..1ed6993 100644 --- a/src/gemini/gemini-parser.lisp +++ b/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) diff --git a/src/html-utils.lisp b/src/html-utils.lisp index 1daa904..c78472c 100644 --- a/src/html-utils.lisp +++ b/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 (strcat *prefix-text-line* node) body-stream) - (princ 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) - (format body-stream "~%"))) + (descend-children node))) (t (descend-children node)))))) (descend root) diff --git a/src/misc-utils.lisp b/src/misc-utils.lisp index f8586d6..8384383 100644 --- a/src/misc-utils.lisp +++ b/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) diff --git a/src/package.lisp b/src/package.lisp index 378301f..004b397 100644 --- a/src/package.lisp +++ b/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 diff --git a/src/program-events.lisp b/src/program-events.lisp index b354968..8727571 100644 --- a/src/program-events.lisp +++ b/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 diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp index f3091c2..ae7dd5d 100644 --- a/src/ui-goodies.lisp +++ b/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)