Mercurial > emacs
annotate lisp/disp-table.el @ 8765:77933f36ddc2
(mouse-save-then-kill, mouse-secondary-save-then-kill): Use the kill-new
interface; don't manipulate kill-ring directly.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Thu, 15 Sep 1994 21:51:14 +0000 |
parents | 1f9ae5be19a2 |
children | 45e6d5476e7f |
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 |
7300 | 3 ;; Copyright (C) 1987, 1994 Free Software Foundation, Inc. |
845 | 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) |
6418
43dea22be493
(standard-display-ascii): Error if using a windowing system.
Karl Heuer <kwzh@gnu.org>
parents:
6417
diff
changeset
|
92 "Display character C using string S. |
43dea22be493
(standard-display-ascii): Error if using a windowing system.
Karl Heuer <kwzh@gnu.org>
parents:
6417
diff
changeset
|
93 S is usually a terminal-dependent escape sequence. |
43dea22be493
(standard-display-ascii): Error if using a windowing system.
Karl Heuer <kwzh@gnu.org>
parents:
6417
diff
changeset
|
94 This function is meaningless for an X frame." |
43dea22be493
(standard-display-ascii): Error if using a windowing system.
Karl Heuer <kwzh@gnu.org>
parents:
6417
diff
changeset
|
95 (if window-system |
43dea22be493
(standard-display-ascii): Error if using a windowing system.
Karl Heuer <kwzh@gnu.org>
parents:
6417
diff
changeset
|
96 (error "Cannot use string glyphs in a windowing system")) |
36 | 97 (or standard-display-table |
98 (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
|
99 (aset standard-display-table c (apply 'vector (append s nil)))) |
36 | 100 |
2072 | 101 ;;;###autoload |
36 | 102 (defun standard-display-g1 (c sc) |
6418
43dea22be493
(standard-display-ascii): Error if using a windowing system.
Karl Heuer <kwzh@gnu.org>
parents:
6417
diff
changeset
|
103 "Display character C as character SC in the g1 character set. |
43dea22be493
(standard-display-ascii): Error if using a windowing system.
Karl Heuer <kwzh@gnu.org>
parents:
6417
diff
changeset
|
104 This function assumes that your terminal uses the SO/SI characters; |
43dea22be493
(standard-display-ascii): Error if using a windowing system.
Karl Heuer <kwzh@gnu.org>
parents:
6417
diff
changeset
|
105 it is meaningless for an X frame." |
43dea22be493
(standard-display-ascii): Error if using a windowing system.
Karl Heuer <kwzh@gnu.org>
parents:
6417
diff
changeset
|
106 (if window-system |
43dea22be493
(standard-display-ascii): Error if using a windowing system.
Karl Heuer <kwzh@gnu.org>
parents:
6417
diff
changeset
|
107 (error "Cannot use string glyphs in a windowing system")) |
36 | 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 "\016" (char-to-string sc) "\017"))))) |
36 | 112 |
2072 | 113 ;;;###autoload |
36 | 114 (defun standard-display-graphic (c gc) |
6418
43dea22be493
(standard-display-ascii): Error if using a windowing system.
Karl Heuer <kwzh@gnu.org>
parents:
6417
diff
changeset
|
115 "Display character C as character GC in graphics character set. |
43dea22be493
(standard-display-ascii): Error if using a windowing system.
Karl Heuer <kwzh@gnu.org>
parents:
6417
diff
changeset
|
116 This function assumes VT100-compatible escapes; it is meaningless for an |
43dea22be493
(standard-display-ascii): Error if using a windowing system.
Karl Heuer <kwzh@gnu.org>
parents:
6417
diff
changeset
|
117 X frame." |
43dea22be493
(standard-display-ascii): Error if using a windowing system.
Karl Heuer <kwzh@gnu.org>
parents:
6417
diff
changeset
|
118 (if window-system |
43dea22be493
(standard-display-ascii): Error if using a windowing system.
Karl Heuer <kwzh@gnu.org>
parents:
6417
diff
changeset
|
119 (error "Cannot use string glyphs in a windowing system")) |
36 | 120 (or standard-display-table |
121 (setq standard-display-table (make-vector 261 nil))) | |
122 (aset standard-display-table c | |
2523
76685b00c607
Use `vector', not `make-rope'.
Richard M. Stallman <rms@gnu.org>
parents:
2072
diff
changeset
|
123 (vector (create-glyph (concat "\e(0" (char-to-string gc) "\e(B"))))) |
36 | 124 |
2072 | 125 ;;;###autoload |
36 | 126 (defun standard-display-underline (c uc) |
127 "Display character C as character UC plus underlining." | |
6418
43dea22be493
(standard-display-ascii): Error if using a windowing system.
Karl Heuer <kwzh@gnu.org>
parents:
6417
diff
changeset
|
128 (if window-system (require 'faces)) |
36 | 129 (or standard-display-table |
130 (setq standard-display-table (make-vector 261 nil))) | |
131 (aset standard-display-table c | |
6418
43dea22be493
(standard-display-ascii): Error if using a windowing system.
Karl Heuer <kwzh@gnu.org>
parents:
6417
diff
changeset
|
132 (vector |
43dea22be493
(standard-display-ascii): Error if using a windowing system.
Karl Heuer <kwzh@gnu.org>
parents:
6417
diff
changeset
|
133 (if window-system |
43dea22be493
(standard-display-ascii): Error if using a windowing system.
Karl Heuer <kwzh@gnu.org>
parents:
6417
diff
changeset
|
134 (logior uc (lsh (face-id (internal-find-face 'underline)) 8)) |
43dea22be493
(standard-display-ascii): Error if using a windowing system.
Karl Heuer <kwzh@gnu.org>
parents:
6417
diff
changeset
|
135 (create-glyph (concat "\e[4m" (char-to-string uc) "\e[m")))))) |
36 | 136 |
696
904853a03d9a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
662
diff
changeset
|
137 ;; Allocate a glyph code to display by sending STRING to the terminal. |
2072 | 138 ;;;###autoload |
696
904853a03d9a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
662
diff
changeset
|
139 (defun create-glyph (string) |
904853a03d9a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
662
diff
changeset
|
140 (if (= (length glyph-table) 65536) |
904853a03d9a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
662
diff
changeset
|
141 (error "No free glyph codes remain")) |
6417
81e96cd91613
(create-glyph): Don't use slots that look like ASCII.
Karl Heuer <kwzh@gnu.org>
parents:
4936
diff
changeset
|
142 ;; Don't use slots that correspond to ASCII characters. |
81e96cd91613
(create-glyph): Don't use slots that look like ASCII.
Karl Heuer <kwzh@gnu.org>
parents:
4936
diff
changeset
|
143 (if (= (length glyph-table) 32) |
81e96cd91613
(create-glyph): Don't use slots that look like ASCII.
Karl Heuer <kwzh@gnu.org>
parents:
4936
diff
changeset
|
144 (setq glyph-table (vconcat glyph-table (make-vector 224 nil)))) |
696
904853a03d9a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
662
diff
changeset
|
145 (setq glyph-table (vconcat glyph-table (list string))) |
904853a03d9a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
662
diff
changeset
|
146 (1- (length glyph-table))) |
36 | 147 |
3061
1e0f5fb4fcf1
* disp-table.el (standard-display-european): Doc fix. Make
Jim Blandy <jimb@redhat.com>
parents:
3033
diff
changeset
|
148 ;;;###autoload |
3033
8bf84289be17
* disp-table.el (standard-display-default): New function.
Jim Blandy <jimb@redhat.com>
parents:
3012
diff
changeset
|
149 (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
|
150 "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
|
151 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
|
152 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
|
153 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
|
154 (interactive "P") |
7830
1f9ae5be19a2
(standard-display-european): Treat 0 arg like negative.
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
155 (if (or (<= (prefix-numeric-value arg) 0) |
3061
1e0f5fb4fcf1
* disp-table.el (standard-display-european): Doc fix. Make
Jim Blandy <jimb@redhat.com>
parents:
3033
diff
changeset
|
156 (and (null arg) |
1e0f5fb4fcf1
* disp-table.el (standard-display-european): Doc fix. Make
Jim Blandy <jimb@redhat.com>
parents:
3033
diff
changeset
|
157 (vectorp standard-display-table) |
1e0f5fb4fcf1
* disp-table.el (standard-display-european): Doc fix. Make
Jim Blandy <jimb@redhat.com>
parents:
3033
diff
changeset
|
158 (>= (length standard-display-table) 161) |
1e0f5fb4fcf1
* disp-table.el (standard-display-european): Doc fix. Make
Jim Blandy <jimb@redhat.com>
parents:
3033
diff
changeset
|
159 (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
|
160 (standard-display-default 160 255) |
3033
8bf84289be17
* disp-table.el (standard-display-default): New function.
Jim Blandy <jimb@redhat.com>
parents:
3012
diff
changeset
|
161 (standard-display-8bit 160 255))) |
8bf84289be17
* disp-table.el (standard-display-default): New function.
Jim Blandy <jimb@redhat.com>
parents:
3012
diff
changeset
|
162 |
36 | 163 (provide 'disp-table) |
662
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
164 |
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
165 ;;; disp-table.el ends here |