Mercurial > emacs
annotate lisp/disp-table.el @ 5991:6ad8db6dc039
(gnu_bits): Use unsigned char.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Fri, 18 Feb 1994 06:28:50 +0000 |
parents | 35e9402cb6bf |
children | 81e96cd91613 |
rev | line source |
---|---|
662
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
1 ;;; disp-table.el --- functions for dealing with char tables. |
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
2 |
845 | 3 ;; Copyright (C) 1987 Free Software Foundation, Inc. |
4 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
696
diff
changeset
|
5 ;; Author: Howard Gayle |
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
696
diff
changeset
|
6 ;; Maintainer: FSF |
3012
d4b85bbedee8
Change "i14n" keyword to "i18n".
Jim Blandy <jimb@redhat.com>
parents:
2628
diff
changeset
|
7 ;; Keywords: i18n |
36 | 8 |
9 ;; This file is part of GNU Emacs. | |
10 | |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
696
diff
changeset
|
13 ;; the Free Software Foundation; either version 2, or (at your option) |
36 | 14 ;; any later version. |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
24 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
696
diff
changeset
|
25 ;;; Code: |
36 | 26 |
2072 | 27 (defun describe-display-table (dt) |
584 | 28 "Describe the display table DT in a help buffer." |
36 | 29 (with-output-to-temp-buffer "*Help*" |
696
904853a03d9a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
662
diff
changeset
|
30 (princ "\nTruncation glyph: ") |
36 | 31 (prin1 (aref dt 256)) |
696
904853a03d9a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
662
diff
changeset
|
32 (princ "\nWrap glyph: ") |
36 | 33 (prin1 (aref dt 257)) |
696
904853a03d9a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
662
diff
changeset
|
34 (princ "\nEscape glyph: ") |
36 | 35 (prin1 (aref dt 258)) |
696
904853a03d9a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
662
diff
changeset
|
36 (princ "\nCtrl glyph: ") |
36 | 37 (prin1 (aref dt 259)) |
2628
6b17fe69a82f
* disp-table.el (describe-display-table): Don't use the term
Jim Blandy <jimb@redhat.com>
parents:
2523
diff
changeset
|
38 (princ "\nSelective display glyph sequence: ") |
2072 | 39 (prin1 (aref dt 260)) |
2628
6b17fe69a82f
* disp-table.el (describe-display-table): Don't use the term
Jim Blandy <jimb@redhat.com>
parents:
2523
diff
changeset
|
40 (princ "\nCharacter display glyph sequences:\n") |
4936
35e9402cb6bf
(describe-current-display-table):
Richard M. Stallman <rms@gnu.org>
parents:
3061
diff
changeset
|
41 (save-excursion |
35e9402cb6bf
(describe-current-display-table):
Richard M. Stallman <rms@gnu.org>
parents:
3061
diff
changeset
|
42 (set-buffer standard-output) |
35e9402cb6bf
(describe-current-display-table):
Richard M. Stallman <rms@gnu.org>
parents:
3061
diff
changeset
|
43 (let ((vector (make-vector 256 nil)) |
35e9402cb6bf
(describe-current-display-table):
Richard M. Stallman <rms@gnu.org>
parents:
3061
diff
changeset
|
44 (i 0)) |
35e9402cb6bf
(describe-current-display-table):
Richard M. Stallman <rms@gnu.org>
parents:
3061
diff
changeset
|
45 (while (< i 256) |
35e9402cb6bf
(describe-current-display-table):
Richard M. Stallman <rms@gnu.org>
parents:
3061
diff
changeset
|
46 (aset vector i (aref dt i)) |
35e9402cb6bf
(describe-current-display-table):
Richard M. Stallman <rms@gnu.org>
parents:
3061
diff
changeset
|
47 (setq i (1+ i))) |
35e9402cb6bf
(describe-current-display-table):
Richard M. Stallman <rms@gnu.org>
parents:
3061
diff
changeset
|
48 (describe-vector vector))) |
36 | 49 (print-help-return-message))) |
50 | |
2072 | 51 ;;;###autoload |
36 | 52 (defun describe-current-display-table () |
4936
35e9402cb6bf
(describe-current-display-table):
Richard M. Stallman <rms@gnu.org>
parents:
3061
diff
changeset
|
53 "Describe the display table in use in the selected window and buffer." |
35e9402cb6bf
(describe-current-display-table):
Richard M. Stallman <rms@gnu.org>
parents:
3061
diff
changeset
|
54 (interactive) |
35e9402cb6bf
(describe-current-display-table):
Richard M. Stallman <rms@gnu.org>
parents:
3061
diff
changeset
|
55 (let ((disptab |
35e9402cb6bf
(describe-current-display-table):
Richard M. Stallman <rms@gnu.org>
parents:
3061
diff
changeset
|
56 (or (window-display-table (selected-window)) |
35e9402cb6bf
(describe-current-display-table):
Richard M. Stallman <rms@gnu.org>
parents:
3061
diff
changeset
|
57 buffer-display-table |
35e9402cb6bf
(describe-current-display-table):
Richard M. Stallman <rms@gnu.org>
parents:
3061
diff
changeset
|
58 standard-display-table))) |
35e9402cb6bf
(describe-current-display-table):
Richard M. Stallman <rms@gnu.org>
parents:
3061
diff
changeset
|
59 (if disptab |
35e9402cb6bf
(describe-current-display-table):
Richard M. Stallman <rms@gnu.org>
parents:
3061
diff
changeset
|
60 (describe-display-table disptab) |
35e9402cb6bf
(describe-current-display-table):
Richard M. Stallman <rms@gnu.org>
parents:
3061
diff
changeset
|
61 (message "No display table")))) |
36 | 62 |
2072 | 63 ;;;###autoload |
36 | 64 (defun make-display-table () |
2072 | 65 "Return a new, empty display table." |
36 | 66 (make-vector 261 nil)) |
67 | |
2072 | 68 ;;;###autoload |
36 | 69 (defun standard-display-8bit (l h) |
584 | 70 "Display characters in the range L to H literally." |
36 | 71 (while (<= l h) |
72 (if (and (>= l ?\ ) (< l 127)) | |
73 (if standard-display-table (aset standard-display-table l nil)) | |
74 (or standard-display-table | |
75 (setq standard-display-table (make-vector 261 nil))) | |
2628
6b17fe69a82f
* disp-table.el (describe-display-table): Don't use the term
Jim Blandy <jimb@redhat.com>
parents:
2523
diff
changeset
|
76 (aset standard-display-table l (vector l))) |
36 | 77 (setq l (1+ l)))) |
78 | |
2072 | 79 ;;;###autoload |
3033
8bf84289be17
* disp-table.el (standard-display-default): New function.
Jim Blandy <jimb@redhat.com>
parents:
3012
diff
changeset
|
80 (defun standard-display-default (l h) |
8bf84289be17
* disp-table.el (standard-display-default): New function.
Jim Blandy <jimb@redhat.com>
parents:
3012
diff
changeset
|
81 "Display characters in the range L to H using the default notation." |
8bf84289be17
* disp-table.el (standard-display-default): New function.
Jim Blandy <jimb@redhat.com>
parents:
3012
diff
changeset
|
82 (while (<= l h) |
8bf84289be17
* disp-table.el (standard-display-default): New function.
Jim Blandy <jimb@redhat.com>
parents:
3012
diff
changeset
|
83 (if (and (>= l ?\ ) (< l 127)) |
8bf84289be17
* disp-table.el (standard-display-default): New function.
Jim Blandy <jimb@redhat.com>
parents:
3012
diff
changeset
|
84 (if standard-display-table (aset standard-display-table l nil)) |
8bf84289be17
* disp-table.el (standard-display-default): New function.
Jim Blandy <jimb@redhat.com>
parents:
3012
diff
changeset
|
85 (or standard-display-table |
8bf84289be17
* disp-table.el (standard-display-default): New function.
Jim Blandy <jimb@redhat.com>
parents:
3012
diff
changeset
|
86 (setq standard-display-table (make-vector 261 nil))) |
8bf84289be17
* disp-table.el (standard-display-default): New function.
Jim Blandy <jimb@redhat.com>
parents:
3012
diff
changeset
|
87 (aset standard-display-table l nil)) |
8bf84289be17
* disp-table.el (standard-display-default): New function.
Jim Blandy <jimb@redhat.com>
parents:
3012
diff
changeset
|
88 (setq l (1+ l)))) |
8bf84289be17
* disp-table.el (standard-display-default): New function.
Jim Blandy <jimb@redhat.com>
parents:
3012
diff
changeset
|
89 |
8bf84289be17
* disp-table.el (standard-display-default): New function.
Jim Blandy <jimb@redhat.com>
parents:
3012
diff
changeset
|
90 ;;;###autoload |
36 | 91 (defun standard-display-ascii (c s) |
92 "Display character C using string S." | |
93 (or standard-display-table | |
94 (setq standard-display-table (make-vector 261 nil))) | |
2523
76685b00c607
Use `vector', not `make-rope'.
Richard M. Stallman <rms@gnu.org>
parents:
2072
diff
changeset
|
95 (aset standard-display-table c (apply 'vector (append s nil)))) |
36 | 96 |
2072 | 97 ;;;###autoload |
36 | 98 (defun standard-display-g1 (c sc) |
99 "Display character C as character SC in the g1 character set." | |
100 (or standard-display-table | |
101 (setq standard-display-table (make-vector 261 nil))) | |
102 (aset standard-display-table c | |
2523
76685b00c607
Use `vector', not `make-rope'.
Richard M. Stallman <rms@gnu.org>
parents:
2072
diff
changeset
|
103 (vector (create-glyph (concat "\016" (char-to-string sc) "\017"))))) |
36 | 104 |
2072 | 105 ;;;###autoload |
36 | 106 (defun standard-display-graphic (c gc) |
107 "Display character C as character GC in graphics character set." | |
108 (or standard-display-table | |
109 (setq standard-display-table (make-vector 261 nil))) | |
110 (aset standard-display-table c | |
2523
76685b00c607
Use `vector', not `make-rope'.
Richard M. Stallman <rms@gnu.org>
parents:
2072
diff
changeset
|
111 (vector (create-glyph (concat "\e(0" (char-to-string gc) "\e(B"))))) |
36 | 112 |
2072 | 113 ;;;###autoload |
36 | 114 (defun standard-display-underline (c uc) |
115 "Display character C as character UC plus underlining." | |
116 (or standard-display-table | |
117 (setq standard-display-table (make-vector 261 nil))) | |
118 (aset standard-display-table c | |
2523
76685b00c607
Use `vector', not `make-rope'.
Richard M. Stallman <rms@gnu.org>
parents:
2072
diff
changeset
|
119 (vector (create-glyph (concat "\e[4m" (char-to-string uc) "\e[m"))))) |
36 | 120 |
696
904853a03d9a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
662
diff
changeset
|
121 ;; Allocate a glyph code to display by sending STRING to the terminal. |
2072 | 122 ;;;###autoload |
696
904853a03d9a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
662
diff
changeset
|
123 (defun create-glyph (string) |
904853a03d9a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
662
diff
changeset
|
124 (if (= (length glyph-table) 65536) |
904853a03d9a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
662
diff
changeset
|
125 (error "No free glyph codes remain")) |
904853a03d9a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
662
diff
changeset
|
126 (setq glyph-table (vconcat glyph-table (list string))) |
904853a03d9a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
662
diff
changeset
|
127 (1- (length glyph-table))) |
36 | 128 |
3061
1e0f5fb4fcf1
* disp-table.el (standard-display-european): Doc fix. Make
Jim Blandy <jimb@redhat.com>
parents:
3033
diff
changeset
|
129 ;;;###autoload |
3033
8bf84289be17
* disp-table.el (standard-display-default): New function.
Jim Blandy <jimb@redhat.com>
parents:
3012
diff
changeset
|
130 (defun standard-display-european (arg) |
3061
1e0f5fb4fcf1
* disp-table.el (standard-display-european): Doc fix. Make
Jim Blandy <jimb@redhat.com>
parents:
3033
diff
changeset
|
131 "Toggle display of European characters encoded with ISO 8859. |
1e0f5fb4fcf1
* disp-table.el (standard-display-european): Doc fix. Make
Jim Blandy <jimb@redhat.com>
parents:
3033
diff
changeset
|
132 When enabled, characters in the range of 160 to 255 display not |
1e0f5fb4fcf1
* disp-table.el (standard-display-european): Doc fix. Make
Jim Blandy <jimb@redhat.com>
parents:
3033
diff
changeset
|
133 as octal escapes, but as accented characters. |
1e0f5fb4fcf1
* disp-table.el (standard-display-european): Doc fix. Make
Jim Blandy <jimb@redhat.com>
parents:
3033
diff
changeset
|
134 With prefix argument, enable European character display iff arg is positive." |
3033
8bf84289be17
* disp-table.el (standard-display-default): New function.
Jim Blandy <jimb@redhat.com>
parents:
3012
diff
changeset
|
135 (interactive "P") |
3061
1e0f5fb4fcf1
* disp-table.el (standard-display-european): Doc fix. Make
Jim Blandy <jimb@redhat.com>
parents:
3033
diff
changeset
|
136 (if (or (< (prefix-numeric-value arg) 0) |
1e0f5fb4fcf1
* disp-table.el (standard-display-european): Doc fix. Make
Jim Blandy <jimb@redhat.com>
parents:
3033
diff
changeset
|
137 (and (null arg) |
1e0f5fb4fcf1
* disp-table.el (standard-display-european): Doc fix. Make
Jim Blandy <jimb@redhat.com>
parents:
3033
diff
changeset
|
138 (vectorp standard-display-table) |
1e0f5fb4fcf1
* disp-table.el (standard-display-european): Doc fix. Make
Jim Blandy <jimb@redhat.com>
parents:
3033
diff
changeset
|
139 (>= (length standard-display-table) 161) |
1e0f5fb4fcf1
* disp-table.el (standard-display-european): Doc fix. Make
Jim Blandy <jimb@redhat.com>
parents:
3033
diff
changeset
|
140 (equal (aref standard-display-table 160) [160]))) |
1e0f5fb4fcf1
* disp-table.el (standard-display-european): Doc fix. Make
Jim Blandy <jimb@redhat.com>
parents:
3033
diff
changeset
|
141 (standard-display-default 160 255) |
3033
8bf84289be17
* disp-table.el (standard-display-default): New function.
Jim Blandy <jimb@redhat.com>
parents:
3012
diff
changeset
|
142 (standard-display-8bit 160 255))) |
8bf84289be17
* disp-table.el (standard-display-default): New function.
Jim Blandy <jimb@redhat.com>
parents:
3012
diff
changeset
|
143 |
36 | 144 (provide 'disp-table) |
662
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
145 |
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
146 ;;; disp-table.el ends here |