mirror of https://codeberg.org/cage/tinmop/
- [GUI] added new events for links
- button two will open the link in background; - button one pressed when simultaneously pressing the control button will add the link to the tour.
This commit is contained in:
parent
3e3f2b1f3c
commit
1e88fe5805
|
@ -521,18 +521,21 @@ local file paths."
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(inline-all-images main-window)))
|
(inline-all-images main-window)))
|
||||||
|
|
||||||
|
(defun enqueue-add-link-to-tour (link-value link-name)
|
||||||
|
(ev:with-enqueued-process-and-unblock ()
|
||||||
|
(comm:make-request :tour-add-link
|
||||||
|
1
|
||||||
|
link-value
|
||||||
|
link-name)
|
||||||
|
(print-info-message (format nil
|
||||||
|
(_ "~a added to tour")
|
||||||
|
(if (string-not-empty-p link-name)
|
||||||
|
link-name
|
||||||
|
link-value)))))
|
||||||
|
|
||||||
(defun contextual-menu-link-clrs (link-name link-value main-window)
|
(defun contextual-menu-link-clrs (link-name link-value main-window)
|
||||||
(labels ((add-to-tour-callback ()
|
(labels ((add-to-tour-callback ()
|
||||||
(ev:with-enqueued-process-and-unblock ()
|
(enqueue-add-link-to-tour link-value link-name))
|
||||||
(comm:make-request :tour-add-link
|
|
||||||
1
|
|
||||||
link-value
|
|
||||||
link-name)
|
|
||||||
(print-info-message (format nil
|
|
||||||
(_ "~a added to tour")
|
|
||||||
(if (string-not-empty-p link-name)
|
|
||||||
link-name
|
|
||||||
link-value)))))
|
|
||||||
(download-background-callback ()
|
(download-background-callback ()
|
||||||
(open-iri link-value main-window nil :status +stream-status-downloading+))
|
(open-iri link-value main-window nil :status +stream-status-downloading+))
|
||||||
(copy-link-callback ()
|
(copy-link-callback ()
|
||||||
|
@ -730,7 +733,11 @@ local file paths."
|
||||||
link-value)))
|
link-value)))
|
||||||
(new-text-line-start `(:line ,line-number :char 0)))
|
(new-text-line-start `(:line ,line-number :char 0)))
|
||||||
(gui:append-text gemtext-widget link-rendered-label)
|
(gui:append-text gemtext-widget link-rendered-label)
|
||||||
(let ((tag-link (gui:make-link-button gemtext-widget
|
(let* ((tag-link-other-bindings
|
||||||
|
(list (cons #$<Control-1>$
|
||||||
|
(lambda () (enqueue-add-link-to-tour target-iri
|
||||||
|
link-name)))))
|
||||||
|
(tag-link (gui:make-link-button gemtext-widget
|
||||||
new-text-line-start
|
new-text-line-start
|
||||||
`(- :end 1 :chars)
|
`(- :end 1 :chars)
|
||||||
link-font
|
link-font
|
||||||
|
@ -744,10 +751,18 @@ local file paths."
|
||||||
(contextual-menu-link-clrs link-name
|
(contextual-menu-link-clrs link-name
|
||||||
target-iri
|
target-iri
|
||||||
main-window)
|
main-window)
|
||||||
|
:button-2-callback
|
||||||
|
(lambda ()
|
||||||
|
(open-iri target-iri
|
||||||
|
main-window
|
||||||
|
nil
|
||||||
|
:status +stream-status-downloading+))
|
||||||
:over-callback
|
:over-callback
|
||||||
(lambda () (print-info-message target-iri))
|
(lambda () (print-info-message target-iri))
|
||||||
:leave-callback
|
:leave-callback
|
||||||
(lambda () (print-info-message "")))))
|
(lambda () (print-info-message ""))
|
||||||
|
:other-bindings
|
||||||
|
tag-link-other-bindings)))
|
||||||
(gui:tag-lower gemtext-widget tag-link)
|
(gui:tag-lower gemtext-widget tag-link)
|
||||||
(gui:append-line gemtext-widget "")))))))
|
(gui:append-line gemtext-widget "")))))))
|
||||||
(render-line (key text line-number &key (wrap :word))
|
(render-line (key text line-number &key (wrap :word))
|
||||||
|
|
Loading…
Reference in New Issue