aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1992-06-07 04:20:03 +0000
committerRichard M. Stallman1992-06-07 04:20:03 +0000
commit031317994b0d9f02e3e5dfd06a6385479e197dfe (patch)
tree3e18861affbd126f7d62cba1d7073f24dfac8263
parent464f88989ff0c5ce1ec228eaf178091bc1f591b8 (diff)
downloademacs-031317994b0d9f02e3e5dfd06a6385479e197dfe.tar.gz
emacs-031317994b0d9f02e3e5dfd06a6385479e197dfe.zip
*** empty log message ***
-rw-r--r--lisp/case-table.el46
-rw-r--r--lisp/disp-table.el34
2 files changed, 30 insertions, 50 deletions
diff --git a/lisp/case-table.el b/lisp/case-table.el
index bb35c1e8913..bdc109675ba 100644
--- a/lisp/case-table.el
+++ b/lisp/case-table.el
@@ -45,29 +45,13 @@
45 (with-output-to-temp-buffer "*Help*" 45 (with-output-to-temp-buffer "*Help*"
46 (describe-vector vector))) 46 (describe-vector vector)))
47 47
48(defun invert-case (count) 48(defun set-case-syntax-delims (l r string)
49 "Change the case of the character just after point and move over it.
50With prefix arg, applies to that many chars.
51Negative arg inverts characters before point but does not move."
52 (interactive "p")
53 (if (< count 0)
54 (progn (setq count (min (1- (point)) (- count)))
55 (forward-char (- count))))
56 (while (> count 0)
57 (let ((oc (following-char))) ; Old character.
58 (cond ((/= (upcase ch) ch)
59 (replace-char (upcase ch)))
60 ((/= (downcase ch) ch)
61 (replace-char (downcase ch)))))
62 (forward-char 1)
63 (setq count (1- count))))
64
65(defun set-case-syntax-delims (l r table)
66 "Make characters L and R a matching pair of non-case-converting delimiters. 49 "Make characters L and R a matching pair of non-case-converting delimiters.
67Sets the entries for L and R in `standard-case-table', `standard-syntax-table', 50Sets the entries for L and R in STRING, which is a downcasing table.
68and `text-mode-syntax-table' to indicate left and right delimiters." 51Also modifies `standard-syntax-table', and `text-mode-syntax-table' to
69 (aset (car table) l l) 52indicate left and right delimiters."
70 (aset (car table) r r) 53 (aset string l l)
54 (aset string r r)
71 (modify-syntax-entry l (concat "(" (char-to-string r) " ") 55 (modify-syntax-entry l (concat "(" (char-to-string r) " ")
72 (standard-syntax-table)) 56 (standard-syntax-table))
73 (modify-syntax-entry l (concat "(" (char-to-string r) " ") 57 (modify-syntax-entry l (concat "(" (char-to-string r) " ")
@@ -77,24 +61,24 @@ and `text-mode-syntax-table' to indicate left and right delimiters."
77 (modify-syntax-entry r (concat ")" (char-to-string l) " ") 61 (modify-syntax-entry r (concat ")" (char-to-string l) " ")
78 text-mode-syntax-table)) 62 text-mode-syntax-table))
79 63
80(defun set-case-syntax-pair (uc lc table) 64(defun set-case-syntax-pair (uc lc string)
81 "Make characters UC and LC a pair of inter-case-converting letters. 65 "Make characters UC and LC a pair of inter-case-converting letters.
82Sets the entries for characters UC and LC in `standard-case-table', 66Sets the entries for characters UC and LC in STRING, which is a downcasing table.
83`standard-syntax-table' and `text-mode-syntax-table' to indicate an 67Also modify `standard-syntax-table' and `text-mode-syntax-table' to indicate an
84(uppercase, lowercase) pair of letters." 68(uppercase, lowercase) pair of letters."
85 69 (aset string uc lc)
86 (aset (car table) uc lc) 70 (aset (car (cdr (standard-case-table))) lc uc)
87 (modify-syntax-entry lc "w " (standard-syntax-table)) 71 (modify-syntax-entry lc "w " (standard-syntax-table))
88 (modify-syntax-entry lc "w " text-mode-syntax-table) 72 (modify-syntax-entry lc "w " text-mode-syntax-table)
89 (modify-syntax-entry uc "w " (standard-syntax-table)) 73 (modify-syntax-entry uc "w " (standard-syntax-table))
90 (modify-syntax-entry uc "w " text-mode-syntax-table)) 74 (modify-syntax-entry uc "w " text-mode-syntax-table))
91 75
92(defun set-case-syntax (c syntax table) 76(defun set-case-syntax (c syntax string)
93 "Make characters C case-invariant with syntax SYNTAX. 77 "Make characters C case-invariant with syntax SYNTAX.
94Sets the entries for character C in `standard-case-table', 78Sets the entries for character C in STRING, which is the downcasing table.
95`standard-syntax-table' and `text-mode-syntax-table' to indicate this. 79Also modify `standard-syntax-table' and `text-mode-syntax-table'.
96SYNTAX should be \" \", \"w\", \".\" or \"_\"." 80SYNTAX should be \" \", \"w\", \".\" or \"_\"."
97 (aset (car table) c c) 81 (aset string c c)
98 (modify-syntax-entry c syntax (standard-syntax-table)) 82 (modify-syntax-entry c syntax (standard-syntax-table))
99 (modify-syntax-entry c syntax text-mode-syntax-table)) 83 (modify-syntax-entry c syntax text-mode-syntax-table))
100 84
diff --git a/lisp/disp-table.el b/lisp/disp-table.el
index d0f0ec03899..9b275cbca0f 100644
--- a/lisp/disp-table.el
+++ b/lisp/disp-table.el
@@ -19,9 +19,7 @@
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))
@@ -34,13 +32,13 @@
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)))
@@ -88,30 +86,28 @@
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