Mercurial > hg > xemacs-beta

comparison lisp/prim/glyphs.el @ 0:376386a54a3c r19-14

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