mirror of https://codeberg.org/cage/tinmop/
- [GUI] rendered links;
- [GUI] started with focus on the address text entry.
This commit is contained in:
cage
parent
9e7feacf8e
commit
c546b47fd4
|
|
@ -14,8 +14,13 @@
|
|||
|
||||
(a:define-constant +font-h3+ "bold" :test #'string=)
|
||||
|
||||
(defun parse-color (name)
|
||||
(nodgui.utils:rgb->tk (cl-colors2:as-rgb name)))
|
||||
(defgeneric parse-color (object))
|
||||
|
||||
(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)
|
||||
(gui:font-create (nodgui.utils:create-name)
|
||||
|
|
|
|||
|
|
@ -192,55 +192,82 @@
|
|||
|
||||
(defun collect-ir-lines (main-window lines)
|
||||
(with-accessors ((ir-lines ir-lines)
|
||||
(ir-rendered-lines ir-rendered-lines)) main-window
|
||||
(flet ((push-prefixed (prefix ir)
|
||||
(let ((raw-line (format nil "~a~a" prefix (ir-line ir))))
|
||||
(vector-push-extend raw-line ir-rendered-lines)))
|
||||
(linkify (line)
|
||||
(let* ((link-name (ir-line line))
|
||||
(link-value (ir-href line))
|
||||
(prefix-gemini (gui-conf:gemini-link-prefix-to-gemini))
|
||||
(prefix-www (gui-conf:gemini-link-prefix-to-http))
|
||||
(prefix-other (gui-conf:gemini-link-prefix-to-other))
|
||||
(link-text (if (text-utils:starting-emoji link-name)
|
||||
(format nil
|
||||
"~a~a"
|
||||
(trim-blanks prefix-other)
|
||||
link-name)
|
||||
(cond
|
||||
((gemini-parser::gemini-link-iri-p link-value)
|
||||
(format nil "~a~a" prefix-gemini link-name))
|
||||
((html-utils::http-link-iri-p link-value)
|
||||
(format nil "~a~a" prefix-www link-name))
|
||||
(t
|
||||
(format nil "~a~a" prefix-other link-name))))))
|
||||
(vector-push-extend link-text ir-rendered-lines))))
|
||||
(loop for line in lines do
|
||||
(vector-push-extend line ir-lines)
|
||||
(let ((type (ir-type line)))
|
||||
(ecase (format-keyword type)
|
||||
(:vertical-space
|
||||
(vector-push-extend (format nil "~%") ir-rendered-lines))
|
||||
(:as-is
|
||||
(vector-push-extend (ir-line line) ir-rendered-lines))
|
||||
(:text
|
||||
(vector-push-extend (ir-line line) ir-rendered-lines))
|
||||
(:h1
|
||||
(push-prefixed (gui-conf:gemini-h1-prefix) line))
|
||||
(:h2
|
||||
(push-prefixed (gui-conf:gemini-h1-prefix) line))
|
||||
(:h3
|
||||
(push-prefixed (gui-conf:gemini-h1-prefix) line))
|
||||
(:li
|
||||
(push-prefixed (gui-conf:gemini-bullet-prefix) line))
|
||||
(:quote
|
||||
(push-prefixed (gui-conf:gemini-quote-prefix) line))
|
||||
(:pre
|
||||
(vector-push-extend (format nil "~%") ir-rendered-lines))
|
||||
(:pre-end
|
||||
(vector-push-extend (format nil "~%") ir-rendered-lines))
|
||||
(:a
|
||||
(linkify line))))))))
|
||||
(ir-rendered-lines ir-rendered-lines)
|
||||
(gemtext-widget gemtext-widget)) main-window
|
||||
(labels ((push-prefixed (prefix ir)
|
||||
(let ((raw-line (format nil "~a~a" prefix (ir-line ir))))
|
||||
(vector-push-extend raw-line ir-rendered-lines)))
|
||||
(linkify (line)
|
||||
(let* ((link-value (ir-href line))
|
||||
(link-name (or (ir-line line)
|
||||
link-value))
|
||||
(prefix-gemini (gui-conf:gemini-link-prefix-to-gemini))
|
||||
(prefix-www (gui-conf:gemini-link-prefix-to-http))
|
||||
(prefix-other (gui-conf:gemini-link-prefix-to-other))
|
||||
(link-text (if (text-utils:starting-emoji link-name)
|
||||
(format nil
|
||||
"~a~a"
|
||||
(trim-blanks prefix-other)
|
||||
link-name)
|
||||
(cond
|
||||
((gemini-parser::gemini-link-iri-p link-value)
|
||||
(format nil "~a~a" prefix-gemini link-name))
|
||||
((html-utils::http-link-iri-p link-value)
|
||||
(format nil "~a~a" prefix-www link-name))
|
||||
(t
|
||||
(format nil "~a~a" prefix-other link-name))))))
|
||||
(vector-push-extend link-text ir-rendered-lines)))
|
||||
(render-line (text)
|
||||
(gui:append-line gemtext-widget text)))
|
||||
(let ((link-font (gui-conf:gemini-link-font-configuration)))
|
||||
(multiple-value-bind (link-bg link-fg)
|
||||
(gui-conf:gemini-link-colors)
|
||||
(loop for line in lines do
|
||||
(vector-push-extend line ir-lines)
|
||||
(let ((type (ir-type line)))
|
||||
(ecase (format-keyword type)
|
||||
(:vertical-space
|
||||
(vector-push-extend (format nil "") ir-rendered-lines)
|
||||
(render-line (a:last-elt ir-rendered-lines)))
|
||||
(:as-is
|
||||
(vector-push-extend (ir-line line) ir-rendered-lines)
|
||||
(render-line (a:last-elt ir-rendered-lines)))
|
||||
(:text
|
||||
(vector-push-extend (ir-line line) ir-rendered-lines)
|
||||
(render-line (a:last-elt ir-rendered-lines)))
|
||||
(:h1
|
||||
(push-prefixed (gui-conf:gemini-h1-prefix) line)
|
||||
(render-line (a:last-elt ir-rendered-lines)))
|
||||
(:h2
|
||||
(push-prefixed (gui-conf:gemini-h1-prefix) 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)
|
||||
(values (getf response :status)
|
||||
|
|
@ -383,7 +410,7 @@
|
|||
(gemtext-widget gemtext-widget)) object
|
||||
(setf tool-bar (make-instance 'tool-bar :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-text (make-instance 'gui:text :height 1 :wrap :none :master info-frame))
|
||||
(gui:configure info-text :font gui:+tk-small-caption-font+)
|
||||
|
|
@ -396,6 +423,7 @@
|
|||
(gui:grid-columnconfigure object 1 :weight 1)
|
||||
(gui:grid-rowconfigure object 1 :weight 1)
|
||||
(setup-main-window-events object)
|
||||
(gui:focus (nodgui.mw:autocomplete-entry-widget (iri-entry (tool-bar object))))
|
||||
object))
|
||||
|
||||
(defun print-info-message (message &key (color (gui-goodies:parse-color "gray")) (bold nil))
|
||||
|
|
|
|||
|
|
@ -3250,7 +3250,12 @@
|
|||
:gemini-h3-prefix
|
||||
:gemini-bullet-prefix
|
||||
: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
|
||||
(:use
|
||||
|
|
|
|||
Loading…
Reference in New Issue