Download
(require 'cl)
(require 'traverselisp)
(require 'iterator)
(defvar eiv-default-dir "~/Pictures/")
(defvar eiv-default-save-dir-name "eiv-save")
(defvar eiv-default-diaporama-delay 2)
(defun eiv-fit-image-to-window (&optional arg quiet)
"Resize image to current window size.
With prefix arg don't preserve the aspect ratio."
(interactive)
(lexical-let ((cur-fname-to-resize
(buffer-file-name (current-buffer)))
(noverbose quiet))
(let* ((edges (window-inside-pixel-edges))
(width (- (nth 2 edges) (nth 0 edges)))
(height (- (nth 3 edges) (nth 1 edges)))
(asr (when current-prefix-arg t)))
(apply #'start-process "resize-image" nil "mogrify"
(list "-resize"
(concat (format "%dx%d" width height)
(and asr "!"))
cur-fname-to-resize))
(set-process-sentinel (get-process "resize-image")
#'(lambda (process event)
(quit-window t)
(view-file cur-fname-to-resize)
(unless noverbose
(message "Ok %s on %s %s"
process
(file-name-nondirectory
cur-fname-to-resize)
event)))))))
(defun eiv-rotate-current-image (&optional num-arg)
"Rotate current image at 90 degrees.
with prefix arg at -90 degrees"
(interactive)
(let ((fname (buffer-file-name (current-buffer))))
(unless num-arg
(setq num-arg (if current-prefix-arg
-90
90)))
(shell-command (format "mogrify -rotate %s %s" num-arg fname))
(quit-window t)
(view-file fname)))
(defun eiv-dec-or-inc-image (n &optional quiet)
"Resize image to current window size.
With prefix arg don't preserve the aspect ratio."
(interactive)
(lexical-let ((cur-fname-to-resize
(buffer-file-name (current-buffer)))
(noverbose quiet))
(let* ((amount 130)
(com-args (if (< n 0)
(format "%d%%^" (* 100 (/ 100.0 amount)))
(format "%d%%^" amount))))
(apply #'start-process "resize-image" nil "mogrify"
(list "-resize"
com-args
"-gravity"
"center"
cur-fname-to-resize))
(set-process-sentinel (get-process "resize-image")
#'(lambda (process event)
(quit-window t)
(view-file cur-fname-to-resize)
(unless noverbose
(message "Ok %s on %s %s"
process
(file-name-nondirectory
cur-fname-to-resize)
event)))))))
(defun eiv-tag-image (text &optional quiet)
(interactive "sText: ")
(lexical-let* ((cur-fname-to-tag (concat (symbol-name (gensym "img")) ".jpg"))
(img (buffer-file-name (current-buffer)))
(def-dir (file-name-directory img))
(noverbose quiet))
(let* ((width-buf (eshell-command-result (concat "identify -format %w " img)))
(size-buf (concat width-buf "x" "24")))
(apply #'start-process "tag-image" nil "convert"
(list "-background"
"#0008"
"-fill"
"white"
"-gravity"
"center"
"-size"
size-buf
(format "caption:%s" text)
"+size"
(file-name-nondirectory img)
"+swap"
"-gravity"
"south"
"-composite"
cur-fname-to-tag)))
(set-process-sentinel (get-process "tag-image")
#'(lambda (process event)
(quit-window t)
(rename-file (expand-file-name cur-fname-to-tag def-dir)
(expand-file-name img def-dir) t)
(view-file img)
(unless noverbose
(message "Ok %s on %s %s"
process
(file-name-nondirectory
cur-fname-to-tag)
event))))))
(defun eiv-display-external (&optional fname)
"Display FNAME or file at point using an external viewer."
(interactive)
(let ((file (or fname (dired-get-filename))))
(call-process shell-file-name nil nil nil shell-command-switch
(format "%s \"%s\"" image-dired-external-viewer file))))
(defvar eiv-view-external nil)
(defun eiv-viewer (tree &optional only)
"Allow to navigate in a Tree of dir and subdir of pictures.
If prefix arg prompt for only file extensions to use.
An interactive diaporama is also available.
On each image, simple manipulations are possible:
- rotate left and right.
- resize image to window size.
- decrease image size
- increase image size
- tag image
- scroll image
NOTE: these manipulations are destructives on file
so when resizing you will be prompt to save image, if you DON'T save
your initial image will be LOST."
(interactive (list (read-directory-name "DTree: ")
(when current-prefix-arg
(read-string "OnlyExt: "))))
(let* ((save-dir (concat eiv-default-save-dir-name "/"))
(ignore-dirs (cons eiv-default-save-dir-name traverse-ignore-dirs))
(flist (traverse-list-files-in-tree tree nil ignore-dirs
(when only (list only))))
(flist-iterator (iter-list flist))
(diapo-run nil)
(display-fn (if eiv-view-external 'eiv-display-external 'view-file))
(diapo-speed eiv-default-diaporama-delay)
action cur-elm flag-move fnext-elm bnext-elm)
(flet ((eiv-viewer-goto-next-file ()
(clear-image-cache t)
(if (eq major-mode 'image-mode)
(quit-window t))
(if flag-move
(progn
(setq flist-iterator (iter-sub-next flist cur-elm))
(setq fnext-elm (iter-next flist-iterator))
(setq cur-elm fnext-elm)
(if fnext-elm
(funcall display-fn fnext-elm)
(throw 'break
(message "Finish! no more images"))))
(let ((next-elm (iter-next flist-iterator)))
(setq cur-elm next-elm)
(if next-elm
(funcall display-fn next-elm)
(throw 'break
(message "Finish! no more images"))))))
(eiv-viewer-goto-prec-file ()
(clear-image-cache t)
(if (eq major-mode 'image-mode)
(quit-window t))
(setq flist-iterator (iter-sub-prec flist cur-elm))
(setq bnext-elm (iter-next flist-iterator))
(setq cur-elm bnext-elm)
(setq flag-move t)
(if bnext-elm
(funcall display-fn bnext-elm)
(throw 'break
(message "Finish! no more images"))))
(eiv-save-file (fn)
(unless diapo-run
(if (y-or-n-p "Save image?")
(let* ((fname (buffer-file-name (current-buffer)))
(tmp-fname (concat (symbol-name (gensym "img"))
(file-name-extension fname t)))
(tmp-dname (concat default-directory save-dir)))
(if (not (file-exists-p tmp-dname))
(make-directory tmp-dname))
(copy-file fname
(concat tmp-dname tmp-fname))
(funcall fn))
(funcall fn)))))
(eiv-viewer-goto-next-file)
(catch 'break
(while t
(catch 'continue
(if diapo-run
(setq
action
(or (read-event
(propertize
(concat
"(b)ack|"
"(a)stop|"
"(q)uit|"
"(<)slowDown"
"(>)speedUp")
'face '((t (:background "DarkSlateBlue" :foreground "AntiqueWhite"))))
nil
diapo-speed)
'?s))
(setq action
(read-event
(propertize
(concat
"(n)ext|"
"(s)tartDiapo|"
"(b)ack|"
"(x)Down|"
"(y)Up|"
"(q)uit|"
"(t)ag)|"
"(l)Rotateleft|"
"(r)otateRight|"
"(f)itToWindow|"
"(d)ecrease|"
"(i)ncrease")
'face '((t (:background "DarkSlateBlue" :foreground "AntiqueWhite")))))))
(case action
('?n
(setq diapo-run nil)
(eiv-viewer-goto-next-file))
('?s
(setq diapo-run t)
(eiv-viewer-goto-next-file)
(throw 'continue nil))
('?a
(setq diapo-run nil))
('?<
(incf diapo-speed))
('?>
(unless (<= diapo-speed 2)
(decf diapo-speed)))
('?b
(setq diapo-run nil)
(eiv-viewer-goto-prec-file))
('?x
(unwind-protect
(scroll-down -1)
(throw 'continue nil)))
('?y
(unwind-protect
(scroll-down 1)
(throw 'continue nil)))
('?r
(unless diapo-run
(eiv-rotate-current-image)))
('?l
(unless diapo-run
(eiv-rotate-current-image -90)))
('?t
(eiv-save-file #'(lambda ()
(eiv-tag-image (read-string "Text: ") t))))
('?f
(eiv-save-file #'(lambda ()
(eiv-fit-image-to-window nil t))))
('?d
(eiv-save-file #'(lambda ()
(eiv-dec-or-inc-image -1 t))))
('?i
(eiv-save-file #'(lambda ()
(eiv-dec-or-inc-image 1 t))))
('?q
(clear-image-cache t)
(quit-window t)
(throw 'break nil)))))))))
(provide 'eiv)