1 ;;; disp-table.el --- functions for dealing with char tables.
3 ;; Copyright (C) 1987, 1994, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Sun Microsystems.
6 ;; Author: Howard Gayle
7 ;; Maintainer: SXEmacs Development Team
8 ;; Keywords: i18n, internal
10 ;; This file is part of SXEmacs.
12 ;; SXEmacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; SXEmacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
25 ;;; Synched up with: Not synched with FSF.
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
33 ;; #### display-tables-as-vectors is really evil and a big pain in
36 ;; Rewritten for XEmacs July 1995, Ben Wing.
41 (defun describe-display-table (dt)
42 "Describe the display table DT in a help buffer."
43 (with-displaying-help-buffer
45 (princ "\nCharacter display glyph sequences:\n")
47 (let ((vector (make-vector 256 nil))
50 (aset vector i (aref dt 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:
56 (let ((old (aref vector 0))
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))
67 (setq str (format "%s - %s"
68 (single-key-description (int-char oldpos))
69 (single-key-description (int-char (1- i)))))
71 (princ (make-string (max (- 2 (/ (length str)
76 (setq old (aref vector i)
81 (defun describe-current-display-table (&optional domain)
82 "Describe the display table in use in the selected window and buffer."
84 (or domain (setq domain (selected-window)))
85 (let ((disptab (specifier-instance current-display-table domain)))
87 (describe-display-table disptab)
88 (message "No display table"))))
91 (defun make-display-table ()
92 "Return a new, empty display table."
93 (make-vector 256 nil))
95 ;; #### we need a generic frob-specifier function.
96 ;; #### this also needs to be redone like frob-face-property.
98 ;; Let me say one more time how much dynamic scoping sucks.
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)
105 (add-spec-list-to-specifier
106 current-display-table
107 (list (cons fdt-locale
110 (funcall fdt-function (cdr fdt-x))
112 (cdar (specifier-spec-list current-display-table
115 (defun standard-display-8bit-1 (dt l h)
117 (aset dt l (char-to-string l))
121 (defun standard-display-8bit (l h &optional locale)
122 "Display characters in the range L to H literally."
125 (standard-display-8bit-1 x l h))
128 (defun standard-display-default-1 (dt l h)
134 (defun standard-display-default (l h &optional locale)
135 "Display characters in the range L to H using the default notation."
138 (standard-display-default-1 x l h))
142 (defun standard-display-ascii (c s &optional locale)
143 "Display character C using printable string S."
150 ;;; #### should frob in a 'tty locale.
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."
159 (aset x c (concat "\016" (char-to-string sc) "\017")))
163 ;;; #### should frob in a 'tty locale.
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
172 (aset x c (concat "\e(0" (char-to-string gc) "\e(B")))
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.
181 (defun standard-display-underline (c uc &optional locale)
182 "Display character C as character UC plus underlining."
185 (aset x c (concat "\e[4m" (char-to-string uc) "\e[m")))
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."
197 (if (or (<= (prefix-numeric-value arg) 0)
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)))
204 (provide 'disp-table)
206 ;;; disp-table.el ends here