annotate lisp/mule/mule-category.el @ 4844:91b3d00e717f

Various cleanups for Dynarr code, from Unicode-internal ws dynarr.c: Add comment explaining Dynarr_largest() use. dynarr.c: In Dynarr_insert_many(), don't call Dynarr_resize() unless we actually need to resize, and note that an assert() that we are inserting at or below the current end could be wrong if code wants to access stuff between `len' and `largest'. dynarr.c: Don't just Dynarr_resize() to the right size; instead use Dynarr_reset() then Dynarr_add_many(), so that the 'len' and 'largest' and such get set properly. dynarr.c, faces.c, gutter.c, lisp.h, lread.c, lrecord.h, redisplay-output.c, redisplay.c: Rename Dynarr member 'cur' to 'len' since it's the length of the dynarr, not really a pointer to a "current insertion point". Use type_checking_assert() instead of just assert() in some places. Add additional assertions (Dynarr_verify*()) to check that we're being given positions within range. Use them in Dynarr_at, Dynarr_atp, etc. New Dynarr_atp_allow_end() for retrieving a pointer to a position that might be the element past the last one. New Dynarr_past_lastp() to retrieve a pointer to the position past the last one, using Dynarr_atp_allow_end(). Change code appropriately to use it. Rename Dynarr_end() to Dynarr_lastp() (pointer to the last element) for clarity, and change code appropriately to use it. Change code appropriately to use Dynarr_begin(). Rewrite Dynarr_add_many(). New version can accept a NULL pointer to mean "reserve space but don't put anything in it". Used by stack_like_malloc().
author Ben Wing <ben@xemacs.org>
date Wed, 13 Jan 2010 04:07:42 -0600
parents 980575c76541
children 311f6817efc2 308d34e9f07d
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 450
diff changeset
1 ;;; mule-category.el --- category functions for XEmacs/Mule. -*- coding: iso-2022-7bit; -*-
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 ;; Copyright (C) 1995, 1997, 1999 Electrotechnical Laboratory, JAPAN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 ;; Licensed to the Free Software Foundation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 ;; Copyright (C) 1995 Amdahl Corporation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Copyright (C) 1995 Sun Microsystems.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
22 ;; along with XEmacs; see the file COPYING. If not, write to the
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;; Boston, MA 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 ;; Functions for working with category tables, which are a particular
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 ;; type of char table. Some function names / arguments should be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 ;; parallel with syntax tables.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 ;; Written by Ben Wing <ben@xemacs.org>. The initialization code
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 ;; at the end of this file comes from Mule.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ;; Some bugfixes by Jareth Hein <jhod@po.iijnet.or.jp>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
38 (defvar defined-category-hashtable (make-hash-table :size 50))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39
3970
949ac151a10d [xemacs-hg @ 2007-05-20 20:09:20 by aidan]
aidan
parents: 952
diff changeset
40 (defun define-category (designator doc-string &optional table)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 "Make a new category whose designator is DESIGNATOR.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 DESIGNATOR should be a visible letter of ' ' thru '~'.
3970
949ac151a10d [xemacs-hg @ 2007-05-20 20:09:20 by aidan]
aidan
parents: 952
diff changeset
43 DOC-STRING is a doc string for the category.
949ac151a10d [xemacs-hg @ 2007-05-20 20:09:20 by aidan]
aidan
parents: 952
diff changeset
44 Letters of 'a' thru 'z' are already used or kept for the system.
949ac151a10d [xemacs-hg @ 2007-05-20 20:09:20 by aidan]
aidan
parents: 952
diff changeset
45 The category should be defined only in category table TABLE, which defaults
949ac151a10d [xemacs-hg @ 2007-05-20 20:09:20 by aidan]
aidan
parents: 952
diff changeset
46 to the current buffer's category table, but this is not implemented. "
949ac151a10d [xemacs-hg @ 2007-05-20 20:09:20 by aidan]
aidan
parents: 952
diff changeset
47 ;; #### Implement the limiting of the definition.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 (check-argument-type 'category-designator-p designator)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 (check-argument-type 'stringp doc-string)
3970
949ac151a10d [xemacs-hg @ 2007-05-20 20:09:20 by aidan]
aidan
parents: 952
diff changeset
50 (setq table (or table (category-table)))
949ac151a10d [xemacs-hg @ 2007-05-20 20:09:20 by aidan]
aidan
parents: 952
diff changeset
51 (check-argument-type 'category-table-p table)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 (puthash designator doc-string defined-category-hashtable))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 (defun undefine-category (designator)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 "Undefine DESIGNATOR as a designator for a category."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 (check-argument-type 'category-designator-p designator)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 (remhash designator defined-category-hashtable))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 (defun defined-category-p (designator)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 "Return non-nil if DESIGNATOR is a designator for a defined category."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 (and (category-designator-p designator)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 (gethash designator defined-category-hashtable)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 (defun defined-category-list ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 "Return a list of the currently defined categories.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 Categories are given by their designators."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 (let (list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 (maphash #'(lambda (key value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 (setq list (cons key list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 defined-category-hashtable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 (nreverse list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 (defun undefined-category-designator ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 "Return an undefined category designator, or nil if there are none."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 (let ((a 32) found)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 (while (and (< a 127) (not found))
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
77 (unless (gethash a defined-category-hashtable)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
78 (setq found (make-char 'ascii a)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 (setq a (1+ a)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 found))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 (defun category-doc-string (designator)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 "Return the doc-string for the category denoted by DESIGNATOR."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 (check-argument-type 'defined-category-p designator)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 (gethash designator defined-category-hashtable))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
87 (defun modify-category-entry (char-range designator &optional category-table reset)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 "Add a category to the categories associated with CHAR-RANGE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 CHAR-RANGE is a single character or a range of characters,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 as per `put-char-table'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 The category is given by a designator character.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
92 The changes are made in CATEGORY-TABLE, which defaults to the current
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
93 buffer's category table.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 If optional fourth argument RESET is non-nil, previous categories associated
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 with CHAR-RANGE are removed before adding the specified category."
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
96 (or category-table (setq category-table (category-table)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
97 (check-argument-type 'category-table-p category-table)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 (check-argument-type 'defined-category-p designator)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 (if reset
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 ;; clear all existing stuff.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
101 (put-char-table char-range nil category-table))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 (map-char-table
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 #'(lambda (key value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 ;; make sure that this range has a bit-vector assigned to it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 (if (not (bit-vector-p value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 (setq value (make-bit-vector 95 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 (setq value (copy-sequence value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 ;; set the appropriate bit in that vector.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 (aset value (- designator 32) 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 ;; put the vector back, thus assuring we have a unique setting for this range
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
111 (put-char-table key value category-table))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
112 category-table char-range))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
114 (defun char-category-list (character &optional category-table)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
115 "Return a list of the categories that CHARACTER is in.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
116 CATEGORY-TABLE defaults to the current buffer's category table.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 The categories are given by their designators."
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
118 (or category-table (setq category-table (category-table)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
119 (check-argument-type 'category-table-p category-table)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
120 (let ((vec (get-char-table character category-table)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 (if (null vec) nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 (let ((a 32) list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 (while (< a 127)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 (if (= 1 (aref vec (- a 32)))
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
125 (setq list (cons (make-char 'ascii a) list)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 (setq a (1+ a)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 (nreverse list)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
129 ;; implemented in C, file chartab.c (97/3/14 jhod@po.iijnet.or.jp)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 ;(defun char-in-category-p (char category &optional table)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 ; "Return non-nil if CHAR is in CATEGORY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 ;TABLE defaults to the current buffer's category table.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 ;Categories are specified by their designators."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 ; (or table (setq table (category-table)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 ; (check-argument-type 'category-table-p table)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 ; (check-argument-type 'category-designator-p category)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 ; (let ((vec (get-char-table char table)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 ; (if (null vec) nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 ; (= 1 (aref vec (- category 32))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140
788
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 502
diff changeset
141 (put 'with-category-table 'lisp-indent-function 1)
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 502
diff changeset
142
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 502
diff changeset
143 (defmacro with-category-table (category-table &rest body)
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 502
diff changeset
144 `(let ((current-category-table (category-table)))
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 502
diff changeset
145 (set-category-table ,category-table)
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 502
diff changeset
146 (unwind-protect
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 502
diff changeset
147 (progn ,@body)
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 502
diff changeset
148 (set-category-table current-category-table))))
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 502
diff changeset
149
3970
949ac151a10d [xemacs-hg @ 2007-05-20 20:09:20 by aidan]
aidan
parents: 952
diff changeset
150 (defun make-category-table ()
949ac151a10d [xemacs-hg @ 2007-05-20 20:09:20 by aidan]
aidan
parents: 952
diff changeset
151 "Construct a new and empty category table and return it."
949ac151a10d [xemacs-hg @ 2007-05-20 20:09:20 by aidan]
aidan
parents: 952
diff changeset
152 (make-char-table 'category))
949ac151a10d [xemacs-hg @ 2007-05-20 20:09:20 by aidan]
aidan
parents: 952
diff changeset
153
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 (defun describe-category ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 "Describe the category specifications in the category table.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 The descriptions are inserted in a buffer, which is then displayed."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 (interactive)
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
158 (with-displaying-help-buffer
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
159 (lambda ()
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
160 (describe-category-table (category-table) standard-output))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 (defun describe-category-table (table stream)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 (let (first-char
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 last-char
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 prev-val
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 (describe-one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 (lambda (first last value stream)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 (if (and (bit-vector-p value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 (> (reduce '+ value) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 (if (equal first last)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 (cond ((vectorp first)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 (princ (format "%s, row %d"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 (charset-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 (aref first 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 (aref first 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 ((charsetp first)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 (princ (charset-name first) stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 (t (princ first stream)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 (cond ((vectorp first)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 (princ (format "%s, rows %d .. %d"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 (charset-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 (aref first 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 (aref first 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 (aref last 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 (princ (format "%s .. %s" first last)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 stream))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 (describe-category-code value stream))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 (map-char-table
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 (lambda (range value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 (if (and (or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 (and (characterp range)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 (characterp first-char)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 (eq (char-charset range) (char-charset first-char))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 (= (char-to-int last-char) (1- (char-to-int range))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 (and (vectorp range)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 (vectorp first-char)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 (eq (aref range 0) (aref first-char 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 (= (aref last-char 1) (1- (aref range 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 (equal value prev-val)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 (setq last-char range)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 (if first-char
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 (funcall describe-one first-char last-char prev-val stream)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 (setq first-char nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 (funcall describe-one range range value stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 table)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 (if first-char
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 (funcall describe-one first-char last-char prev-val stream))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 (defun describe-category-code (code stream)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 (let ((standard-output (or stream standard-output)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 (princ "\tin categories: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 (if (not (bit-vector-p code))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 (princ "(none)")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 (let ((i 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 already-matched)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 (while (< i 95)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 (if (= 1 (aref code i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 (if (not already-matched)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 (setq already-matched t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 (princ " "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 (princ (int-to-char (+ 32 i)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 (setq i (1+ i)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 (if (not already-matched)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 (princ "(none)")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 (let ((i 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 (while (< i 95)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 (if (= 1 (aref code i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 (princ (format "\n\t\tmeaning: %s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 (category-doc-string (int-to-char (+ 32 i))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 (setq i (1+ i)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 (terpri)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 (defconst predefined-category-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 '((latin-iso8859-1 ?l "Latin-1 through Latin-5 character set")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 (latin-iso8859-2 ?l)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 (latin-iso8859-3 ?l)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 (latin-iso8859-4 ?l)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 (latin-iso8859-9 ?l)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 (cyrillic-iso8859-5 ?y "Cyrillic character set")
4805
980575c76541 Move the arabic-iso8859-6 character set back to C, otherwise X11 lookup fails.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4491
diff changeset
247 (arabic-iso8859-6 ?b "Arabic character set")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 (greek-iso8859-7 ?g "Greek character set")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 (hebrew-iso8859-8 ?w "Hebrew character set")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 (katakana-jisx0201 ?k "Japanese 1-byte Katakana character set")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 (latin-jisx0201 ?r "Japanese 1-byte Roman character set")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 (japanese-jisx0208-1978 ?j "Japanese 2-byte character set (old)")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 (japanese-jisx0208 ?j "Japanese 2-byte character set")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 (japanese-jisx0212 ?j)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 (chinese-gb2312 ?c "Chinese GB (China, PRC) 2-byte character set")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 (chinese-cns11643-1 ?t "Chinese Taiwan (CNS or Big5) 2-byte character set")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 (chinese-cns11643-2 ?t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 (chinese-big5-1 ?t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 (chinese-big5-2 ?t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 (korean-ksc5601 ?h "Hangul (Korean) 2-byte character set")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 "List of predefined categories.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 Each element is a list of a charset, a designator, and maybe a doc string.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 (let (i l)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 (define-category ?a "ASCII character set.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 (define-category ?l "Latin-1 through Latin-5 character set")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 (setq i 32)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 (while (< i 127)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 (modify-category-entry i ?a)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 (modify-category-entry i ?l)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 (setq i (1+ i)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 (setq l predefined-category-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 (while l
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 (if (and (nth 2 (car l))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 (not (defined-category-p (nth 2 (car l)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 (define-category (nth 1 (car l)) (nth 2 (car l))))
952
c10d0c3f965f [xemacs-hg @ 2002-08-02 16:54:11 by youngs]
youngs
parents: 788
diff changeset
278 (modify-category-entry (car (car l)) (nth 1 (car l)) nil t)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 (setq l (cdr l))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 ;;; Setting word boundary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 (setq word-combining-categories
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 '((?l . ?l)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 (setq word-separating-categories ; (2-byte character sets)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 '((?A . ?K) ; Alpha numeric - Katakana
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 (?A . ?C) ; Alpha numeric - Chinese
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 (?H . ?A) ; Hiragana - Alpha numeric
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 (?H . ?K) ; Hiragana - Katakana
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 (?H . ?C) ; Hiragana - Chinese
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 (?K . ?A) ; Katakana - Alpha numeric
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 (?K . ?C) ; Katakana - Chinese
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 (?C . ?A) ; Chinese - Alpha numeric
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 (?C . ?K) ; Chinese - Katakana
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 ;;; At the present, I know Japanese and Chinese text can
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 ;;; break line at any point under a restriction of 'kinsoku'.
450
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
300 ;;; #### SJT this needs to be set by language environments and probably should
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
301 ;;; be buffer-local---strategy for dealing with this: check all $language.el
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
302 ;;; files and also mule-base/$language-utils.el files for variables set;
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
303 ;;; these should be made buffer local and some kind of a- or p-list of vars
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
304 ;;; to be set for a language environment created.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 (defvar word-across-newline "\\(\\cj\\|\\cc\\|\\ct\\)"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 "Regular expression of such characters which can be a word across newline.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 (defvar ascii-char "[\40-\176]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 (defvar ascii-space "[ \t]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 (defvar ascii-symbols "[\40-\57\72-\100\133-\140\173-\176]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 (defvar ascii-numeric "[\60-\71]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 (defvar ascii-English-Upper "[\101-\132]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 (defvar ascii-English-Lower "[\141-\172]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 (defvar ascii-alphanumeric "[\60-\71\101-\132\141-\172]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 (defvar kanji-char "\\cj")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 (defvar kanji-space "$B!!(B")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 (defvar kanji-symbols "\\cS")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 (defvar kanji-numeric "[$B#0(B-$B#9(B]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 (defvar kanji-English-Upper "[$B#A(B-$B#Z(B]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 (defvar kanji-English-Lower "[$B#a(B-$B#z(B]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 (defvar kanji-hiragana "\\cH")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 (defvar kanji-katakana "\\cK")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 (defvar kanji-Greek-Upper "[$B&!(B-$B&8(B]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 (defvar kanji-Greek-Lower "[$B&A(B-$B&X(B]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 (defvar kanji-Russian-Upper "[$B'!(B-$B'A(B]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 (defvar kanji-Russian-Lower "[$B'Q(B-$B'q(B]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 (defvar kanji-Kanji-1st-Level "[$B0!(B-$BOS(B]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 (defvar kanji-Kanji-2nd-Level "[$BP!(B-$Bt$(B]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 (defvar kanji-kanji-char "\\(\\cH\\|\\cK\\|\\cC\\)")