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

- [GUI] fixed leaking lines parameter when rendering preformatted text; 

- [gemini] added a missing newline character in 'geminize-preformatted';
- [GUI] parsed standard colors for gemini window's text;
- [GUI] rendered the gemini  protocol rerror  responses to  the gemtext
  window instead of poppinu out a dialog window.
This commit is contained in:
cage 2023-03-12 15:36:13 +01:00
parent fa6844a2ab
commit 559b5dae84
7 changed files with 80 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
etc/gui.conf
View File

@ -66,7 +66,7 @@ gemini.quote.size = 12
gemini.quote.weight = bold
gemini.quote.slant = roman
gemini.quote.slant = italic
gemini.quote.underline = yes
@ -106,7 +106,7 @@ gemini.h2.background = #ffffff
gemini.h2.font = Sans
gemini.h2.size = 12
gemini.h2.size = 15
gemini.h2.weight = bold

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

@ -112,7 +112,7 @@
(gen-geminize-line link +link-prefix+)
(defun geminize-preformatted (text)
(format nil "~a~%~a~a~%"
(format nil "~a~%~a~%~a~%"
+preformatted-prefix+
text
+preformatted-prefix+))

16
src/gui/client/client-configuration.lisp
View File

@ -61,14 +61,14 @@
swconf:+key-favicon+))
(defun gemini-window-colors ()
(values (access:accesses *client-configuration*
swconf:+key-gemini+
swconf:+key-main-window+
swconf:+key-background+)
(access:accesses *client-configuration*
swconf:+key-gemini+
swconf:+key-main-window+
swconf:+key-foreground+)))
(values (gui-goodies:parse-color (access:accesses *client-configuration*
swconf:+key-gemini+
swconf:+key-main-window+
swconf:+key-background+))
(gui-goodies:parse-color (access:accesses *client-configuration*
swconf:+key-gemini+
swconf:+key-main-window+
swconf:+key-foreground+))))
(defun font-configuration (key)
(gui-goodies:make-font (access:accesses *client-configuration*

74
src/gui/client/main-window.lisp
View File

@ -253,10 +253,8 @@
(vector-push-extend raw-line ir-rendered-lines)))
(key->font (key)
(ecase key
((:vertical-space :pre-end :text :li)
nil)
(:as-is
(gui-conf:gemini-preformatted-text-font-configuration))
((:vertical-space :text :li)
(gui-conf:gemini-text-font-configuration))
(:h1
(gui-conf:gemini-h1-font-configuration))
(:h2
@ -265,16 +263,14 @@
(gui-conf:gemini-h3-font-configuration))
(:quote
(gui-conf:gemini-quote-font-configuration))
(:pre
((:pre :pre-end :as-is)
(gui-conf:gemini-preformatted-text-font-configuration))
(:a
(gui-conf:gemini-link-font-configuration))))
(key->colors (key)
(ecase key
((:vertical-space :pre-end :text :li)
nil)
(:as-is
(gui-conf:gemini-preformatted-text-colors))
((:vertical-space :text :li)
(gui-conf:gemini-window-colors))
(:h1
(gui-conf:gemini-h1-colors))
(:h2
@ -283,16 +279,14 @@
(gui-conf:gemini-h3-colors))
(:quote
(gui-conf:gemini-quote-colors))
(:pre
((:pre :pre-end :as-is)
(gui-conf:gemini-preformatted-text-colors))
(:a
(gui-conf:gemini-link-colors))))
(key->justification (key)
(ecase key
((:vertical-space :text :pre-end :li :a)
nil)
(:as-is
(gui-conf:gemini-preformatted-text-justification))
((:vertical-space :text :li :a)
:left)
(:h1
(gui-conf:gemini-h1-justification))
(:h2
@ -301,7 +295,7 @@
(gui-conf:gemini-h3-justification))
(:quote
(gui-conf:gemini-quote-justification))
(:pre
((:pre :pre-end :as-is)
(gui-conf:gemini-preformatted-text-justification))))
(linkify (line line-number)
(multiple-value-bind (link-bg link-fg)
@ -341,31 +335,26 @@
(lambda () (print-info-message target-iri))
:leave-callback
(lambda () (print-info-message "")))
(gui:append-line gemtext-widget "")))))
(render-line (key text line-number)
(let ((font (key->font key))
(justification (key->justification key))
(start-index `(:line ,line-number :char 0)))
(gui:append-text gemtext-widget text)
(if font
(multiple-value-bind (background foreground)
(key->colors key)
(let ((tag (gui:tag-create gemtext-widget
(gui::create-tag-name)
start-index
(gui:make-indices-end))))
(gui:tag-configure gemtext-widget
tag
:font font
:foreground foreground
:background background
:justify justification)
(gui:append-line gemtext-widget "")
tag))
(progn
(gui:append-line gemtext-widget "")
nil)))))
(gui:append-line gemtext-widget "")
(multiple-value-bind (background foreground)
(key->colors key)
(let ((tag (gui:tag-create gemtext-widget
(gui::create-tag-name)
start-index
(gui:make-indices-end))))
(gui:tag-configure gemtext-widget
tag
:font font
:foreground foreground
:background background
:justify justification)
tag)))))
(loop with render-line-count = 0
with starting-pre-block-line = -1
with ending-pre-block-line = -1
@ -408,12 +397,14 @@
(render-line :quote (a:last-elt ir-rendered-lines) render-line-count))
(:pre
(vector-push-extend (format nil "") ir-rendered-lines)
(incf render-line-count)
(setf starting-pre-block-line (1+ render-line-count))
(setf current-pre-block-alt-text (ir-pre-alt-text line))
(render-line :pre (a:last-elt ir-rendered-lines) render-line-count))
(:pre-end
(vector-push-extend (format nil "") ir-rendered-lines)
(setf ending-pre-block-line (1+ render-line-count))
(incf render-line-count)
(render-line :pre-end (a:last-elt ir-rendered-lines) render-line-count))
(:a
(incf render-line-count)
@ -449,6 +440,11 @@
(t
(notify-request-error (format nil (_ "No such file or directory: ~a") path)))))
(defun render-gemtext-string (main-window parsed-lines &key (links-path-prefix ""))
(ev:with-enqueued-process-and-unblock ()
(clean-gemtext main-window)
(collect-ir-lines links-path-prefix gui-goodies:*main-frame* parsed-lines)))
(defun open-iri (iri main-window use-cache)
(handler-case
(let ((parsed-iri (iri:iri-parse iri)))
@ -517,8 +513,14 @@
((or (gemini-client:header-temporary-failure-p status-code)
(gemini-client:header-permanent-failure-p status-code)
(gemini-client:header-certificate-failure-p status-code))
(error (_ "~a ~a Error connecting to: ~a:~2%~a")
status-code status-description iri meta))
(let ((error-gemtext (cev:enqueue-request-and-wait-results :make-error-page
1
ev:+standard-event-priority+
iri
status-code
status-description
meta)))
(render-gemtext-string main-window error-gemtext)))
((gemini-client:header-redirect-p status-code)
(when (gui:ask-yesno (format nil (_ "Follow redirection to ~a?") meta)
:title (_ "Redirection")

23
src/gui/server/public-api-gemini-stream.lisp
View File

@ -435,10 +435,29 @@
(defmethod yason:encode ((object gemini-toc) &optional (stream *standard-output*))
(encode-flat-array-of-plists (unbox object) stream))
(defun gemini-parse-local-file (path)
(let ((parsed-lines (gemini-parser:parse-gemini-file (fs:slurp-file path))))
(defun gemini-parse-string (string)
(let ((parsed-lines (gemini-parser:parse-gemini-file string)))
(make-instance 'parsed-lines-slice
:contents (rearrange-parsed-line-for-encoding parsed-lines))))
(defun gemini-parse-local-file (path)
(if (fs:file-exists-p path)
(gemini-parse-string (fs:slurp-file path))
(error "No such file ~a" path)))
(defun gemini-slurp-local-file (path)
(fs:slurp-file path))
(defun make-error-page (iri code description meta)
(let* ((separator (make-string 10 :initial-element gemini-parser::+h2-underline+))
(gemtext (with-output-to-string (stream)
(write-sequence (gemini-parser:geminize-h2 (format nil
"~a ~a~%"
code
description))
stream)
(write-sequence (gemini-parser:geminize-preformatted separator)
stream)
(write-sequence (format nil "Error connecting to: ~a:~2%" iri) stream)
(write-sequence (format nil "~a~%" meta) stream))))
(gemini-parse-string gemtext)))

9
src/gui/server/public-api.lisp
View File

@ -75,6 +75,15 @@
(gen-rpc "gemini-parse-local-file"
'gemini-parse-local-file
"path" 0)
(gen-rpc "gemini-parse-string"
'gemini-parse-string
"string" 0)
(gen-rpc "make-error-page"
'make-error-page
"iri" 0
"code" 1
"description" 2
"meta" 3)
(gen-rpc "gemini-slurp-local-file"
'gemini-slurp-local-file
"path" 0)

1
src/package.lisp
View File

@ -3259,6 +3259,7 @@
:gemini-h1-colors
:gemini-h2-colors
:gemini-h3-colors
:gemini-window-colors
:gemini-preformatted-text-colors
:gemini-quote-justification
:gemini-h1-justification