mirror of
https://codeberg.org/cage/tinmop/
synced 2025-01-31 04:24:48 +01:00
- added command 'gemini-images-montage'.
This commit is contained in:
cage
parent
9efb99b234
commit
c8b92f7eba
@ -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
59
configure
vendored
@ -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
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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*)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user