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