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