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

- [GUI] implemented a feature to saving contet of a link to a file.

This commit is contained in:
cage 2023-07-12 15:08:47 +02:00
parent dc2b5da552
commit 45813f5317
2 changed files with 16 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -478,7 +478,14 @@
(if (inline-possible-p link-value) (if (inline-possible-p link-value)
(gui-goodies:with-busy* (main-window) (gui-goodies:with-busy* (main-window)
(inline-image main-window link-value line-number)) (inline-image main-window link-value line-number))
(funcall (link-click-mouse-1-callback-clsr link-value main-window)))))) (funcall (link-click-mouse-1-callback-clsr link-value main-window)))))
(save-link-as-callback ()
(a:when-let* ((output-file (gui:get-save-file :initial-dir "."
:parent main-window
:title (_ "Choose a file for saving")))
(input-file (gui-goodies:with-busy* (main-window)
(slurp-iri main-window link-value))))
(fs:copy-a-file input-file output-file :overwrite t))))
(lambda () (lambda ()
(let* ((popup-menu (gui:make-menu nil (_"link menu"))) (let* ((popup-menu (gui:make-menu nil (_"link menu")))
(x (gui:screen-mouse-x)) (x (gui:screen-mouse-x))
@ -490,9 +497,12 @@
(gui:make-menubutton popup-menu (gui:make-menubutton popup-menu
(_ "Inline") (_ "Inline")
(open-inline-clsr (gui:cursor-index (gemtext-widget main-window))))) (open-inline-clsr (gui:cursor-index (gemtext-widget main-window)))))
(gui:make-menubutton popup-menu (_ "Add link to bookmarks") #'bookmark-link-callback)
(gui:make-menubutton popup-menu (_ "Add link to tour") #'add-to-tour-callback) (gui:make-menubutton popup-menu (_ "Add link to tour") #'add-to-tour-callback)
(gui:make-menubutton popup-menu (_ "Copy link to the clipboard") #'copy-link-callback) (gui:make-menubutton popup-menu (_ "Copy link to the clipboard") #'copy-link-callback)
(gui:make-menubutton popup-menu (_ "Add link to bookmarks") #'bookmark-link-callback)
(when (or (gemini-client:absolute-gemini-url-p link-value)
(not (iri:absolute-url-p link-value)))
(gui:make-menubutton popup-menu (_ "Save link as…") #'save-link-as-callback))
(gui:make-menubutton popup-menu (gui:make-menubutton popup-menu
(_ "Open link in background") (_ "Open link in background")
#'download-background-callback) #'download-background-callback)

8
src/gui/client/titan-window.lisp
View File

@ -41,10 +41,10 @@
(when (string-empty-p (trim-blanks (gui:text (data-text titan-frame)))) (when (string-empty-p (trim-blanks (gui:text (data-text titan-frame))))
(a:when-let ((current-file-chosen (file-chosen titan-frame))) (a:when-let ((current-file-chosen (file-chosen titan-frame)))
(setf initial-dir (fs:parent-dir-path current-file-chosen))) (setf initial-dir (fs:parent-dir-path current-file-chosen)))
(let ((new-file-path (gui:get-open-file :initial-dir initial-dir (a:when-let ((new-file-path (gui:get-open-file :initial-dir initial-dir
:parent titan-frame :parent titan-frame
:multiple nil :multiple nil
:title (_ "Choose the file")))) :title (_ "Choose the file"))))
(setf (file-chosen titan-frame) new-file-path (setf (file-chosen titan-frame) new-file-path
(gui:text (file-choose-button titan-frame)) new-file-path))))) (gui:text (file-choose-button titan-frame)) new-file-path)))))