Mercurial > hg > xemacs-beta

comparison lisp/glyphs.el @ 272:c5d627a313b1 r21-0b34

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents 41ff10fd062f
children 558f606b08ae
comparison
equal deleted inserted replaced
271:c7b7086b0a39 272:c5d627a313b1
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details. 20 ;; General Public License for more details.
21 21
22 ;; You should have received a copy of the GNU General Public License 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 23 ;; along with XEmacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, 59 Temple Place - Suite 330, 24 ;; Free Software Foundation, 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA. 25 ;; Boston, MA 02111-1307, USA.
26 26
27 ;;; Synched up with: Not in FSF. 27 ;;; Synched up with: Not in FSF.
28 28
33 ;;; Code: 33 ;;; Code:
34 34
35 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; font specifiers 35 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; font specifiers
36 36
37 (defun make-image-specifier (spec-list) 37 (defun make-image-specifier (spec-list)
38 "Create a new `image' specifier object with the given specification list. 38 "Return a new `image' specifier object with the specification list SPEC-LIST.
39 SPEC-LIST can be a list of specifications (each of which is a cons of a 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 40 locale and a list of instantiators), a single instantiator, or a list
41 of instantiators. See `make-specifier' for more information about 41 of instantiators. See `make-specifier' for more information about
42 specifiers." 42 specifiers."
43 (make-specifier-and-init 'image spec-list)) 43 (make-specifier-and-init 'image spec-list))
47 (defconst built-in-glyph-specifiers 47 (defconst built-in-glyph-specifiers
48 '(image contrib-p baseline) 48 '(image contrib-p baseline)
49 "A list of the built-in face properties that are specifiers.") 49 "A list of the built-in face properties that are specifiers.")
50 50
51 (defun glyph-property (glyph property &optional locale) 51 (defun glyph-property (glyph property &optional locale)
52 "Return GLYPH's value of the given PROPERTY. 52 "Return GLYPH's value of PROPERTY in LOCALE.
53 53
54 If LOCALE is omitted, the GLYPH's actual value for PROPERTY will be 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 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 56 of a type appropriate to the property (e.g. a font or color
57 specifier). For other properties, this could be anything. 57 specifier). For other properties, this could be anything.
104 (defun convert-glyph-property-into-specifier (glyph property) 104 (defun convert-glyph-property-into-specifier (glyph property)
105 "Convert PROPERTY on GLYPH into a specifier, if it's not already." 105 "Convert PROPERTY on GLYPH into a specifier, if it's not already."
106 (check-argument-type 'glyphp glyph) 106 (check-argument-type 'glyphp glyph)
107 (let ((specifier (get glyph property))) 107 (let ((specifier (get glyph property)))
108 ;; if a user-property does not have a specifier but a 108 ;; if a user-property does not have a specifier but a
109 ;; locale was specified, put a specifier there. 109 ;; locale was specified, put a specifier there.
110 ;; If there was already a value there, convert it to a 110 ;; If there was already a value there, convert it to a
111 ;; specifier with the value as its 'global instantiator. 111 ;; specifier with the value as its 'global instantiator.
112 (if (not (specifierp specifier)) 112 (if (not (specifierp specifier))
113 (let ((new-specifier (make-specifier 'generic))) 113 (let ((new-specifier (make-specifier 'generic)))
114 (if (or (not (null specifier)) 114 (if (or (not (null specifier))
216 automatically be converted into a 'generic specifier. 216 automatically be converted into a 'generic specifier.
217 217
218 218
219 The following symbols have predefined meanings: 219 The following symbols have predefined meanings:
220 220
221 image The image used to display the glyph. 221 image The image used to display the glyph.
222 222
223 baseline Percent above baseline that glyph is to be 223 baseline Percent above baseline that glyph is to be
224 displayed. 224 displayed.
225 225
226 contrib-p Whether the glyph contributes to the 226 contrib-p Whether the glyph contributes to the
227 height of the line it's on. 227 height of the line it's on.
228 228
229 face Face of this glyph (*not* a specifier)." 229 face Face of this glyph (*not* a specifier)."
230 (check-argument-type 'glyphp glyph) 230 (check-argument-type 'glyphp glyph)
231 (if (memq property built-in-glyph-specifiers) 231 (if (memq property built-in-glyph-specifiers)
232 (set-specifier (get glyph property) value locale tag-set how-to-add) 232 (set-specifier (get glyph property) value locale tag-set how-to-add)
233 233
234 ;; This section adds user defined properties. 234 ;; This section adds user defined properties.
261 "Change the face of GLYPH to FACE." 261 "Change the face of GLYPH to FACE."
262 ; (interactive (glyph-interactive "face")) 262 ; (interactive (glyph-interactive "face"))
263 (set-glyph-property glyph 'face face)) 263 (set-glyph-property glyph 'face face))
264 264
265 (defun glyph-image (glyph &optional locale) 265 (defun glyph-image (glyph &optional locale)
266 "Return the image of the given glyph, or nil if it is unspecified. 266 "Return the image of GLYPH in LOCALE, or nil if it is unspecified.
267 267
268 LOCALE may be a locale (the instantiators for that particular locale 268 LOCALE may be a locale (the instantiators for that particular locale
269 will be returned), a locale type (the specifications for all locales 269 will be returned), a locale type (the specifications for all locales
270 of that type will be returned), 'all (all specifications will be 270 of that type will be returned), 'all (all specifications will be
271 returned), or nil (the actual specifier object will be returned). 271 returned), or nil (the actual specifier object will be returned).
272 272
273 See `glyph-property' for more information." 273 See `glyph-property' for more information."
274 (glyph-property glyph 'image locale)) 274 (glyph-property glyph 'image locale))
275 275
276 (defun glyph-image-instance (glyph &optional domain default no-fallback) 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. 277 "Return the instance of GLYPH's image in DOMAIN.
278 278
279 Normally DOMAIN will be a window or nil (meaning the selected window), 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 280 and an instance object describing how the image appears in that
281 particular window and buffer will be returned. 281 particular window and buffer will be returned.
282 282
283 See `glyph-property-instance' for more information." 283 See `glyph-property-instance' for more information."
284 (glyph-property-instance glyph 'image domain default no-fallback)) 284 (glyph-property-instance glyph 'image domain default no-fallback))
285 285
286 (defun set-glyph-image (glyph spec &optional locale tag-set how-to-add) 286 (defun set-glyph-image (glyph spec &optional locale tag-set how-to-add)
287 "Change the image of the given glyph. 287 "Change the image of GLYPH in LOCALE.
288 288
289 SPEC should be an instantiator (a string or vector; see 289 SPEC should be an instantiator (a string or vector; see
290 `image-specifier-p' for a description of possible values here), 290 `image-specifier-p' for a description of possible values here),
291 a list of (possibly tagged) instantiators, an alist of specifications 291 a list of (possibly tagged) instantiators, an alist of specifications
292 (each mapping a locale to an instantiator list), or an image specifier 292 (each mapping a locale to an instantiator list), or an image specifier
312 312
313 See `glyph-property' for more information." 313 See `glyph-property' for more information."
314 (glyph-property glyph 'contrib-p locale)) 314 (glyph-property glyph 'contrib-p locale))
315 315
316 (defun glyph-contrib-p-instance (glyph &optional domain default no-fallback) 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. 317 "Return the instance of GLYPH's 'contrib-p property in DOMAIN.
318 318
319 Normally DOMAIN will be a window or nil (meaning the selected window), 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 320 and an instance object describing what the 'contrib-p property is in
321 that particular window and buffer will be returned. 321 that particular window and buffer will be returned.
322 322
323 See `glyph-property-instance' for more information." 323 See `glyph-property-instance' for more information."
324 (glyph-property-instance glyph 'contrib-p domain default no-fallback)) 324 (glyph-property-instance glyph 'contrib-p domain default no-fallback))
325 325
326 (defun set-glyph-contrib-p (glyph spec &optional locale tag-set how-to-add) 326 (defun set-glyph-contrib-p (glyph spec &optional locale tag-set how-to-add)
327 "Change the contrib-p of the given glyph. 327 "Change the contrib-p property of GLYPH in LOCALE.
328 328
329 SPEC should be an instantiator (t or nil), a list of (possibly 329 SPEC should be an instantiator (t or nil), a list of (possibly
330 tagged) instantiators, an alist of specifications (each mapping a 330 tagged) instantiators, an alist of specifications (each mapping a
331 locale to an instantiator list), or a boolean specifier object. 331 locale to an instantiator list), or a boolean specifier object.
332 332
339 See `set-glyph-property' for more information." 339 See `set-glyph-property' for more information."
340 ; (interactive (glyph-interactive "contrib-p")) 340 ; (interactive (glyph-interactive "contrib-p"))
341 (set-glyph-property glyph 'contrib-p spec locale tag-set how-to-add)) 341 (set-glyph-property glyph 'contrib-p spec locale tag-set how-to-add))
342 342
343 (defun glyph-baseline (glyph &optional locale) 343 (defun glyph-baseline (glyph &optional locale)
344 "Return the baseline of the given glyph, or nil if it is unspecified. 344 "Return the baseline of GLYPH in LOCALE, or nil if it is unspecified.
345 345
346 LOCALE may be a locale (the instantiators for that particular locale 346 LOCALE may be a locale (the instantiators for that particular locale
347 will be returned), a locale type (the specifications for all locales 347 will be returned), a locale type (the specifications for all locales
348 of that type will be returned), 'all (all specifications will be 348 of that type will be returned), 'all (all specifications will be
349 returned), or nil (the actual specifier object will be returned). 349 returned), or nil (the actual specifier object will be returned).
350 350
351 See `glyph-property' for more information." 351 See `glyph-property' for more information."
352 (glyph-property glyph 'baseline locale)) 352 (glyph-property glyph 'baseline locale))
353 353
354 (defun glyph-baseline-instance (glyph &optional domain default no-fallback) 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. 355 "Return the instance of GLYPH's baseline in DOMAIN.
356 356
357 Normally DOMAIN will be a window or nil (meaning the selected window), 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 358 and an integer or nil (specifying the baseline in that particular
359 window and buffer) will be returned. 359 window and buffer) will be returned.
360 360
361 See `glyph-property-instance' for more information." 361 See `glyph-property-instance' for more information."
362 (glyph-property-instance glyph 'baseline domain default no-fallback)) 362 (glyph-property-instance glyph 'baseline domain default no-fallback))
363 363
364 (defun set-glyph-baseline (glyph spec &optional locale tag-set how-to-add) 364 (defun set-glyph-baseline (glyph spec &optional locale tag-set how-to-add)
365 "Change the baseline of the given glyph. 365 "Change the baseline of GLYPH to SPEC in LOCALE.
366 366
367 SPEC should be an instantiator (an integer [a percentage above the 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 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 369 tagged) instantiators, an alist of specifications (each mapping a
370 locale to an instantiator list), or a generic specifier object. 370 locale to an instantiator list), or a generic specifier object.
378 See `set-glyph-property' for more information." 378 See `set-glyph-property' for more information."
379 ; (interactive (glyph-interactive "baseline")) 379 ; (interactive (glyph-interactive "baseline"))
380 (set-glyph-property glyph 'baseline spec locale tag-set how-to-add)) 380 (set-glyph-property glyph 'baseline spec locale tag-set how-to-add))
381 381
382 (defun make-glyph (&optional spec-list type) 382 (defun make-glyph (&optional spec-list type)
383 "Create a new `glyph' object of type TYPE. 383 "Return a new `glyph' object of type TYPE.
384 384
385 TYPE should be one of `buffer' (used for glyphs in an extent, the modeline, 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), 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'. 387 or `icon' (used for a frame's icon), and defaults to `buffer'.
388 388
397 (let ((glyph (make-glyph-internal type))) 397 (let ((glyph (make-glyph-internal type)))
398 (and spec-list (set-glyph-image glyph spec-list)) 398 (and spec-list (set-glyph-image glyph spec-list))
399 glyph)) 399 glyph))
400 400
401 (defun buffer-glyph-p (object) 401 (defun buffer-glyph-p (object)
402 "t if OBJECT is a glyph of type `buffer'." 402 "Return t if OBJECT is a glyph of type `buffer'."
403 (and (glyphp object) (eq 'buffer (glyph-type object)))) 403 (and (glyphp object) (eq 'buffer (glyph-type object))))
404 404
405 (defun pointer-glyph-p (object) 405 (defun pointer-glyph-p (object)
406 "t if OBJECT is a glyph of type `pointer'." 406 "Return t if OBJECT is a glyph of type `pointer'."
407 (and (glyphp object) (eq 'pointer (glyph-type object)))) 407 (and (glyphp object) (eq 'pointer (glyph-type object))))
408 408
409 (defun icon-glyph-p (object) 409 (defun icon-glyph-p (object)
410 "t if OBJECT is a glyph of type `icon'." 410 "Return t if OBJECT is a glyph of type `icon'."
411 (and (glyphp object) (eq 'icon (glyph-type object)))) 411 (and (glyphp object) (eq 'icon (glyph-type object))))
412 412
413 (defun make-pointer-glyph (&optional spec-list) 413 (defun make-pointer-glyph (&optional spec-list)
414 "Create a new `pointer-glyph' object with the given specification list. 414 "Return a new `pointer-glyph' object with the specification list SPEC-LIST.
415 415
416 This is equivalent to calling `make-glyph' and specifying a type of 416 This is equivalent to calling `make-glyph', specifying a type of `pointer'.
417 `pointer'.
418 417
419 SPEC-LIST is used to initialize the glyph's image. It is typically an 418 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 419 image instantiator (a string or a vector; see `image-specifier-p' for
421 a detailed description of the valid image instantiators), but can also 420 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 421 be a list of such instantiators (each one in turn is tried until an
428 You can also create a glyph with an empty SPEC-LIST and add image 427 You can also create a glyph with an empty SPEC-LIST and add image
429 instantiators afterwards using `set-glyph-image'." 428 instantiators afterwards using `set-glyph-image'."
430 (make-glyph spec-list 'pointer)) 429 (make-glyph spec-list 'pointer))
431 430
432 (defun make-icon-glyph (&optional spec-list) 431 (defun make-icon-glyph (&optional spec-list)
433 "Create a new `icon-glyph' object with the given specification list. 432 "Return a new `icon-glyph' object with the specification list SPEC-LIST.
434 433
435 This is equivalent to calling `make-glyph' and specifying a type of 434 This is equivalent to calling `make-glyph', specifying a type of `icon'.
436 `icon'.
437 435
438 SPEC-LIST is used to initialize the glyph's image. It is typically an 436 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 437 image instantiator (a string or a vector; see `image-specifier-p' for
440 a detailed description of the valid image instantiators), but can also 438 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 439 be a list of such instantiators (each one in turn is tried until an
447 You can also create a glyph with an empty SPEC-LIST and add image 445 You can also create a glyph with an empty SPEC-LIST and add image
448 instantiators afterwards using `set-glyph-image'." 446 instantiators afterwards using `set-glyph-image'."
449 (make-glyph spec-list 'icon)) 447 (make-glyph spec-list 'icon))
450 448
451 (defun nothing-image-instance-p (object) 449 (defun nothing-image-instance-p (object)
452 "t if OBJECT is an image instance of type `nothing'." 450 "Return t if OBJECT is an image instance of type `nothing'."
453 (and (image-instance-p object) (eq 'nothing (image-instance-type object)))) 451 (and (image-instance-p object) (eq 'nothing (image-instance-type object))))
454 452
455 (defun text-image-instance-p (object) 453 (defun text-image-instance-p (object)
456 "t if OBJECT is an image instance of type `text'." 454 "Return t if OBJECT is an image instance of type `text'."
457 (and (image-instance-p object) (eq 'text (image-instance-type object)))) 455 (and (image-instance-p object) (eq 'text (image-instance-type object))))
458 456
459 (defun mono-pixmap-image-instance-p (object) 457 (defun mono-pixmap-image-instance-p (object)
460 "t if OBJECT is an image instance of type `mono-pixmap'." 458 "Return t if OBJECT is an image instance of type `mono-pixmap'."
461 (and (image-instance-p object) (eq 'mono-pixmap 459 (and (image-instance-p object) (eq 'mono-pixmap
462 (image-instance-type object)))) 460 (image-instance-type object))))
463 461
464 (defun color-pixmap-image-instance-p (object) 462 (defun color-pixmap-image-instance-p (object)
465 "t if OBJECT is an image instance of type `color-pixmap'." 463 "Return t if OBJECT is an image instance of type `color-pixmap'."
466 (and (image-instance-p object) (eq 'color-pixmap 464 (and (image-instance-p object) (eq 'color-pixmap
467 (image-instance-type object)))) 465 (image-instance-type object))))
468 466
469 (defun pointer-image-instance-p (object) 467 (defun pointer-image-instance-p (object)
470 "t if OBJECT is an image instance of type `pointer'." 468 "Return t if OBJECT is an image instance of type `pointer'."
471 (and (image-instance-p object) (eq 'pointer (image-instance-type object)))) 469 (and (image-instance-p object) (eq 'pointer (image-instance-type object))))
472 470
473 (defun subwindow-image-instance-p (object) 471 (defun subwindow-image-instance-p (object)
474 "t if OBJECT is an image instance of type `subwindow'. 472 "Return t if OBJECT is an image instance of type `subwindow'.
475 Subwindows are not implemented in this version of XEmacs." 473 Subwindows are not implemented in this version of XEmacs."
476 (and (image-instance-p object) (eq 'subwindow (image-instance-type object)))) 474 (and (image-instance-p object) (eq 'subwindow (image-instance-type object))))
477 475
478 ;;;;;;;;;; the built-in glyphs 476 ;;;;;;;;;; the built-in glyphs
479 477
657 655
658 ;; finish initializing xemacs logo -- created internally because it 656 ;; finish initializing xemacs logo -- created internally because it
659 ;; has a built-in bitmap 657 ;; has a built-in bitmap
660 (if (featurep 'xpm) 658 (if (featurep 'xpm)
661 (set-glyph-image xemacs-logo 659 (set-glyph-image xemacs-logo
662 (concat "../etc/" 660 (concat "../etc/"
663 (if emacs-beta-version 661 (if emacs-beta-version
664 "xemacs-beta.xpm" 662 "xemacs-beta.xpm"
665 "xemacs.xpm")) 663 "xemacs.xpm"))
666 'global 'x)) 664 'global 'x))
667 (cond ((featurep 'xpm) 665 (cond ((featurep 'xpm)