diff options
| author | Richard M. Stallman | 1992-06-07 04:20:03 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1992-06-07 04:20:03 +0000 |
| commit | 031317994b0d9f02e3e5dfd06a6385479e197dfe (patch) | |
| tree | 3e18861affbd126f7d62cba1d7073f24dfac8263 | |
| parent | 464f88989ff0c5ce1ec228eaf178091bc1f591b8 (diff) | |
| download | emacs-031317994b0d9f02e3e5dfd06a6385479e197dfe.tar.gz emacs-031317994b0d9f02e3e5dfd06a6385479e197dfe.zip | |
*** empty log message ***
| -rw-r--r-- | lisp/case-table.el | 46 | ||||
| -rw-r--r-- | lisp/disp-table.el | 34 |
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. | ||
| 50 | With prefix arg, applies to that many chars. | ||
| 51 | Negative 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. |
| 67 | Sets the entries for L and R in `standard-case-table', `standard-syntax-table', | 50 | Sets the entries for L and R in STRING, which is a downcasing table. |
| 68 | and `text-mode-syntax-table' to indicate left and right delimiters." | 51 | Also modifies `standard-syntax-table', and `text-mode-syntax-table' to |
| 69 | (aset (car table) l l) | 52 | indicate 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. |
| 82 | Sets the entries for characters UC and LC in `standard-case-table', | 66 | Sets 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 | 67 | Also 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. |
| 94 | Sets the entries for character C in `standard-case-table', | 78 | Sets the entries for character C in STRING, which is the downcasing table. |
| 95 | `standard-syntax-table' and `text-mode-syntax-table' to indicate this. | 79 | Also modify `standard-syntax-table' and `text-mode-syntax-table'. |
| 96 | SYNTAX should be \" \", \"w\", \".\" or \"_\"." | 80 | SYNTAX 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 | ||