2 |
|
|
3 |
;; Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN. |
;; Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN. |
4 |
;; Licensed to the Free Software Foundation. |
;; Licensed to the Free Software Foundation. |
5 |
;; Copyright (C) 2001 Free Software Foundation, Inc. |
;; Copyright (C) 2001, 2002 Free Software Foundation, Inc. |
6 |
;; Copyright (C) 2001, 2002 |
;; Copyright (C) 2001, 2002 |
7 |
;; National Institute of Advanced Industrial Science and Technology (AIST) |
;; National Institute of Advanced Industrial Science and Technology (AIST) |
8 |
;; Registration Number H13PRO009 |
;; Registration Number H13PRO009 |
113 |
arabic-2-column))) |
arabic-2-column))) |
114 |
(while charsets |
(while charsets |
115 |
;; (modify-syntax-entry (make-char (car charsets)) "w") |
;; (modify-syntax-entry (make-char (car charsets)) "w") |
116 |
(map-charset-chars |
(map-charset-chars #'modify-category-entry (car charsets) ?b) |
|
#'(lambda (char ignore) (modify-category-entry char ?b)) |
|
|
(car charsets)) |
|
117 |
(setq charsets (cdr charsets)))) |
(setq charsets (cdr charsets)))) |
118 |
(modify-category-entry '(#x600 . #x6ff) ?b) |
(modify-category-entry '(#x600 . #x6ff) ?b) |
119 |
(modify-category-entry '(#xfb50 . #xfdff) ?b) |
(modify-category-entry '(#xfb50 . #xfdff) ?b) |
140 |
(modify-syntax-entry ?\〗 ")〖") |
(modify-syntax-entry ?\〗 ")〖") |
141 |
(modify-syntax-entry ?\】 ")【") |
(modify-syntax-entry ?\】 ")【") |
142 |
|
|
143 |
|
;; Fixme: should any Chinese stuff be re-instated? |
144 |
|
|
145 |
;; (modify-category-entry (make-char 'chinese-gb2312) ?c) |
;; (modify-category-entry (make-char 'chinese-gb2312) ?c) |
146 |
;; (modify-category-entry (make-char 'chinese-gb2312) ?\|) |
;; (modify-category-entry (make-char 'chinese-gb2312) ?\|) |
147 |
;; (modify-category-entry (make-char 'chinese-gb2312 35) ?A) |
;; (modify-category-entry (make-char 'chinese-gb2312 35) ?A) |
191 |
|
|
192 |
;; Cyrillic character set (ISO-8859-5) |
;; Cyrillic character set (ISO-8859-5) |
193 |
|
|
|
(modify-syntax-entry (decode-char 'iso-8859-5 160) " ") |
|
|
(modify-syntax-entry ? ".") |
|
194 |
(modify-syntax-entry ?№ ".") |
(modify-syntax-entry ?№ ".") |
|
(modify-syntax-entry ?§ ".") |
|
195 |
(let ((tbl (standard-case-table))) |
(let ((tbl (standard-case-table))) |
196 |
(set-case-syntax-pair ?Ё ?ё tbl) |
(set-case-syntax-pair ?Ё ?ё tbl) |
197 |
(set-case-syntax-pair ?Ђ ?ђ tbl) |
(set-case-syntax-pair ?Ђ ?ђ tbl) |
282 |
|
|
283 |
;; Ethiopic character set |
;; Ethiopic character set |
284 |
|
|
|
;; (modify-category-entry (make-char 'ethiopic) ?e) |
|
|
;; (modify-syntax-entry (make-char 'ethiopic) "w") |
|
285 |
(modify-category-entry '(#x1200 . #x137b) ?e) |
(modify-category-entry '(#x1200 . #x137b) ?e) |
286 |
(let ((chars '(? ? ? ? ? ? ? ? ? ? ? ? ? ? |
(let ((chars '(? ? ? ? ? ? ? ? ? ? ? ? ? ?))) |
|
;; Unicode equivalents of the above: |
|
|
?፡ ?። ?፣ ?፤ ?፥ ?፦ ?፧ ?፨ ?ﷰ ?ﷻ ?﷼ ?﷽ ?﷾ ?﷿))) |
|
287 |
(while chars |
(while chars |
288 |
(modify-syntax-entry (car chars) ".") |
(modify-syntax-entry (car chars) ".") |
289 |
(setq chars (cdr chars)))) |
(setq chars (cdr chars)))) |
290 |
|
(map-charset-chars #'modify-category-entry 'ethiopic ?e) |
291 |
|
|
292 |
;; Greek character set (ISO-8859-7) |
;; Greek character set (ISO-8859-7) |
293 |
|
|
294 |
;; (modify-category-entry (make-char 'greek-iso8859-7) ?g) |
(modify-category-entry '(#x370 . #x3ff) ?g) |
|
(let ((c #x370)) |
|
|
(while (<= c #x3ff) |
|
|
(modify-category-entry (decode-char 'ucs c) ?g) |
|
|
(setq c (1+ c)))) |
|
295 |
|
|
296 |
;; (let ((c 182)) |
;; (let ((c 182)) |
297 |
;; (while (< c 255) |
;; (while (< c 255) |
354 |
|
|
355 |
;; Hebrew character set (ISO-8859-8) |
;; Hebrew character set (ISO-8859-8) |
356 |
|
|
357 |
;; (modify-category-entry (make-char 'hebrew-iso8859-8) ?w) |
(modify-category-entry '(#x590 . #x5f4) ?w) |
|
(let ((c #x591)) |
|
|
(while (<= c #x5f4) |
|
|
(modify-category-entry (decode-char 'ucs c) ?w) |
|
|
(setq c (1+ c)))) |
|
358 |
|
|
359 |
;; (modify-syntax-entry (make-char 'hebrew-iso8859-8 208) ".") ; PASEQ |
;; (modify-syntax-entry (make-char 'hebrew-iso8859-8 208) ".") ; PASEQ |
360 |
;; (modify-syntax-entry (make-char 'hebrew-iso8859-8 211) ".") ; SOF PASUQ |
;; (modify-syntax-entry (make-char 'hebrew-iso8859-8 211) ".") ; SOF PASUQ |
361 |
(modify-syntax-entry (decode-char 'ucs #x5be) ".") ; MAQAF |
(modify-syntax-entry #x5be ".") ; MAQAF |
362 |
(modify-syntax-entry (decode-char 'ucs #x5c0) ".") ; PASEQ |
(modify-syntax-entry #x5c0 ".") ; PASEQ |
363 |
(modify-syntax-entry (decode-char 'ucs #x5c3) ".") ; SOF PASUQ |
(modify-syntax-entry #x5c3 ".") ; SOF PASUQ |
364 |
(modify-syntax-entry (decode-char 'ucs #x5f3) ".") ; GERESH |
(modify-syntax-entry #x5f3 ".") ; GERESH |
365 |
(modify-syntax-entry (decode-char 'ucs #x5f4) ".") ; GERSHAYIM |
(modify-syntax-entry #x5f4 ".") ; GERSHAYIM |
366 |
|
|
367 |
;; (let ((c 224)) |
;; (let ((c 224)) |
368 |
;; (while (< c 251) |
;; (while (< c 251) |
376 |
;; (modify-category-entry (make-char 'indian-2-column) ?I) |
;; (modify-category-entry (make-char 'indian-2-column) ?I) |
377 |
;; (modify-category-entry (make-char 'indian-glyph) ?I) |
;; (modify-category-entry (make-char 'indian-glyph) ?I) |
378 |
;; Unicode Devanagari block |
;; Unicode Devanagari block |
379 |
(let ((c #x901)) |
(modify-category-entry '(#x901 . #x970) ?i) |
380 |
(while (<= c #x970) |
(map-charset-chars #'modify-category-entry 'indian-is13194 ?i) |
381 |
(modify-category-entry (decode-char 'ucs c) ?i) |
(map-charset-chars #'modify-category-entry 'indian-2-column ?i) |
|
(setq c (1+ c)))) |
|
382 |
|
|
383 |
;;; Commented out since the categories appear not to be used anywhere |
;;; Commented out since the categories appear not to be used anywhere |
384 |
;;; and word syntax is the default. |
;;; and word syntax is the default. |
453 |
;; Unicode equivalents of JISX0201-kana |
;; Unicode equivalents of JISX0201-kana |
454 |
(let ((c #xff61)) |
(let ((c #xff61)) |
455 |
(while (<= c #xff9f) |
(while (<= c #xff9f) |
456 |
(modify-category-entry (decode-char 'ucs c) ?k) |
(modify-category-entry c ?k) |
457 |
(modify-category-entry (decode-char 'ucs c) ?j) |
(modify-category-entry c ?j) |
458 |
(modify-category-entry (decode-char 'ucs c) ?\|) |
(modify-category-entry c ?\|) |
459 |
(setq c (1+ c)))) |
(setq c (1+ c)))) |
460 |
|
|
461 |
;; Katakana block |
;; Katakana block |
462 |
(let ((c #x30a0)) |
(let ((c #x30a0)) |
463 |
(while (<= c #x30ff) |
(while (<= c #x30ff) |
464 |
;; ?K is double width, ?k isn't specified |
;; ?K is double width, ?k isn't specified |
465 |
(modify-category-entry (decode-char 'ucs c) ?K) |
(modify-category-entry c ?K) |
466 |
;;(modify-category-entry (decode-char 'ucs c) ?j) |
;;(modify-category-entry (decode-char 'ucs c) ?j) |
467 |
(modify-category-entry (decode-char 'ucs c) ?\|) |
(modify-category-entry c ?\|) |
468 |
(setq c (1+ c)))) |
(setq c (1+ c)))) |
469 |
|
|
470 |
;; Hiragana block |
;; Hiragana block |
471 |
(let ((c #x3040)) |
(let ((c #x3040)) |
472 |
(while (<= c #x309f) |
(while (<= c #x309f) |
473 |
;; ?H is actually defined to be double width |
;; ?H is actually defined to be double width |
474 |
(modify-category-entry (decode-char 'ucs c) ?H) |
(modify-category-entry c ?H) |
475 |
;;(modify-category-entry (decode-char 'ucs c) ?j) |
;;(modify-category-entry (decode-char 'ucs c) ?j) |
476 |
(modify-category-entry (decode-char 'ucs c) ?\|) |
(modify-category-entry c ?\|) |
477 |
(setq c (1+ c)))) |
(setq c (1+ c)))) |
478 |
|
|
479 |
;; JISX0208 |
;; JISX0208 |
483 |
(decode-char 'japanese-jisx0208 #x287E)) "_") |
(decode-char 'japanese-jisx0208 #x287E)) "_") |
484 |
(let ((chars '(? ? ? ? ? ? ? ? ? ? ? ?))) |
(let ((chars '(? ? ? ? ? ? ? ? ? ? ? ?))) |
485 |
(dolist (elt chars) |
(dolist (elt chars) |
486 |
(modify-syntax-entry (car chars) "w") |
(modify-syntax-entry (car chars) "w"))) |
|
(setq chars (cdr chars)))) |
|
487 |
(modify-syntax-entry ?\ "(") |
(modify-syntax-entry ?\ "(") |
488 |
(modify-syntax-entry ?\ "(") |
(modify-syntax-entry ?\ "(") |
489 |
(modify-syntax-entry ?\ "(") |
(modify-syntax-entry ?\ "(") |
530 |
|
|
531 |
;; JISX0201-Kana |
;; JISX0201-Kana |
532 |
;; (modify-syntax-entry (make-char 'katakana-jisx0201) "w") |
;; (modify-syntax-entry (make-char 'katakana-jisx0201) "w") |
533 |
(let ((chars '(?。 ?、 ?・ |
(let ((chars '(?。 ?、 ?・))) |
|
;; Unicode: |
|
|
?。 ?、 ?・))) |
|
534 |
(while chars |
(while chars |
535 |
(modify-syntax-entry (car chars) ".") |
(modify-syntax-entry (car chars) ".") |
536 |
(setq chars (cdr chars)))) |
(setq chars (cdr chars)))) |
540 |
|
|
541 |
;; Korean character set (KSC5601) |
;; Korean character set (KSC5601) |
542 |
|
|
543 |
|
;; Fixme: re-instate these |
544 |
|
|
545 |
;; (modify-syntax-entry (make-char 'korean-ksc5601) "w") |
;; (modify-syntax-entry (make-char 'korean-ksc5601) "w") |
546 |
;; (modify-syntax-entry (make-char 'korean-ksc5601 33) "_") |
;; (modify-syntax-entry (make-char 'korean-ksc5601 33) "_") |
547 |
;; (modify-syntax-entry (make-char 'korean-ksc5601 34) "_") |
;; (modify-syntax-entry (make-char 'korean-ksc5601 34) "_") |
557 |
;; (modify-category-entry (make-char 'korean-ksc5601 43) ?K) |
;; (modify-category-entry (make-char 'korean-ksc5601 43) ?K) |
558 |
;; (modify-category-entry (make-char 'korean-ksc5601 44) ?Y) |
;; (modify-category-entry (make-char 'korean-ksc5601 44) ?Y) |
559 |
|
|
560 |
;; Latin character set (latin-1,2,3,4,5,8,9) |
;; Latin |
561 |
|
|
562 |
;; (modify-category-entry (make-char 'latin-iso8859-1) ?l) |
(modify-category-entry '(#x80 . #x024F) ?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) ?\ ) |
|
563 |
|
|
564 |
;; Lao character set |
;; Lao character set |
565 |
|
|
566 |
;; (modify-category-entry (make-char 'lao) ?o) |
(modify-category-entry '(#xe80 . #xeff) ?o) |
567 |
(dotimes (i (1+ (- #xeff #xe80))) |
(map-charset-chars #'modify-category-entry 'lao ?o) |
|
(modify-category-entry (decode-char 'ucs (+ i #xe80)) ?o)) |
|
568 |
|
|
569 |
(let ((deflist '(;; chars syntax category |
;; Fixme: check this. Lao characters in HELLO seem to have all the categories |
570 |
("ກ-ຮ" "w" ?0) ; consonant |
(let ((deflist '(("ກ-ຮ" "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 |
|
571 |
("ະາຳຽເ-ໄ" "w" ?1) ; vowel base |
("ະາຳຽເ-ໄ" "w" ?1) ; vowel base |
572 |
("ັິ-ືົໍ" "w" ?2) ; vowel upper |
("ັິ-ືົໍ" "w" ?2) ; vowel upper |
573 |
("ຸູ" "w" ?3) ; vowel lower |
("ຸູ" "w" ?3) ; vowel lower |
600 |
|
|
601 |
;; Thai character set (TIS620) |
;; Thai character set (TIS620) |
602 |
|
|
603 |
;; (modify-category-entry (make-char 'thai-tis620) ?t) |
(modify-category-entry '(#xe00 . #xe7f) ?t) |
604 |
(dotimes (i (1+ (- #xe7f #xe00))) |
(map-charset-chars #'modify-category-entry 'thai-tis620 ?t) |
|
(modify-category-entry (decode-char 'ucs (+ i #xe00)) ?t)) |
|
605 |
|
|
606 |
(let ((deflist '(;; chars syntax category |
(let ((deflist '(;; chars syntax category |
607 |
("ก-รลว-ฮ" "w" ?0) ; consonant |
("ก-รลว-ฮ" "w" ?0) ; consonant |
636 |
|
|
637 |
;; Tibetan character set |
;; Tibetan character set |
638 |
|
|
639 |
;; (modify-category-entry (make-char 'tibetan) ?q) |
(modify-category-entry '(#xf00 . #xfff) ?q) |
640 |
;; (modify-category-entry (make-char 'tibetan-1-column) ?q) |
(map-charset-chars #'modify-category-entry 'tibetan ?q) |
641 |
(dotimes (i (1+ (- #xfff #xf00))) |
(map-charset-chars #'modify-category-entry 'tibetan-1-column ?q) |
|
(modify-category-entry (decode-char 'ucs (+ i #xf00)) ?q)) |
|
642 |
|
|
643 |
(let ((deflist '(;; chars syntax category |
(let ((deflist '(;; chars syntax category |
644 |
("-" "w" ?0) ; consonant |
("-" "w" ?0) ; consonant |
655 |
("" "." ?>) ; |
("" "." ?>) ; |
656 |
("-" "." ?<) ; prohibition |
("-" "." ?<) ; prohibition |
657 |
("----" "." ?q) ; others |
("----" "." ?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 |
|
658 |
)) |
)) |
659 |
elm chars len syntax category to ch i) |
elm chars len syntax category to ch i) |
660 |
(while deflist |
(while deflist |
680 |
|
|
681 |
;; Vietnamese character set |
;; Vietnamese character set |
682 |
|
|
683 |
;; (let ((lower (make-char 'vietnamese-viscii-lower)) |
;; To make a word with Latin characters |
684 |
;; (upper (make-char 'vietnamese-viscii-upper))) |
(map-charset-chars #'modify-category-entry 'vietnamese-viscii-lower ?l) |
685 |
;; (modify-syntax-entry lower "w") |
(map-charset-chars #'modify-category-entry 'vietnamese-viscii-lower ?v) |
686 |
;; (modify-syntax-entry upper "w") |
|
687 |
;; (modify-category-entry lower ?v) |
(map-charset-chars #'modify-category-entry 'vietnamese-viscii-upper ?l) |
688 |
;; (modify-category-entry upper ?v) |
(map-charset-chars #'modify-category-entry 'vietnamese-viscii-upper ?v) |
689 |
;; (modify-category-entry lower ?l) ; To make a word with |
;; Fixme Unicode versions of Vietnamese categeory. |
|
;; (modify-category-entry upper ?l) ; latin characters. |
|
|
;; ) |
|
690 |
|
|
691 |
(let ((tbl (standard-case-table)) |
(let ((tbl (standard-case-table)) |
692 |
(i 32)) |
(i 32)) |
710 |
;; Latin Extended-A, Latin Extended-B |
;; Latin Extended-A, Latin Extended-B |
711 |
(setq c #x0100) |
(setq c #x0100) |
712 |
(while (<= c #x0233) |
(while (<= c #x0233) |
|
(modify-category-entry (decode-char 'ucs c) ?l) |
|
713 |
(and (or (<= c #x012e) |
(and (or (<= c #x012e) |
714 |
(and (>= c #x014a) (<= c #x0177))) |
(and (>= c #x014a) (<= c #x0177))) |
715 |
(zerop (% c 2)) |
(zerop (% c 2)) |
716 |
(set-case-syntax-pair |
(set-case-syntax-pair c (1+ c) tbl)) |
|
(decode-char 'ucs c) (decode-char 'ucs (1+ c)) tbl)) |
|
717 |
(and (>= c #x013a) |
(and (>= c #x013a) |
718 |
(<= c #x0148) |
(<= c #x0148) |
719 |
(zerop (% c 2)) |
(zerop (% c 2)) |
720 |
(set-case-syntax-pair |
(set-case-syntax-pair (1- c) c tbl)) |
|
(decode-char 'ucs (1- c)) (decode-char 'ucs c) tbl)) |
|
721 |
(setq c (1+ c))) |
(setq c (1+ c))) |
722 |
(set-case-syntax-pair ?IJ ?ij tbl) |
(set-case-syntax-pair ?IJ ?ij tbl) |
723 |
(set-case-syntax-pair ?Ĵ ?ĵ tbl) |
(set-case-syntax-pair ?Ĵ ?ĵ tbl) |
824 |
(set-case-syntax-pair ?Ȳ ?ȳ tbl) |
(set-case-syntax-pair ?Ȳ ?ȳ tbl) |
825 |
|
|
826 |
;; Latin Extended Additional |
;; Latin Extended Additional |
827 |
|
(modify-category-entry '(#x1e00 . #x1ef9) ?l) |
828 |
(setq c #x1e00) |
(setq c #x1e00) |
829 |
(while (<= c #x1ef9) |
(while (<= c #x1ef9) |
|
(modify-category-entry (decode-char 'ucs c) ?l) |
|
830 |
(and (zerop (% c 2)) |
(and (zerop (% c 2)) |
831 |
(or (<= c #x1e94) (>= c #x1ea0)) |
(or (<= c #x1e94) (>= c #x1ea0)) |
832 |
(set-case-syntax-pair |
(set-case-syntax-pair c (1+ c) tbl)) |
|
(decode-char 'ucs c) (decode-char 'ucs (1+ c)) tbl)) |
|
833 |
(setq c (1+ c))) |
(setq c (1+ c))) |
834 |
|
|
835 |
;; Greek |
;; Greek |
836 |
|
(modify-category-entry '(#x0370 . #x03ff) ?g) |
837 |
(setq c #x0370) |
(setq c #x0370) |
838 |
(while (<= c #x03ff) |
(while (<= c #x03ff) |
|
(modify-category-entry (decode-char 'ucs c) ?g) |
|
839 |
(if (or (and (>= c #x0391) (<= c #x03a1)) |
(if (or (and (>= c #x0391) (<= c #x03a1)) |
840 |
(and (>= c #x03a3) (<= c #x03ab))) |
(and (>= c #x03a3) (<= c #x03ab))) |
841 |
(set-case-syntax-pair |
(set-case-syntax-pair c (+ c 32) tbl)) |
|
(decode-char 'ucs c) (decode-char 'ucs (+ c 32)) tbl)) |
|
842 |
(and (>= c #x03da) |
(and (>= c #x03da) |
843 |
(<= c #x03ee) |
(<= c #x03ee) |
844 |
(zerop (% c 2)) |
(zerop (% c 2)) |
845 |
(set-case-syntax-pair |
(set-case-syntax-pair c (1+ c) tbl)) |
|
(decode-char 'ucs c) (decode-char 'ucs (1+ c)) tbl)) |
|
846 |
(setq c (1+ c))) |
(setq c (1+ c))) |
847 |
(set-case-syntax-pair ?Ά ?ά tbl) |
(set-case-syntax-pair ?Ά ?ά tbl) |
848 |
(set-case-syntax-pair ?Έ ?έ tbl) |
(set-case-syntax-pair ?Έ ?έ tbl) |
855 |
;; Armenian |
;; Armenian |
856 |
(setq c #x531) |
(setq c #x531) |
857 |
(while (<= c #x556) |
(while (<= c #x556) |
858 |
(set-case-syntax-pair (decode-char 'ucs c) |
(set-case-syntax-pair c (+ c #x30) tbl) |
|
(decode-char 'ucs (+ c #x30)) tbl) |
|
859 |
(setq c (1+ c))) |
(setq c (1+ c))) |
860 |
|
|
861 |
;; Greek Extended |
;; Greek Extended |
862 |
|
(modify-category-entry '(#x1f00 . #x1fff) ?g) |
863 |
(setq c #x1f00) |
(setq c #x1f00) |
864 |
(while (<= c #x1fff) |
(while (<= c #x1fff) |
|
(modify-category-entry (decode-char 'ucs c) ?g) |
|
865 |
(and (<= (logand c #x000f) 7) |
(and (<= (logand c #x000f) 7) |
866 |
(<= c #x1fa7) |
(<= c #x1fa7) |
867 |
(not (memq c '(#x1f50 #x1f52 #x1f54 #x1f56))) |
(not (memq c '(#x1f50 #x1f52 #x1f54 #x1f56))) |
868 |
(/= (logand c #x00f0) 7) |
(/= (logand c #x00f0) 7) |
869 |
(set-case-syntax-pair |
(set-case-syntax-pair (+ c 8) c tbl)) |
|
(decode-char 'ucs (+ c 8)) (decode-char 'ucs c) tbl)) |
|
870 |
(setq c (1+ c))) |
(setq c (1+ c))) |
871 |
(set-case-syntax-pair ?Ᾰ ?ᾰ tbl) |
(set-case-syntax-pair ?Ᾰ ?ᾰ tbl) |
872 |
(set-case-syntax-pair ?Ᾱ ?ᾱ tbl) |
(set-case-syntax-pair ?Ᾱ ?ᾱ tbl) |
894 |
(set-case-syntax-pair ?ῼ ?ῳ tbl) |
(set-case-syntax-pair ?ῼ ?ῳ tbl) |
895 |
|
|
896 |
;; cyrillic |
;; cyrillic |
897 |
|
(modify-category-entry '(#x0400 . #x04FF) ?y) |
898 |
(setq c #x0400) |
(setq c #x0400) |
899 |
(while (<= c #x04ff) |
(while (<= c #x04ff) |
|
(modify-category-entry (decode-char 'ucs c) ?y) |
|
900 |
(and (>= c #x0400) |
(and (>= c #x0400) |
901 |
(<= c #x040f) |
(<= c #x040f) |
902 |
(set-case-syntax-pair |
(set-case-syntax-pair c (+ c 80) tbl)) |
|
(decode-char 'ucs c) (decode-char 'ucs (+ c 80)) tbl)) |
|
903 |
(and (>= c #x0410) |
(and (>= c #x0410) |
904 |
(<= c #x042f) |
(<= c #x042f) |
905 |
(set-case-syntax-pair |
(set-case-syntax-pair c (+ c 32) tbl)) |
|
(decode-char 'ucs c) (decode-char 'ucs (+ c 32)) tbl)) |
|
906 |
(and (zerop (% c 2)) |
(and (zerop (% c 2)) |
907 |
(or (and (>= c #x0460) (<= c #x0480)) |
(or (and (>= c #x0460) (<= c #x0480)) |
908 |
(and (>= c #x048c) (<= c #x04be)) |
(and (>= c #x048c) (<= c #x04be)) |
909 |
(and (>= c #x04d0) (<= c #x04f4))) |
(and (>= c #x04d0) (<= c #x04f4))) |
910 |
(set-case-syntax-pair |
(set-case-syntax-pair c (1+ c) tbl)) |
|
(decode-char 'ucs c) (decode-char 'ucs (1+ c)) tbl)) |
|
911 |
(setq c (1+ c))) |
(setq c (1+ c))) |
912 |
(set-case-syntax-pair ?Ӂ ?ӂ tbl) |
(set-case-syntax-pair ?Ӂ ?ӂ tbl) |
913 |
(set-case-syntax-pair ?Ӄ ?ӄ tbl) |
(set-case-syntax-pair ?Ӄ ?ӄ tbl) |
928 |
;; Roman numerals |
;; Roman numerals |
929 |
(setq c #x2160) |
(setq c #x2160) |
930 |
(while (<= c #x216f) |
(while (<= c #x216f) |
931 |
(set-case-syntax-pair (decode-char 'ucs c) |
(set-case-syntax-pair c (+ c #x10) tbl) |
|
(decode-char 'ucs (+ c #x10)) tbl) |
|
932 |
(setq c (1+ c))) |
(setq c (1+ c))) |
933 |
|
|
934 |
;; Circled Latin |
;; Circled Latin |
935 |
(setq c #x24b6) |
(setq c #x24b6) |
936 |
(while (<= c #x24cf) |
(while (<= c #x24cf) |
937 |
(set-case-syntax-pair (decode-char 'ucs c) |
(set-case-syntax-pair c (+ c 26) tbl) |
938 |
(decode-char 'ucs (+ c 26)) tbl) |
(modify-category-entry c ?l) |
939 |
(modify-category-entry (decode-char 'ucs c) ?l) |
(modify-category-entry (+ c 26) ?l) |
|
(modify-category-entry (decode-char 'ucs (+ c 26)) ?l) |
|
940 |
(setq c (1+ c))) |
(setq c (1+ c))) |
941 |
|
|
942 |
;; Fullwidth Latin |
;; Fullwidth Latin |
943 |
(setq c #xff21) |
(setq c #xff21) |
944 |
(while (<= c #xff3a) |
(while (<= c #xff3a) |
945 |
(set-case-syntax-pair (decode-char 'ucs c) |
(set-case-syntax-pair c (+ c #x20) tbl) |
946 |
(decode-char 'ucs (+ c #x20)) tbl) |
(modify-category-entry c ?l) |
947 |
(modify-category-entry (decode-char 'ucs c) ?l) |
(modify-category-entry (+ c #x20) ?l) |
|
(modify-category-entry (decode-char 'ucs (+ c #x20)) ?l) |
|
948 |
(setq c (1+ c))) |
(setq c (1+ c))) |
949 |
|
|
950 |
;; Ohm, Kelvin, Angstrom |
;; Ohm, Kelvin, Angstrom |
951 |
(set-case-syntax-pair ?Ω ?ω tbl) |
;;; (set-case-syntax-pair ?Ω ?ω tbl) |
952 |
;;; These mess up the case conversion of k and å. |
;;; These mess up the case conversion of k and å. |
953 |
;;; (set-case-syntax-pair ?K ?k tbl) |
;;; (set-case-syntax-pair ?K ?k tbl) |
954 |
;;; (set-case-syntax-pair ?Å ?å tbl) |
;;; (set-case-syntax-pair ?Å ?å tbl) |
955 |
|
|
956 |
;; Combining diacritics |
;; Combining diacritics |
957 |
(setq c #x300) |
(modify-category-entry '(#x300 . #x362) ?^) |
|
(while (<= c #x362) |
|
|
(modify-category-entry (decode-char 'ucs c) ?^) |
|
|
(setq c (1+ c))) |
|
|
|
|
958 |
;; Combining marks |
;; Combining marks |
959 |
(setq c #x20d0) |
(modify-category-entry '(#x20d0 . #x20e3) ?^) |
|
(while (<= c #x20e3) |
|
|
(modify-category-entry (decode-char 'ucs c) ?^) |
|
|
(setq c (1+ c))) |
|
960 |
|
|
961 |
;; Fixme: syntax for symbols &c |
;; Fixme: syntax for symbols &c |
962 |
) |
) |
982 |
;; For each character set, put the information of the most proper |
;; For each character set, put the information of the most proper |
983 |
;; coding system to encode it by `preferred-coding-system' property. |
;; coding system to encode it by `preferred-coding-system' property. |
984 |
|
|
985 |
|
;; Fixme: should this be junked? |
986 |
(let ((l '((latin-iso8859-1 . iso-latin-1) |
(let ((l '((latin-iso8859-1 . iso-latin-1) |
987 |
(latin-iso8859-2 . iso-latin-2) |
(latin-iso8859-2 . iso-latin-2) |
988 |
(latin-iso8859-3 . iso-latin-3) |
(latin-iso8859-3 . iso-latin-3) |
1055 |
(#xFFE0 . #xFFEF)))) |
(#xFFE0 . #xFFEF)))) |
1056 |
(dolist (elt l) |
(dolist (elt l) |
1057 |
(set-char-table-range char-width-table |
(set-char-table-range char-width-table |
1058 |
(cons (decode-char 'ucs (car elt)) |
(cons (car elt) (cdr elt)) |
|
(decode-char 'ucs (cdr elt))) |
|
1059 |
2))) |
2))) |
1060 |
(map-charset-chars |
(map-charset-chars |
1061 |
#'(lambda (range ignore) (set-char-table-range char-width-table range 2)) |
#'(lambda (range ignore) (set-char-table-range char-width-table range 2)) |