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