Mercurial > hg > xemacs-beta

comparison lisp/prim/disp-table.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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
7 ;; Maintainer: FSF
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
23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
24 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
25
26 ;;; Synched up with: Not synched with FSF.
27
28 ;;; #### Need lots of work. make-display-table depends on a value
29 ;;; that is a define in the C code. Maybe we should just move the
30 ;;; function into C.
31
32 ;;; #### display-tables-as-vectors is really evil and a big pain in
33 ;;; the ass.
34
35 ;;; Rewritten for XEmacs July 1995, Ben Wing.
36
37 ;;; Code:
38
39 (defun describe-display-table (dt)
40 "Describe the display table DT in a help buffer."
41 (with-displaying-help-buffer
42 (princ "\nCharacter display glyph sequences:\n")
43 (save-excursion
44 (set-buffer standard-output)
45 (let ((vector (make-vector 256 nil))
46 (i 0))
47 (while (< i 256)
48 (aset vector i (aref dt i))
49 (setq i (1+ i)))
50 (describe-vector vector)))))
51
52 ;;;###autoload
53 (defun describe-current-display-table (&optional domain)
54 "Describe the display table in use in the selected window and buffer."
55 (interactive)
56 (or domain (setq domain (selected-window)))
57 (let ((disptab (specifier-instance current-display-table domain)))
58 (if disptab
59 (describe-display-table disptab)
60 (message "No display table"))))
61
62 ;;;###autoload
63 (defun make-display-table ()
64 "Return a new, empty display table."
65 (make-vector 256 nil))
66
67 ;; #### we need a generic frob-specifier function.
68 ;; #### this also needs to be redone like frob-face-property.
69
70 ;; Let me say one more time how much dynamic scoping sucks.
71
72 (defun frob-display-table (fdt-function fdt-locale)
73 (or fdt-locale (setq fdt-locale 'global))
74 (or (specifier-spec-list current-display-table fdt-locale)
75 (add-spec-to-specifier current-display-table (make-display-table)
76 fdt-locale))
77 (add-spec-list-to-specifier
78 current-display-table
79 (list (cons fdt-locale
80 (mapcar
81 #'(lambda (fdt-x)
82 (funcall fdt-function (cdr fdt-x))
83 fdt-x)
84 (cdar (specifier-spec-list current-display-table
85 fdt-locale)))))))
86
87 (defun standard-display-8bit-1 (dt l h)
88 (while (<= l h)
89 (aset dt l (char-to-string l))
90 (setq l (1+ l))))
91
92 ;;;###autoload
93 (defun standard-display-8bit (l h &optional locale)
94 "Display characters in the range L to H literally."
95 (frob-display-table
96 #'(lambda (x)
97 (standard-display-8bit-1 x l h))
98 locale))
99
100 (defun standard-display-default-1 (dt l h)
101 (while (<= l h)
102 (aset dt l nil)
103 (setq l (1+ l))))
104
105 ;;;###autoload
106 (defun standard-display-default (l h &optional locale)
107 "Display characters in the range L to H using the default notation."
108 (frob-display-table
109 #'(lambda (x)
110 (standard-display-default-1 x l h))
111 locale))
112
113 ;;;###autoload
114 (defun standard-display-ascii (c s &optional locale)
115 "Display character C using printable string S."
116 (frob-display-table
117 #'(lambda (x)
118 (aset x c s))
119 locale))
120
121
122 ;;; #### should frob in a 'tty locale.
123
124 ;;;###autoload
125 (defun standard-display-g1 (c sc &optional locale)
126 "Display character C as character SC in the g1 character set.
127 This function assumes that your terminal uses the SO/SI characters;
128 it is meaningless for an X frame."
129 (frob-display-table
130 #'(lambda (x)
131 (aset x c (concat "\016" (char-to-string sc) "\017")))
132 locale))
133
134
135 ;;; #### should frob in a 'tty locale.
136
137 ;;;###autoload
138 (defun standard-display-graphic (c gc &optional locale)
139 "Display character C as character GC in graphics character set.
140 This function assumes VT100-compatible escapes; it is meaningless for an
141 X frame."
142 (frob-display-table
143 #'(lambda (x)
144 (aset x c (concat "\e(0" (char-to-string gc) "\e(B")))
145 locale))
146
147 ;;; #### should frob in a 'tty locale.
148 ;;; #### the FSF equivalent of this makes this character be displayed
149 ;;; in the 'underline face. There's no current way to do this with
150 ;;; XEmacs display tables.
151
152 ;;;###autoload
153 (defun standard-display-underline (c uc &optional locale)
154 "Display character C as character UC plus underlining."
155 (frob-display-table
156 #'(lambda (x)
157 (aset x c (concat "\e[4m" (char-to-string uc) "\e[m")))
158 locale))
159
160 ;;;###autoload
161 (defun standard-display-european (arg &optional locale)
162 "Toggle display of European characters encoded with ISO 8859.
163 When enabled, characters in the range of 160 to 255 display not
164 as octal escapes, but as accented characters.
165 With prefix argument, enable European character display iff arg is positive."
166 (interactive "P")
167 (frob-display-table
168 #'(lambda (x)
169 (if (or (<= (prefix-numeric-value arg) 0)
170 (and (null arg)
171 (equal (aref x 160) (char-to-string 160))))
172 (standard-display-default-1 x 160 255)
173 (standard-display-8bit-1 x 160 255)))
174 locale))
175
176 (provide 'disp-table)
177
178 ;;; disp-table.el ends here