merge trunk
[emacs.git] / lisp / ezimage.el
blob346b69d9912b6e92d07622f5b2ba2afe9be9cc00
1 ;;; ezimage --- Generalized Image management
3 ;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
6 ;; Keywords: file, tags, tools
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23 ;;; Commentary:
25 ;; A few routines for placing an image over text that will work for any
26 ;; Emacs implementation without error. When images are not supported, then
27 ;; they are just not displayed.
29 ;; The idea is that gui buffers (trees, buttons, etc) will have text
30 ;; representations of the GUI elements. These routines will replace the text
31 ;; with an image when images are available.
33 ;; This file requires the `image' package if it is available.
35 (condition-case nil ; for older XEmacs
36 (require 'image)
37 (error nil))
39 ;;; Code:
40 (defcustom ezimage-use-images (if (featurep 'xemacs)
41 (and (fboundp 'make-image-specifier)
42 window-system)
43 (and (display-images-p)
44 (image-type-available-p 'xpm)))
45 "Non-nil means ezimage should display icons."
46 :group 'ezimage
47 :version "21.1"
48 :type 'boolean)
50 ;;; Create our own version of defimage
51 (eval-and-compile
53 (if (featurep 'emacs)
54 (progn
55 (defmacro defezimage (variable imagespec docstring)
56 "Define VARIABLE as an image if `defimage' is not available.
57 IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
58 `(progn
59 (defimage ,variable ,imagespec ,docstring)
60 (put (quote ,variable) 'ezimage t)))
62 ;; This hack is for the ezimage install which has an icons directory for
63 ;; the default icons to be used.
64 ;; (add-to-list 'load-path
65 ;; (concat (file-name-directory
66 ;; (locate-library "ezimage.el"))
67 ;; "icons"))
71 ;; XEmacs.
72 (if (not (fboundp 'make-glyph))
74 (defmacro defezimage (variable _imagespec docstring)
75 "Don't bother loading up an image...
76 Argument VARIABLE is the variable to define.
77 Argument IMAGESPEC is the list defining the image to create.
78 Argument DOCSTRING is the documentation for VARIABLE."
79 `(defvar ,variable nil ,docstring))
81 (defun ezimage-find-image-on-load-path (image)
82 "Find the image file IMAGE on the load path."
83 (let ((l (cons
84 ;; In XEmacs, try the data directory first (for an
85 ;; install in XEmacs proper.) Search the load
86 ;; path next (for user installs)
87 (locate-data-directory "ezimage")
88 load-path))
89 (r nil))
90 (while (and l (not r))
91 (if (file-exists-p (concat (car l) "/" image))
92 (setq r (concat (car l) "/" image))
93 (if (file-exists-p (concat (car l) "/icons/" image))
94 (setq r (concat (car l) "/icons/" image))
96 (setq l (cdr l)))
97 r))
99 (defun ezimage-convert-emacs21-imagespec-to-xemacs (spec)
100 "Convert the Emacs21 image SPEC into an XEmacs image spec.
101 The Emacs 21 spec is what I first learned, and is easy to convert."
102 (let* ((sl (car spec))
103 (itype (nth 1 sl))
104 (ifile (nth 3 sl)))
105 (vector itype ':file (ezimage-find-image-on-load-path ifile))))
107 (defmacro defezimage (variable imagespec docstring)
108 "Define VARIABLE as an image if `defimage' is not available.
109 IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
110 `(progn
111 (defvar ,variable
112 ;; The Emacs21 version of defimage looks just like the XEmacs image
113 ;; specifier, except that it needs a :type keyword. If we line
114 ;; stuff up right, we can use this cheat to support XEmacs specifiers.
115 (condition-case nil
116 (make-glyph
117 (make-image-specifier
118 (ezimage-convert-emacs21-imagespec-to-xemacs (quote ,imagespec)))
119 'buffer)
120 (error nil))
121 ,docstring)
122 (put ',variable 'ezimage t)))
126 (defezimage ezimage-directory
127 ((:type xpm :file "ezimage/dir.xpm" :ascent center))
128 "Image used for empty directories.")
130 (defezimage ezimage-directory-plus
131 ((:type xpm :file "ezimage/dir-plus.xpm" :ascent center))
132 "Image used for closed directories with stuff in them.")
134 (defezimage ezimage-directory-minus
135 ((:type xpm :file "ezimage/dir-minus.xpm" :ascent center))
136 "Image used for open directories with stuff in them.")
138 (defezimage ezimage-page-plus
139 ((:type xpm :file "ezimage/page-plus.xpm" :ascent center))
140 "Image used for closed files with stuff in them.")
142 (defezimage ezimage-page-minus
143 ((:type xpm :file "ezimage/page-minus.xpm" :ascent center))
144 "Image used for open files with stuff in them.")
146 (defezimage ezimage-page
147 ((:type xpm :file "ezimage/page.xpm" :ascent center))
148 "Image used for files with nothing interesting in it.")
150 (defezimage ezimage-tag
151 ((:type xpm :file "ezimage/tag.xpm" :ascent center))
152 "Image used for tags.")
154 (defezimage ezimage-tag-plus
155 ((:type xpm :file "ezimage/tag-plus.xpm" :ascent center))
156 "Image used for closed tag groups.")
158 (defezimage ezimage-tag-minus
159 ((:type xpm :file "ezimage/tag-minus.xpm" :ascent center))
160 "Image used for open tags.")
162 (defezimage ezimage-tag-gt
163 ((:type xpm :file "ezimage/tag-gt.xpm" :ascent center))
164 "Image used for closed tags (with twist arrow).")
166 (defezimage ezimage-tag-v
167 ((:type xpm :file "ezimage/tag-v.xpm" :ascent center))
168 "Image used for open tags (with twist arrow).")
170 (defezimage ezimage-tag-type
171 ((:type xpm :file "ezimage/tag-type.xpm" :ascent center))
172 "Image used for tags that represent a data type.")
174 (defezimage ezimage-box-plus
175 ((:type xpm :file "ezimage/box-plus.xpm" :ascent center))
176 "Image of a closed box.")
178 (defezimage ezimage-box-minus
179 ((:type xpm :file "ezimage/box-minus.xpm" :ascent center))
180 "Image of an open box.")
182 (defezimage ezimage-mail
183 ((:type xpm :file "ezimage/mail.xpm" :ascent center))
184 "Image of an envelope.")
186 (defezimage ezimage-checkout
187 ((:type xpm :file "ezimage/checkmark.xpm" :ascent center))
188 "Image representing a checkmark. For files checked out of a VC.")
190 (defezimage ezimage-object
191 ((:type xpm :file "ezimage/bits.xpm" :ascent center))
192 "Image representing bits (an object file.)")
194 (defezimage ezimage-object-out-of-date
195 ((:type xpm :file "ezimage/bitsbang.xpm" :ascent center))
196 "Image representing bits with a ! in it. (An out of data object file.)")
198 (defezimage ezimage-label
199 ((:type xpm :file "ezimage/label.xpm" :ascent center))
200 "Image used for label prefix.")
202 (defezimage ezimage-lock
203 ((:type xpm :file "ezimage/lock.xpm" :ascent center))
204 "Image of a lock. Used for Read Only, or private.")
206 (defezimage ezimage-unlock
207 ((:type xpm :file "ezimage/unlock.xpm" :ascent center))
208 "Image of an unlocked lock.")
210 (defezimage ezimage-key
211 ((:type xpm :file "ezimage/key.xpm" :ascent center))
212 "Image of a key.")
214 (defezimage ezimage-document-tag
215 ((:type xpm :file "ezimage/doc.xpm" :ascent center))
216 "Image used to indicate documentation available.")
218 (defezimage ezimage-document-plus
219 ((:type xpm :file "ezimage/doc-plus.xpm" :ascent center))
220 "Image used to indicate closed documentation.")
222 (defezimage ezimage-document-minus
223 ((:type xpm :file "ezimage/doc-minus.xpm" :ascent center))
224 "Image used to indicate open documentation.")
226 (defezimage ezimage-info-tag
227 ((:type xpm :file "ezimage/info.xpm" :ascent center))
228 "Image used to indicate more information available.")
230 (defvar ezimage-expand-image-button-alist
232 ;; here are some standard representations
233 ("<+>" . ezimage-directory-plus)
234 ("<->" . ezimage-directory-minus)
235 ("< >" . ezimage-directory)
236 ("[+]" . ezimage-page-plus)
237 ("[-]" . ezimage-page-minus)
238 ("[?]" . ezimage-page)
239 ("[ ]" . ezimage-page)
240 ("{+}" . ezimage-box-plus)
241 ("{-}" . ezimage-box-minus)
242 ;; Some vaguely representative entries
243 ("*" . ezimage-checkout)
244 ("#" . ezimage-object)
245 ("!" . ezimage-object-out-of-date)
246 ("%" . ezimage-lock)
248 "List of text and image associations.")
250 (defun ezimage-insert-image-button-maybe (start length &optional string)
251 "Insert an image button based on text starting at START for LENGTH chars.
252 If buttontext is unknown, just insert that text.
253 If we have an image associated with it, use that image.
254 Optional argument STRING is a string upon which to add text properties."
255 (when ezimage-use-images
256 (let* ((bt (buffer-substring start (+ length start)))
257 (a (assoc bt ezimage-expand-image-button-alist)))
258 ;; Regular images (created with `insert-image' are intangible
259 ;; which (I suppose) make them more compatible with XEmacs 21.
260 ;; Unfortunately, there is a giant pile of code dependent on the
261 ;; underlying text. This means if we leave it tangible, then I
262 ;; don't have to change said giant piles of code.
263 (if (and a (symbol-value (cdr a)))
264 (ezimage-insert-over-text (symbol-value (cdr a))
265 start
266 (+ start (length bt))))))
267 string)
269 (defun ezimage-image-over-string (string &optional alist)
270 "Insert over the text in STRING an image found in ALIST.
271 Return STRING with properties applied."
272 (if ezimage-use-images
273 (let ((a (assoc string alist)))
274 (if (and a (symbol-value (cdr a)))
275 (ezimage-insert-over-text (symbol-value (cdr a))
276 0 (length string)
277 string)
278 string))
279 string))
281 (defun ezimage-insert-over-text (image start end &optional string)
282 "Place IMAGE over the text between START and END.
283 Assumes the image is part of a GUI and can be clicked on.
284 Optional argument STRING is a string upon which to add text properties."
285 (when ezimage-use-images
286 (add-text-properties start end
287 (if (featurep 'xemacs)
288 (list 'end-glyph image
289 'rear-nonsticky (list 'display)
290 'invisible t
291 'detachable t)
292 (list 'display image
293 'rear-nonsticky (list 'display)))
294 string))
295 string)
297 (defun ezimage-image-association-dump ()
298 "Dump out the current state of the Ezimage image alist.
299 See `ezimage-expand-image-button-alist' for details."
300 (interactive)
301 (with-output-to-temp-buffer "*Ezimage Images*"
302 (with-current-buffer "*Ezimage Images*"
303 (goto-char (point-max))
304 (insert "Ezimage image cache.\n\n")
305 (let ((start (point)) (end nil))
306 (insert "Image\tText\tImage Name")
307 (setq end (point))
308 (insert "\n")
309 (put-text-property start end 'face 'underline))
310 (let ((ia ezimage-expand-image-button-alist))
311 (while ia
312 (let ((start (point)))
313 (insert (car (car ia)))
314 (insert "\t")
315 (ezimage-insert-image-button-maybe start
316 (length (car (car ia))))
317 (insert (car (car ia)) "\t" (format "%s" (cdr (car ia))) "\n"))
318 (setq ia (cdr ia)))))))
320 (defun ezimage-image-dump ()
321 "Dump out the current state of the Ezimage image alist.
322 See `ezimage-expand-image-button-alist' for details."
323 (interactive)
324 (with-output-to-temp-buffer "*Ezimage Images*"
325 (with-current-buffer "*Ezimage Images*"
326 (goto-char (point-max))
327 (insert "Ezimage image cache.\n\n")
328 (let ((start (point)) (end nil))
329 (insert "Image\tImage Name")
330 (setq end (point))
331 (insert "\n")
332 (put-text-property start end 'face 'underline))
333 (let ((ia (ezimage-all-images)))
334 (while ia
335 (let ((start (point)))
336 (insert "cm")
337 (ezimage-insert-over-text (symbol-value (car ia)) start (point))
338 (insert "\t" (format "%s" (car ia)) "\n"))
339 (setq ia (cdr ia)))))))
341 (defun ezimage-all-images ()
342 "Return a list of all variables containing ez images."
343 (let ((ans nil))
344 (mapatoms (lambda (sym)
345 (if (get sym 'ezimage) (setq ans (cons sym ans)))))
346 (setq ans (sort ans (lambda (a b)
347 (string< (symbol-name a) (symbol-name b)))))
348 ans))
350 (provide 'ezimage)
352 ;;; sb-image.el ends here