Mercurial > hg > xemacs-beta

comparison lisp/glyphs.el @ 209:41ff10fd062f r20-4b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b3
author cvs
date Mon, 13 Aug 2007 10:04:58 +0200
parents
children c5d627a313b1
comparison
equal deleted inserted replaced
208:f427b8ec4379 209:41ff10fd062f
1 ;;; glyphs.el --- Lisp interface to C glyphs
2
3 ;; Copyright (C) 1994, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995, 1996 Ben Wing.
5
6 ;; Author: Chuck Thompson <cthomp@cs.uiuc.edu>, Ben Wing <wing@666.com>
7 ;; Maintainer: XEmacs Development Team
8 ;; Keywords: extensions, internal, dumped
9
10 ;; This file is part of XEmacs.
11
12 ;; XEmacs is free software; you can redistribute it and/or modify it
13 ;; under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; any later version.
16
17 ;; XEmacs is distributed in the hope that it will be useful, but
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details.
21
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with XEmacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
26
27 ;;; Synched up with: Not in FSF.
28
29 ;;; Commentary:
30
31 ;; This file is dumped with XEmacs.
32
33 ;;; Code:
34
35 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; font specifiers
36
37 (defun make-image-specifier (spec-list)
38 "Create a new `image' specifier object with the given specification list.
39 SPEC-LIST can be a list of specifications (each of which is a cons of a
40 locale and a list of instantiators), a single instantiator, or a list
41 of instantiators. See `make-specifier' for more information about
42 specifiers."
43 (make-specifier-and-init 'image spec-list))
44
45 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; glyphs
46
47 (defconst built-in-glyph-specifiers
48 '(image contrib-p baseline)
49 "A list of the built-in face properties that are specifiers.")
50
51 (defun glyph-property (glyph property &optional locale)
52 "Return GLYPH's value of the given PROPERTY.
53
54 If LOCALE is omitted, the GLYPH's actual value for PROPERTY will be
55 returned. For built-in properties, this will be a specifier object
56 of a type appropriate to the property (e.g. a font or color
57 specifier). For other properties, this could be anything.
58
59 If LOCALE is supplied, then instead of returning the actual value,
60 the specification(s) for the given locale or locale type will
61 be returned. This will only work if the actual value of
62 PROPERTY is a specifier (this will always be the case for built-in
63 properties, but not or not may apply to user-defined properties).
64 If the actual value of PROPERTY is not a specifier, this value
65 will simply be returned regardless of LOCALE.
66
67 The return value will be a list of instantiators (e.g. strings
68 specifying a font or color name), or a list of specifications, each
69 of which is a cons of a locale and a list of instantiators.
70 Specifically, if LOCALE is a particular locale (a buffer, window,
71 frame, device, or 'global), a list of instantiators for that locale
72 will be returned. Otherwise, if LOCALE is a locale type (one of
73 the symbols 'buffer, 'window, 'frame, 'device, 'device-class, or
74 'device-type), the specifications for all locales of that type will
75 be returned. Finally, if LOCALE is 'all, the specifications for all
76 locales of all types will be returned.
77
78 The specifications in a specifier determine what the value of
79 PROPERTY will be in a particular \"domain\" or set of circumstances,
80 which is typically a particular Emacs window along with the buffer
81 it contains and the frame and device it lies within. The value
82 is derived from the instantiator associated with the most specific
83 locale (in the order buffer, window, frame, device, and 'global)
84 that matches the domain in question. In other words, given a domain
85 (i.e. an Emacs window, usually), the specifier for PROPERTY will first
86 be searched for a specification whose locale is the buffer contained
87 within that window; then for a specification whose locale is the window
88 itself; then for a specification whose locale is the frame that the
89 window is contained within; etc. The first instantiator that is
90 valid for the domain (usually this means that the instantiator is
91 recognized by the device [i.e. the X server or TTY device] that the
92 domain is on. The function `glyph-property-instance' actually does
93 all this, and is used to determine how to display the glyph.
94
95 See `set-glyph-property' for the built-in property-names."
96 (check-argument-type 'glyphp glyph)
97 (let ((value (get glyph property)))
98 (if (and locale
99 (or (memq property built-in-glyph-specifiers)
100 (specifierp value)))
101 (setq value (specifier-specs value locale)))
102 value))
103
104 (defun convert-glyph-property-into-specifier (glyph property)
105 "Convert PROPERTY on GLYPH into a specifier, if it's not already."
106 (check-argument-type 'glyphp glyph)
107 (let ((specifier (get glyph property)))
108 ;; if a user-property does not have a specifier but a
109 ;; locale was specified, put a specifier there.
110 ;; If there was already a value there, convert it to a
111 ;; specifier with the value as its 'global instantiator.
112 (if (not (specifierp specifier))
113 (let ((new-specifier (make-specifier 'generic)))
114 (if (or (not (null specifier))
115 ;; make sure the nil returned from `get' wasn't
116 ;; actually the value of the property
117 (null (get glyph property t)))
118 (add-spec-to-specifier new-specifier specifier))
119 (setq specifier new-specifier)
120 (put glyph property specifier)))))
121
122 (defun glyph-property-instance (glyph property
123 &optional domain default no-fallback)
124 "Return the instance of GLYPH's PROPERTY in the specified DOMAIN.
125
126 Under most circumstances, DOMAIN will be a particular window,
127 and the returned instance describes how the specified property
128 actually is displayed for that window and the particular buffer
129 in it. Note that this may not be the same as how the property
130 appears when the buffer is displayed in a different window or
131 frame, or how the property appears in the same window if you
132 switch to another buffer in that window; and in those cases,
133 the returned instance would be different.
134
135 DOMAIN defaults to the selected window if omitted.
136
137 DOMAIN can be a frame or device, instead of a window. The value
138 returned for a such a domain is used in special circumstances
139 when a more specific domain does not apply; for example, a frame
140 value might be used for coloring a toolbar, which is conceptually
141 attached to a frame rather than a particular window. The value
142 is also useful in determining what the value would be for a
143 particular window within the frame or device, if it is not
144 overridden by a more specific specification.
145
146 If PROPERTY does not name a built-in property, its value will
147 simply be returned unless it is a specifier object, in which case
148 it will be instanced using `specifier-instance'.
149
150 Optional arguments DEFAULT and NO-FALLBACK are the same as in
151 `specifier-instance'."
152 (check-argument-type 'glyphp glyph)
153 (let ((value (get glyph property)))
154 (if (specifierp value)
155 (setq value (specifier-instance value domain default no-fallback)))
156 value))
157
158 (defun set-glyph-property (glyph property value &optional locale tag-set
159 how-to-add)
160 "Change a property of a GLYPH.
161
162 NOTE: If you want to remove a property from a glyph, use
163 `remove-glyph-property' rather than attempting to set a value of nil
164 for the property.
165
166 For built-in properties, the actual value of the property is a
167 specifier and you cannot change this; but you can change the
168 specifications within the specifier, and that is what this function
169 will do. For user-defined properties, you can use this function
170 to either change the actual value of the property or, if this value
171 is a specifier, change the specifications within it.
172
173 If PROPERTY is a built-in property, the specifications to be added to
174 this property can be supplied in many different ways:
175
176 -- If VALUE is a simple instantiator (e.g. a string naming a font or
177 color) or a list of instantiators, then the instantiator(s) will
178 be added as a specification of the property for the given LOCALE
179 (which defaults to 'global if omitted).
180 -- If VALUE is a list of specifications (each of which is a cons of
181 a locale and a list of instantiators), then LOCALE must be nil
182 (it does not make sense to explicitly specify a locale in this
183 case), and specifications will be added as given.
184 -- If VALUE is a specifier (as would be returned by `glyph-property'
185 if no LOCALE argument is given), then some or all of the
186 specifications in the specifier will be added to the property.
187 In this case, the function is really equivalent to
188 `copy-specifier' and LOCALE has the same semantics (if it is
189 a particular locale, the specification for the locale will be
190 copied; if a locale type, specifications for all locales of
191 that type will be copied; if nil or 'all, then all
192 specifications will be copied).
193
194 HOW-TO-ADD should be either nil or one of the symbols 'prepend,
195 'append, 'remove-tag-set-prepend, 'remove-tag-set-append, 'remove-locale,
196 'remove-locale-type, or 'remove-all. See `copy-specifier' and
197 `add-spec-to-specifier' for a description of what each of
198 these means. Most of the time, you do not need to worry about
199 this argument; the default behavior usually is fine.
200
201 In general, it is OK to pass an instance object (e.g. as returned
202 by `glyph-property-instance') as an instantiator in place of
203 an actual instantiator. In such a case, the instantiator used
204 to create that instance object will be used (for example, if
205 you set a font-instance object as the value of the 'font
206 property, then the font name used to create that object will
207 be used instead). If some cases, however, doing this
208 conversion does not make sense, and this will be noted in
209 the documentation for particular types of instance objects.
210
211 If PROPERTY is not a built-in property, then this function will
212 simply set its value if LOCALE is nil. However, if LOCALE is
213 given, then this function will attempt to add VALUE as the
214 instantiator for the given LOCALE, using `add-spec-to-specifier'.
215 If the value of the property is not a specifier, it will
216 automatically be converted into a 'generic specifier.
217
218
219 The following symbols have predefined meanings:
220
221 image The image used to display the glyph.
222
223 baseline Percent above baseline that glyph is to be
224 displayed.
225
226 contrib-p Whether the glyph contributes to the
227 height of the line it's on.
228
229 face Face of this glyph (*not* a specifier)."
230 (check-argument-type 'glyphp glyph)
231 (if (memq property built-in-glyph-specifiers)
232 (set-specifier (get glyph property) value locale tag-set how-to-add)
233
234 ;; This section adds user defined properties.
235 (if (not locale)
236 (put glyph property value)
237 (convert-glyph-property-into-specifier glyph property)
238 (add-spec-to-specifier (get glyph property) value locale tag-set
239 how-to-add)))
240 value)
241
242 (defun remove-glyph-property (glyph property &optional locale tag-set exact-p)
243 "Remove a property from a glyph.
244 For built-in properties, this is analogous to `remove-specifier'.
245 See `remove-specifier' for the meaning of the LOCALE, TAG-SET, and EXACT-P
246 arguments."
247 (or locale (setq locale 'all))
248 (if (memq property built-in-glyph-specifiers)
249 (remove-specifier (glyph-property glyph property) locale tag-set exact-p)
250 (if (eq locale 'all)
251 (remprop glyph property)
252 (convert-glyph-property-into-specifier glyph property)
253 (remove-specifier (glyph-property glyph property) locale tag-set
254 exact-p))))
255
256 (defun glyph-face (glyph)
257 "Return the face of GLYPH."
258 (glyph-property glyph 'face))
259
260 (defun set-glyph-face (glyph face)
261 "Change the face of GLYPH to FACE."
262 ; (interactive (glyph-interactive "face"))
263 (set-glyph-property glyph 'face face))
264
265 (defun glyph-image (glyph &optional locale)
266 "Return the image of the given glyph, or nil if it is unspecified.
267
268 LOCALE may be a locale (the instantiators for that particular locale
269 will be returned), a locale type (the specifications for all locales
270 of that type will be returned), 'all (all specifications will be
271 returned), or nil (the actual specifier object will be returned).
272
273 See `glyph-property' for more information."
274 (glyph-property glyph 'image locale))
275
276 (defun glyph-image-instance (glyph &optional domain default no-fallback)
277 "Return the instance of the given glyph's image in the given domain.
278
279 Normally DOMAIN will be a window or nil (meaning the selected window),
280 and an instance object describing how the image appears in that
281 particular window and buffer will be returned.
282
283 See `glyph-property-instance' for more information."
284 (glyph-property-instance glyph 'image domain default no-fallback))
285
286 (defun set-glyph-image (glyph spec &optional locale tag-set how-to-add)
287 "Change the image of the given glyph.
288
289 SPEC should be an instantiator (a string or vector; see
290 `image-specifier-p' for a description of possible values here),
291 a list of (possibly tagged) instantiators, an alist of specifications
292 (each mapping a locale to an instantiator list), or an image specifier
293 object.
294
295 If SPEC is an alist, LOCALE must be omitted. If SPEC is a
296 specifier object, LOCALE can be a locale, a locale type, 'all,
297 or nil; see `copy-specifier' for its semantics. Otherwise LOCALE
298 specifies the locale under which the specified instantiator(s)
299 will be added, and defaults to 'global.
300
301 See `set-glyph-property' for more information."
302 ; (interactive (glyph-interactive "image"))
303 (set-glyph-property glyph 'image spec locale tag-set how-to-add))
304
305 (defun glyph-contrib-p (glyph &optional locale)
306 "Return whether GLYPH contributes to its line height.
307
308 LOCALE may be a locale (the instantiators for that particular locale
309 will be returned), a locale type (the specifications for all locales
310 of that type will be returned), 'all (all specifications will be
311 returned), or nil (the actual specifier object will be returned).
312
313 See `glyph-property' for more information."
314 (glyph-property glyph 'contrib-p locale))
315
316 (defun glyph-contrib-p-instance (glyph &optional domain default no-fallback)
317 "Return the instance of the GLYPH's 'contrib-p property in the given domain.
318
319 Normally DOMAIN will be a window or nil (meaning the selected window),
320 and an instance object describing what the 'contrib-p property is in
321 that particular window and buffer will be returned.
322
323 See `glyph-property-instance' for more information."
324 (glyph-property-instance glyph 'contrib-p domain default no-fallback))
325
326 (defun set-glyph-contrib-p (glyph spec &optional locale tag-set how-to-add)
327 "Change the contrib-p of the given glyph.
328
329 SPEC should be an instantiator (t or nil), a list of (possibly
330 tagged) instantiators, an alist of specifications (each mapping a
331 locale to an instantiator list), or a boolean specifier object.
332
333 If SPEC is an alist, LOCALE must be omitted. If SPEC is a
334 specifier object, LOCALE can be a locale, a locale type, 'all,
335 or nil; see `copy-specifier' for its semantics. Otherwise LOCALE
336 specifies the locale under which the specified instantiator(s)
337 will be added, and defaults to 'global.
338
339 See `set-glyph-property' for more information."
340 ; (interactive (glyph-interactive "contrib-p"))
341 (set-glyph-property glyph 'contrib-p spec locale tag-set how-to-add))
342
343 (defun glyph-baseline (glyph &optional locale)
344 "Return the baseline of the given glyph, or nil if it is unspecified.
345
346 LOCALE may be a locale (the instantiators for that particular locale
347 will be returned), a locale type (the specifications for all locales
348 of that type will be returned), 'all (all specifications will be
349 returned), or nil (the actual specifier object will be returned).
350
351 See `glyph-property' for more information."
352 (glyph-property glyph 'baseline locale))
353
354 (defun glyph-baseline-instance (glyph &optional domain default no-fallback)
355 "Return the instance of the given glyph's baseline in the given domain.
356
357 Normally DOMAIN will be a window or nil (meaning the selected window),
358 and an integer or nil (specifying the baseline in that particular
359 window and buffer) will be returned.
360
361 See `glyph-property-instance' for more information."
362 (glyph-property-instance glyph 'baseline domain default no-fallback))
363
364 (defun set-glyph-baseline (glyph spec &optional locale tag-set how-to-add)
365 "Change the baseline of the given glyph.
366
367 SPEC should be an instantiator (an integer [a percentage above the
368 baseline of the line the glyph is on] or nil), a list of (possibly
369 tagged) instantiators, an alist of specifications (each mapping a
370 locale to an instantiator list), or a generic specifier object.
371
372 If SPEC is an alist, LOCALE must be omitted. If SPEC is a
373 specifier object, LOCALE can be a locale, a locale type, 'all,
374 or nil; see `copy-specifier' for its semantics. Otherwise LOCALE
375 specifies the locale under which the specified instantiator(s)
376 will be added, and defaults to 'global.
377
378 See `set-glyph-property' for more information."
379 ; (interactive (glyph-interactive "baseline"))
380 (set-glyph-property glyph 'baseline spec locale tag-set how-to-add))
381
382 (defun make-glyph (&optional spec-list type)
383 "Create a new `glyph' object of type TYPE.
384
385 TYPE should be one of `buffer' (used for glyphs in an extent, the modeline,
386 the toolbar, or elsewhere in a buffer), `pointer' (used for the mouse-pointer),
387 or `icon' (used for a frame's icon), and defaults to `buffer'.
388
389 SPEC-LIST is used to initialize the glyph's image. It is typically an
390 image instantiator (a string or a vector; see `image-specifier-p' for
391 a detailed description of the valid image instantiators), but can also
392 be a list of such instantiators (each one in turn is tried until an
393 image is successfully produced), a cons of a locale (frame, buffer, etc.)
394 and an instantiator, a list of such conses, or any other form accepted
395 by `canonicalize-spec-list'. See `make-specifier' for more information
396 about specifiers."
397 (let ((glyph (make-glyph-internal type)))
398 (and spec-list (set-glyph-image glyph spec-list))
399 glyph))
400
401 (defun buffer-glyph-p (object)
402 "t if OBJECT is a glyph of type `buffer'."
403 (and (glyphp object) (eq 'buffer (glyph-type object))))
404
405 (defun pointer-glyph-p (object)
406 "t if OBJECT is a glyph of type `pointer'."
407 (and (glyphp object) (eq 'pointer (glyph-type object))))
408
409 (defun icon-glyph-p (object)
410 "t if OBJECT is a glyph of type `icon'."
411 (and (glyphp object) (eq 'icon (glyph-type object))))
412
413 (defun make-pointer-glyph (&optional spec-list)
414 "Create a new `pointer-glyph' object with the given specification list.
415
416 This is equivalent to calling `make-glyph' and specifying a type of
417 `pointer'.
418
419 SPEC-LIST is used to initialize the glyph's image. It is typically an
420 image instantiator (a string or a vector; see `image-specifier-p' for
421 a detailed description of the valid image instantiators), but can also
422 be a list of such instantiators (each one in turn is tried until an
423 image is successfully produced), a cons of a locale (frame, buffer, etc.)
424 and an instantiator, a list of such conses, or any other form accepted
425 by `canonicalize-spec-list'. See `make-specifier' for more information
426 about specifiers.
427
428 You can also create a glyph with an empty SPEC-LIST and add image
429 instantiators afterwards using `set-glyph-image'."
430 (make-glyph spec-list 'pointer))
431
432 (defun make-icon-glyph (&optional spec-list)
433 "Create a new `icon-glyph' object with the given specification list.
434
435 This is equivalent to calling `make-glyph' and specifying a type of
436 `icon'.
437
438 SPEC-LIST is used to initialize the glyph's image. It is typically an
439 image instantiator (a string or a vector; see `image-specifier-p' for
440 a detailed description of the valid image instantiators), but can also
441 be a list of such instantiators (each one in turn is tried until an
442 image is successfully produced), a cons of a locale (frame, buffer, etc.)
443 and an instantiator, a list of such conses, or any other form accepted
444 by `canonicalize-spec-list'. See `make-specifier' for more information
445 about specifiers.
446
447 You can also create a glyph with an empty SPEC-LIST and add image
448 instantiators afterwards using `set-glyph-image'."
449 (make-glyph spec-list 'icon))
450
451 (defun nothing-image-instance-p (object)
452 "t if OBJECT is an image instance of type `nothing'."
453 (and (image-instance-p object) (eq 'nothing (image-instance-type object))))
454
455 (defun text-image-instance-p (object)
456 "t if OBJECT is an image instance of type `text'."
457 (and (image-instance-p object) (eq 'text (image-instance-type object))))
458
459 (defun mono-pixmap-image-instance-p (object)
460 "t if OBJECT is an image instance of type `mono-pixmap'."
461 (and (image-instance-p object) (eq 'mono-pixmap
462 (image-instance-type object))))
463
464 (defun color-pixmap-image-instance-p (object)
465 "t if OBJECT is an image instance of type `color-pixmap'."
466 (and (image-instance-p object) (eq 'color-pixmap
467 (image-instance-type object))))
468
469 (defun pointer-image-instance-p (object)
470 "t if OBJECT is an image instance of type `pointer'."
471 (and (image-instance-p object) (eq 'pointer (image-instance-type object))))
472
473 (defun subwindow-image-instance-p (object)
474 "t if OBJECT is an image instance of type `subwindow'.
475 Subwindows are not implemented in this version of XEmacs."
476 (and (image-instance-p object) (eq 'subwindow (image-instance-type object))))
477
478 ;;;;;;;;;; the built-in glyphs
479
480 (defvar text-pointer-glyph (make-pointer-glyph)
481 "*The shape of the mouse-pointer when over text.
482 This is a glyph; use `set-glyph-image' to change it.")
483 (set-glyph-face text-pointer-glyph 'pointer)
484
485 (defvar nontext-pointer-glyph (make-pointer-glyph)
486 "*The shape of the mouse-pointer when over a buffer, but not over text.
487 This is a glyph; use `set-glyph-image' to change it.
488 If unspecified in a particular domain, `text-pointer-glyph' is used.")
489 (set-glyph-face nontext-pointer-glyph 'pointer)
490
491 (defvar modeline-pointer-glyph (make-pointer-glyph)
492 "*The shape of the mouse-pointer when over the modeline.
493 This is a glyph; use `set-glyph-image' to change it.
494 If unspecified in a particular domain, `nontext-pointer-glyph' is used.")
495 (set-glyph-face modeline-pointer-glyph 'pointer)
496
497 (defvar selection-pointer-glyph (make-pointer-glyph)
498 "*The shape of the mouse-pointer when over a selectable text region.
499 This is a glyph; use `set-glyph-image' to change it.
500 If unspecified in a particular domain, `text-pointer-glyph' is used.")
501 (set-glyph-face selection-pointer-glyph 'pointer)
502
503 (defvar busy-pointer-glyph (make-pointer-glyph)
504 "*The shape of the mouse-pointer when XEmacs is busy.
505 This is a glyph; use `set-glyph-image' to change it.
506 If unspecified in a particular domain, the pointer is not changed
507 when XEmacs is busy.")
508 (set-glyph-face busy-pointer-glyph 'pointer)
509
510 (defvar toolbar-pointer-glyph (make-pointer-glyph)
511 "*The shape of the mouse-pointer when over a toolbar.
512 This is a glyph; use `set-glyph-image' to change it.
513 If unspecified in a particular domain, `nontext-pointer-glyph' is used.")
514 (set-glyph-face toolbar-pointer-glyph 'pointer)
515
516 ;; The following three are in C.
517 (if (featurep 'menubar)
518 (set-glyph-face menubar-pointer-glyph 'pointer))
519 (if (featurep 'scrollbar)
520 (set-glyph-face scrollbar-pointer-glyph 'pointer))
521 (set-glyph-face gc-pointer-glyph 'pointer)
522
523 ;; Now add the magic access/set behavior.
524
525 (defun dontusethis-set-value-glyph-handler (sym args fun harg handler)
526 (error "Use `set-glyph-image' to set `%s'" sym))
527 (defun dontusethis-make-unbound-glyph-handler (sym args fun harg handler)
528 (error "Can't `makunbound' `%s'" sym))
529 (defun dontusethis-make-local-glyph-handler (sym args fun harg handler)
530 (error "Use `set-glyph-image' to make local values for `%s'" sym))
531
532 (defun define-constant-glyph (sym)
533 (dontusethis-set-symbol-value-handler
534 sym 'set-value
535 'dontusethis-set-value-glyph-handler)
536 (dontusethis-set-symbol-value-handler
537 sym 'make-unbound
538 'dontusethis-make-unbound-glyph-handler)
539 (dontusethis-set-symbol-value-handler
540 sym 'make-local
541 'dontusethis-make-local-glyph-handler)
542 ;; Make frame properties magically work with glyph variables.
543 (put sym 'const-glyph-variable t))
544
545 (define-constant-glyph 'text-pointer-glyph)
546 (define-constant-glyph 'nontext-pointer-glyph)
547 (define-constant-glyph 'modeline-pointer-glyph)
548 (define-constant-glyph 'selection-pointer-glyph)
549 (define-constant-glyph 'busy-pointer-glyph)
550 (define-constant-glyph 'gc-pointer-glyph)
551 (define-constant-glyph 'toolbar-pointer-glyph)
552 (define-constant-glyph 'menubar-pointer-glyph)
553 (define-constant-glyph 'scrollbar-pointer-glyph)
554
555 (define-constant-glyph 'octal-escape-glyph)
556 (define-constant-glyph 'control-arrow-glyph)
557 (define-constant-glyph 'invisible-text-glyph)
558 (define-constant-glyph 'hscroll-glyph)
559 (define-constant-glyph 'truncation-glyph)
560 (define-constant-glyph 'continuation-glyph)
561
562 (define-constant-glyph 'frame-icon-glyph)
563
564 ;; backwards compatibility garbage
565
566 (defun dontusethis-old-pointer-shape-handler (sym args fun harg handler)
567 (let ((value (car args)))
568 (if (null value)
569 (remove-specifier harg 'global)
570 (set-glyph-image (symbol-value harg) value))))
571
572 ;; It might or might not be garbage, but it's rude. Make these
573 ;; 'compatible instead of 'obsolete. -slb
574 (defun define-obsolete-pointer-glyph (old new)
575 (define-compatible-variable-alias old new)
576 (dontusethis-set-symbol-value-handler
577 old 'set-value 'dontusethis-old-pointer-shape-handler new))
578
579 ;;; (defvar x-pointer-shape nil)
580 (define-obsolete-pointer-glyph 'x-pointer-shape 'text-pointer-glyph)
581
582 ;;; (defvar x-nontext-pointer-shape nil)
583 (define-obsolete-pointer-glyph 'x-nontext-pointer-shape 'nontext-pointer-glyph)
584
585 ;;; (defvar x-mode-pointer-shape nil)
586 (define-obsolete-pointer-glyph 'x-mode-pointer-shape 'modeline-pointer-glyph)
587
588 ;;; (defvar x-selection-pointer-shape nil)
589 (define-obsolete-pointer-glyph 'x-selection-pointer-shape
590 'selection-pointer-glyph)
591
592 ;;; (defvar x-busy-pointer-shape nil)
593 (define-obsolete-pointer-glyph 'x-busy-pointer-shape 'busy-pointer-glyph)
594
595 ;;; (defvar x-gc-pointer-shape nil)
596 (define-obsolete-pointer-glyph 'x-gc-pointer-shape 'gc-pointer-glyph)
597
598 ;;; (defvar x-toolbar-pointer-shape nil)
599 (define-obsolete-pointer-glyph 'x-toolbar-pointer-shape 'toolbar-pointer-glyph)
600
601 ;;;;;;;;;; initialization
602
603 (defun init-glyphs ()
604 ;; initialize default image types
605 (if (featurep 'x)
606 (set-console-type-image-conversion-list 'x
607 `(,@(if (featurep 'xpm) '(("\\.xpm\\'" [xpm :file nil] 2)))
608 ("\\.xbm\\'" [xbm :file nil] 2)
609 ,@(if (featurep 'xpm) '(("\\`/\\* XPM \\*/" [xpm :data nil] 2)))
610 ,@(if (featurep 'xface) '(("\\`X-Face:" [xface :data nil] 2)))
611 ,@(if (featurep 'gif) '(("\\.gif\\'" [gif :file nil] 2)
612 ("\\`GIF8[79]" [gif :data nil] 2)))
613 ,@(if (featurep 'jpeg) '(("\\.jpe?g\\'" [jpeg :file nil] 2)))
614 ;; all of the JFIF-format JPEG's that I've seen begin with
615 ;; the following. I have no idea if this is standard.
616 ,@(if (featurep 'jpeg) '(("\\`\377\330\377\340\000\020JFIF"
617 [jpeg :data nil] 2)))
618 ,@(if (featurep 'png) '(("\\.png\\'" [png :file nil] 2)))
619 ,@(if (featurep 'png) '(("\\`\211PNG" [png :data nil] 2)))
620 ("" [autodetect :data nil] 2))))
621 ;; #### this should really be formatted-string, not string but we
622 ;; don't have it implemented yet
623 ;;
624 ;; #define could also mean a bitmap as well as a version 1 XPM. Who
625 ;; cares. We don't want the file contents getting converted to a
626 ;; string in either case which is why the entry is there.
627 (if (featurep 'tty)
628 (progn
629 (set-console-type-image-conversion-list
630 'tty
631 '(("^#define" [string :data "[xpm]"])
632 ("\\`X-Face:" [string :data "[xface]"])
633 ("\\`/\\* XPM \\*/" [string :data "[xpm]"])
634 ("\\`GIF87" [string :data "[gif]"])
635 ("\\`\377\330\340\000\020JFIF" [string :data "[jpeg]"])
636 ("" [string :data nil] 2)
637 ;; this last one is here for pointers and icons and such --
638 ;; strings are not allowed so they will be ignored.
639 ("" [nothing])))
640
641 ;; finish initializing truncation glyph -- created internally
642 ;; because it has a built-in bitmap
643 (set-glyph-image truncation-glyph "$" 'global 'tty)
644
645 ;; finish initializing continuation glyph -- created internally
646 ;; because it has a built-in bitmap
647 (set-glyph-image continuation-glyph "\\" 'global 'tty)
648
649 ;; finish initializing hscroll glyph -- created internally
650 ;; because it has a built-in bitmap
651 (set-glyph-image hscroll-glyph "$" 'global 'tty)))
652
653 (set-glyph-image octal-escape-glyph "\\")
654 (set-glyph-image control-arrow-glyph "^")
655 (set-glyph-image invisible-text-glyph " ...")
656 ;; (set-glyph-image hscroll-glyph "$")
657
658 ;; finish initializing xemacs logo -- created internally because it
659 ;; has a built-in bitmap
660 (if (featurep 'xpm)
661 (set-glyph-image xemacs-logo
662 (concat "../etc/"
663 (if emacs-beta-version
664 "xemacs-beta.xpm"
665 "xemacs.xpm"))
666 'global 'x))
667 (cond ((featurep 'xpm)
668 (set-glyph-image frame-icon-glyph
669 (concat "../etc/" "xemacs-icon.xpm")
670 'global 'x))
671 ((featurep 'x)
672 (set-glyph-image frame-icon-glyph
673 (concat "../etc/" "xemacs-icon2.xbm")
674 'global 'x)))
675
676 (if (featurep 'tty)
677 (set-glyph-image xemacs-logo
678 "XEmacs <insert spiffy graphic logo here>"
679 'global 'tty))
680 )
681
682 (init-glyphs)
683
684 ;;; glyphs.el ends here.