Mercurial > hg > xemacs-beta

comparison lisp/utils/frame-icon.el @ 24:4103f0995bd7 r19-15b95

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b95
author cvs
date Mon, 13 Aug 2007 08:51:03 +0200
parents
children 441bb1e64a06
comparison
equal deleted inserted replaced
23:0edd3412f124 24:4103f0995bd7
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 . "escherknot")
70 ;;
71 (calc-edit-mode . "cray")
72 (calc-keypad . "cray")
73 (calc-mode . "cray")
74 (calc-trail-mode . "cray")
75 (MacEdit-mode . "cray")
76 ;;
77 (calendar-mode . "calendar")
78 (comint-mode . "terminal")
79 (perl-mode . "perl")
80 (csh-mode . "manpage2")
81 (db-edit-mode . "filing")
82 (db-view-mode . "filing")
83 (dired-mode . "filing")
84 (doctor-mode . "ying-yang-48")
85 (edit-faces-mode . "eye")
86 (Edit-options-mode . "swissknife")
87 (emacs-lisp-mode . "elisp")
88 (fortran-mode . "RIP")
89 (gdb-mode . "bug-48")
90 (gud-mode . "bug-48")
91 (gnus-article-mode . "news")
92 (gnus-group-mode . "news")
93 (gnus-summary-mode . "news")
94 (gopher-mode . "gopher")
95 (html-mode . "xmosaic")
96 (indented-text-mode . "page")
97 (Info-mode . "help")
98 (java-mode . "coffee")
99 (kotl-mode . "kotl")
100 (lisp-interaction-mode . "swissknife")
101 (lisp-mode . "lisp")
102 (lock-mode . "termlock")
103 (mail-mode . "scroll2")
104 (Manual-mode . "manpage")
105 (man-mode . "manpage")
106 (news-reply-mode . "match")
107 (outline-mode . "outline")
108 (perl-mode . "perl")
109 (edit-picture . "splat")
110 (pm-fdr-mode . "mail")
111 (pm-group-mode . "news")
112 (pm-msg-edit-mode . "mail")
113 (pm-msgsumm-mode . "mail")
114 (pm-mode . "mail")
115 (rdb-mode . "question")
116 (rmail-mode . "mail")
117 (rmail-edit-mode . "mail")
118 (rmail-summary-mode . "mail")
119 (scheme-interaction-mode . "swissknife")
120 (scheme-mode . "lisp")
121 (shell-mode . "terminal")
122 (sm-manual-mode . "manpage")
123 (sql-mode . "sql")
124 (tcl-mode . "radioactive")
125 (telnet-mode . "rlogin")
126 (texinfo-mode . "texinfo")
127 (text-mode . "page")
128 (unix-apropos-mode . "manpage")
129 (ups-mode . "hourglass") ; process listing mode
130 (vi-mode . "stopsign")
131 (vip-mode . "stopsign")
132 (vkill-mode . "load")
133 (vrml-mode . "drawing")
134 (vm-mode . "mail")
135 (vm-summary-mode . "mail")
136 (w3-mode . "world")
137 (waisq-mode . "library")
138 (wordstar-mode . "words")
139 (wrolo-mode . "phone")
140 ;;
141 (ams-tex-mode . "tex-48")
142 (foiltex-mode . "tex-48")
143 (latex-mode . "tex-48")
144 (LaTeX-mode . "tex-48")
145 (plain-tex-mode . "tex-48")
146 (plain-TeX-mode . "tex-48")
147 (slitex-mode . "tex-48")
148 (tex-mode . "tex-48")
149 )
150 "Alist of (major-mode . non-suffixed-icon-file-name) elements.
151 Used to set frame icons based upon the current major mode.
152 For use with icon-set-frame. See also the variable, 'icon-suffix'.")
153
154 (or (fboundp 'image-instance-p) (fset 'image-instance-p 'pixmapp))
155 (or (fboundp 'image-instance-file-name)
156 (fset 'image-instance-file-name 'pixmap-file-name))
157 (or (fboundp 'make-glyph) (fset 'make-glyph 'make-pixmap))
158
159 (defun icon-set-frame (iconified-frame)
160 "Set icon for selected frame according to the values in icon-mode-alist."
161 (save-excursion
162 (if (framep iconified-frame)
163 (select-frame iconified-frame))
164 (let* ((icon-sym (intern (concat "icon-" (symbol-name major-mode))))
165 (pix (and (boundp icon-sym) (symbol-value icon-sym)))
166 (image (or (cdr (assq major-mode icon-mode-alist))
167 (cdr (assq 'default icon-mode-alist))))
168 (image-file (expand-file-name (concat image icon-suffix)
169 icon-directory)))
170 (cond ((and (image-instance-p pix)
171 (equal image-file (image-instance-file-name pix)))
172 nil)
173 (t
174 ;; Ensure we don't create a copy of a pixmap already in
175 ;; icon-list due to use in a different major-mode.
176 (setq pix (set icon-sym
177 (car (delq
178 nil
179 (mapcar
180 (function
181 (lambda (pixmap)
182 (if (equal (image-instance-file-name
183 pixmap)
184 image-file)
185 pixmap)))
186 icon-list)))))
187 ;; If pix is nil, there was no entry in icon-list, so create a
188 ;; new one.
189 (or (image-instance-p pix)
190 (setq pix
191 (glyph-image-instance
192 (set icon-sym (make-glyph image-file)))
193 icon-list (cons pix icon-list)))))
194 (x-set-frame-icon-pixmap
195 (if (framep iconified-frame)
196 iconified-frame
197 ;; unpatched XEmacs 19.6
198 (selected-frame))
199 pix))))
200
201 (defvar icon-list nil
202 "List of existing pixmap objects used as frame icons by frame-icon.el.")
203
204 ;; Hook in so icons will be selected at iconify time
205 (if (string-match "XEmacs" emacs-version)
206 (add-hook 'unmap-frame-hook 'icon-set-frame) ;; XEmacs 19.12
207 (add-hook 'unmap-screen-hook 'icon-set-frame)) ;; Lemacs 19.10
208
209
210 (provide 'frame-icon)
211
212 ;;; frame-icon.el ends here