X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/430d2ee2919b2d4693780f2474ba40148442d206..026b174672c427b035009911de305992a94098d6:/lisp/ezimage.el diff --git a/lisp/ezimage.el b/lisp/ezimage.el index e3982e58f9..181b19e832 100644 --- a/lisp/ezimage.el +++ b/lisp/ezimage.el @@ -1,17 +1,16 @@ ;;; ezimage --- Generalized Image management -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam ;; 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 -;; the Free Software Foundation; either version 3, 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 @@ -19,9 +18,7 @@ ;; 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 . ;;; Commentary: ;; @@ -35,20 +32,17 @@ ;; ;; This file requires the `image' package if it is available. -(condition-case nil +(condition-case nil ; for older XEmacs (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) @@ -56,20 +50,16 @@ ;;; Create our own version of defimage (eval-and-compile -(if (fboundp 'defimage) - +(if (featurep 'emacs) (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." - `(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 @@ -77,64 +67,61 @@ IMAGESPEC is the image data, and DOCSTRING is documentation for the image." ;; "icons")) ) + + ;; XEmacs. (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." - `(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." - (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." - `(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)) @@ -252,7 +239,7 @@ IMAGESPEC is the image data, and DOCSTRING is documentation for the image." ("[ ]" . 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) @@ -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. - ;; 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 - ;; 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 @@ -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 - (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) - string) - (add-text-properties start end (list 'display image - 'rear-nonsticky (list 'display)) - string))) + 'rear-nonsticky (list 'display))) + string)) 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*" - (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)) @@ -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*" - (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)) @@ -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) - (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))))) - ans) - ) + ans)) (provide 'ezimage) -;; arch-tag: d4ea2d93-3c7a-4cb3-b5a6-c1b9178183aa ;;; sb-image.el ends here