mirror of https://codeberg.org/cage/tinmop/
- added slot 'parsed-lines' to gemini-viewer:gemini-stream,
moreover used this slots when downloading a gemini stream This changes means that the parsing of gemini stream is no more done in program events but during the downloading thread. See, for example the changes in: 'gemini-viewer:make-gemini-download-event' - added a parameter to prevent notification when downloading a gemini stream see 'gemini-viewer:request-stream-gemini-document-thread'; - added a more human friendly constants for each gemini status code (e.g. +success+ for code 20). - as the gemini parser has status added a parameter ('initialize-parser') to 'gemini-parser:parse-gemini-file' (default to nil, do not initialize); - initialize the gemini parser when needed.
This commit is contained in:
parent
72bb14c9d6
commit
685f4e4db7
|
@ -137,6 +137,10 @@
|
|||
:initform (fs:temporary-file)
|
||||
:initarg :support-file
|
||||
:accessor support-file)
|
||||
(parsed-lines
|
||||
:initform '()
|
||||
:initarg :parsed-lines
|
||||
:accessor parsed-lines)
|
||||
(octect-count
|
||||
:initform 0
|
||||
:initarg :octect-count
|
||||
|
@ -269,12 +273,15 @@
|
|||
|
||||
(defmethod (setf stream-status) :after ((val (eql :rendering)) (object gemini-file-stream))
|
||||
(with-accessors ((download-thread-lock download-thread-lock)
|
||||
(support-file support-file)) object
|
||||
(support-file support-file)
|
||||
(parsed-lines parsed-lines)) object
|
||||
(with-lock (download-thread-lock)
|
||||
(let ((event (make-gemini-download-event (fs:slurp-file support-file)
|
||||
object
|
||||
nil)))
|
||||
(program-events:push-event event)))))
|
||||
(gemini-parser:with-initialized-parser
|
||||
(let ((event (make-gemini-download-event (fs:slurp-file support-file)
|
||||
parsed-lines
|
||||
object
|
||||
nil)))
|
||||
(program-events:push-event event))))))
|
||||
|
||||
(defclass gemini-others-data-stream (gemini-stream) ())
|
||||
|
||||
|
@ -307,21 +314,21 @@
|
|||
(with-accessors ((octect-count octect-count)) object
|
||||
(incf octect-count data)))
|
||||
|
||||
(defun make-gemini-download-event (src-data stream-object append-text)
|
||||
(defun make-gemini-download-event (src-data parsed-data stream-object append-text)
|
||||
(with-accessors ((download-iri download-iri)
|
||||
(host host)
|
||||
(port port)
|
||||
(path path)
|
||||
(meta meta)
|
||||
(query query)
|
||||
(parsed-lines parsed-lines)
|
||||
(status-code status-code)
|
||||
(status-code-description status-code-description)) stream-object
|
||||
(let* ((parsed (gemini-parser:parse-gemini-file src-data))
|
||||
(links (gemini-parser:sexp->links parsed host port path query))
|
||||
(let* ((links (gemini-parser:sexp->links parsed-data host port path query))
|
||||
(response (gemini-client:make-gemini-file-response status-code
|
||||
status-code-description
|
||||
meta
|
||||
parsed
|
||||
parsed-data
|
||||
download-iri
|
||||
src-data
|
||||
links)))
|
||||
|
@ -357,7 +364,8 @@
|
|||
|
||||
(defun request-stream-gemini-document-thread (wrapper-object host
|
||||
port path query fragment favicon
|
||||
gemini-format-p)
|
||||
gemini-format-p
|
||||
&key (notify t))
|
||||
(with-accessors ((download-socket download-socket)
|
||||
(download-stream download-stream)
|
||||
(octect-count octect-count)
|
||||
|
@ -381,12 +389,18 @@
|
|||
(ui:open-gemini-message-link-window :give-focus nil))))
|
||||
(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))))
|
||||
(gemini-parser:with-initialized-parser
|
||||
(let* ((preformat-line (format nil "~a~%" gemini-parser:+preformatted-prefix+))
|
||||
(parsed-line (gemini-parser:parse-gemini-file preformat-line)))
|
||||
(setf (parsed-lines wrapper-object)
|
||||
(append (parsed-lines wrapper-object)
|
||||
parsed-line))
|
||||
(let ((preformat-wrapper-event (make-gemini-download-event preformat-line
|
||||
parsed-line
|
||||
wrapper-object
|
||||
t)))
|
||||
(maybe-render-line preformat-wrapper-event)
|
||||
(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)
|
||||
|
@ -394,7 +408,10 @@
|
|||
(char= (first-elt res)
|
||||
#\ZERO_WIDTH_NO-BREAK_SPACE))
|
||||
(subseq res 1)
|
||||
res))))
|
||||
res)))
|
||||
(maybe-notify (message)
|
||||
(when notify
|
||||
(ui:notify message))))
|
||||
(lambda ()
|
||||
(gemini-parser:with-initialized-parser
|
||||
(when-let ((extension (fs:get-extension path)))
|
||||
|
@ -423,6 +440,8 @@
|
|||
:window *message-window*)))
|
||||
(write-sequence url-header file-stream)
|
||||
(increment-bytes-count wrapper-object url-header :convert-to-octects t)
|
||||
(setf (parsed-lines wrapper-object)
|
||||
(gemini-parser:parse-gemini-file url-header))
|
||||
(maybe-change-title new-title-event)
|
||||
(maybe-render-line url-event)
|
||||
(maybe-render-preformat-wrapper file-stream wrapper-object)
|
||||
|
@ -438,24 +457,29 @@
|
|||
(let* ((line (if (= ct 0)
|
||||
(array->string line-as-array t)
|
||||
(array->string line-as-array nil)))
|
||||
(event (make-gemini-download-event line
|
||||
wrapper-object
|
||||
t)))
|
||||
(parsed-line (gemini-parser:parse-gemini-file line)))
|
||||
(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))
|
||||
(setf (parsed-lines wrapper-object)
|
||||
(append (parsed-lines wrapper-object)
|
||||
parsed-line))
|
||||
(let ((event (make-gemini-download-event line
|
||||
parsed-line
|
||||
wrapper-object
|
||||
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"))
|
||||
(maybe-notify (_ "Gemini document downloading aborted"))
|
||||
(progn
|
||||
(maybe-render-toc)
|
||||
(maybe-render-links)
|
||||
(maybe-render-focus-mark)
|
||||
(ui:notify (_ "Gemini document downloading completed"))
|
||||
(maybe-notify (_ "Gemini document downloading completed"))
|
||||
(setf (stream-status wrapper-object) :completed)
|
||||
(when (and fragment
|
||||
(swconf:config-gemini-fragment-as-regex-p))
|
||||
|
|
|
@ -43,41 +43,42 @@
|
|||
(define-constant ,(format-fn-symbol t "+~a+" value) ,error-object :test #'response=)
|
||||
(define-constant ,(format-fn-symbol t "+~a+" error-name-verbose) ,error-object :test #'response=)))))
|
||||
|
||||
(gen-status-constant 10 "Input")
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(gen-status-constant 10 "Input")
|
||||
|
||||
(gen-status-constant 11 "Sensitive input")
|
||||
(gen-status-constant 11 "Sensitive input")
|
||||
|
||||
(gen-status-constant 20 "success")
|
||||
(gen-status-constant 20 "success")
|
||||
|
||||
(gen-status-constant 30 "redirect - temporary")
|
||||
(gen-status-constant 30 "redirect - temporary")
|
||||
|
||||
(gen-status-constant 31 "redirect - permanent")
|
||||
(gen-status-constant 31 "redirect - permanent")
|
||||
|
||||
(gen-status-constant 40 "temporary failure")
|
||||
(gen-status-constant 40 "temporary failure")
|
||||
|
||||
(gen-status-constant 41 "server unavailable")
|
||||
(gen-status-constant 41 "server unavailable")
|
||||
|
||||
(gen-status-constant 42 "cgi error")
|
||||
(gen-status-constant 42 "cgi error")
|
||||
|
||||
(gen-status-constant 43 "proxy error")
|
||||
(gen-status-constant 43 "proxy error")
|
||||
|
||||
(gen-status-constant 44 "slow down")
|
||||
(gen-status-constant 44 "slow down")
|
||||
|
||||
(gen-status-constant 50 "permanent failure")
|
||||
(gen-status-constant 50 "permanent failure")
|
||||
|
||||
(gen-status-constant 51 "not found")
|
||||
(gen-status-constant 51 "not found")
|
||||
|
||||
(gen-status-constant 52 "gone")
|
||||
(gen-status-constant 52 "gone")
|
||||
|
||||
(gen-status-constant 53 "proxy request refused")
|
||||
(gen-status-constant 53 "proxy request refused")
|
||||
|
||||
(gen-status-constant 59 "bad request")
|
||||
(gen-status-constant 59 "bad request")
|
||||
|
||||
(gen-status-constant 60 "client certificate required")
|
||||
(gen-status-constant 60 "client certificate required")
|
||||
|
||||
(gen-status-constant 61 "certificate not authorised")
|
||||
(gen-status-constant 61 "certificate not authorised")
|
||||
|
||||
(gen-status-constant 62 "certificate not valid")
|
||||
(gen-status-constant 62 "certificate not valid"))
|
||||
|
||||
(defparameter *all-codes* (list +10+ +11+
|
||||
+20+
|
||||
|
|
|
@ -704,28 +704,32 @@
|
|||
(flatten (loop for node in parsed-gemini collect (build-row node)))))
|
||||
(build-rows)))
|
||||
|
||||
(defun parse-gemini-file (data)
|
||||
(let* ((lines (if (string= (format nil "~%") data)
|
||||
(list (format nil "~%"))
|
||||
(mapcar (lambda (a)
|
||||
(strcat a (string #\Newline)))
|
||||
(split-lines data))))
|
||||
(parsed (loop for line in lines
|
||||
collect
|
||||
(let ((was-raw-mode *raw-mode-data*)
|
||||
(parsed-line (parse 'gemini-file line :junk-allowed t)))
|
||||
(if was-raw-mode
|
||||
(if *raw-mode-data*
|
||||
(let ((*blanks* '(#\Newline #\Linefeed #\Return)))
|
||||
(html-utils:make-tag-node :as-is
|
||||
(list (list :alt *raw-mode-data*))
|
||||
(trim-blanks line)))
|
||||
parsed-line)
|
||||
parsed-line)))))
|
||||
(mapcar (lambda (a b)
|
||||
(when b
|
||||
(html-utils:add-attribute :source-line a b)))
|
||||
lines parsed)))
|
||||
(defun parse-gemini-file (data &key (initialize-parser nil))
|
||||
(flet ((parse-data (data)
|
||||
(let* ((lines (if (string= (format nil "~%") data)
|
||||
(list (format nil "~%"))
|
||||
(mapcar (lambda (a)
|
||||
(strcat a (string #\Newline)))
|
||||
(split-lines data))))
|
||||
(parsed (loop for line in lines
|
||||
collect
|
||||
(let ((was-raw-mode *raw-mode-data*)
|
||||
(parsed-line (parse 'gemini-file line :junk-allowed t)))
|
||||
(if was-raw-mode
|
||||
(if *raw-mode-data*
|
||||
(let ((*blanks* '(#\Newline #\Linefeed #\Return)))
|
||||
(html-utils:make-tag-node :as-is
|
||||
(list (list :alt *raw-mode-data*))
|
||||
(trim-blanks line)))
|
||||
parsed-line)
|
||||
parsed-line)))))
|
||||
(mapcar (lambda (a b)
|
||||
(when b
|
||||
(html-utils:add-attribute :source-line a b)))
|
||||
lines parsed))))
|
||||
(if initialize-parser
|
||||
(with-initialized-parser (parse-data data))
|
||||
(parse-data data))))
|
||||
|
||||
;; response header
|
||||
|
||||
|
@ -786,15 +790,6 @@
|
|||
(uri:scheme parsed))
|
||||
(uri:host parsed)))))
|
||||
|
||||
(defgeneric gemini-first-h1 (data))
|
||||
|
||||
(defmethod gemini-first-h1 ((data cons))
|
||||
(first (html-utils:children (html-utils:find-tag :h1 data))))
|
||||
|
||||
(defmethod gemini-first-h1 ((data string))
|
||||
(when-let ((parsed (parse-gemini-file data)))
|
||||
(gemini-first-h1 parsed)))
|
||||
|
||||
(defmacro with-initialized-parser (&body body)
|
||||
`(let ((gemini-parser:*pre-group-id* -1)
|
||||
(gemini-parser:*header-group-id* -1)
|
||||
|
@ -802,3 +797,13 @@
|
|||
(gemini-parser:*pre-alt-text* "")
|
||||
(gemini-parser:*raw-mode-data* nil))
|
||||
,@body))
|
||||
|
||||
(defgeneric gemini-first-h1 (data))
|
||||
|
||||
(defmethod gemini-first-h1 ((data cons))
|
||||
(first (html-utils:children (html-utils:find-tag :h1 data))))
|
||||
|
||||
(defmethod gemini-first-h1 ((data string))
|
||||
(with-initialized-parser
|
||||
(when-let ((parsed (parse-gemini-file data :initialize-parser t)))
|
||||
(gemini-first-h1 parsed))))
|
||||
|
|
|
@ -52,7 +52,7 @@ This function return the 'post-title' substring."
|
|||
res))))
|
||||
(when-let* ((data (slurp-gemini-url url))
|
||||
(page (text-utils:to-s data))
|
||||
(parsed (parse-gemini-file page))
|
||||
(parsed (parse-gemini-file page :initialize-parser t))
|
||||
(iri (iri:iri-parse url))
|
||||
(title (gemini-first-h1 parsed)))
|
||||
(let* ((maybe-subtitle-pos (html-utils:position-tag :h2 parsed))
|
||||
|
@ -69,7 +69,7 @@ be subscribed before (see: 'gemini-subscription:subcribe'"
|
|||
(handler-case
|
||||
(when-let* ((data (slurp-gemini-url url))
|
||||
(page (text-utils:to-s data))
|
||||
(parsed (parse-gemini-file page))
|
||||
(parsed (parse-gemini-file page :initialize-parser t))
|
||||
(gemlog-iri (iri:iri-parse url)))
|
||||
(let ((links (remove-if-not (lambda (a) (link-post-timestamp-p (name a)))
|
||||
(sexp->links parsed
|
||||
|
|
|
@ -1124,7 +1124,7 @@
|
|||
(window window)
|
||||
(local-path local-path)) object
|
||||
(tui:with-notify-errors
|
||||
(let* ((parsed (gemini-parser:parse-gemini-file page-data))
|
||||
(let* ((parsed (gemini-parser:parse-gemini-file page-data :initialize-parser t))
|
||||
(local-path-p (text-utils:string-not-empty-p local-path))
|
||||
(links (gemini-parser:sexp->links parsed
|
||||
nil
|
||||
|
@ -1233,7 +1233,7 @@
|
|||
(push-event object))))
|
||||
((opening-gempub-file-p object)
|
||||
(let* ((file-string (fs:slurp-file local-path))
|
||||
(parsed (gemini-parser:parse-gemini-file file-string))
|
||||
(parsed (gemini-parser:parse-gemini-file file-string :initialize-parser t))
|
||||
(parent-dir (fs:parent-dir-path local-path))
|
||||
(links (gemini-parser:sexp->links parsed
|
||||
nil
|
||||
|
@ -1434,7 +1434,7 @@
|
|||
title)
|
||||
seenp)))))
|
||||
(url (iri:iri-parse gemlog-url))
|
||||
(parsed (gemini-parser:parse-gemini-file gemini-page))
|
||||
(parsed (gemini-parser:parse-gemini-file gemini-page :initialize-parser t))
|
||||
(links (gemini-parser:sexp->links parsed
|
||||
(uri:host url)
|
||||
(uri:port url)
|
||||
|
|
Loading…
Reference in New Issue