Mercurial > hg > xemacs-beta

comparison lisp/mule/mule-category.el @ 110:fe104dbd9147 r20-1b7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b7
author cvs
date Mon, 13 Aug 2007 09:19:45 +0200
parents cf808b4c4290
children
comparison
equal deleted inserted replaced
109:e183fc049578 110:fe104dbd9147
117 (if (= 1 (aref vec (- a 32))) 117 (if (= 1 (aref vec (- a 32)))
118 (setq list (cons a list))) 118 (setq list (cons a list)))
119 (setq a (1+ a))) 119 (setq a (1+ a)))
120 (nreverse list))))) 120 (nreverse list)))))
121 121
122 (defun char-in-category-p (char category &optional table) 122 ;; implimented in c, file chartab.c (97/3/14 jhod@po.iijnet.or.jp)
123 "Return non-nil if CHAR is in CATEGORY. 123 ;(defun char-in-category-p (char category &optional table)
124 TABLE defaults to the current buffer's category table. 124 ; "Return non-nil if CHAR is in CATEGORY.
125 Categories are specified by their designators." 125 ;TABLE defaults to the current buffer's category table.
126 (or table (setq table (category-table))) 126 ;Categories are specified by their designators."
127 (check-argument-type 'category-table-p table) 127 ; (or table (setq table (category-table)))
128 (check-argument-type 'category-designator-p category) 128 ; (check-argument-type 'category-table-p table)
129 (let ((vec (get-char-table char table))) 129 ; (check-argument-type 'category-designator-p category)
130 (if (null vec) nil 130 ; (let ((vec (get-char-table char table)))
131 (= 1 (aref vec (- category 32)))))) 131 ; (if (null vec) nil
132 ; (= 1 (aref vec (- category 32))))))
132 133
133 (defun describe-category () 134 (defun describe-category ()
134 "Describe the category specifications in the category table. 135 "Describe the category specifications in the category table.
135 The descriptions are inserted in a buffer, which is then displayed." 136 The descriptions are inserted in a buffer, which is then displayed."
136 (interactive) 137 (interactive)
171 (lambda (range value) 172 (lambda (range value)
172 (if (and (or 173 (if (and (or
173 (and (characterp range) 174 (and (characterp range)
174 (characterp first-char) 175 (characterp first-char)
175 (eq (char-charset range) (char-charset first-char)) 176 (eq (char-charset range) (char-charset first-char))
176 (= (char-int last-char) (1- (char-int range)))) 177 (= (char-to-int last-char) (1- (char-to-int range))))
177 (and (vectorp range) 178 (and (vectorp range)
178 (vectorp first-char) 179 (vectorp first-char)
179 (eq (aref range 0) (aref first-char 0)) 180 (eq (aref range 0) (aref first-char 0))
180 (= (aref last-char 1) (1- (aref range 1)))) 181 (= (aref last-char 1) (1- (aref range 1))))
181 (equal value prev-val))) 182 (equal value prev-val)))
201 (if (= 1 (aref code i)) 202 (if (= 1 (aref code i))
202 (progn 203 (progn
203 (if (not already-matched) 204 (if (not already-matched)
204 (setq already-matched t) 205 (setq already-matched t)
205 (princ " ")) 206 (princ " "))
206 (princ (int-char (+ 32 i))))) 207 (princ (int-to-char (+ 32 i)))))
207 (setq i (1+ i))) 208 (setq i (1+ i)))
208 (if (not already-matched) 209 (if (not already-matched)
209 (princ "(none)"))) 210 (princ "(none)")))
210 (let ((i 0)) 211 (let ((i 0))
211 (while (< i 95) 212 (while (< i 95)
212 (if (= 1 (aref code i)) 213 (if (= 1 (aref code i))
213 (princ (format "\n\t\tmeaning: %s" 214 (princ (format "\n\t\tmeaning: %s"
214 (category-doc-string (int-char (+ 32 i)))))) 215 (category-doc-string (int-to-char (+ 32 i))))))
215 (setq i (1+ i))))) 216 (setq i (1+ i)))))
216 (terpri))) 217 (terpri)))
217 218
218 (defconst predefined-category-list 219 (defconst predefined-category-list
219 '((latin-iso8859-1 ?l "Latin-1 through Latin-5 character set") 220 '((latin-iso8859-1 ?l "Latin-1 through Latin-5 character set")
256 257
257 ;;; At the present, I know Japanese and Chinese text can 258 ;;; At the present, I know Japanese and Chinese text can
258 ;;; break line at any point under a restriction of 'kinsoku'. 259 ;;; break line at any point under a restriction of 'kinsoku'.
259 (defvar word-across-newline "\\(\\cj\\|\\cc\\|\\ct\\)" 260 (defvar word-across-newline "\\(\\cj\\|\\cc\\|\\ct\\)"
260 "Regular expression of such characters which can be a word across newline.") 261 "Regular expression of such characters which can be a word across newline.")
262
263 (defvar ascii-char "[\40-\176]")
264 (defvar ascii-space "[ \t]")
265 (defvar ascii-symbols "[\40-\57\72-\100\133-\140\173-\176]")
266 (defvar ascii-numeric "[\60-\71]")
267 (defvar ascii-English-Upper "[\101-\132]")
268 (defvar ascii-English-Lower "[\141-\172]")
269 (defvar ascii-alphanumeric "[\60-\71\101-\132\141-\172]")
270
271 (defvar kanji-char "\\cj")
272 (defvar kanji-space "$B!!(B")
273 (defvar kanji-symbols "\\cS")
274 (defvar kanji-numeric "[$B#0(B-$B#9(B]")
275 (defvar kanji-English-Upper "[$B#A(B-$B#Z(B]")
276 (defvar kanji-English-Lower "[$B#a(B-$B#z(B]")
277 (defvar kanji-hiragana "\\cH")
278 (defvar kanji-katakana "\\cK")
279 (defvar kanji-Greek-Upper "[$B&!(B-$B&8(B]")
280 (defvar kanji-Greek-Lower "[$B&A(B-$B&X(B]")
281 (defvar kanji-Russian-Upper "[$B'!(B-$B'A(B]")
282 (defvar kanji-Russian-Lower "[$B'Q(B-$B'q(B]")
283 (defvar kanji-Kanji-1st-Level "[$B0!(B-$BOS(B]")
284 (defvar kanji-Kanji-2nd-Level "[$BP!(B-$Bt$(B]")
285
286 (defvar kanji-kanji-char "\\(\\cH\\|\\cK\\|\\cC\\)")