Mercurial > hg > xemacs-beta

comparison lisp/mule/mule-category.el @ 104:cf808b4c4290 r20-1b4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b4
author cvs
date Mon, 13 Aug 2007 09:16:51 +0200
parents 54cc21c15cbb
children fe104dbd9147
comparison
equal deleted inserted replaced
103:30eda07fe280 104:cf808b4c4290
27 ;; type of char table. Some function names / arguments should be 27 ;; type of char table. Some function names / arguments should be
28 ;; parallel with syntax tables. 28 ;; parallel with syntax tables.
29 29
30 ;; Written by Ben Wing <wing@666.com>. The initialization code 30 ;; Written by Ben Wing <wing@666.com>. The initialization code
31 ;; at the end of this file comes from Mule. 31 ;; at the end of this file comes from Mule.
32 ;; Some bugfixes by Jareth Hein <jhod@po.iijnet.or.jp>
32 33
33 ;;; Code: 34 ;;; Code:
34 35
35 (defvar defined-category-hashtable (make-hashtable 50)) 36 (defvar defined-category-hashtable (make-hashtable 50))
36 37
91 (if reset 92 (if reset
92 ;; clear all existing stuff. 93 ;; clear all existing stuff.
93 (put-char-table char-range nil table)) 94 (put-char-table char-range nil table))
94 (map-char-table 95 (map-char-table
95 #'(lambda (key value) 96 #'(lambda (key value)
96 ;; make sure that this range has a bit-vector assigned to it, 97 ;; make sure that this range has a bit-vector assigned to it
97 ;; and set the appropriate bit in that vector.
98 (if (not (bit-vector-p value)) 98 (if (not (bit-vector-p value))
99 (progn 99 (setq value (make-bit-vector 95 0))
100 (setq value (make-bit-vector 95 0)) 100 (setq value (copy-sequence value)))
101 (put-char-table key value table))) 101 ;; set the appropriate bit in that vector.
102 (aset value (- designator 32) 1)) 102 (aset value (- designator 32) 1)
103 ;; put the vector back, thus assuring we have a unique setting for this range
104 (put-char-table key value table))
103 table char-range)) 105 table char-range))
104 106
105 (defun char-category-list (char &optional table) 107 (defun char-category-list (char &optional table)
106 "Return a list of the categories that CHAR is in. 108 "Return a list of the categories that CHAR is in.
107 TABLE defaults to the current buffer's category table. 109 TABLE defaults to the current buffer's category table.
244 (while (< i 127) 246 (while (< i 127)
245 (modify-category-entry i ?a) 247 (modify-category-entry i ?a)
246 (setq i (1+ i))) 248 (setq i (1+ i)))
247 (setq l predefined-category-list) 249 (setq l predefined-category-list)
248 (while l 250 (while l
249 (if (nth 2 (car l)) 251 (if (and (nth 2 (car l))
252 (not (defined-category-p (nth 2 (car l)))))
250 (define-category (nth 1 (car l)) (nth 2 (car l)))) 253 (define-category (nth 1 (car l)) (nth 2 (car l))))
251 (modify-category-entry (car (car l)) (nth 1 (car l))) 254 (modify-category-entry (car (car l)) (nth 1 (car l)))
252 (setq l (cdr l)))) 255 (setq l (cdr l))))
253 256
254 ;;; At the present, I know Japanese and Chinese text can 257 ;;; At the present, I know Japanese and Chinese text can