summaryrefslogtreecommitdiff
path: root/lisp/case-table.el
diff options
context:
space:
mode:
authorMiles Bader <miles@gnu.org>2005-02-06 12:06:02 +0000
committerMiles Bader <miles@gnu.org>2005-02-06 12:06:02 +0000
commita359f0e0ff878285654e2f0bcc7bd3b4340c778c (patch)
treecc0aff13c751bb8ab7ccaae29082bab32e15fd13 /lisp/case-table.el
parentf3d3402885646e6fa79f1ad59fb8a1f9017851d7 (diff)
parent56c30d721096a64f151f9ea6e3c76562380da895 (diff)
downloademacs-a359f0e0ff878285654e2f0bcc7bd3b4340c778c.tar.gz
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-11
Merge from emacs--cvs-trunk--0 Patches applied: * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-69 - miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-71 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-72 src/dispextern.h (xassert): Enable unconditionally. * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-73 - miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-81 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-82 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-12 Merge from emacs--cvs-trunk--0 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-13 Update from CVS
Diffstat (limited to 'lisp/case-table.el')
-rw-r--r--lisp/case-table.el36
1 files changed, 27 insertions, 9 deletions
diff --git a/lisp/case-table.el b/lisp/case-table.el
index 747e90c28f5..c3da621a9dd 100644
--- a/lisp/case-table.el
+++ b/lisp/case-table.el
@@ -1,6 +1,6 @@
;;; case-table.el --- code to extend the character set and support case tables
-;; Copyright (C) 1988, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1994, 2005 Free Software Foundation, Inc.
;; Author: Howard Gayle
;; Maintainer: FSF
@@ -60,11 +60,26 @@
(describe-vector description)
(help-mode)))))
+(defun get-upcase-table (case-table)
+ "Return the upcase table of CASE-TABLE."
+ (or (char-table-extra-slot case-table 0)
+ ;; Setup all extra slots of CASE-TABLE by temporarily selecting
+ ;; it as the standard case table.
+ (let ((old (standard-case-table)))
+ (unwind-protect
+ (progn
+ (set-standard-case-table case-table)
+ (char-table-extra-slot case-table 0))
+ (or (eq case-table old)
+ (set-standard-case-table old))))))
+
(defun copy-case-table (case-table)
- (let ((copy (copy-sequence case-table)))
- ;; Clear out the extra slots so that they will be
- ;; recomputed from the main (downcase) table.
- (set-char-table-extra-slot copy 0 nil)
+ (let ((copy (copy-sequence case-table))
+ (up (char-table-extra-slot case-table 0)))
+ ;; Clear out the extra slots (except for upcase table) so that
+ ;; they will be recomputed from the main (downcase) table.
+ (if up
+ (set-char-table-extra-slot copy 0 (copy-sequence up)))
(set-char-table-extra-slot copy 1 nil)
(set-char-table-extra-slot copy 2 nil)
copy))
@@ -77,9 +92,11 @@ It also modifies `standard-syntax-table' to
indicate left and right delimiters."
(aset table l l)
(aset table r r)
+ (let ((up (get-upcase-table table)))
+ (aset up l l)
+ (aset up r r))
;; Clear out the extra slots so that they will be
- ;; recomputed from the main (downcase) table.
- (set-char-table-extra-slot table 0 nil)
+ ;; recomputed from the main (downcase) table and upcase table.
(set-char-table-extra-slot table 1 nil)
(set-char-table-extra-slot table 2 nil)
(modify-syntax-entry l (concat "(" (char-to-string r) " ")
@@ -110,9 +127,10 @@ that will be used as the downcase part of a case table.
It also modifies `standard-syntax-table'.
SYNTAX should be \" \", \"w\", \".\" or \"_\"."
(aset table c c)
+ (let ((up (get-upcase-table table)))
+ (aset up c c))
;; Clear out the extra slots so that they will be
- ;; recomputed from the main (downcase) table.
- (set-char-table-extra-slot table 0 nil)
+ ;; recomputed from the main (downcase) table and upcase table.
(set-char-table-extra-slot table 1 nil)
(set-char-table-extra-slot table 2 nil)
(modify-syntax-entry c syntax (standard-syntax-table)))