Mercurial > hg > xemacs-beta

comparison lisp/mule/mule-category.el @ 398:74fd4e045ea6 r21-2-29

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 4f79e16b1112
children de805c49cfc1
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
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.
4 ;; Copyright (C) 1995 Amdahl Corporation. 6 ;; Copyright (C) 1995 Amdahl Corporation.
5 ;; Copyright (C) 1995 Sun Microsystems. 7 ;; Copyright (C) 1995 Sun Microsystems.
6 8
7 ;; This file is part of XEmacs. 9 ;; This file is part of XEmacs.
8 10
25 27
26 ;; Functions for working with category tables, which are a particular 28 ;; Functions for working with category tables, which are a particular
27 ;; type of char table. Some function names / arguments should be 29 ;; type of char table. Some function names / arguments should be
28 ;; parallel with syntax tables. 30 ;; parallel with syntax tables.
29 31
30 ;; Written by Ben Wing <wing@666.com>. The initialization code 32 ;; Written by Ben Wing <ben@xemacs.org>. The initialization code
31 ;; at the end of this file comes from Mule. 33 ;; at the end of this file comes from Mule.
32 ;; Some bugfixes by Jareth Hein <jhod@po.iijnet.or.jp> 34 ;; Some bugfixes by Jareth Hein <jhod@po.iijnet.or.jp>
33 35
34 ;;; Code: 36 ;;; Code:
35 37
65 67
66 (defun undefined-category-designator () 68 (defun undefined-category-designator ()
67 "Return an undefined category designator, or nil if there are none." 69 "Return an undefined category designator, or nil if there are none."
68 (let ((a 32) found) 70 (let ((a 32) found)
69 (while (and (< a 127) (not found)) 71 (while (and (< a 127) (not found))
70 (if (gethash a defined-category-hashtable) 72 (unless (gethash a defined-category-hashtable)
71 (setq found a)) 73 (setq found (make-char 'ascii a)))
72 (setq a (1+ a))) 74 (setq a (1+ a)))
73 found)) 75 found))
74 76
75 (defun category-doc-string (designator) 77 (defun category-doc-string (designator)
76 "Return the doc-string for the category denoted by DESIGNATOR." 78 "Return the doc-string for the category denoted by DESIGNATOR."
113 (let ((vec (get-char-table char table))) 115 (let ((vec (get-char-table char table)))
114 (if (null vec) nil 116 (if (null vec) nil
115 (let ((a 32) list) 117 (let ((a 32) list)
116 (while (< a 127) 118 (while (< a 127)
117 (if (= 1 (aref vec (- a 32))) 119 (if (= 1 (aref vec (- a 32)))
118 (setq list (cons a list))) 120 (setq list (cons (make-char 'ascii a) list)))
119 (setq a (1+ a))) 121 (setq a (1+ a)))
120 (nreverse list))))) 122 (nreverse list)))))
121 123
122 ;; implimented 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)
123 ;(defun char-in-category-p (char category &optional table) 125 ;(defun char-in-category-p (char category &optional table)
124 ; "Return non-nil if CHAR is in CATEGORY. 126 ; "Return non-nil if CHAR is in CATEGORY.
125 ;TABLE defaults to the current buffer's category table. 127 ;TABLE defaults to the current buffer's category table.
126 ;Categories are specified by their designators." 128 ;Categories are specified by their designators."
127 ; (or table (setq table (category-table))) 129 ; (or table (setq table (category-table)))
133 135
134 (defun describe-category () 136 (defun describe-category ()
135 "Describe the category specifications in the category table. 137 "Describe the category specifications in the category table.
136 The descriptions are inserted in a buffer, which is then displayed." 138 The descriptions are inserted in a buffer, which is then displayed."
137 (interactive) 139 (interactive)
138 (with-output-to-temp-buffer "*Help*" 140 (with-displaying-help-buffer
139 (describe-category-table (category-table) standard-output))) 141 (lambda ()
142 (describe-category-table (category-table) standard-output))))
140 143
141 (defun describe-category-table (table stream) 144 (defun describe-category-table (table stream)
142 (let (first-char 145 (let (first-char
143 last-char 146 last-char
144 prev-val 147 prev-val
241 "List of predefined categories. 244 "List of predefined categories.
242 Each element is a list of a charset, a designator, and maybe a doc string.") 245 Each element is a list of a charset, a designator, and maybe a doc string.")
243 246
244 (let (i l) 247 (let (i l)
245 (define-category ?a "ASCII character set.") 248 (define-category ?a "ASCII character set.")
249 (define-category ?l "Latin-1 through Latin-5 character set")
246 (setq i 32) 250 (setq i 32)
247 (while (< i 127) 251 (while (< i 127)
248 (modify-category-entry i ?a) 252 (modify-category-entry i ?a)
253 (modify-category-entry i ?l)
249 (setq i (1+ i))) 254 (setq i (1+ i)))
250 (setq l predefined-category-list) 255 (setq l predefined-category-list)
251 (while l 256 (while l
252 (if (and (nth 2 (car l)) 257 (if (and (nth 2 (car l))
253 (not (defined-category-p (nth 2 (car l))))) 258 (not (defined-category-p (nth 2 (car l)))))
254 (define-category (nth 1 (car l)) (nth 2 (car l)))) 259 (define-category (nth 1 (car l)) (nth 2 (car l))))
255 (modify-category-entry (car (car l)) (nth 1 (car l))) 260 (modify-category-entry (car (car l)) (nth 1 (car l)))
256 (setq l (cdr l)))) 261 (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 ))
257 279
258 ;;; At the present, I know Japanese and Chinese text can 280 ;;; At the present, I know Japanese and Chinese text can
259 ;;; break line at any point under a restriction of 'kinsoku'. 281 ;;; break line at any point under a restriction of 'kinsoku'.
260 (defvar word-across-newline "\\(\\cj\\|\\cc\\|\\ct\\)" 282 (defvar word-across-newline "\\(\\cj\\|\\cc\\|\\ct\\)"
261 "Regular expression of such characters which can be a word across newline.") 283 "Regular expression of such characters which can be a word across newline.")