home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 2 / FFMCD02.bin / new / amigalibdisks / disk945 / emacsstarter / lisp / newicon.el next >
Lisp/Scheme  |  1993-12-21  |  3KB  |  92 lines
  1. ;;
  2. ;;  FILE
  3. ;;    newicon.el        $VER: V1.00 newicon.el
  4. ;;
  5. ;;  DESCRIPTION
  6. ;;      A new icon-creating scheme.
  7. ;;
  8. ;;    When creating icons, the following replacement routine searches
  9. ;;      for icons of the name "def_<extension>.info". 
  10. ;;      The routine searches first in the directories specified a _list_
  11. ;;      by the user in the variable "amiga-icon-path" and then in 
  12. ;;      "Gnuemacs:Icons/". The directories in the list must contain the 
  13. ;;    trailing slash.
  14. ;;
  15. ;;      If it can't find any appropriate icons, and the file 
  16. ;;      "Gnuemacs:Icons/def_emacs.info" exists, it is used. Otherwise
  17. ;;      the original function is called.
  18. ;;
  19. ;;      Note: icons are only created when the variable
  20. ;;      "amiga-create-icons" is non-nil.
  21. ;;
  22. ;;  INSTALLATION
  23. ;;    Copy this file to a lisp-directory, for example Gnuemacs:lisp
  24. ;;
  25. ;;    Create a directory called Gnuemacs:icons and copy the icons to it.
  26. ;;
  27. ;;    Place the following line in your s:.emacs
  28. ;;            (setq amiga-create-icons t)
  29. ;;        (load "newicon")
  30. ;;
  31. ;;      Example: If the user would like to use the icons supplied by
  32. ;;    the SAS C-complier, the following lines could be placed
  33. ;;    in his or hers .emacs file:
  34. ;;      (setq amiga-icon-path '("sc:Icons/"))
  35. ;;
  36. ;;  LICENSE
  37. ;;      Copyright (C) 1993  Anders Lindgren
  38. ;;
  39. ;;    This program is free software; you can redistribute it and/or modify
  40. ;;    it under the terms of the GNU General Public License as published by
  41. ;;    the Free Software Foundation; either version 2 of the License,or
  42. ;;    (at your option) any later version.
  43. ;;
  44. ;;    This program is distributed in the hope that it will be useful,
  45. ;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
  46. ;;    MERCHANTABILITY of FITNESS FOR A PARTICULAR PURPOSE. See the
  47. ;;    GNU General Public License for more details.
  48. ;;
  49. ;;    You should have received a copy of the GNU General Public License
  50. ;;    along with this program; if not, write to the Free Software
  51. ;;    Foundation, Inc., 675 Mass Ave, Cambridge, Ma 02139, USA.
  52. ;;
  53. ;;  HOW TO CONTACT ME:
  54. ;;    voice:   Scream  Anders Lindgren  LOUD
  55. ;;    email:   d91ali@csd.uu.se
  56. ;;    mail:    Anders Lindgren
  57. ;;             Kantorsg. 2-331
  58. ;;             S-754 24 Uppsala
  59. ;;    SUGA BBS:+46 (0)8 34 85 23
  60. ;;         +46 (0)8 34 32 76  
  61. ;;
  62.  
  63. (defvar amiga-icon-path '()
  64.   "A list of directories to scan when searching for new icons.")
  65.  
  66. (if (not (fboundp 'old-amiga-put-icon))
  67.     (fset 'old-amiga-put-icon (symbol-function 'amiga-put-icon)))
  68.  
  69. (defun amiga-put-icon (file force)
  70.   (if (or force (not (file-readable-p (concat file ".info"))))
  71.       (let ((extpos (string-match "\\.[a-zA-Z]*\\'" file))
  72.         (iconname nil)
  73.         (path (append amiga-icon-path '("gnuemacs:icons/")))
  74.         (found nil))
  75.     (if (and extpos (< 0 extpos))
  76.         (while (and (not found) path)
  77.           (setq iconname (concat (car path) "def_" (substring file (+ 1 extpos)) ".info"))
  78.           (if (and iconname (file-readable-p iconname))
  79.           (progn
  80.             (copy-file iconname (concat file ".info"))
  81.             (setq found t)))
  82.           (setq path (cdr path))))
  83.     (if (not found)
  84.         (if (file-readable-p "gnuemacs:Icons/def_emacs.info")
  85.         (copy-file "gnuemacs:Icons/def_emacs.info" (concat file ".info"))
  86.           (old-amiga-put-icon file force))))))
  87.       
  88.  
  89.  
  90.         
  91.         
  92.