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*
color-regexp = "\*[^*]+\*" #ffff00 bold
color-regexp = "\*[^[:space:]*]+\*" #ffff00 bold
# _underline_
color-regexp = "_[^_]+_" #ffff00 underline
# color-regexp = "_[^_]+_" #ffff00 underline
# /italic/

278
src/gemini-viewer.lisp
View File

@ -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))

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

@ -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))

1
src/package.lisp
View File

@ -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

3
src/ui-goodies.lisp
View File

@ -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: ")))