Mercurial > hg > xemacs-beta

annotate lisp/disp-table.el @ 5117:3742ea8250b5 ben-lisp-object ben-lisp-object-final-ws-year-2005

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Checking in final CVS version of workspace 'ben-lisp-object'
author Ben Wing <ben@xemacs.org>
date Sat, 26 Dec 2009 00:20:27 -0600
parents 262b8bb4a523
children e0db3c197671
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
219
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
1 ;;; disp-table.el --- functions for dealing with char tables.
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
2
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
3 ;; Copyright (C) 1987, 1994, 1997 Free Software Foundation, Inc.
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
4 ;; Copyright (C) 1995 Sun Microsystems.
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
5 ;; Copyright (C) 2005 Ben Wing.
219
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
6
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
7 ;; Maintainer: XEmacs Development Team
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
8 ;; Keywords: i18n, internal
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
9
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
10 ;; This file is part of XEmacs.
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
11
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
12 ;; XEmacs is free software; you can redistribute it and/or modify it
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
13 ;; under the terms of the GNU General Public License as published by
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
14 ;; the Free Software Foundation; either version 2, or (at your option)
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
15 ;; any later version.
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
16
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
17 ;; XEmacs is distributed in the hope that it will be useful, but
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
20 ;; General Public License for more details.
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
21
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
22 ;; You should have received a copy of the GNU General Public License
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
23 ;; along with XEmacs; see the file COPYING. If not, write to the
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
24 ;; Free Software Foundation, 59 Temple Place - Suite 330,
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
25 ;; Boston, MA 02111-1307, USA.
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
26
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
27 ;;; Synched up with: Not synched with FSF.
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
28
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
29 ;;; Commentary:
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
30
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
31 ;; #### Needs work.
219
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
32
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
33 ;; Rewritten for XEmacs July 1995, Ben Wing.
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
34 ;; November 1998?, display tables generalized to char/range tables, Hrvoje
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
35 ;; Niksic.
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
36 ;; February 2005, rewrite this file to handle generalized display tables,
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
37 ;; Ben Wing.
219
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
38
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
39 ;;; Code:
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
40
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
41 (defun describe-display-table (dt)
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
42 "Describe the display table DT in a help buffer."
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
43 (with-displaying-help-buffer
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
44 (lambda ()
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
45 (princ "\nCharacter display glyph sequences:\n")
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
46 (flet ((describe-display-table-entry
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
47 (entry stream)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
48 ;; #### Write better version
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
49 (princ entry stream))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
50 (describe-display-table-range
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
51 (first last entry)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
52 (if (eq first last)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
53 (princ (format "%s\t\t"
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
54 (single-key-description (int-char first))))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
55 (let ((str (format "%s - %s"
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
56 (single-key-description (int-char first))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
57 (single-key-description (int-char last)))))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
58 (princ str)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
59 (princ (make-string (max (- 2 (/ (length str)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
60 tab-width)) 1) ?\t))))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
61 (describe-display-table-entry entry standard-output)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
62 (terpri)))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
63 (cond ((vectorp dt)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
64 (save-excursion
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
65 (let ((vector (make-vector 256 nil))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
66 (i 0))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
67 (while (< i 256)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
68 (aset vector i (aref dt i))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
69 (incf i))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
70 ;; FSF calls `describe-vector' here, but it is so incredibly
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
71 ;; lame a function for that name that I cannot bring myself
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
72 ;; to port it. Here is what `describe-vector' does:
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
73 (terpri)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
74 (let ((old (aref vector 0))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
75 (oldpos 0)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
76 (i 1))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
77 (while (<= i 256)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
78 (when (or (= i 256)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
79 (not (equal old (aref vector i))))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
80 (describe-display-table-range oldpos (1- i) old)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
81 (or (= i 256)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
82 (setq old (aref vector i)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
83 oldpos i)))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
84 (incf i))))))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
85 ((char-table-p dt)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
86 (describe-char-table dt 'map-char-table
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
87 'describe-display-table-entry
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
88 standard-output))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
89 ((range-table-p dt)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
90 (map-range-table
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
91 #'(lambda (beg end value)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
92 (describe-display-table-range beg end value))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
93 dt)))))))
219
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
94
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
95 ;;;###autoload
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
96 (defun describe-current-display-table (&optional domain)
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
97 "Describe the display table in use in the selected window and buffer."
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
98 (interactive)
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
99 (or domain (setq domain (selected-window)))
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
100 (let ((disptab (specifier-instance current-display-table domain)))
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
101 (if disptab
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
102 (describe-display-table disptab)
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
103 (message "No display table"))))
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
104
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
105 ;;;###autoload
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
106 (defun make-display-table ()
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
107 "Return a new, empty display table.
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
108 Modify a display table using `put-display-table'. Look up in display tables
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
109 using `get-display-table'. The exact format of display tables and their
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
110 specs is described in `current-display-table'."
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
111 ;; #### This should do something smarter.
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
112 ;; #### Should use range table but there are bugs in range table and
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
113 ;; perhaps in callers not expecting this.
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
114 ;(make-range-table 'start-closed-end-closed)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
115 ;(make-vector 256 nil)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
116 ;; #### Should be type `display-table'
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
117 (make-char-table 'generic))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
118
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
119 (defun display-table-p (object)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
120 "Return t if OBJECT is a display table.
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
121 See `make-display-table'."
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
122 (or (and (vectorp object) (= (length object) 256))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
123 (and (char-table-p object) (memq (char-table-type object)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
124 '(char generic display)))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
125 (range-table-p object)))
219
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
126
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
127 ;; #### we need a generic frob-specifier function.
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
128 ;; #### this also needs to be redone like frob-face-property.
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
129
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
130 ;; Let me say one more time how much dynamic scoping sucks.
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
131
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
132 ;; #### Need more thinking about basic primitives for modifying a specifier.
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
133 ;; cf `modify-specifier-instances'.
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
134
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
135 (defun frob-display-table (fdt-function fdt-locale &optional tag-set)
219
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
136 (or fdt-locale (setq fdt-locale 'global))
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
137 (or (specifier-spec-list current-display-table fdt-locale tag-set)
219
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
138 (add-spec-to-specifier current-display-table (make-display-table)
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
139 fdt-locale tag-set))
219
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
140 (add-spec-list-to-specifier
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
141 current-display-table
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
142 (list (cons fdt-locale
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
143 (mapcar
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
144 (lambda (fdt-x)
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
145 (funcall fdt-function (cdr fdt-x))
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
146 fdt-x)
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
147 (cdar (specifier-spec-list current-display-table
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
148 fdt-locale tag-set)))))))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
149
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
150 (defun put-display-table-range (l h spec display-table)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
151 "Display characters in range L .. H, inclusive, in DISPLAY-TABLE using SPEC.
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
152 Display tables are described in `current-display-table'."
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
153 (check-argument-type 'display-table-p display-table)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
154 (cond ((vectorp display-table)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
155 (while (<= l h)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
156 (aset display-table l spec)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
157 (setq l (1+ l))))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
158 ((char-table-p display-table)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
159 (while (<= l h)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
160 (put-char-table l spec display-table)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
161 (setq l (1+ l))))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
162 ((range-table-p display-table)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
163 (put-range-table l h spec display-table))))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
164
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
165 (defun put-display-table (ch spec display-table)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
166 "Display character spec CH in DISPLAY-TABLE using SPEC.
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
167 CH can be a character, a charset, or t for all characters.
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
168 Display tables are described in `current-display-table'."
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
169 (cond ((eq ch t)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
170 (cond ((vectorp display-table)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
171 (put-display-table-range 0 (1- (length display-table)) spec
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
172 display-table))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
173 ((range-table-p display-table)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
174 ; major hack
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
175 (put-display-table-range 0 (string-to-int "3FFFFFFF" 16)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
176 spec display-table))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
177 ((char-table-p display-table)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
178 (put-char-table t spec display-table))))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
179 ((charsetp ch)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
180 (cond ((vectorp display-table)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
181 ;; #### fix
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
182 nil)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
183 ((range-table-p display-table)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
184 ;; #### fix
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
185 nil)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
186 ((char-table-p display-table)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
187 (put-char-table ch spec display-table))))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
188 (t (put-display-table-range ch ch spec display-table))))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
189
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
190 (defun get-display-table (char display-table)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
191 "Return SPEC of CHAR in DISPLAY-TABLE.
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
192 See `current-display-table'."
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
193 (check-argument-type 'display-table-p display-table)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
194 (cond ((vectorp display-table)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
195 (aref display-table char))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
196 ((char-table-p display-table)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
197 (get-char-table char display-table))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
198 ((range-table-p display-table)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
199 (get-range-table char display-table))))
219
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
200
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
201 (defun standard-display-8bit-1 (dt l h)
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
202 (while (<= l h)
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
203 (put-display-table l (char-to-string l) dt)
219
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
204 (setq l (1+ l))))
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
205
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
206 ;;;###autoload
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
207 (defun standard-display-8bit (l h &optional locale)
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
208 "Display characters in the range L to H literally."
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
209 (frob-display-table
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
210 (lambda (x)
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
211 (standard-display-8bit-1 x l h))
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
212 locale))
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
213
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
214 (defun standard-display-default-1 (dt l h)
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
215 (while (<= l h)
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
216 (put-display-table l nil dt)
219
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
217 (setq l (1+ l))))
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
218
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
219 ;;;###autoload
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
220 (defun standard-display-default (l h &optional locale)
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
221 "Display characters in the range L to H using the default notation."
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
222 (frob-display-table
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
223 (lambda (x)
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
224 (standard-display-default-1 x l h))
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
225 locale))
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
226
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
227 ;;;###autoload
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
228 (defun standard-display-ascii (c s &optional locale)
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
229 "Display character C using printable string S."
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
230 (frob-display-table
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
231 (lambda (x)
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
232 (put-display-table c s x))
219
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
233 locale))
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
234
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
235 ;;;###autoload
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
236 (defun standard-display-g1 (c sc &optional locale)
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
237 "Display character C as character SC in the g1 character set.
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
238 This only has an effect on TTY devices and assumes that your terminal uses
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
239 the SO/SI characters."
219
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
240 (frob-display-table
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
241 (lambda (x)
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
242 (put-display-table c (concat "\016" (char-to-string sc) "\017") x))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
243 locale
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
244 'tty))
219
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
245
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
246 ;;;###autoload
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
247 (defun standard-display-graphic (c gc &optional locale)
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
248 "Display character C as character GC in graphics character set.
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
249 This only has an effect on TTY devices and assumes VT100-compatible escapes."
219
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
250 (frob-display-table
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
251 (lambda (x)
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
252 (put-display-table c (concat "\e(0" (char-to-string gc) "\e(B") x))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
253 locale
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
254 'tty))
219
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
255
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
256 ;;; #### the FSF equivalent of this makes this character be displayed
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
257 ;;; in the 'underline face. There's no current way to do this with
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
258 ;;; XEmacs display tables.
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
259
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
260 ;;;###autoload
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
261 (defun standard-display-underline (c uc &optional locale)
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
262 "Display character C as character UC plus underlining."
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
263 (frob-display-table
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
264 (lambda (x)
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
265 (put-display-table c (concat "\e[4m" (char-to-string uc) "\e[m") x))
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
266 locale
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
267 'tty))
219
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
268
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
269 ;;;###autoload
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
270 (defun standard-display-european (arg &optional locale)
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
271 "Toggle display of European characters encoded with ISO 8859.
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
272 When enabled, characters in the range of 160 to 255 display not
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
273 as octal escapes, but as accented characters.
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
274 With prefix argument, enable European character display iff arg is positive."
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
275 (interactive "P")
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
276 (frob-display-table
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
277 (lambda (x)
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
278 (if (or (<= (prefix-numeric-value arg) 0)
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
279 (and (null arg)
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 219
diff changeset
280 (equal (get-display-table 160 x) (char-to-string 160))))
219
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
281 (standard-display-default-1 x 160 255)
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
282 (standard-display-8bit-1 x 160 255)))
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
283 locale))
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
284
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
285 (provide 'disp-table)
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
286
262b8bb4a523 Import from CVS: tag r20-4b8
cvs
parents:
diff changeset
287 ;;; disp-table.el ends here