Mercurial > hg > xemacs-beta

comparison lisp/disp-table.el @ 4451:e214ff9f9507

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Use char-tables, not vectors, to instantiate the display table specifiers. 2007-07-21 Aidan Kehoe <kehoea@parhasard.net> * mule/cyril-util.el: * mule/cyril-util.el (cyrillic-encode-koi8-r-char): Removed. * mule/cyril-util.el (cyrillic-encode-alternativnyj-char): Removed. No-one uses these functions in google.com/codesearch, GNU have a comment doubting their utility, and their implementation is trivial. * mule/cyril-util.el (cyrillic-language-alist): Reformatted. * mule/cyril-util.el (standard-display-table)): Removed. It wasn't used anyway. * mule/cyril-util.el (standard-display-cyrillic-translit): Rewrite it to work with character tables as display tables, and not to abort with an error. 2007-07-21 Aidan Kehoe <kehoea@parhasard.net> * disp-table.el: * disp-table.el (make-display-table): Moved earlier in the file in a weak attempt at making syncing with GNU easier. * disp-table.el (frob-display-table): Autoload it, accept TAG-SET, for editing specifiers. * disp-table.el (describe-display-table): Have it handle character sets. * disp-table.el (standard-display-8bit-1): * disp-table.el (standard-display-8bit): * disp-table.el (standard-display-default-1): * disp-table.el (standard-display-ascii): * disp-table.el (standard-display-g1): * disp-table.el (standard-display-graphic): * disp-table.el (standard-display-underline): * disp-table.el (standard-display-european): Rework them all to use put-char-table, remove-char-table instead of aset. Limit standard-display-g1, standard-display-graphic to TTYs; have standard-display-underline work on X11 too. * font.el (font-caps-display-table): Use put-char-table instead of aset when editing a display table. * x-init.el: * x-init.el (tab): Create the initial display table as a char-table, not a vector.
author Aidan Kehoe <kehoea@parhasard.net>
date Mon, 24 Dec 2007 20:22:08 +0100
parents 262b8bb4a523
children 82f8351e71c8
comparison
equal deleted inserted replaced
4356:cc293ef846d2 4451:e214ff9f9507
1 ;;; disp-table.el --- functions for dealing with char tables. 1 ;;; disp-table.el --- functions for dealing with char tables.
2 2
3 ;; Copyright (C) 1987, 1994, 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1987, 1994, 1997, 2007 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Sun Microsystems. 4 ;; Copyright (C) 1995 Sun Microsystems.
5 5
6 ;; Author: Howard Gayle 6 ;; Author: Howard Gayle
7 ;; Maintainer: XEmacs Development Team 7 ;; Maintainer: XEmacs Development Team
8 ;; Keywords: i18n, internal 8 ;; Keywords: i18n, internal
26 26
27 ;;; Synched up with: Not synched with FSF. 27 ;;; Synched up with: Not synched with FSF.
28 28
29 ;;; Commentary: 29 ;;; Commentary:
30 30
31 ;; #### Need lots of work. make-display-table depends on a value
32 ;; that is a define in the C code. Maybe we should just move the
33 ;; function into C.
34
35 ;; #### display-tables-as-vectors is really evil and a big pain in
36 ;; the ass.
37
38 ;; Rewritten for XEmacs July 1995, Ben Wing. 31 ;; Rewritten for XEmacs July 1995, Ben Wing.
39 32
40 33
41 ;;; Code: 34 ;;; Code:
35
36 ;;;###autoload
37 (defun make-display-table ()
38 "Return a new, empty display table.
39
40 This returns a generic character table; previously it returned a vector, but
41 that was not helpful when dealing with internationalized characters above
42 #xFF. See `make-char-table' for details of character tables in general. To
43 write code that works with both vectors and character tables, add something
44 like the following to the beginning of your file, and use
45 `put-display-table' to set what a given character is displayed as, and
46 `get-display-table' to examine what that character is currently displayed
47 as:
48
49 \(defun-when-void put-display-table (range value display-table)
50 \"Set the value for char RANGE to VALUE in DISPLAY-TABLE. \"
51 (ecase (type-of display-table)
52 (vector
53 (aset display-table range value))
54 (char-table
55 (put-char-table range value display-table))))
56
57 \(defun-when-void get-display-table (character display-table)
58 \"Find value for CHARACTER in DISPLAY-TABLE. \"
59 (ecase (type-of display-table)
60 (vector
61 (aref display-table character))
62 (char-table
63 (get-char-table character display-table))))
64
65 In this implementation, `put-display-table' and `get-display-table' are
66 aliases of `put-char-table' and `get-char-table' respectively, and are
67 always available. "
68 (make-char-table 'generic))
69
70 ;;;###autoload
71 (defalias 'put-display-table #'put-char-table)
72
73 ;;;###autoload
74 (defalias 'get-display-table #'get-char-table)
42 75
43 (defun describe-display-table (dt) 76 (defun describe-display-table (dt)
44 "Describe the display table DT in a help buffer." 77 "Describe the display table DT in a help buffer."
45 (with-displaying-help-buffer 78 (with-displaying-help-buffer
46 (lambda () 79 (lambda ()
47 (princ "\nCharacter display glyph sequences:\n") 80 (map-char-table
48 (save-excursion 81 (lambda (range value)
49 (let ((vector (make-vector 256 nil)) 82 (cond
50 (i 0)) 83 ((eq range t)
51 (while (< i 256) 84 (princ "\nAll characters: \n")
52 (aset vector i (aref dt i)) 85 (princ (format " %S" value)))
53 (incf i)) 86 ((eq 'charset (and (symbolp range) (type-of (find-charset range))))
54 ;; FSF calls `describe-vector' here, but it is so incredibly 87 (princ (format "\n\nCharset %S: \n" (charset-name range)))
55 ;; lame a function for that name that I cannot bring myself 88 (princ (format " %S" value)))
56 ;; to porting it. Here is what `describe-vector' does: 89 ((vectorp range)
57 (terpri) 90 (princ (format "\n\nCharset %S, row %d \n"
58 (let ((old (aref vector 0)) 91 (charset-name (aref value 0))
59 (oldpos 0) 92 (aref value 1)))
60 (i 1) 93 (princ (format " %S\n\n" value)))
61 str) 94 ((characterp range)
62 (while (<= i 256) 95 (princ (format "\nCharacter U+%04X, %S: "
63 (when (or (= i 256) 96 range (if (fboundp 'split-char)
64 (not (equal old (aref vector i)))) 97 (split-char range)
65 (if (eq oldpos (1- i)) 98 (list 'ascii (char-to-int range)))))
66 (princ (format "%s\t\t%s\n" 99 (princ (format " %S" value))))
67 (single-key-description (int-char oldpos)) 100 nil) dt)
68 old)) 101 (princ
69 (setq str (format "%s - %s" 102 "\n\nFor some of the various other glyphs that GNU Emacs uses the display
70 (single-key-description (int-char oldpos)) 103 table for, see the XEmacs specifiers `truncation-glyph' ,
71 (single-key-description (int-char (1- i))))) 104 `continuation-glyph', `control-arrow-glyph', `octal-escape-glyph' and the
72 (princ str) 105 others described in the docstring of `make-glyph'. \n\n"))))
73 (princ (make-string (max (- 2 (/ (length str) 106
74 tab-width)) 1) ?\t))
75 (princ old)
76 (terpri))
77 (or (= i 256)
78 (setq old (aref vector i)
79 oldpos i)))
80 (incf i))))))))
81 107
82 ;;;###autoload 108 ;;;###autoload
83 (defun describe-current-display-table (&optional domain) 109 (defun describe-current-display-table (&optional domain)
84 "Describe the display table in use in the selected window and buffer." 110 "Describe the display table in use in the selected window and buffer."
85 (interactive) 111 (interactive)
87 (let ((disptab (specifier-instance current-display-table domain))) 113 (let ((disptab (specifier-instance current-display-table domain)))
88 (if disptab 114 (if disptab
89 (describe-display-table disptab) 115 (describe-display-table disptab)
90 (message "No display table")))) 116 (message "No display table"))))
91 117
92 ;;;###autoload
93 (defun make-display-table ()
94 "Return a new, empty display table."
95 (make-vector 256 nil))
96
97 ;; #### we need a generic frob-specifier function. 118 ;; #### we need a generic frob-specifier function.
98 ;; #### this also needs to be redone like frob-face-property. 119 ;; #### this also needs to be redone like frob-face-property.
99 120
100 ;; Let me say one more time how much dynamic scoping sucks. 121 ;; Let me say one more time how much dynamic scoping sucks.
101 122
102 (defun frob-display-table (fdt-function fdt-locale) 123 ;;;###autoload
124 (defun frob-display-table (fdt-function fdt-locale &optional tag-set)
103 (or fdt-locale (setq fdt-locale 'global)) 125 (or fdt-locale (setq fdt-locale 'global))
104 (or (specifier-spec-list current-display-table fdt-locale) 126 (or (specifier-spec-list current-display-table fdt-locale tag-set)
105 (add-spec-to-specifier current-display-table (make-display-table) 127 (add-spec-to-specifier current-display-table (make-display-table)
106 fdt-locale)) 128 fdt-locale tag-set))
107 (add-spec-list-to-specifier 129 (add-spec-list-to-specifier
108 current-display-table 130 current-display-table
109 (list (cons fdt-locale 131 (list (cons fdt-locale
110 (mapcar 132 (mapcar
111 (lambda (fdt-x) 133 (lambda (fdt-x)
112 (funcall fdt-function (cdr fdt-x)) 134 (funcall fdt-function (cdr fdt-x))
113 fdt-x) 135 fdt-x)
114 (cdar (specifier-spec-list current-display-table 136 (cdar (specifier-spec-list current-display-table
115 fdt-locale))))))) 137 fdt-locale tag-set)))))))
116 138
117 (defun standard-display-8bit-1 (dt l h) 139 (defun standard-display-8bit-1 (dt l h)
118 (while (<= l h) 140 (while (<= l h)
119 (aset dt l (char-to-string l)) 141 (remove-char-table (int-to-char l) dt)
120 (setq l (1+ l)))) 142 (setq l (1+ l))))
121 143
122 ;;;###autoload 144 ;;;###autoload
123 (defun standard-display-8bit (l h &optional locale) 145 (defun standard-display-8bit (l h &optional locale)
124 "Display characters in the range L to H literally." 146 "Display characters in the range L to H literally [sic].
147
148 GNU Emacs includes this function. There, `literally' has no good meaning.
149 Under XEmacs, this function makes characters with numeric values in the
150 range L to H display as themselves; that is, as ASCII, latin-iso8859-1,
151 latin-iso8859-2 or whatever. See `standard-display-default' for the inverse
152 function. "
125 (frob-display-table 153 (frob-display-table
126 (lambda (x) 154 (lambda (x)
127 (standard-display-8bit-1 x l h)) 155 (standard-display-8bit-1 x l h))
128 locale)) 156 locale))
129 157
130 (defun standard-display-default-1 (dt l h) 158 (defun standard-display-default-1 (dt l h)
159 "Misnamed function under XEmacs. See `standard-display-default'."
131 (while (<= l h) 160 (while (<= l h)
132 (aset dt l nil) 161 (put-char-table (int-to-char l) (format "\\%o" l) dt)
133 (setq l (1+ l)))) 162 (setq l (1+ l))))
134 163
135 ;;;###autoload 164 ;;;###autoload
136 (defun standard-display-default (l h &optional locale) 165 (defun standard-display-default (l h &optional locale)
137 "Display characters in the range L to H using the default notation." 166 "Display characters in the range L to H using octal escape notation.
167
168 In the XEmacs context this function is misnamed. Under GNU Emacs,
169 characters in the range #xA0 to #xFF display as octal escapes unless
170 `standard-display-european' has been called; this function neutralizes the
171 effects of `standard-display-european'. Under XEmacs, those characters
172 normally do not display as octal escapes (this ignores hackery like
173 specifying the X11 font character set on non-Mule builds) and this function
174 sets them to display as octal escapes. "
138 (frob-display-table 175 (frob-display-table
139 (lambda (x) 176 (lambda (x)
140 (standard-display-default-1 x l h)) 177 (standard-display-default-1 x l h))
141 locale)) 178 locale))
142 179
143 ;;;###autoload 180 ;;;###autoload
144 (defun standard-display-ascii (c s &optional locale) 181 (defun standard-display-ascii (c s &optional locale)
145 "Display character C using printable string S." 182 "Display character C using printable string S."
146 (frob-display-table 183 (frob-display-table
147 (lambda (x) 184 (lambda (x)
148 (aset x c s)) 185 (put-char-table c s x))
149 locale)) 186 locale))
150
151
152 ;;; #### should frob in a 'tty locale.
153 187
154 ;;;###autoload 188 ;;;###autoload
155 (defun standard-display-g1 (c sc &optional locale) 189 (defun standard-display-g1 (c sc &optional locale)
156 "Display character C as character SC in the g1 character set. 190 "Display character C as character SC in the g1 character set.
157 This function assumes that your terminal uses the SO/SI characters; 191 This function assumes that your terminal uses the SO/SI characters;
158 it is meaningless for an X frame." 192 it is meaningless for an X frame."
159 (frob-display-table 193 (frob-display-table
160 (lambda (x) 194 (lambda (x)
161 (aset x c (concat "\016" (char-to-string sc) "\017"))) 195 (put-char-table c (concat "\016" (char-to-string sc) "\017") x))
162 locale)) 196 locale '(tty)))
163
164
165 ;;; #### should frob in a 'tty locale.
166 197
167 ;;;###autoload 198 ;;;###autoload
168 (defun standard-display-graphic (c gc &optional locale) 199 (defun standard-display-graphic (c gc &optional locale)
169 "Display character C as character GC in graphics character set. 200 "Display character C as character GC in graphics character set.
170 This function assumes VT100-compatible escapes; it is meaningless for an 201 This function assumes VT100-compatible escapes; it is meaningless for an
171 X frame." 202 X frame."
172 (frob-display-table 203 (frob-display-table
173 (lambda (x) 204 (lambda (x)
174 (aset x c (concat "\e(0" (char-to-string gc) "\e(B"))) 205 (put-char-table c (concat "\e(0" (char-to-string gc) "\e(B") x))
175 locale)) 206 locale '(tty)))
176
177 ;;; #### should frob in a 'tty locale.
178 ;;; #### the FSF equivalent of this makes this character be displayed
179 ;;; in the 'underline face. There's no current way to do this with
180 ;;; XEmacs display tables.
181 207
182 ;;;###autoload 208 ;;;###autoload
183 (defun standard-display-underline (c uc &optional locale) 209 (defun standard-display-underline (c uc &optional locale)
184 "Display character C as character UC plus underlining." 210 "Display character C as character UC plus underlining."
185 (frob-display-table 211 (frob-display-table
186 (lambda (x) 212 (lambda (x)
187 (aset x c (concat "\e[4m" (char-to-string uc) "\e[m"))) 213 (let (glyph)
214 (setq glyph (make-glyph (vector 'string :data (char-to-string uc))))
215 (set-glyph-face glyph 'underline)
216 (put-char-table c glyph x)))
188 locale)) 217 locale))
189 218
190 ;;;###autoload 219 ;;;###autoload
191 (defun standard-display-european (arg &optional locale) 220 (defun standard-display-european (arg &optional locale)
192 "Toggle display of European characters encoded with ISO 8859. 221 "Toggle display of European characters encoded with ISO 8859-1.
193 When enabled, characters in the range of 160 to 255 display not 222 When enabled (the default), characters in the range of 160 to 255 display
194 as octal escapes, but as accented characters. 223 as accented characters. With negative prefix argument, display characters in
195 With prefix argument, enable European character display iff arg is positive." 224 that range as octal escapes.
225
226 If you want to work in a Western European language under XEmacs, it
227 shouldn't be necessary to call this function--things should just work. But
228 it's in a sufficient number of init files that we're not in a hurry to
229 remove it. "
196 (interactive "P") 230 (interactive "P")
197 (frob-display-table 231 (if (<= (prefix-numeric-value arg) 0)
198 (lambda (x) 232 (frob-display-table
199 (if (or (<= (prefix-numeric-value arg) 0) 233 (lambda (x)
200 (and (null arg) 234 (standard-display-default-1 x 160 255))
201 (equal (aref x 160) (char-to-string 160)))) 235 locale)
202 (standard-display-default-1 x 160 255) 236 (frob-display-table
203 (standard-display-8bit-1 x 160 255))) 237 (lambda (x)
204 locale)) 238 (standard-display-8bit-1 x 160 255))
239 locale)))
205 240
206 (provide 'disp-table) 241 (provide 'disp-table)
207 242
208 ;;; disp-table.el ends here 243 ;;; disp-table.el ends here