Mercurial > hg > xemacs-beta

comparison lisp/prim/glyphs.el @ 155:43dd3413c7c7 r20-3b4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b4
author cvs
date Mon, 13 Aug 2007 09:39:39 +0200
parents d2f30a177268
children a2f645c6b9f8
comparison
equal deleted inserted replaced
154:94141801dd7e 155:43dd3413c7c7
1 ;;; glyphs.el --- Lisp interface to C glyphs 1 ;;; glyphs.el --- Lisp interface to C glyphs
2 ;; Keywords: glyphs internal 2
3 3 ;; Copyright (C) 1994, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1994 Board of Trustees, University of Illinois
5 ;; Copyright (C) 1995, 1996 Ben Wing. 4 ;; Copyright (C) 1995, 1996 Ben Wing.
6 5
7 ;; Author: Chuck Thompson <cthomp@cs.uiuc.edu>, 6 ;; Author: Chuck Thompson <cthomp@cs.uiuc.edu>, Ben Wing <wing@666.com>
8 ;; Ben Wing <wing@666.com> 7 ;; Maintainer: XEmacs Development Team
8 ;; Keywords: extensions, internal
9 9
10 ;; This file is part of XEmacs. 10 ;; This file is part of XEmacs.
11 11
12 ;; XEmacs is free software; you can redistribute it and/or modify it 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 13 ;; under the terms of the GNU General Public License as published by
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
29 ;;; Commentary:
30
31 ;;; Code:
28 32
29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; font specifiers 33 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; font specifiers
30 34
31 (defun make-image-specifier (spec-list) 35 (defun make-image-specifier (spec-list)
32 "Create a new `image' specifier object with the given specification list. 36 "Create a new `image' specifier object with the given specification list.
561 (let ((value (car args))) 565 (let ((value (car args)))
562 (if (null value) 566 (if (null value)
563 (remove-specifier harg 'global) 567 (remove-specifier harg 'global)
564 (set-glyph-image (symbol-value harg) value)))) 568 (set-glyph-image (symbol-value harg) value))))
565 569
570 ;; It might or might not be garbage, but it's rude. Make these
571 ;; 'compatible instead of 'obsolete. -slb
566 (defun define-obsolete-pointer-glyph (old new) 572 (defun define-obsolete-pointer-glyph (old new)
567 (define-obsolete-variable-alias old new) 573 (define-compatible-variable-alias old new)
568 (dontusethis-set-symbol-value-handler 574 (dontusethis-set-symbol-value-handler
569 old 'set-value 'dontusethis-old-pointer-shape-handler new)) 575 old 'set-value 'dontusethis-old-pointer-shape-handler new))
570 576
571 (defvar x-pointer-shape nil) 577 ;;; (defvar x-pointer-shape nil)
572 (define-obsolete-pointer-glyph 'x-pointer-shape 'text-pointer-glyph) 578 (define-obsolete-pointer-glyph 'x-pointer-shape 'text-pointer-glyph)
573 579
574 (defvar x-nontext-pointer-shape nil) 580 ;;; (defvar x-nontext-pointer-shape nil)
575 (define-obsolete-pointer-glyph 'x-nontext-pointer-shape 'nontext-pointer-glyph) 581 (define-obsolete-pointer-glyph 'x-nontext-pointer-shape 'nontext-pointer-glyph)
576 582
577 (defvar x-mode-pointer-shape nil) 583 ;;; (defvar x-mode-pointer-shape nil)
578 (define-obsolete-pointer-glyph 'x-mode-pointer-shape 'modeline-pointer-glyph) 584 (define-obsolete-pointer-glyph 'x-mode-pointer-shape 'modeline-pointer-glyph)
579 585
580 (defvar x-selection-pointer-shape nil) 586 ;;; (defvar x-selection-pointer-shape nil)
581 (define-obsolete-pointer-glyph 'x-selection-pointer-shape 587 (define-obsolete-pointer-glyph 'x-selection-pointer-shape
582 'selection-pointer-glyph) 588 'selection-pointer-glyph)
583 589
584 (defvar x-busy-pointer-shape nil) 590 ;;; (defvar x-busy-pointer-shape nil)
585 (define-obsolete-pointer-glyph 'x-busy-pointer-shape 'busy-pointer-glyph) 591 (define-obsolete-pointer-glyph 'x-busy-pointer-shape 'busy-pointer-glyph)
586 592
587 (defvar x-gc-pointer-shape nil) 593 ;;; (defvar x-gc-pointer-shape nil)
588 (define-obsolete-pointer-glyph 'x-gc-pointer-shape 'gc-pointer-glyph) 594 (define-obsolete-pointer-glyph 'x-gc-pointer-shape 'gc-pointer-glyph)
589 595
590 (defvar x-toolbar-pointer-shape nil) 596 ;;; (defvar x-toolbar-pointer-shape nil)
591 (define-obsolete-pointer-glyph 'x-toolbar-pointer-shape 'toolbar-pointer-glyph) 597 (define-obsolete-pointer-glyph 'x-toolbar-pointer-shape 'toolbar-pointer-glyph)
592 598
593 ;;;;;;;;;; initialization 599 ;;;;;;;;;; initialization
594 600
595 (defun init-glyphs () 601 (defun init-glyphs ()
596 ;; initialize default image types 602 ;; initialize default image types
597 (if (featurep 'x) 603 (if (featurep 'x)
598 (set-console-type-image-conversion-list 'x 604 (set-console-type-image-conversion-list 'x
599 `(,@(if (featurep 'xpm) '(("\.xpm$" [xpm :file nil] 2))) 605 `(,@(if (featurep 'xpm) '(("\\.xpm$\\'" [xpm :file nil] 2)))
600 ,@(if (featurep 'xpm) '(("^/\\* XPM \\*/" [xpm :data nil] 2))) 606 ("\\.xbm\\'" [xbm :file nil] 2)
601 ,@(if (featurep 'xface) '(("^X-Face:" [xface :data nil] 2))) 607 ,@(if (featurep 'xpm) '(("\\`/\\* XPM \\*/" [xpm :data nil] 2)))
602 ,@(if (featurep 'gif) '(("\.gif$" [gif :file nil] 2))) 608 ,@(if (featurep 'xface) '(("\\`X-Face:" [xface :data nil] 2)))
603 ,@(if (featurep 'gif) '(("^GIF8[79]" [gif :data nil] 2))) 609 ,@(if (featurep 'gif) '(("\\.gif\\'" [gif :file nil] 2)))
604 ,@(if (featurep 'jpeg) '(("\.jpeg$" [jpeg :file nil] 2))) 610 ,@(if (featurep 'gif) '(("\\`GIF8[79]" [gif :data nil] 2)))
605 ,@(if (featurep 'jpeg) '(("\.jpg$" [jpeg :file nil] 2))) 611 ,@(if (featurep 'jpeg) '(("\\.jpe?g\\'" [jpeg :file nil] 2)))
606 ;; all of the JFIF-format JPEG's that I've seen begin with 612 ;; all of the JFIF-format JPEG's that I've seen begin with
607 ;; the following. I have no idea if this is standard. 613 ;; the following. I have no idea if this is standard.
608 ,@(if (featurep 'jpeg) '(("^\377\330\340\000\020JFIF" 614 ,@(if (featurep 'jpeg) '(("\\`\377\330\340\000\020JFIF"
609 [jpeg :data nil] 2))) 615 [jpeg :data nil] 2)))
610 ,@(if (featurep 'png) '(("\.png$" [png :file nil] 2))) 616 ,@(if (featurep 'png) '(("\\.png\\'" [png :file nil] 2)))
611 ,@(if (featurep 'png) '(("^\211PNG" [png :data nil] 2))) 617 ,@(if (featurep 'png) '(("\\`\211PNG" [png :data nil] 2)))
612 ("" [autodetect :data nil] 2)))) 618 ("" [autodetect :data nil] 2))))
613 ;; #### this should really be formatted-string, not string but we 619 ;; #### this should really be formatted-string, not string but we
614 ;; don't have it implemented yet 620 ;; don't have it implemented yet
615 ;; 621 ;;
616 ;; #define could also mean a bitmap as well as a version 1 XPM. Who 622 ;; #define could also mean a bitmap as well as a version 1 XPM. Who
619 (if (featurep 'tty) 625 (if (featurep 'tty)
620 (progn 626 (progn
621 (set-console-type-image-conversion-list 627 (set-console-type-image-conversion-list
622 'tty 628 'tty
623 '(("^#define" [string :data "[xpm]"]) 629 '(("^#define" [string :data "[xpm]"])
624 ("^X-Face:" [string :data "[xface]"]) 630 ("\\`X-Face:" [string :data "[xface]"])
625 ("^/\\* XPM \\*/" [string :data "[xpm]"]) 631 ("\\`/\\* XPM \\*/" [string :data "[xpm]"])
626 ("^GIF87" [string :data "[gif]"]) 632 ("\\`GIF87" [string :data "[gif]"])
627 ("^\377\330\340\000\020JFIF" [string :data "[jpeg]"]) 633 ("\\`\377\330\340\000\020JFIF" [string :data "[jpeg]"])
628 ("" [string :data nil] 2) 634 ("" [string :data nil] 2)
629 ;; this last one is here for pointers and icons and such -- 635 ;; this last one is here for pointers and icons and such --
630 ;; strings are not allowed so they will be ignored. 636 ;; strings are not allowed so they will be ignored.
631 ("" [nothing]))) 637 ("" [nothing])))
632 638