[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
image-transform.el and image-mode.el rewrite
|
From: |
Vitalie Spinu |
|
Subject: |
image-transform.el and image-mode.el rewrite |
|
Date: |
Fri, 19 Jul 2013 01:22:50 +0200 |
|
User-agent: |
Gnus/5.130008 (Ma Gnus v0.8) Emacs/24.3.50 (gnu/linux) |
I attach a working version of the rewrite.
New image-transform.el with transform api and UI. I rewrote some parts
of image-mode, most interestingly by adding image-mode-auto-resize,
which see. More work should be done - namespace cleanup; n/p/g should
not reset the mode as it messes up user local setting and makes deriving
modes dificult; support for multiple images per page etc.
New keys in image-mode:
+ image-scale-adjust
- image-scale-adjust
0 image-scale-adjust
= image-scale-adjust
B image-change-background
[ image-rotate-left
] image-rotate-right
o image-rotate
r Prefix Command
r f image-fit-to-window
r h image-fit-to-window-height
r s image-stretch-to-window
r w image-fit-to-window-width
T image-mode-show-thumbnails
r stands for resize. A better fit wold be f but that one is already
bound to image-next-frame for multi-frame images.
Currently only internal imagemagick backend is implemented for things
that are exposed at elisp level (:width :height :background
:rotation). Convert backend will come latter. To illustrate the API try:
(setq tt (create-image "/path/to/foo.png"))
(image-transform tt :scale 200) ;in %, imagemagick convention
(image-transform tt :scale 25)
(insert-image (image-transform (copy-list tt) :resize '(500 . 500)))
(insert-image (image-transform (copy-list tt) :resize 200))
(insert-image (image-transform (copy-list tt) :resize 'fit-width))
(insert-image (image-transform (copy-list tt) :resize 'fit-height))
(insert-image (image-transform (copy-list tt) :resize 'fit))
(insert-image (image-transform (copy-list tt) :resize 'fit-stretch))
(insert-image (image-transform (copy-list tt) :resize 'fit-if-large))
(insert-image (image-transform (copy-list tt) :resize 'fit :rotate 45))
(insert-image (image-transform (copy-list tt) :resize 'fit-height :rotate
60))
(insert-image (image-transform (copy-list tt) :background "pink"))
I have changed insert-image to take an additional argument MAP to hook a
transform keymap as local text-properties keymap for the image. With the
following you should get all the transform keys listed above to work on
the inserted image:
(insert-image (image-transform (copy-list tt) :resize 'fit)
nil nil nil image-transform-map)
Would be nice if insert-image would hook a transform map by
default. Then all modes that use insert-image can automatically provide
transformations. But I couldn't think of a handy prefix for this map.
I will be out for a week and will resume when I am back. In meanwhile
suggestions are welcome.
Vitalie
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 30dfd04..deeac68 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -39,7 +39,47 @@
;;; Code:
(require 'image)
-(eval-when-compile (require 'cl-lib))
+(require 'image-transform)
+;; (eval-when-compile (require 'cl-lib))
+
+(defgroup image-mode ()
+ "Support for visiting image files."
+ :group 'multimedia)
+
+(defcustom image-mode-auto-resize 'fit-if-large
+ "The image resize default.
+
+Can be:
+ - a number, giving a proportional scaling of the image.
+ - a cons, giving the actual size (w x h) in pixels.
+ - a symbol:
+ *`fit' - maximally scale IMAGE to fit into window
+ *`fit-if-large' - like `fit', but only when image is larger than window
+ *`fit-height' - fit the image to window height
+ *`fit-width' - fit the image to window width
+ *`fit-stretch' - stretch the image to fit to both height and
+ width of the window"
+ :type '(choice
+ (const :tag "no resize" nil)
+ (number :tag "scale")
+ (cons :tag "size (w . h)" number number)
+ (const :tag "fit" fit)
+ (const :tag "fit if large" fit-if-large)
+ (const :tag "fit height" fit-height)
+ (const :tag "fit width" fit-width)
+ (const :tag "fit stretch" fit-stretch))
+ :group 'image-mode
+ :version "24.4")
+
+;; This one is not customizable
+(defvar image-mode-auto-rotate nil
+ "Default rotation angle for the image.
+Nil means no rotation.")
+
+(defcustom image-mode-show-cursor t
+ "Non-nil if the cursor should be shown in image-mode"
+ :group 'image-mode
+ :type 'boolean)
;;; Image mode window-info management.
@@ -58,15 +98,15 @@ otherwise it defaults to t, used for times when the buffer
is not displayed."
(setq window
(if (eq (current-buffer) (window-buffer)) (selected-window) t)))
((eq window t))
- ((not (windowp window))
- (error "Not a window: %s" window)))
+ ((not (windowp window))
+ (error "Not a window: %s" window)))
(when cleanup
(setq image-mode-winprops-alist
- (delq nil (mapcar (lambda (winprop)
- (let ((w (car-safe winprop)))
- (if (or (not (windowp w)) (window-live-p w))
- winprop)))
- image-mode-winprops-alist))))
+ (delq nil (mapcar (lambda (winprop)
+ (let ((w (car-safe winprop)))
+ (if (or (not (windowp w)) (window-live-p w))
+ winprop)))
+ image-mode-winprops-alist))))
(let ((winprops (assq window image-mode-winprops-alist)))
;; For new windows, set defaults from the latest.
(if winprops
@@ -112,23 +152,18 @@ otherwise it defaults to t, used for times when the
buffer is not displayed."
(hscroll (image-mode-window-get 'hscroll winprops))
(vscroll (image-mode-window-get 'vscroll winprops)))
(when (image-get-display-property) ;Only do it if we display an image!
- (if hscroll (set-window-hscroll (selected-window) hscroll))
- (if vscroll (set-window-vscroll (selected-window) vscroll))))))
+ (if hscroll (set-window-hscroll (selected-window) hscroll))
+ (if vscroll (set-window-vscroll (selected-window) vscroll))))))
(defun image-mode-setup-winprops ()
;; Record current scroll settings.
(unless (listp image-mode-winprops-alist)
(setq image-mode-winprops-alist nil))
(add-hook 'window-configuration-change-hook
- 'image-mode-reapply-winprops nil t))
+ 'image-mode-reapply-winprops nil t))
;;; Image scrolling functions
-(defun image-get-display-property ()
- (get-char-property (point-min) 'display
- ;; There might be different images for different displays.
- (if (eq (window-buffer) (current-buffer))
- (selected-window))))
(declare-function image-size "image.c" (spec &optional pixels frame))
@@ -146,31 +181,31 @@ but not `slice', return the `image-size' of the specified
image."
(if (eq (car spec) 'image)
(image-size spec pixels frame)
(let ((image (assoc 'image spec))
- (slice (assoc 'slice spec)))
+ (slice (assoc 'slice spec)))
(cond ((and image slice)
- (if pixels
- (cons (nth 3 slice) (nth 4 slice))
- (cons (/ (float (nth 3 slice)) (frame-char-width frame))
- (/ (float (nth 4 slice)) (frame-char-height frame)))))
- (image
- (image-size image pixels frame))
- (t
- (error "Invalid image specification: %s" spec))))))
+ (if pixels
+ (cons (nth 3 slice) (nth 4 slice))
+ (cons (/ (float (nth 3 slice)) (frame-char-width frame))
+ (/ (float (nth 4 slice)) (frame-char-height frame)))))
+ (image
+ (image-size image pixels frame))
+ (t
+ (error "Invalid image specification: %s" spec))))))
(defun image-forward-hscroll (&optional n)
"Scroll image in current window to the left by N character widths.
Stop if the right edge of the image is reached."
(interactive "p")
(cond ((= n 0) nil)
- ((< n 0)
- (image-set-window-hscroll (max 0 (+ (window-hscroll) n))))
- (t
- (let* ((image (image-get-display-property))
- (edges (window-inside-edges))
- (win-width (- (nth 2 edges) (nth 0 edges)))
- (img-width (ceiling (car (image-display-size image)))))
- (image-set-window-hscroll (min (max 0 (- img-width win-width))
- (+ n (window-hscroll))))))))
+ ((< n 0)
+ (image-set-window-hscroll (max 0 (+ (window-hscroll) n))))
+ (t
+ (let* ((image (image-get-display-property))
+ (edges (window-inside-edges))
+ (win-width (- (nth 2 edges) (nth 0 edges)))
+ (img-width (ceiling (car (image-display-size image)))))
+ (image-set-window-hscroll (min (max 0 (- img-width win-width))
+ (+ n (window-hscroll))))))))
(defun image-backward-hscroll (&optional n)
"Scroll image in current window to the right by N character widths.
@@ -183,15 +218,15 @@ Stop if the left edge of the image is reached."
Stop if the bottom edge of the image is reached."
(interactive "p")
(cond ((= n 0) nil)
- ((< n 0)
- (image-set-window-vscroll (max 0 (+ (window-vscroll) n))))
- (t
- (let* ((image (image-get-display-property))
- (edges (window-inside-edges))
- (win-height (- (nth 3 edges) (nth 1 edges)))
- (img-height (ceiling (cdr (image-display-size image)))))
- (image-set-window-vscroll (min (max 0 (- img-height win-height))
- (+ n (window-vscroll))))))))
+ ((< n 0)
+ (image-set-window-vscroll (max 0 (+ (window-vscroll) n))))
+ (t
+ (let* ((image (image-get-display-property))
+ (edges (window-inside-edges))
+ (win-height (- (nth 3 edges) (nth 1 edges)))
+ (img-height (ceiling (cdr (image-display-size image)))))
+ (image-set-window-vscroll (min (max 0 (- img-height win-height))
+ (+ n (window-vscroll))))))))
(defun image-previous-line (&optional n)
"Scroll image in current window downward by N lines.
@@ -209,16 +244,16 @@ If ARG is the atom `-', scroll downward by nearly full
screen.
When calling from a program, supply as argument a number, nil, or `-'."
(interactive "P")
(cond ((null n)
- (let* ((edges (window-inside-edges))
- (win-height (- (nth 3 edges) (nth 1 edges))))
- (image-next-line
- (max 0 (- win-height next-screen-context-lines)))))
- ((eq n '-)
- (let* ((edges (window-inside-edges))
- (win-height (- (nth 3 edges) (nth 1 edges))))
- (image-next-line
- (min 0 (- next-screen-context-lines win-height)))))
- (t (image-next-line (prefix-numeric-value n)))))
+ (let* ((edges (window-inside-edges))
+ (win-height (- (nth 3 edges) (nth 1 edges))))
+ (image-next-line
+ (max 0 (- win-height next-screen-context-lines)))))
+ ((eq n '-)
+ (let* ((edges (window-inside-edges))
+ (win-height (- (nth 3 edges) (nth 1 edges))))
+ (image-next-line
+ (min 0 (- next-screen-context-lines win-height)))))
+ (t (image-next-line (prefix-numeric-value n)))))
(defun image-scroll-down (&optional n)
"Scroll image in current window downward by N lines.
@@ -230,16 +265,16 @@ If ARG is the atom `-', scroll upward by nearly full
screen.
When calling from a program, supply as argument a number, nil, or `-'."
(interactive "P")
(cond ((null n)
- (let* ((edges (window-inside-edges))
- (win-height (- (nth 3 edges) (nth 1 edges))))
- (image-next-line
- (min 0 (- next-screen-context-lines win-height)))))
- ((eq n '-)
- (let* ((edges (window-inside-edges))
- (win-height (- (nth 3 edges) (nth 1 edges))))
- (image-next-line
- (max 0 (- win-height next-screen-context-lines)))))
- (t (image-next-line (- (prefix-numeric-value n))))))
+ (let* ((edges (window-inside-edges))
+ (win-height (- (nth 3 edges) (nth 1 edges))))
+ (image-next-line
+ (min 0 (- next-screen-context-lines win-height)))))
+ ((eq n '-)
+ (let* ((edges (window-inside-edges))
+ (win-height (- (nth 3 edges) (nth 1 edges))))
+ (image-next-line
+ (max 0 (- win-height next-screen-context-lines)))))
+ (t (image-next-line (- (prefix-numeric-value n))))))
(defun image-bol (arg)
"Scroll horizontally to the left edge of the image in the current window.
@@ -260,9 +295,9 @@ stopping if the top or bottom edge of the image is reached."
(/= (setq arg (prefix-numeric-value arg)) 1)
(image-next-line (- arg 1)))
(let* ((image (image-get-display-property))
- (edges (window-inside-edges))
- (win-width (- (nth 2 edges) (nth 0 edges)))
- (img-width (ceiling (car (image-display-size image)))))
+ (edges (window-inside-edges))
+ (win-width (- (nth 2 edges) (nth 0 edges)))
+ (img-width (ceiling (car (image-display-size image)))))
(image-set-window-hscroll (max 0 (- img-width win-width)))))
(defun image-bob ()
@@ -275,11 +310,11 @@ stopping if the top or bottom edge of the image is
reached."
"Scroll to the bottom-right corner of the image in the current window."
(interactive)
(let* ((image (image-get-display-property))
- (edges (window-inside-edges))
- (win-width (- (nth 2 edges) (nth 0 edges)))
- (img-width (ceiling (car (image-display-size image))))
- (win-height (- (nth 3 edges) (nth 1 edges)))
- (img-height (ceiling (cdr (image-display-size image)))))
+ (edges (window-inside-edges))
+ (win-width (- (nth 2 edges) (nth 0 edges)))
+ (img-width (ceiling (car (image-display-size image))))
+ (win-height (- (nth 3 edges) (nth 1 edges)))
+ (img-height (ceiling (cdr (image-display-size image)))))
(image-set-window-hscroll (max 0 (- img-width win-width)))
(image-set-window-vscroll (max 0 (- img-height win-height)))))
@@ -298,37 +333,37 @@ call."
(let* ((buffer (current-buffer))
(display (image-get-display-property))
(size (image-display-size display))
- (saved (frame-parameter frame 'image-mode-saved-params))
- (window-configuration (current-window-configuration frame))
- (width (frame-width frame))
- (height (frame-height frame)))
+ (saved (frame-parameter frame 'image-mode-saved-params))
+ (window-configuration (current-window-configuration frame))
+ (width (frame-width frame))
+ (height (frame-height frame)))
(with-selected-frame (or frame (selected-frame))
(if (and toggle saved
- (= (caar saved) width)
- (= (cdar saved) height))
- (progn
- (set-frame-width frame (car (nth 1 saved)))
- (set-frame-height frame (cdr (nth 1 saved)))
- (set-window-configuration (nth 2 saved))
- (set-frame-parameter frame 'image-mode-saved-params nil))
- (delete-other-windows)
- (switch-to-buffer buffer t t)
- (let* ((edges (window-inside-edges))
- (inner-width (- (nth 2 edges) (nth 0 edges)))
- (inner-height (- (nth 3 edges) (nth 1 edges))))
- (set-frame-width frame (+ (ceiling (car size))
- width (- inner-width)))
- (set-frame-height frame (+ (ceiling (cdr size))
- height (- inner-height)))
- ;; The frame size after the above `set-frame-*' calls may
- ;; differ from what we specified, due to window manager
- ;; interference. We have to call `frame-width' and
- ;; `frame-height' to get the actual results.
- (set-frame-parameter frame 'image-mode-saved-params
- (list (cons (frame-width)
- (frame-height))
- (cons width height)
- window-configuration)))))))
+ (= (caar saved) width)
+ (= (cdar saved) height))
+ (progn
+ (set-frame-width frame (car (nth 1 saved)))
+ (set-frame-height frame (cdr (nth 1 saved)))
+ (set-window-configuration (nth 2 saved))
+ (set-frame-parameter frame 'image-mode-saved-params nil))
+ (delete-other-windows)
+ (switch-to-buffer buffer t t)
+ (let* ((edges (window-inside-edges))
+ (inner-width (- (nth 2 edges) (nth 0 edges)))
+ (inner-height (- (nth 3 edges) (nth 1 edges))))
+ (set-frame-width frame (+ (ceiling (car size))
+ width (- inner-width)))
+ (set-frame-height frame (+ (ceiling (cdr size))
+ height (- inner-height)))
+ ;; The frame size after the above `set-frame-*' calls may
+ ;; differ from what we specified, due to window manager
+ ;; interference. We have to call `frame-width' and
+ ;; `frame-height' to get the actual results.
+ (set-frame-parameter frame 'image-mode-saved-params
+ (list (cons (frame-width)
+ (frame-height))
+ (cons width height)
+ window-configuration)))))))
;;; Image Mode setup
@@ -349,6 +384,7 @@ call."
(define-key map (kbd "S-SPC") 'image-scroll-down)
(define-key map (kbd "DEL") 'image-scroll-down)
(define-key map (kbd "RET") 'image-toggle-animation)
+ (define-key map "T" 'image-mode-show-thumbnails)
(define-key map "F" 'image-goto-frame)
(define-key map "f" 'image-next-frame)
(define-key map "b" 'image-previous-frame)
@@ -370,59 +406,68 @@ call."
(define-key map [remap end-of-buffer] 'image-eob)
(easy-menu-define image-mode-menu map "Menu for Image mode."
'("Image"
- ["Show as Text" image-toggle-display :active t
- :help "Show image as text"]
- "--"
- ["Fit Frame to Image" image-mode-fit-frame :active t
- :help "Resize frame to match image"]
- ["Fit to Window Height" image-transform-fit-to-height
- :visible (eq image-type 'imagemagick)
- :help "Resize image to match the window height"]
- ["Fit to Window Width" image-transform-fit-to-width
- :visible (eq image-type 'imagemagick)
- :help "Resize image to match the window width"]
- ["Rotate Image..." image-transform-set-rotation
- :visible (eq image-type 'imagemagick)
- :help "Rotate the image"]
- "--"
- ["Show Thumbnails"
- (lambda ()
- (interactive)
- (image-dired default-directory))
- :active default-directory
- :help "Show thumbnails for all images in this directory"]
- ["Next Image" image-next-file :active buffer-file-name
+ ["Show as Text" image-toggle-display
+ :active t
+ :help "Show image as text"]
+ "--"
+ ["Fit Frame to Image" image-mode-fit-frame
+ :active t
+ :help "Resize frame to match image"]
+ ["Fit into Window" image-fit-to-window
+ :visible (eq image-type 'imagemagick)
+ :help "Maximally resize image to fit into window"]
+ ["Fit to Window Height" image-fit-to-window-height
+ :visible (eq image-type 'imagemagick)
+ :help "Resize image to match the window height"]
+ ["Fit to Window Width" image-fit-to-window-width
+ :visible (eq image-type 'imagemagick)
+ :help "Resize image to match the window width"]
+ ["Rotate Image..." image-rotate
+ :visible (eq image-type 'imagemagick)]
+ ["Rotate Image Right" image-rotate-right
+ :visible (eq image-type 'imagemagick)]
+ ["Rotate Image Left" image-rotate-left
+ :visible (eq image-type 'imagemagick)]
+ ["Change Image Background..." image-change-background
+ :visible (eq image-type 'imagemagick)]
+ "--"
+ ["Show Thumbnails" image-mode-show-thumbnails
+ :active default-directory
+ :help "Show thumbnails for all images in this directory"]
+ ["Next Image" image-next-file :active buffer-file-name
:help "Move to next image in this directory"]
- ["Previous Image" image-previous-file :active buffer-file-name
+ ["Previous Image" image-previous-file :active buffer-file-name
:help "Move to previous image in this directory"]
- "--"
- ["Animate Image" image-toggle-animation :style toggle
- :selected (let ((image (image-get-display-property)))
- (and image (image-animate-timer image)))
- :active image-multi-frame
+ "--"
+ ["Animate Image" image-toggle-animation :style toggle
+ :selected (let ((image (image-get-display-property)))
+ (and image (image-animate-timer image)))
+ :active image-multi-frame
:help "Toggle image animation"]
- ["Loop Animation"
- (lambda () (interactive)
- (setq image-animate-loop (not image-animate-loop))
- ;; FIXME this is a hacky way to make it affect a currently
- ;; animating image.
- (when (let ((image (image-get-display-property)))
- (and image (image-animate-timer image)))
- (image-toggle-animation)
- (image-toggle-animation)))
- :style toggle :selected image-animate-loop
- :active image-multi-frame
+ ["Loop Animation"
+ (lambda () (interactive)
+ (setq image-animate-loop (not image-animate-loop))
+ ;; FIXME this is a hacky way to make it affect a currently
+ ;; animating image.
+ (when (let ((image (image-get-display-property)))
+ (and image (image-animate-timer image)))
+ (image-toggle-animation)
+ (image-toggle-animation)))
+ :style toggle :selected image-animate-loop
+ :active image-multi-frame
:help "Animate images once, or forever?"]
- ["Next Frame" image-next-frame :active image-multi-frame
- :help "Show the next frame of this image"]
- ["Previous Frame" image-previous-frame :active image-multi-frame
- :help "Show the previous frame of this image"]
- ["Goto Frame..." image-goto-frame :active image-multi-frame
- :help "Show a specific frame of this image"]
- ))
+ ["Next Frame" image-next-frame :active image-multi-frame
+ :help "Show the next frame of this image"]
+ ["Previous Frame" image-previous-frame :active image-multi-frame
+ :help "Show the previous frame of this image"]
+ ["Goto Frame..." image-goto-frame :active image-multi-frame
+ :help "Show a specific frame of this image"]
+ ))
map)
"Mode keymap for `image-mode'.")
+(image--add-transform-keys image-mode-map)
+
(defvar image-minor-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-c" 'image-toggle-display)
@@ -437,72 +482,79 @@ call."
(defun image-mode ()
"Major mode for image files.
You can use \\<image-mode-map>\\[image-toggle-display]
-to toggle between display as an image and display as text."
+to toggle between display as an image and display as text.
+
+\\{image-mode-map\}"
(interactive)
(condition-case err
(progn
- (unless (display-images-p)
- (error "Display does not support images"))
-
- (kill-all-local-variables)
- (setq major-mode 'image-mode)
-
- (if (not (image-get-display-property))
- (progn
- (image-toggle-display-image)
- ;; If attempt to display the image fails.
- (if (not (image-get-display-property))
- (error "Invalid image")))
- ;; Set next vars when image is already displayed but local
- ;; variables were cleared by kill-all-local-variables
- (setq cursor-type nil truncate-lines t
- image-type (plist-get (cdr (image-get-display-property))
:type)))
-
- (setq mode-name (if image-type (format "Image[%s]" image-type) "Image"))
- (use-local-map image-mode-map)
-
- ;; Use our own bookmarking function for images.
- (setq-local bookmark-make-record-function
+ (unless (display-images-p)
+ (error "Display does not support images"))
+
+ (kill-all-local-variables)
+ (setq major-mode 'image-mode)
+
+ (if (not (image-get-display-property))
+ (progn
+ (image-toggle-display-image)
+ ;; If attempt to display the image fails.
+ (if (not (image-get-display-property))
+ (error "Invalid image")))
+ ;; Set next vars when image is already displayed but local
+ ;; variables were cleared by kill-all-local-variables
+ (setq cursor-type nil truncate-lines t
+ image-type (plist-get (cdr (image-get-display-property))
:type)))
+
+ (setq mode-name (if image-type (format "Image[%s]" image-type)
"Image"))
+ (use-local-map image-mode-map)
+
+ ;; Use our own bookmarking function for images.
+ (setq-local bookmark-make-record-function
#'image-bookmark-make-record)
- ;; Keep track of [vh]scroll when switching buffers
- (image-mode-setup-winprops)
-
- (add-hook 'change-major-mode-hook 'image-toggle-display-text nil t)
- (add-hook 'after-revert-hook 'image-after-revert-hook nil t)
- (run-mode-hooks 'image-mode-hook)
- (let ((image (image-get-display-property))
- (msg1 (substitute-command-keys
- "Type \\[image-toggle-display] to view the image as "))
- animated)
- (cond
- ((null image)
- (message "%s" (concat msg1 "an image.")))
- ((setq animated (image-multi-frame-p image))
- (setq image-multi-frame t
- mode-line-process
- `(:eval
- (concat " "
- (propertize
- (format "[%s/%s]"
- (1+ (image-current-frame ',image))
- ,(car animated))
- 'help-echo "Frames
+ ;; Keep track of [vh]scroll when switching buffers
+ (image-mode-setup-winprops)
+
+ ;; fixme: should be rewritten whiteout actually re-installing
+ ;; the mode, user vars are lost + deriving modes is difficult
+ (set (make-local-variable 'revert-buffer-function)
+ 'image-mode-revert-buffer-function)
+
+ (add-hook 'change-major-mode-hook 'image-toggle-display-text nil t)
+ (add-hook 'after-revert-hook 'image-after-revert-hook nil t)
+ (run-mode-hooks 'image-mode-hook)
+ (let ((image (image-get-display-property))
+ (msg1 (substitute-command-keys
+ "Type \\[image-toggle-display] to view the image as "))
+ animated)
+ (cond
+ ((null image)
+ (message "%s" (concat msg1 "an image.")))
+ ((setq animated (image-multi-frame-p image))
+ (setq image-multi-frame t
+ mode-line-process
+ `(:eval
+ (concat " "
+ (propertize
+ (format "[%s/%s]"
+ (1+ (image-current-frame ',image))
+ ,(car animated))
+ 'help-echo "Frames
mouse-1: Next frame
mouse-3: Previous frame"
- 'mouse-face 'mode-line-highlight
- 'local-map
- '(keymap
- (mode-line
- keymap
- (down-mouse-1 . image-next-frame)
- (down-mouse-3 . image-previous-frame)))))))
- (message "%s"
- (concat msg1 "text. This image has multiple frames.")))
-;;; (substitute-command-keys
-;;; "\\[image-toggle-animation] to animate."))))
- (t
- (message "%s" (concat msg1 "text."))))))
+ 'mouse-face 'mode-line-highlight
+ 'local-map
+ '(keymap
+ (mode-line
+ keymap
+ (down-mouse-1 . image-next-frame)
+ (down-mouse-3 . image-previous-frame)))))))
+ (message "%s"
+ (concat msg1 "text. This image has multiple frames.")))
+;;; (substitute-command-keys
+;;; "\\[image-toggle-animation] to animate."))))
+ (t
+ (message "%s" (concat msg1 "text."))))))
(error
(image-mode-as-text)
@@ -510,6 +562,11 @@ mouse-3: Previous frame"
(if (called-interactively-p 'any) 'error 'message)
"Cannot display image: %s" (cdr err)))))
+(defun image-mode-revert-buffer-function (ignore noconfirm)
+ ;; don't ask on reversion
+ (let ((revert-buffer-function nil))
+ (revert-buffer ignore t)))
+
;;;###autoload
(define-minor-mode image-minor-mode
"Toggle Image minor mode in this buffer.
@@ -544,25 +601,25 @@ on these modes."
;; image-mode-as-text = normal-mode + image-minor-mode
(let ((previous-image-type image-type)) ; preserve `image-type'
(if image-mode-previous-major-mode
- ;; Restore previous major mode that was already found by this
- ;; function and cached in `image-mode-previous-major-mode'
- (funcall image-mode-previous-major-mode)
+ ;; Restore previous major mode that was already found by this
+ ;; function and cached in `image-mode-previous-major-mode'
+ (funcall image-mode-previous-major-mode)
(let ((auto-mode-alist
- (delq nil (mapcar
- (lambda (elt)
- (unless (memq (or (car-safe (cdr elt)) (cdr elt))
- '(image-mode image-mode-maybe
image-mode-as-text))
- elt))
- auto-mode-alist)))
- (magic-fallback-mode-alist
- (delq nil (mapcar
- (lambda (elt)
- (unless (memq (or (car-safe (cdr elt)) (cdr elt))
- '(image-mode image-mode-maybe
image-mode-as-text))
- elt))
- magic-fallback-mode-alist))))
- (normal-mode)
- (setq-local image-mode-previous-major-mode major-mode)))
+ (delq nil (mapcar
+ (lambda (elt)
+ (unless (memq (or (car-safe (cdr elt)) (cdr elt))
+ '(image-mode image-mode-maybe
image-mode-as-text))
+ elt))
+ auto-mode-alist)))
+ (magic-fallback-mode-alist
+ (delq nil (mapcar
+ (lambda (elt)
+ (unless (memq (or (car-safe (cdr elt)) (cdr elt))
+ '(image-mode image-mode-maybe
image-mode-as-text))
+ elt))
+ magic-fallback-mode-alist))))
+ (normal-mode)
+ (setq-local image-mode-previous-major-mode major-mode)))
;; Restore `image-type' after `kill-all-local-variables' in `normal-mode'.
(setq image-type previous-image-type)
;; Enable image minor mode with `C-c C-c'.
@@ -570,10 +627,10 @@ on these modes."
;; Show the image file as text.
(image-toggle-display-text)
(message "%s" (concat
- (substitute-command-keys
- "Type \\[image-toggle-display] to view the image as ")
- (if (image-get-display-property)
- "text" "an image") "."))))
+ (substitute-command-keys
+ "Type \\[image-toggle-display] to view the image as ")
+ (if (image-get-display-property)
+ "text" "an image") "."))))
(define-obsolete-function-alias 'image-mode-maybe 'image-mode "23.2")
@@ -581,14 +638,20 @@ on these modes."
"Show the image file as text.
Remove text properties that display the image."
(let ((inhibit-read-only t)
- (buffer-undo-list t)
- (modified (buffer-modified-p)))
+ (buffer-undo-list t)
+ (modified (buffer-modified-p)))
(remove-list-of-text-properties (point-min) (point-max)
- '(display read-nonsticky ;; intangible
- read-only front-sticky))
+ '(display read-nonsticky ;; intangible
+ read-only front-sticky))
(set-buffer-modified-p modified)
(if (called-interactively-p 'any)
- (message "Repeat this command to go back to displaying the image"))))
+ (message "Repeat this command to go back to displaying the image"))))
+
+(defun image-mode-show-thumbnails ()
+ "Show thumbnails alongside dired buffer.
+Based on `image-dired'"
+ (interactive)
+ (image-dired default-directory))
(defvar archive-superior-buffer)
(defvar tar-superior-buffer)
@@ -601,56 +664,67 @@ was inserted."
(unless (derived-mode-p 'image-mode)
(error "The buffer is not in Image mode"))
(let* ((filename (buffer-file-name))
- (data-p (not (and filename
- (file-readable-p filename)
- (not (file-remote-p filename))
- (not (buffer-modified-p))
- (not (and (boundp 'archive-superior-buffer)
- archive-superior-buffer))
- (not (and (boundp 'tar-superior-buffer)
- tar-superior-buffer)))))
- (file-or-data (if data-p
- (string-make-unibyte
- (buffer-substring-no-properties (point-min)
(point-max)))
- filename))
- (type (image-type file-or-data nil data-p))
- (image (create-image file-or-data type data-p))
- (inhibit-read-only t)
- (buffer-undo-list t)
- (modified (buffer-modified-p))
- props)
+ (data-p (not (and filename
+ (file-readable-p filename)
+ (not (file-remote-p filename))
+ (not (buffer-modified-p))
+ (not (and (boundp 'archive-superior-buffer)
+ archive-superior-buffer))
+ (not (and (boundp 'tar-superior-buffer)
+ tar-superior-buffer)))))
+ (file-or-data (if data-p
+ (string-make-unibyte
+ (buffer-substring-no-properties (point-min)
(point-max)))
+ filename))
+ (image (create-image file-or-data nil data-p))
+ (type (plist-get (cdr image) :type))
+ ;; (type (image-type file-or-data nil data-p))
+ (inhibit-read-only t)
+ (buffer-undo-list t)
+ (modified (buffer-modified-p))
+ props)
;; Discard any stale image data before looking it up again.
(image-flush image)
- (setq image (append image (image-transform-properties image)))
+ (setq image (image-transform-interactive image
+ :resize image-mode-auto-resize
+ :rotate image-mode-auto-rotate))
(setq props
- `(display ,image
- ;; intangible ,image
- rear-nonsticky (display) ;; intangible
- read-only t front-sticky (read-only)))
+ `(display ,image
+ ;; intangible ,image
+ rear-nonsticky (display) ;; intangible
+ read-only t front-sticky (read-only)))
(let ((buffer-file-truename nil)) ; avoid changing dir mtime by lock_file
(add-text-properties (point-min) (point-max) props)
(restore-buffer-modified-p modified))
;; Inhibit the cursor when the buffer contains only an image,
;; because cursors look very strange on top of images.
- (setq cursor-type nil)
+
+ ;; VS[16-07-2013]: It is a blinking box around image. Not a big
+ ;; deal. It is way more important to distinguish active
+ ;; buffer/image. In the future we will have multiple images per
+ ;; buffer. Will need to activate it anyhow.
+
+ (unless image-mode-show-cursor
+ (setq cursor-type nil))
+
;; This just makes the arrow displayed in the right fringe
;; area look correct when the image is wider than the window.
(setq truncate-lines t)
;; Disable adding a newline at the end of the image file when it
;; is written with, e.g., C-x C-w.
(if (coding-system-equal (coding-system-base buffer-file-coding-system)
- 'no-conversion)
- (setq-local find-file-literally t))
+ 'no-conversion)
+ (setq-local find-file-literally t))
;; Allow navigation of large images.
(setq-local auto-hscroll-mode nil)
(setq image-type type)
(if (eq major-mode 'image-mode)
- (setq mode-name (format "Image[%s]" type)))
- (image-transform-check-size)
+ (setq mode-name (format "Image[%s]" type)))
+ ;; (image--transform-check-size)
(if (called-interactively-p 'any)
- (message "Repeat this command to go back to displaying the file as
text"))))
+ (message "Repeat this command to go back to displaying the file as
text"))))
(defun image-toggle-display ()
"Toggle between image and text display.
@@ -685,7 +759,7 @@ If `image-animate-loop' is non-nil, animation loops forever.
Otherwise it plays once, then stops."
(interactive)
(let ((image (image-get-display-property))
- animation)
+ animation)
(cond
((null image)
(error "No image is present"))
@@ -693,15 +767,15 @@ Otherwise it plays once, then stops."
(message "No image animation."))
(t
(let ((timer (image-animate-timer image)))
- (if timer
- (cancel-timer timer)
- (let ((index (plist-get (cdr image) :index)))
- ;; If we're at the end, restart.
- (and index
- (>= index (1- (car animation)))
- (setq index nil))
- (image-animate image index
- (if image-animate-loop t)))))))))
+ (if timer
+ (cancel-timer timer)
+ (let ((index (plist-get (cdr image) :index)))
+ ;; If we're at the end, restart.
+ (and index
+ (>= index (1- (car animation)))
+ (setq index nil))
+ (image-animate image index
+ (if image-animate-loop t)))))))))
(defun image-goto-frame (n &optional relative)
"Show frame N of a multi-frame image.
@@ -709,7 +783,7 @@ Optional argument OFFSET non-nil means interpret N as
relative to the
current frame. Frames are indexed from 1."
(interactive
(list (or current-prefix-arg
- (read-number "Show frame number: "))))
+ (read-number "Show frame number: "))))
(let ((image (image-get-display-property)))
(cond
((null image)
@@ -718,9 +792,9 @@ current frame. Frames are indexed from 1."
(message "No image animation."))
(t
(image-show-frame image
- (if relative
- (+ n (image-current-frame image))
- (1- n)))))))
+ (if relative
+ (+ n (image-current-frame image))
+ (1- n)))))))
(defun image-next-frame (&optional n)
"Switch to the next frame of a multi-frame image.
@@ -752,13 +826,13 @@ replacing the current Image mode buffer."
(unless buffer-file-name
(error "The current image is not associated with a file"))
(let* ((file (file-name-nondirectory buffer-file-name))
- (images (image-mode--images-in-directory file))
- (idx 0))
+ (images (image-mode--images-in-directory file))
+ (idx 0))
(catch 'image-visit-next-file
(dolist (f images)
- (if (string= f file)
- (throw 'image-visit-next-file (1+ idx)))
- (setq idx (1+ idx))))
+ (if (string= f file)
+ (throw 'image-visit-next-file (1+ idx)))
+ (setq idx (1+ idx))))
(setq idx (mod (+ idx (or n 1)) (length images)))
(find-alternate-file (nth idx images))))
@@ -774,8 +848,8 @@ replacing the current Image mode buffer."
(defun image-mode--images-in-directory (file)
(let* ((dir (file-name-directory buffer-file-name))
- (files (directory-files dir nil
- (image-file-name-regexp) t)))
+ (files (directory-files dir nil
+ (image-file-name-regexp) t)))
;; Add the current file to the list of images if necessary, in
;; case it does not match `image-file-name-regexp'.
(unless (member file files)
@@ -791,8 +865,8 @@ replacing the current Image mode buffer."
(defun image-bookmark-make-record ()
`(,@(bookmark-make-record-default nil 'no-context 0)
- (image-type . ,image-type)
- (handler . image-bookmark-jump)))
+ (image-type . ,image-type)
+ (handler . image-bookmark-jump)))
;;;###autoload
(defun image-bookmark-jump (bmk)
@@ -801,228 +875,7 @@ replacing the current Image mode buffer."
(prog1 (bookmark-default-handler bmk)
(when (not (string= image-type (bookmark-prop-get bmk 'image-type)))
(image-toggle-display))))
-
-
-;; Not yet implemented.
-;; (defvar image-transform-minor-mode-map
-;; (let ((map (make-sparse-keymap)))
-;; ;; (define-key map [(control ?+)] 'image-scale-in)
-;; ;; (define-key map [(control ?-)] 'image-scale-out)
-;; ;; (define-key map [(control ?=)] 'image-scale-none)
-;; ;; (define-key map "c f h" 'image-scale-fit-height)
-;; ;; (define-key map "c ]" 'image-rotate-right)
-;; map)
-;; "Minor mode keymap `image-transform-mode'.")
-;;
-;; (define-minor-mode image-transform-mode
-;; "Minor mode for scaling and rotating images.
-;; With a prefix argument ARG, enable the mode if ARG is positive,
-;; and disable it otherwise. If called from Lisp, enable the mode
-;; if ARG is omitted or nil. This minor mode requires Emacs to have
-;; been compiled with ImageMagick support."
-;; nil "image-transform" image-transform-minor-mode-map)
-
-
-;; FIXME this doesn't seem mature yet. Document in manual when it is.
-(defvar image-transform-resize nil
- "The image resize operation.
-Its value should be one of the following:
- - nil, meaning no resizing.
- - `fit-height', meaning to fit the image to the window height.
- - `fit-width', meaning to fit the image to the window width.
- - A number, which is a scale factor (the default size is 1).")
-
-(defvar image-transform-scale 1.0
- "The scale factor of the image being displayed.")
-
-(defvar image-transform-rotation 0.0
- "Rotation angle for the image in the current Image mode buffer.")
-
-(defvar image-transform-right-angle-fudge 0.0001
- "Snap distance to a multiple of a right angle.
-There's no deep theory behind the default value, it should just
-be somewhat larger than ImageMagick's MagickEpsilon.")
-
-(defsubst image-transform-width (width height)
- "Return the bounding box width of a rotated WIDTH x HEIGHT rectangle.
-The rotation angle is the value of `image-transform-rotation' in degrees."
- (let ((angle (degrees-to-radians image-transform-rotation)))
- ;; Assume, w.l.o.g., that the vertices of the rectangle have the
- ;; coordinates (+-w/2, +-h/2) and that (0, 0) is the center of the
- ;; rotation by the angle A. The projections onto the first axis
- ;; of the vertices of the rotated rectangle are +- (w/2) cos A +-
- ;; (h/2) sin A, and the difference between the largest and the
- ;; smallest of the four values is the expression below.
- (+ (* width (abs (cos angle))) (* height (abs (sin angle))))))
-
-;; The following comment and code snippet are from
-;; ImageMagick-6.7.4-4/magick/distort.c
-
-;; /* Set the output image geometry to calculated 'best fit'.
-;; Yes this tends to 'over do' the file image size, ON PURPOSE!
-;; Do not do this for DePolar which needs to be exact for virtual tiling.
-;; */
-;; if ( fix_bounds ) {
-;; geometry.x = (ssize_t) floor(min.x-0.5);
-;; geometry.y = (ssize_t) floor(min.y-0.5);
-;; geometry.width=(size_t) ceil(max.x-geometry.x+0.5);
-;; geometry.height=(size_t) ceil(max.y-geometry.y+0.5);
-;; }
-
-;; Other parts of the same file show that here the origin is in the
-;; left lower corner of the image rectangle, the center of the
-;; rotation is the center of the rectangle and min.x and max.x
-;; (resp. min.y and max.y) are the smallest and the largest of the
-;; projections of the vertices onto the first (resp. second) axis.
-
-(defun image-transform-fit-width (width height length)
- "Return (w . h) so that a rotated w x h image has exactly width LENGTH.
-The rotation angle is the value of `image-transform-rotation'.
-Write W for WIDTH and H for HEIGHT. Then the w x h rectangle is
-an \"approximately uniformly\" scaled W x H rectangle, which
-currently means that w is one of floor(s W) + {0, 1, -1} and h is
-floor(s H), where s can be recovered as the value of `image-transform-scale'.
-The value of `image-transform-rotation' may be replaced by
-a slightly different angle. Currently this is done for values
-close to a multiple of 90, see `image-transform-right-angle-fudge'."
- (cond ((< (abs (- (mod (+ image-transform-rotation 90) 180) 90))
- image-transform-right-angle-fudge)
- (cl-assert (not (zerop width)) t)
- (setq image-transform-rotation
- (float (round image-transform-rotation))
- image-transform-scale (/ (float length) width))
- (cons length nil))
- ((< (abs (- (mod (+ image-transform-rotation 45) 90) 45))
- image-transform-right-angle-fudge)
- (cl-assert (not (zerop height)) t)
- (setq image-transform-rotation
- (float (round image-transform-rotation))
- image-transform-scale (/ (float length) height))
- (cons nil length))
- (t
- (cl-assert (not (and (zerop width) (zerop height))) t)
- (setq image-transform-scale
- (/ (float (1- length)) (image-transform-width width height)))
- ;; Assume we have a w x h image and an angle A, and let l =
- ;; l(w, h) = w |cos A| + h |sin A|, which is the actual width
- ;; of the bounding box of the rotated image, as calculated by
- ;; `image-transform-width'. The code snippet quoted above
- ;; means that ImageMagick puts the rotated image in
- ;; a bounding box of width L = 2 ceil((w+l+1)/2) - w.
- ;; Elementary considerations show that this is equivalent to
- ;; L - w being even and L-3 < l(w, h) <= L-1. In our case, L is
- ;; the given `length' parameter and our job is to determine
- ;; reasonable values for w and h which satisfy these
- ;; conditions.
- (let ((w (floor (* image-transform-scale width)))
- (h (floor (* image-transform-scale height))))
- ;; Let w and h as bound above. Then l(w, h) <= l(s W, s H)
- ;; = L-1 < l(w+1, h+1) = l(w, h) + l(1, 1) <= l(w, h) + 2,
- ;; hence l(w, h) > (L-1) - 2 = L-3.
- (cons
- (cond ((= (mod w 2) (mod length 2))
- w)
- ;; l(w+1, h) >= l(w, h) > L-3, but does l(w+1, h) <=
- ;; L-1 hold?
- ((<= (image-transform-width (1+ w) h) (1- length))
- (1+ w))
- ;; No, it doesn't, but this implies that l(w-1, h) =
- ;; l(w+1, h) - l(2, 0) >= l(w+1, h) - 2 > (L-1) -
- ;; 2 = L-3. Clearly, l(w-1, h) <= l(w, h) <= L-1.
- (t
- (1- w)))
- h)))))
-
-(defun image-transform-check-size ()
- "Check that the image exactly fits the width/height of the window.
-
-Do this for an image of type `imagemagick' to make sure that the
-elisp code matches the way ImageMagick computes the bounding box
-of a rotated image."
- (when (and (not (numberp image-transform-resize))
- (boundp 'image-type)
- (eq image-type 'imagemagick))
- (let ((size (image-display-size (image-get-display-property) t)))
- (cond ((eq image-transform-resize 'fit-width)
- (cl-assert (= (car size)
- (- (nth 2 (window-inside-pixel-edges))
- (nth 0 (window-inside-pixel-edges))))
- t))
- ((eq image-transform-resize 'fit-height)
- (cl-assert (= (cdr size)
- (- (nth 3 (window-inside-pixel-edges))
- (nth 1 (window-inside-pixel-edges))))
- t))))))
-
-(defun image-transform-properties (spec)
- "Return rescaling/rotation properties for image SPEC.
-These properties are determined by the Image mode variables
-`image-transform-resize' and `image-transform-rotation'. The
-return value is suitable for appending to an image spec.
-
-Rescaling and rotation properties only take effect if Emacs is
-compiled with ImageMagick support."
- (setq image-transform-scale 1.0)
- (when (or image-transform-resize
- (/= image-transform-rotation 0.0))
- ;; Note: `image-size' looks up and thus caches the untransformed
- ;; image. There's no easy way to prevent that.
- (let* ((size (image-size spec t))
- (resized
- (cond
- ((numberp image-transform-resize)
- (unless (= image-transform-resize 1)
- (setq image-transform-scale image-transform-resize)
- (cons nil (floor (* image-transform-resize (cdr size))))))
- ((eq image-transform-resize 'fit-width)
- (image-transform-fit-width
- (car size) (cdr size)
- (- (nth 2 (window-inside-pixel-edges))
- (nth 0 (window-inside-pixel-edges)))))
- ((eq image-transform-resize 'fit-height)
- (let ((res (image-transform-fit-width
- (cdr size) (car size)
- (- (nth 3 (window-inside-pixel-edges))
- (nth 1 (window-inside-pixel-edges))))))
- (cons (cdr res) (car res)))))))
- `(,@(when (car resized)
- (list :width (car resized)))
- ,@(when (cdr resized)
- (list :height (cdr resized)))
- ,@(unless (= 0.0 image-transform-rotation)
- (list :rotation image-transform-rotation))))))
-
-(defun image-transform-set-scale (scale)
- "Prompt for a number, and resize the current image by that amount.
-This command has no effect unless Emacs is compiled with
-ImageMagick support."
- (interactive "nScale: ")
- (setq image-transform-resize scale)
- (image-toggle-display-image))
-
-(defun image-transform-fit-to-height ()
- "Fit the current image to the height of the current window.
-This command has no effect unless Emacs is compiled with
-ImageMagick support."
- (interactive)
- (setq image-transform-resize 'fit-height)
- (image-toggle-display-image))
-(defun image-transform-fit-to-width ()
- "Fit the current image to the width of the current window.
-This command has no effect unless Emacs is compiled with
-ImageMagick support."
- (interactive)
- (setq image-transform-resize 'fit-width)
- (image-toggle-display-image))
-
-(defun image-transform-set-rotation (rotation)
- "Prompt for an angle ROTATION, and rotate the image by that amount.
-ROTATION should be in degrees. This command has no effect unless
-Emacs is compiled with ImageMagick support."
- (interactive "nRotation angle (in degrees): ")
- (setq image-transform-rotation (float (mod rotation 360)))
- (image-toggle-display-image))
(provide 'image-mode)
diff --git a/lisp/image-transform.el b/lisp/image-transform.el
new file mode 100644
index 0000000..080ae4f
--- /dev/null
+++ b/lisp/image-transform.el
@@ -0,0 +1,930 @@
+;;; image-transform.el --- support for image transformations -*-
lexical-binding: nil -*-
+;;
+;; Copyright (C) 2013 Free Software Foundation, Inc.
+;;
+;; Author: Vitalie Spinu <address@hidden>
+;; Keywords: multimedia
+;; Package: emacs
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;
+;;; Commentary:
+;;
+;;; Code:
+
+(require 'image)
+(require 'pcase)
+(eval-when-compile
+ (require 'cl-macs)
+ ;; (require 'cl-lib)
+ )
+
+
+
+;;; GENERAL IMAGE FUNCTIONS (fixme: move to image.el)
+
+(defun image-get-display-property (&optional pos)
+ (setq pos (or pos (point)))
+ (or (get-char-property pos 'display
+ ;; There might be different images for different
displays.
+ (if (eq (window-buffer) (current-buffer))
+ (selected-window)))
+ ;; overlay before-string/after-string display property, like in put-image
+ (let ((OVS (overlays-at pos))
+ ov disp)
+ (while (setq ov (pop OVS))
+ (let ((bs (overlay-get ov 'before-string))
+ (as (overlay-get ov 'after-string)))
+ ;; last one takes precedence
+ (setq disp (or (and as (get-text-property 0 'display as))
+ (and bs (get-text-property 0 'display bs))))))
+ disp)))
+
+;;;###autoload
+(defun get-image (&optional pos)
+ "Get image at POS in current buffer
+
+This function investigates text properties as well as overlays at
+POS for display property that holds an image."
+ (let* ((disp (image-get-display-property pos)))
+ (or (and (eq (car-safe disp) 'image)
+ disp)
+ ;; margin images
+ (and (eq (car-safe (cdr-safe disp)) 'image)
+ (cdr disp)))))
+
+(defun image--delete-properties (image props)
+ "Remove PROPS from IMAGE destructively.
+This is as opposed to setting them to nil. Return transformed
+image."
+ (let ((p (cdr image)))
+ (while p
+ (if (member (cadr p) props)
+ (setcdr p (nthcdr 3 p))
+ (setq p (cdr p)))
+ image)))
+
+
+;;; INTERNALS
+;; these are 3, virtuly unchenged, objects from old image-mode.el
+;; fixme: see the author
+(defvar image--right-angle-fudge 0.0001
+ "Snap distance to a multiple of a right angle.
+There's no deep theory behind the default value, it should just
+be somewhat larger than ImageMagick's MagickEpsilon.")
+
+(defsubst image--get-rotated-width (width height rotation)
+ "Return the bounding box width of a rotated WIDTH x HEIGHT rectangle.
+ROTATION is the rotation angle in degrees."
+ (let ((angle (degrees-to-radians rotation)))
+ ;; Assume, w.l.o.g., that the vertices of the rectangle have the
+ ;; coordinates (+-w/2, +-h/2) and that (0, 0) is the center of the
+ ;; rotation by the angle A. The projections onto the first axis
+ ;; of the vertices of the rotated rectangle are +- (w/2) cos A +-
+ ;; (h/2) sin A, and the difference between the largest and the
+ ;; smallest of the four values is the expression below.
+ (+ (* width (abs (cos angle))) (* height (abs (sin angle))))))
+
+;; The following comment and code snippet are from
+;; ImageMagick-6.7.4-4/magick/distort.c
+
+;; /* Set the output image geometry to calculated 'best fit'.
+;; Yes this tends to 'over do' the file image size, ON PURPOSE!
+;; Do not do this for DePolar which needs to be exact for virtual tiling.
+;; */
+;; if ( fix_bounds ) {
+;; geometry.x = (ssize_t) floor(min.x-0.5);
+;; geometry.y = (ssize_t) floor(min.y-0.5);
+;; geometry.width=(size_t) ceil(max.x-geometry.x+0.5);
+;; geometry.height=(size_t) ceil(max.y-geometry.y+0.5);
+;; }
+
+;; Other parts of the same file show that here the origin is in the
+;; left lower corner of the image rectangle, the center of the
+;; rotation is the center of the rectangle and min.x and max.x
+;; (resp. min.y and max.y) are the smallest and the largest of the
+;; projections of the vertices onto the first (resp. second) axis.
+
+(defun image--get-rotated-size (width height length &optional rotation)
+ "Return (w . h) so that a rotated w x h image has exactly width LENGTH.
+The ROTATION angle defaults 0 and SCALE to 1.
+
+Write W for WIDTH and H for HEIGHT. Then the w x h rectangle is
+an \"approximately uniformly\" scaled W x H rectangle, which
+currently means that w is one of floor(s W) + {0, 1, -1} and h is
+floor(s H), where s is a scale factor. The value of ROTATION may
+be replaced by a slightly different angle. Currently this is
+done for values close to a multiple of 90, see
+`image--right-angle-fudge'."
+ (setq rotation (or rotation 0.0))
+ (cond ((< (abs (- (mod (+ rotation 90) 180) 90))
+ image--right-angle-fudge)
+ (cl-assert (not (zerop width)) t)
+ (cons length nil))
+ ((< (abs (- (mod (+ rotation 45) 90) 45))
+ image--right-angle-fudge)
+ (cl-assert (not (zerop height)) t)
+ (cons nil length))
+ (t
+ (let (scale)
+ (cl-assert (not (and (zerop width) (zerop height))) t)
+ ;; on GNU Emacs 24.3.50.4 (i686-pc-linux-gnu, X toolkit, Xaw
+ ;; scroll bars) of 2013-07-16, image width is slightly
+ ;; truncated, ~6px, so the below mambo math for .5px
+ ;; adjustment is pretty useless.
+ (setq scale
+ (/ (float (1- length))
+ (image--get-rotated-width width height rotation)))
+ ;; Assume we have a w x h image and an angle A, and let l =
+ ;; l(w, h)) = w |cos A| + h |sin A|, which is the actual width
+ ;; of the bounding box of the rotated image, as calculated by
+ ;; `image--get-rotated-width'. The code snippet quoted above
+ ;; means that ImageMagick puts the rotated image in
+ ;; a bounding box of width L = 2 ceil((w+l+1)/2) - w.
+ ;; Elementary considerations show that this is equivalent to
+ ;; L - w being even and L-3 < l(w, h) <= L-1. In our case, L is
+ ;; the given `length' parameter and our job is to determine
+ ;; reasonable values for w and h which satisfy these
+ ;; conditions.
+ (let ((w (floor (* scale width)))
+ (h (floor (* scale height))))
+ ;; Let w and h as bound above. Then l(w, h) <= l(s W, s H)
+ ;; = L-1 < l(w+1, h+1) = l(w, h) + l(1, 1) <= l(w, h) + 2,
+ ;; hence l(w, h) > (L-1) - 2 = L-3.
+ (cons
+ ;; VS[16-07-2013]: returning (w . h) is unnecessary, it
+ ;; distorts the image and processing becomes very slow
+
+ (cond ((= (mod w 2) (mod length 2))
+ w)
+ ;; l(w+1, h) >= l(w, h) > L-3, but does l(w+1, h) <=
+ ;; L-1 hold?
+ ((<= (image--get-rotated-width (1+ w) h rotation)
+ (1- length))
+ (1+ w))
+ ;; No, it doesn't, but this implies that l(w-1, h) =
+ ;; l(w+1, h) - l(2, 0) >= l(w+1, h) - 2 > (L-1) -
+ ;; 2 = L-3. Clearly, l(w-1, h) <= l(w, h) <= L-1.
+ (t
+ (1- w)))
+ nil))))))
+
+
+
+;;; TRANSFORM API
+
+;;;###autoload
+(defun image-transform (image &rest specs)
+ "Return destructively transformed IMAGE."
+
+ ;; ROTATE is the rotation angle in degrees.
+
+ ;; RESIZE can be
+ ;; - a number, giving a proportional scaling of the image.
+ ;; - a cons, giving thesize (w x h) in pixels.
+ ;; - a symbol:
+ ;; *`fit' - maximally scale IMAGE to fit into WIN.
+ ;; *`fit-height' - fit the image to WIN's height.
+ ;; *`fit-width' - fit the image to WIN's width.
+ ;; *`fit-stretch' - stretch the image to fit to both height and
+ ;; width of WIN.
+
+ ;; WIN is a window that is used when RESIZE is a symbol. Defaults
+ ;; to the selected window.
+
+ ;; This functions uses plist-put. Thus it might, or might not
+ ;; destructively modify IMAGE.
+
+ ;; Rescaling, resizing and rotation only take effect if Emacs is
+ ;; compiled with ImageMagick support."
+
+ (let* ((resize (cadr (memq :resize specs)))
+ (rotate (cadr (memq :rotate specs)))
+ (orot (plist-get (cdr image) :rotation)))
+ (setq rotate (float (mod (+ (or rotate 0.0) (or orot 0.0)) 360)))
+ ;; Reset rotation. Otherwise returned image-size is the size of
+ ;; rotated image, and image-size seems to rotate the image
+ ;; internally before reporting the size. This could be slow. Avoid
+ ;; this and other problems by caching original size below.
+ ;; (image--delete-properties image :rotation)
+
+ (when (symbolp resize)
+
+ (unless (and (symbolp resize)
+ (member resize '(nil fit fit-if-large fit-width
+ fit-height fit-stretch)))
+ (error "Invalid :resize argument"))
+
+ (let* ((win (or (cadr (memq :WIN specs))
+ (selected-window)))
+ ;; Note: `image-size' looks up and thus caches the
+ ;; untransformed (VS[17-07-2013]: I think this changed,
+ ;; it returns transformed size for me) image. There's no
+ ;; easy way to prevent that.
+ (size (or (plist-get (cdr image) :osize)
+ (image-size image t)))
+ ;; transformed by the user: user-size
+ (usize (cons (plist-get (cdr image) :width)
+ (plist-get (cdr image) :height)))
+ newsize)
+
+ ;; (image--delete-properties image '(:width :height))
+ ;; cache original-size
+ (plist-put (cdr image) :osize size)
+
+ (setq newsize (cons (image--get-rotated-width
+ (car size) (cdr size) rotate)
+ (image--get-rotated-width
+ (cdr size) (car size) rotate)))
+
+ (plist-put specs :resize
+ ;; fixme: simplify with pcase?
+ (let* ((wedges (window-inside-pixel-edges win))
+ (wsize (cons (- (nth 2 wedges)
+ (nth 0 wedges))
+ (- (nth 3 wedges)
+ (nth 1 wedges))))
+ (resize (if (and (eq resize 'fit-if-large)
+ (or (> (car newsize) (car wsize))
+ (> (cdr newsize) (cdr wsize))))
+ 'fit
+ resize))
+ (resize (if (eq resize 'fit)
+ (if (< (/ (float (car wsize)) (cdr
wsize))
+ (/ (float (car newsize)) (cdr
newsize)))
+ 'fit-width
+ 'fit-height)
+ resize)))
+
+ (cond
+ ((eq resize 'fit-stretch)
+ (let ((res (image--get-rotated-size
+ (car wsize) (cdr wsize) (car wsize)
rotate)))
+ ;; fixme: stretching doesn't work correctly with
rotation
+ (when (null (car res))
+ (setcar res (car wsize)))
+ (when (null (cdr res))
+ (setcdr res (cdr wsize)))
+ res))
+ ((eq resize 'fit-width)
+ (image--get-rotated-size
+ (car size) (cdr size) (car wsize) rotate))
+ ((eq resize 'fit-height)
+ (let ((res (image--get-rotated-size
+ (cdr size) (car size) (cdr wsize) rotate)))
+ (cons (cdr res) (car res)))))))))
+
+ (when (or (and orot (/= rotate orot))
+ (/= rotate 0.0))
+ (plist-put specs :rotate rotate))
+
+ (let ((bfuncs (cl-loop for b in image-transform-backends
+ collect (intern (concat "image-transform:"
(symbol-name b)))))
+ timage)
+ (while (and bfuncs
+ (null (setq timage
+ (apply (pop bfuncs) image specs))))))
+ ;; (setcdr image (cdr image))
+ image))
+
+(defun image-transform-interactive (&optional image &rest specs)
+ "Like `image-transform' but finds IMAGE at point if not supplied.
+and refreshes window display. Intended to be used for user level commands."
+ (unless image
+ (unless (setq image (get-image))
+ (error "No image at point")))
+
+ (prog1 (apply 'image-transform image specs)
+ (force-window-update (selected-window))))
+
+(defun image-transform-unsupported-features (backend specs)
+ "Return unsupported features of BACKEND from the list of features in SPECS.
+SPECS is a list of :keyword value pairs like in plist but with
+value might be omitted. Features are the keywords. BACKEND is a
+symbol or string and FEATURES is a list of symbols to be looked
+in image-transform-features:BACKEND alist."
+ (let ((features (cl-loop for s in specs if (keywordp s) collect s))
+ (available (symbol-value
+ (intern (concat "image-transform-features:"
+ (if (symbolp backend)
+ (symbol-name backend)
+ backend))))))
+ (cl-loop for f in features
+ unless (assoc f available)
+ collect f)))
+
+(defcustom image-transform-backends '(imagemagick convert)
+ "Backends to try out for image transformation.
+
+For `imagemagick', `image-transform' will try to use internal
+Emacs ImageMagick support. For `convert' use external ImageMagick
+\"convert\" utility to produce a transformed temporary image
+file.
+
+If Emacs was not compiled with ImageMagick support `imagemagick'
+backend is ignored.
+
+The actual transformation functions are image-transform:BACKEND
+where BACKEND is backend's name. See `image-transform' for more."
+ :group 'image
+ :type '(repeat symbol))
+
+
+;;; IMAGEMAGICK BACKEND
+(defun image-transform:imagemagick (image &rest specs)
+ "Image transform Emacs ImageMagick backend.
+See `image-transform' for the definition of SPEC and what a
+image-transform:BACKEND function should do.
+
+Accepted arguments by this backend:
+
+:resize - If number treat as width. If string, should be of the
+form Wx, xH, WxH where x is arbitrary string not containing
+numbers. If cons: (W . H).
+
+:scale - If number scale in percent. If string, should either
+encode a number or be of the form S% where S is a number.
+
+:rotate - Number or numeric string giving the rotation in
+degrees.
+
+:background - String giving color."
+ (when (and (image-type-available-p 'imagemagick)
+ (null (image-transform-unsupported-features 'imagemagick specs)))
+ ;; first process specs and then adjust the image
+ (let ((new-specs
+ (cl-loop for s on specs by 'cddr append
+ ;; fixme: rewrite in terms of simple cons
+ (pcase s
+ (`(:resize . (,size . ,_))
+ (setq size
+ (pcase size
+ ((or (pred null)
+ (pred consp)) size)
+ ((pred numberp) (cons size nil))
+ ((pred stringp)
+ (if (image-tr--parse-geometry:convert size t)
+ (cl-return) ; resize is intended for :convert
backend,
+ (image-tr--parse-geometry:imagemagick size)))
+ ((pred keywordp) (error ":resize parameter is
empty"))
+ (_ (cl-return))))
+ `((:width . ,(car size)) (:height . ,(cdr size))))
+ (`(:scale . (,scale . ,_))
+ (setq scale
+ (pcase scale
+ ((or (pred null)
+ (pred numberp)) scale)
+ ((pred stringp) (or
(image-tr--parse-scale:imagemagick scale)
+ (cl-return))) ; not intended
for imagemagick
+ ((pred keywordp) (error ":scale parameter is
empty"))
+ (_ (cl-return))))
+ `((:scale . ,scale)))
+ (`(:background . (,bg . ,_))
+ (if (stringp bg)
+ `((:background . ,bg))
+ (if (keywordp bg)
+ (error ":background argument is emtpy")
+ (cl-return))))
+ (`(:rotate . (,rot . ,_))
+ (let ((out (pcase rot
+ ((or (pred null)
+ (pred numberp)) rot)
+ ((pred stringp) (or
(image-tr--parse-number:imagemagick rot)
+ (cl-return)))
+ ((pred keywordp) (error ":scale parameter is
empty"))
+ (_ (cl-return)))))
+ `((:rotation . ,out))))
+ (x (error "%s is not a feature in imagemagick backend"
x))))))
+ (when new-specs
+ ;; specs are correct so alter the image
+ (cl-loop for s in new-specs do
+ ;; null values have no effect? tothink: chaining effect
+ (when (cdr s)
+ (pcase s
+ (`(:width . ,w)
+ (plist-put (cdr image) :width w))
+ (`(:height . ,h)
+ (plist-put (cdr image) :height h))
+ (`(:scale . ,s)
+ (unless (= s 100)
+ (let ((s (/ s 100.0))
+ (uw (plist-get (cdr image) :width))
+ (uh (plist-get (cdr image) :height)))
+ ;; only one could have been supplied, keep it
+ (if (or uw uh)
+ (progn (when uw
+ (plist-put (cdr image)
+ :width (floor (* s uw))))
+ (when uh
+ (plist-put (cdr image)
+ :height (floor (* s uh)))))
+ (let ((size (or (plist-get (cdr image) :osize)
+ (image-size image t))))
+ (plist-put (cdr image) :osize size)
+ (plist-put (cdr image) :width (floor (* s (car
size)))))))))
+ (`(,kwd . ,val) (plist-put (cdr image) kwd val))
+ (_ (error "Unclear mess in imagemagick backend. Please
report")))))
+ (plist-put (cdr image) :type 'imagemagick)
+ image))))
+
+(defvar image-transform-features:imagemagick '((:background)
+ (:resize)
+ (:rotate)
+ (:scale))
+ "List of supported features by Emacs ImageMagick backend.")
+
+(defun image-tr--parse-geometry:imagemagick (geom)
+ "Simple geometry parser.
+Parse WxH where W and H are digits and x is arbitrary non digit
+string. Wx and xH are also fine with obvious interpretation. xHx
+is interpreted as height. Return (W . H) where W and H are
+strings representing numbers or nil."
+ ;; fixme: multiple dots are not checked
+ (if (not (string-match "^\\([0-9.]+\\)*[^0-9.]*\\([0-9.]*\\)" geom))
+ (error "Invalid geometry format supplied")
+ (let ((out (cons (match-string 1 geom)
+ (match-string 2 geom))))
+ (setcar out
+ (unless (= 0 (length (car out)))
+ (string-to-number (car out))))
+ (setcdr out
+ (unless (= 0 (length (cdr out)))
+ (string-to-number (cdr out)))))))
+
+(defun image-tr--parse-scale:imagemagick (scale)
+ (when (string-match "^ *\\([0-9.]\\)%? *$" scale)
+ (string-to-number (match-string 1 scale))))
+
+(defun image-tr--parse-number:imagemagick (scale)
+ (when (string-match "^ *\\([0-9.]\\) *$" scale)
+ (string-to-number (match-string 1 scale))))
+
+
+;;; CONVERT BACKEND
+
+(defun image-transform:convert (image &rest specs)
+ nil)
+
+(defun image-tr--parse-geometry:convert (geom &optional specific?)
+ "If geom is an ImageMagick geometry specification return GEOM else nil.
+If SPECIFIC is non-nil match only the specific convert regexp.
+See http://www.imagemagick.org/script/command-line-processing.php#geometry";
+ (when (and geom
+ (string-match-p
+ (concat "^ *"
+ (unless specific? "[0-9.]+\\|" )
+
"\\([0-9.]+%\\|[0-9.]+%x[0-9.]+%\\|[0-9.]+x[0-9.]+[!<>^]?\\|address@hidden) *$")
+ geom))
+ geom))
+
+(defvar image-transform-features:convert
+ "Convert backend features.
+An alist of values like (:feature type 'description'). If type is
+nil, this is a boolean option."
+
+ '(
+ ;; Image Settings:
+ (:adjoin nil "join images into a single multi-image file")
+ (:affine 'matrix "affine transform matrix")
+ (:antialias nil "remove pixel-aliasing")
+ (:authenticate 'value "decrypt image with this password")
+ (:background 'color "background color")
+ (:bias 'value "add bias when convolving an image")
+ (:black-point-compensation nil "use black point compensation")
+ (:blue-primary 'point "chromaticity blue primary point")
+ (:bordercolor 'color "border color")
+ (:caption 'string "assign a caption to an image")
+ (:cdl 'filename "color correct with a color decision list")
+ (:channel 'type "apply option to select image channels")
+ (:colors 'value "preferred number of colors in the image")
+ (:colorspace 'type "alternate image colorspace")
+ (:comment 'string "annotate image with comment")
+ (:compose 'operator "set image composite operator")
+ (:compress 'type "type of pixel compression when writing the image")
+ (:decipher 'filename "convert cipher pixels to plain pixels")
+ (:define 'format:option "define one or more image format options")
+ (:delay 'value "display the next image after pausing")
+ (:density 'geometry "horizontal and vertical density of the image")
+ (:depth 'value "image depth")
+ (:direction 'type "render text right-to-left or left-to-right")
+ (:display 'server "get image or font from this X server")
+ (:dispose 'method "layer disposal method")
+ (:dither 'method "apply error diffusion to image")
+ (:encipher 'filename "convert plain pixels to cipher pixels")
+ (:encoding 'type "text encoding type")
+ (:endian 'type "endianness (MSB or LSB) of the image")
+ (:family 'name "render text with this font family")
+ (:features 'distance "analyze image features (e.g. contrast,
correlation")
+ (:fill 'color "color to use when filling a graphic primitive")
+ (:filter 'type "use this filter when resizing an image")
+ (:flatten nil "flatten a sequence of images")
+ (:font 'name "render text with this font")
+ (:format 'string "output formatted image characteristics")
+ (:fuzz 'distance "colors within this distance are considered equal")
+ (:gravity 'type "horizontal and vertical text placement")
+ (:green-primary point "chromaticity green primary point")
+ (:intent 'type "type of rendering intent when managing the image
color")
+ (:interlace 'type "type of image interlacing scheme")
+ (:interpolate 'method "pixel color interpolation method")
+ (:kerning 'value "set the space between two letters")
+ (:label 'string "assign a label to an image")
+ (:limit type value "pixel cache resource limit")
+ (:loop 'iterations "add Netscape loop extension to your GIF animation")
+ (:mask 'filename "associate a mask with the image")
+ (:matte nil "store matte channel if the image has one")
+ (:mattecolor 'color "frame color")
+ (:monitor nil "monitor progress")
+ (:orient 'type "image orientation")
+ (:origin 'geometry "image origin")
+ (:page 'geometry "size and location of an image canvas (setting)")
+ (:ping nil "efficiently determine image attributes")
+ (:pointsize 'value "font point size")
+ (:preview 'type "image preview type")
+ (:quality 'value "JPEG/MIFF/PNG compression level")
+ (:quiet nil "suppress all warning messages")
+ (:red-primary 'point "chromaticity red primary point")
+ (:regard-warnings nil "pay attention to warning messages")
+ (:sampling-factor 'geometry "horizontal and vertical sampling
factor")
+ (:scene 'value "image scene number")
+ (:seed 'value "seed a new sequence of pseudo-random numbers")
+ (:size 'geometry "width and height of image")
+ (:statistic type geometry "replace each pixel with corresponding
statistic from the neighborhood")
+ (:stretch 'type "render text with this font stretch")
+ (:stroke 'color "graphic primitive stroke color")
+ (:strokewidth 'value "graphic primitive stroke width")
+ (:style 'type "render text with this font style")
+ (:support 'factor "resize support: > 1.0 is blurry, < 1.0 is sharp")
+ (:synchronize nil "synchronize image to storage device")
+ (:taint nil "declare the image as modified")
+ (:texture 'filename "name of texture to tile onto the image
background")
+ (:tile-offset 'geometry "tile offset")
+ (:treedepth 'value "color tree depth")
+ (:transparent-color 'color "transparent color")
+ (:undercolor 'color "annotation bounding box color")
+ (:units 'type "the units of image resolution")
+ (:verbose nil "print detailed information about the image")
+ (:view nil "FlashPix viewing transforms")
+ (:virtual-pixel 'method "virtual pixel access method")
+ (:weight 'type "render text with this font weight")
+ (:white-point 'point "chromaticity white point")
+
+ ;; Image Operators:
+ (:adaptive-blur 'geometry "adaptively blur pixels, decrease effect near
edges")
+ (:adaptive-resize 'geometry "adaptively resize image with data
dependent triangulation")
+ (:adaptive-sharpen 'geometry "adaptively sharpen pixels, increase
effect near edges")
+ (:annotate geometry text "annotate the image with text")
+ (:auto-orient nil "automatically orient image")
+ (:black-threshold 'value "force all pixels below the threshold into
black")
+ (:blur 'geometry "reduce image noise and reduce detail levels")
+ (:border 'geometry "surround image with a border of color")
+ (:charcoal 'radius "simulate a charcoal drawing")
+ (:chop 'geometry "remove pixels from the image interior")
+ (:clip nil "clip along the first path from the 8BIM profile")
+ (:clip-mask 'filename "associate a clip mask with the image")
+ (:clip-path 'id "clip along a named path from the 8BIM profile")
+ (:colorize 'value "colorize the image with the fill color")
+ (:color-matrix 'matrix "apply color correction to the image")
+ (:contrast nil "enhance or reduce the image contrast")
+ (:contrast-stretch 'geometry "improve contrast by `stretching' the
intensity range")
+ (:convolve 'coefficients "apply a convolution kernel to the image")
+ (:cycle 'amount "cycle the image colormap")
+ (:despeckle nil "reduce the speckles within an image")
+ (:draw 'string "annotate the image with a graphic primitive")
+ (:edge 'radius "apply a filter to detect edges in the image")
+ (:emboss 'radius "emboss an image")
+ (:enhance nil "apply a digital filter to enhance a noisy image")
+ (:equalize nil "perform histogram equalization to an image")
+ (:evaluate operator value "evaluate an arithmetic, relational, or logical
expression")
+ (:extent 'geometry "set the image size")
+ (:extract 'geometry "extract area from image")
+ (:fft nil "implements the discrete Fourier transform (DFT)")
+ (:flip nil "flip image vertically")
+ (:floodfill 'geometry-color "floodfill the image with color") ;??
+ (:flop nil "flop image horizontally")
+ (:frame 'geometry "surround image with an ornamental border")
+ (:function 'name "apply a function to the image")
+ (:gamma 'value "level of gamma correction")
+ (:gaussian-blur 'geometry "reduce image noise and reduce detail levels")
+ (:geometry 'geometry "preferred size or location of the image")
+ (:identify nil "identify the format and characteristics of the image")
+ (:ift nil "implements the inverse discrete Fourier transform (DFT)")
+ (:implode 'amount "implode image pixels about the center")
+ (:lat 'geometry "local adaptive thresholding")
+ (:layers 'method "optimize or compare image layers")
+ (:level 'value "adjust the level of image contrast")
+ (:linear-stretch 'geometry "improve contrast by `stretching with
saturation' the intensity range")
+ (:median 'geometry "apply a median filter to the image")
+ (:mode 'geometry "make each pixel the 'predominant color' of the
neighborhood")
+ (:modulate 'value "vary the brightness, saturation, and hue")
+ (:monochrome nil "transform image to black and white")
+ (:morphology 'method-kernel "apply a morphology method to the
image") ;;??
+ (:motion-blur 'geometry "simulate motion blur")
+ (:negate nil "replace each pixel with its complementary color")
+ (:noise 'geometry "add or reduce noise in an image")
+ (:normalize nil "transform image to span the full range of colors")
+ (:opaque 'color "change this color to the fill color")
+ (:ordered-dither 'NxN "add a noise pattern to the image with specific
amplitudes")
+ (:paint 'radius "simulate an oil painting")
+ (:polaroid 'angle "simulate a Polaroid picture")
+ (:posterize 'levels "reduce the image to a limited number of color
levels")
+ (:print 'string "interpret string and print to console")
+ (:profile 'filename "add, delete, or apply an image profile")
+ (:quantize 'colorspace "reduce colors in this colorspace")
+ (:radial-blur 'angle "radial blur the image")
+ (:raise 'value "lighten/darken image edges to create a 3-D effect")
+ (:random-threshold 'low,high "random threshold the image")
+ (:region 'geometry "apply options to a portion of the image")
+ (:render nil "render vector graphics")
+ (:repage 'geometry "size and location of an image canvas")
+ (:resample 'geometry "change the resolution of an image")
+ (:resize 'geometry "resize the image")
+ (:roll 'geometry "roll an image vertically or horizontally")
+ (:rotate 'degrees "apply Paeth rotation to the image")
+ (:sample 'geometry "scale image with pixel sampling")
+ (:scale 'geometry "scale the image")
+ (:segment 'values "segment an image")
+ (:selective-blur 'geometry "selectively blur pixels within a contrast
threshold")
+ (:sepia-tone 'threshold "simulate a sepia-toned photo")
+ (:set property value "set an image property")
+ (:shade 'degrees "shade the image using a distant light source")
+ (:shadow 'geometry "simulate an image shadow")
+ (:sharpen 'geometry "sharpen the image")
+ (:shave 'geometry "shave pixels from the image edges")
+ (:shear 'geometry "slide one edge of the image along the X or Y axis")
+ (:sigmoidal-contrast 'geometry "lightness rescaling using sigmoidal
contrast enhancement")
+ (:sketch 'geometry "simulate a pencil sketch")
+ (:solarize 'threshold "negate all pixels above the threshold level")
+ (:splice 'geometry "splice the background color into the image")
+ (:spread 'amount "displace image pixels by a random amount")
+ (:strip nil "strip image of all profiles and comments")
+ (:swirl 'degrees "swirl image pixels about the center")
+ (:threshold 'value "threshold the image")
+ (:thumbnail 'geometry "create a thumbnail of the image")
+ (:tile 'filename "tile image when filling a graphic primitive")
+ (:tint 'value "tint the image with the fill color")
+ (:transform nil "affine transform image")
+ (:transparent 'color "make this color transparent within the image")
+ (:transpose nil "flip image vertically and rotate 90 degrees")
+ (:transverse nil "flop image horizontally and rotate 270 degrees")
+ (:trim nil "trim image edges")
+ (:type 'type "image type")
+ (:unique-colors nil "discard all but one of any pixel color")
+ (:unsharp 'geometry "sharpen the image")
+ (:vignette 'geometry "soften the edges of the image in vignette
style")
+ (:wave 'geometry "alter an image along a sine wave")
+ (:white-threshold 'value "force all pixels above the threshold into
white")
+
+ ;; Image Sequence Operators:
+ (:affinity 'filename "transform image colors to match this set of
colors")
+ (:append nil "append an image sequence top to bottom (use +append
for left to right)")
+ (:clut nil "apply a color lookup table to the image")
+ (:coalesce nil "merge a sequence of images")
+ (:combine nil "combine a sequence of images")
+ (:composite nil "composite image")
+ (:crop 'geometry "cut out a rectangular region of the image")
+ (:deconstruct nil "break down an image sequence into constituent parts")
+ (:evaluate-sequence 'operator "evaluate an arithmetic, relational, or
logical expression")
+ (:flatten nil "flatten a sequence of images")
+ (:fx 'expression "apply mathematical expression to an image channel(s)")
+ (:hald-clut nil "apply a Hald color lookup table to the image")
+ (:morph 'value "morph an image sequence")
+ (:mosaic nil "create a mosaic from an image sequence")
+ (:process 'arguments "process the image with a custom image filter")
+ (:separate nil "separate an image channel into a grayscale image")
+ (:smush 'geometry "smush an image sequence together")
+ (:write 'filename "write images to this file")
+
+ ;; Image Stack Operators:
+ (:clone 'indexes "clone an image")
+ (:delete 'indexes "delete the image from the image sequence")
+ (:duplicate 'count,indexes "duplicate an image one or more times")
+ (:insert 'index "insert last image into the image sequence")
+ (:swap 'indexes "swap two images in the image sequence")
+
+ ;; Miscellaneous Options:
+ (:debug 'events "display copious debugging information")
+ (:help nil "print program options")
+ (:log 'format "format of debugging information")
+ (:list 'type "print a list of supported option arguments")
+ (:version nil "print version information")
+ ))
+
+
+
+;;; Transform UI
+
+(defcustom image-scale-step 1.1
+ "Each positive or negative step scales the current image by
+this amount."
+ :type 'number
+ :group 'image)
+
+;;;###autoload
+(defun image-scale-adjust (&optional inc)
+ "Adjust the scale of the image by INC.
+
+INC may be passed as a numeric prefix argument.
+
+The actual adjustment made depends on the final component of the
+key-binding used to invoke the command, with all modifiers removed:
+
+ +, = Increase the size of the image by one step
+ - Decrease the size of the image by one step
+ 0 Reset to the original image size
+
+When adjusting with `+' or `-', continue to read input events and
+further adjust the face height as long as the input event read
+\(with all modifiers removed) is `+' or `-'.
+
+Each step scales the image by the value of `image-scale-step' (a
+negative number of steps decreases the height by the same
+amount). As a special case, an argument of 0 will remove any
+scaling currently active.
+
+This command is a special-purpose wrapper around the
+`image-scale-increase'."
+ ;; fixme: doesn't work with universal arg
+ (interactive "p")
+ (let ((ev last-command-event)
+ (echo-keystrokes nil))
+ (let* ((base (event-basic-type ev))
+ (step
+ (pcase base
+ ((or ?+ ?=) inc)
+ (?- (- inc))
+ (?0 0)
+ (t inc))))
+ (image-scale-increase step)
+ (message "Use +,-,0 for further adjustment")
+ (set-temporary-overlay-map
+ (let ((map (make-sparse-keymap)))
+ (dolist (mods '(() (control)))
+ (dolist (key '(?- ?+ ?= ?0)) ;; = is often unshifted +.
+ (define-key map (vector (append mods (list key)))
+ `(lambda () (interactive) (image-scale-adjust (abs ,inc))))))
+ map)))))
+
+;;;###autoload
+(defun image-scale-increase (&optional inc image)
+ "Increase the size of the IMAGE by INC steps.
+
+IMAGE defaults to the image at point found by `get-image'.
+
+Each step scales up the size of the IMAGE the value of
+`text-scale-mode-step' (a negative number of steps decreases the
+size by the same amount). As a special case, an argument of 0
+will remove any scaling currently active.
+
+This command has no unless Emacs is compiled with
+ImageMagick support."
+ (interactive "p")
+ (unless image
+ (unless (setq image (get-image))
+ (error "No image at point")))
+ (if (/= inc 0)
+ (image-transform image :scale (* 100 (expt image-scale-step inc)))
+ (image--delete-properties image '(:width :height)))
+ (force-window-update (selected-window)))
+
+;;;###autoload
+(defun image-scale-decrease (&optional inc image)
+ "Decrease the size of the IMAGE by INC steps.
+
+IMAGE defaults to the image at point found by `get-image'.
+
+Each step scales down the size of the IMAGE the value of
+`text-scale-mode-step' (a negative number of steps increases the
+size by the same amount). As a special case, an argument of 0
+will remove any scaling currently active.
+
+This command has no effect unless Emacs is compiled with
+ImageMagick support."
+ (interactive "p")
+ (image-scale-increase (- inc) image))
+
+;;;###autoload
+(defun image-fit-to-window-height (&optional image)
+ "Fit IMAGE to the height of the current window.
+If not provided, IMAGE is the image at point.
+
+This command has no effect unless Emacs is compiled with
+ImageMagick support."
+ (interactive)
+ (image-transform-interactive image :resize 'fit-height))
+
+;;;###autoload
+(defun image-fit-to-window-width (&optional image)
+ "Fit IMAGE to the width of the current window.
+If not provided, IMAGE is the image at point.
+
+This command has no effect unless Emacs is compiled with
+ImageMagick support."
+ (interactive)
+ (image-transform-interactive image :resize 'fit-width))
+
+;;;###autoload
+(defun image-fit-to-window (&optional image)
+ "Maximally fit IMAGE into current window.
+If not provided, IMAGE is the image at point.
+
+This command has no effect unless Emacs is compiled with
+ImageMagick support."
+ (interactive)
+ (image-transform-interactive image :resize 'fit))
+
+;;;###autoload
+(defun image-stretch-to-window (&optional image)
+ "Stretch IMAGE into current window.
+If not provided, IMAGE is the image at point.
+
+This command has no effect unless Emacs is compiled with
+ImageMagick support."
+ (interactive)
+ (image-transform-interactive image :resize 'fit-stretch))
+
+;;;###autoload
+(defun image-rotate (rotation &optional image)
+ "Prompt for an angle ROTATION, and rotate the image by that amount.
+ROTATION should be in degrees.
+
+This command has no effect unless Emacs is compiled with
+ImageMagick support."
+ (interactive "nRotation angle (in degrees): ")
+ (image-transform-interactive image :rotate rotation))
+
+;;;###autoload
+(defun image-rotate-right (&optional image)
+ "Rotate the image clockwise by 90 degrees.
+
+This command has no effect unless Emacs is compiled with
+ImageMagick support."
+ (interactive)
+ (image-transform-interactive image :rotate 90))
+
+;;;###autoload
+(defun image-rotate-left (&optional image)
+ "Rotate the image counter-clockwise by 90 degrees.
+
+This command has no effect unless Emacs is compiled with
+ImageMagick support."
+ (interactive)
+ (image-transform-interactive image :rotate -90))
+
+;;;###autoload
+(defun image-change-background (&optional background image)
+ "Set background of the IMAGE to BACKGROUND.
+For this to work, image must have a transparent background.
+If not provided, IMAGE is the image at point.
+
+This command has no effect unless Emacs is compiled with
+ImageMagick support."
+ (interactive)
+ (let ((bg (or background (read-color "Background: " t))))
+ (unless image
+ (unless (setq image (get-image))
+ (error "No image at point")))
+ (image-transform-interactive image :background bg)))
+
+(defun image--add-transform-keys (map &optional mod)
+ "Add manipulation keys to MAP.
+MOD is a vector of modifiers, like [control] or [control meta]."
+ (define-key map (vector `(,@mod ?+)) 'image-scale-adjust)
+ (define-key map (vector `(,@mod ?-)) 'image-scale-adjust)
+ (define-key map (vector `(,@mod ?=)) 'image-scale-adjust)
+ (define-key map (vector `(,@mod ?0)) 'image-scale-adjust)
+ (define-key map (vector `(,@mod ?o)) 'image-rotate)
+ (define-key map (vector `(,@mod ?\])) 'image-rotate-right)
+ (define-key map (vector `(,@mod ?\[)) 'image-rotate-left)
+ (define-key map (vector `(,@mod ?r) `(,@mod ?f)) 'image-fit-to-window)
+ (define-key map (vector `(,@mod ?r) `(,@mod ?h)) 'image-fit-to-window-height)
+ (define-key map (vector `(,@mod ?r) `(,@mod ?w)) 'image-fit-to-window-width)
+ (define-key map (vector `(,@mod ?r) `(,@mod ?s)) 'image-stretch-to-window)
+ (define-key map (vector `(,@mod shift ?b)) 'image-change-background)
+ map)
+
+;;;###autoload
+(defvar image-transform-map
+ (let ((map (make-sparse-keymap)))
+ (image--add-transform-keys map))
+ "Image manipulation keymap.
+Usually used as keymap text property for images. See also
+`image--add-transform-keys' for how to add manipulation keys
+to a map with modifiers.
+
+\\{image-transform-map}")
+
+
+(provide 'image-transform)
diff --git a/lisp/image.el b/lisp/image.el
index 804dc3a..63bebdf 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -425,7 +425,7 @@ means display it in the right marginal area."
;;;###autoload
-(defun insert-image (image &optional string area slice)
+(defun insert-image (image &optional string area slice map)
"Insert IMAGE into current buffer at point.
IMAGE is displayed by inserting STRING into the current buffer
with a `display' property whose value is the image. STRING
@@ -438,7 +438,10 @@ SLICE specifies slice of IMAGE to insert. SLICE nil or
omitted
means insert whole image. SLICE is a list (X Y WIDTH HEIGHT)
specifying the X and Y positions and WIDTH and HEIGHT of image area
to insert. A float value 0.0 - 1.0 means relative to the width or
-height of the image; integer values are taken as pixel values."
+height of the image; integer values are taken as pixel values.
+If MAP is provided, it must be a keymap what will be used as
+text property keymap. A special value of t means to use
+`image-transform-map'"
;; Use a space as least likely to cause trouble when it's a hidden
;; character in the buffer.
(unless string (setq string " "))
@@ -455,12 +458,16 @@ height of the image; integer values are taken as pixel
values."
;; cut-and-paste. (Yanking killed image text next to another copy
;; of it loses anyway.)
(setq image (cons 'image (cdr image))))
+ (when (eq map t)
+ (setq map image-transform-map))
(let ((start (point)))
(insert string)
(add-text-properties start (point)
`(display ,(if slice
(list (cons 'slice slice) image)
- image) rear-nonsticky (display)))))
+ image)
+ rear-nonsticky (display)
+ keymap ,map))))
;;;###autoload
- Re: imagemagic in image-mode and image-dired-thumbnail-mode?, (continued)
- Re: imagemagic in image-mode and image-dired-thumbnail-mode?, Stefan Monnier, 2013/07/16
- Re: imagemagic in image-mode and image-dired-thumbnail-mode?, Vitalie Spinu, 2013/07/17
- Re: imagemagic in image-mode and image-dired-thumbnail-mode?, Vitalie Spinu, 2013/07/17
- Re: imagemagic in image-mode and image-dired-thumbnail-mode?, Lars Magne Ingebrigtsen, 2013/07/18
- Re: imagemagic in image-mode and image-dired-thumbnail-mode?, Vitalie Spinu, 2013/07/18
- Re: imagemagic in image-mode and image-dired-thumbnail-mode?, Stefan Monnier, 2013/07/19
- Re: imagemagic in image-mode and image-dired-thumbnail-mode?, Vitalie Spinu, 2013/07/20
- Re: imagemagic in image-mode and image-dired-thumbnail-mode?, Vitalie Spinu, 2013/07/22
- Re: imagemagic in image-mode and image-dired-thumbnail-mode?, Lars Magne Ingebrigtsen, 2013/07/22
- Re: imagemagic in image-mode and image-dired-thumbnail-mode?, Vitalie Spinu, 2013/07/23
- image-transform.el and image-mode.el rewrite,
Vitalie Spinu <=
- Re: image-transform.el and image-mode.el rewrite, Wolfgang Jenkner, 2013/07/19
- Re: image-transform.el and image-mode.el rewrite, Wolfgang Jenkner, 2013/07/19
- Re: image-transform.el and image-mode.el rewrite, Vitalie Spinu, 2013/07/20
- Re: image-transform.el and image-mode.el rewrite, Glenn Morris, 2013/07/22
- Re: image-transform.el and image-mode.el rewrite, Vitalie Spinu, 2013/07/22