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

- [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:
cage 2023-10-29 12:41:17 +01:00
parent 3e3f2b1f3c
commit 1e88fe5805
1 changed files with 27 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -521,8 +521,7 @@ local file paths."
(lambda ()
(inline-all-images main-window)))
(defun contextual-menu-link-clrs (link-name link-value main-window)
(labels ((add-to-tour-callback ()
(defun enqueue-add-link-to-tour (link-value link-name)
(ev:with-enqueued-process-and-unblock ()
(comm:make-request :tour-add-link
1
@ -533,6 +532,10 @@ local file paths."
(if (string-not-empty-p link-name)
link-name
link-value)))))
(defun contextual-menu-link-clrs (link-name link-value main-window)
(labels ((add-to-tour-callback ()
(enqueue-add-link-to-tour link-value link-name))
(download-background-callback ()
(open-iri link-value main-window nil :status +stream-status-downloading+))
(copy-link-callback ()
@ -730,7 +733,11 @@ local file paths."
link-value)))
(new-text-line-start `(:line ,line-number :char 0)))
(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
`(- :end 1 :chars)
link-font
@ -744,10 +751,18 @@ local file paths."
(contextual-menu-link-clrs link-name
target-iri
main-window)
:button-2-callback
(lambda ()
(open-iri target-iri
main-window
nil
:status +stream-status-downloading+))
:over-callback
(lambda () (print-info-message target-iri))
:leave-callback
(lambda () (print-info-message "")))))
(lambda () (print-info-message ""))
:other-bindings
tag-link-other-bindings)))
(gui:tag-lower gemtext-widget tag-link)
(gui:append-line gemtext-widget "")))))))
(render-line (key text line-number &key (wrap :word))