mirror of
https://codeberg.org/cage/tinmop/
synced 2024-12-16 23:08:34 +01:00
- moved to an internal wrapping of 'mkstemp' to allow extensions in filename;
- [gemini] rendering all stream with MIME type "text/*" with this program.
This commit is contained in:
parent
9a20e187e9
commit
61c39b6c62
@ -176,4 +176,6 @@ color-regexp = ":rendering" cyan
|
||||
# if you want to open some kind of file with tinmop try the following
|
||||
# valid values are "tinmop" "me" "internal"
|
||||
# ▼▼▼▼▼▼▼▼
|
||||
open "gmi$" with "tinmop"
|
||||
open "gmi$" with "tinmop"
|
||||
open "txt$" with "tinmop"
|
||||
open ".sh$" with "tinmop"
|
@ -166,7 +166,8 @@
|
||||
(nix:s-isreg (nix:stat-mode (nix:stat path))))
|
||||
|
||||
(defun dirp (path)
|
||||
(nix:s-isdir (nix:stat-mode (nix:stat path))))
|
||||
(and (nix:stat path)
|
||||
(nix:s-isdir (nix:stat-mode (nix:stat path)))))
|
||||
|
||||
(defun split-path-elements (path)
|
||||
(cl-ppcre:split *directory-sep-regexp* path))
|
||||
@ -265,20 +266,28 @@
|
||||
(text-utils:strcat home *directory-sep*)
|
||||
home)))
|
||||
|
||||
(cffi:defcfun (ffi-mkstemp "mkstemp") :int (template :pointer))
|
||||
|
||||
(defun %mkstemp (prefix suffix)
|
||||
(let ((template (text-utils:strcat prefix "XXXXXX" suffix)))
|
||||
(cffi:with-foreign-string (ptr-template template)
|
||||
(ffi-mkstemp ptr-template)
|
||||
(cffi:foreign-string-to-lisp ptr-template))))
|
||||
|
||||
(defparameter *temporary-files-created* ())
|
||||
|
||||
(defun temporary-file (&optional (temp-directory nil))
|
||||
(defun temporary-file (&key (temp-directory nil) (extension ""))
|
||||
(let ((tmpdir (or temp-directory
|
||||
(os-utils:default-temp-dir))))
|
||||
(multiple-value-bind (x filename)
|
||||
(if tmpdir
|
||||
(nix:mkstemp (format nil "~a~a~a" tmpdir *directory-sep*
|
||||
config:+program-name+))
|
||||
(nix:mkstemp (format nil "~atmp~a~a" *directory-sep* *directory-sep*
|
||||
config:+program-name+)))
|
||||
(declare (ignore x))
|
||||
(push filename *temporary-files-created*)
|
||||
filename)))
|
||||
(let ((filepath (if tmpdir
|
||||
(%mkstemp (format nil "~a~a~a" tmpdir *directory-sep*
|
||||
config:+program-name+)
|
||||
extension)
|
||||
(%mkstemp (format nil "~atmp~a~a" *directory-sep* *directory-sep*
|
||||
config:+program-name+)
|
||||
extension))))
|
||||
(push filepath *temporary-files-created*)
|
||||
filepath)))
|
||||
|
||||
(defun clean-temporary-files ()
|
||||
(dolist (temporary-file *temporary-files-created*)
|
||||
|
@ -335,53 +335,69 @@
|
||||
(swconf:gemini-default-favicon)))))))
|
||||
|
||||
(defun request-stream-gemini-document-thread (wrapper-object host
|
||||
port path query fragment favicon)
|
||||
port path query fragment favicon
|
||||
gemini-format-p)
|
||||
(with-accessors ((download-socket download-socket)
|
||||
(download-stream download-stream)
|
||||
(octect-count octect-count)
|
||||
(support-file support-file)) wrapper-object
|
||||
(flet ((maybe-render-line (line-event)
|
||||
(when (eq (stream-status wrapper-object) :rendering)
|
||||
(program-events:push-event line-event))))
|
||||
(labels ((maybe-render-line (line-event)
|
||||
(when (eq (stream-status wrapper-object) :rendering)
|
||||
(program-events:push-event line-event)))
|
||||
(maybe-render-preformat-wrapper (file-stream wrapper-object)
|
||||
(when (not gemini-format-p)
|
||||
(let* ((preformat-line (format nil "~a~%" gemini-parser:+preformatted-prefix+))
|
||||
(preformat-wrapper-event (make-gemini-download-event preformat-line
|
||||
wrapper-object
|
||||
t)))
|
||||
(maybe-render-line preformat-wrapper-event)
|
||||
(write-sequence preformat-line file-stream)))))
|
||||
(lambda ()
|
||||
(when-let ((extension (fs:get-extension path)))
|
||||
(setf support-file (fs:temporary-file :extension extension)))
|
||||
(with-open-support-file (file-stream support-file character)
|
||||
(let* ((url (gemini-parser:make-gemini-iri host
|
||||
path
|
||||
:query query
|
||||
:port port
|
||||
:fragment fragment))
|
||||
(url-header (format nil "~a ~a~2%" favicon url))
|
||||
(parsed-url (gemini-parser:parse-gemini-file url-header))
|
||||
(url-response (gemini-client:make-gemini-file-response nil
|
||||
nil
|
||||
nil
|
||||
parsed-url
|
||||
nil
|
||||
""
|
||||
nil))
|
||||
(url-event (make-instance 'program-events:gemini-got-line-event
|
||||
:wrapper-object wrapper-object
|
||||
:payload url-response
|
||||
:append-text nil)))
|
||||
(let* ((url (gemini-parser:make-gemini-iri host
|
||||
path
|
||||
:query query
|
||||
:port port
|
||||
:fragment fragment))
|
||||
(url-header (format nil "~a ~a~2%" favicon url))
|
||||
(parsed-url (gemini-parser:parse-gemini-file url-header))
|
||||
(url-response (gemini-client:make-gemini-file-response nil
|
||||
nil
|
||||
nil
|
||||
parsed-url
|
||||
nil
|
||||
""
|
||||
nil))
|
||||
(url-event (make-instance 'program-events:gemini-got-line-event
|
||||
:wrapper-object wrapper-object
|
||||
:payload url-response
|
||||
:append-text nil)))
|
||||
|
||||
(write-sequence url-header file-stream)
|
||||
(increment-bytes-count wrapper-object url-header :convert-to-octects t)
|
||||
(maybe-render-line url-event)
|
||||
(maybe-render-preformat-wrapper file-stream wrapper-object)
|
||||
(loop
|
||||
named download-loop
|
||||
for line-as-array = (read-line-into-array download-stream)
|
||||
while line-as-array do
|
||||
(gemini-client:debug-gemini "[stream] gemini file stream raw data line : ~a"
|
||||
line-as-array)
|
||||
(if (downloading-allowed-p wrapper-object)
|
||||
(let* ((line (babel:octets-to-string line-as-array :errorp nil))
|
||||
(event (make-gemini-download-event line wrapper-object t)))
|
||||
(gemini-client:debug-gemini "[stream] gemini file stream got data line : ~a"
|
||||
line)
|
||||
(write-sequence line file-stream)
|
||||
(increment-bytes-count wrapper-object line :convert-to-octects t)
|
||||
(maybe-render-line event))
|
||||
(progn
|
||||
(return-from download-loop nil))))
|
||||
named download-loop
|
||||
for line-as-array = (read-line-into-array download-stream)
|
||||
while line-as-array do
|
||||
(gemini-client:debug-gemini "[stream] gemini file stream raw data line : ~a"
|
||||
line-as-array)
|
||||
(if (downloading-allowed-p wrapper-object)
|
||||
(let* ((line (babel:octets-to-string line-as-array :errorp nil))
|
||||
(event (make-gemini-download-event line
|
||||
wrapper-object
|
||||
t)))
|
||||
(gemini-client:debug-gemini "[stream] gemini file stream got data line : ~a"
|
||||
line)
|
||||
(write-sequence line file-stream)
|
||||
(increment-bytes-count wrapper-object line :convert-to-octects t)
|
||||
(maybe-render-line event))
|
||||
(progn
|
||||
(return-from download-loop nil))))
|
||||
(maybe-render-preformat-wrapper file-stream wrapper-object)
|
||||
(if (not (downloading-allowed-p wrapper-object))
|
||||
(ui:notify (_ "Gemini document downloading aborted"))
|
||||
(progn
|
||||
@ -410,6 +426,8 @@
|
||||
(support-file support-file)) wrapper-object
|
||||
|
||||
(lambda ()
|
||||
(when-let ((extension (fs:get-extension path)))
|
||||
(setf support-file (fs:temporary-file :extension extension)))
|
||||
(with-open-support-file (file-stream support-file)
|
||||
(labels ((%fill-buffer ()
|
||||
(when (downloading-allowed-p wrapper-object)
|
||||
@ -422,7 +440,7 @@
|
||||
(force-output file-stream)
|
||||
(setf (stream-status wrapper-object) :completed)
|
||||
(gemini-client:close-ssl-socket socket)
|
||||
(os-utils:xdg-open support-file))
|
||||
(os-utils:open-resource-with-external-program support-file nil))
|
||||
(progn
|
||||
(write-sequence buffer file-stream)
|
||||
(%fill-buffer)))))))
|
||||
@ -432,7 +450,8 @@
|
||||
(lambda (status code-description meta response socket iri parsed-iri)
|
||||
(declare (ignore iri))
|
||||
(labels ((starting-status (meta)
|
||||
(if (gemini-client:gemini-file-stream-p meta)
|
||||
(if (or (gemini-client:gemini-file-stream-p meta)
|
||||
(gemini-client:text-file-stream-p meta))
|
||||
(if enqueue
|
||||
:streaming
|
||||
:rendering)
|
||||
@ -443,66 +462,74 @@
|
||||
(gemini-client:displace-iri parsed-iri)
|
||||
(declare (ignore actual-iri))
|
||||
(gemini-client:debug-gemini "response is a stream")
|
||||
(if (gemini-client:gemini-file-stream-p meta)
|
||||
(let* ((starting-status (starting-status meta))
|
||||
(gemini-stream (make-instance 'gemini-file-stream
|
||||
:host host
|
||||
:port port
|
||||
:path path
|
||||
:query query
|
||||
:fragment fragment
|
||||
:meta meta
|
||||
:status-code status
|
||||
:status-code-description
|
||||
code-description
|
||||
:stream-status starting-status
|
||||
:download-stream response
|
||||
:download-socket socket))
|
||||
(favicon (fetch-favicon parsed-iri))
|
||||
(thread-fn (request-stream-gemini-document-thread gemini-stream
|
||||
host
|
||||
port
|
||||
path
|
||||
query
|
||||
fragment
|
||||
favicon))
|
||||
(enqueue-event (make-instance 'program-events:gemini-enqueue-download-event
|
||||
:payload gemini-stream)))
|
||||
(gemini-client:debug-gemini "response is a gemini file stream")
|
||||
(program-events:push-event enqueue-event)
|
||||
(downloading-start-thread gemini-stream
|
||||
thread-fn
|
||||
host
|
||||
port
|
||||
path
|
||||
query
|
||||
fragment))
|
||||
(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
|
||||
fragment
|
||||
status
|
||||
code-description
|
||||
meta))
|
||||
(enqueue-event (make-instance 'program-events:gemini-enqueue-download-event
|
||||
:payload gemini-stream)))
|
||||
(gemini-client:debug-gemini "response is *not* a gemini file stream")
|
||||
(program-events:push-event enqueue-event)
|
||||
(downloading-start-thread gemini-stream
|
||||
thread-fn
|
||||
host
|
||||
port
|
||||
path
|
||||
query
|
||||
fragment)))))))
|
||||
(labels ((make-text-based-stream (gemini-format-p)
|
||||
(let* ((starting-status (starting-status meta))
|
||||
(gemini-stream (make-instance 'gemini-file-stream
|
||||
:host host
|
||||
:port port
|
||||
:path path
|
||||
:query query
|
||||
:fragment fragment
|
||||
:meta meta
|
||||
:status-code status
|
||||
:status-code-description
|
||||
code-description
|
||||
:stream-status starting-status
|
||||
:download-stream response
|
||||
:download-socket socket))
|
||||
(favicon (fetch-favicon parsed-iri))
|
||||
(thread-fn (request-stream-gemini-document-thread gemini-stream
|
||||
host
|
||||
port
|
||||
path
|
||||
query
|
||||
fragment
|
||||
favicon
|
||||
gemini-format-p))
|
||||
(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
|
||||
fragment))))
|
||||
(cond
|
||||
((gemini-client:gemini-file-stream-p meta)
|
||||
(gemini-client:debug-gemini "response is a gemini document stream")
|
||||
(make-text-based-stream t))
|
||||
((gemini-client:text-file-stream-p meta)
|
||||
(gemini-client:debug-gemini "response is a text stream")
|
||||
(make-text-based-stream nil))
|
||||
(t
|
||||
(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
|
||||
fragment
|
||||
status
|
||||
code-description
|
||||
meta))
|
||||
(enqueue-event (make-instance 'program-events:gemini-enqueue-download-event
|
||||
:payload gemini-stream)))
|
||||
(gemini-client:debug-gemini "response is *not* a gemini file stream")
|
||||
(program-events:push-event enqueue-event)
|
||||
(downloading-start-thread gemini-stream
|
||||
thread-fn
|
||||
host
|
||||
port
|
||||
path
|
||||
query
|
||||
fragment)))))))))
|
||||
|
||||
(defun request (url &key
|
||||
(enqueue nil)
|
||||
|
@ -96,6 +96,9 @@
|
||||
(defun mime-gemini-p (header-meta)
|
||||
(string-starts-with-p "text/gemini" header-meta))
|
||||
|
||||
(defun mime-text-p (header-meta)
|
||||
(string-starts-with-p "text/" header-meta))
|
||||
|
||||
(defun header-code= (header code-class)
|
||||
(code= (status-code header)
|
||||
code-class))
|
||||
@ -451,7 +454,10 @@
|
||||
,@body)))
|
||||
|
||||
(defun gemini-file-stream-p (meta)
|
||||
(gemini-client:mime-gemini-p meta))
|
||||
(mime-gemini-p meta))
|
||||
|
||||
(defun text-file-stream-p (meta)
|
||||
(mime-text-p meta))
|
||||
|
||||
(defun fetch-cached-certificate (url)
|
||||
(let ((certificate nil)
|
||||
|
@ -49,6 +49,12 @@
|
||||
|
||||
(gen-geminize-line link +link-prefix+)
|
||||
|
||||
(defun geminize-preformatted (text)
|
||||
(format nil "~a~%~a~a~%"
|
||||
+preformatted-prefix+
|
||||
text
|
||||
+preformatted-prefix+))
|
||||
|
||||
(defun make-gemini-link (url title)
|
||||
(format nil "~a ~a"
|
||||
(geminize-link url)
|
||||
|
@ -37,12 +37,14 @@
|
||||
(:shadowing-import-from :misc :random-elt :shuffle)
|
||||
(:export
|
||||
:+gemini-scheme+
|
||||
:+preformatted-prefix+
|
||||
:geminize-h1
|
||||
:geminize-h2
|
||||
:geminize-h3
|
||||
:geminize-list
|
||||
:geminize-quote
|
||||
:geminize-link
|
||||
:geminize-preformatted
|
||||
:make-gemini-link
|
||||
:gemini-link
|
||||
:target
|
||||
@ -88,6 +90,7 @@
|
||||
:find-code-description
|
||||
:find-code-class
|
||||
:mime-gemini-p
|
||||
:mime-text-stream
|
||||
:gemini-protocol-error
|
||||
:error-code
|
||||
:error-description
|
||||
@ -119,6 +122,7 @@
|
||||
:debug-gemini
|
||||
:request
|
||||
:gemini-file-stream-p
|
||||
:text-file-stream-p
|
||||
:request-dispatch
|
||||
:with-request-dispatch-table
|
||||
:fetch-cached-certificate
|
||||
|
Loading…
Reference in New Issue
Block a user