Commit 03131799 authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

*** empty log message ***

parent 464f8898
...@@ -45,29 +45,13 @@ ...@@ -45,29 +45,13 @@
(with-output-to-temp-buffer "*Help*" (with-output-to-temp-buffer "*Help*"
(describe-vector vector))) (describe-vector vector)))
(defun invert-case (count) (defun set-case-syntax-delims (l r string)
"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)
"Make characters L and R a matching pair of non-case-converting delimiters. "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', Sets the entries for L and R in STRING, which is a downcasing table.
and `text-mode-syntax-table' to indicate left and right delimiters." Also modifies `standard-syntax-table', and `text-mode-syntax-table' to
(aset (car table) l l) indicate left and right delimiters."
(aset (car table) r r) (aset string l l)
(aset string r r)
(modify-syntax-entry l (concat "(" (char-to-string r) " ") (modify-syntax-entry l (concat "(" (char-to-string r) " ")
(standard-syntax-table)) (standard-syntax-table))
(modify-syntax-entry l (concat "(" (char-to-string r) " ") (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,24 +61,24 @@ and `text-mode-syntax-table' to indicate left and right delimiters."
(modify-syntax-entry r (concat ")" (char-to-string l) " ") (modify-syntax-entry r (concat ")" (char-to-string l) " ")
text-mode-syntax-table)) 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. "Make characters UC and LC a pair of inter-case-converting letters.
Sets the entries for characters UC and LC in `standard-case-table', Sets the entries for characters UC and LC in STRING, which is a downcasing table.
`standard-syntax-table' and `text-mode-syntax-table' to indicate an Also modify `standard-syntax-table' and `text-mode-syntax-table' to indicate an
(uppercase, lowercase) pair of letters." (uppercase, lowercase) pair of letters."
(aset string uc lc)
(aset (car table) uc lc) (aset (car (cdr (standard-case-table))) lc uc)
(modify-syntax-entry lc "w " (standard-syntax-table)) (modify-syntax-entry lc "w " (standard-syntax-table))
(modify-syntax-entry lc "w " text-mode-syntax-table) (modify-syntax-entry lc "w " text-mode-syntax-table)
(modify-syntax-entry uc "w " (standard-syntax-table)) (modify-syntax-entry uc "w " (standard-syntax-table))
(modify-syntax-entry uc "w " text-mode-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. "Make characters C case-invariant with syntax SYNTAX.
Sets the entries for character C in `standard-case-table', Sets the entries for character C in STRING, which is the downcasing table.
`standard-syntax-table' and `text-mode-syntax-table' to indicate this. Also modify `standard-syntax-table' and `text-mode-syntax-table'.
SYNTAX should be \" \", \"w\", \".\" or \"_\"." 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 (standard-syntax-table))
(modify-syntax-entry c syntax text-mode-syntax-table)) (modify-syntax-entry c syntax text-mode-syntax-table))
......
...@@ -19,9 +19,7 @@ ...@@ -19,9 +19,7 @@
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;; Written by Howard Gayle. See case-table.el for details. ;; Written by Howard Gayle.
(require 'case-table)
(defun rope-to-vector (rope) (defun rope-to-vector (rope)
(let* ((len (/ (length rope) 2)) (let* ((len (/ (length rope) 2))
...@@ -34,13 +32,13 @@ ...@@ -34,13 +32,13 @@
(defun describe-display-table (DT) (defun describe-display-table (DT)
"Describe the display table DT in a help buffer." "Describe the display table DT in a help buffer."
(with-output-to-temp-buffer "*Help*" (with-output-to-temp-buffer "*Help*"
(princ "\nTruncation glyf: ") (princ "\nTruncation glyph: ")
(prin1 (aref dt 256)) (prin1 (aref dt 256))
(princ "\nWrap glyf: ") (princ "\nWrap glyph: ")
(prin1 (aref dt 257)) (prin1 (aref dt 257))
(princ "\nEscape glyf: ") (princ "\nEscape glyph: ")
(prin1 (aref dt 258)) (prin1 (aref dt 258))
(princ "\nCtrl glyf: ") (princ "\nCtrl glyph: ")
(prin1 (aref dt 259)) (prin1 (aref dt 259))
(princ "\nSelective display rope: ") (princ "\nSelective display rope: ")
(prin1 (rope-to-vector (aref dt 260))) (prin1 (rope-to-vector (aref dt 260)))
...@@ -88,30 +86,28 @@ ...@@ -88,30 +86,28 @@
(or standard-display-table (or standard-display-table
(setq standard-display-table (make-vector 261 nil))) (setq standard-display-table (make-vector 261 nil)))
(aset standard-display-table c (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) (defun standard-display-graphic (c gc)
"Display character C as character GC in graphics character set." "Display character C as character GC in graphics character set."
(or standard-display-table (or standard-display-table
(setq standard-display-table (make-vector 261 nil))) (setq standard-display-table (make-vector 261 nil)))
(aset standard-display-table c (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) (defun standard-display-underline (c uc)
"Display character C as character UC plus underlining." "Display character C as character UC plus underlining."
(or standard-display-table (or standard-display-table
(setq standard-display-table (make-vector 261 nil))) (setq standard-display-table (make-vector 261 nil)))
(aset standard-display-table c (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) ;; Allocate a glyph code to display by sending STRING to the terminal.
(let ((i 256)) (defun create-glyph (string)
(while (and (< i 65536) (aref glyf-table i) (if (= (length glyph-table) 65536)
(not (string= (aref glyf-table i) string))) (error "No free glyph codes remain"))
(setq i (1+ i))) (setq glyph-table (vconcat glyph-table (list string)))
(if (= i 65536) (1- (length glyph-table)))
(error "No free glyf codes remain"))
(aset glyf-table i string)))
(provide 'disp-table) (provide 'disp-table)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment