38412
|
1 ;;; disp-table.el --- functions for dealing with char tables
|
662
|
2
|
64762
|
3 ;; Copyright (C) 1987, 1994, 1995, 1999, 2002, 2003, 2004,
|
68651
|
4 ;; 2005, 2006 Free Software Foundation, Inc.
|
845
|
5
|
13164
|
6 ;; Author: Erik Naggum <erik@naggum.no>
|
|
7 ;; Based on a previous version by Howard Gayle
|
807
|
8 ;; Maintainer: FSF
|
3012
|
9 ;; Keywords: i18n
|
36
|
10
|
|
11 ;; This file is part of GNU Emacs.
|
|
12
|
|
13 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
14 ;; it under the terms of the GNU General Public License as published by
|
807
|
15 ;; the Free Software Foundation; either version 2, or (at your option)
|
36
|
16 ;; any later version.
|
|
17
|
|
18 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
21 ;; GNU General Public License for more details.
|
|
22
|
|
23 ;; You should have received a copy of the GNU General Public License
|
14169
|
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
64091
|
25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
26 ;; Boston, MA 02110-1301, USA.
|
36
|
27
|
38412
|
28 ;;; Commentary:
|
|
29
|
807
|
30 ;;; Code:
|
36
|
31
|
13199
|
32 (put 'display-table 'char-table-extra-slots 6)
|
13164
|
33
|
|
34 ;;;###autoload
|
|
35 (defun make-display-table ()
|
|
36 "Return a new, empty display table."
|
13199
|
37 (make-char-table 'display-table nil))
|
13164
|
38
|
58727
|
39 (or standard-display-table
|
|
40 (setq standard-display-table (make-display-table)))
|
13164
|
41
|
13199
|
42 ;;; Display-table slot names. The property value says which slot.
|
13164
|
43
|
13199
|
44 (put 'truncation 'display-table-slot 0)
|
|
45 (put 'wrap 'display-table-slot 1)
|
|
46 (put 'escape 'display-table-slot 2)
|
|
47 (put 'control 'display-table-slot 3)
|
|
48 (put 'selective-display 'display-table-slot 4)
|
|
49 (put 'vertical-border 'display-table-slot 5)
|
13164
|
50
|
|
51 ;;;###autoload
|
|
52 (defun display-table-slot (display-table slot)
|
|
53 "Return the value of the extra slot in DISPLAY-TABLE named SLOT.
|
13683
d628bf92f672
(display-table-slot,set-display-table-slot): Document the slot names.
Erik Naggum <erik@naggum.no>
diff
changeset
|
54 SLOT may be a number from 0 to 5 inclusive, or a slot name (symbol).
|
d628bf92f672
(display-table-slot,set-display-table-slot): Document the slot names.
Erik Naggum <erik@naggum.no>
diff
changeset
|
55 Valid symbols are `truncation', `wrap', `escape', `control',
|
d628bf92f672
(display-table-slot,set-display-table-slot): Document the slot names.
Erik Naggum <erik@naggum.no>
diff
changeset
|
56 `selective-display', and `vertical-border'."
|
13164
|
57 (let ((slot-number
|
|
58 (if (numberp slot) slot
|
13199
|
59 (or (get slot 'display-table-slot)
|
13164
|
60 (error "Invalid display-table slot name: %s" slot)))))
|
|
61 (char-table-extra-slot display-table slot-number)))
|
|
62
|
|
63 ;;;###autoload
|
|
64 (defun set-display-table-slot (display-table slot value)
|
|
65 "Set the value of the extra slot in DISPLAY-TABLE named SLOT to VALUE.
|
|
66 SLOT may be a number from 0 to 5 inclusive, or a name (symbol).
|
13683
d628bf92f672
(display-table-slot,set-display-table-slot): Document the slot names.
Erik Naggum <erik@naggum.no>
diff
changeset
|
67 Valid symbols are `truncation', `wrap', `escape', `control',
|
d628bf92f672
(display-table-slot,set-display-table-slot): Document the slot names.
Erik Naggum <erik@naggum.no>
diff
changeset
|
68 `selective-display', and `vertical-border'."
|
13199
|
69 (let ((slot-number
|
|
70 (if (numberp slot) slot
|
|
71 (or (get slot 'display-table-slot)
|
|
72 (error "Invalid display-table slot name: %s" slot)))))
|
|
73 (set-char-table-extra-slot display-table slot-number value)))
|
13164
|
74
|
|
75 ;;;###autoload
|
2072
|
76 (defun describe-display-table (dt)
|
584
|
77 "Describe the display table DT in a help buffer."
|
36
|
78 (with-output-to-temp-buffer "*Help*"
|
696
|
79 (princ "\nTruncation glyph: ")
|
13199
|
80 (prin1 (display-table-slot dt 'truncation))
|
696
|
81 (princ "\nWrap glyph: ")
|
13199
|
82 (prin1 (display-table-slot dt 'wrap))
|
696
|
83 (princ "\nEscape glyph: ")
|
13199
|
84 (prin1 (display-table-slot dt 'escape))
|
696
|
85 (princ "\nCtrl glyph: ")
|
13199
|
86 (prin1 (display-table-slot dt 'control))
|
2628
|
87 (princ "\nSelective display glyph sequence: ")
|
13199
|
88 (prin1 (display-table-slot dt 'selective-display))
|
8920
|
89 (princ "\nVertical window border glyph: ")
|
13199
|
90 (prin1 (display-table-slot dt 'vertical-border))
|
2628
|
91 (princ "\nCharacter display glyph sequences:\n")
|
4936
|
92 (save-excursion
|
|
93 (set-buffer standard-output)
|
|
94 (let ((vector (make-vector 256 nil))
|
|
95 (i 0))
|
|
96 (while (< i 256)
|
|
97 (aset vector i (aref dt i))
|
|
98 (setq i (1+ i)))
|
9856
|
99 (describe-vector vector))
|
|
100 (help-mode))
|
36
|
101 (print-help-return-message)))
|
|
102
|
2072
|
103 ;;;###autoload
|
36
|
104 (defun describe-current-display-table ()
|
4936
|
105 "Describe the display table in use in the selected window and buffer."
|
|
106 (interactive)
|
13164
|
107 (let ((disptab (or (window-display-table (selected-window))
|
|
108 buffer-display-table
|
|
109 standard-display-table)))
|
4936
|
110 (if disptab
|
|
111 (describe-display-table disptab)
|
|
112 (message "No display table"))))
|
36
|
113
|
2072
|
114 ;;;###autoload
|
36
|
115 (defun standard-display-8bit (l h)
|
584
|
116 "Display characters in the range L to H literally."
|
52948
|
117 (or standard-display-table
|
|
118 (setq standard-display-table (make-display-table)))
|
36
|
119 (while (<= l h)
|
54432
|
120 (aset standard-display-table l (if (or (< l ?\ ) (>= l 127)) (vector l)))
|
36
|
121 (setq l (1+ l))))
|
|
122
|
2072
|
123 ;;;###autoload
|
3033
|
124 (defun standard-display-default (l h)
|
|
125 "Display characters in the range L to H using the default notation."
|
52948
|
126 (or standard-display-table
|
|
127 (setq standard-display-table (make-display-table)))
|
3033
|
128 (while (<= l h)
|
31157
|
129 (if (and (>= l ?\ ) (char-valid-p l))
|
|
130 (aset standard-display-table l nil))
|
3033
|
131 (setq l (1+ l))))
|
|
132
|
10435
|
133 ;; This function does NOT take terminal-dependent escape sequences.
|
|
134 ;; For that, you need to go through create-glyph. Use one of the
|
|
135 ;; other functions below, or roll your own.
|
13164
|
136 ;;;###autoload
|
36
|
137 (defun standard-display-ascii (c s)
|
10435
|
138 "Display character C using printable string S."
|
52948
|
139 (or standard-display-table
|
|
140 (setq standard-display-table (make-display-table)))
|
13164
|
141 (aset standard-display-table c (vconcat s)))
|
36
|
142
|
2072
|
143 ;;;###autoload
|
36
|
144 (defun standard-display-g1 (c sc)
|
6418
|
145 "Display character C as character SC in the g1 character set.
|
|
146 This function assumes that your terminal uses the SO/SI characters;
|
|
147 it is meaningless for an X frame."
|
66274
8e3aeb72b4d2
(standard-display-g1, standard-display-graphic): Refuse to use string
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
148 (if (memq window-system '(x w32 mac))
|
6418
|
149 (error "Cannot use string glyphs in a windowing system"))
|
52948
|
150 (or standard-display-table
|
|
151 (setq standard-display-table (make-display-table)))
|
36
|
152 (aset standard-display-table c
|
2523
|
153 (vector (create-glyph (concat "\016" (char-to-string sc) "\017")))))
|
36
|
154
|
2072
|
155 ;;;###autoload
|
36
|
156 (defun standard-display-graphic (c gc)
|
6418
|
157 "Display character C as character GC in graphics character set.
|
|
158 This function assumes VT100-compatible escapes; it is meaningless for an
|
|
159 X frame."
|
66274
8e3aeb72b4d2
(standard-display-g1, standard-display-graphic): Refuse to use string
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
160 (if (memq window-system '(x w32 mac))
|
6418
|
161 (error "Cannot use string glyphs in a windowing system"))
|
52948
|
162 (or standard-display-table
|
|
163 (setq standard-display-table (make-display-table)))
|
36
|
164 (aset standard-display-table c
|
2523
|
165 (vector (create-glyph (concat "\e(0" (char-to-string gc) "\e(B")))))
|
36
|
166
|
2072
|
167 ;;;###autoload
|
36
|
168 (defun standard-display-underline (c uc)
|
|
169 "Display character C as character UC plus underlining."
|
52948
|
170 (or standard-display-table
|
|
171 (setq standard-display-table (make-display-table)))
|
36
|
172 (aset standard-display-table c
|
49588
|
173 (vector
|
6418
|
174 (if window-system
|
29249
|
175 (logior uc (lsh (face-id 'underline) 19))
|
6418
|
176 (create-glyph (concat "\e[4m" (char-to-string uc) "\e[m"))))))
|
36
|
177
|
2072
|
178 ;;;###autoload
|
696
|
179 (defun create-glyph (string)
|
29510
|
180 "Allocate a glyph code to display by sending STRING to the terminal."
|
696
|
181 (if (= (length glyph-table) 65536)
|
|
182 (error "No free glyph codes remain"))
|
6417
|
183 ;; Don't use slots that correspond to ASCII characters.
|
|
184 (if (= (length glyph-table) 32)
|
|
185 (setq glyph-table (vconcat glyph-table (make-vector 224 nil))))
|
696
|
186 (setq glyph-table (vconcat glyph-table (list string)))
|
|
187 (1- (length glyph-table)))
|
36
|
188
|
3061
|
189 ;;;###autoload
|
26124
ee67b2340a0f
* disp-table.el (standard-display-european): Remove undocumented
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
190 (defun standard-display-european (arg)
|
24813
|
191 "Semi-obsolete way to toggle display of ISO 8859 European characters.
|
24116
|
192
|
24813
|
193 This function is semi-obsolete; if you want to do your editing with
|
|
194 unibyte characters, it is better to `set-language-environment' coupled
|
|
195 with either the `--unibyte' option or the EMACS_UNIBYTE environment
|
|
196 variable, or else customize `enable-multibyte-characters'.
|
|
197
|
|
198 With prefix argument, this command enables European character display
|
|
199 if arg is positive, disables it otherwise. Otherwise, it toggles
|
|
200 European character display.
|
22008
|
201
|
24813
|
202 When this mode is enabled, characters in the range of 160 to 255
|
|
203 display not as octal escapes, but as accented characters. Codes 146
|
|
204 and 160 display as apostrophe and space, even though they are not the
|
|
205 ASCII codes for apostrophe and space.
|
19850
|
206
|
24813
|
207 Enabling European character display with this command noninteractively
|
|
208 from Lisp code also selects Latin-1 as the language environment, and
|
|
209 selects unibyte mode for all Emacs buffers \(both existing buffers and
|
|
210 those created subsequently). This provides increased compatibility
|
|
211 for users who call this function in `.emacs'."
|
19618
|
212
|
7830
|
213 (if (or (<= (prefix-numeric-value arg) 0)
|
3061
|
214 (and (null arg)
|
13164
|
215 (char-table-p standard-display-table)
|
13822
|
216 ;; Test 161, because 160 displays as a space.
|
13794
|
217 (equal (aref standard-display-table 161) [161])))
|
19814
|
218 (progn
|
|
219 (standard-display-default 160 255)
|
66274
8e3aeb72b4d2
(standard-display-g1, standard-display-graphic): Refuse to use string
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
220 (unless (or (memq window-system '(x w32 mac)))
|
24813
|
221 (and (terminal-coding-system)
|
|
222 (set-terminal-coding-system nil))))
|
65366
|
223
|
|
224 (display-warning 'i18n
|
67284
f5f54b3e0a2f
(standard-display-european): Add to the warning message a reference to the
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
225 "`standard-display-european' is semi-obsolete; see its doc string for details"
|
65366
|
226 :warning)
|
41781
|
227
|
|
228 ;; Switch to Latin-1 language environment
|
21855
|
229 ;; unless some other has been specified.
|
41781
|
230 (if (equal current-language-environment "English")
|
|
231 (set-language-environment "latin-1"))
|
66760
5aeef369b96e
(standard-display-european): Apply changes previously mentioned but
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
232 (unless (or noninteractive (memq window-system '(x w32 mac)))
|
26124
ee67b2340a0f
* disp-table.el (standard-display-european): Remove undocumented
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
233 ;; Send those codes literally to a character-based terminal.
|
ee67b2340a0f
* disp-table.el (standard-display-european): Remove undocumented
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
234 ;; If we are using single-byte characters,
|
ee67b2340a0f
* disp-table.el (standard-display-european): Remove undocumented
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
235 ;; it doesn't matter which coding system we use.
|
19920
1d832fd69760
(standard-display-european): Do something useful where AUTO is t or a symbol.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
236 (set-terminal-coding-system
|
26124
ee67b2340a0f
* disp-table.el (standard-display-european): Remove undocumented
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
237 (let ((c (intern (downcase current-language-environment))))
|
ee67b2340a0f
* disp-table.el (standard-display-european): Remove undocumented
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
238 (if (coding-system-p c) c 'latin-1))))
|
21855
|
239 (standard-display-european-internal)))
|
3033
|
240
|
36
|
241 (provide 'disp-table)
|
662
|
242
|
52401
|
243 ;;; arch-tag: ffe4c28c-960c-47aa-b8a8-ae89d371ffc7
|
662
|
244 ;;; disp-table.el ends here
|