diff options
author | Stefan Monnier <monnier@iro.umontreal.ca> | 2013-03-27 10:33:03 -0400 |
---|---|---|
committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2013-03-27 10:33:03 -0400 |
commit | f557c1b1a9b24212728bf27027f0d0cc1d9bbecb (patch) | |
tree | ef5c289924788904c1c1c8585786ca7782349280 /lisp/case-table.el | |
parent | 002668e109fe71527f564a797d4c5e0756e45530 (diff) | |
download | emacs-f557c1b1a9b24212728bf27027f0d0cc1d9bbecb.tar.gz |
* lisp/case-table.el (case-table-get-table): New function.
* lisp/case-table.el: Use lexical-binding.
(case-table-get-table): New function.
(get-upcase-table): Use it. Mark as obsolete. Adjust callers.
* src/casetab.c (init_casetab_once): Don't abuse the ascii eqv table for
the upcase table.
Diffstat (limited to 'lisp/case-table.el')
-rw-r--r-- | lisp/case-table.el | 40 |
1 files changed, 24 insertions, 16 deletions
diff --git a/lisp/case-table.el b/lisp/case-table.el index 711d4e4ec8c..7d4aa27de1c 100644 --- a/lisp/case-table.el +++ b/lisp/case-table.el @@ -1,4 +1,4 @@ -;;; case-table.el --- code to extend the character set and support case tables +;;; case-table.el --- code to extend the character set and support case tables -*- lexical-binding: t -*- ;; Copyright (C) 1988, 1994, 2001-2013 Free Software Foundation, Inc. @@ -65,18 +65,26 @@ (describe-vector description) (help-mode))))) +(defun case-table-get-table (case-table table) + "Return the TABLE of CASE-TABLE. +TABLE can be `down', `up', `eqv' or `canon'." + (let ((slot-nb (cdr (assq table '((up . 0) (canon . 1) (eqv . 2)))))) + (or (if (eq table 'down) case-table) + (char-table-extra-slot case-table slot-nb) + ;; 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 slot-nb)) + (or (eq case-table old) + (set-standard-case-table old))))))) + (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)))))) + (case-table-get-table case-table 'up)) +(make-obsolete 'get-upcase-table 'case-table-get-table "24.4") (defun copy-case-table (case-table) (let ((copy (copy-sequence case-table)) @@ -97,7 +105,7 @@ 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))) + (let ((up (case-table-get-table table 'up))) (aset up l l) (aset up r r)) ;; Clear out the extra slots so that they will be @@ -117,7 +125,7 @@ It also modifies `standard-syntax-table' to give them the syntax of word constituents." (aset table uc lc) (aset table lc lc) - (let ((up (get-upcase-table table))) + (let ((up (case-table-get-table table 'up))) (aset up uc uc) (aset up lc uc)) ;; Clear out the extra slots so that they will be @@ -132,7 +140,7 @@ word constituents." It also modifies `standard-syntax-table' to give them the syntax of word constituents." (aset table lc lc) - (let ((up (get-upcase-table table))) + (let ((up (case-table-get-table table 'up))) (aset up uc uc) (aset up lc uc)) ;; Clear out the extra slots so that they will be @@ -148,7 +156,7 @@ It also modifies `standard-syntax-table' to give them the syntax of word constituents." (aset table uc lc) (aset table lc lc) - (let ((up (get-upcase-table table))) + (let ((up (case-table-get-table table 'up))) (aset up uc uc)) ;; Clear out the extra slots so that they will be ;; recomputed from the main (downcase) table and upcase table. @@ -164,7 +172,7 @@ 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))) + (let ((up (case-table-get-table table 'up))) (aset up c c)) ;; Clear out the extra slots so that they will be ;; recomputed from the main (downcase) table and upcase table. |