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

- [GUI] rendered links; 

- [GUI] started with focus on the address text entry.
This commit is contained in:
cage 2023-02-25 18:18:34 +01:00
parent 9e7feacf8e
commit c546b47fd4
3 changed files with 91 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/gui/client/gui-goodies.lisp
View File

@ -14,8 +14,13 @@
(a:define-constant +font-h3+ "bold" :test #'string=) (a:define-constant +font-h3+ "bold" :test #'string=)
(defun parse-color (name) (defgeneric parse-color (object))
(nodgui.utils:rgb->tk (cl-colors2:as-rgb name)))
(defmethod parse-color ((object symbol))
(parse-color (string-downcase (symbol-name object))))
(defmethod parse-color ((object string))
(nodgui.utils:rgb->tk (cl-colors2:as-rgb object)))
(defun make-font (font-name font-size font-weight font-slant underline) (defun make-font (font-name font-size font-weight font-slant underline)
(gui:font-create (nodgui.utils:create-name) (gui:font-create (nodgui.utils:create-name)

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

@ -192,55 +192,82 @@
(defun collect-ir-lines (main-window lines) (defun collect-ir-lines (main-window lines)
(with-accessors ((ir-lines ir-lines) (with-accessors ((ir-lines ir-lines)
(ir-rendered-lines ir-rendered-lines)) main-window (ir-rendered-lines ir-rendered-lines)
(flet ((push-prefixed (prefix ir) (gemtext-widget gemtext-widget)) main-window
(let ((raw-line (format nil "~a~a" prefix (ir-line ir)))) (labels ((push-prefixed (prefix ir)
(vector-push-extend raw-line ir-rendered-lines))) (let ((raw-line (format nil "~a~a" prefix (ir-line ir))))
(linkify (line) (vector-push-extend raw-line ir-rendered-lines)))
(let* ((link-name (ir-line line)) (linkify (line)
(link-value (ir-href line)) (let* ((link-value (ir-href line))
(prefix-gemini (gui-conf:gemini-link-prefix-to-gemini)) (link-name (or (ir-line line)
(prefix-www (gui-conf:gemini-link-prefix-to-http)) link-value))
(prefix-other (gui-conf:gemini-link-prefix-to-other)) (prefix-gemini (gui-conf:gemini-link-prefix-to-gemini))
(link-text (if (text-utils:starting-emoji link-name) (prefix-www (gui-conf:gemini-link-prefix-to-http))
(format nil (prefix-other (gui-conf:gemini-link-prefix-to-other))
"~a~a" (link-text (if (text-utils:starting-emoji link-name)
(trim-blanks prefix-other) (format nil
link-name) "~a~a"
(cond (trim-blanks prefix-other)
((gemini-parser::gemini-link-iri-p link-value) link-name)
(format nil "~a~a" prefix-gemini link-name)) (cond
((html-utils::http-link-iri-p link-value) ((gemini-parser::gemini-link-iri-p link-value)
(format nil "~a~a" prefix-www link-name)) (format nil "~a~a" prefix-gemini link-name))
(t ((html-utils::http-link-iri-p link-value)
(format nil "~a~a" prefix-other link-name)))))) (format nil "~a~a" prefix-www link-name))
(vector-push-extend link-text ir-rendered-lines)))) (t
(loop for line in lines do (format nil "~a~a" prefix-other link-name))))))
(vector-push-extend line ir-lines) (vector-push-extend link-text ir-rendered-lines)))
(let ((type (ir-type line))) (render-line (text)
(ecase (format-keyword type) (gui:append-line gemtext-widget text)))
(:vertical-space (let ((link-font (gui-conf:gemini-link-font-configuration)))
(vector-push-extend (format nil "~%") ir-rendered-lines)) (multiple-value-bind (link-bg link-fg)
(:as-is (gui-conf:gemini-link-colors)
(vector-push-extend (ir-line line) ir-rendered-lines)) (loop for line in lines do
(:text (vector-push-extend line ir-lines)
(vector-push-extend (ir-line line) ir-rendered-lines)) (let ((type (ir-type line)))
(:h1 (ecase (format-keyword type)
(push-prefixed (gui-conf:gemini-h1-prefix) line)) (:vertical-space
(:h2 (vector-push-extend (format nil "") ir-rendered-lines)
(push-prefixed (gui-conf:gemini-h1-prefix) line)) (render-line (a:last-elt ir-rendered-lines)))
(:h3 (:as-is
(push-prefixed (gui-conf:gemini-h1-prefix) line)) (vector-push-extend (ir-line line) ir-rendered-lines)
(:li (render-line (a:last-elt ir-rendered-lines)))
(push-prefixed (gui-conf:gemini-bullet-prefix) line)) (:text
(:quote (vector-push-extend (ir-line line) ir-rendered-lines)
(push-prefixed (gui-conf:gemini-quote-prefix) line)) (render-line (a:last-elt ir-rendered-lines)))
(:pre (:h1
(vector-push-extend (format nil "~%") ir-rendered-lines)) (push-prefixed (gui-conf:gemini-h1-prefix) line)
(:pre-end (render-line (a:last-elt ir-rendered-lines)))
(vector-push-extend (format nil "~%") ir-rendered-lines)) (:h2
(:a (push-prefixed (gui-conf:gemini-h1-prefix) line)
(linkify line)))))))) (render-line (a:last-elt ir-rendered-lines)))
(:h3
(push-prefixed (gui-conf:gemini-h1-prefix) line)
(render-line (a:last-elt ir-rendered-lines)))
(:li
(push-prefixed (gui-conf:gemini-bullet-prefix) line)
(render-line (a:last-elt ir-rendered-lines)))
(:quote
(push-prefixed (gui-conf:gemini-quote-prefix) line)
(render-line (a:last-elt ir-rendered-lines)))
(:pre
(vector-push-extend (format nil "") ir-rendered-lines)
(render-line (a:last-elt ir-rendered-lines)))
(:pre-end
(vector-push-extend (format nil "") ir-rendered-lines)
(render-line (a:last-elt ir-rendered-lines)))
(:a
(linkify line)
(gui:append-text gemtext-widget (a:last-elt ir-rendered-lines))
(gui:move-cursor-to-last-line gemtext-widget)
(gui:make-link-button gemtext-widget
(gui:raw-coordinates gemtext-widget)
(gui:make-indices-end)
link-font
link-fg
link-bg
(lambda () t))
(gui:append-line gemtext-widget ""))))))))))
(defun displace-gemini-response (response) (defun displace-gemini-response (response)
(values (getf response :status) (values (getf response :status)
@ -383,7 +410,7 @@
(gemtext-widget gemtext-widget)) object (gemtext-widget gemtext-widget)) object
(setf tool-bar (make-instance 'tool-bar :master object)) (setf tool-bar (make-instance 'tool-bar :master object))
(setf toc-frame (make-instance 'toc-frame :master object)) (setf toc-frame (make-instance 'toc-frame :master object))
(setf gemtext-widget (make-instance 'gui:scrolled-text :master object)) (setf gemtext-widget (make-instance 'gui:scrolled-text :master object :read-only t))
(setf info-frame (make-instance 'gui:frame :master object :relief :sunken :borderwidth 1)) (setf info-frame (make-instance 'gui:frame :master object :relief :sunken :borderwidth 1))
(setf info-text (make-instance 'gui:text :height 1 :wrap :none :master info-frame)) (setf info-text (make-instance 'gui:text :height 1 :wrap :none :master info-frame))
(gui:configure info-text :font gui:+tk-small-caption-font+) (gui:configure info-text :font gui:+tk-small-caption-font+)
@ -396,6 +423,7 @@
(gui:grid-columnconfigure object 1 :weight 1) (gui:grid-columnconfigure object 1 :weight 1)
(gui:grid-rowconfigure object 1 :weight 1) (gui:grid-rowconfigure object 1 :weight 1)
(setup-main-window-events object) (setup-main-window-events object)
(gui:focus (nodgui.mw:autocomplete-entry-widget (iri-entry (tool-bar object))))
object)) object))
(defun print-info-message (message &key (color (gui-goodies:parse-color "gray")) (bold nil)) (defun print-info-message (message &key (color (gui-goodies:parse-color "gray")) (bold nil))

7
src/package.lisp
View File

@ -3250,7 +3250,12 @@
:gemini-h3-prefix :gemini-h3-prefix
:gemini-bullet-prefix :gemini-bullet-prefix
:gemini-preformatted-fg :gemini-preformatted-fg
:gemini-toc-padding-char)) :gemini-link-colors
:gemini-quote-colors
:gemini-h1-colors
:gemini-h2-colors
:gemini-h3-colors
:gemini-preformatted-text-colors))
(defpackage :client-events (defpackage :client-events
(:use (:use