comparison lisp/ezimage.el @ 95072:a2ec715aefb4

(ezimage-use-images): Drop support for Emacs < 21 and simplify initial value. (defezimage): Drop support for Emacs without defimage, use a featurep test rather than fboundp when defining, drop with-no-warnings. (ezimage-insert-over-text): Move featurep test inside add-text-properties.
author Glenn Morris <rgm@gnu.org>
date Sat, 17 May 2008 20:20:55 +0000
parents ee5932bf781d
children a9dc0e7c3f2b
comparison
equal deleted inserted replaced
95071:3be19d5fa2a3 95072:a2ec715aefb4
1 ;;; ezimage --- Generalized Image management 1 ;;; ezimage --- Generalized Image management
2 2
3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. 4 ;; 2008 Free Software Foundation, Inc.
5 5
6 ;; Author: Eric M. Ludlam <zappo@gnu.org> 6 ;; Author: Eric M. Ludlam <zappo@gnu.org>
7 ;; Keywords: file, tags, tools 7 ;; Keywords: file, tags, tools
8 8
9 ;; This file is part of GNU Emacs. 9 ;; This file is part of GNU Emacs.
31 ;; representations of the GUI elements. These routines will replace the text 31 ;; representations of the GUI elements. These routines will replace the text
32 ;; with an image when images are available. 32 ;; with an image when images are available.
33 ;; 33 ;;
34 ;; This file requires the `image' package if it is available. 34 ;; This file requires the `image' package if it is available.
35 35
36 (condition-case nil 36 (condition-case nil ; for older XEmacs
37 (require 'image) 37 (require 'image)
38 (error nil)) 38 (error nil))
39 39
40 ;;; Code: 40 ;;; Code:
41 (defcustom ezimage-use-images 41 (defcustom ezimage-use-images (if (featurep 'xemacs)
42 (and (or (fboundp 'defimage) ; emacs 21 42 (and (fboundp 'make-image-specifier)
43 (fboundp 'make-image-specifier)) ; xemacs 43 window-system)
44 (if (fboundp 'display-graphic-p) ; emacs 21 44 (and (display-images-p)
45 (display-graphic-p) 45 (image-type-available-p 'xpm)))
46 window-system) ; old emacs & xemacs 46 "Non-nil means ezimage should display icons."
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 47 :group 'ezimage
51 :version "21.1" 48 :version "21.1"
52 :type 'boolean) 49 :type 'boolean)
53 50
54 ;;; Create our own version of defimage 51 ;;; Create our own version of defimage
55 (eval-and-compile 52 (eval-and-compile
56 53
57 (if (fboundp 'defimage) 54 (if (featurep 'emacs)
58
59 (progn 55 (progn
60 56 (defmacro defezimage (variable imagespec docstring)
61 (defmacro defezimage (variable imagespec docstring) 57 "Define VARIABLE as an image if `defimage' is not available.
62 "Define VARIABLE as an image if `defimage' is not available.
63 IMAGESPEC is the image data, and DOCSTRING is documentation for the image." 58 IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
64 `(progn 59 `(progn
65 (defimage ,variable ,imagespec ,docstring) 60 (defimage ,variable ,imagespec ,docstring)
66 (put (quote ,variable) 'ezimage t))) 61 (put (quote ,variable) 'ezimage t)))
67
68 ; (defalias 'defezimage 'defimage)
69 62
70 ;; This hack is for the ezimage install which has an icons direcory for 63 ;; This hack is for the ezimage install which has an icons direcory for
71 ;; the default icons to be used. 64 ;; the default icons to be used.
72 ;; (add-to-list 'load-path 65 ;; (add-to-list 'load-path
73 ;; (concat (file-name-directory 66 ;; (concat (file-name-directory
74 ;; (locate-library "ezimage.el")) 67 ;; (locate-library "ezimage.el"))
75 ;; "icons")) 68 ;; "icons"))
76 69
77 ) 70 )
71
72 ;; XEmacs.
78 (if (not (fboundp 'make-glyph)) 73 (if (not (fboundp 'make-glyph))
79 74
80 (defmacro defezimage (variable imagespec docstring) 75 (defmacro defezimage (variable imagespec docstring)
81 "Don't bother loading up an image... 76 "Don't bother loading up an image...
82 Argument VARIABLE is the variable to define. 77 Argument VARIABLE is the variable to define.
83 Argument IMAGESPEC is the list defining the image to create. 78 Argument IMAGESPEC is the list defining the image to create.
84 Argument DOCSTRING is the documentation for VARIABLE." 79 Argument DOCSTRING is the documentation for VARIABLE."
85 `(defvar ,variable nil ,docstring)) 80 `(defvar ,variable nil ,docstring))
86 81
87 ;; ELSE 82 (defun ezimage-find-image-on-load-path (image)
88 (with-no-warnings 83 "Find the image file IMAGE on the load path."
89 (defun ezimage-find-image-on-load-path (image) 84 (let ((l (cons
90 "Find the image file IMAGE on the load path." 85 ;; In XEmacs, try the data directory first (for an
91 (let ((l (cons 86 ;; install in XEmacs proper.) Search the load
92 ;; In XEmacs, try the data directory first (for an 87 ;; path next (for user installs)
93 ;; install in XEmacs proper.) Search the load 88 (locate-data-directory "ezimage")
94 ;; path next (for user installs) 89 load-path))
95 (locate-data-directory "ezimage") 90 (r nil))
96 load-path)) 91 (while (and l (not r))
97 (r nil)) 92 (if (file-exists-p (concat (car l) "/" image))
98 (while (and l (not r)) 93 (setq r (concat (car l) "/" image))
99 (if (file-exists-p (concat (car l) "/" image)) 94 (if (file-exists-p (concat (car l) "/icons/" image))
100 (setq r (concat (car l) "/" image)) 95 (setq r (concat (car l) "/icons/" image))
101 (if (file-exists-p (concat (car l) "/icons/" image)) 96 ))
102 (setq r (concat (car l) "/icons/" image)) 97 (setq l (cdr l)))
103 )) 98 r))
104 (setq l (cdr l))) 99
105 r)) 100 (defun ezimage-convert-emacs21-imagespec-to-xemacs (spec)
106 );with-no-warnings 101 "Convert the Emacs21 image SPEC into an XEmacs image spec.
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." 102 The Emacs 21 spec is what I first learned, and is easy to convert."
112 (let* ((sl (car spec)) 103 (let* ((sl (car spec))
113 (itype (nth 1 sl)) 104 (itype (nth 1 sl))
114 (ifile (nth 3 sl))) 105 (ifile (nth 3 sl)))
115 (vector itype ':file (ezimage-find-image-on-load-path ifile)))) 106 (vector itype ':file (ezimage-find-image-on-load-path ifile))))
116 );with-no-warnings 107
117 108 (defmacro defezimage (variable imagespec docstring)
118 (defmacro defezimage (variable imagespec docstring) 109 "Define VARIABLE as an image if `defimage' is not available.
119 "Define VARIABLE as an image if `defimage' is not available.
120 IMAGESPEC is the image data, and DOCSTRING is documentation for the image." 110 IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
121 `(progn 111 `(progn
122 (defvar ,variable 112 (defvar ,variable
123 ;; The Emacs21 version of defimage looks just like the XEmacs image 113 ;; The Emacs21 version of defimage looks just like the XEmacs image
124 ;; specifier, except that it needs a :type keyword. If we line 114 ;; specifier, except that it needs a :type keyword. If we line
125 ;; stuff up right, we can use this cheat to support XEmacs specifiers. 115 ;; stuff up right, we can use this cheat to support XEmacs specifiers.
126 (condition-case nil 116 (condition-case nil
127 (make-glyph 117 (make-glyph
128 (make-image-specifier 118 (make-image-specifier
129 (ezimage-convert-emacs21-imagespec-to-xemacs (quote ,imagespec))) 119 (ezimage-convert-emacs21-imagespec-to-xemacs (quote ,imagespec)))
130 'buffer) 120 'buffer)
131 (error nil)) 121 (error nil))
132 ,docstring) 122 ,docstring)
133 (put ',variable 'ezimage t))) 123 (put ',variable 'ezimage t)))
134 124
135 ))) 125 )))
136 126
137 (defezimage ezimage-directory 127 (defezimage ezimage-directory
138 ((:type xpm :file "ezimage/dir.xpm" :ascent center)) 128 ((:type xpm :file "ezimage/dir.xpm" :ascent center))
139 "Image used for empty directories.") 129 "Image used for empty directories.")
140 130
292 (defun ezimage-insert-over-text (image start end &optional string) 282 (defun ezimage-insert-over-text (image start end &optional string)
293 "Place IMAGE over the text between START and END. 283 "Place IMAGE over the text between START and END.
294 Assumes the image is part of a GUI and can be clicked on. 284 Assumes the image is part of a GUI and can be clicked on.
295 Optional argument STRING is a string upon which to add text properties." 285 Optional argument STRING is a string upon which to add text properties."
296 (when ezimage-use-images 286 (when ezimage-use-images
297 (if (featurep 'xemacs) 287 (add-text-properties start end
298 (add-text-properties start end 288 (if (featurep 'xemacs)
299 (list 'end-glyph image 289 (list 'end-glyph image
300 'rear-nonsticky (list 'display) 290 'rear-nonsticky (list 'display)
301 'invisible t 291 'invisible t
302 'detachable t) 292 'detachable t)
303 string)
304 (add-text-properties start end
305 (list 'display image 293 (list 'display image
306 'rear-nonsticky (list 'display)) 294 'rear-nonsticky (list 'display)))
307 string))) 295 string))
308 string) 296 string)
309 297
310 (defun ezimage-image-association-dump () 298 (defun ezimage-image-association-dump ()
311 "Dump out the current state of the Ezimage image alist. 299 "Dump out the current state of the Ezimage image alist.
312 See `ezimage-expand-image-button-alist' for details." 300 See `ezimage-expand-image-button-alist' for details."
355 343
356 (defun ezimage-all-images () 344 (defun ezimage-all-images ()
357 "Return a list of all variables containing ez images." 345 "Return a list of all variables containing ez images."
358 (let ((ans nil)) 346 (let ((ans nil))
359 (mapatoms (lambda (sym) 347 (mapatoms (lambda (sym)
360 (if (get sym 'ezimage) (setq ans (cons sym ans)))) 348 (if (get sym 'ezimage) (setq ans (cons sym ans)))))
361 )
362 (setq ans (sort ans (lambda (a b) 349 (setq ans (sort ans (lambda (a b)
363 (string< (symbol-name a) (symbol-name b))))) 350 (string< (symbol-name a) (symbol-name b)))))
364 ans) 351 ans))
365 )
366 352
367 (provide 'ezimage) 353 (provide 'ezimage)
368 354
369 ;; arch-tag: d4ea2d93-3c7a-4cb3-b5a6-c1b9178183aa 355 ;; arch-tag: d4ea2d93-3c7a-4cb3-b5a6-c1b9178183aa
370 ;;; sb-image.el ends here 356 ;;; sb-image.el ends here