home *** CD-ROM | disk | FTP | other *** search
- ;;
- ;; FILE
- ;; newicon.el $VER: V1.00 newicon.el
- ;;
- ;; DESCRIPTION
- ;; A new icon-creating scheme.
- ;;
- ;; When creating icons, the following replacement routine searches
- ;; for icons of the name "def_<extension>.info".
- ;; The routine searches first in the directories specified a _list_
- ;; by the user in the variable "amiga-icon-path" and then in
- ;; "Gnuemacs:Icons/". The directories in the list must contain the
- ;; trailing slash.
- ;;
- ;; If it can't find any appropriate icons, and the file
- ;; "Gnuemacs:Icons/def_emacs.info" exists, it is used. Otherwise
- ;; the original function is called.
- ;;
- ;; Note: icons are only created when the variable
- ;; "amiga-create-icons" is non-nil.
- ;;
- ;; INSTALLATION
- ;; Copy this file to a lisp-directory, for example Gnuemacs:lisp
- ;;
- ;; Create a directory called Gnuemacs:icons and copy the icons to it.
- ;;
- ;; Place the following line in your s:.emacs
- ;; (setq amiga-create-icons t)
- ;; (load "newicon")
- ;;
- ;; Example: If the user would like to use the icons supplied by
- ;; the SAS C-complier, the following lines could be placed
- ;; in his or hers .emacs file:
- ;; (setq amiga-icon-path '("sc:Icons/"))
- ;;
- ;; LICENSE
- ;; Copyright (C) 1993 Anders Lindgren
- ;;
- ;; This program 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 2 of the License,or
- ;; (at your option) any later version.
- ;;
- ;; This program is distributed in the hope that it will be useful,
- ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- ;; MERCHANTABILITY of FITNESS FOR A PARTICULAR PURPOSE. See the
- ;; GNU General Public License for more details.
- ;;
- ;; You should have received a copy of the GNU General Public License
- ;; along with this program; if not, write to the Free Software
- ;; Foundation, Inc., 675 Mass Ave, Cambridge, Ma 02139, USA.
- ;;
- ;; HOW TO CONTACT ME:
- ;; voice: Scream Anders Lindgren LOUD
- ;; email: d91ali@csd.uu.se
- ;; mail: Anders Lindgren
- ;; Kantorsg. 2-331
- ;; S-754 24 Uppsala
- ;; SUGA BBS:+46 (0)8 34 85 23
- ;; +46 (0)8 34 32 76
- ;;
-
- (defvar amiga-icon-path '()
- "A list of directories to scan when searching for new icons.")
-
- (if (not (fboundp 'old-amiga-put-icon))
- (fset 'old-amiga-put-icon (symbol-function 'amiga-put-icon)))
-
- (defun amiga-put-icon (file force)
- (if (or force (not (file-readable-p (concat file ".info"))))
- (let ((extpos (string-match "\\.[a-zA-Z]*\\'" file))
- (iconname nil)
- (path (append amiga-icon-path '("gnuemacs:icons/")))
- (found nil))
- (if (and extpos (< 0 extpos))
- (while (and (not found) path)
- (setq iconname (concat (car path) "def_" (substring file (+ 1 extpos)) ".info"))
- (if (and iconname (file-readable-p iconname))
- (progn
- (copy-file iconname (concat file ".info"))
- (setq found t)))
- (setq path (cdr path))))
- (if (not found)
- (if (file-readable-p "gnuemacs:Icons/def_emacs.info")
- (copy-file "gnuemacs:Icons/def_emacs.info" (concat file ".info"))
- (old-amiga-put-icon file force))))))
-
-
-
-
-
-