mirror of https://codeberg.org/cage/tinmop/
- [GUI] added a new internal only gemini parsed line to provide errpr messages to GUI.
This commit is contained in:
cage
parent
e466dd7c6e
commit
1bd8b6c1cf
|
|
@ -753,6 +753,12 @@
|
|||
(with-initialized-parser (build-rows))
|
||||
(build-rows))))
|
||||
|
||||
(defun make-error-parsing-line (message)
|
||||
`(:error ,message))
|
||||
|
||||
(defun error-parsing-line-extract-message (message)
|
||||
(second message))
|
||||
|
||||
(defun parse-gemini-file (data &key (initialize-parser nil) (add-metadata t))
|
||||
(flet ((parse-data (data)
|
||||
(let* ((lines (if (string= (format nil "~%") data)
|
||||
|
|
|
|||
|
|
@ -63,6 +63,8 @@
|
|||
:gemini-response
|
||||
:status-code
|
||||
:meta
|
||||
:make-error-parsing-line
|
||||
:error-parsing-line-extract-message
|
||||
:parse-gemini-file
|
||||
:absolutize-link
|
||||
:make-gemini-iri
|
||||
|
|
|
|||
|
|
@ -845,7 +845,7 @@ local file paths."
|
|||
(labels ((key->font (key)
|
||||
(or (cdr (assoc :key font-cache))
|
||||
(let ((font (ecase key
|
||||
((:vertical-space :text :li)
|
||||
((:vertical-space :text :li :error)
|
||||
(gui-conf:gemini-text-font-configuration))
|
||||
(:h1
|
||||
(gui-conf:gemini-h1-font-configuration))
|
||||
|
|
@ -864,7 +864,7 @@ local file paths."
|
|||
font)))
|
||||
(key->colors (key)
|
||||
(ecase key
|
||||
((:vertical-space :text :li)
|
||||
((:vertical-space :text :li :error)
|
||||
(gui-conf:gemini-window-colors))
|
||||
(:h1
|
||||
(gui-conf:gemini-h1-colors))
|
||||
|
|
@ -878,7 +878,7 @@ local file paths."
|
|||
(gui-conf:gemini-preformatted-text-colors))))
|
||||
(key->justification (key)
|
||||
(ecase key
|
||||
((:vertical-space :text :li :a)
|
||||
((:vertical-space :text :li :a :error)
|
||||
:left)
|
||||
(:h1
|
||||
(gui-conf:gemini-h1-justification))
|
||||
|
|
@ -1010,7 +1010,9 @@ local file paths."
|
|||
(render-line :pre-end rendered-line render-line-count))
|
||||
(:a
|
||||
(incf render-line-count)
|
||||
(render-link ir-line rendered-line render-line-count)))))))))
|
||||
(render-link ir-line rendered-line render-line-count))
|
||||
(:error
|
||||
(print-error-message (ir-line ir-line))))))))))
|
||||
|
||||
(defun collect-ir-lines (request-iri main-window lines)
|
||||
(with-accessors ((ir-lines ir-lines)
|
||||
|
|
@ -1029,7 +1031,7 @@ local file paths."
|
|||
(vector-push-extend line ir-lines)
|
||||
(let ((type (ir-type line)))
|
||||
(ecase (format-keyword type)
|
||||
(:vertical-space
|
||||
((:vertical-space :error)
|
||||
(vector-push-extend (format nil "") ir-rendered-lines))
|
||||
(:as-is
|
||||
(vector-push-extend (ir-line line) ir-rendered-lines))
|
||||
|
|
|
|||
|
|
@ -25,6 +25,8 @@
|
|||
|
||||
(a:define-constant +certificate-expired-status-code+ -3 :test #'=)
|
||||
|
||||
(a:define-constant +stream-error+ -4 :test #'=)
|
||||
|
||||
(defun debug-gemini-gui (&rest data)
|
||||
(apply #'gemini-client:debug-gemini
|
||||
(strcat "[gui] " (first data))
|
||||
|
|
@ -91,6 +93,81 @@
|
|||
(%fill-buffer))))))
|
||||
(%fill-buffer))))))
|
||||
|
||||
(defun request-stream-gemini-document-thread (wrapper-object scheme host
|
||||
port path query fragment favicon
|
||||
gemini-format-p)
|
||||
(with-accessors ((download-socket gw:download-socket)
|
||||
(download-stream gw:download-stream)
|
||||
(octet-count gw:octet-count)
|
||||
(support-file gw:support-file)) wrapper-object
|
||||
(labels ((maybe-render-preformat-wrapper (file-stream wrapper-object)
|
||||
(when (and (os-utils:open-resource-with-tinmop-p
|
||||
(gw:download-iri wrapper-object))
|
||||
(not gemini-format-p))
|
||||
(let* ((preformat-line (format nil "~a~%" gemini-parser:+preformatted-prefix+))
|
||||
(parsed-line (gemini-parser:parse-gemini-file preformat-line)))
|
||||
(setf (gw:parsed-lines wrapper-object)
|
||||
(append (gw:parsed-lines wrapper-object)
|
||||
parsed-line))
|
||||
(write-sequence preformat-line file-stream))))
|
||||
(array->string (array remove-bom)
|
||||
(let ((res (text-utils:to-s array :errorp nil)))
|
||||
(if (and (string-not-empty-p res)
|
||||
remove-bom
|
||||
(char= (a:first-elt res)
|
||||
#\ZERO_WIDTH_NO-BREAK_SPACE))
|
||||
(subseq res 1)
|
||||
res)))
|
||||
(write-out-stream (file-stream wrapper-object line)
|
||||
(let ((parsed-line (gemini-parser:parse-gemini-file line)))
|
||||
(write-sequence line file-stream)
|
||||
(gw::increment-bytes-count wrapper-object line :convert-to-octets t)
|
||||
(append-parsed-line wrapper-object parsed-line)))
|
||||
(append-parsed-line (wrapper-object parsed-line)
|
||||
(setf (gw:parsed-lines wrapper-object)
|
||||
(append (gw:parsed-lines wrapper-object)
|
||||
parsed-line))))
|
||||
(lambda ()
|
||||
(gemini-parser:with-initialized-parser
|
||||
(a:when-let ((extension (fs:get-extension path)))
|
||||
(setf support-file (fs:temporary-file :extension extension)))
|
||||
(gw::with-open-support-file (file-stream support-file character)
|
||||
(let* ((url (gemini-parser:make-gemini-iri host
|
||||
path
|
||||
:scheme scheme
|
||||
:query query
|
||||
:port port
|
||||
:fragment fragment))
|
||||
(url-header (format nil "~a ~a~2%" favicon url)))
|
||||
(write-sequence url-header file-stream)
|
||||
(gw::increment-bytes-count wrapper-object url-header :convert-to-octets t)
|
||||
(setf (gw:parsed-lines wrapper-object)
|
||||
(gemini-parser:parse-gemini-file url-header))
|
||||
(maybe-render-preformat-wrapper file-stream wrapper-object)
|
||||
(handler-case
|
||||
(loop
|
||||
named download-loop
|
||||
for ct from 0
|
||||
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 (gw:downloading-allowed-p wrapper-object)
|
||||
(let* ((line (if (= ct 0)
|
||||
(array->string line-as-array t)
|
||||
(array->string line-as-array nil))))
|
||||
(gemini-client:debug-gemini "[stream] gemini file stream got data line : ~a"
|
||||
line)
|
||||
(write-out-stream file-stream wrapper-object line))
|
||||
(return-from download-loop nil)))
|
||||
(error (e)
|
||||
(let ((message (gemini-parser:make-error-parsing-line (format nil
|
||||
(_ "Gemini stream error: ~a")
|
||||
e))))
|
||||
(append-parsed-line wrapper-object (list message)))))
|
||||
(maybe-render-preformat-wrapper file-stream wrapper-object)
|
||||
(gemini-client:close-ssl-socket download-socket))))))))
|
||||
|
||||
(defun request-success-dispatched-fn (status code-description meta response socket iri parsed-iri)
|
||||
(declare (ignore iri))
|
||||
(multiple-value-bind (actual-iri host path query port fragment scheme)
|
||||
|
|
@ -113,17 +190,15 @@
|
|||
:download-stream response
|
||||
:download-socket socket))
|
||||
(favicon (gemini-viewer::fetch-favicon parsed-iri))
|
||||
(thread-fn (gemini-viewer::request-stream-gemini-document-thread gemini-stream
|
||||
scheme
|
||||
host
|
||||
port
|
||||
path
|
||||
query
|
||||
fragment
|
||||
favicon
|
||||
gemini-format-p
|
||||
:notify nil
|
||||
:open-with-external-program nil)))
|
||||
(thread-fn (request-stream-gemini-document-thread gemini-stream
|
||||
scheme
|
||||
host
|
||||
port
|
||||
path
|
||||
query
|
||||
fragment
|
||||
favicon
|
||||
gemini-format-p)))
|
||||
(gemini-viewer:push-db-stream gemini-stream)
|
||||
(gemini-viewer::downloading-start-thread gemini-stream
|
||||
thread-fn
|
||||
|
|
|
|||
|
|
@ -81,15 +81,14 @@ followed by different acct e.g.:
|
|||
is found as key in the alist `usernames-table' note that `usernames-table' is not a map see: `usernames->usernames-table'."
|
||||
(let ((results text-line))
|
||||
(loop for (local-mention . actual-mention) in usernames-table do
|
||||
(let ((local-mention-re (strcat "(\\s|^)"
|
||||
(let* ((local-mention-re (strcat "(\\s|^)"
|
||||
local-mention
|
||||
"(\\s|$)")))
|
||||
(multiple-value-bind (replaced matched)
|
||||
(funcall replace-function
|
||||
local-mention-re
|
||||
results
|
||||
(wrap-with actual-mention " "))
|
||||
(setf results replaced))))
|
||||
"(\\s|$)"))
|
||||
(replaced (funcall replace-function
|
||||
local-mention-re
|
||||
results
|
||||
(wrap-with actual-mention " "))))
|
||||
(setf results replaced)))
|
||||
;; NOTE: as `usernames-table' is not a map some mention can not be
|
||||
;; replaced properly e.g.
|
||||
;;
|
||||
|
|
|
|||
Loading…
Reference in New Issue