From 0cfdb8844ee6e0cd6339460a0b4d7ab88ebf9f7f Mon Sep 17 00:00:00 2001 From: cage Date: Sat, 12 Sep 2020 10:23:26 +0200 Subject: [PATCH] - [gemini] ensure just a single gemini file is in rendering state at the same time; - [gemini] add a newline to data before parsing a gemini file only when needed (thre is no one at the end); - commented and improved some regular expressions for coloring. --- etc/shared.conf | 4 +- src/gemini-viewer.lisp | 278 ++++++++++++++++++---------------- src/gemini/gemini-parser.lisp | 9 +- src/package.lisp | 1 + src/ui-goodies.lisp | 3 +- 5 files changed, 159 insertions(+), 136 deletions(-) diff --git a/etc/shared.conf b/etc/shared.conf index 7274016..47386c6 100644 --- a/etc/shared.conf +++ b/etc/shared.conf @@ -84,11 +84,11 @@ color-regexp = "-?[0-9]+(.[0-9]+)?%" #ff00ff bold # *bold* -color-regexp = "\*[^*]+\*" #ffff00 bold +color-regexp = "\*[^[:space:]*]+\*" #ffff00 bold # _underline_ -color-regexp = "_[^_]+_" #ffff00 underline +# color-regexp = "_[^_]+_" #ffff00 underline # /italic/ diff --git a/src/gemini-viewer.lisp b/src/gemini-viewer.lisp index d70ef84..13529a3 100644 --- a/src/gemini-viewer.lisp +++ b/src/gemini-viewer.lisp @@ -17,6 +17,8 @@ (in-package :gemini-viewer) +(defparameter *gemini-db-streams-lock* (bt:make-recursive-lock)) + (define-constant +read-buffer-size+ 1024 :documentation "Chunk's size of the buffer when reading non gemini contents from stream") @@ -41,12 +43,21 @@ (defun find-db-stream-url (url) (find-db-stream-if (lambda (a) (string= (download-uri a) url)))) +(defun ensure-just-one-stream-rendering () + (with-lock (*gemini-db-streams-lock*) + (when-let ((current-rendering (find-db-stream-if (lambda (a) + (eq (stream-status a) + :rendering))))) + (setf (stream-status current-rendering) :streaming)))) + (defun db-entry-to-foreground (uri) (when-let* ((stream-object (find-db-stream-url uri))) (with-accessors ((support-file support-file) (meta meta)) stream-object (if (gemini-client:mime-gemini-p meta) - (setf (stream-status stream-object) :rendering) + (progn + (ensure-just-one-stream-rendering) + (setf (stream-status stream-object) :rendering)) (os-utils:xdg-open support-file))))) (defclass gemini-stream () @@ -338,7 +349,7 @@ (%fill-buffer))))))) (%fill-buffer)))))) -(defun request (url &key (enqueue nil)) +(defun request (url &key (enqueue nil) (do-nothing-if-exists-in-db t)) (let ((parsed-uri (quri:uri url))) (maybe-initialize-metadata specials:*message-window*) (if (null parsed-uri) @@ -350,135 +361,142 @@ (query (quri:uri-query parsed-uri)) (port (or (quri:uri-port parsed-uri) gemini-client:+gemini-default-port+))) - (handler-case - (labels ((gemini-file-stream-p (meta) - (gemini-client:mime-gemini-p meta)) - (starting-status (meta) - (if (gemini-file-stream-p meta) - (if enqueue - nil - :rendering) - (if enqueue - nil - :running))) - (get-user-input (hide-input host prompt) - (flet ((on-input-complete (input) - (when (string-not-empty-p input) + (when (not (and do-nothing-if-exists-in-db + (find-db-stream-url (gemini-parser:make-gemini-uri host + path + query + port)))) + (when (null enqueue) + (ensure-just-one-stream-rendering)) + (handler-case + (labels ((gemini-file-stream-p (meta) + (gemini-client:mime-gemini-p meta)) + (starting-status (meta) + (if (gemini-file-stream-p meta) + (if enqueue + :streaming + :rendering) + (if enqueue + :streaming + :running))) + (get-user-input (hide-input host prompt) + (flet ((on-input-complete (input) + (when (string-not-empty-p input) + (db-utils:with-ready-database (:connect nil) + (request (gemini-parser:make-gemini-uri host + path + input + port)))))) + (ui:ask-string-input #'on-input-complete + :hide-input hide-input + :prompt (format nil + (_ "Server ~s asks: ~s ") + host + prompt))))) + (multiple-value-bind (status code-description meta response socket) + (gemini-client:request host + path + :query query + :port port) + (add-url-to-history specials:*message-window* url) + (cond + ((gemini-client:response-redirect-p status) + (flet ((on-input-complete (maybe-accepted) + (when (ui::boolean-input-accepted-p maybe-accepted) + (let ((new-url (gemini-parser:absolutize-link meta + (quri:uri-host parsed-uri) + (quri:uri-port parsed-uri) + (quri:uri-path parsed-uri)))) (db-utils:with-ready-database (:connect nil) - (request (gemini-parser:make-gemini-uri host - path - input - port)))))) - (ui:ask-string-input #'on-input-complete - :hide-input hide-input - :prompt (format nil - (_ "Server ~s asks: ~s ") - host - prompt))))) - (multiple-value-bind (status code-description meta response socket) - (gemini-client:request host - path - :query query - :port port) - (add-url-to-history specials:*message-window* url) - (cond - ((gemini-client:response-redirect-p status) - (flet ((on-input-complete (maybe-accepted) - (when (ui::boolean-input-accepted-p maybe-accepted) - (let ((new-url (gemini-parser:absolutize-link meta - (quri:uri-host parsed-uri) - (quri:uri-port parsed-uri) - (quri:uri-path parsed-uri)))) - (db-utils:with-ready-database (:connect nil) - (request new-url)))))) - (ui:ask-string-input #'on-input-complete - :priority program-events:+minimum-event-priority+ - :prompt - (format nil - (_ "Redirects to ~s, follows redirect? [y/N] ") - meta)))) - ((gemini-client:response-input-p status) - (get-user-input nil host meta)) - ((gemini-client:response-sensitive-input-p status) - (get-user-input t host meta)) - ((streamp response) - (if (gemini-file-stream-p meta) - (let* ((starting-status (starting-status meta)) - (gemini-stream (make-instance 'gemini-file-stream - :host host - :port port - :path path - :meta meta - :status-code status - :status-code-description - code-description - :stream-status starting-status - :download-stream response - :download-socket socket)) - (thread-fn - (request-stream-gemini-document-thread gemini-stream - host - port - path - query)) - (enqueue-event (make-instance 'program-events:gemini-enqueue-download-event - :payload gemini-stream))) - (program-events:push-event enqueue-event) - (downloading-start-thread gemini-stream - thread-fn - host - port - path - query)) - (let* ((starting-status (starting-status meta)) - (gemini-stream (make-instance 'gemini-others-data-stream - :stream-status starting-status - :download-stream response - :download-socket socket)) - (thread-fn - (request-stream-other-document-thread gemini-stream - socket - host - port - path - query - status - code-description - meta)) - (enqueue-event (make-instance 'program-events:gemini-enqueue-download-event - :payload gemini-stream))) - (program-events:push-event enqueue-event) - (downloading-start-thread gemini-stream - thread-fn - host - port - path - query))))))) - (gemini-client:gemini-tofu-error (e) - (let ((host (gemini-client:host e))) - (flet ((on-input-complete (maybe-accepted) - (when (ui::boolean-input-accepted-p maybe-accepted) - (db-utils:with-ready-database (:connect nil) - (db:tofu-delete host) - (request url))))) - (ui:ask-string-input #'on-input-complete - :prompt - (format nil - (_ "Host ~s signature changed! This is a potential security risk! Ignore this warning? [y/N] ") - host))))) - (conditions:not-implemented-error (e) - (ui:notify (format nil (_ "Error: ~a") e) - :as-error t)) - (gemini-client:gemini-protocol-error (e) - (ui:notify (format nil "~a" e) - :as-error t)) - #-debug-mode - (error (e) - (ui:notify (format nil - (_ "Error getting ~s: ~a") - url - e) - :as-error t))))))) + (request new-url)))))) + (ui:ask-string-input #'on-input-complete + :priority program-events:+minimum-event-priority+ + :prompt + (format nil + (_ "Redirects to ~s, follows redirect? [y/N] ") + meta)))) + ((gemini-client:response-input-p status) + (get-user-input nil host meta)) + ((gemini-client:response-sensitive-input-p status) + (get-user-input t host meta)) + ((streamp response) + (if (gemini-file-stream-p meta) + (let* ((starting-status (starting-status meta)) + (gemini-stream (make-instance 'gemini-file-stream + :host host + :port port + :path path + :meta meta + :status-code status + :status-code-description + code-description + :stream-status starting-status + :download-stream response + :download-socket socket)) + (thread-fn + (request-stream-gemini-document-thread gemini-stream + host + port + path + query)) + (enqueue-event (make-instance 'program-events:gemini-enqueue-download-event + :payload gemini-stream))) + (program-events:push-event enqueue-event) + (downloading-start-thread gemini-stream + thread-fn + host + port + path + query)) + (let* ((starting-status (starting-status meta)) + (gemini-stream (make-instance 'gemini-others-data-stream + :stream-status starting-status + :download-stream response + :download-socket socket)) + (thread-fn + (request-stream-other-document-thread gemini-stream + socket + host + port + path + query + status + code-description + meta)) + (enqueue-event (make-instance 'program-events:gemini-enqueue-download-event + :payload gemini-stream))) + (program-events:push-event enqueue-event) + (downloading-start-thread gemini-stream + thread-fn + host + port + path + query))))))) + (gemini-client:gemini-tofu-error (e) + (let ((host (gemini-client:host e))) + (flet ((on-input-complete (maybe-accepted) + (when (ui::boolean-input-accepted-p maybe-accepted) + (db-utils:with-ready-database (:connect nil) + (db:tofu-delete host) + (request url))))) + (ui:ask-string-input #'on-input-complete + :prompt + (format nil + (_ "Host ~s signature changed! This is a potential security risk! Ignore this warning? [y/N] ") + host))))) + (conditions:not-implemented-error (e) + (ui:notify (format nil (_ "Error: ~a") e) + :as-error t)) + (gemini-client:gemini-protocol-error (e) + (ui:notify (format nil "~a" e) + :as-error t)) + #-debug-mode + (error (e) + (ui:notify (format nil + (_ "Error getting ~s: ~a") + url + e) + :as-error t)))))))) (defun history-back (window) (when-let* ((metadata (message-window:metadata window)) diff --git a/src/gemini/gemini-parser.lisp b/src/gemini/gemini-parser.lisp index 3caceaa..74da8a8 100644 --- a/src/gemini/gemini-parser.lisp +++ b/src/gemini/gemini-parser.lisp @@ -378,9 +378,12 @@ (write-string (linkify link-value link-value) stream))))))))) (defun parse-gemini-file (data) - (let ((was-raw-mode *raw-mode*) - (parsed (parse 'gemini-file (strcat data (string #\Newline)) - :junk-allowed t))) + (let* ((was-raw-mode *raw-mode*) + (actual-data (if (and (string-not-empty-p data) + (char/= (last-elt data) #\Newline)) + (strcat data (string #\Newline)) + data)) + (parsed (parse 'gemini-file actual-data :junk-allowed t))) (if was-raw-mode (if *raw-mode* (list (html-utils:make-tag-node :as-is nil data)) diff --git a/src/package.lisp b/src/package.lisp index e7becae..e5d5646 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -2002,6 +2002,7 @@ :remove-db-stream :find-db-stream-if :find-db-stream-url + :ensure-just-one-stream-rendering :db-entry-to-foreground :gemini-metadata-p :make-gemini-metadata diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp index 3f38d49..ae472a5 100644 --- a/src/ui-goodies.lisp +++ b/src/ui-goodies.lisp @@ -1549,7 +1549,8 @@ mot recent updated to least recent" (flet ((on-input-complete (url) (if (gemini-parser:gemini-uri-p url) (let* ((event (make-instance 'gemini-request-event - :url url))) + :priority program-events:+maximum-event-priority+ + :url url))) (program-events:push-event event)) (error-message (_ "This is not a valid gemini address"))))) (let ((prompt (_ "Open Gemini url: ")))