mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-30 04:10:54 -08:00
Code Issues Projects Releases Wiki Activity

*** empty log message ***

Browse source
This commit is contained in:
Richard M. Stallman 1992-06-07 04:20:03 +00:00
parent 464f88989f
commit 031317994b
2 changed files with 29 additions and 49 deletions
Download patch file Download diff file Expand all files Collapse all files

46
lisp/case-table.el
View file

@ -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))

32
lisp/disp-table.el
View file

@ -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)