Mercurial > hg > xemacs-beta

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children 0293115a14e9
comparison
equal deleted inserted replaced
1:c0c6a60d29db 2:ac2d302a0011
37 ;;; Code: 37 ;;; Code:
38 38
39 (defun describe-display-table (dt) 39 (defun describe-display-table (dt)
40 "Describe the display table DT in a help buffer." 40 "Describe the display table DT in a help buffer."
41 (with-displaying-help-buffer 41 (with-displaying-help-buffer
42 (princ "\nCharacter display glyph sequences:\n") 42 (lambda ()
43 (save-excursion 43 (princ "\nCharacter display glyph sequences:\n")
44 (set-buffer standard-output) 44 (save-excursion
45 (let ((vector (make-vector 256 nil)) 45 (set-buffer standard-output)
46 (i 0)) 46 (let ((vector (make-vector 256 nil))
47 (while (< i 256) 47 (i 0))
48 (aset vector i (aref dt i)) 48 (while (< i 256)
49 (setq i (1+ i))) 49 (aset vector i (aref dt i))
50 (describe-vector vector))))) 50 (setq i (1+ i)))
51 ;;; ### No such function `describe-vector'...
52 (describe-vector vector))))))
51 53
52 ;;;###autoload 54 ;;;###autoload
53 (defun describe-current-display-table (&optional domain) 55 (defun describe-current-display-table (&optional domain)
54 "Describe the display table in use in the selected window and buffer." 56 "Describe the display table in use in the selected window and buffer."
55 (interactive) 57 (interactive)
76 fdt-locale)) 78 fdt-locale))
77 (add-spec-list-to-specifier 79 (add-spec-list-to-specifier
78 current-display-table 80 current-display-table
79 (list (cons fdt-locale 81 (list (cons fdt-locale
80 (mapcar 82 (mapcar
81 #'(lambda (fdt-x) 83 (lambda (fdt-x)
82 (funcall fdt-function (cdr fdt-x)) 84 (funcall fdt-function (cdr fdt-x))
83 fdt-x) 85 fdt-x)
84 (cdar (specifier-spec-list current-display-table 86 (cdar (specifier-spec-list current-display-table
85 fdt-locale))))))) 87 fdt-locale)))))))
86 88
87 (defun standard-display-8bit-1 (dt l h) 89 (defun standard-display-8bit-1 (dt l h)
88 (while (<= l h) 90 (while (<= l h)
91 93
92 ;;;###autoload 94 ;;;###autoload
93 (defun standard-display-8bit (l h &optional locale) 95 (defun standard-display-8bit (l h &optional locale)
94 "Display characters in the range L to H literally." 96 "Display characters in the range L to H literally."
95 (frob-display-table 97 (frob-display-table
96 #'(lambda (x) 98 (lambda (x)
97 (standard-display-8bit-1 x l h)) 99 (standard-display-8bit-1 x l h))
98 locale)) 100 locale))
99 101
100 (defun standard-display-default-1 (dt l h) 102 (defun standard-display-default-1 (dt l h)
101 (while (<= l h) 103 (while (<= l h)
102 (aset dt l nil) 104 (aset dt l nil)
104 106
105 ;;;###autoload 107 ;;;###autoload
106 (defun standard-display-default (l h &optional locale) 108 (defun standard-display-default (l h &optional locale)
107 "Display characters in the range L to H using the default notation." 109 "Display characters in the range L to H using the default notation."
108 (frob-display-table 110 (frob-display-table
109 #'(lambda (x) 111 (lambda (x)
110 (standard-display-default-1 x l h)) 112 (standard-display-default-1 x l h))
111 locale)) 113 locale))
112 114
113 ;;;###autoload 115 ;;;###autoload
114 (defun standard-display-ascii (c s &optional locale) 116 (defun standard-display-ascii (c s &optional locale)
115 "Display character C using printable string S." 117 "Display character C using printable string S."
116 (frob-display-table 118 (frob-display-table
117 #'(lambda (x) 119 (lambda (x)
118 (aset x c s)) 120 (aset x c s))
119 locale)) 121 locale))
120 122
121 123
122 ;;; #### should frob in a 'tty locale. 124 ;;; #### should frob in a 'tty locale.
123 125
125 (defun standard-display-g1 (c sc &optional locale) 127 (defun standard-display-g1 (c sc &optional locale)
126 "Display character C as character SC in the g1 character set. 128 "Display character C as character SC in the g1 character set.
127 This function assumes that your terminal uses the SO/SI characters; 129 This function assumes that your terminal uses the SO/SI characters;
128 it is meaningless for an X frame." 130 it is meaningless for an X frame."
129 (frob-display-table 131 (frob-display-table
130 #'(lambda (x) 132 (lambda (x)
131 (aset x c (concat "\016" (char-to-string sc) "\017"))) 133 (aset x c (concat "\016" (char-to-string sc) "\017")))
132 locale)) 134 locale))
133 135
134 136
135 ;;; #### should frob in a 'tty locale. 137 ;;; #### should frob in a 'tty locale.
136 138
138 (defun standard-display-graphic (c gc &optional locale) 140 (defun standard-display-graphic (c gc &optional locale)
139 "Display character C as character GC in graphics character set. 141 "Display character C as character GC in graphics character set.
140 This function assumes VT100-compatible escapes; it is meaningless for an 142 This function assumes VT100-compatible escapes; it is meaningless for an
141 X frame." 143 X frame."
142 (frob-display-table 144 (frob-display-table
143 #'(lambda (x) 145 (lambda (x)
144 (aset x c (concat "\e(0" (char-to-string gc) "\e(B"))) 146 (aset x c (concat "\e(0" (char-to-string gc) "\e(B")))
145 locale)) 147 locale))
146 148
147 ;;; #### should frob in a 'tty locale. 149 ;;; #### should frob in a 'tty locale.
148 ;;; #### the FSF equivalent of this makes this character be displayed 150 ;;; #### the FSF equivalent of this makes this character be displayed
149 ;;; in the 'underline face. There's no current way to do this with 151 ;;; in the 'underline face. There's no current way to do this with
151 153
152 ;;;###autoload 154 ;;;###autoload
153 (defun standard-display-underline (c uc &optional locale) 155 (defun standard-display-underline (c uc &optional locale)
154 "Display character C as character UC plus underlining." 156 "Display character C as character UC plus underlining."
155 (frob-display-table 157 (frob-display-table
156 #'(lambda (x) 158 (lambda (x)
157 (aset x c (concat "\e[4m" (char-to-string uc) "\e[m"))) 159 (aset x c (concat "\e[4m" (char-to-string uc) "\e[m")))
158 locale)) 160 locale))
159 161
160 ;;;###autoload 162 ;;;###autoload
161 (defun standard-display-european (arg &optional locale) 163 (defun standard-display-european (arg &optional locale)
162 "Toggle display of European characters encoded with ISO 8859. 164 "Toggle display of European characters encoded with ISO 8859.
163 When enabled, characters in the range of 160 to 255 display not 165 When enabled, characters in the range of 160 to 255 display not
164 as octal escapes, but as accented characters. 166 as octal escapes, but as accented characters.
165 With prefix argument, enable European character display iff arg is positive." 167 With prefix argument, enable European character display iff arg is positive."
166 (interactive "P") 168 (interactive "P")
167 (frob-display-table 169 (frob-display-table
168 #'(lambda (x) 170 (lambda (x)
169 (if (or (<= (prefix-numeric-value arg) 0) 171 (if (or (<= (prefix-numeric-value arg) 0)
170 (and (null arg) 172 (and (null arg)
171 (equal (aref x 160) (char-to-string 160)))) 173 (equal (aref x 160) (char-to-string 160))))
172 (standard-display-default-1 x 160 255) 174 (standard-display-default-1 x 160 255)
173 (standard-display-8bit-1 x 160 255))) 175 (standard-display-8bit-1 x 160 255)))
174 locale)) 176 locale))
175 177
176 (provide 'disp-table) 178 (provide 'disp-table)
177 179
178 ;;; disp-table.el ends here 180 ;;; disp-table.el ends here