# HG changeset patch
# User Dave Love <fx@gnu.org>
# Date 1022177812 0
# Node ID ec8e29bbca3792575d9d973913d0bcccf024978a
# Parent  f3dd1dced03a596870f99b9e5f9a8e5462bcdad0
Various simplifications and
additions.

diff -r f3dd1dced03a -r ec8e29bbca37 lisp/international/characters.el
--- a/lisp/international/characters.el	Thu May 23 18:15:02 2002 +0000
+++ b/lisp/international/characters.el	Thu May 23 18:16:52 2002 +0000
@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
 ;; Licensed to the Free Software Foundation.
-;; Copyright (C) 2001 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
 ;; Copyright (C) 2001, 2002
 ;;   National Institute of Advanced Industrial Science and Technology (AIST)
 ;;   Registration Number H13PRO009
@@ -113,9 +113,7 @@
 		  arabic-2-column)))
   (while charsets
 ;;     (modify-syntax-entry (make-char (car charsets)) "w")
-    (map-charset-chars
-     #'(lambda (char ignore) (modify-category-entry char ?b))
-     (car charsets))
+    (map-charset-chars #'modify-category-entry (car charsets) ?b)
     (setq charsets (cdr charsets))))
 (modify-category-entry '(#x600 . #x6ff) ?b)
 (modify-category-entry '(#xfb50 . #xfdff) ?b)
@@ -142,6 +140,8 @@
 (modify-syntax-entry ?\〗 ")〖")
 (modify-syntax-entry ?\】 ")【")
 
+;; Fixme: should any Chinese stuff be re-instated?
+
 ;; (modify-category-entry (make-char 'chinese-gb2312) ?c)
 ;; (modify-category-entry (make-char 'chinese-gb2312) ?\|)
 ;; (modify-category-entry (make-char 'chinese-gb2312 35) ?A)
@@ -191,10 +191,7 @@
 
 ;; Cyrillic character set (ISO-8859-5)
 
-(modify-syntax-entry (decode-char 'iso-8859-5 160) " ")
-(modify-syntax-entry ?­ ".")
 (modify-syntax-entry ?№ ".")
-(modify-syntax-entry ?§ ".")
 (let ((tbl (standard-case-table)))
   (set-case-syntax-pair ?Ё ?ё tbl)
   (set-case-syntax-pair ?Ђ ?ђ tbl)
@@ -285,23 +282,16 @@
 
 ;; Ethiopic character set
 
-;; (modify-category-entry (make-char 'ethiopic) ?e)
-;; (modify-syntax-entry (make-char 'ethiopic) "w")
 (modify-category-entry '(#x1200 . #x137b) ?e)
-(let ((chars '(?���� ?���� ?���� ?���� ?���� ?���� ?���� ?���� ?���� ?���� ?���� ?���� ?���� ?����
-	       ;; Unicode equivalents of the above:
-	       ?፡ ?። ?፣ ?፤ ?፥ ?፦ ?፧ ?፨ ?ﷰ ?ﷻ ?﷼ ?﷽ ?﷾ ?﷿)))
+(let ((chars '(?���� ?���� ?���� ?���� ?���� ?���� ?���� ?���� ?���� ?���� ?���� ?���� ?���� ?����)))
   (while chars
     (modify-syntax-entry (car chars) ".")
     (setq chars (cdr chars))))
+(map-charset-chars #'modify-category-entry 'ethiopic ?e)
 
 ;; Greek character set (ISO-8859-7)
 
-;; (modify-category-entry (make-char 'greek-iso8859-7) ?g)
-(let ((c #x370))
-  (while (<= c #x3ff)
-    (modify-category-entry (decode-char 'ucs c) ?g)
-    (setq c (1+ c))))
+(modify-category-entry '(#x370 . #x3ff) ?g)
 
 ;; (let ((c 182))
 ;;   (while (< c 255)
@@ -364,19 +354,15 @@
 
 ;; Hebrew character set (ISO-8859-8)
 
-;; (modify-category-entry (make-char 'hebrew-iso8859-8) ?w)
-(let ((c #x591))
-  (while (<= c #x5f4)
-    (modify-category-entry (decode-char 'ucs c) ?w)
-    (setq c (1+ c))))
+(modify-category-entry '(#x590 . #x5f4) ?w)
 
 ;; (modify-syntax-entry (make-char 'hebrew-iso8859-8 208) ".") ; PASEQ
 ;; (modify-syntax-entry (make-char 'hebrew-iso8859-8 211) ".") ; SOF PASUQ
-(modify-syntax-entry (decode-char 'ucs #x5be) ".") ; MAQAF
-(modify-syntax-entry (decode-char 'ucs #x5c0) ".") ; PASEQ
-(modify-syntax-entry (decode-char 'ucs #x5c3) ".") ; SOF PASUQ
-(modify-syntax-entry (decode-char 'ucs #x5f3) ".") ; GERESH
-(modify-syntax-entry (decode-char 'ucs #x5f4) ".") ; GERSHAYIM
+(modify-syntax-entry #x5be ".") ; MAQAF
+(modify-syntax-entry #x5c0 ".") ; PASEQ
+(modify-syntax-entry #x5c3 ".") ; SOF PASUQ
+(modify-syntax-entry #x5f3 ".") ; GERESH
+(modify-syntax-entry #x5f4 ".") ; GERSHAYIM
 
 ;; (let ((c 224))
 ;;   (while (< c 251)
@@ -390,10 +376,9 @@
 ;; (modify-category-entry (make-char 'indian-2-column) ?I)
 ;; (modify-category-entry (make-char 'indian-glyph) ?I)
 ;; Unicode Devanagari block
-(let ((c #x901))
-  (while (<= c #x970)
-    (modify-category-entry (decode-char 'ucs c) ?i)
-    (setq c (1+ c))))
+(modify-category-entry '(#x901 . #x970) ?i)
+(map-charset-chars #'modify-category-entry 'indian-is13194 ?i)
+(map-charset-chars #'modify-category-entry 'indian-2-column ?i)
 
 ;;; Commented out since the categories appear not to be used anywhere
 ;;; and word syntax is the default.
@@ -468,27 +453,27 @@
 ;; Unicode equivalents of JISX0201-kana
 (let ((c #xff61))
   (while (<= c #xff9f)
-    (modify-category-entry (decode-char 'ucs c) ?k)
-    (modify-category-entry (decode-char 'ucs c) ?j)
-    (modify-category-entry (decode-char 'ucs c) ?\|)
+    (modify-category-entry c ?k)
+    (modify-category-entry c ?j)
+    (modify-category-entry c ?\|)
     (setq c (1+ c))))
 
 ;; Katakana block
 (let ((c #x30a0))
   (while (<= c #x30ff)
     ;; ?K is double width, ?k isn't specified
-    (modify-category-entry (decode-char 'ucs c) ?K)
+    (modify-category-entry c ?K)
     ;;(modify-category-entry (decode-char 'ucs c) ?j)
-    (modify-category-entry (decode-char 'ucs c) ?\|) 
+    (modify-category-entry c ?\|) 
     (setq c (1+ c))))
 
 ;; Hiragana block
 (let ((c #x3040))
   (while (<= c #x309f)
     ;; ?H is actually defined to be double width
-    (modify-category-entry (decode-char 'ucs c) ?H)
+    (modify-category-entry c ?H)
     ;;(modify-category-entry (decode-char 'ucs c) ?j)
-    (modify-category-entry (decode-char 'ucs c) ?\|) 
+    (modify-category-entry c ?\|) 
     (setq c (1+ c))))
 
 ;; JISX0208
@@ -498,8 +483,7 @@
 			   (decode-char 'japanese-jisx0208 #x287E)) "_")
 (let ((chars '(?���� ?���� ?���� ?���� ?���� ?���� ?���� ?���� ?���� ?���� ?���� ?����)))
   (dolist (elt chars)
-    (modify-syntax-entry (car chars) "w")
-    (setq chars (cdr chars))))
+    (modify-syntax-entry (car chars) "w")))
 (modify-syntax-entry ?\���� "(����")
 (modify-syntax-entry ?\���� "(����")
 (modify-syntax-entry ?\���� "(����")
@@ -546,9 +530,7 @@
 
 ;; JISX0201-Kana
 ;; (modify-syntax-entry (make-char 'katakana-jisx0201) "w")
-(let ((chars '(?｡ ?､ ?･
-	       ;; Unicode:
-	       ?｡ ?､ ?･)))
+(let ((chars '(?｡ ?､ ?･)))
   (while chars
     (modify-syntax-entry (car chars) ".")
     (setq chars (cdr chars))))
@@ -558,6 +540,8 @@
 
 ;; Korean character set (KSC5601)
 
+;; Fixme: re-instate these
+
 ;; (modify-syntax-entry (make-char 'korean-ksc5601) "w")
 ;; (modify-syntax-entry (make-char 'korean-ksc5601 33) "_")
 ;; (modify-syntax-entry (make-char 'korean-ksc5601 34) "_")
@@ -573,41 +557,17 @@
 ;; (modify-category-entry (make-char 'korean-ksc5601 43) ?K)
 ;; (modify-category-entry (make-char 'korean-ksc5601 44) ?Y)
 
-;; Latin character set (latin-1,2,3,4,5,8,9)
+;; Latin
 
-;; (modify-category-entry (make-char 'latin-iso8859-1) ?l)
-;; (modify-category-entry (make-char 'latin-iso8859-2) ?l)
-;; (modify-category-entry (make-char 'latin-iso8859-3) ?l)
-;; (modify-category-entry (make-char 'latin-iso8859-4) ?l)
-;; (modify-category-entry (make-char 'latin-iso8859-9) ?l)
-;; (modify-category-entry (make-char 'latin-iso8859-14) ?l)
-;; (modify-category-entry (make-char 'latin-iso8859-15) ?l)
-
-;; (modify-category-entry (make-char 'latin-iso8859-1 160) ?\ )
-;; (modify-category-entry (make-char 'latin-iso8859-2 160) ?\ )
-;; (modify-category-entry (make-char 'latin-iso8859-3 160) ?\ )
-;; (modify-category-entry (make-char 'latin-iso8859-4 160) ?\ )
-;; (modify-category-entry (make-char 'latin-iso8859-9 160) ?\ )
-;; (modify-category-entry (make-char 'latin-iso8859-14 160) ?\ )
-;; (modify-category-entry (make-char 'latin-iso8859-15 160) ?\ )
+(modify-category-entry '(#x80 . #x024F) ?l)
 
 ;; Lao character set
 
-;; (modify-category-entry (make-char 'lao) ?o)
-(dotimes (i (1+ (- #xeff #xe80)))
-  (modify-category-entry (decode-char 'ucs (+ i #xe80)) ?o))
+(modify-category-entry '(#xe80 . #xeff) ?o)
+(map-charset-chars #'modify-category-entry 'lao ?o)
 
-(let ((deflist	'(;; chars	syntax	category
-		  ("ກ-ຮ"	"w"	?0) ; consonant
-		  ("ະາຳຽເ-ໄ"	"w"	?1) ; vowel base
-		  ("ັິ-ືົໍ"	"w"	?2) ; vowel upper
-		  ("ຸູ"		"w"	?3) ; vowel lower
-		  ("່-໌"	"w"	?4) ; tone mark 
-		  ("ຼ"		"w"	?9) ; semivowel lower
-		  ("໐-໙"	"w"	?6) ; digit
-		  ("ຯໆ"		"_"	?5) ; symbol
-		  ;; Unicode equivalents
-		  ("ກ-ຮ"	"w"	?0) ; consonant
+;; Fixme: check this.  Lao characters in HELLO seem to have all the categories
+(let ((deflist	'(("ກ-ຮ"	"w"	?0) ; consonant
 		  ("ະາຳຽເ-ໄ"	"w"	?1) ; vowel base
 		  ("ັິ-ືົໍ"	"w"	?2) ; vowel upper
 		  ("ຸູ"	"w"	?3) ; vowel lower
@@ -640,9 +600,8 @@
 
 ;; Thai character set (TIS620)
 
-;; (modify-category-entry (make-char 'thai-tis620) ?t)
-(dotimes (i (1+ (- #xe7f #xe00)))
-  (modify-category-entry (decode-char 'ucs (+ i #xe00)) ?t))
+(modify-category-entry '(#xe00 . #xe7f) ?t)
+(map-charset-chars #'modify-category-entry 'thai-tis620 ?t)
 
 (let ((deflist	'(;; chars	syntax	category
 		  ("ก-รลว-ฮ"	"w"	?0) ; consonant
@@ -677,10 +636,9 @@
 
 ;; Tibetan character set
 
-;; (modify-category-entry (make-char 'tibetan) ?q)
-;; (modify-category-entry (make-char 'tibetan-1-column) ?q)
-(dotimes (i (1+ (- #xfff #xf00)))
-  (modify-category-entry (decode-char 'ucs (+ i #xf00)) ?q))
+(modify-category-entry '(#xf00 . #xfff) ?q)
+(map-charset-chars #'modify-category-entry 'tibetan ?q)
+(map-charset-chars #'modify-category-entry 'tibetan-1-column ?q)
 
 (let ((deflist	'(;; chars             syntax category
 		  ("����-��������"        	"w"	?0) ; consonant
@@ -697,18 +655,6 @@
 		  ("����������������������������"            "."     ?>) ;
 		  ("����-��������������������"      "."     ?<) ; prohibition
 		  ("��������-��������-������������-��������������������-����" "." ?q) ; others
-
-		  ;; Unicode version (not complete)
-		  ("ཀ-ཀྵཪ"        	"w"	?0) ; consonant
-		  ("ྐ-ྐྵྺྻྼ"       "w"     ?0) ;
-		  ("ིེཻོཽྀ"       "w"	?2) ; upper vowel
-		  ("ཾྂྃ྆྇ྈྉྊྋ" "w"	?2) ; upper modifier
-		  ("༙཰྄ཱུ༵༷"       "w"	?3) ; lowel vowel/modifier
-		  ("༠-༩༪-༳"	        "w"	?6) ; digit
-		  ("་།-༒༔ཿ"        "."     ?|) ; line-break char
-		  ("༈་།-༒༔ཿ༽༴"  "."     ?>) ; prohibition
-		  ("ༀ-༊༼࿁࿂྅"      "."     ?<) ; prohibition
-		  ("༓༕-༘༚-༟༶༸-༻༾༿྾྿-࿏" "." ?q) ; others
 		  ))
       elm chars len syntax category to ch i)
   (while deflist
@@ -734,15 +680,13 @@
 
 ;; Vietnamese character set
 
-;; (let ((lower (make-char 'vietnamese-viscii-lower))
-;;      (upper (make-char 'vietnamese-viscii-upper)))
-;;   (modify-syntax-entry lower "w")
-;;   (modify-syntax-entry upper "w")
-;;  (modify-category-entry lower ?v)
-;;  (modify-category-entry upper ?v)
-;;  (modify-category-entry lower ?l)	; To make a word with
-;;  (modify-category-entry upper ?l)	; latin characters.
-;;  )
+;; To make a word with Latin characters
+(map-charset-chars #'modify-category-entry 'vietnamese-viscii-lower ?l)
+(map-charset-chars #'modify-category-entry 'vietnamese-viscii-lower ?v)
+
+(map-charset-chars #'modify-category-entry 'vietnamese-viscii-upper ?l)
+(map-charset-chars #'modify-category-entry 'vietnamese-viscii-upper ?v)
+;; Fixme Unicode versions of Vietnamese categeory.
 
 (let ((tbl (standard-case-table))
       (i 32))
@@ -766,17 +710,14 @@
   ;; Latin Extended-A, Latin Extended-B
   (setq c #x0100)
   (while (<= c #x0233)
-    (modify-category-entry (decode-char 'ucs c) ?l)
     (and (or (<= c #x012e)
 	     (and (>= c #x014a) (<= c #x0177)))
 	 (zerop (% c 2))
-	 (set-case-syntax-pair
-	  (decode-char 'ucs c) (decode-char 'ucs (1+ c)) tbl))
+	 (set-case-syntax-pair c (1+ c) tbl))
     (and (>= c #x013a)
 	 (<= c #x0148)
 	 (zerop (% c 2))
-	 (set-case-syntax-pair
-	  (decode-char 'ucs (1- c)) (decode-char 'ucs c) tbl))
+	 (set-case-syntax-pair (1- c) c tbl))
     (setq c (1+ c)))
   (set-case-syntax-pair ?IJ ?ij tbl)
   (set-case-syntax-pair ?Ĵ ?ĵ tbl)
@@ -883,28 +824,25 @@
   (set-case-syntax-pair ?Ȳ ?ȳ tbl)
 
   ;; Latin Extended Additional
+  (modify-category-entry '(#x1e00 . #x1ef9) ?l)
   (setq c #x1e00)
   (while (<= c #x1ef9)
-    (modify-category-entry (decode-char 'ucs c) ?l)
     (and (zerop (% c 2))
 	 (or (<= c #x1e94) (>= c #x1ea0))
-	 (set-case-syntax-pair
-	  (decode-char 'ucs c) (decode-char 'ucs (1+ c)) tbl))
+	 (set-case-syntax-pair c (1+ c) tbl))
     (setq c (1+ c)))
 
   ;; Greek
+  (modify-category-entry '(#x0370 . #x03ff) ?g)
   (setq c #x0370)
   (while (<= c #x03ff)
-    (modify-category-entry (decode-char 'ucs c) ?g)
     (if (or (and (>= c #x0391) (<= c #x03a1))
 	    (and (>= c #x03a3) (<= c #x03ab)))
-	(set-case-syntax-pair
-	 (decode-char 'ucs c) (decode-char 'ucs (+ c 32)) tbl))
+	(set-case-syntax-pair c (+ c 32) tbl))
     (and (>= c #x03da)
 	 (<= c #x03ee)
 	 (zerop (% c 2))
-	 (set-case-syntax-pair
-	  (decode-char 'ucs c) (decode-char 'ucs (1+ c)) tbl))
+	 (set-case-syntax-pair c (1+ c) tbl))
     (setq c (1+ c)))
   (set-case-syntax-pair ?Ά ?ά tbl)
   (set-case-syntax-pair ?Έ ?έ tbl)
@@ -917,20 +855,18 @@
   ;; Armenian
   (setq c #x531)
   (while (<= c #x556)
-    (set-case-syntax-pair (decode-char 'ucs c)
-			  (decode-char 'ucs (+ c #x30)) tbl)
+    (set-case-syntax-pair c (+ c #x30) tbl)
     (setq c (1+ c)))
 
   ;; Greek Extended
+  (modify-category-entry '(#x1f00 . #x1fff) ?g)
   (setq c #x1f00)
   (while (<= c #x1fff)
-    (modify-category-entry (decode-char 'ucs c) ?g)
     (and (<= (logand c #x000f) 7)
 	 (<= c #x1fa7)
 	 (not (memq c '(#x1f50 #x1f52 #x1f54 #x1f56)))
 	 (/= (logand c #x00f0) 7)
-	 (set-case-syntax-pair
-	  (decode-char 'ucs (+ c 8)) (decode-char 'ucs c) tbl))
+	 (set-case-syntax-pair (+ c 8) c tbl))
     (setq c (1+ c)))
   (set-case-syntax-pair ?Ᾰ ?ᾰ tbl)
   (set-case-syntax-pair ?Ᾱ ?ᾱ tbl)
@@ -958,23 +894,20 @@
   (set-case-syntax-pair ?ῼ ?ῳ tbl)
 
   ;; cyrillic
+  (modify-category-entry '(#x0400 . #x04FF) ?y)
   (setq c #x0400)
   (while (<= c #x04ff)
-    (modify-category-entry (decode-char 'ucs c) ?y)
     (and (>= c #x0400)
 	 (<= c #x040f)
-	 (set-case-syntax-pair
-	  (decode-char 'ucs c) (decode-char 'ucs (+ c 80)) tbl))
+	 (set-case-syntax-pair c (+ c 80) tbl))
     (and (>= c #x0410)
 	 (<= c #x042f)
-	 (set-case-syntax-pair
-	  (decode-char 'ucs c) (decode-char 'ucs (+ c 32)) tbl))
+	 (set-case-syntax-pair c (+ c 32) tbl))
     (and (zerop (% c 2))
 	 (or (and (>= c #x0460) (<= c #x0480))
 	     (and (>= c #x048c) (<= c #x04be))
 	     (and (>= c #x04d0) (<= c #x04f4)))
-	 (set-case-syntax-pair
-	  (decode-char 'ucs c) (decode-char 'ucs (1+ c)) tbl))	 
+	 (set-case-syntax-pair c (1+ c) tbl))	 
     (setq c (1+ c)))
   (set-case-syntax-pair ?Ӂ ?ӂ tbl)
   (set-case-syntax-pair ?Ӄ ?ӄ tbl)
@@ -995,45 +928,35 @@
   ;; Roman numerals
   (setq c #x2160)
   (while (<= c #x216f)
-    (set-case-syntax-pair (decode-char 'ucs c)
-			  (decode-char 'ucs (+ c #x10)) tbl)
+    (set-case-syntax-pair c (+ c #x10) tbl)
     (setq c (1+ c)))
 
   ;; Circled Latin
   (setq c #x24b6)
   (while (<= c #x24cf)
-    (set-case-syntax-pair (decode-char 'ucs c)
-			  (decode-char 'ucs (+ c 26)) tbl)
-    (modify-category-entry (decode-char 'ucs c) ?l)
-    (modify-category-entry (decode-char 'ucs (+ c 26)) ?l)
+    (set-case-syntax-pair c (+ c 26) tbl)
+    (modify-category-entry c ?l)
+    (modify-category-entry (+ c 26) ?l)
     (setq c (1+ c)))
 
   ;; Fullwidth Latin
   (setq c #xff21)
   (while (<= c #xff3a)
-    (set-case-syntax-pair (decode-char 'ucs c)
-			  (decode-char 'ucs (+ c #x20)) tbl)
-    (modify-category-entry (decode-char 'ucs c) ?l)
-    (modify-category-entry (decode-char 'ucs (+ c #x20)) ?l)
+    (set-case-syntax-pair c (+ c #x20) tbl)
+    (modify-category-entry c ?l)
+    (modify-category-entry (+ c #x20) ?l)
     (setq c (1+ c)))
 
   ;; Ohm, Kelvin, Angstrom
-  (set-case-syntax-pair ?Ω ?ω tbl)
+;;;  (set-case-syntax-pair ?Ω ?ω tbl)
 ;;;  These mess up the case conversion of k and å.
 ;;;  (set-case-syntax-pair ?K ?k tbl)
 ;;;  (set-case-syntax-pair ?Å ?å tbl)
 
   ;; Combining diacritics
-  (setq c #x300)
-  (while (<= c #x362)
-    (modify-category-entry (decode-char 'ucs c) ?^)
-    (setq c (1+ c)))
-
+  (modify-category-entry '(#x300 . #x362) ?^)
   ;; Combining marks
-  (setq c #x20d0)
-  (while (<= c #x20e3)
-    (modify-category-entry (decode-char 'ucs c) ?^)
-    (setq c (1+ c)))
+  (modify-category-entry '(#x20d0 . #x20e3) ?^)
 
   ;; Fixme: syntax for symbols &c
   )
@@ -1059,6 +982,7 @@
 ;; For each character set, put the information of the most proper
 ;; coding system to encode it by `preferred-coding-system' property.
 
+;; Fixme: should this be junked?
 (let ((l '((latin-iso8859-1	. iso-latin-1)
 	   (latin-iso8859-2	. iso-latin-2)
 	   (latin-iso8859-3	. iso-latin-3)
@@ -1131,8 +1055,7 @@
 	   (#xFFE0 . #xFFEF))))
   (dolist (elt l)
     (set-char-table-range char-width-table
-			  (cons (decode-char 'ucs (car elt))
-				(decode-char 'ucs (cdr elt)))
+			  (cons (car elt) (cdr elt))
 			  2)))
 (map-charset-chars
  #'(lambda (range ignore) (set-char-table-range char-width-table range 2))