;;; image.el --- image API
-;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2016 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: multimedia
(defconst image-type-header-regexps
`(("\\`/[\t\n\r ]*\\*.*XPM.\\*/" . xpm)
- ("\\`P[1-6]\\\(?:\
+ ("\\`P[1-6]\\(?:\
\\(?:\\(?:#[^\r\n]*[\r\n]\\)?[[:space:]]\\)+\
\\(?:\\(?:#[^\r\n]*[\r\n]\\)?[0-9]\\)+\
\\)\\{2\\}" . pbm)
:type '(repeat (choice directory variable))
:initialize 'custom-initialize-delay)
+(defcustom image-scaling-factor 'auto
+ "When displaying images, apply this scaling factor before displaying.
+This is not supported for all image types, and is mostly useful
+when you have a high-resolution monitor.
+The value is either a floating point number (where numbers higher
+than 1 means to increase the size and lower means to shrink the
+size), or the symbol `auto', which will compute a scaling factor
+based on the font pixel size."
+ :type '(choice number
+ (const :tag "Automatically compute" auto))
+ :group 'image
+ :version "25.2")
+
+;; Map put into text properties on images.
+(defvar image-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "-" 'image-decrease-size)
+ (define-key map "+" 'image-increase-size)
+ (define-key map "r" 'image-rotate)
+ (define-key map "o" 'image-save)
+ map))
(defun image-load-path-for-library (library image &optional path no-error)
"Return a suitable search path for images used by LIBRARY.
(let* ((load-path (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\"))
(image-load-path (cons (car load-path)
- (when (boundp 'image-load-path)
+ (when (boundp \\='image-load-path)
image-load-path))))
(mh-tool-bar-folder-buttons-init))"
(unless library (error "No library specified"))
use its file extension as image type.
Optional DATA-P non-nil means SOURCE is a string containing image data."
(when (and (not data-p) (not (stringp source)))
- (error "Invalid image file name ‘%s’" source))
+ (error "Invalid image file name `%s'" source))
(unless type
(setq type (if data-p
(image-type-from-data source)
(image-type-from-file-name source))))
(or type (error "Cannot determine image type")))
(or (memq type (and (boundp 'image-types) image-types))
- (error "Invalid image type ‘%s’" type))
+ (error "Invalid image type `%s'" type))
type)
(if (fboundp 'image-metadata) ; eg not --without-x
(define-obsolete-function-alias 'image-extension-data
- 'image-metadata' "24.1"))
+ 'image-metadata "24.1"))
(define-obsolete-variable-alias
'image-library-alist
(setq type (image-type file-or-data type data-p))
(when (image-type-available-p type)
(append (list 'image :type type (if data-p :data :file) file-or-data)
+ (and (not (plist-get props :scale))
+ (list :scale
+ (image-compute-scaling-factor image-scaling-factor)))
props)))
+(defun image--set-property (image property value)
+ "Set PROPERTY in IMAGE to VALUE.
+Internal use only."
+ (if (null value)
+ (while (cdr image)
+ ;; IMAGE starts with the symbol `image', and the rest is a
+ ;; plist. Decouple plist entries where the key matches
+ ;; the property.
+ (if (eq (cadr image) property)
+ (setcdr image (cddr image))
+ (setq image (cddr image))))
+ ;; Just enter the new value.
+ (plist-put (cdr image) property value))
+ value)
+
+(defun image-property (image property)
+ "Return the value of PROPERTY in IMAGE.
+Properties can be set with
+
+ (setf (image-property IMAGE PROPERTY) VALUE)
+If VALUE is nil, PROPERTY is removed from IMAGE."
+ (declare (gv-setter image--set-property))
+ (plist-get (cdr image) property))
+
+(defun image-compute-scaling-factor (scaling)
+ (cond
+ ((numberp image-scaling-factor)
+ image-scaling-factor)
+ ((eq image-scaling-factor 'auto)
+ (let ((width (/ (float (window-width nil t)) (window-width))))
+ ;; If we assume that a typical character is 10 pixels in width,
+ ;; then we should scale all images according to how wide they
+ ;; are. But don't scale images down.
+ (if (< width 10)
+ 1
+ (/ (float width) 10))))
+ (t
+ (error "Invalid scaling factor %s" image-scaling-factor))))
;;;###autoload
(defun put-image (image pos &optional string area)
(put-text-property 0 (length string) 'display prop string)
(overlay-put overlay 'put-image t)
(overlay-put overlay 'before-string string)
+ (overlay-put overlay 'map image-map)
overlay)))
(add-text-properties start (point)
`(display ,(if slice
(list (cons 'slice slice) image)
- image) rear-nonsticky (display)))))
+ image)
+ rear-nonsticky (display)
+ keymap ,image-map))))
;;;###autoload
(insert string)
(add-text-properties start (point)
`(display ,(list (list 'slice x y dx dy) image)
- rear-nonsticky (display)))
+ rear-nonsticky (display)
+ keymap ,image-map))
(setq x (+ x dx))))
(setq x 0.0
y (+ y dy))
;; Subtract off the time we took to load the image from the
;; stated delay time.
(delay (max (+ (* (or (cdr animation) image-default-frame-delay)
- (/ 1 (abs speed)))
+ (/ 1.0 (abs speed)))
time (- (float-time)))
image-minimum-frame-delay))
done)
(imagemagick-register-types)
+(defun image-increase-size (n)
+ "Increase the image size by a factor of N.
+If N is 3, then the image size will be increased by 30%. The
+default is 20%."
+ (interactive "P")
+ (image--change-size (if n
+ (1+ (/ n 10))
+ 1.2)))
+
+(defun image-decrease-size (n)
+ "Decrease the image size by a factor of N.
+If N is 3, then the image size will be decreased by 30%. The
+default is 20%."
+ (interactive "P")
+ (image--change-size (if n
+ (- 1 (/ n 10))
+ 0.8)))
+
+(defun image--get-image ()
+ (let ((image (or (get-text-property (point) 'display)
+ ;; `put-image' uses overlays, so find an image in
+ ;; the overlays.
+ (seq-find (lambda (overlay)
+ (overlay-get overlay 'display))
+ (overlays-at (point))))))
+ (when (or (not (consp image))
+ (not (eq (car image) 'image)))
+ (error "No image under point"))
+ image))
+
+(defun image--get-imagemagick-and-warn ()
+ (unless (fboundp 'imagemagick-types)
+ (error "Can't rescale images without ImageMagick support"))
+ (let ((image (image--get-image)))
+ (image-flush image)
+ (plist-put (cdr image) :type 'imagemagick)
+ image))
+
+(defun image--change-size (factor)
+ (let* ((image (image--get-imagemagick-and-warn))
+ (new-image (image--image-without-parameters image))
+ (scale (image--current-scaling image new-image)))
+ (setcdr image (cdr new-image))
+ (plist-put (cdr image) :scale (* scale factor))))
+
+(defun image--image-without-parameters (image)
+ (cons (pop image)
+ (let ((new nil))
+ (while image
+ (let ((key (pop image))
+ (val (pop image)))
+ (unless (memq key '(:scale :width :height :max-width :max-height))
+ (setq new (nconc new (list key val))))))
+ new)))
+
+(defun image--current-scaling (image new-image)
+ ;; The image may be scaled due to many reasons (:scale, :max-width,
+ ;; etc), so find out what the current scaling is based on the
+ ;; original image size and the displayed size.
+ (let ((image-width (car (image-size new-image t)))
+ (display-width (car (image-size image t))))
+ (/ (float display-width) image-width)))
+
+(defun image-rotate ()
+ "Rotate the image under point by 90 degrees clockwise."
+ (interactive)
+ (let ((image (image--get-imagemagick-and-warn)))
+ (plist-put (cdr image) :rotation
+ (float (+ (or (plist-get (cdr image) :rotation) 0) 90)))))
+
+(defun image-save ()
+ "Save the image under point."
+ (interactive)
+ (let ((image (get-text-property (point) 'display)))
+ (when (or (not (consp image))
+ (not (eq (car image) 'image)))
+ (error "No image under point"))
+ (with-temp-buffer
+ (let ((file (plist-get (cdr image) :file)))
+ (if file
+ (if (not (file-exists-p file))
+ (error "File %s no longer exists" file)
+ (insert-file-contents-literally file))
+ (insert (plist-get (cdr image) :data))))
+ (write-region (point-min) (point-max)
+ (read-file-name "Write image to file: ")))))
+
(provide 'image)
;;; image.el ends here