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