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

- [gemini] fixed bugs that prevented the same IRI to be opened multiple-time.

This commit is contained in:
cage 2020-12-17 13:12:16 +01:00
parent 2679d83457
commit bafa0c596b
3 changed files with 58 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
src/gemini-viewer.lisp
View File

@ -57,6 +57,12 @@
:rendering))))) :rendering)))))
(setf (stream-status current-rendering) :streaming)))) (setf (stream-status current-rendering) :streaming))))
(defun force-rendering-of-cached-file (stream-object)
;; this is more than a mere setter
;; and is 'eql' specialized on rendering
;; it will force displaying of gemini cached file on the screen
(setf (stream-status stream-object) :rendering))
(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)
@ -64,7 +70,8 @@
(if (gemini-client:mime-gemini-p meta) (if (gemini-client:mime-gemini-p meta)
(progn (progn
(ensure-just-one-stream-rendering) (ensure-just-one-stream-rendering)
(setf (stream-status stream-object) :rendering)) (force-rendering-of-cached-file stream-object)
(setf (stream-status stream-object) :completed))
(os-utils:xdg-open support-file))))) (os-utils:xdg-open support-file)))))
(defclass gemini-stream () (defclass gemini-stream ()
@ -360,26 +367,52 @@
(%fill-buffer))))))) (%fill-buffer)))))))
(%fill-buffer)))))) (%fill-buffer))))))
(defun displace-iri (iri)
(let* ((host (uri:host iri))
(path (uri:path iri))
(query (uri:query iri))
(port (or (uri:port iri)
gemini-client:+gemini-default-port+))
(actual-iri (gemini-parser:make-gemini-uri host
path
query
port)))
(values actual-iri
host
path
query
port)))
(defun request (url &key (defun request (url &key
(enqueue nil) (enqueue nil)
(certificate nil) (certificate nil)
(certificate-key nil) (certificate-key nil)
(use-cached-file-if-exists nil)
(do-nothing-if-exists-in-db t)) (do-nothing-if-exists-in-db t))
(let ((parsed-uri (ignore-errors (iri:iri-parse url)))) (let ((parsed-uri (ignore-errors (iri:iri-parse url))))
(maybe-initialize-metadata specials:*message-window*) (maybe-initialize-metadata specials:*message-window*)
(if (null parsed-uri) (cond
((null parsed-uri)
(ui:error-message (format nil (ui:error-message (format nil
(_ "Could not understand the address ~s") (_ "Could not understand the address ~s")
url)) url)))
(let* ((host (uri:host parsed-uri)) (use-cached-file-if-exists
(path (uri:path parsed-uri)) (multiple-value-bind (actual-iri host path query port)
(query (uri:query parsed-uri)) (displace-iri parsed-uri)
(port (or (uri:port parsed-uri) (if (find-db-stream-url actual-iri)
gemini-client:+gemini-default-port+)) (gemini-viewer:db-entry-to-foreground actual-iri)
(actual-uri (gemini-parser:make-gemini-uri host (request (gemini-parser:make-gemini-uri host
path path
query query
port))) port)
:certificate-key certificate-key
:certificate certificate
:use-cached-file-if-exists nil
:do-nothing-if-exists-in-db
do-nothing-if-exists-in-db))))
(t
(multiple-value-bind (actual-uri host path query port)
(displace-iri parsed-uri)
(when (not (and do-nothing-if-exists-in-db (when (not (and do-nothing-if-exists-in-db
(find-db-stream-url actual-uri))) (find-db-stream-url actual-uri)))
(when (null enqueue) (when (null enqueue)
@ -543,7 +576,7 @@
(_ "Error getting ~s: ~a") (_ "Error getting ~s: ~a")
url url
e) e)
:as-error t)))))))) :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))

11
src/program-events.lisp
View File

@ -945,12 +945,17 @@
((url ((url
:initform nil :initform nil
:initarg :url :initarg :url
:accessor url))) :accessor url)
(use-cached-file-if-exists
:initform nil
:initarg :use-cached-file-if-exists
:accessor use-cached-file-if-exists)))
(defmethod process-event ((object gemini-request-event)) (defmethod process-event ((object gemini-request-event))
(with-accessors ((url url)) object (with-accessors ((url url)
(use-cached-file-if-exists use-cached-file-if-exists)) object
(ui:focus-to-message-window) (ui:focus-to-message-window)
(gemini-viewer:request url))) (gemini-viewer:request url :use-cached-file-if-exists use-cached-file-if-exists)))
(defclass gemini-back-event (program-event) ()) (defclass gemini-back-event (program-event) ())

6
src/ui-goodies.lisp
View File

@ -1695,8 +1695,10 @@ 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
:priority program-events:+maximum-event-priority+ :priority
:url url))) program-events:+maximum-event-priority+
:use-cached-file-if-exists t
: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: ")))