Mercurial > emacs
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)