Mercurial > hg > xemacs-beta

comparison lisp/utils/frame-icon.el @ 100:4be1180a9e89 r20-1b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b2
author cvs
date Mon, 13 Aug 2007 09:15:11 +0200
parents
children
comparison
equal deleted inserted replaced
99:2d83cbd90d8d 100:4be1180a9e89
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")
69 (c-mode . "c")
70 (awk-mode . "escherknot")
71 (cvs-mode . "tree")
72 (f90-mode . "wizard")
73 (xrdb-mode . "RIP")
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")
138 (vm-mode . "scroll2")
139 (vm-summary-mode . "scroll2")
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