cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- [gemini] fixed parser, made many parser state variables from 

function local to thread local;
- fixed 'line-oriented-widget:append-new-rows';  uses slots  instead of
  accessors  as, for  example, message  window skips  invisible lines
  when specialzed (on message-window) method 'rows' is called.
This commit is contained in:
cage 2021-05-16 15:20:17 +02:00
parent 4a6e2fca3d
commit 8423ca7d38
4 changed files with 91 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

107
src/gemini-viewer.lisp
View File

@ -352,59 +352,62 @@
(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 ((gemini-parser:*pre-group-id* -1)
(gemini-parser:*header-group-id* -1)
(gemini-parser:*pre-alt-text* ""))
(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)))
(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))))
(maybe-render-preformat-wrapper file-stream wrapper-object)
(if (not (downloading-allowed-p wrapper-object))
(ui:notify (_ "Gemini document downloading aborted"))
(progn
(ui:notify (_ "Gemini document downloading completed"))
(ui:open-gemini-toc)
(setf (stream-status wrapper-object) :completed)))
;; (allow-downloading wrapper-object)
(gemini-client:close-ssl-socket download-socket)))))))
(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))))
(maybe-render-preformat-wrapper file-stream wrapper-object)
(if (not (downloading-allowed-p wrapper-object))
(ui:notify (_ "Gemini document downloading aborted"))
(progn
(ui:notify (_ "Gemini document downloading completed"))
(ui:open-gemini-toc)
(setf (stream-status wrapper-object) :completed)))
;; (allow-downloading wrapper-object)
(gemini-client:close-ssl-socket download-socket))))))))
;; (fs:delete-file-if-exists support-file)))))
(defun request-stream-other-document-thread (wrapper-object

42
src/gemini/gemini-parser.lisp
View File

@ -19,6 +19,31 @@
(defparameter *raw-mode-data* nil)
(defparameter *pre-group-id* -1)
(defparameter *parser-lock* (bt:make-recursive-lock))
(defparameter *header-group-id* -1)
(defparameter *pre-alt-text* "")
(defun-w-lock next-pre-group-id () *parser-lock*
(incf *pre-group-id*)
*pre-group-id*)
(defun-w-lock pre-group-id () *parser-lock*
*pre-group-id*)
(defun-w-lock next-header-group-id () *parser-lock*
(incf *header-group-id*)
*header-group-id*)
(defun-w-lock set-pre-alt-text (text) *parser-lock*
(setf *pre-alt-text* text))
(defun-w-lock current-pre-alt-text () *parser-lock*
*pre-alt-text*)
(defparameter *omitted-port* +gemini-default-port+)
(define-constant +h1-prefix+ "#" :test #'string=)
@ -438,10 +463,7 @@
:link-value link-value))
(defun sexp->text-rows (parsed-gemini theme)
(let ((win-width (message-window:viewport-width (viewport theme)))
(pre-group-id -1)
(header-group-id -1)
(pre-alt-text ""))
(let ((win-width (message-window:viewport-width (viewport theme))))
(labels ((header-prefix (prefix header)
(strcat prefix header))
(header-prefix-h1 (header)
@ -455,8 +477,8 @@
(underline (build-string size underline-char)))
underline))
(make-header (level text underline-char)
(let ((underline (build-underline text underline-char)))
(incf header-group-id)
(let ((underline (build-underline text underline-char))
(header-group-id (next-header-group-id)))
(list (make-header-line text header-group-id level)
(make-header-line underline header-group-id level))))
(trim (a)
@ -497,7 +519,7 @@
"~a"
truncated-line)
:fgcolor fg)))
(make-pre-line (list line) pre-group-id pre-alt-text)))
(make-pre-line (list line) (pre-group-id) (current-pre-alt-text))))
((html-utils:tag= :text node)
(format nil "~a~%" (text-value node)))
((html-utils:tag= :h1 node)
@ -522,9 +544,9 @@
(fit-quote-lines (text-value node :trim nil)
win-width))
((html-utils:tag= :pre node)
(let ((current-alt-text (pre-alt-text node)))
(incf pre-group-id)
(setf pre-alt-text current-alt-text)
(let ((current-alt-text (pre-alt-text node))
(pre-group-id (next-pre-group-id)))
(set-pre-alt-text current-alt-text)
(make-pre-start current-alt-text pre-group-id)))
((html-utils:tag= :pre-end node)
(make-pre-end))

3
src/gemini/package.lisp
View File

@ -39,6 +39,9 @@
:+gemini-scheme+
:+preformatted-prefix+
:+max-header-level+
:*pre-group-id*
:*pre-alt-text*
:*header-group-id*
:geminize-h1
:geminize-h2
:geminize-h3

2
src/line-oriented-window.lisp
View File

@ -307,7 +307,7 @@ this exact quantity would go beyond the length or rows or zero."
(setf (rows object) new-rows))
(defmethod append-new-rows ((object row-oriented-widget) (new-rows sequence))
(with-accessors ((rows rows)) object
(with-slots (rows) object
(let ((reversed-old-rows (reverse rows)))
(loop for new-row in new-rows do
(push new-row reversed-old-rows))