mirror of https://codeberg.org/cage/tinmop/
- [gemini] added support for favicon.txt
the implementation more or less follow gemini://mozz.us/files/rfc_gemini_favicon.gmi but it does render the first character of the file instead of checking for emoji characters.
This commit is contained in:
parent
c66a71881e
commit
17401274b5
|
@ -471,7 +471,7 @@ open-message-link-window.input.selected.foreground = #FFB200
|
||||||
|
|
||||||
# gemini browser
|
# gemini browser
|
||||||
|
|
||||||
gemini.current.url.prefix = "🌍 "
|
gemini.favicon = "🌍"
|
||||||
|
|
||||||
gemini.link.scheme.gemini.prefix = "→ "
|
gemini.link.scheme.gemini.prefix = "→ "
|
||||||
|
|
||||||
|
|
|
@ -312,8 +312,27 @@
|
||||||
:payload response
|
:payload response
|
||||||
:append-text append-text))))
|
:append-text append-text))))
|
||||||
|
|
||||||
|
(let ((cache ()))
|
||||||
|
(defun fetch-favicon (parsed-url)
|
||||||
|
(flet ((fetch-from-cache (key)
|
||||||
|
(assoc-value cache key :test #'string=)))
|
||||||
|
(multiple-value-bind (actual-iri host path query port fragment)
|
||||||
|
(displace-iri parsed-url)
|
||||||
|
(declare (ignore actual-iri path query fragment))
|
||||||
|
(or (fetch-from-cache host)
|
||||||
|
(ignore-errors
|
||||||
|
(let* ((favicon-url (gemini-parser:make-gemini-iri host
|
||||||
|
"/favicon.txt"
|
||||||
|
:port port))
|
||||||
|
(response-body (gemini-client:slurp-gemini-url favicon-url))
|
||||||
|
(favicon (misc:safe-subseq (babel:octets-to-string response-body :errorp t)
|
||||||
|
0 1)))
|
||||||
|
(setf cache (acons host favicon cache))
|
||||||
|
(fetch-favicon parsed-url)))
|
||||||
|
(swconf:gemini-default-favicon))))))
|
||||||
|
|
||||||
(defun request-stream-gemini-document-thread (wrapper-object host
|
(defun request-stream-gemini-document-thread (wrapper-object host
|
||||||
port path query fragment)
|
port path query fragment favicon)
|
||||||
(with-accessors ((download-socket download-socket)
|
(with-accessors ((download-socket download-socket)
|
||||||
(download-stream download-stream)
|
(download-stream download-stream)
|
||||||
(octect-count octect-count)
|
(octect-count octect-count)
|
||||||
|
@ -328,7 +347,7 @@
|
||||||
:query query
|
:query query
|
||||||
:port port
|
:port port
|
||||||
:fragment fragment))
|
:fragment fragment))
|
||||||
(url-header (format nil "-> ~a~%" url))
|
(url-header (format nil "~a ~a~2%" favicon url))
|
||||||
(parsed-url (gemini-parser:parse-gemini-file url-header))
|
(parsed-url (gemini-parser:parse-gemini-file url-header))
|
||||||
(url-response (gemini-client:make-gemini-file-response nil
|
(url-response (gemini-client:make-gemini-file-response nil
|
||||||
nil
|
nil
|
||||||
|
@ -559,13 +578,15 @@
|
||||||
:stream-status starting-status
|
:stream-status starting-status
|
||||||
:download-stream response
|
:download-stream response
|
||||||
:download-socket socket))
|
:download-socket socket))
|
||||||
|
(favicon (fetch-favicon parsed-iri))
|
||||||
(thread-fn
|
(thread-fn
|
||||||
(request-stream-gemini-document-thread gemini-stream
|
(request-stream-gemini-document-thread gemini-stream
|
||||||
host
|
host
|
||||||
port
|
port
|
||||||
path
|
path
|
||||||
query
|
query
|
||||||
fragment))
|
fragment
|
||||||
|
favicon))
|
||||||
(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)
|
||||||
|
|
|
@ -368,3 +368,32 @@
|
||||||
|
|
||||||
(defmethod build-redirect-iri (meta (iri-from string))
|
(defmethod build-redirect-iri (meta (iri-from string))
|
||||||
(build-redirect-iri meta (iri:iri-parse iri-from)))
|
(build-redirect-iri meta (iri:iri-parse iri-from)))
|
||||||
|
|
||||||
|
(define-constant +maximum-redirections+ 5 :test `=)
|
||||||
|
|
||||||
|
(defun slurp-gemini-url (url &optional (redirect-count 0))
|
||||||
|
"Read 'full' data from gemini address `url'; note that specs says
|
||||||
|
that gemini flow is streamed by default so this function has limited
|
||||||
|
use as there is a chance that it would not returns. Anyway for gemlog
|
||||||
|
subscription (for example) could be used.
|
||||||
|
|
||||||
|
TODO: Add client certificate."
|
||||||
|
(let ((iri (iri:iri-parse url)))
|
||||||
|
(multiple-value-bind (status description meta response socket)
|
||||||
|
(request (uri:host iri)
|
||||||
|
(uri:path iri)
|
||||||
|
:query (uri:query iri)
|
||||||
|
:port (uri:port iri)
|
||||||
|
:fragment (uri:fragment iri))
|
||||||
|
(declare (ignore description))
|
||||||
|
(cond
|
||||||
|
((response-success-p status)
|
||||||
|
(let ((data (misc:make-fresh-array 0 0 '(unsigned-byte 8) nil)))
|
||||||
|
(loop for new-byte = (read-byte response nil nil)
|
||||||
|
while new-byte do
|
||||||
|
(vector-push-extend new-byte data))
|
||||||
|
(close-ssl-socket socket)
|
||||||
|
data))
|
||||||
|
((and (response-redirect-p status)
|
||||||
|
(< redirect-count +maximum-redirections+))
|
||||||
|
(slurp-gemini-url (build-redirect-iri meta iri) (1+ redirect-count)))))))
|
||||||
|
|
|
@ -92,6 +92,7 @@
|
||||||
:error-code
|
:error-code
|
||||||
:error-description
|
:error-description
|
||||||
:gemini-tofu-error
|
:gemini-tofu-error
|
||||||
|
:*gemini-page-theme*
|
||||||
:make-gemini-file-response
|
:make-gemini-file-response
|
||||||
:host
|
:host
|
||||||
:response-certificate-requested-p
|
:response-certificate-requested-p
|
||||||
|
@ -117,7 +118,8 @@
|
||||||
:request
|
:request
|
||||||
:gemini-file-stream-p
|
:gemini-file-stream-p
|
||||||
:fetch-cached-certificate
|
:fetch-cached-certificate
|
||||||
:build-redirect-iri))
|
:build-redirect-iri
|
||||||
|
:slurp-gemini-url))
|
||||||
|
|
||||||
(defpackage :gemini-subscription
|
(defpackage :gemini-subscription
|
||||||
(:use
|
(:use
|
||||||
|
|
|
@ -16,35 +16,6 @@
|
||||||
|
|
||||||
(in-package :gemini-subscription)
|
(in-package :gemini-subscription)
|
||||||
|
|
||||||
(define-constant +maximum-redirections+ 5 :test `=)
|
|
||||||
|
|
||||||
(defun slurp-gemini-url (url &optional (redirect-count 0))
|
|
||||||
"Read 'full' data from gemini address `url'; note that specs says
|
|
||||||
that gemini flow is streamed by default so this function has limited
|
|
||||||
use as there is a chance that it would not returns. Anyway for gemlog
|
|
||||||
subscription (for example) could be used.
|
|
||||||
|
|
||||||
TODO: Add client certificate."
|
|
||||||
(let ((iri (iri:iri-parse url)))
|
|
||||||
(multiple-value-bind (status description meta response socket)
|
|
||||||
(gemini-client:request (uri:host iri)
|
|
||||||
(uri:path iri)
|
|
||||||
:query (uri:query iri)
|
|
||||||
:port (uri:port iri)
|
|
||||||
:fragment (uri:fragment iri))
|
|
||||||
(declare (ignore description))
|
|
||||||
(cond
|
|
||||||
((response-success-p status)
|
|
||||||
(let ((data (misc:make-fresh-array 0 0 '(unsigned-byte 8) nil)))
|
|
||||||
(loop for new-byte = (read-byte response nil nil)
|
|
||||||
while new-byte do
|
|
||||||
(vector-push-extend new-byte data))
|
|
||||||
(gemini-client:close-ssl-socket socket)
|
|
||||||
data))
|
|
||||||
((and (response-redirect-p status)
|
|
||||||
(< redirect-count +maximum-redirections+))
|
|
||||||
(slurp-gemini-url (gemini-client:build-redirect-iri meta iri) (1+ redirect-count)))))))
|
|
||||||
|
|
||||||
(defun link-post-timestamp (link-text)
|
(defun link-post-timestamp (link-text)
|
||||||
"Returns a local-time object parsing a gemlog entry's link text
|
"Returns a local-time object parsing a gemlog entry's link text
|
||||||
|
|
||||||
|
|
|
@ -1072,6 +1072,7 @@
|
||||||
:perform-missing-value-check
|
:perform-missing-value-check
|
||||||
:load-config-file
|
:load-config-file
|
||||||
:external-editor
|
:external-editor
|
||||||
|
:gemini-default-favicon
|
||||||
:gemini-link-prefix-to-gemini
|
:gemini-link-prefix-to-gemini
|
||||||
:gemini-link-prefix-to-other
|
:gemini-link-prefix-to-other
|
||||||
:gemini-quote-prefix
|
:gemini-quote-prefix
|
||||||
|
@ -2175,6 +2176,7 @@
|
||||||
:abort-download-stream
|
:abort-download-stream
|
||||||
:db-entry-to-foreground
|
:db-entry-to-foreground
|
||||||
:gemini-metadata-p
|
:gemini-metadata-p
|
||||||
|
:maybe-initialize-metadata
|
||||||
:make-gemini-metadata
|
:make-gemini-metadata
|
||||||
:gemini-metadata-links
|
:gemini-metadata-links
|
||||||
:gemini-metadata-source-file
|
:gemini-metadata-source-file
|
||||||
|
|
|
@ -1212,8 +1212,8 @@
|
||||||
(uri:host url)
|
(uri:host url)
|
||||||
(uri:port url)
|
(uri:port url)
|
||||||
(uri:path url)))
|
(uri:path url)))
|
||||||
(theme gemini-client::*gemini-page-theme*))
|
(theme gemini-client:*gemini-page-theme*))
|
||||||
(gemini-viewer::maybe-initialize-metadata specials:*message-window*)
|
(gemini-viewer:maybe-initialize-metadata specials:*message-window*)
|
||||||
(refresh-gemini-message-window links
|
(refresh-gemini-message-window links
|
||||||
gemini-page
|
gemini-page
|
||||||
(gemini-parser:sexp->text parsed theme)
|
(gemini-parser:sexp->text parsed theme)
|
||||||
|
|
|
@ -397,6 +397,7 @@
|
||||||
command-window
|
command-window
|
||||||
command-separator
|
command-separator
|
||||||
gemini
|
gemini
|
||||||
|
favicon
|
||||||
tree
|
tree
|
||||||
branch
|
branch
|
||||||
arrow
|
arrow
|
||||||
|
@ -475,6 +476,11 @@
|
||||||
keys)))
|
keys)))
|
||||||
value)))
|
value)))
|
||||||
|
|
||||||
|
(defun gemini-default-favicon ()
|
||||||
|
(access-non-null-conf-value *software-configuration*
|
||||||
|
+key-gemini+
|
||||||
|
+key-favicon+))
|
||||||
|
|
||||||
(defun gemini-link-prefix (scheme)
|
(defun gemini-link-prefix (scheme)
|
||||||
(access-non-null-conf-value *software-configuration*
|
(access-non-null-conf-value *software-configuration*
|
||||||
+key-gemini+
|
+key-gemini+
|
||||||
|
|
Loading…
Reference in New Issue