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

*** empty log message ***

parent 464f8898
......@@ -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 @@ and `text-mode-syntax-table' to indicate left and right delimiters."
(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))
......
......@@ -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")))))
(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)))
(make-rope (create-glyph (concat "\e[4m" (char-to-string uc) "\e[m")))))
;; 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)
......
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