cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- [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.
This commit is contained in:
cage 2020-09-12 10:23:26 +02:00
parent f6744dad4a
commit 0cfdb8844e
5 changed files with 159 additions and 136 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
etc/shared.conf
View File

@ -84,11 +84,11 @@ color-regexp = "-?[0-9]+(.[0-9]+)?%" #ff00ff bold
# *bold* # *bold*
color-regexp = "\*[^*]+\*" #ffff00 bold color-regexp = "\*[^[:space:]*]+\*" #ffff00 bold
# _underline_ # _underline_
color-regexp = "_[^_]+_" #ffff00 underline # color-regexp = "_[^_]+_" #ffff00 underline
# /italic/ # /italic/

278
src/gemini-viewer.lisp
View File

@ -17,6 +17,8 @@
(in-package :gemini-viewer) (in-package :gemini-viewer)
(defparameter *gemini-db-streams-lock* (bt:make-recursive-lock))
(define-constant +read-buffer-size+ 1024 (define-constant +read-buffer-size+ 1024
: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")
@ -41,12 +43,21 @@
(defun find-db-stream-url (url) (defun find-db-stream-url (url)
(find-db-stream-if (lambda (a) (string= (download-uri a) 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) (defun db-entry-to-foreground (uri)
(when-let* ((stream-object (find-db-stream-url uri))) (when-let* ((stream-object (find-db-stream-url uri)))
(with-accessors ((support-file support-file) (with-accessors ((support-file support-file)
(meta meta)) stream-object (meta meta)) stream-object
(if (gemini-client:mime-gemini-p meta) (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))))) (os-utils:xdg-open support-file)))))
(defclass gemini-stream () (defclass gemini-stream ()
@ -338,7 +349,7 @@
(%fill-buffer))))))) (%fill-buffer)))))))
(%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))) (let ((parsed-uri (quri:uri url)))
(maybe-initialize-metadata specials:*message-window*) (maybe-initialize-metadata specials:*message-window*)
(if (null parsed-uri) (if (null parsed-uri)
@ -350,135 +361,142 @@
(query (quri:uri-query parsed-uri)) (query (quri:uri-query parsed-uri))
(port (or (quri:uri-port parsed-uri) (port (or (quri:uri-port parsed-uri)
gemini-client:+gemini-default-port+))) gemini-client:+gemini-default-port+)))
(handler-case (when (not (and do-nothing-if-exists-in-db
(labels ((gemini-file-stream-p (meta) (find-db-stream-url (gemini-parser:make-gemini-uri host
(gemini-client:mime-gemini-p meta)) path
(starting-status (meta) query
(if (gemini-file-stream-p meta) port))))
(if enqueue (when (null enqueue)
nil (ensure-just-one-stream-rendering))
:rendering) (handler-case
(if enqueue (labels ((gemini-file-stream-p (meta)
nil (gemini-client:mime-gemini-p meta))
:running))) (starting-status (meta)
(get-user-input (hide-input host prompt) (if (gemini-file-stream-p meta)
(flet ((on-input-complete (input) (if enqueue
(when (string-not-empty-p input) :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) (db-utils:with-ready-database (:connect nil)
(request (gemini-parser:make-gemini-uri host (request new-url))))))
path (ui:ask-string-input #'on-input-complete
input :priority program-events:+minimum-event-priority+
port)))))) :prompt
(ui:ask-string-input #'on-input-complete (format nil
:hide-input hide-input (_ "Redirects to ~s, follows redirect? [y/N] ")
:prompt (format nil meta))))
(_ "Server ~s asks: ~s ") ((gemini-client:response-input-p status)
host (get-user-input nil host meta))
prompt))))) ((gemini-client:response-sensitive-input-p status)
(multiple-value-bind (status code-description meta response socket) (get-user-input t host meta))
(gemini-client:request host ((streamp response)
path (if (gemini-file-stream-p meta)
:query query (let* ((starting-status (starting-status meta))
:port port) (gemini-stream (make-instance 'gemini-file-stream
(add-url-to-history specials:*message-window* url) :host host
(cond :port port
((gemini-client:response-redirect-p status) :path path
(flet ((on-input-complete (maybe-accepted) :meta meta
(when (ui::boolean-input-accepted-p maybe-accepted) :status-code status
(let ((new-url (gemini-parser:absolutize-link meta :status-code-description
(quri:uri-host parsed-uri) code-description
(quri:uri-port parsed-uri) :stream-status starting-status
(quri:uri-path parsed-uri)))) :download-stream response
(db-utils:with-ready-database (:connect nil) :download-socket socket))
(request new-url)))))) (thread-fn
(ui:ask-string-input #'on-input-complete (request-stream-gemini-document-thread gemini-stream
:priority program-events:+minimum-event-priority+ host
:prompt port
(format nil path
(_ "Redirects to ~s, follows redirect? [y/N] ") query))
meta)))) (enqueue-event (make-instance 'program-events:gemini-enqueue-download-event
((gemini-client:response-input-p status) :payload gemini-stream)))
(get-user-input nil host meta)) (program-events:push-event enqueue-event)
((gemini-client:response-sensitive-input-p status) (downloading-start-thread gemini-stream
(get-user-input t host meta)) thread-fn
((streamp response) host
(if (gemini-file-stream-p meta) port
(let* ((starting-status (starting-status meta)) path
(gemini-stream (make-instance 'gemini-file-stream query))
:host host (let* ((starting-status (starting-status meta))
:port port (gemini-stream (make-instance 'gemini-others-data-stream
:path path :stream-status starting-status
:meta meta :download-stream response
:status-code status :download-socket socket))
:status-code-description (thread-fn
code-description (request-stream-other-document-thread gemini-stream
:stream-status starting-status socket
:download-stream response host
:download-socket socket)) port
(thread-fn path
(request-stream-gemini-document-thread gemini-stream query
host status
port code-description
path meta))
query)) (enqueue-event (make-instance 'program-events:gemini-enqueue-download-event
(enqueue-event (make-instance 'program-events:gemini-enqueue-download-event :payload gemini-stream)))
:payload gemini-stream))) (program-events:push-event enqueue-event)
(program-events:push-event enqueue-event) (downloading-start-thread gemini-stream
(downloading-start-thread gemini-stream thread-fn
thread-fn host
host port
port path
path query)))))))
query)) (gemini-client:gemini-tofu-error (e)
(let* ((starting-status (starting-status meta)) (let ((host (gemini-client:host e)))
(gemini-stream (make-instance 'gemini-others-data-stream (flet ((on-input-complete (maybe-accepted)
:stream-status starting-status (when (ui::boolean-input-accepted-p maybe-accepted)
:download-stream response (db-utils:with-ready-database (:connect nil)
:download-socket socket)) (db:tofu-delete host)
(thread-fn (request url)))))
(request-stream-other-document-thread gemini-stream (ui:ask-string-input #'on-input-complete
socket :prompt
host (format nil
port (_ "Host ~s signature changed! This is a potential security risk! Ignore this warning? [y/N] ")
path host)))))
query (conditions:not-implemented-error (e)
status (ui:notify (format nil (_ "Error: ~a") e)
code-description :as-error t))
meta)) (gemini-client:gemini-protocol-error (e)
(enqueue-event (make-instance 'program-events:gemini-enqueue-download-event (ui:notify (format nil "~a" e)
:payload gemini-stream))) :as-error t))
(program-events:push-event enqueue-event) #-debug-mode
(downloading-start-thread gemini-stream (error (e)
thread-fn (ui:notify (format nil
host (_ "Error getting ~s: ~a")
port url
path e)
query))))))) :as-error t))))))))
(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) (defun history-back (window)
(when-let* ((metadata (message-window:metadata window)) (when-let* ((metadata (message-window:metadata window))

9
src/gemini/gemini-parser.lisp
View File

@ -378,9 +378,12 @@
(write-string (linkify link-value link-value) stream))))))))) (write-string (linkify link-value link-value) stream)))))))))
(defun parse-gemini-file (data) (defun parse-gemini-file (data)
(let ((was-raw-mode *raw-mode*) (let* ((was-raw-mode *raw-mode*)
(parsed (parse 'gemini-file (strcat data (string #\Newline)) (actual-data (if (and (string-not-empty-p data)
:junk-allowed t))) (char/= (last-elt data) #\Newline))
(strcat data (string #\Newline))
data))
(parsed (parse 'gemini-file actual-data :junk-allowed t)))
(if was-raw-mode (if was-raw-mode
(if *raw-mode* (if *raw-mode*
(list (html-utils:make-tag-node :as-is nil data)) (list (html-utils:make-tag-node :as-is nil data))

1
src/package.lisp
View File

@ -2002,6 +2002,7 @@
:remove-db-stream :remove-db-stream
:find-db-stream-if :find-db-stream-if
:find-db-stream-url :find-db-stream-url
:ensure-just-one-stream-rendering
:db-entry-to-foreground :db-entry-to-foreground
:gemini-metadata-p :gemini-metadata-p
:make-gemini-metadata :make-gemini-metadata

3
src/ui-goodies.lisp
View File

@ -1549,7 +1549,8 @@ mot recent updated to least recent"
(flet ((on-input-complete (url) (flet ((on-input-complete (url)
(if (gemini-parser:gemini-uri-p url) (if (gemini-parser:gemini-uri-p url)
(let* ((event (make-instance 'gemini-request-event (let* ((event (make-instance 'gemini-request-event
:url url))) :priority program-events:+maximum-event-priority+
:url url)))
(program-events:push-event event)) (program-events:push-event event))
(error-message (_ "This is not a valid gemini address"))))) (error-message (_ "This is not a valid gemini address")))))
(let ((prompt (_ "Open Gemini url: "))) (let ((prompt (_ "Open Gemini url: ")))