Mercurial > hg > xemacs-beta

comparison lisp/mule/mule-category.el @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents de805c49cfc1
children 41dbb7a9d5f2
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
1 ;;; mule-category.el --- category functions for XEmacs/Mule. 1 ;;; mule-category.el --- category functions for XEmacs/Mule.
2 2
3 ;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc. 3 ;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995, 1997, 1999 Electrotechnical Laboratory, JAPAN.
5 ;; Licensed to the Free Software Foundation.
6 ;; Copyright (C) 1995 Amdahl Corporation. 4 ;; Copyright (C) 1995 Amdahl Corporation.
7 ;; Copyright (C) 1995 Sun Microsystems. 5 ;; Copyright (C) 1995 Sun Microsystems.
8 6
9 ;; This file is part of XEmacs. 7 ;; This file is part of XEmacs.
10 8
27 25
28 ;; Functions for working with category tables, which are a particular 26 ;; Functions for working with category tables, which are a particular
29 ;; type of char table. Some function names / arguments should be 27 ;; type of char table. Some function names / arguments should be
30 ;; parallel with syntax tables. 28 ;; parallel with syntax tables.
31 29
32 ;; Written by Ben Wing <ben@xemacs.org>. The initialization code 30 ;; Written by Ben Wing <wing@666.com>. The initialization code
33 ;; at the end of this file comes from Mule. 31 ;; at the end of this file comes from Mule.
34 ;; Some bugfixes by Jareth Hein <jhod@po.iijnet.or.jp> 32 ;; Some bugfixes by Jareth Hein <jhod@po.iijnet.or.jp>
35 33
36 ;;; Code: 34 ;;; Code:
37 35
38 (defvar defined-category-hashtable (make-hash-table :size 50)) 36 (defvar defined-category-hashtable (make-hashtable 50))
39 37
40 (defun define-category (designator doc-string) 38 (defun define-category (designator doc-string)
41 "Make a new category whose designator is DESIGNATOR. 39 "Make a new category whose designator is DESIGNATOR.
42 DESIGNATOR should be a visible letter of ' ' thru '~'. 40 DESIGNATOR should be a visible letter of ' ' thru '~'.
43 STRING is a doc string for the category. 41 STRING is a doc string for the category.
67 65
68 (defun undefined-category-designator () 66 (defun undefined-category-designator ()
69 "Return an undefined category designator, or nil if there are none." 67 "Return an undefined category designator, or nil if there are none."
70 (let ((a 32) found) 68 (let ((a 32) found)
71 (while (and (< a 127) (not found)) 69 (while (and (< a 127) (not found))
72 (unless (gethash a defined-category-hashtable) 70 (if (gethash a defined-category-hashtable)
73 (setq found (make-char 'ascii a))) 71 (setq found a))
74 (setq a (1+ a))) 72 (setq a (1+ a)))
75 found)) 73 found))
76 74
77 (defun category-doc-string (designator) 75 (defun category-doc-string (designator)
78 "Return the doc-string for the category denoted by DESIGNATOR." 76 "Return the doc-string for the category denoted by DESIGNATOR."
115 (let ((vec (get-char-table char table))) 113 (let ((vec (get-char-table char table)))
116 (if (null vec) nil 114 (if (null vec) nil
117 (let ((a 32) list) 115 (let ((a 32) list)
118 (while (< a 127) 116 (while (< a 127)
119 (if (= 1 (aref vec (- a 32))) 117 (if (= 1 (aref vec (- a 32)))
120 (setq list (cons (make-char 'ascii a) list))) 118 (setq list (cons a list)))
121 (setq a (1+ a))) 119 (setq a (1+ a)))
122 (nreverse list))))) 120 (nreverse list)))))
123 121
124 ;; implemented in c, file chartab.c (97/3/14 jhod@po.iijnet.or.jp) 122 ;; implimented in c, file chartab.c (97/3/14 jhod@po.iijnet.or.jp)
125 ;(defun char-in-category-p (char category &optional table) 123 ;(defun char-in-category-p (char category &optional table)
126 ; "Return non-nil if CHAR is in CATEGORY. 124 ; "Return non-nil if CHAR is in CATEGORY.
127 ;TABLE defaults to the current buffer's category table. 125 ;TABLE defaults to the current buffer's category table.
128 ;Categories are specified by their designators." 126 ;Categories are specified by their designators."
129 ; (or table (setq table (category-table))) 127 ; (or table (setq table (category-table)))
135 133
136 (defun describe-category () 134 (defun describe-category ()
137 "Describe the category specifications in the category table. 135 "Describe the category specifications in the category table.
138 The descriptions are inserted in a buffer, which is then displayed." 136 The descriptions are inserted in a buffer, which is then displayed."
139 (interactive) 137 (interactive)
140 (with-displaying-help-buffer 138 (with-output-to-temp-buffer "*Help*"
141 (lambda () 139 (describe-category-table (category-table) standard-output)))
142 (describe-category-table (category-table) standard-output))))
143 140
144 (defun describe-category-table (table stream) 141 (defun describe-category-table (table stream)
145 (let (first-char 142 (let (first-char
146 last-char 143 last-char
147 prev-val 144 prev-val
244 "List of predefined categories. 241 "List of predefined categories.
245 Each element is a list of a charset, a designator, and maybe a doc string.") 242 Each element is a list of a charset, a designator, and maybe a doc string.")
246 243
247 (let (i l) 244 (let (i l)
248 (define-category ?a "ASCII character set.") 245 (define-category ?a "ASCII character set.")
249 (define-category ?l "Latin-1 through Latin-5 character set")
250 (setq i 32) 246 (setq i 32)
251 (while (< i 127) 247 (while (< i 127)
252 (modify-category-entry i ?a) 248 (modify-category-entry i ?a)
253 (modify-category-entry i ?l)
254 (setq i (1+ i))) 249 (setq i (1+ i)))
255 (setq l predefined-category-list) 250 (setq l predefined-category-list)
256 (while l 251 (while l
257 (if (and (nth 2 (car l)) 252 (if (and (nth 2 (car l))
258 (not (defined-category-p (nth 2 (car l))))) 253 (not (defined-category-p (nth 2 (car l)))))
259 (define-category (nth 1 (car l)) (nth 2 (car l)))) 254 (define-category (nth 1 (car l)) (nth 2 (car l))))
260 (modify-category-entry (car (car l)) (nth 1 (car l))) 255 (modify-category-entry (car (car l)) (nth 1 (car l)))
261 (setq l (cdr l)))) 256 (setq l (cdr l))))
262
263 ;;; Setting word boundary.
264
265 (setq word-combining-categories
266 '((?l . ?l)))
267
268 (setq word-separating-categories ; (2-byte character sets)
269 '((?A . ?K) ; Alpha numeric - Katakana
270 (?A . ?C) ; Alpha numeric - Chinese
271 (?H . ?A) ; Hiragana - Alpha numeric
272 (?H . ?K) ; Hiragana - Katakana
273 (?H . ?C) ; Hiragana - Chinese
274 (?K . ?A) ; Katakana - Alpha numeric
275 (?K . ?C) ; Katakana - Chinese
276 (?C . ?A) ; Chinese - Alpha numeric
277 (?C . ?K) ; Chinese - Katakana
278 ))
279 257
280 ;;; At the present, I know Japanese and Chinese text can 258 ;;; At the present, I know Japanese and Chinese text can
281 ;;; break line at any point under a restriction of 'kinsoku'. 259 ;;; break line at any point under a restriction of 'kinsoku'.
282 (defvar word-across-newline "\\(\\cj\\|\\cc\\|\\ct\\)" 260 (defvar word-across-newline "\\(\\cj\\|\\cc\\|\\ct\\)"
283 "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.")