Commit | Line | Data |
---|---|---|
58bd8bf9 CY |
1 | ;;; ezimage --- Generalized Image management |
2 | ||
acaf905b | 3 | ;; Copyright (C) 1999-2012 Free Software Foundation, Inc. |
58bd8bf9 CY |
4 | |
5 | ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
6 | ;; Keywords: file, tags, tools | |
58bd8bf9 CY |
7 | |
8 | ;; This file is part of GNU Emacs. | |
9 | ||
eb3fa2cf | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
58bd8bf9 | 11 | ;; it under the terms of the GNU General Public License as published by |
eb3fa2cf GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
58bd8bf9 CY |
14 | |
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. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
eb3fa2cf | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
58bd8bf9 CY |
22 | |
23 | ;;; Commentary: | |
24 | ;; | |
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 | |
7c5800f0 | 27 | ;; they are just not displayed. |
58bd8bf9 CY |
28 | ;; |
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. | |
32 | ;; | |
33 | ;; This file requires the `image' package if it is available. | |
34 | ||
819d0ce9 | 35 | (condition-case nil ; for older XEmacs |
58bd8bf9 CY |
36 | (require 'image) |
37 | (error nil)) | |
38 | ||
39 | ;;; Code: | |
819d0ce9 GM |
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." | |
58bd8bf9 CY |
46 | :group 'ezimage |
47 | :version "21.1" | |
48 | :type 'boolean) | |
49 | ||
50 | ;;; Create our own version of defimage | |
51 | (eval-and-compile | |
52 | ||
819d0ce9 | 53 | (if (featurep 'emacs) |
58bd8bf9 | 54 | (progn |
819d0ce9 GM |
55 | (defmacro defezimage (variable imagespec docstring) |
56 | "Define VARIABLE as an image if `defimage' is not available. | |
58bd8bf9 | 57 | IMAGESPEC is the image data, and DOCSTRING is documentation for the image." |
819d0ce9 GM |
58 | `(progn |
59 | (defimage ,variable ,imagespec ,docstring) | |
60 | (put (quote ,variable) 'ezimage t))) | |
58bd8bf9 | 61 | |
4c36be58 | 62 | ;; This hack is for the ezimage install which has an icons directory for |
58bd8bf9 CY |
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")) | |
68 | ||
69 | ) | |
819d0ce9 GM |
70 | |
71 | ;; XEmacs. | |
58bd8bf9 | 72 | (if (not (fboundp 'make-glyph)) |
3f19eaa7 | 73 | |
06b60517 | 74 | (defmacro defezimage (variable _imagespec docstring) |
819d0ce9 | 75 | "Don't bother loading up an image... |
58bd8bf9 CY |
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." | |
819d0ce9 GM |
79 | `(defvar ,variable nil ,docstring)) |
80 | ||
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)) | |
95 | )) | |
96 | (setq l (cdr l))) | |
97 | r)) | |
98 | ||
99 | (defun ezimage-convert-emacs21-imagespec-to-xemacs (spec) | |
100 | "Convert the Emacs21 image SPEC into an XEmacs image spec. | |
58bd8bf9 | 101 | The Emacs 21 spec is what I first learned, and is easy to convert." |
819d0ce9 GM |
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)))) | |
106 | ||
107 | (defmacro defezimage (variable imagespec docstring) | |
108 | "Define VARIABLE as an image if `defimage' is not available. | |
58bd8bf9 | 109 | IMAGESPEC is the image data, and DOCSTRING is documentation for the image." |
819d0ce9 GM |
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))) | |
123 | ||
124 | ))) | |
58bd8bf9 CY |
125 | |
126 | (defezimage ezimage-directory | |
127 | ((:type xpm :file "ezimage/dir.xpm" :ascent center)) | |
128 | "Image used for empty directories.") | |
129 | ||
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.") | |
133 | ||
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.") | |
137 | ||
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.") | |
141 | ||
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.") | |
145 | ||
146 | (defezimage ezimage-page | |
147 | ((:type xpm :file "ezimage/page.xpm" :ascent center)) | |
148 | "Image used for files with nothing interesting in it.") | |
149 | ||
150 | (defezimage ezimage-tag | |
151 | ((:type xpm :file "ezimage/tag.xpm" :ascent center)) | |
152 | "Image used for tags.") | |
153 | ||
154 | (defezimage ezimage-tag-plus | |
155 | ((:type xpm :file "ezimage/tag-plus.xpm" :ascent center)) | |
156 | "Image used for closed tag groups.") | |
157 | ||
158 | (defezimage ezimage-tag-minus | |
159 | ((:type xpm :file "ezimage/tag-minus.xpm" :ascent center)) | |
160 | "Image used for open tags.") | |
161 | ||
162 | (defezimage ezimage-tag-gt | |
163 | ((:type xpm :file "ezimage/tag-gt.xpm" :ascent center)) | |
164 | "Image used for closed tags (with twist arrow).") | |
165 | ||
166 | (defezimage ezimage-tag-v | |
167 | ((:type xpm :file "ezimage/tag-v.xpm" :ascent center)) | |
168 | "Image used for open tags (with twist arrow).") | |
169 | ||
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.") | |
173 | ||
174 | (defezimage ezimage-box-plus | |
175 | ((:type xpm :file "ezimage/box-plus.xpm" :ascent center)) | |
176 | "Image of a closed box.") | |
177 | ||
178 | (defezimage ezimage-box-minus | |
179 | ((:type xpm :file "ezimage/box-minus.xpm" :ascent center)) | |
180 | "Image of an open box.") | |
181 | ||
182 | (defezimage ezimage-mail | |
183 | ((:type xpm :file "ezimage/mail.xpm" :ascent center)) | |
3f19eaa7 | 184 | "Image of an envelope.") |
58bd8bf9 CY |
185 | |
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.") | |
189 | ||
190 | (defezimage ezimage-object | |
191 | ((:type xpm :file "ezimage/bits.xpm" :ascent center)) | |
192 | "Image representing bits (an object file.)") | |
193 | ||
194 | (defezimage ezimage-object-out-of-date | |
195 | ((:type xpm :file "ezimage/bitsbang.xpm" :ascent center)) | |
3f19eaa7 | 196 | "Image representing bits with a ! in it. (An out of data object file.)") |
58bd8bf9 CY |
197 | |
198 | (defezimage ezimage-label | |
199 | ((:type xpm :file "ezimage/label.xpm" :ascent center)) | |
200 | "Image used for label prefix.") | |
201 | ||
202 | (defezimage ezimage-lock | |
203 | ((:type xpm :file "ezimage/lock.xpm" :ascent center)) | |
204 | "Image of a lock. Used for Read Only, or private.") | |
205 | ||
206 | (defezimage ezimage-unlock | |
207 | ((:type xpm :file "ezimage/unlock.xpm" :ascent center)) | |
208 | "Image of an unlocked lock.") | |
209 | ||
210 | (defezimage ezimage-key | |
211 | ((:type xpm :file "ezimage/key.xpm" :ascent center)) | |
212 | "Image of a key.") | |
213 | ||
214 | (defezimage ezimage-document-tag | |
215 | ((:type xpm :file "ezimage/doc.xpm" :ascent center)) | |
216 | "Image used to indicate documentation available.") | |
217 | ||
218 | (defezimage ezimage-document-plus | |
219 | ((:type xpm :file "ezimage/doc-plus.xpm" :ascent center)) | |
220 | "Image used to indicate closed documentation.") | |
221 | ||
222 | (defezimage ezimage-document-minus | |
223 | ((:type xpm :file "ezimage/doc-minus.xpm" :ascent center)) | |
224 | "Image used to indicate open documentation.") | |
225 | ||
226 | (defezimage ezimage-info-tag | |
227 | ((:type xpm :file "ezimage/info.xpm" :ascent center)) | |
228 | "Image used to indicate more information available.") | |
229 | ||
230 | (defvar ezimage-expand-image-button-alist | |
231 | '( | |
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) | |
40ba43b4 | 242 | ;; Some vaguely representative entries |
58bd8bf9 CY |
243 | ("*" . ezimage-checkout) |
244 | ("#" . ezimage-object) | |
245 | ("!" . ezimage-object-out-of-date) | |
246 | ("%" . ezimage-lock) | |
247 | ) | |
248 | "List of text and image associations.") | |
249 | ||
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. | |
3f19eaa7 | 254 | Optional argument STRING is a string upon which to add text properties." |
58bd8bf9 CY |
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. | |
40a8bdf6 | 260 | ;; Unfortunately, there is a giant pile of code dependent on the |
58bd8bf9 | 261 | ;; underlying text. This means if we leave it tangible, then I |
40a8bdf6 | 262 | ;; don't have to change said giant piles of code. |
58bd8bf9 CY |
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) | |
268 | ||
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)) | |
280 | ||
281 | (defun ezimage-insert-over-text (image start end &optional string) | |
282 | "Place IMAGE over the text between START and END. | |
3f19eaa7 | 283 | Assumes the image is part of a GUI and can be clicked on. |
58bd8bf9 CY |
284 | Optional argument STRING is a string upon which to add text properties." |
285 | (when ezimage-use-images | |
819d0ce9 GM |
286 | (add-text-properties start end |
287 | (if (featurep 'xemacs) | |
58bd8bf9 CY |
288 | (list 'end-glyph image |
289 | 'rear-nonsticky (list 'display) | |
290 | 'invisible t | |
291 | 'detachable t) | |
58bd8bf9 | 292 | (list 'display image |
819d0ce9 GM |
293 | 'rear-nonsticky (list 'display))) |
294 | string)) | |
58bd8bf9 CY |
295 | string) |
296 | ||
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*" | |
7fdbcd83 | 302 | (with-current-buffer "*Ezimage Images*" |
58bd8bf9 CY |
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))))))) | |
319 | ||
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*" | |
7fdbcd83 | 325 | (with-current-buffer "*Ezimage Images*" |
58bd8bf9 CY |
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))))))) | |
340 | ||
341 | (defun ezimage-all-images () | |
342 | "Return a list of all variables containing ez images." | |
343 | (let ((ans nil)) | |
344 | (mapatoms (lambda (sym) | |
819d0ce9 | 345 | (if (get sym 'ezimage) (setq ans (cons sym ans))))) |
58bd8bf9 CY |
346 | (setq ans (sort ans (lambda (a b) |
347 | (string< (symbol-name a) (symbol-name b))))) | |
819d0ce9 | 348 | ans)) |
58bd8bf9 CY |
349 | |
350 | (provide 'ezimage) | |
351 | ||
352 | ;;; sb-image.el ends here |