/[emacs]/emacs/lisp/case-table.el
ViewVC logotype

Diff of /emacs/lisp/case-table.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.26 by rms, Sun Dec 16 03:45:57 2001 UTC revision 1.26.10.1 by handa, Mon Sep 8 12:53:36 2003 UTC
# Line 34  Line 34 
34    
35  ;;; Code:  ;;; Code:
36    
 (defvar set-case-syntax-offset 0)  
   
 (defvar set-case-syntax-set-multibyte nil)  
   
37  (defun describe-buffer-case-table ()  (defun describe-buffer-case-table ()
38    "Describe the case table of the current buffer."    "Describe the case table of the current buffer."
39    (interactive)    (interactive)
40    (let ((description (make-char-table 'case-table)))    (let ((description (make-char-table 'case-table)))
41      (map-char-table      (map-char-table
42       (function (lambda (key value)       (function (lambda (key value)
43                   (aset                   (if (consp key)
44                    description key                       (set-char-table-range description key "case-invariant")
45                    (cond ((not (natnump value))                     (aset
46                           "case-invariant")                      description key
47                          ((/= key (downcase key))                      (cond ((not (natnump value))
48                           (concat "uppercase, matches "                             "case-invariant")
49                                   (char-to-string (downcase key))))                            ((/= key (downcase key))
50                          ((/= key (upcase key))                             (concat "uppercase, matches "
51                           (concat "lowercase, matches "                                     (char-to-string (downcase key))))
52                                   (char-to-string (upcase key))))                            ((/= key (upcase key))
53                          (t "case-invariant")))))                             (concat "lowercase, matches "
54                                       (char-to-string (upcase key))))
55                              (t "case-invariant"))))))
56       (current-case-table))       (current-case-table))
57      (save-excursion      (save-excursion
58       (with-output-to-temp-buffer "*Help*"       (with-output-to-temp-buffer "*Help*"
# Line 71  Line 69 
69      (set-char-table-extra-slot copy 2 nil)      (set-char-table-extra-slot copy 2 nil)
70      copy))      copy))
71    
 (defsubst set-case-syntax-1 (char)  
   "Offset CHAR by `set-case-syntax-offset' if CHAR is a non-ASCII 8-bit char."  
   (if (and (>= char 128) (< char 256))  
       (+ char set-case-syntax-offset)  
     char))  
   
72  (defun set-case-syntax-delims (l r table)  (defun set-case-syntax-delims (l r table)
73    "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.
74  This sets the entries for L and R in TABLE, which is a string  This sets the entries for L and R in TABLE, which is a string
75  that will be used as the downcase part of a case table.  that will be used as the downcase part of a case table.
76  It also modifies `standard-syntax-table' to  It also modifies `standard-syntax-table' to
77  indicate left and right delimiters."  indicate left and right delimiters."
   (setq l (set-case-syntax-1 l))  
   (setq r (set-case-syntax-1 r))  
78    (aset table l l)    (aset table l l)
79    (aset table r r)    (aset table r r)
80    ;; Clear out the extra slots so that they will be    ;; Clear out the extra slots so that they will be
# Line 103  This sets the entries for characters UC Line 93  This sets the entries for characters UC
93  that will be used as the downcase part of a case table.  that will be used as the downcase part of a case table.
94  It also modifies `standard-syntax-table' to give them the syntax of  It also modifies `standard-syntax-table' to give them the syntax of
95  word constituents."  word constituents."
   (unless (= (charset-bytes (char-charset uc))  
              (charset-bytes (char-charset lc)))  
     (error "Can't casify chars with different `charset-bytes' values"))  
   (setq uc (set-case-syntax-1 uc))  
   (setq lc (set-case-syntax-1 lc))  
96    (aset table uc lc)    (aset table uc lc)
97    (aset table lc lc)    (aset table lc lc)
98    (set-char-table-extra-slot table 0 nil)    (set-char-table-extra-slot table 0 nil)
# Line 122  This sets the entry for character C in T Line 107  This sets the entry for character C in T
107  that will be used as the downcase part of a case table.  that will be used as the downcase part of a case table.
108  It also modifies `standard-syntax-table'.  It also modifies `standard-syntax-table'.
109  SYNTAX should be \" \", \"w\", \".\" or \"_\"."  SYNTAX should be \" \", \"w\", \".\" or \"_\"."
   (setq c (set-case-syntax-1 c))  
110    (aset table c c)    (aset table c c)
111    (set-char-table-extra-slot table 0 nil)    (set-char-table-extra-slot table 0 nil)
112    (set-char-table-extra-slot table 1 nil)    (set-char-table-extra-slot table 1 nil)

Legend:
Removed from v.1.26  
changed lines
  Added in v.1.26.10.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26