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