cgit.sxemacs.org Git - packages/blob - xemacs-packages/cedet-common/ezimage.el

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