1;;; ezimage --- Generalized Image management 2 3;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Eric M. Ludlam <zappo@gnu.org> 7;; Keywords: file, tags, tools 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., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, 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 just not 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. 65IMAGESPEC 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... 84Argument VARIABLE is the variable to define. 85Argument IMAGESPEC is the list defining the image to create. 86Argument 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. 113The 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. 122IMAGESPEC 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 of 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. 265If buttontext is unknown, just insert that text. 266If we have an image associated with it, use that image. 267Optional argument STRING is a string 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. 284Return 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. 296Assumes the image is part of a GUI and can be clicked on. 297Optional 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. 314See `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. 338See `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;; arch-tag: d4ea2d93-3c7a-4cb3-b5a6-c1b9178183aa 372;;; sb-image.el ends here 373