diff options
Diffstat (limited to 'lisp/image.el')
| -rw-r--r-- | lisp/image.el | 186 |
1 files changed, 167 insertions, 19 deletions
diff --git a/lisp/image.el b/lisp/image.el index 663afa7764..08df7d4aa1 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -1,4 +1,4 @@ -;;; image.el --- image API +;;; image.el --- image API -*- lexical-binding:t -*- ;; Copyright (C) 1998-2016 Free Software Foundation, Inc. @@ -25,7 +25,6 @@ ;;; Code: - (defgroup image () "Image support." :group 'multimedia) @@ -124,8 +123,28 @@ value is used as a list of directories to search. Subdirectories are not automatically included in the search." :type '(repeat (choice directory variable)) - :initialize 'custom-initialize-delay) - + :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)) + :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. @@ -409,8 +428,48 @@ Image file names that are not absolute are searched for in the (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 scaling) scaling) + ((eq scaling '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" scaling)))) ;;;###autoload (defun put-image (image pos &optional string area) @@ -437,6 +496,7 @@ means display it in the right marginal 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))) @@ -476,7 +536,9 @@ height of the image; integer values are taken as pixel values." (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 @@ -512,7 +574,8 @@ The image is automatically split into ROWS x COLS slices." (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)) @@ -663,9 +726,9 @@ number, play until that number of seconds has elapsed." (if (setq timer (image-animate-timer image)) (cancel-timer timer)) (plist-put (cdr image) :animate-buffer (current-buffer)) - (run-with-timer 0.2 nil 'image-animate-timeout + (run-with-timer 0.2 nil #'image-animate-timeout image (or index 0) (car animation) - 0 limit)))) + 0 limit (+ (float-time) 0.2))))) (defun image-animate-timer (image) "Return the animation timer for image IMAGE." @@ -674,7 +737,7 @@ number, play until that number of seconds has elapsed." (while tail (setq timer (car tail) tail (cdr tail)) - (if (and (eq (timer--function timer) 'image-animate-timeout) + (if (and (eq (timer--function timer) #'image-animate-timeout) (eq (car-safe (timer--args timer)) image)) (setq tail nil) (setq timer nil))) @@ -714,7 +777,7 @@ multiplication factor for the current value." ;; hence we need to call image-multi-frame-p to return it. ;; But it also returns count, so why do we bother passing that as an ;; argument? -(defun image-animate-timeout (image n count time-elapsed limit) +(defun image-animate-timeout (image n count time-elapsed limit target-time) "Display animation frame N of IMAGE. N=0 refers to the initial animation frame. COUNT is the total number of frames in the animation. @@ -727,7 +790,12 @@ The minimum delay between successive frames is `image-minimum-frame-delay'. If the image has a non-nil :speed property, it acts as a multiplier for the animation speed. A negative value means to animate in reverse." - (when (buffer-live-p (plist-get (cdr image) :animate-buffer)) + (when (and (buffer-live-p (plist-get (cdr image) :animate-buffer)) + ;; Delayed more than two seconds more than expected. + (or (<= (- (float-time) target-time) 2) + (progn + (message "Stopping animation; animation possibly too big") + nil))) (image-show-frame image n t) (let* ((speed (image-animate-get-speed image)) (time (float-time)) @@ -750,8 +818,9 @@ for the animation speed. A negative value means to animate in reverse." (if (numberp limit) (setq done (>= time-elapsed limit))) (unless done - (run-with-timer delay nil 'image-animate-timeout - image n count time-elapsed limit))))) + (run-with-timer delay nil #'image-animate-timeout + image n count time-elapsed limit + (+ (float-time) delay)))))) (defvar imagemagick-types-inhibit) @@ -837,12 +906,11 @@ has no effect." :type '(choice (const :tag "Support all ImageMagick types" nil) (const :tag "Disable all ImageMagick types" t) (repeat symbol)) - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (symbol value) (set-default symbol value) (imagemagick-register-types)) - :version "24.3" - :group 'image) + :version "24.3") (defcustom imagemagick-enabled-types '(3FR ART ARW AVS BMP BMP2 BMP3 CAL CALS CMYK CMYKA CR2 CRW @@ -875,15 +943,95 @@ has no effect." (repeat :tag "List of types" (choice (symbol :tag "type") (regexp :tag "regexp")))) - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (symbol value) (set-default symbol value) (imagemagick-register-types)) - :version "24.3" - :group 'image) + :version "24.3") (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 (get-text-property (point) 'display))) + (unless (eq (car-safe 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 |