Mercurial > hg > xemacs-beta

comparison lisp/mule/mule-category.el @ 444:576fb035e263 r21-2-37

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-37
author cvs
date Mon, 13 Aug 2007 11:36:19 +0200
parents abe6d1db359e
children 98528da0b7fc
comparison
equal deleted inserted replaced
443:a8296e22da4e 444:576fb035e263
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details. 19 ;; General Public License for more details.
20 20
21 ;; You should have received a copy of the GNU General Public License 21 ;; You should have received a copy of the GNU General Public License
22 ;; along with XEmacs; see the file COPYING. If not, write to the 22 ;; along with XEmacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA. 24 ;; Boston, MA 02111-1307, USA.
25 25
26 ;;; Commentary: 26 ;;; Commentary:
27 27
77 (defun category-doc-string (designator) 77 (defun category-doc-string (designator)
78 "Return the doc-string for the category denoted by DESIGNATOR." 78 "Return the doc-string for the category denoted by DESIGNATOR."
79 (check-argument-type 'defined-category-p designator) 79 (check-argument-type 'defined-category-p designator)
80 (gethash designator defined-category-hashtable)) 80 (gethash designator defined-category-hashtable))
81 81
82 (defun modify-category-entry (char-range designator &optional table reset) 82 (defun modify-category-entry (char-range designator &optional category-table reset)
83 "Add a category to the categories associated with CHAR-RANGE. 83 "Add a category to the categories associated with CHAR-RANGE.
84 CHAR-RANGE is a single character or a range of characters, 84 CHAR-RANGE is a single character or a range of characters,
85 as per `put-char-table'. 85 as per `put-char-table'.
86 The category is given by a designator character. 86 The category is given by a designator character.
87 The changes are made in TABLE, which defaults to the current buffer's 87 The changes are made in CATEGORY-TABLE, which defaults to the current
88 category table. 88 buffer's category table.
89 If optional fourth argument RESET is non-nil, previous categories associated 89 If optional fourth argument RESET is non-nil, previous categories associated
90 with CHAR-RANGE are removed before adding the specified category." 90 with CHAR-RANGE are removed before adding the specified category."
91 (or table (setq table (category-table))) 91 (or category-table (setq category-table (category-table)))
92 (check-argument-type 'category-table-p table) 92 (check-argument-type 'category-table-p category-table)
93 (check-argument-type 'defined-category-p designator) 93 (check-argument-type 'defined-category-p designator)
94 (if reset 94 (if reset
95 ;; clear all existing stuff. 95 ;; clear all existing stuff.
96 (put-char-table char-range nil table)) 96 (put-char-table char-range nil category-table))
97 (map-char-table 97 (map-char-table
98 #'(lambda (key value) 98 #'(lambda (key value)
99 ;; make sure that this range has a bit-vector assigned to it 99 ;; make sure that this range has a bit-vector assigned to it
100 (if (not (bit-vector-p value)) 100 (if (not (bit-vector-p value))
101 (setq value (make-bit-vector 95 0)) 101 (setq value (make-bit-vector 95 0))
102 (setq value (copy-sequence value))) 102 (setq value (copy-sequence value)))
103 ;; set the appropriate bit in that vector. 103 ;; set the appropriate bit in that vector.
104 (aset value (- designator 32) 1) 104 (aset value (- designator 32) 1)
105 ;; put the vector back, thus assuring we have a unique setting for this range 105 ;; put the vector back, thus assuring we have a unique setting for this range
106 (put-char-table key value table)) 106 (put-char-table key value category-table))
107 table char-range)) 107 category-table char-range))
108 108
109 (defun char-category-list (char &optional table) 109 (defun char-category-list (character &optional category-table)
110 "Return a list of the categories that CHAR is in. 110 "Return a list of the categories that CHARACTER is in.
111 TABLE defaults to the current buffer's category table. 111 CATEGORY-TABLE defaults to the current buffer's category table.
112 The categories are given by their designators." 112 The categories are given by their designators."
113 (or table (setq table (category-table))) 113 (or category-table (setq category-table (category-table)))
114 (check-argument-type 'category-table-p table) 114 (check-argument-type 'category-table-p category-table)
115 (let ((vec (get-char-table char table))) 115 (let ((vec (get-char-table character category-table)))
116 (if (null vec) nil 116 (if (null vec) nil
117 (let ((a 32) list) 117 (let ((a 32) list)
118 (while (< a 127) 118 (while (< a 127)
119 (if (= 1 (aref vec (- a 32))) 119 (if (= 1 (aref vec (- a 32)))
120 (setq list (cons (make-char 'ascii a) list))) 120 (setq list (cons (make-char 'ascii a) list)))
121 (setq a (1+ a))) 121 (setq a (1+ a)))
122 (nreverse list))))) 122 (nreverse list)))))
123 123
124 ;; implemented in c, file chartab.c (97/3/14 jhod@po.iijnet.or.jp) 124 ;; implemented in C, file chartab.c (97/3/14 jhod@po.iijnet.or.jp)
125 ;(defun char-in-category-p (char category &optional table) 125 ;(defun char-in-category-p (char category &optional table)
126 ; "Return non-nil if CHAR is in CATEGORY. 126 ; "Return non-nil if CHAR is in CATEGORY.
127 ;TABLE defaults to the current buffer's category table. 127 ;TABLE defaults to the current buffer's category table.
128 ;Categories are specified by their designators." 128 ;Categories are specified by their designators."
129 ; (or table (setq table (category-table))) 129 ; (or table (setq table (category-table)))