diff options
Diffstat (limited to 'lisp/image.el')
| -rw-r--r-- | lisp/image.el | 272 |
1 files changed, 185 insertions, 87 deletions
diff --git a/lisp/image.el b/lisp/image.el index ea1a22698c6..de2afdc2c7b 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -27,10 +27,11 @@ (defgroup image () "Image support." + :prefix "image-" + :link '(info-link "(emacs) Image Mode") :group 'multimedia) (declare-function image-flush "image.c" (spec &optional frame)) -(defalias 'image-refresh 'image-flush) (defconst image-type-header-regexps `(("\\`/[\t\n\r ]*\\*.*XPM.\\*/" . xpm) @@ -48,6 +49,7 @@ static \\(unsigned \\)?char \\1_bits" . xbm) ("\\`\\(?:MM\0\\*\\|II\\*\0\\)" . tiff) ("\\`[\t\n\r ]*%!PS" . postscript) ("\\`\xff\xd8" . jpeg) ; used to be (image-jpeg-p . jpeg) + ("\\`RIFF....WEBPVP8" . webp) (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)") (comment-re (concat "\\(?:!--" incomment-re "*-->[ \t\r\n]*<\\)"))) (concat "\\(?:<\\?xml[ \t\r\n]+[^>]*>\\)?[ \t\r\n]*<" @@ -55,7 +57,7 @@ static \\(unsigned \\)?char \\1_bits" . xbm) "\\(?:!DOCTYPE[ \t\r\n]+[^>]*>[ \t\r\n]*<[ \t\r\n]*" comment-re "*\\)?" "[Ss][Vv][Gg]")) . svg) - ) + ("\\`....ftyp\\(heic\\|heix\\|hevc\\|heim\\|heis\\|hevm\\|hevs\\|mif1\\|msf1\\)" . heic)) "Alist of (REGEXP . IMAGE-TYPE) pairs used to auto-detect image types. When the first bytes of an image file match REGEXP, it is assumed to be of image type IMAGE-TYPE if IMAGE-TYPE is a symbol. If not a symbol, @@ -67,6 +69,7 @@ a non-nil value, TYPE is the image's type.") '(("\\.png\\'" . png) ("\\.gif\\'" . gif) ("\\.jpe?g\\'" . jpeg) + ("\\.webp\\'" . webp) ("\\.bmp\\'" . bmp) ("\\.xpm\\'" . xpm) ("\\.pbm\\'" . pbm) @@ -74,7 +77,7 @@ a non-nil value, TYPE is the image's type.") ("\\.ps\\'" . postscript) ("\\.tiff?\\'" . tiff) ("\\.svgz?\\'" . svg) - ) + ("\\.hei[cf]s?\\'" . heic)) "Alist of (REGEXP . IMAGE-TYPE) pairs used to identify image files. When the name of an image file match REGEXP, it is assumed to be of image type IMAGE-TYPE.") @@ -92,7 +95,9 @@ be of image type IMAGE-TYPE.") (jpeg . maybe) (tiff . maybe) (svg . maybe) - (postscript . nil)) + (webp . maybe) + (postscript . nil) + (heic . maybe)) "Alist of (IMAGE-TYPE . AUTODETECT) pairs used to auto-detect image files. \(See `image-type-auto-detected-p'). @@ -165,18 +170,18 @@ or \"ffmpeg\") is installed." (define-error 'unknown-image-type "Unknown image type") -;; 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 [C-wheel-down] 'image-mouse-decrease-size) - (define-key map [C-mouse-5] 'image-mouse-decrease-size) - (define-key map [C-wheel-up] 'image-mouse-increase-size) - (define-key map [C-mouse-4] 'image-mouse-increase-size) - (define-key map "r" 'image-rotate) - (define-key map "o" 'image-save) - map)) +(defvar-keymap image-map + :doc "Map put into text properties on images." + "-" #'image-decrease-size + "+" #'image-increase-size + "r" #'image-rotate + "o" #'image-save + "h" #'image-flip-horizontally + "v" #'image-flip-vertically + "C-<wheel-down>" #'image-mouse-decrease-size + "C-<mouse-5>" #'image-mouse-decrease-size + "C-<wheel-up>" #'image-mouse-increase-size + "C-<mouse-4>" #'image-mouse-increase-size) (defun image-load-path-for-library (library image &optional path no-error) "Return a suitable search path for images used by LIBRARY. @@ -376,6 +381,7 @@ be determined." "Determine the type of image file FILE from its name. Value is a symbol specifying the image type, or nil if type cannot be determined." + (declare (obsolete image-supported-file-p "29.1")) (let (type first (case-fold-search t)) (catch 'found (dolist (elem image-type-file-name-regexps first) @@ -385,6 +391,20 @@ be determined." ;; If nothing seems to be supported, return first type that matched. (or first (setq first type)))))))) + ;;;###autoload +(defun image-supported-file-p (file) + "Say whether Emacs has native support for displaying TYPE. +The value is a symbol specifying the image type, or nil if type +cannot be determined (or if Emacs doesn't have built-in support +for the image type)." + (let ((case-fold-search t) + type) + (catch 'found + (dolist (elem image-type-file-name-regexps) + (when (and (string-match-p (car elem) file) + (image-type-available-p (setq type (cdr elem)))) + (throw 'found type)))))) + (declare-function image-convert-p "image-converter.el" (source &optional image-format)) (declare-function image-convert "image-converter.el" @@ -413,7 +433,7 @@ type if we can't otherwise guess it." (require 'image-converter) (image-convert-p source data-p)))) (or (image-type-from-file-header source) - (image-type-from-file-name source) + (image-supported-file-p source) (and image-use-external-converter (progn (require 'image-converter) @@ -425,15 +445,6 @@ type if we can't otherwise guess it." (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")) - -(define-obsolete-variable-alias - 'image-library-alist - 'dynamic-library-alist "24.1") - ;;;###autoload (defun image-type-available-p (type) "Return t if image type TYPE is available. @@ -457,6 +468,7 @@ must be available." (and auto (or (eq auto t) (image-type-available-p type))))) +(defvar image-convert-to-format) ;;;###autoload (defun create-image (file-or-data &optional type data-p &rest props) @@ -494,7 +506,7 @@ Image file names that are not absolute are searched for in the (when (eq type 'image-convert) (require 'image-converter) (setq file-or-data (image-convert file-or-data data-format) - type 'png + type (intern image-convert-to-format) data-p t))) (when (image-type-available-p type) (let ((image @@ -556,7 +568,12 @@ 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) +(defun image-compute-scaling-factor (&optional scaling) + "Compute the scaling factor based on SCALING. +If a number, use that. If it's `auto', compute the factor. +If nil, use the `image-scaling-factor' variable." + (unless scaling + (setq scaling image-scaling-factor)) (cond ((numberp scaling) scaling) ((eq scaling 'auto) @@ -595,12 +612,12 @@ 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-put overlay 'keymap image-map) overlay))) ;;;###autoload -(defun insert-image (image &optional string area slice) +(defun insert-image (image &optional string area slice inhibit-isearch) "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. @@ -617,7 +634,11 @@ 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. + +Normally `isearch' is able to search for STRING in the buffer +even if it's hidden behind a displayed image. If INHIBIT-ISEARCH +is non-nil, this is inhibited." ;; Use a space as least likely to cause trouble when it's a hidden ;; character in the buffer. (unless string (setq string " ")) @@ -641,6 +662,7 @@ height of the image; integer values are taken as pixel values." (list (cons 'slice slice) image) image) rear-nonsticky t + inhibit-isearch ,inhibit-isearch keymap ,image-map)))) @@ -734,13 +756,15 @@ SPECS is a list of image specifications. Each image specification in SPECS is a property list. The contents of a specification are image type dependent. All specifications must at -least contain the properties `:type TYPE' and either `:file FILE' or -`:data DATA', where TYPE is a symbol specifying the image type, -e.g. `xbm', FILE is the file to load the image from, and DATA is a -string containing the actual image data. The specification whose TYPE -is supported, and FILE exists, is used to construct the image -specification to be returned. Return nil if no specification is -satisfied. +least contain either the property `:file FILE' or `:data DATA', +where FILE is the file to load the image from, and DATA is a string +containing the actual image data. If the property `:type TYPE' is +omitted or nil, try to determine the image type from its first few +bytes of image data. If that doesn't work, and the property `:file +FILE' provide a file name, use its file extension as image type. +If `:type TYPE' is provided, it must match the actual type +determined for FILE or DATA by `create-image'. Return nil if no +specification is satisfied. If CACHE is non-nil, results are cached and returned on subsequent calls. @@ -755,22 +779,44 @@ Image files should not be larger than specified by `max-image-size'." (let* ((spec (car specs)) (type (plist-get spec :type)) (data (plist-get spec :data)) - (file (plist-get spec :file)) - found) - (when (image-type-available-p type) - (cond ((stringp file) - (if (setq found (image-search-load-path file)) - (setq image - (cons 'image (plist-put (copy-sequence spec) - :file found))))) - ((not (null data)) - (setq image (cons 'image spec))))) + (file (plist-get spec :file))) + (cond + ((stringp file) + (when (setq file (image-search-load-path file)) + ;; At this point, remove the :type and :file properties. + ;; `create-image' will set them depending on image file. + (setq image (cons 'image (copy-sequence spec))) + (setf (image-property image :type) nil) + (setf (image-property image :file) nil) + (and (setq image (ignore-errors + (apply #'create-image file nil nil + (cdr image)))) + ;; Ensure, if a type has been provided, it is + ;; consistent with the type returned by + ;; `create-image'. If not, return nil. + (not (null type)) + (not (eq type (image-property image :type))) + (setq image nil)))) + ((not (null data)) + ;; At this point, remove the :type and :data properties. + ;; `create-image' will set them depending on image data. + (setq image (cons 'image (copy-sequence spec))) + (setf (image-property image :type) nil) + (setf (image-property image :data) nil) + (and (setq image (ignore-errors + (apply #'create-image data nil t + (cdr image)))) + ;; Ensure, if a type has been provided, it is + ;; consistent with the type returned by + ;; `create-image'. If not, return nil. + (not (null type)) + (not (eq type (image-property image :type))) + (setq image nil)))) (setq specs (cdr specs)))) (when cache (setf (gethash orig-specs find-image--cache) image)) image))) - ;;;###autoload (defmacro defimage (symbol specs &optional doc) "Define SYMBOL as an image, and return SYMBOL. @@ -791,7 +837,7 @@ Example: (defimage test-image ((:type xpm :file \"~/test1.xpm\") (:type xbm :file \"~/test1.xbm\")))" - (declare (doc-string 3)) + (declare (doc-string 3) (indent defun)) `(defvar ,symbol (find-image ',specs) ,doc)) @@ -823,15 +869,18 @@ in which case you might want to use `image-default-frame-delay'." (make-obsolete 'image-animated-p 'image-multi-frame-p "24.4") -;; "Destructively"? -(defun image-animate (image &optional index limit) +(defun image-animate (image &optional index limit position) "Start animating IMAGE. Animation occurs by destructively altering the IMAGE spec list. With optional INDEX, begin animating from that animation frame. LIMIT specifies how long to animate the image. If omitted or nil, play the animation until the end. If t, loop forever. If a -number, play until that number of seconds has elapsed." +number, play until that number of seconds has elapsed. + +If POSITION (which should be buffer position where the image is +displayed), stop the animation if the image is no longer +displayed." (let ((animation (image-multi-frame-p image)) timer) (when animation @@ -839,6 +888,9 @@ number, play until that number of seconds has elapsed." (cancel-timer timer)) (plist-put (cdr image) :animate-buffer (current-buffer)) (plist-put (cdr image) :animate-tardiness 0) + (when position + (plist-put (cdr image) :animate-position + (set-marker (make-marker) position (current-buffer)))) ;; Stash the data about the animation here so that we don't ;; trigger image recomputation unnecessarily later. (plist-put (cdr image) :animate-multi-frame-data animation) @@ -913,40 +965,61 @@ for the animation speed. A negative value means to animate in reverse." (plist-put (cdr image) :animate-tardiness (+ (* (plist-get (cdr image) :animate-tardiness) 0.9) (float-time (time-since target-time)))) - (when (and (buffer-live-p (plist-get (cdr image) :animate-buffer)) - ;; Cumulatively delayed two seconds more than expected. - (or (< (plist-get (cdr image) :animate-tardiness) 2) - (progn - (message "Stopping animation; animation possibly too big") - nil))) - (image-show-frame image n t) - (let* ((speed (image-animate-get-speed image)) - (time (current-time)) - (time-to-load-image (time-since time)) - (stated-delay-time - (/ (or (cdr (plist-get (cdr image) :animate-multi-frame-data)) - image-default-frame-delay) - (float (abs speed)))) - ;; Subtract off the time we took to load the image from the - ;; stated delay time. - (delay (max (float-time (time-subtract stated-delay-time - time-to-load-image)) - image-minimum-frame-delay)) - done) - (setq n (if (< speed 0) - (1- n) - (1+ n))) - (if limit - (cond ((>= n count) (setq n 0)) - ((< n 0) (setq n (1- count)))) - (and (or (>= n count) (< n 0)) (setq done t))) - (setq time-elapsed (+ delay time-elapsed)) - (if (numberp limit) - (setq done (>= time-elapsed limit))) - (unless done - (run-with-timer delay nil #'image-animate-timeout - image n count time-elapsed limit - (+ (float-time) delay)))))) + (let* ((buffer (plist-get (cdr image) :animate-buffer)) + (position (plist-get (cdr image) :animate-position)) + (continue-animation + (and (buffer-live-p buffer) + ;; If we have a :animate-position setting, the caller + ;; has requested that the animation be stopped if the + ;; image is no longer displayed in the buffer. + (or (null position) + (with-current-buffer buffer + (let ((disp (get-text-property position 'display))) + (and (consp disp) + (eq (car disp) 'image) + ;; We can't check `eq'-ness of the image + ;; itself, since that may change. + (eq position + (plist-get (cdr disp) :animate-position)))))) + ;; Cumulatively delayed two seconds more than expected. + (or (< (plist-get (cdr image) :animate-tardiness) 2) + (progn + (message "Stopping animation; animation possibly too big") + nil))))) + (if (not continue-animation) + ;; Eject from the animation cache since we've decided not to + ;; keep updating it. This helps stop unbounded RAM usage when + ;; doing, for instance, `g' in an eww buffer with animated + ;; images. + (clear-image-cache nil image) + (let* ((time (prog1 (current-time) + (image-show-frame image n t))) + (speed (image-animate-get-speed image)) + (time-to-load-image (time-since time)) + (stated-delay-time + (/ (or (cdr (plist-get (cdr image) :animate-multi-frame-data)) + image-default-frame-delay) + (float (abs speed)))) + ;; Subtract off the time we took to load the image from the + ;; stated delay time. + (delay (max (float-time (time-subtract stated-delay-time + time-to-load-image)) + image-minimum-frame-delay)) + done) + (setq n (if (< speed 0) + (1- n) + (1+ n))) + (if limit + (cond ((>= n count) (setq n 0)) + ((< n 0) (setq n (1- count)))) + (and (or (>= n count) (< n 0)) (setq done t))) + (setq time-elapsed (+ delay time-elapsed)) + (if (numberp limit) + (setq done (>= time-elapsed limit))) + (unless done + (run-with-timer delay nil #'image-animate-timeout + image n count time-elapsed limit + (+ (float-time) delay))))))) (defvar imagemagick-types-inhibit) @@ -1138,6 +1211,13 @@ default is 20%." (error "No image under point")) image)) +;;;###autoload +(defun image-at-point-p () + "Return non-nil if there is an image at point." + (condition-case nil + (prog1 t (image--get-image)) + (error nil))) + (defun image--get-imagemagick-and-warn (&optional position) (declare-function image-transforms-p "image.c" (&optional frame)) (unless (or (fboundp 'imagemagick-types) (image-transforms-p)) @@ -1207,6 +1287,24 @@ changing the displayed image size does not affect the saved image." (write-region (point-min) (point-max) (read-file-name "Write image to file: "))))) +(defun image-flip-horizontally () + "Horizontally flip the image under point." + (interactive) + (let ((image (image--get-image))) + (image-flush image) + (setf (image-property image :flip) + (not (image-property image :flip))))) + +(defun image-flip-vertically () + "Vertically flip the image under point." + (interactive) + (let ((image (image--get-image))) + (image-rotate 180) + (setf (image-property image :flip) + (not (image-property image :flip))))) + +(define-obsolete-function-alias 'image-refresh #'image-flush "29.1") + (provide 'image) ;;; image.el ends here |