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)
(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 ((iri-entry iri-entry)) tool-bar
(lambda ()
(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)
(let ((parsed-request-iri (iri:iri-parse request-iri)))
@ -296,7 +299,8 @@
query))))
(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 ()
(let* ((popup-menu (gui:make-menu nil (_"link menu")))
(add-to-tour-button (gui:make-menubutton popup-menu
@ -306,9 +310,13 @@
(comm:make-request :tour-add-link
1
link-value
link-name))))))
(declare (ignore add-to-tour-button))
(gui:popup popup-menu (gui:screen-mouse-x) (gui:screen-mouse-y)))))
link-name)))))
(background-open (gui:make-menubutton popup-menu
(_ "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)
(with-accessors ((ir-lines ir-lines)
@ -529,12 +537,12 @@
(clean-gemtext main-window)
(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
(let ((parsed-iri (iri:iri-parse iri)))
(cond
((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))
(string= (uri:scheme parsed-iri)
constants:+file-scheme+))
@ -691,7 +699,10 @@
(slurp-non-text-data main-window iri))))
((eq status +stream-status-downloading+)
(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
(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)))
(let* ((url (gui:id selection))
(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)
(gui:with-toplevel (toplevel :master master :title (_ "Streams"))