Mercurial > emacs

comparison lisp/disp-table.el @ 696:904853a03d9a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
*** empty log message ***
author Richard M. Stallman <rms@gnu.org>
date Sun, 07 Jun 1992 04:20:03 +0000
parents 8a533acedb77
children 4f28bd14272c
comparison
equal deleted inserted replaced
695:e3fac20d3015 696:904853a03d9a
17 ;; You should have received a copy of the GNU General Public License 17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs; see the file COPYING. If not, write to 18 ;; along with GNU Emacs; see the file COPYING. If not, write to
19 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 19 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
20 20
21 21
22 ;; Written by Howard Gayle. See case-table.el for details. 22 ;; Written by Howard Gayle.
23
24 (require 'case-table)
25 23
26 (defun rope-to-vector (rope) 24 (defun rope-to-vector (rope)
27 (let* ((len (/ (length rope) 2)) 25 (let* ((len (/ (length rope) 2))
28 (vector (make-vector len nil)) 26 (vector (make-vector len nil))
29 (i 0)) 27 (i 0))
32 (setq i (1+ i))))) 30 (setq i (1+ i)))))
33 31
34 (defun describe-display-table (DT) 32 (defun describe-display-table (DT)
35 "Describe the display table DT in a help buffer." 33 "Describe the display table DT in a help buffer."
36 (with-output-to-temp-buffer "*Help*" 34 (with-output-to-temp-buffer "*Help*"
37 (princ "\nTruncation glyf: ") 35 (princ "\nTruncation glyph: ")
38 (prin1 (aref dt 256)) 36 (prin1 (aref dt 256))
39 (princ "\nWrap glyf: ") 37 (princ "\nWrap glyph: ")
40 (prin1 (aref dt 257)) 38 (prin1 (aref dt 257))
41 (princ "\nEscape glyf: ") 39 (princ "\nEscape glyph: ")
42 (prin1 (aref dt 258)) 40 (prin1 (aref dt 258))
43 (princ "\nCtrl glyf: ") 41 (princ "\nCtrl glyph: ")
44 (prin1 (aref dt 259)) 42 (prin1 (aref dt 259))
45 (princ "\nSelective display rope: ") 43 (princ "\nSelective display rope: ")
46 (prin1 (rope-to-vector (aref dt 260))) 44 (prin1 (rope-to-vector (aref dt 260)))
47 (princ "\nCharacter display ropes:\n") 45 (princ "\nCharacter display ropes:\n")
48 (let ((vector (make-vector 256 nil)) 46 (let ((vector (make-vector 256 nil))
86 (defun standard-display-g1 (c sc) 84 (defun standard-display-g1 (c sc)
87 "Display character C as character SC in the g1 character set." 85 "Display character C as character SC in the g1 character set."
88 (or standard-display-table 86 (or standard-display-table
89 (setq standard-display-table (make-vector 261 nil))) 87 (setq standard-display-table (make-vector 261 nil)))
90 (aset standard-display-table c 88 (aset standard-display-table c
91 (make-rope (create-glyf (concat "\016" (char-to-string sc) "\017"))))) 89 (make-rope (create-glyph (concat "\016" (char-to-string sc) "\017")))))
92 90
93 (defun standard-display-graphic (c gc) 91 (defun standard-display-graphic (c gc)
94 "Display character C as character GC in graphics character set." 92 "Display character C as character GC in graphics character set."
95 (or standard-display-table 93 (or standard-display-table
96 (setq standard-display-table (make-vector 261 nil))) 94 (setq standard-display-table (make-vector 261 nil)))
97 (aset standard-display-table c 95 (aset standard-display-table c
98 (make-rope (create-glyf (concat "\e(0" (char-to-string gc) "\e(B"))))) 96 (make-rope (create-glyph (concat "\e(0" (char-to-string gc) "\e(B")))))
99 97
100 (defun standard-display-underline (c uc) 98 (defun standard-display-underline (c uc)
101 "Display character C as character UC plus underlining." 99 "Display character C as character UC plus underlining."
102 (or standard-display-table 100 (or standard-display-table
103 (setq standard-display-table (make-vector 261 nil))) 101 (setq standard-display-table (make-vector 261 nil)))
104 (aset standard-display-table c 102 (aset standard-display-table c
105 (make-rope (create-glyf (concat "\e[4m" (char-to-string uc) "\e[m"))))) 103 (make-rope (create-glyph (concat "\e[4m" (char-to-string uc) "\e[m")))))
106 104
107 (defun create-glyf (string) 105 ;; Allocate a glyph code to display by sending STRING to the terminal.
108 (let ((i 256)) 106 (defun create-glyph (string)
109 (while (and (< i 65536) (aref glyf-table i) 107 (if (= (length glyph-table) 65536)
110 (not (string= (aref glyf-table i) string))) 108 (error "No free glyph codes remain"))
111 (setq i (1+ i))) 109 (setq glyph-table (vconcat glyph-table (list string)))
112 (if (= i 65536) 110 (1- (length glyph-table)))
113 (error "No free glyf codes remain"))
114 (aset glyf-table i string)))
115 111
116 (provide 'disp-table) 112 (provide 'disp-table)
117 113
118 ;;; disp-table.el ends here 114 ;;; disp-table.el ends here