mirror of https://codeberg.org/cage/tinmop/
- added command 'gemini-images-montage'.
This commit is contained in:
parent
9efb99b234
commit
c8b92f7eba
|
@ -312,6 +312,7 @@ LTLIBOBJS = @LTLIBOBJS@
|
||||||
MAKEINFO = @MAKEINFO@
|
MAKEINFO = @MAKEINFO@
|
||||||
MAN = @MAN@
|
MAN = @MAN@
|
||||||
MKDIR_P = @MKDIR_P@
|
MKDIR_P = @MKDIR_P@
|
||||||
|
MONTAGE = @MONTAGE@
|
||||||
MSGFMT = @MSGFMT@
|
MSGFMT = @MSGFMT@
|
||||||
MSGFMT_015 = @MSGFMT_015@
|
MSGFMT_015 = @MSGFMT_015@
|
||||||
MSGMERGE = @MSGMERGE@
|
MSGMERGE = @MSGMERGE@
|
||||||
|
|
|
@ -621,6 +621,7 @@ ac_subst_vars='am__EXEEXT_FALSE
|
||||||
am__EXEEXT_TRUE
|
am__EXEEXT_TRUE
|
||||||
LTLIBOBJS
|
LTLIBOBJS
|
||||||
LIBOBJS
|
LIBOBJS
|
||||||
|
MONTAGE
|
||||||
DIRNAME
|
DIRNAME
|
||||||
CHMOD
|
CHMOD
|
||||||
GIT
|
GIT
|
||||||
|
@ -7624,6 +7625,64 @@ if test "$DIRNAME" = "no" ; then
|
||||||
exit 1;
|
exit 1;
|
||||||
fi
|
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
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -123,6 +123,13 @@ if test "$DIRNAME" = "no" ; then
|
||||||
exit 1;
|
exit 1;
|
||||||
fi
|
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
|
AC_PROG_MKDIR_P
|
||||||
|
|
||||||
dnl checks for libraries
|
dnl checks for libraries
|
||||||
|
|
|
@ -482,6 +482,8 @@
|
||||||
|
|
||||||
(define-key "C-[" #'go-to-previous-link *gemini-message-keymap*)
|
(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
|
;; gemini page table of contents keymap
|
||||||
|
|
||||||
(define-key "up" #'gemini-toc-scroll-up *gemini-toc-keymap*)
|
(define-key "up" #'gemini-toc-scroll-up *gemini-toc-keymap*)
|
||||||
|
|
|
@ -19,7 +19,9 @@
|
||||||
|
|
||||||
(alexandria:define-constant +unzip-bin+ "@UNZIP@" :test #'string=)
|
(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)
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||||
|
|
||||||
|
@ -30,7 +32,9 @@
|
||||||
|
|
||||||
(allow-features +unzip-bin+ :gempub-support)
|
(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)
|
(defmacro with-return-untranslated ((untranslated) &body body)
|
||||||
`(handler-bind ((i18n-conditions:no-translation-table-error
|
`(handler-bind ((i18n-conditions:no-translation-table-error
|
||||||
|
|
|
@ -79,7 +79,9 @@
|
||||||
search
|
search
|
||||||
input
|
input
|
||||||
output
|
output
|
||||||
(error :output))
|
(error :output)
|
||||||
|
#+sbcl (if-output-exists :supersede)
|
||||||
|
#+sbcl (if-error-exists :supersede))
|
||||||
(declare (ignorable search))
|
(declare (ignorable search))
|
||||||
#+ecl (ext:run-program program
|
#+ecl (ext:run-program program
|
||||||
args
|
args
|
||||||
|
@ -88,12 +90,14 @@
|
||||||
:error error
|
:error error
|
||||||
:wait wait)
|
:wait wait)
|
||||||
#+sbcl (sb-ext:run-program program
|
#+sbcl (sb-ext:run-program program
|
||||||
args
|
args
|
||||||
:wait wait
|
:wait wait
|
||||||
:search search
|
:search search
|
||||||
:input input
|
:input input
|
||||||
:output output
|
:output output
|
||||||
:error error))
|
:error error
|
||||||
|
:if-output-exists if-output-exists
|
||||||
|
:if-error-exists if-error-exists))
|
||||||
|
|
||||||
(defun process-exit-code (process)
|
(defun process-exit-code (process)
|
||||||
#+ecl (nth-value 1 (ext:external-process-status process))
|
#+ecl (nth-value 1 (ext:external-process-status process))
|
||||||
|
|
|
@ -36,6 +36,7 @@
|
||||||
:+xdg-open-bin+
|
:+xdg-open-bin+
|
||||||
:+unzip-bin+
|
:+unzip-bin+
|
||||||
:+man-bin+
|
:+man-bin+
|
||||||
|
:+montage-bin+
|
||||||
:_
|
:_
|
||||||
:n_))
|
:n_))
|
||||||
|
|
||||||
|
@ -2799,6 +2800,7 @@
|
||||||
:search-link-window
|
:search-link-window
|
||||||
:open-gemini-message-link-window
|
:open-gemini-message-link-window
|
||||||
:open-message-link
|
:open-message-link
|
||||||
|
:gemini-images-montage
|
||||||
:open-message-link-go-up
|
:open-message-link-go-up
|
||||||
:open-message-link-go-down
|
:open-message-link-go-down
|
||||||
:open-message-link-perform-opening
|
:open-message-link-perform-opening
|
||||||
|
|
|
@ -1496,6 +1496,64 @@ It an existing file path is provided the command will refuse to run."
|
||||||
:enqueue enqueue
|
:enqueue enqueue
|
||||||
:links links)))
|
: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 ()
|
(defun open-message-link ()
|
||||||
"Open message links window
|
"Open message links window
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue