1
0
Fork 0

- added command 'gemini-images-montage'.

This commit is contained in:
cage 2022-12-10 14:11:13 +01:00
parent 9efb99b234
commit c8b92f7eba
8 changed files with 146 additions and 9 deletions

View File

@ -312,6 +312,7 @@ LTLIBOBJS = @LTLIBOBJS@
MAKEINFO = @MAKEINFO@
MAN = @MAN@
MKDIR_P = @MKDIR_P@
MONTAGE = @MONTAGE@
MSGFMT = @MSGFMT@
MSGFMT_015 = @MSGFMT_015@
MSGMERGE = @MSGMERGE@

59
configure vendored
View File

@ -621,6 +621,7 @@ ac_subst_vars='am__EXEEXT_FALSE
am__EXEEXT_TRUE
LTLIBOBJS
LIBOBJS
MONTAGE
DIRNAME
CHMOD
GIT
@ -7624,6 +7625,64 @@ if test "$DIRNAME" = "no" ; then
exit 1;
fi
for ac_prog in montage
do
# Extract the first word of "$ac_prog", so it can be a program name with args.
set dummy $ac_prog; ac_word=$2
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
printf %s "checking for $ac_word... " >&6; }
if test ${ac_cv_path_MONTAGE+y}
then :
printf %s "(cached) " >&6
else $as_nop
case $MONTAGE in
[\\/]* | ?:[\\/]*)
ac_cv_path_MONTAGE="$MONTAGE" # Let the user override the test with a path.
;;
*)
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
case $as_dir in #(((
'') as_dir=./ ;;
*/) ;;
*) as_dir=$as_dir/ ;;
esac
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then
ac_cv_path_MONTAGE="$as_dir$ac_word$ac_exec_ext"
printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
;;
esac
fi
MONTAGE=$ac_cv_path_MONTAGE
if test -n "$MONTAGE"; then
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $MONTAGE" >&5
printf "%s\n" "$MONTAGE" >&6; }
else
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
fi
test -n "$MONTAGE" && break
done
test -n "$MONTAGE" || MONTAGE="no"
if test "$MONTAGE" = "no" ; then
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: Can not find imagemagick 'montage' executable." >&5
printf "%s\n" "$as_me: WARNING: Can not find imagemagick 'montage' executable." >&2;}
exit 1;
fi

View File

@ -123,6 +123,13 @@ if test "$DIRNAME" = "no" ; then
exit 1;
fi
AC_PATH_PROGS([MONTAGE],[montage],[no])
if test "$MONTAGE" = "no" ; then
AC_MSG_WARN([Can not find imagemagick 'montage' executable.])
exit 1;
fi
AC_PROG_MKDIR_P
dnl checks for libraries

View File

@ -482,6 +482,8 @@
(define-key "C-[" #'go-to-previous-link *gemini-message-keymap*)
(define-key "I M" #'gemini-images-montage *gemini-message-keymap*)
;; gemini page table of contents keymap
(define-key "up" #'gemini-toc-scroll-up *gemini-toc-keymap*)

View File

@ -19,7 +19,9 @@
(alexandria:define-constant +unzip-bin+ "@UNZIP@" :test #'string=)
(alexandria:define-constant +man-bin+ "@MAN@" :test #'string=)
(alexandria:define-constant +man-bin+ "@MAN@" :test #'string=)
(alexandria:define-constant +montage-bin+ "@MONTAGE@" :test #'string=)
(eval-when (:compile-toplevel :load-toplevel :execute)
@ -30,7 +32,9 @@
(allow-features +unzip-bin+ :gempub-support)
(allow-features +man-bin+ :man-bin))
(allow-features +man-bin+ :man-bin)
(allow-features +montage-bin+ :montage-bin))
(defmacro with-return-untranslated ((untranslated) &body body)
`(handler-bind ((i18n-conditions:no-translation-table-error

View File

@ -79,7 +79,9 @@
search
input
output
(error :output))
(error :output)
#+sbcl (if-output-exists :supersede)
#+sbcl (if-error-exists :supersede))
(declare (ignorable search))
#+ecl (ext:run-program program
args
@ -88,12 +90,14 @@
:error error
:wait wait)
#+sbcl (sb-ext:run-program program
args
:wait wait
:search search
:input input
:output output
:error error))
args
:wait wait
:search search
:input input
:output output
:error error
:if-output-exists if-output-exists
:if-error-exists if-error-exists))
(defun process-exit-code (process)
#+ecl (nth-value 1 (ext:external-process-status process))

View File

@ -36,6 +36,7 @@
:+xdg-open-bin+
:+unzip-bin+
:+man-bin+
:+montage-bin+
:_
:n_))
@ -2799,6 +2800,7 @@
:search-link-window
:open-gemini-message-link-window
:open-message-link
:gemini-images-montage
:open-message-link-go-up
:open-message-link-go-down
:open-message-link-perform-opening

View File

@ -1496,6 +1496,64 @@ It an existing file path is provided the command will refuse to run."
:enqueue enqueue
:links links)))
(define-constant +image-link-extension-re+ "(?i)(\\.jpg$)|(\\.bmp$)|(\\.png$)|(\\.tiff$)|(\\.tga$)|(\\.ps$)|(\\.svg)|(\\.pcx)"
:test #'string=)
(defun gemini-images-montage ()
#+montage-bin
(when-let* ((window *message-window*)
(metadata (message-window:metadata window))
(links (gemini-viewer:gemini-metadata-links metadata))
(images-uris (remove-if-not (lambda (a) (cl-ppcre:scan +image-link-extension-re+
(gemini-parser:target a)))
links))
(images-count (length images-uris))
(name-padding (num:count-digit images-count))
(name-format (format nil (_"\"Figure: ~~~d,'0d\"") name-padding))
(names (loop for ct from 1 below (1+ images-count)
collect
(format nil name-format ct)))
(files (loop for ct from 0 below images-count
collect
(fs:temporary-file :extension ".bitmap")))
(output-file (fs:temporary-file)))
(loop for file in files
for uri in images-uris
do
(let ((data (gemini-client:slurp-gemini-url (gemini-parser:target uri))))
(with-open-file (stream file
:direction :output
:if-does-not-exist :error
:if-exists :supersede
:element-type filesystem-tree-window:+octect-type+)
(write-sequence data stream))))
(let* ((command-line (flatten (list "-title" (gemini-viewer:current-gemini-url)
"-frame" "5"
"-geometry" "320x320"
"-tile" "x4"
"-background" "Grey"
"-bordercolor" "SkyBlue"
"-mattecolor" "Lavender"
"-font" "Arial"
"-pointsize" "12"
(loop for name in names
for file in files
collect
(list "-label" name file))
"-")))
(process (os-utils:run-external-program +montage-bin+
command-line
:search t
:wait t
:input t
:output output-file
:error t)))
(if (not (os-utils:process-exit-success-p process))
(error-message (_ "Error during image composition."))
(os-utils:xdg-open output-file))))
#-montage-bin
(notify (_ "ImageMagick binaries not found on this system") :as-error t))
(defun open-message-link ()
"Open message links window