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

- [GUI] added contextual menu command for opening link in background.

This commit is contained in:
cage 2023-04-13 17:54:54 +02:00
parent c07ccb054f
commit 7543b84005
2 changed files with 31 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -277,12 +277,15 @@
(gen-ir-access pre-alt-text) (gen-ir-access pre-alt-text)
(defun link-click-mouse-1-callback-clsr (link-value main-window &key (use-cache t)) (defun link-click-mouse-1-callback-clsr (link-value main-window
&key
(use-cache t)
(status +stream-status-streaming+))
(with-accessors ((tool-bar tool-bar)) main-window (with-accessors ((tool-bar tool-bar)) main-window
(with-accessors ((iri-entry iri-entry)) tool-bar (with-accessors ((iri-entry iri-entry)) tool-bar
(lambda () (lambda ()
(setf (gui:text iri-entry) link-value) (setf (gui:text iri-entry) link-value)
(open-iri link-value main-window use-cache))))) (open-iri link-value main-window use-cache :status status)))))
(defun absolutize-link (request-iri link-value) (defun absolutize-link (request-iri link-value)
(let ((parsed-request-iri (iri:iri-parse request-iri))) (let ((parsed-request-iri (iri:iri-parse request-iri)))
@ -296,7 +299,8 @@
query)))) query))))
(defun contextual-menu-link-clrs (link-name link-value main-window) (defun contextual-menu-link-clrs (link-name link-value main-window)
(declare (ignore main-window)) (flet ((download-background-callback ()
(open-iri link-value main-window nil :status +stream-status-downloading+)))
(lambda () (lambda ()
(let* ((popup-menu (gui:make-menu nil (_"link menu"))) (let* ((popup-menu (gui:make-menu nil (_"link menu")))
(add-to-tour-button (gui:make-menubutton popup-menu (add-to-tour-button (gui:make-menubutton popup-menu
@ -306,9 +310,13 @@
(comm:make-request :tour-add-link (comm:make-request :tour-add-link
1 1
link-value link-value
link-name)))))) link-name)))))
(declare (ignore add-to-tour-button)) (background-open (gui:make-menubutton popup-menu
(gui:popup popup-menu (gui:screen-mouse-x) (gui:screen-mouse-y))))) (_ "Open link in background")
#'download-background-callback)))
(declare (ignore add-to-tour-button
background-open))
(gui:popup popup-menu (gui:screen-mouse-x) (gui:screen-mouse-y))))))
(defun collect-ir-lines (request-iri main-window lines) (defun collect-ir-lines (request-iri main-window lines)
(with-accessors ((ir-lines ir-lines) (with-accessors ((ir-lines ir-lines)
@ -529,12 +537,12 @@
(clean-gemtext main-window) (clean-gemtext main-window)
(collect-ir-lines links-path-prefix gui-goodies:*main-frame* parsed-lines))) (collect-ir-lines links-path-prefix gui-goodies:*main-frame* parsed-lines)))
(defun open-iri (iri main-window use-cache) (defun open-iri (iri main-window use-cache &key (status +stream-status-streaming+))
(handler-case (handler-case
(let ((parsed-iri (iri:iri-parse iri))) (let ((parsed-iri (iri:iri-parse iri)))
(cond (cond
((gemini-parser:gemini-iri-p iri) ((gemini-parser:gemini-iri-p iri)
(start-stream-iri iri main-window use-cache)) (start-stream-iri iri main-window use-cache status))
((or (null (uri:scheme parsed-iri)) ((or (null (uri:scheme parsed-iri))
(string= (uri:scheme parsed-iri) (string= (uri:scheme parsed-iri)
constants:+file-scheme+)) constants:+file-scheme+))
@ -691,7 +699,10 @@
(slurp-non-text-data main-window iri)))) (slurp-non-text-data main-window iri))))
((eq status +stream-status-downloading+) ((eq status +stream-status-downloading+)
(when (not (find-db-stream-url iri)) (when (not (find-db-stream-url iri))
(enqueue-request-notify-error :gemini-request 1 iri use-cache))) (let ((background-stream (make-instance 'gemini-stream
:server-stream-handle iri
:status status)))
(push-db-stream background-stream))))
(t (t
(error "Unrecognized stream status for address ~s: ~s" iri status)))))))) (error "Unrecognized stream status for address ~s: ~s" iri status))))))))

4
src/gui/client/stream-window.lisp
View File

@ -66,8 +66,8 @@
(selection (first selections))) (selection (first selections)))
(let* ((url (gui:id selection)) (let* ((url (gui:id selection))
(new-rows (all-rows))) (new-rows (all-rows)))
(resync-rows stream-frame new-rows) (client-main-window::open-iri url gui-goodies:*main-frame* t)
(client-main-window::open-iri url gui-goodies:*main-frame* t))))) (resync-rows stream-frame new-rows)))))
(defun init-window (master) (defun init-window (master)
(gui:with-toplevel (toplevel :master master :title (_ "Streams")) (gui:with-toplevel (toplevel :master master :title (_ "Streams"))