mirror of https://codeberg.org/cage/tinmop/
- [gemini] fixed bugs that prevented the same IRI to be opened multiple-time.
This commit is contained in:
parent
2679d83457
commit
bafa0c596b
|
@ -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))
|
||||||
|
|
|
@ -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) ())
|
||||||
|
|
||||||
|
|
|
@ -1695,7 +1695,9 @@ 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
|
||||||
|
program-events:+maximum-event-priority+
|
||||||
|
:use-cached-file-if-exists t
|
||||||
:url url)))
|
: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")))))
|
||||||
|
|
Loading…
Reference in New Issue