changeset 696:904853a03d9a

*** empty log message ***
author Richard M. Stallman <rms@gnu.org>
date Sun, 07 Jun 1992 04:20:03 +0000
parents e3fac20d3015
children 6dd85fc4fb2c
files lisp/case-table.el lisp/disp-table.el
diffstat 2 files changed, 29 insertions(+), 49 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/case-table.el	Sun Jun 07 02:36:01 1992 +0000
+++ b/lisp/case-table.el	Sun Jun 07 04:20:03 1992 +0000
@@ -45,29 +45,13 @@
   (with-output-to-temp-buffer "*Help*"
     (describe-vector vector)))
 
-(defun invert-case (count)
-  "Change the case of the character just after point and move over it.
-With prefix arg, applies to that many chars.
-Negative arg inverts characters before point but does not move."
-  (interactive "p")
-  (if (< count 0)
-      (progn (setq count (min (1- (point)) (- count)))
-	     (forward-char (- count))))
-  (while (> count 0)
-    (let ((oc (following-char)))		; Old character.
-      (cond ((/= (upcase ch) ch)
-	     (replace-char (upcase ch)))
-	    ((/= (downcase ch) ch)
-	     (replace-char (downcase ch)))))
-    (forward-char 1)
-    (setq count (1- count))))
-
-(defun set-case-syntax-delims (l r table)
+(defun set-case-syntax-delims (l r string)
   "Make characters L and R a matching pair of non-case-converting delimiters.
-Sets the entries for L and R in `standard-case-table', `standard-syntax-table',
-and `text-mode-syntax-table' to indicate left and right delimiters."
-  (aset (car table) l l)
-  (aset (car table) r r)
+Sets the entries for L and R in STRING, which is a downcasing table.
+Also modifies `standard-syntax-table', and `text-mode-syntax-table' to
+indicate left and right delimiters."
+  (aset string l l)
+  (aset string r r)
   (modify-syntax-entry l (concat "(" (char-to-string r) "  ")
 		       (standard-syntax-table))
   (modify-syntax-entry l (concat "(" (char-to-string r) "  ")
@@ -77,24 +61,24 @@
   (modify-syntax-entry r (concat ")" (char-to-string l) "  ")
 		       text-mode-syntax-table))
 
-(defun set-case-syntax-pair (uc lc table)
+(defun set-case-syntax-pair (uc lc string)
   "Make characters UC and LC a pair of inter-case-converting letters.
-Sets the entries for characters UC and LC in `standard-case-table',
-`standard-syntax-table' and `text-mode-syntax-table' to indicate an
+Sets the entries for characters UC and LC in STRING, which is a downcasing table.
+Also modify `standard-syntax-table' and `text-mode-syntax-table' to indicate an
 (uppercase, lowercase) pair of letters."
-
-  (aset (car table) uc lc)
+  (aset string uc lc)
+  (aset (car (cdr (standard-case-table))) lc uc)
   (modify-syntax-entry lc "w   " (standard-syntax-table))
   (modify-syntax-entry lc "w   " text-mode-syntax-table)
   (modify-syntax-entry uc "w   " (standard-syntax-table))
   (modify-syntax-entry uc "w   " text-mode-syntax-table))
 
-(defun set-case-syntax (c syntax table)
+(defun set-case-syntax (c syntax string)
   "Make characters C case-invariant with syntax SYNTAX.
-Sets the entries for character C in `standard-case-table',
-`standard-syntax-table' and `text-mode-syntax-table' to indicate this.
+Sets the entries for character C in STRING, which is the downcasing table.
+Also modify `standard-syntax-table' and `text-mode-syntax-table'.
 SYNTAX should be \" \", \"w\", \".\" or \"_\"."
-  (aset (car table) c c)
+  (aset string c c)
   (modify-syntax-entry c syntax (standard-syntax-table))
   (modify-syntax-entry c syntax text-mode-syntax-table))
 
--- a/lisp/disp-table.el	Sun Jun 07 02:36:01 1992 +0000
+++ b/lisp/disp-table.el	Sun Jun 07 04:20:03 1992 +0000
@@ -19,9 +19,7 @@
 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-;; Written by Howard Gayle.  See case-table.el for details.
-
-(require 'case-table)
+;; Written by Howard Gayle.
 
 (defun rope-to-vector (rope)
   (let* ((len (/ (length rope) 2))
@@ -34,13 +32,13 @@
 (defun describe-display-table (DT)
   "Describe the display table DT in a help buffer."
   (with-output-to-temp-buffer "*Help*"
-    (princ "\nTruncation glyf: ")
+    (princ "\nTruncation glyph: ")
     (prin1 (aref dt 256))
-    (princ "\nWrap glyf: ")
+    (princ "\nWrap glyph: ")
     (prin1 (aref dt 257))
-    (princ "\nEscape glyf: ")
+    (princ "\nEscape glyph: ")
     (prin1 (aref dt 258))
-    (princ "\nCtrl glyf: ")
+    (princ "\nCtrl glyph: ")
     (prin1 (aref dt 259))
     (princ "\nSelective display rope: ")
     (prin1 (rope-to-vector (aref dt 260)))
@@ -88,30 +86,28 @@
   (or standard-display-table
       (setq standard-display-table (make-vector 261 nil)))
   (aset standard-display-table c
-	(make-rope (create-glyf (concat "\016" (char-to-string sc) "\017")))))
+	(make-rope (create-glyph (concat "\016" (char-to-string sc) "\017")))))
 
 (defun standard-display-graphic (c gc)
   "Display character C as character GC in graphics character set."
   (or standard-display-table
       (setq standard-display-table (make-vector 261 nil)))
   (aset standard-display-table c
-	(make-rope (create-glyf (concat "\e(0" (char-to-string gc) "\e(B")))))
+	(make-rope (create-glyph (concat "\e(0" (char-to-string gc) "\e(B")))))
 
 (defun standard-display-underline (c uc)
   "Display character C as character UC plus underlining."
   (or standard-display-table
       (setq standard-display-table (make-vector 261 nil)))
   (aset standard-display-table c
-	(make-rope (create-glyf (concat "\e[4m" (char-to-string uc) "\e[m")))))
+	(make-rope (create-glyph (concat "\e[4m" (char-to-string uc) "\e[m")))))
 
-(defun create-glyf (string)
-  (let ((i 256))
-    (while (and (< i 65536) (aref glyf-table i)
-		(not (string= (aref glyf-table i) string)))
-      (setq i (1+ i)))
-    (if (= i 65536)
-	(error "No free glyf codes remain"))
-    (aset glyf-table i string)))
+;; Allocate a glyph code to display by sending STRING to the terminal.
+(defun create-glyph (string)
+  (if (= (length glyph-table) 65536)
+      (error "No free glyph codes remain"))
+  (setq glyph-table (vconcat glyph-table (list string)))
+  (1- (length glyph-table)))
 
 (provide 'disp-table)