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

- captured error that could happens when making a image mosaic from a gemini page.

This commit is contained in:
cage 2022-12-11 12:59:41 +01:00
parent 3145ee8263
commit 7924136282
1 changed files with 40 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
src/ui-goodies.lisp
View File

@ -1503,7 +1503,7 @@ It an existing file path is provided the command will refuse to run."
"Generate an image formed that contains all the images linked to a "Generate an image formed that contains all the images linked to a
gemini page and arranged in a grid layout, the resulting image is then gemini page and arranged in a grid layout, the resulting image is then
displayed using the standard image viewer installed on the system." displayed using the standard image viewer installed on the system."
#+montage-bin #+montage-bin
(when-let* ((window *message-window*) (when-let* ((window *message-window*)
(metadata (message-window:metadata window)) (metadata (message-window:metadata window))
(links (gemini-viewer:gemini-metadata-links metadata)) (links (gemini-viewer:gemini-metadata-links metadata))
@ -1526,43 +1526,48 @@ displayed using the standard image viewer installed on the system."
(map nil (map nil
(lambda (file uri) (lambda (file uri)
(with-enqueued-process () (with-enqueued-process ()
(let ((data (gemini-client:slurp-gemini-url (gemini-parser:target uri)))) (tui:with-notify-errors
(info-message (format nil (_ "downloaded: ~a") (gemini-parser:target uri)) (let ((data (gemini-client:slurp-gemini-url (gemini-parser:target uri))))
program-events:+maximum-event-priority+) (info-message (format nil (_ "downloaded: ~a") (gemini-parser:target uri))
(with-open-file (stream file program-events:+maximum-event-priority+)
:direction :output (with-open-file (stream file
:if-does-not-exist :error :direction :output
:if-exists :supersede :if-does-not-exist :error
:element-type filesystem-tree-window:+octect-type+) :if-exists :supersede
(write-sequence data stream))))) :element-type filesystem-tree-window:+octect-type+)
(write-sequence data stream))))))
files files
images-uris) images-uris)
(with-enqueued-process () (with-enqueued-process ()
(let* ((command-line (flatten (list "-title" (gemini-viewer:current-gemini-url) (tui:with-notify-errors
"-frame" "5" (let ((error-message (misc:make-fresh-array 0 #\a 'character nil)))
"-geometry" (with-output-to-string (error-stream error-message)
(swconf:config-gemini-images-montage-geometry) (let* ((command-line (flatten (list "-title" (gemini-viewer:current-gemini-url)
"-tile" "-frame" "5"
(swconf:config-gemini-images-montage-tile) "-geometry"
"-background" "Grey" (swconf:config-gemini-images-montage-geometry)
"-bordercolor" "SkyBlue" "-tile"
"-mattecolor" "Lavender" (swconf:config-gemini-images-montage-tile)
"-pointsize" "12" "-background" "Grey"
(loop for name in names "-bordercolor" "SkyBlue"
for file in files "-mattecolor" "Lavender"
collect "-font" "Sans"
(list "-label" name file)) "-pointsize" "12"
"-"))) (loop for name in names
(process (os-utils:run-external-program +montage-bin+ for file in files
command-line collect
:search t (list "-label" name file))
:wait t "-")))
:input t (process (os-utils:run-external-program +montage-bin+
:output output-file command-line
:error t))) :search t
(if (not (os-utils:process-exit-success-p process)) :wait t
(error-message (_ "Error during images montage.")) :input t
(os-utils:xdg-open output-file))))) :output output-file
:error error-stream)))
(if (not (os-utils:process-exit-success-p process))
(error-message (format nil (_ "Error during images montage: ~a.") error-message))
(os-utils:xdg-open output-file))))))))
#-montage-bin #-montage-bin
(notify (_ "ImageMagick binaries not found on this system") :as-error t)) (notify (_ "ImageMagick binaries not found on this system") :as-error t))