upstream

[gnu-emacs] / lisp / ezimage.el

diff --git a/lisp/ezimage.el b/lisp/ezimage.el
index aaf9cabb48094ef02b73c30df0fed0bea9ddd9a9..346b69d9912b6e92d07622f5b2ba2afe9be9cc00 100644 (file)
--- a/lisp/ezimage.el
+++ b/lisp/ezimage.el
@@ -1,17 +1,16 @@
 ;;; ezimage --- Generalized Image management
 
 ;;; ezimage --- Generalized Image management
 

-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012  Free Software Foundation, Inc.

 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Keywords: file, tags, tools
 
 ;; This file is part of GNU Emacs.
 
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Keywords: file, tags, tools
 
 ;; This file is part of GNU Emacs.
 

-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify

 ;; it under the terms of the GNU General Public License as published by
 ;; it under the terms of the GNU General Public License as published by

-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.

 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of


@@ -19,9 +18,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License

-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

 
 ;;; Commentary:
 ;;
 
 ;;; Commentary:
 ;;


@@ -35,20 +32,17 @@
 ;;
 ;; This file requires the `image' package if it is available.
 
 ;;
 ;; This file requires the `image' package if it is available.
 

-(condition-case nil
+(condition-case nil                    ; for older XEmacs

     (require 'image)
   (error nil))
 
 ;;; Code:
     (require 'image)
   (error nil))
 
 ;;; Code:

-(defcustom ezimage-use-images
-  (and (or (fboundp 'defimage) ; emacs 21
-          (fboundp 'make-image-specifier)) ; xemacs
-       (if (fboundp 'display-graphic-p) ; emacs 21
-          (display-graphic-p)
-        window-system) ; old emacs & xemacs
-       (or (not (fboundp 'image-type-available-p)) ; xemacs?
-          (image-type-available-p 'xpm))) ; emacs 21
-  "*Non-nil if ezimage should display icons."
+(defcustom ezimage-use-images (if (featurep 'xemacs)
+                                 (and (fboundp 'make-image-specifier)
+                                      window-system)
+                               (and (display-images-p)
+                                    (image-type-available-p 'xpm)))
+  "Non-nil means ezimage should display icons."

   :group 'ezimage
   :version "21.1"
   :type 'boolean)
   :group 'ezimage
   :version "21.1"
   :type 'boolean)


@@ -56,20 +50,16 @@
 ;;; Create our own version of defimage
 (eval-and-compile
 
 ;;; Create our own version of defimage
 (eval-and-compile
 

-(if (fboundp 'defimage)
-
+(if (featurep 'emacs)

     (progn
     (progn

-
-(defmacro defezimage (variable imagespec docstring)
-  "Define VARIABLE as an image if `defimage' is not available.
+      (defmacro defezimage (variable imagespec docstring)
+       "Define VARIABLE as an image if `defimage' is not available.

 IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
 IMAGESPEC is the image data, and DOCSTRING is documentation for the image."

-  `(progn
-     (defimage ,variable ,imagespec ,docstring)
-     (put (quote ,variable) 'ezimage t)))
-
-;    (defalias 'defezimage 'defimage)
+       `(progn
+          (defimage ,variable ,imagespec ,docstring)
+          (put (quote ,variable) 'ezimage t)))

 
 

-;; This hack is for the ezimage install which has an icons direcory for
+;; This hack is for the ezimage install which has an icons directory for

 ;; the default icons to be used.
 ;; (add-to-list 'load-path
 ;;          (concat (file-name-directory
 ;; the default icons to be used.
 ;; (add-to-list 'load-path
 ;;          (concat (file-name-directory


@@ -77,64 +67,61 @@ IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
 ;;                  "icons"))
 
        )
 ;;                  "icons"))
 
        )

+
+  ;; XEmacs.

   (if (not (fboundp 'make-glyph))
 
   (if (not (fboundp 'make-glyph))
 

-(defmacro defezimage (variable imagespec docstring)
-  "Don't bother loading up an image...
+      (defmacro defezimage (variable _imagespec docstring)
+       "Don't bother loading up an image...

 Argument VARIABLE is the variable to define.
 Argument IMAGESPEC is the list defining the image to create.
 Argument DOCSTRING is the documentation for VARIABLE."
 Argument VARIABLE is the variable to define.
 Argument IMAGESPEC is the list defining the image to create.
 Argument DOCSTRING is the documentation for VARIABLE."

-  `(defvar ,variable nil ,docstring))
-
-;; ELSE
-(with-no-warnings
-(defun ezimage-find-image-on-load-path (image)
-  "Find the image file IMAGE on the load path."
-  (let ((l (cons
-           ;; In XEmacs, try the data directory first (for an
-           ;; install in XEmacs proper.)   Search the load
-           ;; path next (for user installs)
-           (locate-data-directory "ezimage")
-           load-path))
-       (r nil))
-    (while (and l (not r))
-      (if (file-exists-p (concat (car l) "/" image))
-         (setq r (concat (car l) "/" image))
-       (if (file-exists-p (concat (car l) "/icons/" image))
-           (setq r (concat (car l) "/icons/" image))
-         ))
-      (setq l (cdr l)))
-    r))
-);with-no-warnings
-
-(with-no-warnings
-(defun ezimage-convert-emacs21-imagespec-to-xemacs (spec)
-  "Convert the Emacs21 image SPEC into an XEmacs image spec.
+       `(defvar ,variable nil ,docstring))
+
+    (defun ezimage-find-image-on-load-path (image)
+      "Find the image file IMAGE on the load path."
+      (let ((l (cons
+               ;; In XEmacs, try the data directory first (for an
+               ;; install in XEmacs proper.)   Search the load
+               ;; path next (for user installs)
+               (locate-data-directory "ezimage")
+               load-path))
+           (r nil))
+       (while (and l (not r))
+         (if (file-exists-p (concat (car l) "/" image))
+             (setq r (concat (car l) "/" image))
+           (if (file-exists-p (concat (car l) "/icons/" image))
+               (setq r (concat (car l) "/icons/" image))
+             ))
+         (setq l (cdr l)))
+       r))
+
+    (defun ezimage-convert-emacs21-imagespec-to-xemacs (spec)
+      "Convert the Emacs21 image SPEC into an XEmacs image spec.

 The Emacs 21 spec is what I first learned, and is easy to convert."
 The Emacs 21 spec is what I first learned, and is easy to convert."

-  (let* ((sl (car spec))
-        (itype (nth 1 sl))
-        (ifile (nth 3 sl)))
-    (vector itype ':file (ezimage-find-image-on-load-path ifile))))
-);with-no-warnings
-
-(defmacro defezimage (variable imagespec docstring)
-  "Define VARIABLE as an image if `defimage' is not available.
+      (let* ((sl (car spec))
+            (itype (nth 1 sl))
+            (ifile (nth 3 sl)))
+       (vector itype ':file (ezimage-find-image-on-load-path ifile))))
+
+    (defmacro defezimage (variable imagespec docstring)
+      "Define VARIABLE as an image if `defimage' is not available.

 IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
 IMAGESPEC is the image data, and DOCSTRING is documentation for the image."

-  `(progn
-     (defvar ,variable
-       ;; The Emacs21 version of defimage looks just like the XEmacs image
-       ;; specifier, except that it needs a :type keyword.  If we line
-       ;; stuff up right, we can use this cheat to support XEmacs specifiers.
-       (condition-case nil
-          (make-glyph
-           (make-image-specifier
-            (ezimage-convert-emacs21-imagespec-to-xemacs (quote ,imagespec)))
-           'buffer)
-        (error nil))
-       ,docstring)
-     (put ',variable 'ezimage t)))
-
-)))
+      `(progn
+        (defvar ,variable
+          ;; The Emacs21 version of defimage looks just like the XEmacs image
+          ;; specifier, except that it needs a :type keyword.  If we line
+          ;; stuff up right, we can use this cheat to support XEmacs specifiers.
+          (condition-case nil
+              (make-glyph
+               (make-image-specifier
+                (ezimage-convert-emacs21-imagespec-to-xemacs (quote ,imagespec)))
+               'buffer)
+            (error nil))
+          ,docstring)
+        (put ',variable 'ezimage t)))
+
+    )))

 
 (defezimage ezimage-directory
   ((:type xpm :file "ezimage/dir.xpm" :ascent center))
 
 (defezimage ezimage-directory
   ((:type xpm :file "ezimage/dir.xpm" :ascent center))


@@ -252,7 +239,7 @@ IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
     ("[ ]" . ezimage-page)
     ("{+}" . ezimage-box-plus)
     ("{-}" . ezimage-box-minus)
     ("[ ]" . ezimage-page)
     ("{+}" . ezimage-box-plus)
     ("{-}" . ezimage-box-minus)

-    ;; Some vaguely representitive entries
+    ;; Some vaguely representative entries

     ("*" . ezimage-checkout)
     ("#" . ezimage-object)
     ("!" . ezimage-object-out-of-date)
     ("*" . ezimage-checkout)
     ("#" . ezimage-object)
     ("!" . ezimage-object-out-of-date)


@@ -270,9 +257,9 @@ Optional argument STRING is a string upon which to add text properties."
           (a (assoc bt ezimage-expand-image-button-alist)))
       ;; Regular images (created with `insert-image' are intangible
       ;; which (I suppose) make them more compatible with XEmacs 21.
           (a (assoc bt ezimage-expand-image-button-alist)))
       ;; Regular images (created with `insert-image' are intangible
       ;; which (I suppose) make them more compatible with XEmacs 21.

-      ;; Unfortunatly, there is a giant pile o code dependent on the
+      ;; Unfortunately, there is a giant pile of code dependent on the

       ;; underlying text.  This means if we leave it tangible, then I
       ;; underlying text.  This means if we leave it tangible, then I

-      ;; don't have to change said giant piles o code.
+      ;; don't have to change said giant piles of code.

       (if (and a (symbol-value (cdr a)))
          (ezimage-insert-over-text (symbol-value (cdr a))
                                    start
       (if (and a (symbol-value (cdr a)))
          (ezimage-insert-over-text (symbol-value (cdr a))
                                    start


@@ -296,17 +283,15 @@ Return STRING with properties applied."
 Assumes the image is part of a GUI and can be clicked on.
 Optional argument STRING is a string upon which to add text properties."
   (when ezimage-use-images
 Assumes the image is part of a GUI and can be clicked on.
 Optional argument STRING is a string upon which to add text properties."
   (when ezimage-use-images

-    (if (featurep 'xemacs)
-       (add-text-properties start end
+    (add-text-properties start end
+                        (if (featurep 'xemacs)

                             (list 'end-glyph image
                                   'rear-nonsticky (list 'display)
                                   'invisible t
                                   'detachable t)
                             (list 'end-glyph image
                                   'rear-nonsticky (list 'display)
                                   'invisible t
                                   'detachable t)

-                            string)
-      (add-text-properties start end

                           (list 'display image
                           (list 'display image

-                                'rear-nonsticky (list 'display))
-                          string)))
+                                'rear-nonsticky (list 'display)))
+                        string))

   string)
 
 (defun ezimage-image-association-dump ()
   string)
 
 (defun ezimage-image-association-dump ()


@@ -314,8 +299,7 @@ Optional argument STRING is a string upon which to add text properties."
 See `ezimage-expand-image-button-alist' for details."
   (interactive)
   (with-output-to-temp-buffer "*Ezimage Images*"
 See `ezimage-expand-image-button-alist' for details."
   (interactive)
   (with-output-to-temp-buffer "*Ezimage Images*"

-    (save-excursion
-      (set-buffer "*Ezimage Images*")
+    (with-current-buffer "*Ezimage Images*"

       (goto-char (point-max))
       (insert "Ezimage image cache.\n\n")
       (let ((start (point)) (end nil))
       (goto-char (point-max))
       (insert "Ezimage image cache.\n\n")
       (let ((start (point)) (end nil))


@@ -338,8 +322,7 @@ See `ezimage-expand-image-button-alist' for details."
 See `ezimage-expand-image-button-alist' for details."
   (interactive)
   (with-output-to-temp-buffer "*Ezimage Images*"
 See `ezimage-expand-image-button-alist' for details."
   (interactive)
   (with-output-to-temp-buffer "*Ezimage Images*"

-    (save-excursion
-      (set-buffer "*Ezimage Images*")
+    (with-current-buffer "*Ezimage Images*"

       (goto-char (point-max))
       (insert "Ezimage image cache.\n\n")
       (let ((start (point)) (end nil))
       (goto-char (point-max))
       (insert "Ezimage image cache.\n\n")
       (let ((start (point)) (end nil))


@@ -359,14 +342,11 @@ See `ezimage-expand-image-button-alist' for details."
   "Return a list of all variables containing ez images."
   (let ((ans nil))
     (mapatoms (lambda (sym)
   "Return a list of all variables containing ez images."
   (let ((ans nil))
     (mapatoms (lambda (sym)

-               (if (get sym 'ezimage) (setq ans (cons sym ans))))
-             )
+               (if (get sym 'ezimage) (setq ans (cons sym ans)))))

     (setq ans (sort ans (lambda (a b)
                          (string< (symbol-name a) (symbol-name b)))))
     (setq ans (sort ans (lambda (a b)
                          (string< (symbol-name a) (symbol-name b)))))

-    ans)
-  )
+    ans))

 
 (provide 'ezimage)
 
 
 (provide 'ezimage)
 

-;; arch-tag: d4ea2d93-3c7a-4cb3-b5a6-c1b9178183aa

 ;;; sb-image.el ends here
 ;;; sb-image.el ends here