annotate lisp/prim/disp-table.el @ 2:ac2d302a0011 r19-15b2

Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children 0293115a14e9
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1 ;;; disp-table.el --- functions for dealing with char tables.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3 ;; Copyright (C) 1987, 1994 Free Software Foundation, Inc.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4 ;; Copyright (C) 1995 Sun Microsystems.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6 ;; Author: Howard Gayle
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
7 ;; Maintainer: FSF
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
8 ;; Keywords: i18n
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
9
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
10 ;; This file is part of XEmacs.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
11
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
12 ;; XEmacs is free software; you can redistribute it and/or modify it
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
13 ;; under the terms of the GNU General Public License as published by
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
14 ;; the Free Software Foundation; either version 2, or (at your option)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
15 ;; any later version.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
16
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
17 ;; XEmacs is distributed in the hope that it will be useful, but
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
20 ;; General Public License for more details.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
21
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
22 ;; You should have received a copy of the GNU General Public License
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
24 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
25
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
26 ;;; Synched up with: Not synched with FSF.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
27
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
28 ;;; #### Need lots of work. make-display-table depends on a value
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
29 ;;; that is a define in the C code. Maybe we should just move the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
30 ;;; function into C.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
31
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
32 ;;; #### display-tables-as-vectors is really evil and a big pain in
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
33 ;;; the ass.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
34
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
35 ;;; Rewritten for XEmacs July 1995, Ben Wing.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
36
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
37 ;;; Code:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
38
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
39 (defun describe-display-table (dt)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
40 "Describe the display table DT in a help buffer."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
41 (with-displaying-help-buffer
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
42 (lambda ()
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
43 (princ "\nCharacter display glyph sequences:\n")
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
44 (save-excursion
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
45 (set-buffer standard-output)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
46 (let ((vector (make-vector 256 nil))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
47 (i 0))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
48 (while (< i 256)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
49 (aset vector i (aref dt i))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
50 (setq i (1+ i)))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
51 ;;; ### No such function `describe-vector'...
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
52 (describe-vector vector))))))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
53
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
54 ;;;###autoload
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
55 (defun describe-current-display-table (&optional domain)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
56 "Describe the display table in use in the selected window and buffer."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
57 (interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
58 (or domain (setq domain (selected-window)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
59 (let ((disptab (specifier-instance current-display-table domain)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
60 (if disptab
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
61 (describe-display-table disptab)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
62 (message "No display table"))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
63
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
64 ;;;###autoload
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
65 (defun make-display-table ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
66 "Return a new, empty display table."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
67 (make-vector 256 nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
68
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
69 ;; #### we need a generic frob-specifier function.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
70 ;; #### this also needs to be redone like frob-face-property.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
71
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
72 ;; Let me say one more time how much dynamic scoping sucks.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
73
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
74 (defun frob-display-table (fdt-function fdt-locale)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
75 (or fdt-locale (setq fdt-locale 'global))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
76 (or (specifier-spec-list current-display-table fdt-locale)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
77 (add-spec-to-specifier current-display-table (make-display-table)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
78 fdt-locale))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
79 (add-spec-list-to-specifier
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
80 current-display-table
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
81 (list (cons fdt-locale
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
82 (mapcar
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
83 (lambda (fdt-x)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
84 (funcall fdt-function (cdr fdt-x))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
85 fdt-x)
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
86 (cdar (specifier-spec-list current-display-table
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
87 fdt-locale)))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
88
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
89 (defun standard-display-8bit-1 (dt l h)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
90 (while (<= l h)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
91 (aset dt l (char-to-string l))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
92 (setq l (1+ l))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
93
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
94 ;;;###autoload
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
95 (defun standard-display-8bit (l h &optional locale)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
96 "Display characters in the range L to H literally."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
97 (frob-display-table
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
98 (lambda (x)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
99 (standard-display-8bit-1 x l h))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
100 locale))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
101
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
102 (defun standard-display-default-1 (dt l h)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
103 (while (<= l h)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
104 (aset dt l nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
105 (setq l (1+ l))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
106
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
107 ;;;###autoload
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
108 (defun standard-display-default (l h &optional locale)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
109 "Display characters in the range L to H using the default notation."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
110 (frob-display-table
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
111 (lambda (x)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
112 (standard-display-default-1 x l h))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
113 locale))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
114
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
115 ;;;###autoload
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
116 (defun standard-display-ascii (c s &optional locale)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
117 "Display character C using printable string S."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
118 (frob-display-table
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
119 (lambda (x)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
120 (aset x c s))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
121 locale))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
122
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
123
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
124 ;;; #### should frob in a 'tty locale.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
125
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
126 ;;;###autoload
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
127 (defun standard-display-g1 (c sc &optional locale)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
128 "Display character C as character SC in the g1 character set.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
129 This function assumes that your terminal uses the SO/SI characters;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
130 it is meaningless for an X frame."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
131 (frob-display-table
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
132 (lambda (x)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
133 (aset x c (concat "\016" (char-to-string sc) "\017")))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
134 locale))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
135
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
136
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
137 ;;; #### should frob in a 'tty locale.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
138
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
139 ;;;###autoload
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
140 (defun standard-display-graphic (c gc &optional locale)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
141 "Display character C as character GC in graphics character set.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
142 This function assumes VT100-compatible escapes; it is meaningless for an
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
143 X frame."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
144 (frob-display-table
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
145 (lambda (x)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
146 (aset x c (concat "\e(0" (char-to-string gc) "\e(B")))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
147 locale))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
148
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
149 ;;; #### should frob in a 'tty locale.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
150 ;;; #### the FSF equivalent of this makes this character be displayed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
151 ;;; in the 'underline face. There's no current way to do this with
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
152 ;;; XEmacs display tables.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
153
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
154 ;;;###autoload
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
155 (defun standard-display-underline (c uc &optional locale)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
156 "Display character C as character UC plus underlining."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
157 (frob-display-table
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
158 (lambda (x)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
159 (aset x c (concat "\e[4m" (char-to-string uc) "\e[m")))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
160 locale))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
161
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
162 ;;;###autoload
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
163 (defun standard-display-european (arg &optional locale)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
164 "Toggle display of European characters encoded with ISO 8859.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
165 When enabled, characters in the range of 160 to 255 display not
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
166 as octal escapes, but as accented characters.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
167 With prefix argument, enable European character display iff arg is positive."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
168 (interactive "P")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
169 (frob-display-table
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
170 (lambda (x)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
171 (if (or (<= (prefix-numeric-value arg) 0)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
172 (and (null arg)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
173 (equal (aref x 160) (char-to-string 160))))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
174 (standard-display-default-1 x 160 255)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
175 (standard-display-8bit-1 x 160 255)))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
176 locale))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
177
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
178 (provide 'disp-table)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
179
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
180 ;;; disp-table.el ends here