diff --git a/etc/gui.conf b/etc/gui.conf index 4032823..fac70da 100644 --- a/etc/gui.conf +++ b/etc/gui.conf @@ -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 diff --git a/src/gemini/gemini-parser.lisp b/src/gemini/gemini-parser.lisp index bfdc2fa..2111278 100644 --- a/src/gemini/gemini-parser.lisp +++ b/src/gemini/gemini-parser.lisp @@ -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+)) diff --git a/src/gui/client/client-configuration.lisp b/src/gui/client/client-configuration.lisp index edd3001..2ece4ab 100644 --- a/src/gui/client/client-configuration.lisp +++ b/src/gui/client/client-configuration.lisp @@ -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* diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp index d03d50e..bcaa1b8 100644 --- a/src/gui/client/main-window.lisp +++ b/src/gui/client/main-window.lisp @@ -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") diff --git a/src/gui/server/public-api-gemini-stream.lisp b/src/gui/server/public-api-gemini-stream.lisp index 12f435b..8486131 100644 --- a/src/gui/server/public-api-gemini-stream.lisp +++ b/src/gui/server/public-api-gemini-stream.lisp @@ -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))) diff --git a/src/gui/server/public-api.lisp b/src/gui/server/public-api.lisp index f72ef19..92fe06b 100644 --- a/src/gui/server/public-api.lisp +++ b/src/gui/server/public-api.lisp @@ -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) diff --git a/src/package.lisp b/src/package.lisp index 27016ca..dd5ed39 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -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