annotate lisp/image.el @ 77472:70d58d56b53b

(idlwave-shell-clear-all-bp): Don't re-query for each cleared BP. (idlwave-shell-clear-bp): Optionally skip BP query. (idlwave-shell-update-bp-overlays): Use set-window-margins instead of set-window-buffer, which incorrectly moves displayed region.
author J.D. Smith <jdsmith@as.arizona.edu>
date Tue, 24 Apr 2007 00:22:52 +0000
parents 53fa6ea37e3a
children b2375f70c499 b808e2e86f98 52a7f3f50b89
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1 ;;; image.el --- image API
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2
64762
41bb365f41c4 Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 64091
diff changeset
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003,
75347
e3694f1cb928 Add 2007 to copyright years.
Glenn Morris <rgm@gnu.org>
parents: 75115
diff changeset
4 ;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
42316
b1023d722287 Add Maintainer header.
Pavel Janík <Pavel@Janik.cz>
parents: 38884
diff changeset
5
b1023d722287 Add Maintainer header.
Pavel Janík <Pavel@Janik.cz>
parents: 38884
diff changeset
6 ;; Maintainer: FSF
25309
6842eb73559c Add Keywords.
Dave Love <fx@gnu.org>
parents: 25003
diff changeset
7 ;; Keywords: multimedia
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
8
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
9 ;; This file is part of GNU Emacs.
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
10
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
12 ;; it under the terms of the GNU General Public License as published by
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
13 ;; the Free Software Foundation; either version 2, or (at your option)
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
14 ;; any later version.
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
15
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful,
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
19 ;; GNU General Public License for more details.
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
20
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
64091
6fb026ad601f Update FSF's address.
Lute Kamstra <lute@gnu.org>
parents: 62816
diff changeset
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
6fb026ad601f Update FSF's address.
Lute Kamstra <lute@gnu.org>
parents: 62816
diff changeset
24 ;; Boston, MA 02110-1301, USA.
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
25
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
26 ;;; Commentary:
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
27
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
28 ;;; Code:
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
29
32166
e3be69cf6c81 (image): New group.
Miles Bader <miles@gnu.org>
parents: 31635
diff changeset
30
e3be69cf6c81 (image): New group.
Miles Bader <miles@gnu.org>
parents: 31635
diff changeset
31 (defgroup image ()
e3be69cf6c81 (image): New group.
Miles Bader <miles@gnu.org>
parents: 31635
diff changeset
32 "Image support."
e3be69cf6c81 (image): New group.
Miles Bader <miles@gnu.org>
parents: 31635
diff changeset
33 :group 'multimedia)
e3be69cf6c81 (image): New group.
Miles Bader <miles@gnu.org>
parents: 31635
diff changeset
34
e3be69cf6c81 (image): New group.
Miles Bader <miles@gnu.org>
parents: 31635
diff changeset
35
66296
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
36 (defconst image-type-header-regexps
74972
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
37 '(("\\`/[\t\n\r ]*\\*.*XPM.\\*/" . xpm)
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
38 ("\\`P[1-6][[:space:]]+\\(?:#.*[[:space:]]+\\)*[0-9]+[[:space:]]+[0-9]+" . pbm)
75472
ad8f4e060e53 (image-type-header-regexps): Make GIF regex more specific.
Richard M. Stallman <rms@gnu.org>
parents: 75347
diff changeset
39 ("\\`GIF8[79]a" . gif)
74972
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
40 ("\\`\x89PNG\r\n\x1a\n" . png)
75115
1ec77a44faf9 (image-type-header-regexps): Recognize xbm more strictly.
Richard M. Stallman <rms@gnu.org>
parents: 74972
diff changeset
41 ("\\`[\t\n\r ]*#define \\([a-z0-9]+\\)_width [0-9]+\n\
1ec77a44faf9 (image-type-header-regexps): Recognize xbm more strictly.
Richard M. Stallman <rms@gnu.org>
parents: 74972
diff changeset
42 #define \\1_height [0-9]+\n\
1ec77a44faf9 (image-type-header-regexps): Recognize xbm more strictly.
Richard M. Stallman <rms@gnu.org>
parents: 74972
diff changeset
43 static char \\1_bits" . xbm)
74972
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
44 ("\\`\\(?:MM\0\\*\\|II\\*\0\\)" . tiff)
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
45 ("\\`[\t\n\r ]*%!PS" . postscript)
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
46 ("\\`\xff\xd8" . (image-jpeg-p . jpeg)))
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
47 "Alist of (REGEXP . IMAGE-TYPE) pairs used to auto-detect image types.
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
48 When the first bytes of an image file match REGEXP, it is assumed to
74972
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
49 be of image type IMAGE-TYPE if IMAGE-TYPE is a symbol. If not a symbol,
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
50 IMAGE-TYPE must be a pair (PREDICATE . TYPE). PREDICATE is called
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
51 with one argument, a string containing the image data. If PREDICATE returns
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
52 a non-nil value, TYPE is the image's type.")
38732
24fe4f884e82 (image-type-regexps): Allow predicates. Change the way
Gerd Moellmann <gerd@gnu.org>
parents: 38711
diff changeset
53
66296
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
54 (defconst image-type-file-name-regexps
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
55 '(("\\.png\\'" . png)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
56 ("\\.gif\\'" . gif)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
57 ("\\.jpe?g\\'" . jpeg)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
58 ("\\.bmp\\'" . bmp)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
59 ("\\.xpm\\'" . xpm)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
60 ("\\.pbm\\'" . pbm)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
61 ("\\.xbm\\'" . xbm)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
62 ("\\.ps\\'" . postscript)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
63 ("\\.tiff?\\'" . tiff))
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
64 "Alist of (REGEXP . IMAGE-TYPE) pairs used to identify image files.
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
65 When the name of an image file match REGEXP, it is assumed to
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
66 be of image type IMAGE-TYPE.")
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
67
75744
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
68 ;; We rely on `auto-mode-alist' to detect xbm and xpm files, instead
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
69 ;; of content autodetection. Their contents are just C code, so it is
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
70 ;; easy to generate false matches.
74972
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
71 (defvar image-type-auto-detectable
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
72 '((pbm . t)
75744
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
73 (xbm . nil)
74972
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
74 (bmp . maybe)
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
75 (gif . maybe)
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
76 (png . maybe)
75744
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
77 (xpm . nil)
74972
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
78 (jpeg . maybe)
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
79 (tiff . maybe)
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
80 (postscript . nil))
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
81 "Alist of (IMAGE-TYPE . AUTODETECT) pairs used to auto-detect image files.
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
82 \(See `image-type-auto-detected-p').
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
83
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
84 AUTODETECT can be
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
85 - t always auto-detect.
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
86 - nil never auto-detect.
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
87 - maybe auto-detect only if the image type is available
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
88 (see `image-type-available-p').")
66296
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
89
66307
ca953a3dbdf1 (image-load-path): Use eval-at-startup to initialize.
Richard M. Stallman <rms@gnu.org>
parents: 66296
diff changeset
90 (defvar image-load-path nil
65544
78d74ef1436b 2005-09-15 Chong Yidong <cyd@stupidchicken.com>
Chong Yidong <cyd@stupidchicken.com>
parents: 64762
diff changeset
91 "List of locations in which to search for image files.
65599
39114a2ae201 (image-load-path): Use symbol `data-directory' instead of its value,
Chong Yidong <cyd@stupidchicken.com>
parents: 65544
diff changeset
92 If an element is a string, it defines a directory to search.
39114a2ae201 (image-load-path): Use symbol `data-directory' instead of its value,
Chong Yidong <cyd@stupidchicken.com>
parents: 65544
diff changeset
93 If an element is a variable symbol whose value is a string, that
39114a2ae201 (image-load-path): Use symbol `data-directory' instead of its value,
Chong Yidong <cyd@stupidchicken.com>
parents: 65544
diff changeset
94 value defines a directory to search.
39114a2ae201 (image-load-path): Use symbol `data-directory' instead of its value,
Chong Yidong <cyd@stupidchicken.com>
parents: 65544
diff changeset
95 If an element is a variable symbol whose value is a list, the
39114a2ae201 (image-load-path): Use symbol `data-directory' instead of its value,
Chong Yidong <cyd@stupidchicken.com>
parents: 65544
diff changeset
96 value is used as a list of directories to search.")
65544
78d74ef1436b 2005-09-15 Chong Yidong <cyd@stupidchicken.com>
Chong Yidong <cyd@stupidchicken.com>
parents: 64762
diff changeset
97
66307
ca953a3dbdf1 (image-load-path): Use eval-at-startup to initialize.
Richard M. Stallman <rms@gnu.org>
parents: 66296
diff changeset
98 (eval-at-startup
ca953a3dbdf1 (image-load-path): Use eval-at-startup to initialize.
Richard M. Stallman <rms@gnu.org>
parents: 66296
diff changeset
99 (setq image-load-path
ca953a3dbdf1 (image-load-path): Use eval-at-startup to initialize.
Richard M. Stallman <rms@gnu.org>
parents: 66296
diff changeset
100 (list (file-name-as-directory (expand-file-name "images" data-directory))
ca953a3dbdf1 (image-load-path): Use eval-at-startup to initialize.
Richard M. Stallman <rms@gnu.org>
parents: 66296
diff changeset
101 'data-directory 'load-path)))
ca953a3dbdf1 (image-load-path): Use eval-at-startup to initialize.
Richard M. Stallman <rms@gnu.org>
parents: 66296
diff changeset
102
69471
6f07bf99b6f8 (image-load-path-for-library): Pass value of path rather than symbol.
Bill Wohler <wohler@newt.com>
parents: 69365
diff changeset
103
69365
0a2d89023fde (image-load-path-for-library): Merged changes from Reiner. Add
Bill Wohler <wohler@newt.com>
parents: 69360
diff changeset
104 (defun image-load-path-for-library (library image &optional path no-error)
69569
dd7f85a6af09 (image-load-path-for-library): Shorten first line in docstring.
Bill Wohler <wohler@newt.com>
parents: 69535
diff changeset
105 "Return a suitable search path for images used by LIBRARY.
69360
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
106
69535
3feef8dfbff5 (image-load-path-for-library): Minor docstring fix.
Bill Wohler <wohler@newt.com>
parents: 69516
diff changeset
107 It searches for IMAGE in `image-load-path' (excluding
69516
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
108 \"`data-directory'/images\") and `load-path', followed by a path
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
109 suitable for LIBRARY, which includes \"../../etc/images\" and
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
110 \"../etc/images\" relative to the library file itself, and then
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
111 in \"`data-directory'/images\".
69360
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
112
69471
6f07bf99b6f8 (image-load-path-for-library): Pass value of path rather than symbol.
Bill Wohler <wohler@newt.com>
parents: 69365
diff changeset
113 Then this function returns a list of directories which contains
6f07bf99b6f8 (image-load-path-for-library): Pass value of path rather than symbol.
Bill Wohler <wohler@newt.com>
parents: 69365
diff changeset
114 first the directory in which IMAGE was found, followed by the
6f07bf99b6f8 (image-load-path-for-library): Pass value of path rather than symbol.
Bill Wohler <wohler@newt.com>
parents: 69365
diff changeset
115 value of `load-path'. If PATH is given, it is used instead of
6f07bf99b6f8 (image-load-path-for-library): Pass value of path rather than symbol.
Bill Wohler <wohler@newt.com>
parents: 69365
diff changeset
116 `load-path'.
69365
0a2d89023fde (image-load-path-for-library): Merged changes from Reiner. Add
Bill Wohler <wohler@newt.com>
parents: 69360
diff changeset
117
69471
6f07bf99b6f8 (image-load-path-for-library): Pass value of path rather than symbol.
Bill Wohler <wohler@newt.com>
parents: 69365
diff changeset
118 If NO-ERROR is non-nil and a suitable path can't be found, don't
6f07bf99b6f8 (image-load-path-for-library): Pass value of path rather than symbol.
Bill Wohler <wohler@newt.com>
parents: 69365
diff changeset
119 signal an error. Instead, return a list of directories as before,
6f07bf99b6f8 (image-load-path-for-library): Pass value of path rather than symbol.
Bill Wohler <wohler@newt.com>
parents: 69365
diff changeset
120 except that nil appears in place of the image directory.
69360
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
121
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
122 Here is an example that uses a common idiom to provide
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
123 compatibility with versions of Emacs that lack the variable
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
124 `image-load-path':
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
125
69493
4f9233243d97 (image-load-path-for-library): Fix example by not recommending that
Bill Wohler <wohler@newt.com>
parents: 69471
diff changeset
126 ;; Shush compiler.
4f9233243d97 (image-load-path-for-library): Fix example by not recommending that
Bill Wohler <wohler@newt.com>
parents: 69471
diff changeset
127 (defvar image-load-path)
69471
6f07bf99b6f8 (image-load-path-for-library): Pass value of path rather than symbol.
Bill Wohler <wohler@newt.com>
parents: 69365
diff changeset
128
6f07bf99b6f8 (image-load-path-for-library): Pass value of path rather than symbol.
Bill Wohler <wohler@newt.com>
parents: 69365
diff changeset
129 (let* ((load-path (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\"))
69493
4f9233243d97 (image-load-path-for-library): Fix example by not recommending that
Bill Wohler <wohler@newt.com>
parents: 69471
diff changeset
130 (image-load-path (cons (car load-path)
4f9233243d97 (image-load-path-for-library): Fix example by not recommending that
Bill Wohler <wohler@newt.com>
parents: 69471
diff changeset
131 (when (boundp 'image-load-path)
4f9233243d97 (image-load-path-for-library): Fix example by not recommending that
Bill Wohler <wohler@newt.com>
parents: 69471
diff changeset
132 image-load-path))))
69471
6f07bf99b6f8 (image-load-path-for-library): Pass value of path rather than symbol.
Bill Wohler <wohler@newt.com>
parents: 69365
diff changeset
133 (mh-tool-bar-folder-buttons-init))"
69360
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
134 (unless library (error "No library specified"))
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
135 (unless image (error "No image specified"))
69516
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
136 (let (image-directory image-directory-load-path)
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
137 ;; Check for images in image-load-path or load-path.
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
138 (let ((img image)
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
139 (dir (or
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
140 ;; Images in image-load-path.
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
141 (image-search-load-path image)
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
142 ;; Images in load-path.
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
143 (locate-library image)))
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
144 parent)
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
145 ;; Since the image might be in a nested directory (for
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
146 ;; example, mail/attach.pbm), adjust `image-directory'
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
147 ;; accordingly.
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
148 (when dir
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
149 (setq dir (file-name-directory dir))
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
150 (while (setq parent (file-name-directory img))
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
151 (setq img (directory-file-name parent)
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
152 dir (expand-file-name "../" dir))))
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
153 (setq image-directory-load-path dir))
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
154
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
155 ;; If `image-directory-load-path' isn't Emacs' image directory,
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
156 ;; it's probably a user preference, so use it. Then use a
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
157 ;; relative setting if possible; otherwise, use
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
158 ;; `image-directory-load-path'.
69360
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
159 (cond
69516
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
160 ;; User-modified image-load-path?
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
161 ((and image-directory-load-path
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
162 (not (equal image-directory-load-path
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
163 (file-name-as-directory
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
164 (expand-file-name "images" data-directory)))))
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
165 (setq image-directory image-directory-load-path))
69360
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
166 ;; Try relative setting.
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
167 ((let (library-name d1ei d2ei)
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
168 ;; First, find library in the load-path.
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
169 (setq library-name (locate-library library))
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
170 (if (not library-name)
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
171 (error "Cannot find library %s in load-path" library))
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
172 ;; And then set image-directory relative to that.
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
173 (setq
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
174 ;; Go down 2 levels.
69516
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
175 d2ei (file-name-as-directory
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
176 (expand-file-name
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
177 (concat (file-name-directory library-name) "../../etc/images")))
69360
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
178 ;; Go down 1 level.
69516
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
179 d1ei (file-name-as-directory
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
180 (expand-file-name
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
181 (concat (file-name-directory library-name) "../etc/images"))))
69360
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
182 (setq image-directory
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
183 ;; Set it to nil if image is not found.
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
184 (cond ((file-exists-p (expand-file-name image d2ei)) d2ei)
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
185 ((file-exists-p (expand-file-name image d1ei)) d1ei)))))
69516
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
186 ;; Use Emacs' image directory.
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
187 (image-directory-load-path
e419733d5cf6 (image-load-path-for-library): Prefer user's images in
Bill Wohler <wohler@newt.com>
parents: 69493
diff changeset
188 (setq image-directory image-directory-load-path))
69365
0a2d89023fde (image-load-path-for-library): Merged changes from Reiner. Add
Bill Wohler <wohler@newt.com>
parents: 69360
diff changeset
189 (no-error
0a2d89023fde (image-load-path-for-library): Merged changes from Reiner. Add
Bill Wohler <wohler@newt.com>
parents: 69360
diff changeset
190 (message "Could not find image %s for library %s" image library))
69360
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
191 (t
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
192 (error "Could not find image %s for library %s" image library)))
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
193
69471
6f07bf99b6f8 (image-load-path-for-library): Pass value of path rather than symbol.
Bill Wohler <wohler@newt.com>
parents: 69365
diff changeset
194 ;; Return an augmented `path' or `load-path'.
6f07bf99b6f8 (image-load-path-for-library): Pass value of path rather than symbol.
Bill Wohler <wohler@newt.com>
parents: 69365
diff changeset
195 (nconc (list image-directory)
6f07bf99b6f8 (image-load-path-for-library): Pass value of path rather than symbol.
Bill Wohler <wohler@newt.com>
parents: 69365
diff changeset
196 (delete image-directory (copy-sequence (or path load-path))))))
6f07bf99b6f8 (image-load-path-for-library): Pass value of path rather than symbol.
Bill Wohler <wohler@newt.com>
parents: 69365
diff changeset
197
69360
e5e4303f8050 (image-load-path-for-library): Merge at least three functions from
Bill Wohler <wohler@newt.com>
parents: 68651
diff changeset
198
38732
24fe4f884e82 (image-type-regexps): Allow predicates. Change the way
Gerd Moellmann <gerd@gnu.org>
parents: 38711
diff changeset
199 (defun image-jpeg-p (data)
46810
65ad7b458435 (image-jpeg-p): Accept "Exif" marker.
Richard M. Stallman <rms@gnu.org>
parents: 43834
diff changeset
200 "Value is non-nil if DATA, a string, consists of JFIF image data.
65ad7b458435 (image-jpeg-p): Accept "Exif" marker.
Richard M. Stallman <rms@gnu.org>
parents: 43834
diff changeset
201 We accept the tag Exif because that is the same format."
38732
24fe4f884e82 (image-type-regexps): Allow predicates. Change the way
Gerd Moellmann <gerd@gnu.org>
parents: 38711
diff changeset
202 (when (string-match "\\`\xff\xd8" data)
24fe4f884e82 (image-type-regexps): Allow predicates. Change the way
Gerd Moellmann <gerd@gnu.org>
parents: 38711
diff changeset
203 (catch 'jfif
24fe4f884e82 (image-type-regexps): Allow predicates. Change the way
Gerd Moellmann <gerd@gnu.org>
parents: 38711
diff changeset
204 (let ((len (length data)) (i 2))
24fe4f884e82 (image-type-regexps): Allow predicates. Change the way
Gerd Moellmann <gerd@gnu.org>
parents: 38711
diff changeset
205 (while (< i len)
24fe4f884e82 (image-type-regexps): Allow predicates. Change the way
Gerd Moellmann <gerd@gnu.org>
parents: 38711
diff changeset
206 (when (/= (aref data i) #xff)
24fe4f884e82 (image-type-regexps): Allow predicates. Change the way
Gerd Moellmann <gerd@gnu.org>
parents: 38711
diff changeset
207 (throw 'jfif nil))
24fe4f884e82 (image-type-regexps): Allow predicates. Change the way
Gerd Moellmann <gerd@gnu.org>
parents: 38711
diff changeset
208 (setq i (1+ i))
24fe4f884e82 (image-type-regexps): Allow predicates. Change the way
Gerd Moellmann <gerd@gnu.org>
parents: 38711
diff changeset
209 (when (>= (+ i 2) len)
24fe4f884e82 (image-type-regexps): Allow predicates. Change the way
Gerd Moellmann <gerd@gnu.org>
parents: 38711
diff changeset
210 (throw 'jfif nil))
24fe4f884e82 (image-type-regexps): Allow predicates. Change the way
Gerd Moellmann <gerd@gnu.org>
parents: 38711
diff changeset
211 (let ((nbytes (+ (lsh (aref data (+ i 1)) 8)
38776
a679a282d5cb (image-jpeg-p): Test for APPn markers in the range
Gerd Moellmann <gerd@gnu.org>
parents: 38746
diff changeset
212 (aref data (+ i 2))))
a679a282d5cb (image-jpeg-p): Test for APPn markers in the range
Gerd Moellmann <gerd@gnu.org>
parents: 38746
diff changeset
213 (code (aref data i)))
a679a282d5cb (image-jpeg-p): Test for APPn markers in the range
Gerd Moellmann <gerd@gnu.org>
parents: 38746
diff changeset
214 (when (and (>= code #xe0) (<= code #xef))
38732
24fe4f884e82 (image-type-regexps): Allow predicates. Change the way
Gerd Moellmann <gerd@gnu.org>
parents: 38711
diff changeset
215 ;; APP0 LEN1 LEN2 "JFIF\0"
49588
37645a051842 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 48130
diff changeset
216 (throw 'jfif
52344
f1fd0b3a923e (image-jpeg-p): Don't search beyond length of data.
John Paul Wallington <jpw@pobox.com>
parents: 49589
diff changeset
217 (string-match "JFIF\\|Exif"
f1fd0b3a923e (image-jpeg-p): Don't search beyond length of data.
John Paul Wallington <jpw@pobox.com>
parents: 49589
diff changeset
218 (substring data i (min (+ i nbytes) len)))))
38746
0fc8e4a27edc (image-type-regexps): Allow whitespace at the start
Gerd Moellmann <gerd@gnu.org>
parents: 38732
diff changeset
219 (setq i (+ i 1 nbytes))))))))
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
220
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
221
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
222 ;;;###autoload
27073
aad0a025b1e3 (defimage): Handle specifications containing :data
Gerd Moellmann <gerd@gnu.org>
parents: 27059
diff changeset
223 (defun image-type-from-data (data)
aad0a025b1e3 (defimage): Handle specifications containing :data
Gerd Moellmann <gerd@gnu.org>
parents: 27059
diff changeset
224 "Determine the image type from image data DATA.
aad0a025b1e3 (defimage): Handle specifications containing :data
Gerd Moellmann <gerd@gnu.org>
parents: 27059
diff changeset
225 Value is a symbol specifying the image type or nil if type cannot
aad0a025b1e3 (defimage): Handle specifications containing :data
Gerd Moellmann <gerd@gnu.org>
parents: 27059
diff changeset
226 be determined."
66296
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
227 (let ((types image-type-header-regexps)
27073
aad0a025b1e3 (defimage): Handle specifications containing :data
Gerd Moellmann <gerd@gnu.org>
parents: 27059
diff changeset
228 type)
66296
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
229 (while types
27073
aad0a025b1e3 (defimage): Handle specifications containing :data
Gerd Moellmann <gerd@gnu.org>
parents: 27059
diff changeset
230 (let ((regexp (car (car types)))
74972
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
231 (image-type (cdr (car types))))
66296
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
232 (if (or (and (symbolp image-type)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
233 (string-match regexp data))
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
234 (and (consp image-type)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
235 (funcall (car image-type) data)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
236 (setq image-type (cdr image-type))))
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
237 (setq type image-type
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
238 types nil)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
239 (setq types (cdr types)))))
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
240 type))
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
241
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
242
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
243 ;;;###autoload
74972
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
244 (defun image-type-from-buffer ()
66296
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
245 "Determine the image type from data in the current buffer.
74972
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
246 Value is a symbol specifying the image type or nil if type cannot
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
247 be determined."
66296
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
248 (let ((types image-type-header-regexps)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
249 type
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
250 (opoint (point)))
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
251 (goto-char (point-min))
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
252 (while types
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
253 (let ((regexp (car (car types)))
74972
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
254 (image-type (cdr (car types)))
66296
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
255 data)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
256 (if (or (and (symbolp image-type)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
257 (looking-at regexp))
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
258 (and (consp image-type)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
259 (funcall (car image-type)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
260 (or data
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
261 (setq data
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
262 (buffer-substring
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
263 (point-min)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
264 (min (point-max)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
265 (+ (point-min) 256))))))
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
266 (setq image-type (cdr image-type))))
74972
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
267 (setq type image-type
66296
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
268 types nil)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
269 (setq types (cdr types)))))
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
270 (goto-char opoint)
27073
aad0a025b1e3 (defimage): Handle specifications containing :data
Gerd Moellmann <gerd@gnu.org>
parents: 27059
diff changeset
271 type))
aad0a025b1e3 (defimage): Handle specifications containing :data
Gerd Moellmann <gerd@gnu.org>
parents: 27059
diff changeset
272
aad0a025b1e3 (defimage): Handle specifications containing :data
Gerd Moellmann <gerd@gnu.org>
parents: 27059
diff changeset
273
aad0a025b1e3 (defimage): Handle specifications containing :data
Gerd Moellmann <gerd@gnu.org>
parents: 27059
diff changeset
274 ;;;###autoload
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
275 (defun image-type-from-file-header (file)
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
276 "Determine the type of image file FILE from its first few bytes.
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
277 Value is a symbol specifying the image type, or nil if type cannot
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
278 be determined."
66296
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
279 (unless (or (file-readable-p file)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
280 (file-name-absolute-p file))
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
281 (setq file (image-search-load-path file)))
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
282 (and file
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
283 (file-readable-p file)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
284 (with-temp-buffer
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
285 (set-buffer-multibyte nil)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
286 (insert-file-contents-literally file nil 0 256)
74972
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
287 (image-type-from-buffer))))
66296
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
288
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
289
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
290 ;;;###autoload
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
291 (defun image-type-from-file-name (file)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
292 "Determine the type of image file FILE from its name.
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
293 Value is a symbol specifying the image type, or nil if type cannot
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
294 be determined."
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
295 (let ((types image-type-file-name-regexps)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
296 type)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
297 (while types
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
298 (if (string-match (car (car types)) file)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
299 (setq type (cdr (car types))
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
300 types nil)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
301 (setq types (cdr types))))
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
302 type))
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
303
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
304
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
305 ;;;###autoload
70170
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
306 (defun image-type (file-or-data &optional type data-p)
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
307 "Determine and return image type.
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
308 FILE-OR-DATA is an image file name or image data.
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
309 Optional TYPE is a symbol describing the image type. If TYPE is omitted
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
310 or nil, try to determine the image type from its first few bytes
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
311 of image data. If that doesn't work, and FILE-OR-DATA is a file name,
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
312 use its file extension as image type.
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
313 Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data."
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
314 (when (and (not data-p) (not (stringp file-or-data)))
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
315 (error "Invalid image file name `%s'" file-or-data))
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
316 (cond ((null data-p)
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
317 ;; FILE-OR-DATA is a file name.
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
318 (unless (or type
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
319 (setq type (image-type-from-file-header file-or-data)))
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
320 (let ((extension (file-name-extension file-or-data)))
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
321 (unless extension
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
322 (error "Cannot determine image type"))
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
323 (setq type (intern extension)))))
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
324 (t
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
325 ;; FILE-OR-DATA contains image data.
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
326 (unless type
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
327 (setq type (image-type-from-data file-or-data)))))
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
328 (unless type
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
329 (error "Cannot determine image type"))
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
330 (unless (symbolp type)
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
331 (error "Invalid image type `%s'" type))
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
332 type)
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
333
74972
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
334
70170
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
335 ;;;###autoload
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
336 (defun image-type-available-p (type)
62816
f5a3eeaf3d70 (image-library-alist): Moved to image.c.
Juanma Barranquero <lekktu@gmail.com>
parents: 60688
diff changeset
337 "Return non-nil if image type TYPE is available.
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
338 Image types are symbols like `xbm' or `jpeg'."
56106
5b3f0e4cf47f (image-library-alist): New variable to map image types to external
Juanma Barranquero <lekktu@gmail.com>
parents: 55167
diff changeset
339 (and (fboundp 'init-image-library)
5b3f0e4cf47f (image-library-alist): New variable to map image types to external
Juanma Barranquero <lekktu@gmail.com>
parents: 55167
diff changeset
340 (init-image-library type image-library-alist)))
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
341
66296
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
342
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
343 ;;;###autoload
74972
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
344 (defun image-type-auto-detected-p ()
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
345 "Return t iff the current buffer contains an auto-detectable image.
75744
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
346 This function is intended to be used from `magic-mode-alist' (which see).
74972
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
347
75744
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
348 First, compare the beginning of the buffer with `image-type-header-regexps'.
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
349 If an appropriate image type is found, check if that image type can be
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
350 autodetected using the variable `image-type-auto-detectable'. Finally,
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
351 if `buffer-file-name' is non-nil, check if it matches another major mode
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
352 in `auto-mode-alist' apart from `image-mode'; if there is another match,
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
353 the autodetection is considered to have failed. Return t if all the above
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
354 steps succeed."
74972
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
355 (let* ((type (image-type-from-buffer))
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
356 (auto (and type (cdr (assq type image-type-auto-detectable)))))
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
357 (and auto
75744
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
358 (or (eq auto t) (image-type-available-p type))
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
359 (or (null buffer-file-name)
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
360 (not (assoc-default
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
361 buffer-file-name
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
362 (delq nil (mapcar
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
363 (lambda (elt)
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
364 (unless (memq (or (car-safe (cdr elt))
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
365 (cdr elt))
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
366 '(image-mode image-mode-maybe))
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
367 elt))
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
368 auto-mode-alist))
53fa6ea37e3a (image-type-auto-detectable): Don't autodetect x[pb]m.
Chong Yidong <cyd@stupidchicken.com>
parents: 75472
diff changeset
369 'string-match))))))
74972
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
370
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
371
94afc7cac404 (image-type-header-regexps, image-type-from-data, image-type-from-buffer,
Juanma Barranquero <lekktu@gmail.com>
parents: 74916
diff changeset
372 ;;;###autoload
27073
aad0a025b1e3 (defimage): Handle specifications containing :data
Gerd Moellmann <gerd@gnu.org>
parents: 27059
diff changeset
373 (defun create-image (file-or-data &optional type data-p &rest props)
aad0a025b1e3 (defimage): Handle specifications containing :data
Gerd Moellmann <gerd@gnu.org>
parents: 27059
diff changeset
374 "Create an image.
aad0a025b1e3 (defimage): Handle specifications containing :data
Gerd Moellmann <gerd@gnu.org>
parents: 27059
diff changeset
375 FILE-OR-DATA is an image file name or image data.
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
376 Optional TYPE is a symbol describing the image type. If TYPE is omitted
27073
aad0a025b1e3 (defimage): Handle specifications containing :data
Gerd Moellmann <gerd@gnu.org>
parents: 27059
diff changeset
377 or nil, try to determine the image type from its first few bytes
aad0a025b1e3 (defimage): Handle specifications containing :data
Gerd Moellmann <gerd@gnu.org>
parents: 27059
diff changeset
378 of image data. If that doesn't work, and FILE-OR-DATA is a file name,
34378
5ae7af279df7 (create-image): Doc fix; spotted by Per Cederqvist <ceder@lysator.liu.se>.
Eli Zaretskii <eliz@gnu.org>
parents: 32166
diff changeset
379 use its file extension as image type.
27073
aad0a025b1e3 (defimage): Handle specifications containing :data
Gerd Moellmann <gerd@gnu.org>
parents: 27059
diff changeset
380 Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data.
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
381 Optional PROPS are additional image attributes to assign to the image,
31635
208d8385ccae (create-image): Doc fix.
Gerd Moellmann <gerd@gnu.org>
parents: 30952
diff changeset
382 like, e.g. `:mask MASK'.
66196
2e59eea25fcf * image.el (create-image, find-image): Mention max-image-size in
Chong Yidong <cyd@stupidchicken.com>
parents: 65599
diff changeset
383 Value is the image created, or nil if images of type TYPE are not supported.
2e59eea25fcf * image.el (create-image, find-image): Mention max-image-size in
Chong Yidong <cyd@stupidchicken.com>
parents: 65599
diff changeset
384
2e59eea25fcf * image.el (create-image, find-image): Mention max-image-size in
Chong Yidong <cyd@stupidchicken.com>
parents: 65599
diff changeset
385 Images should not be larger than specified by `max-image-size'."
70170
de6c9508749d (image-type): New defun split out of create-image.
Kim F. Storm <storm@cua.dk>
parents: 69569
diff changeset
386 (setq type (image-type file-or-data type data-p))
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
387 (when (image-type-available-p type)
27073
aad0a025b1e3 (defimage): Handle specifications containing :data
Gerd Moellmann <gerd@gnu.org>
parents: 27059
diff changeset
388 (append (list 'image :type type (if data-p :data :file) file-or-data)
aad0a025b1e3 (defimage): Handle specifications containing :data
Gerd Moellmann <gerd@gnu.org>
parents: 27059
diff changeset
389 props)))
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
390
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
391
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
392 ;;;###autoload
29470
7bde123bed95 (find-image): Doc fix. Return nil if image not found.
Dave Love <fx@gnu.org>
parents: 28958
diff changeset
393 (defun put-image (image pos &optional string area)
25617
697b28471784 (put-image): Remove optional buffer parameter.
Gerd Moellmann <gerd@gnu.org>
parents: 25309
diff changeset
394 "Put image IMAGE in front of POS in the current buffer.
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
395 IMAGE must be an image created with `create-image' or `defimage'.
25816
2d53a03a3baa (put-image, insert-image): Add string argument.
Gerd Moellmann <gerd@gnu.org>
parents: 25617
diff changeset
396 IMAGE is displayed by putting an overlay into the current buffer with a
2d53a03a3baa (put-image, insert-image): Add string argument.
Gerd Moellmann <gerd@gnu.org>
parents: 25617
diff changeset
397 `before-string' STRING that has a `display' property whose value is the
29470
7bde123bed95 (find-image): Doc fix. Return nil if image not found.
Dave Love <fx@gnu.org>
parents: 28958
diff changeset
398 image. STRING is defaulted if you omit it.
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
399 POS may be an integer or marker.
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
400 AREA is where to display the image. AREA nil or omitted means
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
401 display it in the text area, a value of `left-margin' means
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
402 display it in the left marginal area, a value of `right-margin'
25816
2d53a03a3baa (put-image, insert-image): Add string argument.
Gerd Moellmann <gerd@gnu.org>
parents: 25617
diff changeset
403 means display it in the right marginal area."
29626
ecb96a7369d3 Fix last change to be in insert-image as intended.
Dave Love <fx@gnu.org>
parents: 29624
diff changeset
404 (unless string (setq string "x"))
25617
697b28471784 (put-image): Remove optional buffer parameter.
Gerd Moellmann <gerd@gnu.org>
parents: 25309
diff changeset
405 (let ((buffer (current-buffer)))
29470
7bde123bed95 (find-image): Doc fix. Return nil if image not found.
Dave Love <fx@gnu.org>
parents: 28958
diff changeset
406 (unless (eq (car-safe image) 'image)
25617
697b28471784 (put-image): Remove optional buffer parameter.
Gerd Moellmann <gerd@gnu.org>
parents: 25309
diff changeset
407 (error "Not an image: %s" image))
697b28471784 (put-image): Remove optional buffer parameter.
Gerd Moellmann <gerd@gnu.org>
parents: 25309
diff changeset
408 (unless (or (null area) (memq area '(left-margin right-margin)))
697b28471784 (put-image): Remove optional buffer parameter.
Gerd Moellmann <gerd@gnu.org>
parents: 25309
diff changeset
409 (error "Invalid area %s" area))
25816
2d53a03a3baa (put-image, insert-image): Add string argument.
Gerd Moellmann <gerd@gnu.org>
parents: 25617
diff changeset
410 (setq string (copy-sequence string))
25617
697b28471784 (put-image): Remove optional buffer parameter.
Gerd Moellmann <gerd@gnu.org>
parents: 25309
diff changeset
411 (let ((overlay (make-overlay pos pos buffer))
25816
2d53a03a3baa (put-image, insert-image): Add string argument.
Gerd Moellmann <gerd@gnu.org>
parents: 25617
diff changeset
412 (prop (if (null area) image (list (list 'margin area) image))))
2d53a03a3baa (put-image, insert-image): Add string argument.
Gerd Moellmann <gerd@gnu.org>
parents: 25617
diff changeset
413 (put-text-property 0 (length string) 'display prop string)
25617
697b28471784 (put-image): Remove optional buffer parameter.
Gerd Moellmann <gerd@gnu.org>
parents: 25309
diff changeset
414 (overlay-put overlay 'put-image t)
697b28471784 (put-image): Remove optional buffer parameter.
Gerd Moellmann <gerd@gnu.org>
parents: 25309
diff changeset
415 (overlay-put overlay 'before-string string))))
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
416
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
417
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
418 ;;;###autoload
55033
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
419 (defun insert-image (image &optional string area slice)
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
420 "Insert IMAGE into current buffer at point.
25816
2d53a03a3baa (put-image, insert-image): Add string argument.
Gerd Moellmann <gerd@gnu.org>
parents: 25617
diff changeset
421 IMAGE is displayed by inserting STRING into the current buffer
29470
7bde123bed95 (find-image): Doc fix. Return nil if image not found.
Dave Love <fx@gnu.org>
parents: 28958
diff changeset
422 with a `display' property whose value is the image. STRING is
7bde123bed95 (find-image): Doc fix. Return nil if image not found.
Dave Love <fx@gnu.org>
parents: 28958
diff changeset
423 defaulted if you omit it.
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
424 AREA is where to display the image. AREA nil or omitted means
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
425 display it in the text area, a value of `left-margin' means
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
426 display it in the left marginal area, a value of `right-margin'
55033
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
427 means display it in the right marginal area.
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
428 SLICE specifies slice of IMAGE to insert. SLICE nil or omitted
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
429 means insert whole image. SLICE is a list (X Y WIDTH HEIGHT)
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
430 specifying the X and Y positions and WIDTH and HEIGHT of image area
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
431 to insert. A float value 0.0 - 1.0 means relative to the width or
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
432 height of the image; integer values are taken as pixel values."
29626
ecb96a7369d3 Fix last change to be in insert-image as intended.
Dave Love <fx@gnu.org>
parents: 29624
diff changeset
433 ;; Use a space as least likely to cause trouble when it's a hidden
ecb96a7369d3 Fix last change to be in insert-image as intended.
Dave Love <fx@gnu.org>
parents: 29624
diff changeset
434 ;; character in the buffer.
ecb96a7369d3 Fix last change to be in insert-image as intended.
Dave Love <fx@gnu.org>
parents: 29624
diff changeset
435 (unless string (setq string " "))
29470
7bde123bed95 (find-image): Doc fix. Return nil if image not found.
Dave Love <fx@gnu.org>
parents: 28958
diff changeset
436 (unless (eq (car-safe image) 'image)
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
437 (error "Not an image: %s" image))
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
438 (unless (or (null area) (memq area '(left-margin right-margin)))
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
439 (error "Invalid area %s" area))
29607
42d156d8d8eb (insert-image): Save a little consing.
Dave Love <fx@gnu.org>
parents: 29470
diff changeset
440 (if area
42d156d8d8eb (insert-image): Save a little consing.
Dave Love <fx@gnu.org>
parents: 29470
diff changeset
441 (setq image (list (list 'margin area) image))
42d156d8d8eb (insert-image): Save a little consing.
Dave Love <fx@gnu.org>
parents: 29470
diff changeset
442 ;; Cons up a new spec equal but not eq to `image' so that
42d156d8d8eb (insert-image): Save a little consing.
Dave Love <fx@gnu.org>
parents: 29470
diff changeset
443 ;; inserting it twice in a row (adjacently) displays two copies of
42d156d8d8eb (insert-image): Save a little consing.
Dave Love <fx@gnu.org>
parents: 29470
diff changeset
444 ;; the image. Don't try to avoid this by looking at the display
42d156d8d8eb (insert-image): Save a little consing.
Dave Love <fx@gnu.org>
parents: 29470
diff changeset
445 ;; properties on either side so that we DTRT more often with
42d156d8d8eb (insert-image): Save a little consing.
Dave Love <fx@gnu.org>
parents: 29470
diff changeset
446 ;; cut-and-paste. (Yanking killed image text next to another copy
42d156d8d8eb (insert-image): Save a little consing.
Dave Love <fx@gnu.org>
parents: 29470
diff changeset
447 ;; of it loses anyway.)
42d156d8d8eb (insert-image): Save a little consing.
Dave Love <fx@gnu.org>
parents: 29470
diff changeset
448 (setq image (cons 'image (cdr image))))
25816
2d53a03a3baa (put-image, insert-image): Add string argument.
Gerd Moellmann <gerd@gnu.org>
parents: 25617
diff changeset
449 (let ((start (point)))
2d53a03a3baa (put-image, insert-image): Add string argument.
Gerd Moellmann <gerd@gnu.org>
parents: 25617
diff changeset
450 (insert string)
2d53a03a3baa (put-image, insert-image): Add string argument.
Gerd Moellmann <gerd@gnu.org>
parents: 25617
diff changeset
451 (add-text-properties start (point)
55033
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
452 `(display ,(if slice
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
453 (list (cons 'slice slice) image)
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
454 image) rear-nonsticky (display)))))
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
455
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
456
60688
b0de8a447a79 (insert-sliced-image): Add autoload cookie.
Richard M. Stallman <rms@gnu.org>
parents: 59276
diff changeset
457 ;;;###autoload
55033
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
458 (defun insert-sliced-image (image &optional string area rows cols)
57196
090c23fa222c (insert-sliced-image): Add doc string.
Kim F. Storm <storm@cua.dk>
parents: 56189
diff changeset
459 "Insert IMAGE into current buffer at point.
090c23fa222c (insert-sliced-image): Add doc string.
Kim F. Storm <storm@cua.dk>
parents: 56189
diff changeset
460 IMAGE is displayed by inserting STRING into the current buffer
090c23fa222c (insert-sliced-image): Add doc string.
Kim F. Storm <storm@cua.dk>
parents: 56189
diff changeset
461 with a `display' property whose value is the image. STRING is
090c23fa222c (insert-sliced-image): Add doc string.
Kim F. Storm <storm@cua.dk>
parents: 56189
diff changeset
462 defaulted if you omit it.
090c23fa222c (insert-sliced-image): Add doc string.
Kim F. Storm <storm@cua.dk>
parents: 56189
diff changeset
463 AREA is where to display the image. AREA nil or omitted means
090c23fa222c (insert-sliced-image): Add doc string.
Kim F. Storm <storm@cua.dk>
parents: 56189
diff changeset
464 display it in the text area, a value of `left-margin' means
090c23fa222c (insert-sliced-image): Add doc string.
Kim F. Storm <storm@cua.dk>
parents: 56189
diff changeset
465 display it in the left marginal area, a value of `right-margin'
090c23fa222c (insert-sliced-image): Add doc string.
Kim F. Storm <storm@cua.dk>
parents: 56189
diff changeset
466 means display it in the right marginal area.
090c23fa222c (insert-sliced-image): Add doc string.
Kim F. Storm <storm@cua.dk>
parents: 56189
diff changeset
467 The image is automatically split into ROW x COLS slices."
55033
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
468 (unless string (setq string " "))
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
469 (unless (eq (car-safe image) 'image)
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
470 (error "Not an image: %s" image))
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
471 (unless (or (null area) (memq area '(left-margin right-margin)))
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
472 (error "Invalid area %s" area))
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
473 (if area
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
474 (setq image (list (list 'margin area) image))
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
475 ;; Cons up a new spec equal but not eq to `image' so that
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
476 ;; inserting it twice in a row (adjacently) displays two copies of
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
477 ;; the image. Don't try to avoid this by looking at the display
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
478 ;; properties on either side so that we DTRT more often with
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
479 ;; cut-and-paste. (Yanking killed image text next to another copy
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
480 ;; of it loses anyway.)
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
481 (setq image (cons 'image (cdr image))))
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
482 (let ((x 0.0) (dx (/ 1.0001 (or cols 1)))
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
483 (y 0.0) (dy (/ 1.0001 (or rows 1))))
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
484 (while (< y 1.0)
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
485 (while (< x 1.0)
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
486 (let ((start (point)))
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
487 (insert string)
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
488 (add-text-properties start (point)
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
489 `(display ,(list (list 'slice x y dx dy) image)
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
490 rear-nonsticky (display)))
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
491 (setq x (+ x dx))))
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
492 (setq x 0.0
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
493 y (+ y dy))
59276
d50d807507e0 (insert-sliced-image): Use t for line-height property.
Kim F. Storm <storm@cua.dk>
parents: 57196
diff changeset
494 (insert (propertize "\n" 'line-height t)))))
55033
a7dfcd60873e (insert-image): Add optional SLICE arg.
Kim F. Storm <storm@cua.dk>
parents: 52401
diff changeset
495
26007
774b2504710b (insert-image): Copy the image spec and add an intangible property.
Dave Love <fx@gnu.org>
parents: 25872
diff changeset
496
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
497
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
498 ;;;###autoload
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
499 (defun remove-images (start end &optional buffer)
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
500 "Remove images between START and END in BUFFER.
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
501 Remove only images that were put in BUFFER with calls to `put-image'.
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
502 BUFFER nil or omitted means use the current buffer."
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
503 (unless buffer
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
504 (setq buffer (current-buffer)))
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
505 (let ((overlays (overlays-in start end)))
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
506 (while overlays
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
507 (let ((overlay (car overlays)))
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
508 (when (overlay-get overlay 'put-image)
25857
fdc2bd91cf63 (defimage): Remove redundant code. Substitute file on image plist.
Dave Love <fx@gnu.org>
parents: 25816
diff changeset
509 (delete-overlay overlay)))
fdc2bd91cf63 (defimage): Remove redundant code. Substitute file on image plist.
Dave Love <fx@gnu.org>
parents: 25816
diff changeset
510 (setq overlays (cdr overlays)))))
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
511
66296
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
512 (defun image-search-load-path (file &optional path)
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
513 (unless path
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
514 (setq path image-load-path))
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
515 (let (element found filename)
65544
78d74ef1436b 2005-09-15 Chong Yidong <cyd@stupidchicken.com>
Chong Yidong <cyd@stupidchicken.com>
parents: 64762
diff changeset
516 (while (and (not found) (consp path))
65599
39114a2ae201 (image-load-path): Use symbol `data-directory' instead of its value,
Chong Yidong <cyd@stupidchicken.com>
parents: 65544
diff changeset
517 (setq element (car path))
65544
78d74ef1436b 2005-09-15 Chong Yidong <cyd@stupidchicken.com>
Chong Yidong <cyd@stupidchicken.com>
parents: 64762
diff changeset
518 (cond
65599
39114a2ae201 (image-load-path): Use symbol `data-directory' instead of its value,
Chong Yidong <cyd@stupidchicken.com>
parents: 65544
diff changeset
519 ((stringp element)
65544
78d74ef1436b 2005-09-15 Chong Yidong <cyd@stupidchicken.com>
Chong Yidong <cyd@stupidchicken.com>
parents: 64762
diff changeset
520 (setq found
78d74ef1436b 2005-09-15 Chong Yidong <cyd@stupidchicken.com>
Chong Yidong <cyd@stupidchicken.com>
parents: 64762
diff changeset
521 (file-readable-p
66296
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
522 (setq filename (expand-file-name file element)))))
65599
39114a2ae201 (image-load-path): Use symbol `data-directory' instead of its value,
Chong Yidong <cyd@stupidchicken.com>
parents: 65544
diff changeset
523 ((and (symbolp element) (boundp element))
39114a2ae201 (image-load-path): Use symbol `data-directory' instead of its value,
Chong Yidong <cyd@stupidchicken.com>
parents: 65544
diff changeset
524 (setq element (symbol-value element))
39114a2ae201 (image-load-path): Use symbol `data-directory' instead of its value,
Chong Yidong <cyd@stupidchicken.com>
parents: 65544
diff changeset
525 (cond
39114a2ae201 (image-load-path): Use symbol `data-directory' instead of its value,
Chong Yidong <cyd@stupidchicken.com>
parents: 65544
diff changeset
526 ((stringp element)
39114a2ae201 (image-load-path): Use symbol `data-directory' instead of its value,
Chong Yidong <cyd@stupidchicken.com>
parents: 65544
diff changeset
527 (setq found
39114a2ae201 (image-load-path): Use symbol `data-directory' instead of its value,
Chong Yidong <cyd@stupidchicken.com>
parents: 65544
diff changeset
528 (file-readable-p
66296
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
529 (setq filename (expand-file-name file element)))))
65599
39114a2ae201 (image-load-path): Use symbol `data-directory' instead of its value,
Chong Yidong <cyd@stupidchicken.com>
parents: 65544
diff changeset
530 ((consp element)
66296
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
531 (if (setq filename (image-search-load-path file element))
65599
39114a2ae201 (image-load-path): Use symbol `data-directory' instead of its value,
Chong Yidong <cyd@stupidchicken.com>
parents: 65544
diff changeset
532 (setq found t))))))
65544
78d74ef1436b 2005-09-15 Chong Yidong <cyd@stupidchicken.com>
Chong Yidong <cyd@stupidchicken.com>
parents: 64762
diff changeset
533 (setq path (cdr path)))
66296
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
534 (if found filename)))
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
535
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
536 ;;;###autoload
28721
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
537 (defun find-image (specs)
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
538 "Find an image, choosing one of a list of image specifications.
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
539
29470
7bde123bed95 (find-image): Doc fix. Return nil if image not found.
Dave Love <fx@gnu.org>
parents: 28958
diff changeset
540 SPECS is a list of image specifications.
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
541
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
542 Each image specification in SPECS is a property list. The contents of
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
543 a specification are image type dependent. All specifications must at
27059
6bb2a4a0413e * image.el (defimage): Images with the :data keyword should be considered valid as well.
William M. Perry <wmperry@aventail.com>
parents: 26007
diff changeset
544 least contain the properties `:type TYPE' and either `:file FILE' or
6bb2a4a0413e * image.el (defimage): Images with the :data keyword should be considered valid as well.
William M. Perry <wmperry@aventail.com>
parents: 26007
diff changeset
545 `:data DATA', where TYPE is a symbol specifying the image type,
6bb2a4a0413e * image.el (defimage): Images with the :data keyword should be considered valid as well.
William M. Perry <wmperry@aventail.com>
parents: 26007
diff changeset
546 e.g. `xbm', FILE is the file to load the image from, and DATA is a
29470
7bde123bed95 (find-image): Doc fix. Return nil if image not found.
Dave Love <fx@gnu.org>
parents: 28958
diff changeset
547 string containing the actual image data. The specification whose TYPE
7bde123bed95 (find-image): Doc fix. Return nil if image not found.
Dave Love <fx@gnu.org>
parents: 28958
diff changeset
548 is supported, and FILE exists, is used to construct the image
7bde123bed95 (find-image): Doc fix. Return nil if image not found.
Dave Love <fx@gnu.org>
parents: 28958
diff changeset
549 specification to be returned. Return nil if no specification is
7bde123bed95 (find-image): Doc fix. Return nil if image not found.
Dave Love <fx@gnu.org>
parents: 28958
diff changeset
550 satisfied.
7bde123bed95 (find-image): Doc fix. Return nil if image not found.
Dave Love <fx@gnu.org>
parents: 28958
diff changeset
551
66196
2e59eea25fcf * image.el (create-image, find-image): Mention max-image-size in
Chong Yidong <cyd@stupidchicken.com>
parents: 65599
diff changeset
552 The image is looked for in `image-load-path'.
2e59eea25fcf * image.el (create-image, find-image): Mention max-image-size in
Chong Yidong <cyd@stupidchicken.com>
parents: 65599
diff changeset
553
2e59eea25fcf * image.el (create-image, find-image): Mention max-image-size in
Chong Yidong <cyd@stupidchicken.com>
parents: 65599
diff changeset
554 Image files should not be larger than specified by `max-image-size'."
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
555 (let (image)
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
556 (while (and specs (null image))
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
557 (let* ((spec (car specs))
27073
aad0a025b1e3 (defimage): Handle specifications containing :data
Gerd Moellmann <gerd@gnu.org>
parents: 27059
diff changeset
558 (type (plist-get spec :type))
27059
6bb2a4a0413e * image.el (defimage): Images with the :data keyword should be considered valid as well.
William M. Perry <wmperry@aventail.com>
parents: 26007
diff changeset
559 (data (plist-get spec :data))
27921
ea0a2a4f20b7 (defimage): Look for image files in load-path.
Gerd Moellmann <gerd@gnu.org>
parents: 27075
diff changeset
560 (file (plist-get spec :file))
ea0a2a4f20b7 (defimage): Look for image files in load-path.
Gerd Moellmann <gerd@gnu.org>
parents: 27075
diff changeset
561 found)
27073
aad0a025b1e3 (defimage): Handle specifications containing :data
Gerd Moellmann <gerd@gnu.org>
parents: 27059
diff changeset
562 (when (image-type-available-p type)
aad0a025b1e3 (defimage): Handle specifications containing :data
Gerd Moellmann <gerd@gnu.org>
parents: 27059
diff changeset
563 (cond ((stringp file)
66296
941b6508462f (image-type-header-regexps): Rename from image-type-regexps.
Kim F. Storm <storm@cua.dk>
parents: 66196
diff changeset
564 (if (setq found (image-search-load-path file))
65544
78d74ef1436b 2005-09-15 Chong Yidong <cyd@stupidchicken.com>
Chong Yidong <cyd@stupidchicken.com>
parents: 64762
diff changeset
565 (setq image
78d74ef1436b 2005-09-15 Chong Yidong <cyd@stupidchicken.com>
Chong Yidong <cyd@stupidchicken.com>
parents: 64762
diff changeset
566 (cons 'image (plist-put (copy-sequence spec)
78d74ef1436b 2005-09-15 Chong Yidong <cyd@stupidchicken.com>
Chong Yidong <cyd@stupidchicken.com>
parents: 64762
diff changeset
567 :file found)))))
27075
893ec72bd6b1 (create-image, defimage): Don't assume image data is a
Gerd Moellmann <gerd@gnu.org>
parents: 27073
diff changeset
568 ((not (null data))
27073
aad0a025b1e3 (defimage): Handle specifications containing :data
Gerd Moellmann <gerd@gnu.org>
parents: 27059
diff changeset
569 (setq image (cons 'image spec)))))
aad0a025b1e3 (defimage): Handle specifications containing :data
Gerd Moellmann <gerd@gnu.org>
parents: 27059
diff changeset
570 (setq specs (cdr specs))))
28721
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
571 image))
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
572
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
573
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
574 ;;;###autoload
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
575 (defmacro defimage (symbol specs &optional doc)
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
576 "Define SYMBOL as an image.
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
577
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
578 SPECS is a list of image specifications. DOC is an optional
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
579 documentation string.
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
580
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
581 Each image specification in SPECS is a property list. The contents of
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
582 a specification are image type dependent. All specifications must at
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
583 least contain the properties `:type TYPE' and either `:file FILE' or
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
584 `:data DATA', where TYPE is a symbol specifying the image type,
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
585 e.g. `xbm', FILE is the file to load the image from, and DATA is a
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
586 string containing the actual image data. The first image
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
587 specification whose TYPE is supported, and FILE exists, is used to
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
588 define SYMBOL.
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
589
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
590 Example:
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
591
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
592 (defimage test-image ((:type xpm :file \"~/test1.xpm\")
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
593 (:type xbm :file \"~/test1.xbm\")))"
66402
ade0d81f63a9 (defimage): Add `doc-string' declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 66307
diff changeset
594 (declare (doc-string 3))
28721
b4ea18c92e38 (find-image): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 27921
diff changeset
595 `(defvar ,symbol (find-image ',specs) ,doc))
25003
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
596
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
597
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
598 (provide 'image)
bb68fe3c72f8 New file.
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
599
66402
ade0d81f63a9 (defimage): Add `doc-string' declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 66307
diff changeset
600 ;; arch-tag: 8e76a07b-eb48-4f3e-a7a0-1a7ba9f096b3
25872
6ae50308e8a3 Fix footer comment.
Dave Love <fx@gnu.org>
parents: 25857
diff changeset
601 ;;; image.el ends here