mirror of
https://codeberg.org/cage/tinmop/
synced 2025-02-17 08:10:36 +01:00
- [GUI] transformed relative IRI to absolute in the rendered gemtext;
[GUI] printed IRI on the info-bar when moving cursor over links in the rendered gemtext.
This commit is contained in:
cage
parent
fd19aa8704
commit
d6fdf00253
@ -286,24 +286,24 @@
|
||||
(iri:make-iri nil nil nil nil link-value nil nil))))
|
||||
(cond
|
||||
((null (uri:host parsed))
|
||||
(let* ((absolute-path-p (string-starts-with-p "/" link-value))
|
||||
(query-path-p (uri:query parsed))
|
||||
(path (cond
|
||||
(absolute-path-p
|
||||
(uri:path parsed))
|
||||
((and query-path-p
|
||||
original-query)
|
||||
(strcat (safe-all-but-last-elt original-path)
|
||||
(uri:path parsed)))
|
||||
((or query-path-p
|
||||
original-query)
|
||||
(strcat original-path
|
||||
(uri:path parsed)))
|
||||
(t
|
||||
(strcat (if original-path
|
||||
(path-last-dir original-path)
|
||||
"/")
|
||||
(uri:path parsed))))))
|
||||
(let* ((absolute-path-p (string-starts-with-p "/" link-value))
|
||||
(query-path-p (uri:query parsed))
|
||||
(path (cond
|
||||
(absolute-path-p
|
||||
(uri:path parsed))
|
||||
((and query-path-p
|
||||
original-query)
|
||||
(strcat (safe-all-but-last-elt original-path)
|
||||
(uri:path parsed)))
|
||||
((or query-path-p
|
||||
original-query)
|
||||
(strcat original-path
|
||||
(uri:path parsed)))
|
||||
(t
|
||||
(strcat (if original-path
|
||||
(path-last-dir original-path)
|
||||
"/")
|
||||
(uri:path parsed))))))
|
||||
(make-gemini-iri original-host
|
||||
(fs:normalize-path path)
|
||||
:query (uri:query parsed)
|
||||
|
||||
@ -62,8 +62,8 @@
|
||||
(defun find-db-stream-url (url)
|
||||
(find-db-stream-if (lambda (a) (string= (server-stream-handle a) url))))
|
||||
|
||||
(defun notify-request-error (message)
|
||||
(gui-goodies:error-dialog gui-goodies:*toplevel* message))
|
||||
(defun notify-request-error (error)
|
||||
(gui-goodies:error-dialog gui-goodies:*toplevel* error))
|
||||
|
||||
(defmacro with-notify-errors (&body body)
|
||||
`(handler-case
|
||||
@ -134,8 +134,8 @@
|
||||
(defun initialize-menu (parent)
|
||||
(with-accessors ((main-window main-window)) parent
|
||||
(let* ((bar (gui:make-menubar parent))
|
||||
(file (gui:make-menu bar (_ "File") :underline 0))
|
||||
(help (gui:make-menu bar (_ "Help") :underline 0)))
|
||||
(file (gui:make-menu bar (_ "File") :underline 0))
|
||||
(help (gui:make-menu bar (_ "Help") :underline 0)))
|
||||
(gui:make-menubutton file (_ "Quit") #'menu:quit :underline 0)
|
||||
(gui:make-menubutton help (_ "About") #'menu:help-about :underline 0))))
|
||||
|
||||
@ -197,7 +197,7 @@
|
||||
(lambda ()
|
||||
(open-iri link-value main-window use-cache)))
|
||||
|
||||
(defun collect-ir-lines (main-window lines)
|
||||
(defun collect-ir-lines (request-iri main-window lines)
|
||||
(with-accessors ((ir-lines ir-lines)
|
||||
(ir-rendered-lines ir-rendered-lines)
|
||||
(gemtext-widget gemtext-widget)) main-window
|
||||
@ -256,11 +256,24 @@
|
||||
(gui-conf:gemini-quote-justification))
|
||||
(:pre
|
||||
(gui-conf:gemini-preformatted-text-justification))))
|
||||
(absolutize-link (link-value)
|
||||
(if (iri:absolute-url-p link-value)
|
||||
link-value
|
||||
(let ((parsed-request-iri (iri:iri-parse request-iri)))
|
||||
(multiple-value-bind (x host path query port y w z)
|
||||
(gemini-client:displace-iri parsed-request-iri)
|
||||
(declare (ignore x y w z))
|
||||
(gemini-parser:absolutize-link link-value
|
||||
host
|
||||
port
|
||||
path
|
||||
query)))))
|
||||
(linkify (line line-number)
|
||||
(multiple-value-bind (link-bg link-fg)
|
||||
(gui-conf:gemini-link-colors)
|
||||
(let* ((link-font (gui-conf:gemini-link-font-configuration))
|
||||
(link-value (ir-href line))
|
||||
(target-iri (absolutize-link link-value))
|
||||
(link-name (or (ir-line line)
|
||||
link-value))
|
||||
(prefix-gemini (gui-conf:gemini-link-prefix-to-gemini))
|
||||
@ -287,7 +300,13 @@
|
||||
link-font
|
||||
link-fg
|
||||
link-bg
|
||||
(link-click-mouse-1-callback link-value main-window))
|
||||
(link-click-mouse-1-callback target-iri
|
||||
main-window)
|
||||
:over-callback
|
||||
(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))
|
||||
@ -316,54 +335,54 @@
|
||||
with starting-pre-block-line = -1
|
||||
with ending-pre-block-line = -1
|
||||
with current-pre-block-alt-text = nil
|
||||
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)
|
||||
(incf render-line-count)
|
||||
(render-line :vertical-space (a:last-elt ir-rendered-lines) render-line-count))
|
||||
(:as-is
|
||||
(vector-push-extend (ir-line line) ir-rendered-lines)
|
||||
(incf render-line-count)
|
||||
(render-line :as-is (a:last-elt ir-rendered-lines) render-line-count))
|
||||
(:text
|
||||
(vector-push-extend (ir-line line) ir-rendered-lines)
|
||||
(incf render-line-count)
|
||||
(render-line :text (a:last-elt ir-rendered-lines) render-line-count))
|
||||
(:h1
|
||||
(push-prefixed (gui-conf:gemini-h1-prefix) line)
|
||||
(incf render-line-count)
|
||||
(render-line :h1 (a:last-elt ir-rendered-lines) render-line-count))
|
||||
(:h2
|
||||
(push-prefixed (gui-conf:gemini-h1-prefix) line)
|
||||
(incf render-line-count)
|
||||
(render-line :h2 (a:last-elt ir-rendered-lines) render-line-count))
|
||||
(:h3
|
||||
(push-prefixed (gui-conf:gemini-h1-prefix) line)
|
||||
(incf render-line-count)
|
||||
(render-line :h3 (a:last-elt ir-rendered-lines) render-line-count))
|
||||
(:li
|
||||
(push-prefixed (gui-conf:gemini-bullet-prefix) line)
|
||||
(incf render-line-count)
|
||||
(render-line :li (a:last-elt ir-rendered-lines) render-line-count))
|
||||
(:quote
|
||||
(push-prefixed (gui-conf:gemini-quote-prefix) line)
|
||||
(incf render-line-count)
|
||||
(render-line :quote (a:last-elt ir-rendered-lines) render-line-count))
|
||||
(:pre
|
||||
(vector-push-extend (format nil "") ir-rendered-lines)
|
||||
(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))
|
||||
(render-line :pre-end (a:last-elt ir-rendered-lines) render-line-count))
|
||||
(:a
|
||||
(incf render-line-count)
|
||||
(linkify line render-line-count))))))))
|
||||
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)
|
||||
(incf render-line-count)
|
||||
(render-line :vertical-space (a:last-elt ir-rendered-lines) render-line-count))
|
||||
(:as-is
|
||||
(vector-push-extend (ir-line line) ir-rendered-lines)
|
||||
(incf render-line-count)
|
||||
(render-line :as-is (a:last-elt ir-rendered-lines) render-line-count))
|
||||
(:text
|
||||
(vector-push-extend (ir-line line) ir-rendered-lines)
|
||||
(incf render-line-count)
|
||||
(render-line :text (a:last-elt ir-rendered-lines) render-line-count))
|
||||
(:h1
|
||||
(push-prefixed (gui-conf:gemini-h1-prefix) line)
|
||||
(incf render-line-count)
|
||||
(render-line :h1 (a:last-elt ir-rendered-lines) render-line-count))
|
||||
(:h2
|
||||
(push-prefixed (gui-conf:gemini-h1-prefix) line)
|
||||
(incf render-line-count)
|
||||
(render-line :h2 (a:last-elt ir-rendered-lines) render-line-count))
|
||||
(:h3
|
||||
(push-prefixed (gui-conf:gemini-h1-prefix) line)
|
||||
(incf render-line-count)
|
||||
(render-line :h3 (a:last-elt ir-rendered-lines) render-line-count))
|
||||
(:li
|
||||
(push-prefixed (gui-conf:gemini-bullet-prefix) line)
|
||||
(incf render-line-count)
|
||||
(render-line :li (a:last-elt ir-rendered-lines) render-line-count))
|
||||
(:quote
|
||||
(push-prefixed (gui-conf:gemini-quote-prefix) line)
|
||||
(incf render-line-count)
|
||||
(render-line :quote (a:last-elt ir-rendered-lines) render-line-count))
|
||||
(:pre
|
||||
(vector-push-extend (format nil "") ir-rendered-lines)
|
||||
(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))
|
||||
(render-line :pre-end (a:last-elt ir-rendered-lines) render-line-count))
|
||||
(:a
|
||||
(incf render-line-count)
|
||||
(linkify line render-line-count))))))))
|
||||
|
||||
(defun displace-gemini-response (response)
|
||||
(values (getf response :status)
|
||||
@ -375,9 +394,11 @@
|
||||
(defun open-iri (iri main-window use-cache)
|
||||
(handler-case
|
||||
(let ((parsed-iri (iri:iri-parse iri)))
|
||||
(if (string= (uri:scheme parsed-iri)
|
||||
gemini-constants:+gemini-scheme+)
|
||||
(start-stream-iri iri main-window use-cache)
|
||||
(if (iri:absolute-url-p iri)
|
||||
(if (string= (uri:scheme parsed-iri)
|
||||
gemini-constants:+gemini-scheme+)
|
||||
(start-stream-iri iri main-window use-cache)
|
||||
(progn))
|
||||
(progn)))
|
||||
(error (e)
|
||||
#+debug-mode (misc:dbg "error quen getting iri from autocomplete ~a" e)
|
||||
@ -400,7 +421,7 @@
|
||||
(start-streaming-thread iri
|
||||
:use-cache nil
|
||||
:process-function (lambda (lines)
|
||||
(collect-ir-lines main-window lines)
|
||||
(collect-ir-lines iri main-window lines)
|
||||
(misc:dbg "lines ~a" lines))
|
||||
:status status))))))
|
||||
|
||||
@ -538,7 +559,9 @@
|
||||
(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))
|
||||
(defun print-info-message (message &key
|
||||
(color (gui-goodies:parse-color "black"))
|
||||
(bold nil))
|
||||
(let ((info-widget (info-text gui-goodies:*main-frame*)))
|
||||
(setf (gui:text info-widget) message)
|
||||
(let ((color-tag (gui:tag-create info-widget
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user