|
24
|
1 ;; frame-icon.el - set up mode-specific icons for each frame under XEmacs
|
|
|
2
|
|
|
3 ;; Author: Michael Lamoureux <lamour@engin.umich.edu>
|
|
|
4 ;; Keywords: lisp, extensions
|
|
|
5 ;; date created: 8/3/93
|
|
|
6
|
|
|
7 ;; This file is part of XEmacs.
|
|
|
8
|
|
|
9 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
10 ;; under the terms of the GNU General Public License as published by
|
|
|
11 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
12 ;; any later version.
|
|
|
13
|
|
|
14 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
17 ;; General Public License for more details.
|
|
|
18
|
|
|
19 ;; You should have received a copy of the GNU General Public License
|
|
|
20 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
|
21 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
|
|
22 ;; 02111-1307, USA.
|
|
|
23
|
|
|
24 ;;; Synched up with: Not in FSF.
|
|
|
25
|
|
|
26 ;;; Commentary:
|
|
|
27
|
|
|
28 ;; Modified by Bob Weiner <weiner@infodock.com>, 1/13/94
|
|
|
29 ;; Handle XEmacs 19.8 pixmaps properly.
|
|
|
30 ;; Also added in more mode settings and added many new bitmaps.
|
|
|
31 ;; Renamed from icon.el to frame-icon.el.
|
|
|
32 ;; Made all definitions start with the same prefix, 'icon-'.
|
|
|
33 ;; Added a provide clause.
|
|
|
34 ;;
|
|
|
35 ;; Modified by Bob Weiner, 2/24/95, to handle XEmacs 19.12.
|
|
|
36 ;; Added set of unmap-frame-hook.
|
|
|
37 ;;
|
|
|
38 ;; Modified by Bob Weiner, 7/17/95, to handle XEmacs 19.12.
|
|
|
39 ;; Changed to use new image-handling protocols and added backwards
|
|
|
40 ;; compatibility functions for new image functions.
|
|
|
41 ;;
|
|
|
42 ;; Modified by Bob Weiner, 7/18/95.
|
|
|
43 ;; Added icon-suffix variable so can use .xbm or .xpm icons.
|
|
|
44 ;;
|
|
|
45 ;; Most Icons were extracted from: /export.lcs.mit.edu:/contrib/AIcons
|
|
|
46 ;;
|
|
|
47
|
|
|
48 ;;; Code:
|
|
|
49
|
|
|
50 (defvar icon-directory (concat data-directory "frame-icon/")
|
|
|
51 "Directory of icons used by frame-icon.el.")
|
|
|
52
|
|
|
53 (defvar icon-suffix ".xbm"
|
|
|
54 "Must be .xbm or .xpm, depending on the format of the icons in icon-directory.")
|
|
|
55
|
|
|
56 (defconst icon-mode-alist
|
|
|
57 '(
|
|
|
58 (default . "question")
|
|
|
59 ;; For testing
|
|
|
60 (fundamental-mode . "match")
|
|
|
61 ;;
|
|
|
62 (archie-mode . "archie")
|
|
|
63 (asm-mode . "nuke")
|
|
|
64 (bbdb-mode . "eye")
|
|
|
65 (bookmark-menu-mode . "finder")
|
|
|
66 (Buffer-menu-mode . "help")
|
|
|
67 (c++-mode . "c++")
|
|
|
68 (c++-c-mode . "escherknot")
|
|
26
|
69 (c-mode . "c")
|
|
|
70 (awk-mode . "escherknot")
|
|
|
71 (cvs-mode . "tree")
|
|
|
72 (f90-mode . "wizard")
|
|
|
73 (xrdb-mode . "RIP")
|
|
24
|
74 ;;
|
|
|
75 (calc-edit-mode . "cray")
|
|
|
76 (calc-keypad . "cray")
|
|
|
77 (calc-mode . "cray")
|
|
|
78 (calc-trail-mode . "cray")
|
|
|
79 (MacEdit-mode . "cray")
|
|
|
80 ;;
|
|
|
81 (calendar-mode . "calendar")
|
|
|
82 (comint-mode . "terminal")
|
|
|
83 (perl-mode . "perl")
|
|
|
84 (csh-mode . "manpage2")
|
|
|
85 (db-edit-mode . "filing")
|
|
|
86 (db-view-mode . "filing")
|
|
|
87 (dired-mode . "filing")
|
|
|
88 (doctor-mode . "ying-yang-48")
|
|
|
89 (edit-faces-mode . "eye")
|
|
|
90 (Edit-options-mode . "swissknife")
|
|
|
91 (emacs-lisp-mode . "elisp")
|
|
|
92 (fortran-mode . "RIP")
|
|
|
93 (gdb-mode . "bug-48")
|
|
|
94 (gud-mode . "bug-48")
|
|
|
95 (gnus-article-mode . "news")
|
|
|
96 (gnus-group-mode . "news")
|
|
|
97 (gnus-summary-mode . "news")
|
|
|
98 (gopher-mode . "gopher")
|
|
|
99 (html-mode . "xmosaic")
|
|
|
100 (indented-text-mode . "page")
|
|
|
101 (Info-mode . "help")
|
|
|
102 (java-mode . "coffee")
|
|
|
103 (kotl-mode . "kotl")
|
|
|
104 (lisp-interaction-mode . "swissknife")
|
|
|
105 (lisp-mode . "lisp")
|
|
|
106 (lock-mode . "termlock")
|
|
|
107 (mail-mode . "scroll2")
|
|
|
108 (Manual-mode . "manpage")
|
|
|
109 (man-mode . "manpage")
|
|
|
110 (news-reply-mode . "match")
|
|
|
111 (outline-mode . "outline")
|
|
|
112 (perl-mode . "perl")
|
|
|
113 (edit-picture . "splat")
|
|
|
114 (pm-fdr-mode . "mail")
|
|
|
115 (pm-group-mode . "news")
|
|
|
116 (pm-msg-edit-mode . "mail")
|
|
|
117 (pm-msgsumm-mode . "mail")
|
|
|
118 (pm-mode . "mail")
|
|
|
119 (rdb-mode . "question")
|
|
|
120 (rmail-mode . "mail")
|
|
|
121 (rmail-edit-mode . "mail")
|
|
|
122 (rmail-summary-mode . "mail")
|
|
|
123 (scheme-interaction-mode . "swissknife")
|
|
|
124 (scheme-mode . "lisp")
|
|
|
125 (shell-mode . "terminal")
|
|
|
126 (sm-manual-mode . "manpage")
|
|
|
127 (sql-mode . "sql")
|
|
|
128 (tcl-mode . "radioactive")
|
|
|
129 (telnet-mode . "rlogin")
|
|
|
130 (texinfo-mode . "texinfo")
|
|
|
131 (text-mode . "page")
|
|
|
132 (unix-apropos-mode . "manpage")
|
|
|
133 (ups-mode . "hourglass") ; process listing mode
|
|
|
134 (vi-mode . "stopsign")
|
|
|
135 (vip-mode . "stopsign")
|
|
|
136 (vkill-mode . "load")
|
|
|
137 (vrml-mode . "drawing")
|
|
26
|
138 (vm-mode . "scroll2")
|
|
|
139 (vm-summary-mode . "scroll2")
|
|
24
|
140 (w3-mode . "world")
|
|
|
141 (waisq-mode . "library")
|
|
|
142 (wordstar-mode . "words")
|
|
|
143 (wrolo-mode . "phone")
|
|
|
144 ;;
|
|
|
145 (ams-tex-mode . "tex-48")
|
|
|
146 (foiltex-mode . "tex-48")
|
|
|
147 (latex-mode . "tex-48")
|
|
|
148 (LaTeX-mode . "tex-48")
|
|
|
149 (plain-tex-mode . "tex-48")
|
|
|
150 (plain-TeX-mode . "tex-48")
|
|
|
151 (slitex-mode . "tex-48")
|
|
|
152 (tex-mode . "tex-48")
|
|
|
153 )
|
|
|
154 "Alist of (major-mode . non-suffixed-icon-file-name) elements.
|
|
|
155 Used to set frame icons based upon the current major mode.
|
|
|
156 For use with icon-set-frame. See also the variable, 'icon-suffix'.")
|
|
|
157
|
|
|
158 (or (fboundp 'image-instance-p) (fset 'image-instance-p 'pixmapp))
|
|
|
159 (or (fboundp 'image-instance-file-name)
|
|
|
160 (fset 'image-instance-file-name 'pixmap-file-name))
|
|
|
161 (or (fboundp 'make-glyph) (fset 'make-glyph 'make-pixmap))
|
|
|
162
|
|
|
163 (defun icon-set-frame (iconified-frame)
|
|
|
164 "Set icon for selected frame according to the values in icon-mode-alist."
|
|
|
165 (save-excursion
|
|
|
166 (if (framep iconified-frame)
|
|
|
167 (select-frame iconified-frame))
|
|
|
168 (let* ((icon-sym (intern (concat "icon-" (symbol-name major-mode))))
|
|
|
169 (pix (and (boundp icon-sym) (symbol-value icon-sym)))
|
|
|
170 (image (or (cdr (assq major-mode icon-mode-alist))
|
|
|
171 (cdr (assq 'default icon-mode-alist))))
|
|
|
172 (image-file (expand-file-name (concat image icon-suffix)
|
|
|
173 icon-directory)))
|
|
|
174 (cond ((and (image-instance-p pix)
|
|
|
175 (equal image-file (image-instance-file-name pix)))
|
|
|
176 nil)
|
|
|
177 (t
|
|
|
178 ;; Ensure we don't create a copy of a pixmap already in
|
|
|
179 ;; icon-list due to use in a different major-mode.
|
|
|
180 (setq pix (set icon-sym
|
|
|
181 (car (delq
|
|
|
182 nil
|
|
|
183 (mapcar
|
|
|
184 (function
|
|
|
185 (lambda (pixmap)
|
|
|
186 (if (equal (image-instance-file-name
|
|
|
187 pixmap)
|
|
|
188 image-file)
|
|
|
189 pixmap)))
|
|
|
190 icon-list)))))
|
|
|
191 ;; If pix is nil, there was no entry in icon-list, so create a
|
|
|
192 ;; new one.
|
|
|
193 (or (image-instance-p pix)
|
|
|
194 (setq pix
|
|
|
195 (glyph-image-instance
|
|
|
196 (set icon-sym (make-glyph image-file)))
|
|
|
197 icon-list (cons pix icon-list)))))
|
|
|
198 (x-set-frame-icon-pixmap
|
|
|
199 (if (framep iconified-frame)
|
|
|
200 iconified-frame
|
|
|
201 ;; unpatched XEmacs 19.6
|
|
|
202 (selected-frame))
|
|
|
203 pix))))
|
|
|
204
|
|
|
205 (defvar icon-list nil
|
|
|
206 "List of existing pixmap objects used as frame icons by frame-icon.el.")
|
|
|
207
|
|
|
208 ;; Hook in so icons will be selected at iconify time
|
|
|
209 (if (string-match "XEmacs" emacs-version)
|
|
|
210 (add-hook 'unmap-frame-hook 'icon-set-frame) ;; XEmacs 19.12
|
|
|
211 (add-hook 'unmap-screen-hook 'icon-set-frame)) ;; Lemacs 19.10
|
|
|
212
|
|
|
213
|
|
|
214 (provide 'frame-icon)
|
|
|
215
|
|
|
216 ;;; frame-icon.el ends here
|
