April 2011 - XEmacs-Patches - XEmacs Mailing List Archives

commit: No longer create windows-874 as a Win32-specific coding system; thanks Mats! 13 years

Aidan Kehoe

changeset: 5397:a63e666bb68a tag: tip user: Aidan Kehoe <kehoea(a)parhasard.net> date: Tue Apr 12 13:01:07 2011 +0100 files: lisp/ChangeLog lisp/mule/mule-win32-init.el description: No longer create windows-874 as a Win32-specific coding system; thanks Mats! 2011-04-12 Aidan Kehoe <kehoea(a)parhasard.net> * mule/mule-win32-init.el (windows-874): No longer create this coding system, now it's provided by thai.el; thanks for the report of the associated Win32 build problem, Mats! diff -r 75469840109b -r a63e666bb68a lisp/ChangeLog --- a/lisp/ChangeLog Fri Apr 08 14:44:20 2011 +0100 +++ b/lisp/ChangeLog Tue Apr 12 13:01:07 2011 +0100 ＠＠ -1,3 +1,9 ＠＠ +2011-04-12 Aidan Kehoe <kehoea(a)parhasard.net> + + * mule/mule-win32-init.el (windows-874): + No longer create this coding system, now it's provided by thai.el; + thanks for the report of the associated Win32 build problem, Mats! + 2011-04-08 Aidan Kehoe <kehoea(a)parhasard.net> * unicode.el (load-unicode-tables): diff -r 75469840109b -r a63e666bb68a lisp/mule/mule-win32-init.el --- a/lisp/mule/mule-win32-init.el Fri Apr 08 14:44:20 2011 +0100 +++ b/lisp/mule/mule-win32-init.el Tue Apr 12 13:01:07 2011 +0100 ＠＠ -141,7 +141,7 ＠＠ ("OEM" 865 no-conversion "MS-DOS Nordic") ; ("OEM" 866 no-conversion "MS-DOS Russian") ("OEM" 869 no-conversion "IBM Modern Greek") - ("Ansi/OEM" 874 no-conversion "Thai") + ; ("Ansi/OEM" 874 no-conversion "Thai") ("EBCDIC" 875 no-conversion "EBCDIC") ("Ansi/OEM" 932 shift_jis "Japanese") ("Ansi/OEM" 936 iso_8_2 "Chinese (PRC, Singapore)") _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

[COMMIT] Drop support for Thai-XTIS, which was always non-standard and never used. 13 years

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1302270260 -3600 # Node ID 75469840109bcd2bc7f84f30e9e9e9f26f9b1c36 # Parent ccf7e84fe265cc4bc9db2ea13972c5c3e49d8792 Drop support for Thai-XTIS, which was always non-standard and never used. lisp/ChangeLog addition: 2011-04-08 Aidan Kehoe <kehoea(a)parhasard.net> * unicode.el (load-unicode-tables): No longer include thai-xtis in the default Unicode precedence list. * mule/thai.el: * mule/thai.el (tis-620): * mule/thai.el (windows-874): * mule/thai.el ("Thai"): Move the Thai language environment and the TIS-620 coding system to this file; add support for Microsoft's code page 874. * mule/thai-util.el: * mule/thai-xtis.el: Remove these two files; XTIS was always non-standard and was never widely implemented, and we've never supported the character composition necessary for thai-util.el. * dumped-lisp.el (preloaded-file-list): Drop thai-xtis, dump thai.el instead. diff -r ccf7e84fe265 -r 75469840109b lisp/ChangeLog --- a/lisp/ChangeLog Mon Apr 04 20:34:17 2011 +0100 +++ b/lisp/ChangeLog Fri Apr 08 14:44:20 2011 +0100 ＠＠ -1,3 +1,21 ＠＠ +2011-04-08 Aidan Kehoe <kehoea(a)parhasard.net> + + * unicode.el (load-unicode-tables): + No longer include thai-xtis in the default Unicode precedence list. + * mule/thai.el: + * mule/thai.el (tis-620): + * mule/thai.el (windows-874): + * mule/thai.el ("Thai"): + Move the Thai language environment and the TIS-620 coding system + to this file; add support for Microsoft's code page 874. + * mule/thai-util.el: + * mule/thai-xtis.el: + Remove these two files; XTIS was always non-standard and was never + widely implemented, and we've never supported the character + composition necessary for thai-util.el. + * dumped-lisp.el (preloaded-file-list): + Drop thai-xtis, dump thai.el instead. + 2011-04-02 Aidan Kehoe <kehoea(a)parhasard.net> * cl.el (cadr, caddr, cadddr): diff -r ccf7e84fe265 -r 75469840109b lisp/dumped-lisp.el --- a/lisp/dumped-lisp.el Mon Apr 04 20:34:17 2011 +0100 +++ b/lisp/dumped-lisp.el Fri Apr 08 14:44:20 2011 +0100 ＠＠ -205,10 +205,7 ＠＠ "mule/lao" ; sucks. "mule/latin" "mule/misc-lang" - ;; "thai" #### merge thai and thai-xtis!!! - ;; #### Even better; take out thai-xtis! It's not even a - ;; standard, and no-one uses it. - "mule/thai-xtis" + "mule/thai" "mule/tibetan" "mule/vietnamese" )) diff -r ccf7e84fe265 -r 75469840109b lisp/mule/thai-util.el --- a/lisp/mule/thai-util.el Mon Apr 04 20:34:17 2011 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 ＠＠ -1,211 +0,0 ＠＠ -;;; thai-util.el --- utilities for Thai -*- coding: iso-2022-7bit; -*- - -;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. - -;; Keywords: mule, multilingual, thai - -;; This file is part of XEmacs. - -;; XEmacs is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; XEmacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. - -;;; Synched up with: Emacs 21.1 (language/thai-util.el). - -;;; Commentary: - -;;; Code: - -;; Setting information of Thai characters. - -(defconst thai-category-table (make-category-table)) -(define-category ?c "Thai consonant" thai-category-table) -(define-category ?v "Thai upper/lower vowel" thai-category-table) -(define-category ?t "Thai tone" thai-category-table) - -;; The general composing rules are as follows: -;; -;; T -;; V T V T -;; CV -> C, CT -> C, CVT -> C, Cv -> C, CvT -> C -;; v v -;; -;; where C: consonant, V: vowel upper, v: vowel lower, T: tone mark. - -(defvar thai-composition-pattern "\\cc\$\\ct\\|\\cv\\ct?\$" - "Regular expression matching a Thai composite sequence.") - -(let ((l '((?,T!(B consonant "LETTER KO KAI") ; 0xA1 - (?,T"(B consonant "LETTER KHO KHAI") ; 0xA2 - (?,T#(B consonant "LETTER KHO KHUAT") ; 0xA3 - (?,T$(B consonant "LETTER KHO KHWAI") ; 0xA4 - (?,T%(B consonant "LETTER KHO KHON") ; 0xA5 - (?,T&(B consonant "LETTER KHO RAKHANG") ; 0xA6 - (?,T'(B consonant "LETTER NGO NGU") ; 0xA7 - (?,T((B consonant "LETTER CHO CHAN") ; 0xA8 - (?,T)(B consonant "LETTER CHO CHING") ; 0xA9 - (?,T*(B consonant "LETTER CHO CHANG") ; 0xAA - (?,T+(B consonant "LETTER SO SO") ; 0xAB - (?,T,(B consonant "LETTER CHO CHOE") ; 0xAC - (?,T-(B consonant "LETTER YO YING") ; 0xAD - (?,T.(B consonant "LETTER DO CHADA") ; 0xAE - (?,T/(B consonant "LETTER TO PATAK") ; 0xAF - (?,T0(B consonant "LETTER THO THAN") ; 0xB0 - (?,T1(B consonant "LETTER THO NANGMONTHO") ; 0xB1 - (?,T2(B consonant "LETTER THO PHUTHAO") ; 0xB2 - (?,T3(B consonant "LETTER NO NEN") ; 0xB3 - (?,T4(B consonant "LETTER DO DEK") ; 0xB4 - (?,T5(B consonant "LETTER TO TAO") ; 0xB5 - (?,T6(B consonant "LETTER THO THUNG") ; 0xB6 - (?,T7(B consonant "LETTER THO THAHAN") ; 0xB7 - (?,T8(B consonant "LETTER THO THONG") ; 0xB8 - (?,T9(B consonant "LETTER NO NU") ; 0xB9 - (?,T:(B consonant "LETTER BO BAIMAI") ; 0xBA - (?,T;(B consonant "LETTER PO PLA") ; 0xBB - (?,T<(B consonant "LETTER PHO PHUNG") ; 0xBC - (?,T=(B consonant "LETTER FO FA") ; 0xBD - (?,T>(B consonant "LETTER PHO PHAN") ; 0xBE - (?,T?(B consonant "LETTER FO FAN") ; 0xBF - (?,T＠(B consonant "LETTER PHO SAMPHAO") ; 0xC0 - (?,TA(B consonant "LETTER MO MA") ; 0xC1 - (?,TB(B consonant "LETTER YO YAK") ; 0xC2 - (?,TC(B consonant "LETTER RO RUA") ; 0xC3 - (?,TD(B vowel-base "LETTER RU (Pali vowel letter)") ; 0xC4 - (?,TE(B consonant "LETTER LO LING") ; 0xC5 - (?,TF(B vowel-base "LETTER LU (Pali vowel letter)") ; 0xC6 - (?,TG(B consonant "LETTER WO WAEN") ; 0xC7 - (?,TH(B consonant "LETTER SO SALA") ; 0xC8 - (?,TI(B consonant "LETTER SO RUSI") ; 0xC9 - (?,TJ(B consonant "LETTER SO SUA") ; 0xCA - (?,TK(B consonant "LETTER HO HIP") ; 0xCB - (?,TL(B consonant "LETTER LO CHULA") ; 0xCC - (?,TM(B consonant "LETTER O ANG") ; 0xCD - (?,TN(B consonant "LETTER HO NOK HUK") ; 0xCE - (?,TO(B special "PAI YAN NOI (abbreviation)") ; 0xCF - (?,TP(B vowel-base "VOWEL SIGN SARA A") ; 0xD0 - (?,TQ(B vowel-upper "VOWEL SIGN MAI HAN-AKAT N/S-T") ; 0xD1 - (?,TR(B vowel-base "VOWEL SIGN SARA AA") ; 0xD2 - (?,TS(B vowel-base "VOWEL SIGN SARA AM") ; 0xD3 - (?,TT(B vowel-upper "VOWEL SIGN SARA I N/S-T") ; 0xD4 - (?,TU(B vowel-upper "VOWEL SIGN SARA II N/S-T") ; 0xD5 - (?,TV(B vowel-upper "VOWEL SIGN SARA UE N/S-T") ; 0xD6 - (?,TW(B vowel-upper "VOWEL SIGN SARA UEE N/S-T") ; 0xD7 - (?,TX(B vowel-lower "VOWEL SIGN SARA U N/S-B") ; 0xD8 - (?,TY(B vowel-lower "VOWEL SIGN SARA UU N/S-B") ; 0xD9 - (?,TZ(B vowel-lower "VOWEL SIGN PHINTHU N/S-B (Pali virama)") ; 0xDA - (?,T[(B invalid nil) ; 0xDA - (?,T\(B invalid nil) ; 0xDC - (?,T](B invalid nil) ; 0xDC - (?,T^(B invalid nil) ; 0xDC - (?,T_(B special "BAHT SIGN (currency symbol)") ; 0xDF - (?,T`(B vowel-base "VOWEL SIGN SARA E") ; 0xE0 - (?,Ta(B vowel-base "VOWEL SIGN SARA AE") ; 0xE1 - (?,Tb(B vowel-base "VOWEL SIGN SARA O") ; 0xE2 - (?,Tc(B vowel-base "VOWEL SIGN SARA MAI MUAN") ; 0xE3 - (?,Td(B vowel-base "VOWEL SIGN SARA MAI MALAI") ; 0xE4 - (?,Te(B vowel-base "LAK KHANG YAO") ; 0xE5 - (?,Tf(B special "MAI YAMOK (repetition)") ; 0xE6 - (?,Tg(B vowel-upper "VOWEL SIGN MAI TAI KHU N/S-T") ; 0xE7 - (?,Th(B tone "TONE MAI EK N/S-T") ; 0xE8 - (?,Ti(B tone "TONE MAI THO N/S-T") ; 0xE9 - (?,Tj(B tone "TONE MAI TRI N/S-T") ; 0xEA - (?,Tk(B tone "TONE MAI CHATTAWA N/S-T") ; 0xEB - (?,Tl(B tone "THANTHAKHAT N/S-T (cancellation mark)") ; 0xEC - (?,Tm(B tone "NIKKHAHIT N/S-T (final nasal)") ; 0xED - (?,Tn(B vowel-upper "YAMAKKAN N/S-T") ; 0xEE - (?,To(B special "FONRMAN") ; 0xEF - (?,Tp(B special "DIGIT ZERO") ; 0xF0 - (?,Tq(B special "DIGIT ONE") ; 0xF1 - (?,Tr(B special "DIGIT TWO") ; 0xF2 - (?,Ts(B special "DIGIT THREE") ; 0xF3 - (?,Tt(B special "DIGIT FOUR") ; 0xF4 - (?,Tu(B special "DIGIT FIVE") ; 0xF5 - (?,Tv(B special "DIGIT SIX") ; 0xF6 - (?,Tw(B special "DIGIT SEVEN") ; 0xF7 - (?,Tx(B special "DIGIT EIGHT") ; 0xF8 - (?,Ty(B special "DIGIT NINE") ; 0xF9 - (?,Tz(B special "ANGKHANKHU (ellipsis)") ; 0xFA - (?,T{(B special "KHOMUT (beginning of religious texts)") ; 0xFB - (?,T|(B invalid nil) ; 0xFC - (?,T}(B invalid nil) ; 0xFD - (?,T~(B invalid nil) ; 0xFE - )) - elm) - (while l - (setq elm (car l) l (cdr l)) - (let ((char (car elm)) - (ptype (nth 1 elm))) - (put-char-code-property char 'phonetic-type ptype) - (cond ((eq ptype 'consonant) - (modify-category-entry char ?c thai-category-table)) - ((memq ptype '(vowel-upper vowel-lower)) - (modify-category-entry char ?v thai-category-table)) - ((eq ptype 'tone) - (modify-category-entry char ?t thai-category-table))) - (put-char-code-property char 'name (nth 2 elm))))) - -;;;###autoload -(defun thai-compose-region (beg end) - "Compose Thai characters in the region. -When called from a program, expects two arguments, -positions (integers or markers) specifying the region." - (interactive "r") - (save-restriction - (narrow-to-region beg end) - (goto-char (point-min)) - (with-category-table thai-category-table - (while (re-search-forward thai-composition-pattern nil t) - (compose-region (match-beginning 0) (match-end 0)))))) - -;;;###autoload -(defun thai-compose-string (string) - "Compose Thai characters in STRING and return the resulting string." - (with-category-table thai-category-table - (let ((idx 0)) - (while (setq idx (string-match thai-composition-pattern string idx)) - (compose-string string idx (match-end 0)) - (setq idx (match-end 0))))) - string) - -;;;###autoload -(defun thai-compose-buffer () - "Compose Thai characters in the current buffer." - (interactive) - (thai-compose-region (point-min) (point-max))) - -;;;###autoload -(defun thai-post-read-conversion (len) - (thai-compose-region (point) (+ (point) len)) - len) - -;;;###autoload -(defun thai-composition-function (from to pattern &optional string) - "Compose Thai text in the region FROM and TO. -The text matches the regular expression PATTERN. -Optional 4th argument STRING, if non-nil, is a string containing text -to compose. - -The return value is number of composed characters." - (if (< (1+ from) to) - (prog1 (- to from) - (if string - (compose-string string from to) - (compose-region from to)) - (- to from)))) - -;; -(provide 'thai-util) - -;;; thai-util.el ends here diff -r ccf7e84fe265 -r 75469840109b lisp/mule/thai-xtis.el --- a/lisp/mule/thai-xtis.el Mon Apr 04 20:34:17 2011 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 ＠＠ -1,370 +0,0 ＠＠ -;;; thai-xtis.el --- Support for Thai (XTIS) -*- coding: iso-2022-7bit; -*- - -;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. - -;; Author: TAKAHASHI Naoto <ntakahas(a)etl.go.jp> -;; MORIOKA Tomohiko <tomo(a)etl.go.jp> -;; Created: 1998-03-27 for Emacs-20.3 by TAKAHASHI Naoto -;; 1999-03-29 imported and modified for XEmacs by MORIOKA Tomohiko - -;; Keywords: mule, multilingual, Thai, XTIS - -;; This file is part of XEmacs. - -;; XEmacs is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; XEmacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. - -;;; Commentary: - -;; For Thai, the pre-composed character set proposed by -;; Virach Sornlertlamvanich <virach(a)links.nectec.or.th> is supported. - -;;; Code: - -(make-charset 'thai-xtis "Precomposed Thai (XTIS by Virach)." - '(registries ["xtis-0"] - dimension 2 - columns 1 - chars 94 - final ?? - graphic 0)) - -(define-category ?x "Precomposed Thai character.") -(modify-category-entry 'thai-xtis ?x) - -(when (featurep 'xemacs) - (let ((deflist '(;; chars syntax - ("$(?!0(B-$(?NxP0R0S0`0(B-$(?e0(B" "w") - ("$(?p0(B-$(?y0(B" "w") - ("$(?O0f0_0o0z0{0(B" "_") - )) - elm chars len syntax to ch i) - (while deflist - (setq elm (car deflist)) - (setq chars (car elm) - len (length chars) - syntax (nth 1 elm) - i 0) - (while (< i len) - (if (= (aref chars i) ?-) - (setq i (1+ i) - to (nth 1 (split-char (aref chars i)))) - (setq ch (nth 1 (split-char (aref chars i))) - to ch)) - (while (<= ch to) - (modify-syntax-entry (vector 'thai-xtis ch) syntax) - (setq ch (1+ ch))) - (setq i (1+ i))) - (setq deflist (cdr deflist)))) - - (put-charset-property 'thai-xtis 'preferred-coding-system 'tis-620) - ) - -;; This is the ccl-decode-thai-xtis automaton. -;; -;; "WRITE x y" == (insert (make-char 'thai-xtis x y)) -;; "write x" == (insert x) -;; rx' == (tis620-to-thai-xtis-second-byte-bitpattern rx) -;; r3 == "no vower nor tone" -;; r4 == (charset-id 'thai-xtis) -;; -;; | input (= r0) -;; state |-------------------------------------------- -;; | consonant | vowel | tone -;; ---------+-------------+-------------+---------------- -;; r1 == 0 | r1 = r0 | WRITE r0,r3 | WRITE r0,r3 -;; r2 == 0 | | | -;; ---------+-------------+-------------+---------------- -;; r1 == C | WRITE r1,r3 | r2 = r0' | WRITE r1,r3|r0' -;; r2 == 0 | r1 = r0 | | r1 = 0 -;; ---------+-------------+-------------+---------------- -;; r1 == C | WRITE r1,r2 | WRITE r1,r2 | WRITE r1,r2|r0' -;; r2 == V | r1 = r0 | WRITE r0,r3 | r1 = r2 = 0 -;; | r2 = 0 | r1 = r2 = 0 | -;; -;; -;; | input (= r0) -;; state |----------------------------------------- -;; | symbol | ASCII | EOF -;; ---------+-------------+-------------+------------- -;; r1 == 0 | WRITE r0,r3 | write r0 | -;; r2 == 0 | | | -;; ---------+-------------+-------------+------------- -;; r1 == C | WRITE r1,r3 | WRITE r1,r3 | WRITE r1,r3 -;; r2 == 0 | WRITE r0,r3 | write r0 | -;; | r1 = 0 | r1 = 0 | -;; ---------+-------------+-------------+------------- -;; r1 == C | WRITE r1,r2 | WRITE r1,r2 | WRITE r1,r2 -;; r2 == V | WRITE r0,r3 | write r0 | -;; | r1 = r2 = 0 | r1 = r2 = 0 | - - -(eval-and-compile - -;; input : r5 = 1st byte, r6 = 2nd byte -;; Their values will be destroyed. -(define-ccl-program ccl-thai-xtis-write - '(0 - ((r5 = ((r5 & #x7F) << 7)) - (r6 = ((r6 & #x7F) | r5)) - (write-multibyte-character r4 r6)))) - -(define-ccl-program ccl-thai-xtis-consonant - '(0 - (if (r1 == 0) - (r1 = r0) - (if (r2 == 0) - ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write) - (r1 = r0)) - ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) - (r1 = r0) - (r2 = 0)))))) - -(define-ccl-program ccl-thai-xtis-vowel - '(0 - ((if (r1 == 0) - ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)) - ((if (r2 == 0) - (r2 = ((r0 - 204) << 3)) - ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) - (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write) - (r1 = 0) - (r2 = 0)))))))) - -(define-ccl-program ccl-thai-xtis-vowel-d1 - '(0 - ((if (r1 == 0) - ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)) - ((if (r2 == 0) - (r2 = #x38) - ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) - (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write) - (r1 = 0) - (r2 = 0)))))))) - -(define-ccl-program ccl-thai-xtis-vowel-ee - '(0 - ((if (r1 == 0) - ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)) - ((if (r2 == 0) - (r2 = #x78) - ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) - (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write) - (r1 = 0) - (r2 = 0)))))))) - -(define-ccl-program ccl-thai-xtis-tone - '(0 - (if (r1 == 0) - ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)) - (if (r2 == 0) - ((r5 = r1) (r6 = ((r0 - #xE6) | r3)) (call ccl-thai-xtis-write) - (r1 = 0)) - ((r5 = r1) (r6 = ((r0 - #xE6) | r2)) (call ccl-thai-xtis-write) - (r1 = 0) - (r2 = 0)))))) - -(define-ccl-program ccl-thai-xtis-symbol - '(0 - (if (r1 == 0) - ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)) - (if (r2 == 0) - ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write) - (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write) - (r1 = 0)) - ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) - (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write) - (r1 = 0) - (r2 = 0)))))) - -(define-ccl-program ccl-thai-xtis-ascii - '(0 - (if (r1 == 0) - (write r0) - (if (r2 == 0) - ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write) - (write r0) - (r1 = 0)) - ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) - (write r0) - (r1 = 0) - (r2 = 0)))))) - -(define-ccl-program ccl-thai-xtis-eof - '(0 - (if (r1 != 0) - (if (r2 == 0) - ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write)) - ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)))))) - -(define-ccl-program ccl-decode-thai-xtis - `(4 - ((read r0) - (r1 = 0) - (r2 = 0) - (r3 = #x30) - (r4 = ,(charset-id 'thai-xtis)) - (loop - (if (r0 < 161) - (call ccl-thai-xtis-ascii) - (branch (r0 - 161) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-vowel-d1) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-vowel) - (call ccl-thai-xtis-vowel) - (call ccl-thai-xtis-vowel) - (call ccl-thai-xtis-vowel) - (call ccl-thai-xtis-vowel) - (call ccl-thai-xtis-vowel) - (call ccl-thai-xtis-vowel) - nil - nil - nil - nil - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-tone) - (call ccl-thai-xtis-tone) - (call ccl-thai-xtis-tone) - (call ccl-thai-xtis-tone) - (call ccl-thai-xtis-tone) - (call ccl-thai-xtis-tone) - (call ccl-thai-xtis-tone) - (call ccl-thai-xtis-vowel-ee) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - nil - nil - nil)) - (read r0) - (repeat))) - - (call ccl-thai-xtis-eof))) - -) - -(defconst leading-code-private-21 #x9F) - -(define-ccl-program ccl-encode-thai-xtis - `(1 - ((read r0) - (loop - (if (r0 == ,leading-code-private-21) - ((read r1) - (if (r1 == ,(charset-id 'thai-xtis)) - ((read r0) - (write r0) - (read r0) - (r1 = (r0 & 7)) - (r0 = ((r0 - #xB0) >> 3)) - (if (r0 != 0) - (write r0 [0 209 212 213 214 215 216 217 218 238])) - (if (r1 != 0) - (write r1 [0 231 232 233 234 235 236 237])) - (read r0) - (repeat)) - ((write r0 r1) - (read r0) - (repeat)))) - (write-read-repeat r0)))))) - -(make-coding-system - 'tis-620 'ccl - "TIS620 (Thai)" - `(mnemonic "TIS620" - decode ccl-decode-thai-xtis - encode ccl-encode-thai-xtis - safe-charsets (ascii thai-xtis) - documentation "external=tis620, internal=thai-xtis")) -(coding-system-put 'tis-620 'category 'iso-8-1) - -(set-language-info-alist - "Thai-XTIS" - '((charset thai-xtis) - (coding-system tis-620 iso-2022-7bit) - (tutorial . "TUTORIAL.th") - (tutorial-coding-system . tis-620) - (coding-priority tis-620 iso-2022-7bit) - (sample-text . "$(?!:(B") - (documentation . t))) - -;; thai-xtis.el ends here. diff -r ccf7e84fe265 -r 75469840109b lisp/mule/thai.el --- a/lisp/mule/thai.el Mon Apr 04 20:34:17 2011 +0100 +++ b/lisp/mule/thai.el Fri Apr 08 14:44:20 2011 +0100 ＠＠ -1,4 +1,4 ＠＠ -;;; thai.el --- support for Thai -*- coding: iso-2022-7bit; -*- +;;; thai.el --- support for Thai -*- coding: utf-8; -*- ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation. ＠＠ -26,68 +26,246 ＠＠ ;;; Commentary: -;; For Thai, the character set TIS620 is supported. +(make-coding-system + 'tis-620 'fixed-width + "TIS620 (Thai)" + '(mnemonic "TIS620" + unicode-map + ((#x80 ?\u0080) ;; <control> + (#x81 ?\u0081) ;; <control> + (#x82 ?\u0082) ;; <control> + (#x83 ?\u0083) ;; <control> + (#x84 ?\u0084) ;; <control> + (#x85 ?\u0085) ;; <control> + (#x86 ?\u0086) ;; <control> + (#x87 ?\u0087) ;; <control> + (#x88 ?\u0088) ;; <control> + (#x89 ?\u0089) ;; <control> + (#x8A ?\u008A) ;; <control> + (#x8B ?\u008B) ;; <control> + (#x8C ?\u008C) ;; <control> + (#x8D ?\u008D) ;; <control> + (#x8E ?\u008E) ;; <control> + (#x8F ?\u008F) ;; <control> + (#x90 ?\u0090) ;; <control> + (#x91 ?\u0091) ;; <control> + (#x92 ?\u0092) ;; <control> + (#x93 ?\u0093) ;; <control> + (#x94 ?\u0094) ;; <control> + (#x95 ?\u0095) ;; <control> + (#x96 ?\u0096) ;; <control> + (#x97 ?\u0097) ;; <control> + (#x98 ?\u0098) ;; <control> + (#x99 ?\u0099) ;; <control> + (#x9A ?\u009A) ;; <control> + (#x9B ?\u009B) ;; <control> + (#x9C ?\u009C) ;; <control> + (#x9D ?\u009D) ;; <control> + (#x9E ?\u009E) ;; <control> + (#x9F ?\u009F) ;; <control> + (#xA0 ?\u00A0) ;; NO-BREAK SPACE + (#xA1 ?\u0E01) ;; THAI CHARACTER KO KAI + (#xA2 ?\u0E02) ;; THAI CHARACTER KHO KHAI + (#xA3 ?\u0E03) ;; THAI CHARACTER KHO KHUAT + (#xA4 ?\u0E04) ;; THAI CHARACTER KHO KHWAI + (#xA5 ?\u0E05) ;; THAI CHARACTER KHO KHON + (#xA6 ?\u0E06) ;; THAI CHARACTER KHO RAKHANG + (#xA7 ?\u0E07) ;; THAI CHARACTER NGO NGU + (#xA8 ?\u0E08) ;; THAI CHARACTER CHO CHAN + (#xA9 ?\u0E09) ;; THAI CHARACTER CHO CHING + (#xAA ?\u0E0A) ;; THAI CHARACTER CHO CHANG + (#xAB ?\u0E0B) ;; THAI CHARACTER SO SO + (#xAC ?\u0E0C) ;; THAI CHARACTER CHO CHOE + (#xAD ?\u0E0D) ;; THAI CHARACTER YO YING + (#xAE ?\u0E0E) ;; THAI CHARACTER DO CHADA + (#xAF ?\u0E0F) ;; THAI CHARACTER TO PATAK + (#xB0 ?\u0E10) ;; THAI CHARACTER THO THAN + (#xB1 ?\u0E11) ;; THAI CHARACTER THO NANGMONTHO + (#xB2 ?\u0E12) ;; THAI CHARACTER THO PHUTHAO + (#xB3 ?\u0E13) ;; THAI CHARACTER NO NEN + (#xB4 ?\u0E14) ;; THAI CHARACTER DO DEK + (#xB5 ?\u0E15) ;; THAI CHARACTER TO TAO + (#xB6 ?\u0E16) ;; THAI CHARACTER THO THUNG + (#xB7 ?\u0E17) ;; THAI CHARACTER THO THAHAN + (#xB8 ?\u0E18) ;; THAI CHARACTER THO THONG + (#xB9 ?\u0E19) ;; THAI CHARACTER NO NU + (#xBA ?\u0E1A) ;; THAI CHARACTER BO BAIMAI + (#xBB ?\u0E1B) ;; THAI CHARACTER PO PLA + (#xBC ?\u0E1C) ;; THAI CHARACTER PHO PHUNG + (#xBD ?\u0E1D) ;; THAI CHARACTER FO FA + (#xBE ?\u0E1E) ;; THAI CHARACTER PHO PHAN + (#xBF ?\u0E1F) ;; THAI CHARACTER FO FAN + (#xC0 ?\u0E20) ;; THAI CHARACTER PHO SAMPHAO + (#xC1 ?\u0E21) ;; THAI CHARACTER MO MA + (#xC2 ?\u0E22) ;; THAI CHARACTER YO YAK + (#xC3 ?\u0E23) ;; THAI CHARACTER RO RUA + (#xC4 ?\u0E24) ;; THAI CHARACTER RU + (#xC5 ?\u0E25) ;; THAI CHARACTER LO LING + (#xC6 ?\u0E26) ;; THAI CHARACTER LU + (#xC7 ?\u0E27) ;; THAI CHARACTER WO WAEN + (#xC8 ?\u0E28) ;; THAI CHARACTER SO SALA + (#xC9 ?\u0E29) ;; THAI CHARACTER SO RUSI + (#xCA ?\u0E2A) ;; THAI CHARACTER SO SUA + (#xCB ?\u0E2B) ;; THAI CHARACTER HO HIP + (#xCC ?\u0E2C) ;; THAI CHARACTER LO CHULA + (#xCD ?\u0E2D) ;; THAI CHARACTER O ANG + (#xCE ?\u0E2E) ;; THAI CHARACTER HO NOKHUK + (#xCF ?\u0E2F) ;; THAI CHARACTER PAIYANNOI + (#xD0 ?\u0E30) ;; THAI CHARACTER SARA A + (#xD1 ?\u0E31) ;; THAI CHARACTER MAI HAN-AKAT + (#xD2 ?\u0E32) ;; THAI CHARACTER SARA AA + (#xD3 ?\u0E33) ;; THAI CHARACTER SARA AM + (#xD4 ?\u0E34) ;; THAI CHARACTER SARA I + (#xD5 ?\u0E35) ;; THAI CHARACTER SARA II + (#xD6 ?\u0E36) ;; THAI CHARACTER SARA UE + (#xD7 ?\u0E37) ;; THAI CHARACTER SARA UEE + (#xD8 ?\u0E38) ;; THAI CHARACTER SARA U + (#xD9 ?\u0E39) ;; THAI CHARACTER SARA UU + (#xDA ?\u0E3A) ;; THAI CHARACTER PHINTHU + (#xDF ?\u0E3F) ;; THAI CURRENCY SYMBOL BAHT + (#xE0 ?\u0E40) ;; THAI CHARACTER SARA E + (#xE1 ?\u0E41) ;; THAI CHARACTER SARA AE + (#xE2 ?\u0E42) ;; THAI CHARACTER SARA O + (#xE3 ?\u0E43) ;; THAI CHARACTER SARA AI MAIMUAN + (#xE4 ?\u0E44) ;; THAI CHARACTER SARA AI MAIMALAI + (#xE5 ?\u0E45) ;; THAI CHARACTER LAKKHANGYAO + (#xE6 ?\u0E46) ;; THAI CHARACTER MAIYAMOK + (#xE7 ?\u0E47) ;; THAI CHARACTER MAITAIKHU + (#xE8 ?\u0E48) ;; THAI CHARACTER MAI EK + (#xE9 ?\u0E49) ;; THAI CHARACTER MAI THO + (#xEA ?\u0E4A) ;; THAI CHARACTER MAI TRI + (#xEB ?\u0E4B) ;; THAI CHARACTER MAI CHATTAWA + (#xEC ?\u0E4C) ;; THAI CHARACTER THANTHAKHAT + (#xED ?\u0E4D) ;; THAI CHARACTER NIKHAHIT + (#xEE ?\u0E4E) ;; THAI CHARACTER YAMAKKAN + (#xEF ?\u0E4F) ;; THAI CHARACTER FONGMAN + (#xF0 ?\u0E50) ;; THAI DIGIT ZERO + (#xF1 ?\u0E51) ;; THAI DIGIT ONE + (#xF2 ?\u0E52) ;; THAI DIGIT TWO + (#xF3 ?\u0E53) ;; THAI DIGIT THREE + (#xF4 ?\u0E54) ;; THAI DIGIT FOUR + (#xF5 ?\u0E55) ;; THAI DIGIT FIVE + (#xF6 ?\u0E56) ;; THAI DIGIT SIX + (#xF7 ?\u0E57) ;; THAI DIGIT SEVEN + (#xF8 ?\u0E58) ;; THAI DIGIT EIGHT + (#xF9 ?\u0E59) ;; THAI DIGIT NINE + (#xFA ?\u0E5A) ;; THAI CHARACTER ANGKHANKHU + (#xFB ?\u0E5B));; THAI CHARACTER KHOMUT + documentation "Non-composed Thai" + aliases (iso-8859-11))) -;; #### I don't know how this differs from the existing thai-xtis.el so -;; I'm leaving it commented out. +(make-coding-system + 'windows-874 'fixed-width "Microsoft's CP874" + '(mnemonic "CP874" + unicode-map + ((#x80 ?\u20AC) ;; EURO SIGN + (#x85 ?\u2026) ;; HORIZONTAL ELLIPSIS + (#x91 ?\u2018) ;; LEFT SINGLE QUOTATION MARK + (#x92 ?\u2019) ;; RIGHT SINGLE QUOTATION MARK + (#x93 ?\u201C) ;; LEFT DOUBLE QUOTATION MARK + (#x94 ?\u201D) ;; RIGHT DOUBLE QUOTATION MARK + (#x95 ?\u2022) ;; BULLET + (#x96 ?\u2013) ;; EN DASH + (#x97 ?\u2014) ;; EM DASH + (#xA0 ?\u00A0) ;; NO-BREAK SPACE + (#xA1 ?\u0E01) ;; THAI CHARACTER KO KAI + (#xA2 ?\u0E02) ;; THAI CHARACTER KHO KHAI + (#xA3 ?\u0E03) ;; THAI CHARACTER KHO KHUAT + (#xA4 ?\u0E04) ;; THAI CHARACTER KHO KHWAI + (#xA5 ?\u0E05) ;; THAI CHARACTER KHO KHON + (#xA6 ?\u0E06) ;; THAI CHARACTER KHO RAKHANG + (#xA7 ?\u0E07) ;; THAI CHARACTER NGO NGU + (#xA8 ?\u0E08) ;; THAI CHARACTER CHO CHAN + (#xA9 ?\u0E09) ;; THAI CHARACTER CHO CHING + (#xAA ?\u0E0A) ;; THAI CHARACTER CHO CHANG + (#xAB ?\u0E0B) ;; THAI CHARACTER SO SO + (#xAC ?\u0E0C) ;; THAI CHARACTER CHO CHOE + (#xAD ?\u0E0D) ;; THAI CHARACTER YO YING + (#xAE ?\u0E0E) ;; THAI CHARACTER DO CHADA + (#xAF ?\u0E0F) ;; THAI CHARACTER TO PATAK + (#xB0 ?\u0E10) ;; THAI CHARACTER THO THAN + (#xB1 ?\u0E11) ;; THAI CHARACTER THO NANGMONTHO + (#xB2 ?\u0E12) ;; THAI CHARACTER THO PHUTHAO + (#xB3 ?\u0E13) ;; THAI CHARACTER NO NEN + (#xB4 ?\u0E14) ;; THAI CHARACTER DO DEK + (#xB5 ?\u0E15) ;; THAI CHARACTER TO TAO + (#xB6 ?\u0E16) ;; THAI CHARACTER THO THUNG + (#xB7 ?\u0E17) ;; THAI CHARACTER THO THAHAN + (#xB8 ?\u0E18) ;; THAI CHARACTER THO THONG + (#xB9 ?\u0E19) ;; THAI CHARACTER NO NU + (#xBA ?\u0E1A) ;; THAI CHARACTER BO BAIMAI + (#xBB ?\u0E1B) ;; THAI CHARACTER PO PLA + (#xBC ?\u0E1C) ;; THAI CHARACTER PHO PHUNG + (#xBD ?\u0E1D) ;; THAI CHARACTER FO FA + (#xBE ?\u0E1E) ;; THAI CHARACTER PHO PHAN + (#xBF ?\u0E1F) ;; THAI CHARACTER FO FAN + (#xC0 ?\u0E20) ;; THAI CHARACTER PHO SAMPHAO + (#xC1 ?\u0E21) ;; THAI CHARACTER MO MA + (#xC2 ?\u0E22) ;; THAI CHARACTER YO YAK + (#xC3 ?\u0E23) ;; THAI CHARACTER RO RUA + (#xC4 ?\u0E24) ;; THAI CHARACTER RU + (#xC5 ?\u0E25) ;; THAI CHARACTER LO LING + (#xC6 ?\u0E26) ;; THAI CHARACTER LU + (#xC7 ?\u0E27) ;; THAI CHARACTER WO WAEN + (#xC8 ?\u0E28) ;; THAI CHARACTER SO SALA + (#xC9 ?\u0E29) ;; THAI CHARACTER SO RUSI + (#xCA ?\u0E2A) ;; THAI CHARACTER SO SUA + (#xCB ?\u0E2B) ;; THAI CHARACTER HO HIP + (#xCC ?\u0E2C) ;; THAI CHARACTER LO CHULA + (#xCD ?\u0E2D) ;; THAI CHARACTER O ANG + (#xCE ?\u0E2E) ;; THAI CHARACTER HO NOKHUK + (#xCF ?\u0E2F) ;; THAI CHARACTER PAIYANNOI + (#xD0 ?\u0E30) ;; THAI CHARACTER SARA A + (#xD1 ?\u0E31) ;; THAI CHARACTER MAI HAN-AKAT + (#xD2 ?\u0E32) ;; THAI CHARACTER SARA AA + (#xD3 ?\u0E33) ;; THAI CHARACTER SARA AM + (#xD4 ?\u0E34) ;; THAI CHARACTER SARA I + (#xD5 ?\u0E35) ;; THAI CHARACTER SARA II + (#xD6 ?\u0E36) ;; THAI CHARACTER SARA UE + (#xD7 ?\u0E37) ;; THAI CHARACTER SARA UEE + (#xD8 ?\u0E38) ;; THAI CHARACTER SARA U + (#xD9 ?\u0E39) ;; THAI CHARACTER SARA UU + (#xDA ?\u0E3A) ;; THAI CHARACTER PHINTHU + (#xDF ?\u0E3F) ;; THAI CURRENCY SYMBOL BAHT + (#xE0 ?\u0E40) ;; THAI CHARACTER SARA E + (#xE1 ?\u0E41) ;; THAI CHARACTER SARA AE + (#xE2 ?\u0E42) ;; THAI CHARACTER SARA O + (#xE3 ?\u0E43) ;; THAI CHARACTER SARA AI MAIMUAN + (#xE4 ?\u0E44) ;; THAI CHARACTER SARA AI MAIMALAI + (#xE5 ?\u0E45) ;; THAI CHARACTER LAKKHANGYAO + (#xE6 ?\u0E46) ;; THAI CHARACTER MAIYAMOK + (#xE7 ?\u0E47) ;; THAI CHARACTER MAITAIKHU + (#xE8 ?\u0E48) ;; THAI CHARACTER MAI EK + (#xE9 ?\u0E49) ;; THAI CHARACTER MAI THO + (#xEA ?\u0E4A) ;; THAI CHARACTER MAI TRI + (#xEB ?\u0E4B) ;; THAI CHARACTER MAI CHATTAWA + (#xEC ?\u0E4C) ;; THAI CHARACTER THANTHAKHAT + (#xED ?\u0E4D) ;; THAI CHARACTER NIKHAHIT + (#xEE ?\u0E4E) ;; THAI CHARACTER YAMAKKAN + (#xEF ?\u0E4F) ;; THAI CHARACTER FONGMAN + (#xF0 ?\u0E50) ;; THAI DIGIT ZERO + (#xF1 ?\u0E51) ;; THAI DIGIT ONE + (#xF2 ?\u0E52) ;; THAI DIGIT TWO + (#xF3 ?\u0E53) ;; THAI DIGIT THREE + (#xF4 ?\u0E54) ;; THAI DIGIT FOUR + (#xF5 ?\u0E55) ;; THAI DIGIT FIVE + (#xF6 ?\u0E56) ;; THAI DIGIT SIX + (#xF7 ?\u0E57) ;; THAI DIGIT SEVEN + (#xF8 ?\u0E58) ;; THAI DIGIT EIGHT + (#xF9 ?\u0E59) ;; THAI DIGIT NINE + (#xFA ?\u0E5A) ;; THAI CHARACTER ANGKHANKHU + (#xFB ?\u0E5B));; THAI CHARACTER KHOMUT + documentation "Microsoft's encoding for Thai." + aliases (cp874))) -;;; Code: - -; (make-charset 'thai-tis620 -; "Right-Hand Part of TIS620.2533 (Thai): ISO-IR-166" -; '(dimension -; 1 -; registry "TIS620" -; chars 96 -; columns 1 -; direction l2r -; final ?T -; graphic 1 -; short-name "RHP of TIS620" -; long-name "RHP of Thai (TIS620): ISO-IR-166" -; )) - -; ; (make-coding-system -; ; 'thai-tis620 2 ?T -; ; "8-bit encoding for ASCII (MSB=0) and Thai TIS620 (MSB=1)" -; ; '(ascii thai-tis620 nil nil -; ; nil ascii-eol) -; ; '((safe-charsets ascii thai-tis620) -; ; (post-read-conversion . thai-post-read-conversion))) - -; (make-coding-system -; 'thai-tis620 'iso2022 "Thai/TIS620" -; '(charset-g0 ascii -; charset-g1 thai-tis620 -; mnemonic "Thai" -; safe-charsets (ascii thai-tis620) -; post-read-conversion thai-post-read-conversion -; documentation "8-bit encoding for ASCII (MSB=0) and Thai TIS620 (MSB=1)")) - -; (define-coding-system-alias 'th-tis620 'thai-tis620) -; (define-coding-system-alias 'tis620 'thai-tis620) -; (define-coding-system-alias 'tis-620 'thai-tis620) - -; (set-language-info-alist -; "Thai" '((tutorial . "TUTORIAL.th") -; (charset thai-tis620) -; (coding-system thai-tis620) -; (coding-priority thai-tis620) -; (nonascii-translation . thai-tis620) -; (input-method . "thai-kesmanee") -; (unibyte-display . thai-tis620) -; (features thai-util) -; (sample-text -; . (thai-compose-string -; (copy-sequence "Thai (,T＠RIRd7B(B) ,TJ0GQ1J04U1$0CQ1:(B, ,TJ0GQ1J04U10$h1P(B"))) -; (documentation . t))) - - -;; Register a function to compose Thai characters. -; (put-char-table 'thai-tis620 -; '(("\\c0\\c4\\|\\c0\$\\c2\\|\\c3\$\\c4?" . -; thai-composition-function)) -; composition-function-table) +(set-language-info-alist + "Thai" + '((coding-system tis-620 utf-8) + (tutorial . "TUTORIAL.th") + (tutorial-coding-system . tis-620) + (coding-priority tis-620 utf-8 iso-2022-7bit) + (sample-text . "สวัสดีครับ, สวัสดีค่ะ") + (documentation . t))) (provide 'thai) diff -r ccf7e84fe265 -r 75469840109b lisp/unicode.el --- a/lisp/unicode.el Mon Apr 04 20:34:17 2011 +0100 +++ b/lisp/unicode.el Fri Apr 08 14:44:20 2011 +0100 ＠＠ -161,7 +161,7 ＠＠ indian-is13194 korean-ksc5601 chinese-cns11643-1 chinese-cns11643-2 chinese-isoir165 composite ethiopic indian-1-column indian-2-column jit-ucs-charset-0 - katakana-jisx0201 lao thai-tis620 thai-xtis tibetan tibetan-1-column + katakana-jisx0201 lao thai-tis620 tibetan tibetan-1-column latin-jisx0201 chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5 chinese-cns11643-6 chinese-cns11643-7))))) -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

commit: Drop support for Thai-XTIS, which was always non-standard and never used. 13 years

Aidan Kehoe

changeset: 5396:75469840109b tag: tip user: Aidan Kehoe <kehoea(a)parhasard.net> date: Fri Apr 08 14:44:20 2011 +0100 files: lisp/ChangeLog lisp/dumped-lisp.el lisp/mule/thai-util.el lisp/mule/thai-xtis.el lisp/mule/thai.el lisp/unicode.el description: Drop support for Thai-XTIS, which was always non-standard and never used. lisp/ChangeLog addition: 2011-04-08 Aidan Kehoe <kehoea(a)parhasard.net> * unicode.el (load-unicode-tables): No longer include thai-xtis in the default Unicode precedence list. * mule/thai.el: * mule/thai.el (tis-620): * mule/thai.el (windows-874): * mule/thai.el ("Thai"): Move the Thai language environment and the TIS-620 coding system to this file; add support for Microsoft's code page 874. * mule/thai-util.el: * mule/thai-xtis.el: Remove these two files; XTIS was always non-standard and was never widely implemented, and we've never supported the character composition necessary for thai-util.el. * dumped-lisp.el (preloaded-file-list): Drop thai-xtis, dump thai.el instead. diff -r ccf7e84fe265 -r 75469840109b lisp/ChangeLog --- a/lisp/ChangeLog Mon Apr 04 20:34:17 2011 +0100 +++ b/lisp/ChangeLog Fri Apr 08 14:44:20 2011 +0100 ＠＠ -1,3 +1,21 ＠＠ +2011-04-08 Aidan Kehoe <kehoea(a)parhasard.net> + + * unicode.el (load-unicode-tables): + No longer include thai-xtis in the default Unicode precedence list. + * mule/thai.el: + * mule/thai.el (tis-620): + * mule/thai.el (windows-874): + * mule/thai.el ("Thai"): + Move the Thai language environment and the TIS-620 coding system + to this file; add support for Microsoft's code page 874. + * mule/thai-util.el: + * mule/thai-xtis.el: + Remove these two files; XTIS was always non-standard and was never + widely implemented, and we've never supported the character + composition necessary for thai-util.el. + * dumped-lisp.el (preloaded-file-list): + Drop thai-xtis, dump thai.el instead. + 2011-04-02 Aidan Kehoe <kehoea(a)parhasard.net> * cl.el (cadr, caddr, cadddr): diff -r ccf7e84fe265 -r 75469840109b lisp/dumped-lisp.el --- a/lisp/dumped-lisp.el Mon Apr 04 20:34:17 2011 +0100 +++ b/lisp/dumped-lisp.el Fri Apr 08 14:44:20 2011 +0100 ＠＠ -205,10 +205,7 ＠＠ "mule/lao" ; sucks. "mule/latin" "mule/misc-lang" - ;; "thai" #### merge thai and thai-xtis!!! - ;; #### Even better; take out thai-xtis! It's not even a - ;; standard, and no-one uses it. - "mule/thai-xtis" + "mule/thai" "mule/tibetan" "mule/vietnamese" )) diff -r ccf7e84fe265 -r 75469840109b lisp/mule/thai-util.el --- a/lisp/mule/thai-util.el Mon Apr 04 20:34:17 2011 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 ＠＠ -1,211 +0,0 ＠＠ -;;; thai-util.el --- utilities for Thai -*- coding: iso-2022-7bit; -*- - -;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. - -;; Keywords: mule, multilingual, thai - -;; This file is part of XEmacs. - -;; XEmacs is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; XEmacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. - -;;; Synched up with: Emacs 21.1 (language/thai-util.el). - -;;; Commentary: - -;;; Code: - -;; Setting information of Thai characters. - -(defconst thai-category-table (make-category-table)) -(define-category ?c "Thai consonant" thai-category-table) -(define-category ?v "Thai upper/lower vowel" thai-category-table) -(define-category ?t "Thai tone" thai-category-table) - -;; The general composing rules are as follows: -;; -;; T -;; V T V T -;; CV -> C, CT -> C, CVT -> C, Cv -> C, CvT -> C -;; v v -;; -;; where C: consonant, V: vowel upper, v: vowel lower, T: tone mark. - -(defvar thai-composition-pattern "\\cc\$\\ct\\|\\cv\\ct?\$" - "Regular expression matching a Thai composite sequence.") - -(let ((l '((?,T!(B consonant "LETTER KO KAI") ; 0xA1 - (?,T"(B consonant "LETTER KHO KHAI") ; 0xA2 - (?,T#(B consonant "LETTER KHO KHUAT") ; 0xA3 - (?,T$(B consonant "LETTER KHO KHWAI") ; 0xA4 - (?,T%(B consonant "LETTER KHO KHON") ; 0xA5 - (?,T&(B consonant "LETTER KHO RAKHANG") ; 0xA6 - (?,T'(B consonant "LETTER NGO NGU") ; 0xA7 - (?,T((B consonant "LETTER CHO CHAN") ; 0xA8 - (?,T)(B consonant "LETTER CHO CHING") ; 0xA9 - (?,T*(B consonant "LETTER CHO CHANG") ; 0xAA - (?,T+(B consonant "LETTER SO SO") ; 0xAB - (?,T,(B consonant "LETTER CHO CHOE") ; 0xAC - (?,T-(B consonant "LETTER YO YING") ; 0xAD - (?,T.(B consonant "LETTER DO CHADA") ; 0xAE - (?,T/(B consonant "LETTER TO PATAK") ; 0xAF - (?,T0(B consonant "LETTER THO THAN") ; 0xB0 - (?,T1(B consonant "LETTER THO NANGMONTHO") ; 0xB1 - (?,T2(B consonant "LETTER THO PHUTHAO") ; 0xB2 - (?,T3(B consonant "LETTER NO NEN") ; 0xB3 - (?,T4(B consonant "LETTER DO DEK") ; 0xB4 - (?,T5(B consonant "LETTER TO TAO") ; 0xB5 - (?,T6(B consonant "LETTER THO THUNG") ; 0xB6 - (?,T7(B consonant "LETTER THO THAHAN") ; 0xB7 - (?,T8(B consonant "LETTER THO THONG") ; 0xB8 - (?,T9(B consonant "LETTER NO NU") ; 0xB9 - (?,T:(B consonant "LETTER BO BAIMAI") ; 0xBA - (?,T;(B consonant "LETTER PO PLA") ; 0xBB - (?,T<(B consonant "LETTER PHO PHUNG") ; 0xBC - (?,T=(B consonant "LETTER FO FA") ; 0xBD - (?,T>(B consonant "LETTER PHO PHAN") ; 0xBE - (?,T?(B consonant "LETTER FO FAN") ; 0xBF - (?,T＠(B consonant "LETTER PHO SAMPHAO") ; 0xC0 - (?,TA(B consonant "LETTER MO MA") ; 0xC1 - (?,TB(B consonant "LETTER YO YAK") ; 0xC2 - (?,TC(B consonant "LETTER RO RUA") ; 0xC3 - (?,TD(B vowel-base "LETTER RU (Pali vowel letter)") ; 0xC4 - (?,TE(B consonant "LETTER LO LING") ; 0xC5 - (?,TF(B vowel-base "LETTER LU (Pali vowel letter)") ; 0xC6 - (?,TG(B consonant "LETTER WO WAEN") ; 0xC7 - (?,TH(B consonant "LETTER SO SALA") ; 0xC8 - (?,TI(B consonant "LETTER SO RUSI") ; 0xC9 - (?,TJ(B consonant "LETTER SO SUA") ; 0xCA - (?,TK(B consonant "LETTER HO HIP") ; 0xCB - (?,TL(B consonant "LETTER LO CHULA") ; 0xCC - (?,TM(B consonant "LETTER O ANG") ; 0xCD - (?,TN(B consonant "LETTER HO NOK HUK") ; 0xCE - (?,TO(B special "PAI YAN NOI (abbreviation)") ; 0xCF - (?,TP(B vowel-base "VOWEL SIGN SARA A") ; 0xD0 - (?,TQ(B vowel-upper "VOWEL SIGN MAI HAN-AKAT N/S-T") ; 0xD1 - (?,TR(B vowel-base "VOWEL SIGN SARA AA") ; 0xD2 - (?,TS(B vowel-base "VOWEL SIGN SARA AM") ; 0xD3 - (?,TT(B vowel-upper "VOWEL SIGN SARA I N/S-T") ; 0xD4 - (?,TU(B vowel-upper "VOWEL SIGN SARA II N/S-T") ; 0xD5 - (?,TV(B vowel-upper "VOWEL SIGN SARA UE N/S-T") ; 0xD6 - (?,TW(B vowel-upper "VOWEL SIGN SARA UEE N/S-T") ; 0xD7 - (?,TX(B vowel-lower "VOWEL SIGN SARA U N/S-B") ; 0xD8 - (?,TY(B vowel-lower "VOWEL SIGN SARA UU N/S-B") ; 0xD9 - (?,TZ(B vowel-lower "VOWEL SIGN PHINTHU N/S-B (Pali virama)") ; 0xDA - (?,T[(B invalid nil) ; 0xDA - (?,T\(B invalid nil) ; 0xDC - (?,T](B invalid nil) ; 0xDC - (?,T^(B invalid nil) ; 0xDC - (?,T_(B special "BAHT SIGN (currency symbol)") ; 0xDF - (?,T`(B vowel-base "VOWEL SIGN SARA E") ; 0xE0 - (?,Ta(B vowel-base "VOWEL SIGN SARA AE") ; 0xE1 - (?,Tb(B vowel-base "VOWEL SIGN SARA O") ; 0xE2 - (?,Tc(B vowel-base "VOWEL SIGN SARA MAI MUAN") ; 0xE3 - (?,Td(B vowel-base "VOWEL SIGN SARA MAI MALAI") ; 0xE4 - (?,Te(B vowel-base "LAK KHANG YAO") ; 0xE5 - (?,Tf(B special "MAI YAMOK (repetition)") ; 0xE6 - (?,Tg(B vowel-upper "VOWEL SIGN MAI TAI KHU N/S-T") ; 0xE7 - (?,Th(B tone "TONE MAI EK N/S-T") ; 0xE8 - (?,Ti(B tone "TONE MAI THO N/S-T") ; 0xE9 - (?,Tj(B tone "TONE MAI TRI N/S-T") ; 0xEA - (?,Tk(B tone "TONE MAI CHATTAWA N/S-T") ; 0xEB - (?,Tl(B tone "THANTHAKHAT N/S-T (cancellation mark)") ; 0xEC - (?,Tm(B tone "NIKKHAHIT N/S-T (final nasal)") ; 0xED - (?,Tn(B vowel-upper "YAMAKKAN N/S-T") ; 0xEE - (?,To(B special "FONRMAN") ; 0xEF - (?,Tp(B special "DIGIT ZERO") ; 0xF0 - (?,Tq(B special "DIGIT ONE") ; 0xF1 - (?,Tr(B special "DIGIT TWO") ; 0xF2 - (?,Ts(B special "DIGIT THREE") ; 0xF3 - (?,Tt(B special "DIGIT FOUR") ; 0xF4 - (?,Tu(B special "DIGIT FIVE") ; 0xF5 - (?,Tv(B special "DIGIT SIX") ; 0xF6 - (?,Tw(B special "DIGIT SEVEN") ; 0xF7 - (?,Tx(B special "DIGIT EIGHT") ; 0xF8 - (?,Ty(B special "DIGIT NINE") ; 0xF9 - (?,Tz(B special "ANGKHANKHU (ellipsis)") ; 0xFA - (?,T{(B special "KHOMUT (beginning of religious texts)") ; 0xFB - (?,T|(B invalid nil) ; 0xFC - (?,T}(B invalid nil) ; 0xFD - (?,T~(B invalid nil) ; 0xFE - )) - elm) - (while l - (setq elm (car l) l (cdr l)) - (let ((char (car elm)) - (ptype (nth 1 elm))) - (put-char-code-property char 'phonetic-type ptype) - (cond ((eq ptype 'consonant) - (modify-category-entry char ?c thai-category-table)) - ((memq ptype '(vowel-upper vowel-lower)) - (modify-category-entry char ?v thai-category-table)) - ((eq ptype 'tone) - (modify-category-entry char ?t thai-category-table))) - (put-char-code-property char 'name (nth 2 elm))))) - -;;;###autoload -(defun thai-compose-region (beg end) - "Compose Thai characters in the region. -When called from a program, expects two arguments, -positions (integers or markers) specifying the region." - (interactive "r") - (save-restriction - (narrow-to-region beg end) - (goto-char (point-min)) - (with-category-table thai-category-table - (while (re-search-forward thai-composition-pattern nil t) - (compose-region (match-beginning 0) (match-end 0)))))) - -;;;###autoload -(defun thai-compose-string (string) - "Compose Thai characters in STRING and return the resulting string." - (with-category-table thai-category-table - (let ((idx 0)) - (while (setq idx (string-match thai-composition-pattern string idx)) - (compose-string string idx (match-end 0)) - (setq idx (match-end 0))))) - string) - -;;;###autoload -(defun thai-compose-buffer () - "Compose Thai characters in the current buffer." - (interactive) - (thai-compose-region (point-min) (point-max))) - -;;;###autoload -(defun thai-post-read-conversion (len) - (thai-compose-region (point) (+ (point) len)) - len) - -;;;###autoload -(defun thai-composition-function (from to pattern &optional string) - "Compose Thai text in the region FROM and TO. -The text matches the regular expression PATTERN. -Optional 4th argument STRING, if non-nil, is a string containing text -to compose. - -The return value is number of composed characters." - (if (< (1+ from) to) - (prog1 (- to from) - (if string - (compose-string string from to) - (compose-region from to)) - (- to from)))) - -;; -(provide 'thai-util) - -;;; thai-util.el ends here diff -r ccf7e84fe265 -r 75469840109b lisp/mule/thai-xtis.el --- a/lisp/mule/thai-xtis.el Mon Apr 04 20:34:17 2011 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 ＠＠ -1,370 +0,0 ＠＠ -;;; thai-xtis.el --- Support for Thai (XTIS) -*- coding: iso-2022-7bit; -*- - -;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. - -;; Author: TAKAHASHI Naoto <ntakahas(a)etl.go.jp> -;; MORIOKA Tomohiko <tomo(a)etl.go.jp> -;; Created: 1998-03-27 for Emacs-20.3 by TAKAHASHI Naoto -;; 1999-03-29 imported and modified for XEmacs by MORIOKA Tomohiko - -;; Keywords: mule, multilingual, Thai, XTIS - -;; This file is part of XEmacs. - -;; XEmacs is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; XEmacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. - -;;; Commentary: - -;; For Thai, the pre-composed character set proposed by -;; Virach Sornlertlamvanich <virach(a)links.nectec.or.th> is supported. - -;;; Code: - -(make-charset 'thai-xtis "Precomposed Thai (XTIS by Virach)." - '(registries ["xtis-0"] - dimension 2 - columns 1 - chars 94 - final ?? - graphic 0)) - -(define-category ?x "Precomposed Thai character.") -(modify-category-entry 'thai-xtis ?x) - -(when (featurep 'xemacs) - (let ((deflist '(;; chars syntax - ("$(?!0(B-$(?NxP0R0S0`0(B-$(?e0(B" "w") - ("$(?p0(B-$(?y0(B" "w") - ("$(?O0f0_0o0z0{0(B" "_") - )) - elm chars len syntax to ch i) - (while deflist - (setq elm (car deflist)) - (setq chars (car elm) - len (length chars) - syntax (nth 1 elm) - i 0) - (while (< i len) - (if (= (aref chars i) ?-) - (setq i (1+ i) - to (nth 1 (split-char (aref chars i)))) - (setq ch (nth 1 (split-char (aref chars i))) - to ch)) - (while (<= ch to) - (modify-syntax-entry (vector 'thai-xtis ch) syntax) - (setq ch (1+ ch))) - (setq i (1+ i))) - (setq deflist (cdr deflist)))) - - (put-charset-property 'thai-xtis 'preferred-coding-system 'tis-620) - ) - -;; This is the ccl-decode-thai-xtis automaton. -;; -;; "WRITE x y" == (insert (make-char 'thai-xtis x y)) -;; "write x" == (insert x) -;; rx' == (tis620-to-thai-xtis-second-byte-bitpattern rx) -;; r3 == "no vower nor tone" -;; r4 == (charset-id 'thai-xtis) -;; -;; | input (= r0) -;; state |-------------------------------------------- -;; | consonant | vowel | tone -;; ---------+-------------+-------------+---------------- -;; r1 == 0 | r1 = r0 | WRITE r0,r3 | WRITE r0,r3 -;; r2 == 0 | | | -;; ---------+-------------+-------------+---------------- -;; r1 == C | WRITE r1,r3 | r2 = r0' | WRITE r1,r3|r0' -;; r2 == 0 | r1 = r0 | | r1 = 0 -;; ---------+-------------+-------------+---------------- -;; r1 == C | WRITE r1,r2 | WRITE r1,r2 | WRITE r1,r2|r0' -;; r2 == V | r1 = r0 | WRITE r0,r3 | r1 = r2 = 0 -;; | r2 = 0 | r1 = r2 = 0 | -;; -;; -;; | input (= r0) -;; state |----------------------------------------- -;; | symbol | ASCII | EOF -;; ---------+-------------+-------------+------------- -;; r1 == 0 | WRITE r0,r3 | write r0 | -;; r2 == 0 | | | -;; ---------+-------------+-------------+------------- -;; r1 == C | WRITE r1,r3 | WRITE r1,r3 | WRITE r1,r3 -;; r2 == 0 | WRITE r0,r3 | write r0 | -;; | r1 = 0 | r1 = 0 | -;; ---------+-------------+-------------+------------- -;; r1 == C | WRITE r1,r2 | WRITE r1,r2 | WRITE r1,r2 -;; r2 == V | WRITE r0,r3 | write r0 | -;; | r1 = r2 = 0 | r1 = r2 = 0 | - - -(eval-and-compile - -;; input : r5 = 1st byte, r6 = 2nd byte -;; Their values will be destroyed. -(define-ccl-program ccl-thai-xtis-write - '(0 - ((r5 = ((r5 & #x7F) << 7)) - (r6 = ((r6 & #x7F) | r5)) - (write-multibyte-character r4 r6)))) - -(define-ccl-program ccl-thai-xtis-consonant - '(0 - (if (r1 == 0) - (r1 = r0) - (if (r2 == 0) - ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write) - (r1 = r0)) - ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) - (r1 = r0) - (r2 = 0)))))) - -(define-ccl-program ccl-thai-xtis-vowel - '(0 - ((if (r1 == 0) - ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)) - ((if (r2 == 0) - (r2 = ((r0 - 204) << 3)) - ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) - (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write) - (r1 = 0) - (r2 = 0)))))))) - -(define-ccl-program ccl-thai-xtis-vowel-d1 - '(0 - ((if (r1 == 0) - ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)) - ((if (r2 == 0) - (r2 = #x38) - ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) - (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write) - (r1 = 0) - (r2 = 0)))))))) - -(define-ccl-program ccl-thai-xtis-vowel-ee - '(0 - ((if (r1 == 0) - ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)) - ((if (r2 == 0) - (r2 = #x78) - ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) - (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write) - (r1 = 0) - (r2 = 0)))))))) - -(define-ccl-program ccl-thai-xtis-tone - '(0 - (if (r1 == 0) - ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)) - (if (r2 == 0) - ((r5 = r1) (r6 = ((r0 - #xE6) | r3)) (call ccl-thai-xtis-write) - (r1 = 0)) - ((r5 = r1) (r6 = ((r0 - #xE6) | r2)) (call ccl-thai-xtis-write) - (r1 = 0) - (r2 = 0)))))) - -(define-ccl-program ccl-thai-xtis-symbol - '(0 - (if (r1 == 0) - ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)) - (if (r2 == 0) - ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write) - (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write) - (r1 = 0)) - ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) - (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write) - (r1 = 0) - (r2 = 0)))))) - -(define-ccl-program ccl-thai-xtis-ascii - '(0 - (if (r1 == 0) - (write r0) - (if (r2 == 0) - ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write) - (write r0) - (r1 = 0)) - ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) - (write r0) - (r1 = 0) - (r2 = 0)))))) - -(define-ccl-program ccl-thai-xtis-eof - '(0 - (if (r1 != 0) - (if (r2 == 0) - ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write)) - ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)))))) - -(define-ccl-program ccl-decode-thai-xtis - `(4 - ((read r0) - (r1 = 0) - (r2 = 0) - (r3 = #x30) - (r4 = ,(charset-id 'thai-xtis)) - (loop - (if (r0 < 161) - (call ccl-thai-xtis-ascii) - (branch (r0 - 161) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-consonant) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-vowel-d1) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-vowel) - (call ccl-thai-xtis-vowel) - (call ccl-thai-xtis-vowel) - (call ccl-thai-xtis-vowel) - (call ccl-thai-xtis-vowel) - (call ccl-thai-xtis-vowel) - (call ccl-thai-xtis-vowel) - nil - nil - nil - nil - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-tone) - (call ccl-thai-xtis-tone) - (call ccl-thai-xtis-tone) - (call ccl-thai-xtis-tone) - (call ccl-thai-xtis-tone) - (call ccl-thai-xtis-tone) - (call ccl-thai-xtis-tone) - (call ccl-thai-xtis-vowel-ee) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - (call ccl-thai-xtis-symbol) - nil - nil - nil)) - (read r0) - (repeat))) - - (call ccl-thai-xtis-eof))) - -) - -(defconst leading-code-private-21 #x9F) - -(define-ccl-program ccl-encode-thai-xtis - `(1 - ((read r0) - (loop - (if (r0 == ,leading-code-private-21) - ((read r1) - (if (r1 == ,(charset-id 'thai-xtis)) - ((read r0) - (write r0) - (read r0) - (r1 = (r0 & 7)) - (r0 = ((r0 - #xB0) >> 3)) - (if (r0 != 0) - (write r0 [0 209 212 213 214 215 216 217 218 238])) - (if (r1 != 0) - (write r1 [0 231 232 233 234 235 236 237])) - (read r0) - (repeat)) - ((write r0 r1) - (read r0) - (repeat)))) - (write-read-repeat r0)))))) - -(make-coding-system - 'tis-620 'ccl - "TIS620 (Thai)" - `(mnemonic "TIS620" - decode ccl-decode-thai-xtis - encode ccl-encode-thai-xtis - safe-charsets (ascii thai-xtis) - documentation "external=tis620, internal=thai-xtis")) -(coding-system-put 'tis-620 'category 'iso-8-1) - -(set-language-info-alist - "Thai-XTIS" - '((charset thai-xtis) - (coding-system tis-620 iso-2022-7bit) - (tutorial . "TUTORIAL.th") - (tutorial-coding-system . tis-620) - (coding-priority tis-620 iso-2022-7bit) - (sample-text . "$(?!:(B") - (documentation . t))) - -;; thai-xtis.el ends here. diff -r ccf7e84fe265 -r 75469840109b lisp/mule/thai.el --- a/lisp/mule/thai.el Mon Apr 04 20:34:17 2011 +0100 +++ b/lisp/mule/thai.el Fri Apr 08 14:44:20 2011 +0100 ＠＠ -1,4 +1,4 ＠＠ -;;; thai.el --- support for Thai -*- coding: iso-2022-7bit; -*- +;;; thai.el --- support for Thai -*- coding: utf-8; -*- ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation. ＠＠ -26,68 +26,246 ＠＠ ;;; Commentary: -;; For Thai, the character set TIS620 is supported. +(make-coding-system + 'tis-620 'fixed-width + "TIS620 (Thai)" + '(mnemonic "TIS620" + unicode-map + ((#x80 ?\u0080) ;; <control> + (#x81 ?\u0081) ;; <control> + (#x82 ?\u0082) ;; <control> + (#x83 ?\u0083) ;; <control> + (#x84 ?\u0084) ;; <control> + (#x85 ?\u0085) ;; <control> + (#x86 ?\u0086) ;; <control> + (#x87 ?\u0087) ;; <control> + (#x88 ?\u0088) ;; <control> + (#x89 ?\u0089) ;; <control> + (#x8A ?\u008A) ;; <control> + (#x8B ?\u008B) ;; <control> + (#x8C ?\u008C) ;; <control> + (#x8D ?\u008D) ;; <control> + (#x8E ?\u008E) ;; <control> + (#x8F ?\u008F) ;; <control> + (#x90 ?\u0090) ;; <control> + (#x91 ?\u0091) ;; <control> + (#x92 ?\u0092) ;; <control> + (#x93 ?\u0093) ;; <control> + (#x94 ?\u0094) ;; <control> + (#x95 ?\u0095) ;; <control> + (#x96 ?\u0096) ;; <control> + (#x97 ?\u0097) ;; <control> + (#x98 ?\u0098) ;; <control> + (#x99 ?\u0099) ;; <control> + (#x9A ?\u009A) ;; <control> + (#x9B ?\u009B) ;; <control> + (#x9C ?\u009C) ;; <control> + (#x9D ?\u009D) ;; <control> + (#x9E ?\u009E) ;; <control> + (#x9F ?\u009F) ;; <control> + (#xA0 ?\u00A0) ;; NO-BREAK SPACE + (#xA1 ?\u0E01) ;; THAI CHARACTER KO KAI + (#xA2 ?\u0E02) ;; THAI CHARACTER KHO KHAI + (#xA3 ?\u0E03) ;; THAI CHARACTER KHO KHUAT + (#xA4 ?\u0E04) ;; THAI CHARACTER KHO KHWAI + (#xA5 ?\u0E05) ;; THAI CHARACTER KHO KHON + (#xA6 ?\u0E06) ;; THAI CHARACTER KHO RAKHANG + (#xA7 ?\u0E07) ;; THAI CHARACTER NGO NGU + (#xA8 ?\u0E08) ;; THAI CHARACTER CHO CHAN + (#xA9 ?\u0E09) ;; THAI CHARACTER CHO CHING + (#xAA ?\u0E0A) ;; THAI CHARACTER CHO CHANG + (#xAB ?\u0E0B) ;; THAI CHARACTER SO SO + (#xAC ?\u0E0C) ;; THAI CHARACTER CHO CHOE + (#xAD ?\u0E0D) ;; THAI CHARACTER YO YING + (#xAE ?\u0E0E) ;; THAI CHARACTER DO CHADA + (#xAF ?\u0E0F) ;; THAI CHARACTER TO PATAK + (#xB0 ?\u0E10) ;; THAI CHARACTER THO THAN + (#xB1 ?\u0E11) ;; THAI CHARACTER THO NANGMONTHO + (#xB2 ?\u0E12) ;; THAI CHARACTER THO PHUTHAO + (#xB3 ?\u0E13) ;; THAI CHARACTER NO NEN + (#xB4 ?\u0E14) ;; THAI CHARACTER DO DEK + (#xB5 ?\u0E15) ;; THAI CHARACTER TO TAO + (#xB6 ?\u0E16) ;; THAI CHARACTER THO THUNG + (#xB7 ?\u0E17) ;; THAI CHARACTER THO THAHAN + (#xB8 ?\u0E18) ;; THAI CHARACTER THO THONG + (#xB9 ?\u0E19) ;; THAI CHARACTER NO NU + (#xBA ?\u0E1A) ;; THAI CHARACTER BO BAIMAI + (#xBB ?\u0E1B) ;; THAI CHARACTER PO PLA + (#xBC ?\u0E1C) ;; THAI CHARACTER PHO PHUNG + (#xBD ?\u0E1D) ;; THAI CHARACTER FO FA + (#xBE ?\u0E1E) ;; THAI CHARACTER PHO PHAN + (#xBF ?\u0E1F) ;; THAI CHARACTER FO FAN + (#xC0 ?\u0E20) ;; THAI CHARACTER PHO SAMPHAO + (#xC1 ?\u0E21) ;; THAI CHARACTER MO MA + (#xC2 ?\u0E22) ;; THAI CHARACTER YO YAK + (#xC3 ?\u0E23) ;; THAI CHARACTER RO RUA + (#xC4 ?\u0E24) ;; THAI CHARACTER RU + (#xC5 ?\u0E25) ;; THAI CHARACTER LO LING + (#xC6 ?\u0E26) ;; THAI CHARACTER LU + (#xC7 ?\u0E27) ;; THAI CHARACTER WO WAEN + (#xC8 ?\u0E28) ;; THAI CHARACTER SO SALA + (#xC9 ?\u0E29) ;; THAI CHARACTER SO RUSI + (#xCA ?\u0E2A) ;; THAI CHARACTER SO SUA + (#xCB ?\u0E2B) ;; THAI CHARACTER HO HIP + (#xCC ?\u0E2C) ;; THAI CHARACTER LO CHULA + (#xCD ?\u0E2D) ;; THAI CHARACTER O ANG + (#xCE ?\u0E2E) ;; THAI CHARACTER HO NOKHUK + (#xCF ?\u0E2F) ;; THAI CHARACTER PAIYANNOI + (#xD0 ?\u0E30) ;; THAI CHARACTER SARA A + (#xD1 ?\u0E31) ;; THAI CHARACTER MAI HAN-AKAT + (#xD2 ?\u0E32) ;; THAI CHARACTER SARA AA + (#xD3 ?\u0E33) ;; THAI CHARACTER SARA AM + (#xD4 ?\u0E34) ;; THAI CHARACTER SARA I + (#xD5 ?\u0E35) ;; THAI CHARACTER SARA II + (#xD6 ?\u0E36) ;; THAI CHARACTER SARA UE + (#xD7 ?\u0E37) ;; THAI CHARACTER SARA UEE + (#xD8 ?\u0E38) ;; THAI CHARACTER SARA U + (#xD9 ?\u0E39) ;; THAI CHARACTER SARA UU + (#xDA ?\u0E3A) ;; THAI CHARACTER PHINTHU + (#xDF ?\u0E3F) ;; THAI CURRENCY SYMBOL BAHT + (#xE0 ?\u0E40) ;; THAI CHARACTER SARA E + (#xE1 ?\u0E41) ;; THAI CHARACTER SARA AE + (#xE2 ?\u0E42) ;; THAI CHARACTER SARA O + (#xE3 ?\u0E43) ;; THAI CHARACTER SARA AI MAIMUAN + (#xE4 ?\u0E44) ;; THAI CHARACTER SARA AI MAIMALAI + (#xE5 ?\u0E45) ;; THAI CHARACTER LAKKHANGYAO + (#xE6 ?\u0E46) ;; THAI CHARACTER MAIYAMOK + (#xE7 ?\u0E47) ;; THAI CHARACTER MAITAIKHU + (#xE8 ?\u0E48) ;; THAI CHARACTER MAI EK + (#xE9 ?\u0E49) ;; THAI CHARACTER MAI THO + (#xEA ?\u0E4A) ;; THAI CHARACTER MAI TRI + (#xEB ?\u0E4B) ;; THAI CHARACTER MAI CHATTAWA + (#xEC ?\u0E4C) ;; THAI CHARACTER THANTHAKHAT + (#xED ?\u0E4D) ;; THAI CHARACTER NIKHAHIT + (#xEE ?\u0E4E) ;; THAI CHARACTER YAMAKKAN + (#xEF ?\u0E4F) ;; THAI CHARACTER FONGMAN + (#xF0 ?\u0E50) ;; THAI DIGIT ZERO + (#xF1 ?\u0E51) ;; THAI DIGIT ONE + (#xF2 ?\u0E52) ;; THAI DIGIT TWO + (#xF3 ?\u0E53) ;; THAI DIGIT THREE + (#xF4 ?\u0E54) ;; THAI DIGIT FOUR + (#xF5 ?\u0E55) ;; THAI DIGIT FIVE + (#xF6 ?\u0E56) ;; THAI DIGIT SIX + (#xF7 ?\u0E57) ;; THAI DIGIT SEVEN + (#xF8 ?\u0E58) ;; THAI DIGIT EIGHT + (#xF9 ?\u0E59) ;; THAI DIGIT NINE + (#xFA ?\u0E5A) ;; THAI CHARACTER ANGKHANKHU + (#xFB ?\u0E5B));; THAI CHARACTER KHOMUT + documentation "Non-composed Thai" + aliases (iso-8859-11))) -;; #### I don't know how this differs from the existing thai-xtis.el so -;; I'm leaving it commented out. +(make-coding-system + 'windows-874 'fixed-width "Microsoft's CP874" + '(mnemonic "CP874" + unicode-map + ((#x80 ?\u20AC) ;; EURO SIGN + (#x85 ?\u2026) ;; HORIZONTAL ELLIPSIS + (#x91 ?\u2018) ;; LEFT SINGLE QUOTATION MARK + (#x92 ?\u2019) ;; RIGHT SINGLE QUOTATION MARK + (#x93 ?\u201C) ;; LEFT DOUBLE QUOTATION MARK + (#x94 ?\u201D) ;; RIGHT DOUBLE QUOTATION MARK + (#x95 ?\u2022) ;; BULLET + (#x96 ?\u2013) ;; EN DASH + (#x97 ?\u2014) ;; EM DASH + (#xA0 ?\u00A0) ;; NO-BREAK SPACE + (#xA1 ?\u0E01) ;; THAI CHARACTER KO KAI + (#xA2 ?\u0E02) ;; THAI CHARACTER KHO KHAI + (#xA3 ?\u0E03) ;; THAI CHARACTER KHO KHUAT + (#xA4 ?\u0E04) ;; THAI CHARACTER KHO KHWAI + (#xA5 ?\u0E05) ;; THAI CHARACTER KHO KHON + (#xA6 ?\u0E06) ;; THAI CHARACTER KHO RAKHANG + (#xA7 ?\u0E07) ;; THAI CHARACTER NGO NGU + (#xA8 ?\u0E08) ;; THAI CHARACTER CHO CHAN + (#xA9 ?\u0E09) ;; THAI CHARACTER CHO CHING + (#xAA ?\u0E0A) ;; THAI CHARACTER CHO CHANG + (#xAB ?\u0E0B) ;; THAI CHARACTER SO SO + (#xAC ?\u0E0C) ;; THAI CHARACTER CHO CHOE + (#xAD ?\u0E0D) ;; THAI CHARACTER YO YING + (#xAE ?\u0E0E) ;; THAI CHARACTER DO CHADA + (#xAF ?\u0E0F) ;; THAI CHARACTER TO PATAK + (#xB0 ?\u0E10) ;; THAI CHARACTER THO THAN + (#xB1 ?\u0E11) ;; THAI CHARACTER THO NANGMONTHO + (#xB2 ?\u0E12) ;; THAI CHARACTER THO PHUTHAO + (#xB3 ?\u0E13) ;; THAI CHARACTER NO NEN + (#xB4 ?\u0E14) ;; THAI CHARACTER DO DEK + (#xB5 ?\u0E15) ;; THAI CHARACTER TO TAO + (#xB6 ?\u0E16) ;; THAI CHARACTER THO THUNG + (#xB7 ?\u0E17) ;; THAI CHARACTER THO THAHAN + (#xB8 ?\u0E18) ;; THAI CHARACTER THO THONG + (#xB9 ?\u0E19) ;; THAI CHARACTER NO NU + (#xBA ?\u0E1A) ;; THAI CHARACTER BO BAIMAI + (#xBB ?\u0E1B) ;; THAI CHARACTER PO PLA + (#xBC ?\u0E1C) ;; THAI CHARACTER PHO PHUNG + (#xBD ?\u0E1D) ;; THAI CHARACTER FO FA + (#xBE ?\u0E1E) ;; THAI CHARACTER PHO PHAN + (#xBF ?\u0E1F) ;; THAI CHARACTER FO FAN + (#xC0 ?\u0E20) ;; THAI CHARACTER PHO SAMPHAO + (#xC1 ?\u0E21) ;; THAI CHARACTER MO MA + (#xC2 ?\u0E22) ;; THAI CHARACTER YO YAK + (#xC3 ?\u0E23) ;; THAI CHARACTER RO RUA + (#xC4 ?\u0E24) ;; THAI CHARACTER RU + (#xC5 ?\u0E25) ;; THAI CHARACTER LO LING + (#xC6 ?\u0E26) ;; THAI CHARACTER LU + (#xC7 ?\u0E27) ;; THAI CHARACTER WO WAEN + (#xC8 ?\u0E28) ;; THAI CHARACTER SO SALA + (#xC9 ?\u0E29) ;; THAI CHARACTER SO RUSI + (#xCA ?\u0E2A) ;; THAI CHARACTER SO SUA + (#xCB ?\u0E2B) ;; THAI CHARACTER HO HIP + (#xCC ?\u0E2C) ;; THAI CHARACTER LO CHULA + (#xCD ?\u0E2D) ;; THAI CHARACTER O ANG + (#xCE ?\u0E2E) ;; THAI CHARACTER HO NOKHUK + (#xCF ?\u0E2F) ;; THAI CHARACTER PAIYANNOI + (#xD0 ?\u0E30) ;; THAI CHARACTER SARA A + (#xD1 ?\u0E31) ;; THAI CHARACTER MAI HAN-AKAT + (#xD2 ?\u0E32) ;; THAI CHARACTER SARA AA + (#xD3 ?\u0E33) ;; THAI CHARACTER SARA AM + (#xD4 ?\u0E34) ;; THAI CHARACTER SARA I + (#xD5 ?\u0E35) ;; THAI CHARACTER SARA II + (#xD6 ?\u0E36) ;; THAI CHARACTER SARA UE + (#xD7 ?\u0E37) ;; THAI CHARACTER SARA UEE + (#xD8 ?\u0E38) ;; THAI CHARACTER SARA U + (#xD9 ?\u0E39) ;; THAI CHARACTER SARA UU + (#xDA ?\u0E3A) ;; THAI CHARACTER PHINTHU + (#xDF ?\u0E3F) ;; THAI CURRENCY SYMBOL BAHT + (#xE0 ?\u0E40) ;; THAI CHARACTER SARA E + (#xE1 ?\u0E41) ;; THAI CHARACTER SARA AE + (#xE2 ?\u0E42) ;; THAI CHARACTER SARA O + (#xE3 ?\u0E43) ;; THAI CHARACTER SARA AI MAIMUAN + (#xE4 ?\u0E44) ;; THAI CHARACTER SARA AI MAIMALAI + (#xE5 ?\u0E45) ;; THAI CHARACTER LAKKHANGYAO + (#xE6 ?\u0E46) ;; THAI CHARACTER MAIYAMOK + (#xE7 ?\u0E47) ;; THAI CHARACTER MAITAIKHU + (#xE8 ?\u0E48) ;; THAI CHARACTER MAI EK + (#xE9 ?\u0E49) ;; THAI CHARACTER MAI THO + (#xEA ?\u0E4A) ;; THAI CHARACTER MAI TRI + (#xEB ?\u0E4B) ;; THAI CHARACTER MAI CHATTAWA + (#xEC ?\u0E4C) ;; THAI CHARACTER THANTHAKHAT + (#xED ?\u0E4D) ;; THAI CHARACTER NIKHAHIT + (#xEE ?\u0E4E) ;; THAI CHARACTER YAMAKKAN + (#xEF ?\u0E4F) ;; THAI CHARACTER FONGMAN + (#xF0 ?\u0E50) ;; THAI DIGIT ZERO + (#xF1 ?\u0E51) ;; THAI DIGIT ONE + (#xF2 ?\u0E52) ;; THAI DIGIT TWO + (#xF3 ?\u0E53) ;; THAI DIGIT THREE + (#xF4 ?\u0E54) ;; THAI DIGIT FOUR + (#xF5 ?\u0E55) ;; THAI DIGIT FIVE + (#xF6 ?\u0E56) ;; THAI DIGIT SIX + (#xF7 ?\u0E57) ;; THAI DIGIT SEVEN + (#xF8 ?\u0E58) ;; THAI DIGIT EIGHT + (#xF9 ?\u0E59) ;; THAI DIGIT NINE + (#xFA ?\u0E5A) ;; THAI CHARACTER ANGKHANKHU + (#xFB ?\u0E5B));; THAI CHARACTER KHOMUT + documentation "Microsoft's encoding for Thai." + aliases (cp874))) -;;; Code: - -; (make-charset 'thai-tis620 -; "Right-Hand Part of TIS620.2533 (Thai): ISO-IR-166" -; '(dimension -; 1 -; registry "TIS620" -; chars 96 -; columns 1 -; direction l2r -; final ?T -; graphic 1 -; short-name "RHP of TIS620" -; long-name "RHP of Thai (TIS620): ISO-IR-166" -; )) - -; ; (make-coding-system -; ; 'thai-tis620 2 ?T -; ; "8-bit encoding for ASCII (MSB=0) and Thai TIS620 (MSB=1)" -; ; '(ascii thai-tis620 nil nil -; ; nil ascii-eol) -; ; '((safe-charsets ascii thai-tis620) -; ; (post-read-conversion . thai-post-read-conversion))) - -; (make-coding-system -; 'thai-tis620 'iso2022 "Thai/TIS620" -; '(charset-g0 ascii -; charset-g1 thai-tis620 -; mnemonic "Thai" -; safe-charsets (ascii thai-tis620) -; post-read-conversion thai-post-read-conversion -; documentation "8-bit encoding for ASCII (MSB=0) and Thai TIS620 (MSB=1)")) - -; (define-coding-system-alias 'th-tis620 'thai-tis620) -; (define-coding-system-alias 'tis620 'thai-tis620) -; (define-coding-system-alias 'tis-620 'thai-tis620) - -; (set-language-info-alist -; "Thai" '((tutorial . "TUTORIAL.th") -; (charset thai-tis620) -; (coding-system thai-tis620) -; (coding-priority thai-tis620) -; (nonascii-translation . thai-tis620) -; (input-method . "thai-kesmanee") -; (unibyte-display . thai-tis620) -; (features thai-util) -; (sample-text -; . (thai-compose-string -; (copy-sequence "Thai (,T＠RIRd7B(B) ,TJ0GQ1J04U1$0CQ1:(B, ,TJ0GQ1J04U10$h1P(B"))) -; (documentation . t))) - - -;; Register a function to compose Thai characters. -; (put-char-table 'thai-tis620 -; '(("\\c0\\c4\\|\\c0\$\\c2\\|\\c3\$\\c4?" . -; thai-composition-function)) -; composition-function-table) +(set-language-info-alist + "Thai" + '((coding-system tis-620 utf-8) + (tutorial . "TUTORIAL.th") + (tutorial-coding-system . tis-620) + (coding-priority tis-620 utf-8 iso-2022-7bit) + (sample-text . "สวัสดีครับ, สวัสดีค่ะ") + (documentation . t))) (provide 'thai) diff -r ccf7e84fe265 -r 75469840109b lisp/unicode.el --- a/lisp/unicode.el Mon Apr 04 20:34:17 2011 +0100 +++ b/lisp/unicode.el Fri Apr 08 14:44:20 2011 +0100 ＠＠ -161,7 +161,7 ＠＠ indian-is13194 korean-ksc5601 chinese-cns11643-1 chinese-cns11643-2 chinese-isoir165 composite ethiopic indian-1-column indian-2-column jit-ucs-charset-0 - katakana-jisx0201 lao thai-tis620 thai-xtis tibetan tibetan-1-column + katakana-jisx0201 lao thai-tis620 tibetan tibetan-1-column latin-jisx0201 chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5 chinese-cns11643-6 chinese-cns11643-7))))) _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

[PATCH] Force control char disambiguity if giving XEmacs key sequences 13 years

Aidan Kehoe

This doesn’t bring much to users, and would probably need to be accompanied by some changes to the packages, though I believe I addressed most of them around the time of http://mid.gmane.org/19585.17108.616205.880365＠parhasard.net . It makes the documentation clearer and less ambiguous and makes life easier for programmers. src/ChangeLog addition: 2011-04-04 Aidan Kehoe <kehoea(a)parhasard.net> * keymap.c (Fdefine_key): Make the docstring here clearer; don't apply the ASCII hack to key sequences specified with vectors of characters, which are XEmacs-specific and should be expected to be sane from the ASCII-confusion perspective. lisp/ChangeLog addition: 2011-04-04 Aidan Kehoe <kehoea(a)parhasard.net> * help.el (help-map): * keydefs.el (global-map): Don't assume #'define-key will apply the ASCII-equivalence hack to keys specified with vectors of characters, construct strings instead (where the ASCII hack will be accepted for the foreseeable future). diff -r ccf7e84fe265 lisp/help.el --- a/lisp/help.el Mon Apr 04 20:34:17 2011 +0100 +++ b/lisp/help.el Mon Apr 04 22:53:34 2011 +0100 ＠＠ -61,7 +61,7 ＠＠ ;; global-map definitions moved to keydefs.el (fset 'help-command help-map) -(define-key help-map (vector help-char) 'help-for-help) +(define-key help-map (string help-char) 'help-for-help) (define-key help-map "?" 'help-for-help) (define-key help-map 'help 'help-for-help) (define-key help-map '(f1) 'help-for-help) diff -r ccf7e84fe265 lisp/keydefs.el --- a/lisp/keydefs.el Mon Apr 04 20:34:17 2011 +0100 +++ b/lisp/keydefs.el Mon Apr 04 22:53:34 2011 +0100 ＠＠ -156,7 +156,7 ＠＠ ;; FSFmacs help.el -(define-key global-map (vector help-char) 'help-command) +(define-key global-map (string help-char) 'help-command) (define-key global-map 'help 'help-command) (define-key global-map 'f1 'help-command) ;; This is a failsafe mechanism, esp. on TTY's, in case the terminal is --- a/src/keymap.c Mon Apr 04 20:34:17 2011 +0100 +++ b/src/keymap.c Mon Apr 04 22:53:34 2011 +0100 ＠＠ -1828,16 +1828,20 ＠＠ `define-key' also accepts a number of abbreviations, aliases, and variants for convenience, compatibility, and internal use. -A keystroke may be represented by a key; this is treated as though it were a -list containing that key as the only element. A keystroke may also be -represented by an event object, as returned by the `next-command-event' and -`read-key-sequence' functions. A key sequence may be represented by a -single keystroke; this is treated as a vector containing that keystroke as -its only element. - -A key may be represented by a character or its equivalent integer code, -if and only if it is equivalent to a character with a code in the range -32 - 255. +A key sequence may be represented by a single keystroke. This is treated as +a vector containing that keystroke as its only element. XEmacs refuses to +accept key sequences represented by single keystrokes if those single +keystrokes are characters or integers below #x20 (the code for space). + +A keystroke may be represented by a key; this is treated as though it were a +list containing that key as the only element. + +A keystroke may also be represented by an event object, as returned by the +`next-command-event' and `read-key-sequence' functions. A key sequence may +be represented by a single keystroke; this is treated as a vector containing +that keystroke as its only element. + +A key may be represented by a character or its equivalent integer code. For backward compatibility, a key sequence may also be represented by a string. In this case, it represents the key sequence(s) that would ＠＠ -1937,10 +1941,17 ＠＠ Lisp_Object c; Lisp_Key_Data raw_key1; Lisp_Key_Data raw_key2; - if (STRINGP (keys)) + if (ascii_hack) c = make_char (string_ichar (keys, idx)); else - c = XVECTOR_DATA (keys) [idx]; + { + c = XVECTOR_DATA (keys) [idx]; + if (CHARP (c)) + { + /* Avoid problems with meta-character identity. */ + c = XVECTOR_DATA (keys) [idx] = list1 (c); + } + } define_key_parser (c, &raw_key1); -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

[COMMIT] Correct some nesting of GCPRO and UNGCPRO, thank you Mats' buildbot! 13 years

Aidan Kehoe

I had *built* the last version with the C++ compiler, but I hadn’t compiled the Lisp with it, which revealed the problems the below addresses. APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1301904759 -3600 # Node ID 484b437fc7b427b77cea75392465b10d533a6d98 # Parent e99b473303e3fe0b4198ea47578c483bdde09712 Correct some nesting of GCPRO and UNGCPRO, thank you Mats' buildbot! 2011-04-04 Aidan Kehoe <kehoea(a)parhasard.net> * fns.c (FremoveX): * fns.c (sublis): Correct some nesting of GCPRO and UNGCPRO here, revealed by the the C++ build compiling core Lisp. Thank you Mats' buildbot! diff -r e99b473303e3 -r 484b437fc7b4 src/ChangeLog --- a/src/ChangeLog Mon Apr 04 00:20:09 2011 +0100 +++ b/src/ChangeLog Mon Apr 04 09:12:39 2011 +0100 ＠＠ -1,3 +1,10 ＠＠ +2011-04-04 Aidan Kehoe <kehoea(a)parhasard.net> + + * fns.c (FremoveX): + * fns.c (sublis): + Correct some nesting of GCPRO and UNGCPRO here, revealed by the + the C++ build compiling core Lisp. Thank you Mats' buildbot! + 2011-04-04 Aidan Kehoe <kehoea(a)parhasard.net> * lisp.h (GC_EXTERNAL_LIST_LOOP_3, GC_EXTERNAL_LIST_LOOP_4): New. diff -r e99b473303e3 -r 484b437fc7b4 src/fns.c --- a/src/fns.c Mon Apr 04 00:20:09 2011 +0100 +++ b/src/fns.c Mon Apr 04 09:12:39 2011 +0100 ＠＠ -3658,6 +3658,7 ＠＠ if (EQ (tail, tailing)) { XUNGCPRO (elt); + UNGCPRO; if (NILP (result)) { ＠＠ -9147,7 +9148,7 ＠＠ if (!CONSP (tree)) { - RETURN_UNGCPRO (tree); + return tree; } aa = sublis (alist, XCAR (tree), check_test, test_not_unboundp, test, key, ＠＠ -9157,10 +9158,10 ＠＠ if (EQ (aa, XCAR (tree)) && EQ (dd, XCDR (tree))) { - RETURN_UNGCPRO (tree); - } - - RETURN_UNGCPRO (Fcons (aa, dd)); + return tree; + } + + return Fcons (aa, dd); } DEFUN ("sublis", Fsublis, 2, MANY, 0, /* -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

commit: Correct some nesting of GCPRO and UNGCPRO, thank you Mats' buildbot! 13 years

Aidan Kehoe

changeset: 5394:484b437fc7b4 tag: tip user: Aidan Kehoe <kehoea(a)parhasard.net> date: Mon Apr 04 09:12:39 2011 +0100 files: src/ChangeLog src/fns.c description: Correct some nesting of GCPRO and UNGCPRO, thank you Mats' buildbot! 2011-04-04 Aidan Kehoe <kehoea(a)parhasard.net> * fns.c (FremoveX): * fns.c (sublis): Correct some nesting of GCPRO and UNGCPRO here, revealed by the the C++ build compiling core Lisp. Thank you Mats' buildbot! diff -r e99b473303e3 -r 484b437fc7b4 src/ChangeLog --- a/src/ChangeLog Mon Apr 04 00:20:09 2011 +0100 +++ b/src/ChangeLog Mon Apr 04 09:12:39 2011 +0100 ＠＠ -1,3 +1,10 ＠＠ +2011-04-04 Aidan Kehoe <kehoea(a)parhasard.net> + + * fns.c (FremoveX): + * fns.c (sublis): + Correct some nesting of GCPRO and UNGCPRO here, revealed by the + the C++ build compiling core Lisp. Thank you Mats' buildbot! + 2011-04-04 Aidan Kehoe <kehoea(a)parhasard.net> * lisp.h (GC_EXTERNAL_LIST_LOOP_3, GC_EXTERNAL_LIST_LOOP_4): New. diff -r e99b473303e3 -r 484b437fc7b4 src/fns.c --- a/src/fns.c Mon Apr 04 00:20:09 2011 +0100 +++ b/src/fns.c Mon Apr 04 09:12:39 2011 +0100 ＠＠ -3658,6 +3658,7 ＠＠ if (EQ (tail, tailing)) { XUNGCPRO (elt); + UNGCPRO; if (NILP (result)) { ＠＠ -9147,7 +9148,7 ＠＠ if (!CONSP (tree)) { - RETURN_UNGCPRO (tree); + return tree; } aa = sublis (alist, XCAR (tree), check_test, test_not_unboundp, test, key, ＠＠ -9157,10 +9158,10 ＠＠ if (EQ (aa, XCAR (tree)) && EQ (dd, XCDR (tree))) { - RETURN_UNGCPRO (tree); - } - - RETURN_UNGCPRO (Fcons (aa, dd)); + return tree; + } + + return Fcons (aa, dd); } DEFUN ("sublis", Fsublis, 2, MANY, 0, /* _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

[COMMIT] Use GC_EXTERNAL_LIST_LOOP_* where appropriate, fns.c 13 years

Aidan Kehoe

Raymond, this probably won’t resolve your slime crash, but there’s an outside possibility it *could.* I’ll try your recipe to reproduce it over the next few days, it is almost certainly my bug. APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1301872809 -3600 # Node ID e99b473303e3fe0b4198ea47578c483bdde09712 # Parent 25c10648ffbaeaa8cacb9de0e60622664288eccd Use GC_EXTERNAL_LIST_LOOP_* where appropriate, fns.c src/ChangeLog addition: 2011-04-04 Aidan Kehoe <kehoea(a)parhasard.net> * lisp.h (GC_EXTERNAL_LIST_LOOP_3, GC_EXTERNAL_LIST_LOOP_4): New. * fns.c (count_with_tail, list_position_cons_before, FassocX): * fns.c (FrassocX, position, FdeleteX, FremoveX): * fns.c (list_delete_duplicates_from_end): * fns.c (Fdelete_duplicates, Fremove_duplicates, Freduce): * fns.c (Fnsubstitute, Fsubstitute, sublis, nsublis, Fnsublis): * fns.c (venn, nvenn, Funion, Fset_exclusive_or, Fnset_exclusive_or): Use GC_EXTERNAL_LIST_LOOP_* in the sequence functions in fns.c where appropriate, there were some corner cases where my old approach was unsafe (mainly if the circularity checking's tortoise lost GCPRO protection. Add GC_EXTERNAL_LIST_LOOP_{3,4}, analogous to GC_EXTERNAL_LIST_LOOP_2. diff -r 25c10648ffba -r e99b473303e3 src/ChangeLog --- a/src/ChangeLog Sat Apr 02 16:18:07 2011 +0100 +++ b/src/ChangeLog Mon Apr 04 00:20:09 2011 +0100 ＠＠ -1,3 +1,19 ＠＠ +2011-04-04 Aidan Kehoe <kehoea(a)parhasard.net> + + * lisp.h (GC_EXTERNAL_LIST_LOOP_3, GC_EXTERNAL_LIST_LOOP_4): New. + * fns.c (count_with_tail, list_position_cons_before, FassocX): + * fns.c (FrassocX, position, FdeleteX, FremoveX): + * fns.c (list_delete_duplicates_from_end): + * fns.c (Fdelete_duplicates, Fremove_duplicates, Freduce): + * fns.c (Fnsubstitute, Fsubstitute, sublis, nsublis, Fnsublis): + * fns.c (venn, nvenn, Funion, Fset_exclusive_or, Fnset_exclusive_or): + Use GC_EXTERNAL_LIST_LOOP_* in the sequence functions in fns.c + where appropriate, there were some corner cases where my old + approach was unsafe (mainly if the circularity checking's tortoise + lost GCPRO protection. + Add GC_EXTERNAL_LIST_LOOP_{3,4}, analogous to + GC_EXTERNAL_LIST_LOOP_2. + 2011-03-24 Jerry James <james(a)xemacs.org> * alloc.c (listu): Assemble the list in the right order so we don't diff -r 25c10648ffba -r e99b473303e3 src/fns.c --- a/src/fns.c Sat Apr 02 16:18:07 2011 +0100 +++ b/src/fns.c Mon Apr 04 00:20:09 2011 +0100 ＠＠ -1009,9 +1009,6 ＠＠ if (CONSP (sequence)) { - Lisp_Object elt, tail = Qnil; - struct gcpro gcpro1; - if (EQ (caller, Qcount) && !NILP (from_end) && (!EQ (key, Qnil) || check_test == check_other_nokey || check_test == check_if_nokey)) ＠＠ -1026,8 +1023,6 ＠＠ start, end); } - GCPRO1 (tail); - /* If COUNT is non-nil and FROM-END is t, we can give the tail containing the last match, since that's what #'remove* is interested in (a zero or negative COUNT won't ever reach ＠＠ -1039,7 +1034,7 ＠＠ } { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len) + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) { if (!(ii < ending)) { ＠＠ -1060,9 +1055,8 ＠＠ ii++; } - } - - UNGCPRO; + END_GC_EXTERNAL_LIST_LOOP (elt); + } if ((ii < starting || (ii < ending && !NILP (end))) && encountered != counting) ＠＠ -2622,18 +2616,18 ＠＠ Boolint reverse_test_order, Lisp_Object start, Lisp_Object end) { - struct gcpro gcpro1, gcpro2; - Lisp_Object elt = Qnil, tail = list, tail_before = Qnil; - Elemcount len, ii = 0, starting = XINT (start); + struct gcpro gcpro1; + Lisp_Object tail_before = Qnil; + Elemcount ii = 0, starting = XINT (start); Elemcount ending = NILP (end) ? EMACS_INT_MAX : XINT (end); - GCPRO2 (elt, tail); + GCPRO1 (tail_before); if (check_test == check_eq_nokey) { /* TEST is #'eq, no need to call any C functions, and the test order won't be visible. */ - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, list, tail, len) + EXTERNAL_LIST_LOOP_3 (elt, list, tail) { if (starting <= ii && ii < ending && EQ (item, elt) == test_not_unboundp) ＠＠ -2654,15 +2648,17 ＠＠ } else { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, list, tail, len) + GC_EXTERNAL_LIST_LOOP_3 (elt, list, tail) { if (starting <= ii && ii < ending && (reverse_test_order ? check_test (test, key, elt, item) : - check_test (test, key, item, elt)) == test_not_unboundp) + check_test (test, key, item, elt)) == test_not_unboundp) { *cons_out = tail_before; - RETURN_UNGCPRO (make_integer (ii)); + XUNGCPRO (elt); + UNGCPRO; + return make_integer (ii); } else { ＠＠ -2674,6 +2670,7 ＠＠ ii++; tail_before = tail; } + END_GC_EXTERNAL_LIST_LOOP (elt); } RETURN_UNGCPRO (Qnil); ＠＠ -2860,22 +2857,16 ＠＠ } else { - Lisp_Object tailed = alist; - struct gcpro gcpro1; - - GCPRO1 (tailed); - { - EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail) - { - tailed = tail; - - if (check_test (test, key, item, elt_car) == test_not_unboundp) - { - RETURN_UNGCPRO (elt); - } - } - } - UNGCPRO; + GC_EXTERNAL_LIST_LOOP_2 (elt, alist) + { + if (CONSP (elt) && + check_test (test, key, item, XCAR (elt)) == test_not_unboundp) + { + XUNGCPRO (elt); + return elt; + } + } + END_GC_EXTERNAL_LIST_LOOP (elt); } return Qnil; ＠＠ -2969,22 +2960,16 ＠＠ } else { - struct gcpro gcpro1; - Lisp_Object tailed = alist; - - GCPRO1 (tailed); - { - EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail) - { - tailed = tail; - - if (check_test (test, key, item, elt_cdr) == test_not_unboundp) - { - RETURN_UNGCPRO (elt); - } - } - } - UNGCPRO; + GC_EXTERNAL_LIST_LOOP_2 (elt, alist) + { + if (CONSP (elt) && + check_test (test, key, item, XCDR (elt)) == test_not_unboundp) + { + XUNGCPRO (elt); + return elt; + } + } + END_GC_EXTERNAL_LIST_LOOP (elt); } return Qnil; ＠＠ -3014,9 +2999,6 ＠＠ if (CONSP (sequence)) { - Lisp_Object elt, tail = Qnil; - struct gcpro gcpro1; - if (!(starting < ending)) { check_sequence_range (sequence, start, end, Flength (sequence)); ＠＠ -3025,10 +3007,8 ＠＠ return Qnil; } - GCPRO1 (tail); - - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len) + { + GC_EXTERNAL_LIST_LOOP_2 (elt, sequence) { if (starting <= ii && ii < ending && check_test (test, key, item, elt) == test_not_unboundp) ＠＠ -3038,7 +3018,7 ＠＠ if (NILP (from_end)) { - UNGCPRO; + XUNGCPRO (elt); return result; } } ＠＠ -3049,9 +3029,8 ＠＠ ii++; } - } - - UNGCPRO; + END_GC_EXTERNAL_LIST_LOOP (elt); + } if (ii < starting || (ii < ending && !NILP (end))) { ＠＠ -3259,12 +3238,11 ＠＠ */ (int nargs, Lisp_Object *args)) { - Lisp_Object item = args[0], sequence = args[1], tail = sequence; + Lisp_Object item = args[0], sequence = args[1]; Elemcount starting = 0, ending = EMACS_INT_MAX, counting = EMACS_INT_MAX; Elemcount len, ii = 0, encountered = 0, presenting = 0; Boolint test_not_unboundp = 1; check_test_func_t check_test = NULL; - struct gcpro gcpro1; PARSE_KEYWORDS (FdeleteX, nargs, args, 9, (test, if_not, if_, test_not, key, start, end, from_end, ＠＠ -3309,14 +3287,15 ＠＠ if (CONSP (sequence)) { - Lisp_Object prev_tail_list_elt = Qnil, list_elt = Qnil; + Lisp_Object prev_tail_list_elt = Qnil, ignore = Qnil; Elemcount list_len = 0, deleted = 0; + struct gcpro gcpro1; if (!NILP (count) && !NILP (from_end)) { /* Both COUNT and FROM-END were specified; we need to traverse the list twice. */ - Lisp_Object present = count_with_tail (&list_elt, nargs, args, + Lisp_Object present = count_with_tail (&ignore, nargs, args, QdeleteX); if (ZEROP (present)) ＠＠ -3334,11 +3313,11 ＠＠ presenting = presenting <= counting ? 0 : presenting - counting; } - GCPRO1 (tail); + GCPRO1 (prev_tail_list_elt); ii = -1; { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (list_elt, sequence, tail, list_len) + GC_EXTERNAL_LIST_LOOP_4 (list_elt, sequence, tail, list_len) { ii++; ＠＠ -3369,6 +3348,7 ＠＠ } } } + END_GC_EXTERNAL_LIST_LOOP (list_elt); } UNGCPRO; ＠＠ -3606,10 +3586,9 ＠＠ Lisp_Object item = args[0], sequence = args[1], matched_count = Qnil, tail = Qnil; Elemcount starting = 0, ending = EMACS_INT_MAX, counting = EMACS_INT_MAX; - Elemcount len, ii = 0, encountered = 0, presenting = 0; - Boolint test_not_unboundp = 1; - check_test_func_t check_test = NULL; - struct gcpro gcpro1; + Elemcount ii = 0, encountered = 0, presenting = 0; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; PARSE_KEYWORDS (FremoveX, nargs, args, 9, (test, if_not, if_, test_not, key, start, end, from_end, ＠＠ -3657,8 +3636,8 ＠＠ if (!ZEROP (matched_count)) { - Lisp_Object elt, tailing = Qnil, result = Qnil, result_tail = Qnil; - GCPRO1 (tailing); + Lisp_Object result = Qnil, result_tail = Qnil; + struct gcpro gcpro1, gcpro2; if (!NILP (count) && !NILP (from_end)) { ＠＠ -3672,18 +3651,21 ＠＠ presenting = presenting <= counting ? 0 : presenting - counting; } - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tailing, len) + GCPRO2 (result, tail); + { + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tailing) { if (EQ (tail, tailing)) { + XUNGCPRO (elt); + if (NILP (result)) { - RETURN_UNGCPRO (XCDR (tail)); + return XCDR (tail); } XSETCDR (result_tail, XCDR (tail)); - RETURN_UNGCPRO (result); + return result; } else if (starting <= ii && ii < ending && (check_test (test, key, item, elt) == test_not_unboundp) ＠＠ -3709,8 +3691,8 ＠＠ ii++; } - } - + END_GC_EXTERNAL_LIST_LOOP (elt); + } UNGCPRO; if (ii < starting || (ii < ending && !NILP (end))) ＠＠ -3829,12 +3811,12 ＠＠ Lisp_Object start, Lisp_Object end, Boolint copy) { - Lisp_Object checking = Qnil, elt, tail, result = list; + Lisp_Object checking = Qnil, result = list; Lisp_Object keyed, positioned, position_cons = Qnil, result_tail; Elemcount len = XINT (Flength (list)), pos, starting = XINT (start); Elemcount ending = (NILP (end) ? len : XINT (end)), greatest_pos_seen = -1; Elemcount ii = 0; - struct gcpro gcpro1, gcpro2; + struct gcpro gcpro1; /* We can't delete (or remove) as we go, because that breaks START and END. We could if END were nil, and that would change an ON(N + 2) ＠＠ -3854,10 +3836,10 ＠＠ memset (&(deleting->bits), 0, sizeof (long) * BIT_VECTOR_LONG_STORAGE (len)); - GCPRO2 (tail, keyed); - - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, list, tail, len) + GCPRO1 (keyed); + + { + GC_EXTERNAL_LIST_LOOP_3 (elt, list, tail) { if (!(starting <= ii && ii <= ending) || bit_vector_bit (deleting, ii)) { ＠＠ -3884,6 +3866,7 ＠＠ } ii++; } + END_GC_EXTERNAL_LIST_LOOP (elt); } UNGCPRO; ＠＠ -3899,7 +3882,7 ＠＠ ii = 1; { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, list, tail, len) + EXTERNAL_LIST_LOOP_3 (elt, list, tail) { if (ii == greatest_pos_seen) { ＠＠ -3917,7 +3900,7 ＠＠ } else { - EXTERNAL_LIST_LOOP_DELETE_IF (elt0, list, + EXTERNAL_LIST_LOOP_DELETE_IF (elt, list, bit_vector_bit (deleting, ii++)); } } ＠＠ -3945,8 +3928,8 ＠＠ */ (int nargs, Lisp_Object *args)) { - Lisp_Object sequence = args[0], tail = sequence, keyed = Qnil, elt = Qnil; - Lisp_Object elt0 = Qnil, positioned = Qnil, ignore = Qnil; + Lisp_Object sequence = args[0], keyed = Qnil; + Lisp_Object positioned = Qnil, ignore = Qnil; Elemcount starting = 0, ending = EMACS_INT_MAX, len, ii = 0, jj = 0; Boolint test_not_unboundp = 1; check_test_func_t check_test = NULL; ＠＠ -3978,10 +3961,10 ＠＠ Lisp_Object prev_tail = Qnil; Elemcount deleted = 0; - GCPRO2 (tail, keyed); - - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len) + GCPRO2 (keyed, prev_tail); + + { + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) { if (starting <= ii && ii < ending) { ＠＠ -4012,9 +3995,10 ＠＠ ii++; } - } - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt0, sequence, tail, len) + END_GC_EXTERNAL_LIST_LOOP (elt); + } + { + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) { if (!(starting <= ii && ii <= ending)) { ＠＠ -4023,7 +4007,7 ＠＠ continue; } - keyed = KEY (key, elt0); + keyed = KEY (key, elt); positioned = list_position_cons_before (&ignore, keyed, XCDR (tail), check_test, test_not_unboundp, ＠＠ -4052,7 +4036,9 ＠＠ ii++; } - } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + UNGCPRO; if ((ii < starting || (ii < ending && !NILP (end)))) ＠＠ -4072,6 +4058,8 ＠＠ } else if (STRINGP (sequence)) { + Lisp_Object elt = Qnil; + if (EQ (Qidentity, key)) { /* We know all the elements will be characters; set check_test to ＠＠ -4090,7 +4078,6 ＠＠ Ibyte *cursor = XSTRING_DATA (sequence), *startp = cursor; Elemcount deleted = 0; - elt = Qnil; GCPRO1 (elt); while (cursor_offset < byte_len) ＠＠ -4245,6 +4232,7 ＠＠ Elemcount deleted = 0; Lisp_Object *content = XVECTOR_DATA (sequence); struct Lisp_Bit_Vector *deleting; + Lisp_Object elt = Qnil; len = XVECTOR_LENGTH (sequence); check_sequence_range (sequence, start, end, make_integer (len)); ＠＠ -4328,6 +4316,7 ＠＠ and KEY arguments, which may be non-deterministic from our perspective, we need the same algorithm as for vectors. */ struct Lisp_Bit_Vector *deleting; + Lisp_Object elt = Qnil; len = bit_vector_length (bv); ＠＠ -4429,13 +4418,13 ＠＠ */ (int nargs, Lisp_Object *args)) { - Lisp_Object sequence = args[0], tail = sequence, keyed, positioned = Qnil; + Lisp_Object sequence = args[0], keyed, positioned = Qnil; Lisp_Object result = sequence, result_tail = result, cursor = Qnil; - Lisp_Object cons_with_shared_tail = Qnil, elt, elt0; - Elemcount starting = 0, ending = EMACS_INT_MAX, len, ii = 0; - Boolint test_not_unboundp = 1; - check_test_func_t check_test = NULL; - struct gcpro gcpro1, gcpro2, gcpro3; + Lisp_Object cons_with_shared_tail = Qnil; + Elemcount starting = 0, ending = EMACS_INT_MAX, ii = 0; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; + struct gcpro gcpro1, gcpro2; PARSE_KEYWORDS (Fremove_duplicates, nargs, args, 6, (test, key, test_not, start, end, from_end), ＠＠ -4469,10 +4458,10 ＠＠ { Lisp_Object ignore = Qnil; - GCPRO3 (tail, keyed, result); - - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len) + GCPRO2 (keyed, result); + + { + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) { if (starting <= ii && ii <= ending) { ＠＠ -4500,10 +4489,11 ＠＠ ii++; } - } - - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt0, sequence, tail, len) + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + { + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) { if (!(starting <= ii && ii <= ending)) { ＠＠ -4516,7 +4506,7 ＠＠ removed cons to this one. Otherwise, the tail of the output list is shared with the input list, which is OK. */ - keyed = KEY (key, elt0); + keyed = KEY (key, elt); positioned = list_position_cons_before (&ignore, keyed, XCDR (tail), check_test, test_not_unboundp, ＠＠ -4548,7 +4538,9 ＠＠ ii++; } - } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + UNGCPRO; if ((ii < starting || (ii < ending && !NILP (end)))) ＠＠ -7932,10 +7924,9 ＠＠ { if (NILP (from_end)) { - struct gcpro gcpro1, gcpro2; - Lisp_Object tailed = Qnil; - - GCPRO2 (tailed, accum); + struct gcpro gcpro1; + + GCPRO1 (accum); if (!UNBOUNDP (initial_value)) { ＠＠ -7943,11 +7934,8 ＠＠ } else if (ending - starting) { - EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) - { - /* KEY may amputate the list behind us; make sure what - remains to be processed is still reachable. */ - tailed = tail; + GC_EXTERNAL_LIST_LOOP_2 (elt, sequence) + { if (ii == starting) { accum = KEY (key, elt); ＠＠ -7956,18 +7944,15 ＠＠ } ++ii; } + END_GC_EXTERNAL_LIST_LOOP (elt); } ii = 0; if (ending - starting) { - EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) - { - /* KEY or FUNCTION may amputate the list behind us; make - sure what remains to be processed is still - reachable. */ - tailed = tail; + GC_EXTERNAL_LIST_LOOP_2 (elt, sequence) + { if (ii >= starting) { if (ii < ending) ＠＠ -7981,6 +7966,7 ＠＠ } ++ii; } + END_GC_EXTERNAL_LIST_LOOP (elt); } UNGCPRO; ＠＠ -8703,13 +8689,12 ＠＠ */ (int nargs, Lisp_Object *args)) { - Lisp_Object new_ = args[0], item = args[1], sequence = args[2], tail = Qnil; + Lisp_Object new_ = args[0], item = args[1], sequence = args[2]; Lisp_Object object_, position0; Elemcount starting = 0, ending = EMACS_INT_MAX, encountered = 0; Elemcount len, ii = 0, counting = EMACS_INT_MAX, presenting = 0; Boolint test_not_unboundp = 1; check_test_func_t check_test = NULL; - struct gcpro gcpro1; PARSE_KEYWORDS (Fnsubstitute, nargs, args, 9, (test, if_, if_not, test_not, key, start, end, count, ＠＠ -8751,11 +8736,9 ＠＠ if (CONSP (sequence)) { - Lisp_Object elt; - if (!NILP (count) && !NILP (from_end)) { - Lisp_Object present = count_with_tail (&elt, nargs - 1, args + 1, + Lisp_Object present = count_with_tail (&object_, nargs - 1, args + 1, Qnsubstitute); if (ZEROP (present)) ＠＠ -8767,9 +8750,8 ＠＠ presenting = presenting <= counting ? 0 : presenting - counting; } - GCPRO1 (tail); - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len) + { + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) { if (!(ii < ending)) { ＠＠ -8791,8 +8773,8 ＠＠ ii++; } - } - UNGCPRO; + END_GC_EXTERNAL_LIST_LOOP (elt); + } if ((ii < starting || (ii < ending && !NILP (end))) && encountered < counting) ＠＠ -8964,10 +8946,10 ＠＠ (int nargs, Lisp_Object *args)) { Lisp_Object new_ = args[0], item = args[1], sequence = args[2], tail = Qnil; - Lisp_Object elt, tailing = Qnil, result = Qnil, result_tail = Qnil; + Lisp_Object result = Qnil, result_tail = Qnil; Lisp_Object object, position0, matched_count; Elemcount starting = 0, ending = EMACS_INT_MAX, encountered = 0; - Elemcount len, ii = 0, counting = EMACS_INT_MAX, presenting = 0; + Elemcount ii = 0, counting = EMACS_INT_MAX, presenting = 0; Boolint test_not_unboundp = 1; check_test_func_t check_test = NULL; struct gcpro gcpro1; ＠＠ -9044,19 +9026,22 ＠＠ presenting = presenting <= counting ? 0 : presenting - counting; } - GCPRO1 (tailing); - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tailing, len) + GCPRO1 (result); + { + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tailing) { if (EQ (tail, tailing)) { + XUNGCPRO (elt); + UNGCPRO; + if (NILP (result)) { - RETURN_UNGCPRO (XCDR (tail)); + return XCDR (tail); } XSETCDR (result_tail, XCDR (tail)); - RETURN_UNGCPRO (result); + return result; } else if (starting <= ii && ii < ending && (check_test (test, key, item, elt) == test_not_unboundp) ＠＠ -9090,6 +9075,7 ＠＠ ii++; } + END_GC_EXTERNAL_LIST_LOOP (elt); } UNGCPRO; ＠＠ -9138,28 +9124,27 ＠＠ check_test_func_t check_test, Boolint test_not_unboundp, Lisp_Object test, Lisp_Object key, int depth) { - Lisp_Object keyed = KEY (key, tree), tailed = alist, aa, dd; - struct gcpro gcpro1, gcpro2, gcpro3; + Lisp_Object keyed = KEY (key, tree), aa, dd; + struct gcpro gcpro1; if (depth + lisp_eval_depth > max_lisp_eval_depth) { stack_overflow ("Stack overflow in sublis", tree); } - GCPRO3 (tailed, alist, tree); - { - EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail) - { - tailed = tail; - - if (check_test (test, key, elt_car, keyed) == test_not_unboundp) - { - /* Don't use elt_cdr, it is helpful to allow TEST or KEY to - modify the alist while it executes. */ - RETURN_UNGCPRO (XCDR (elt)); - } - } - } + { + GC_EXTERNAL_LIST_LOOP_2 (elt, alist) + { + if (CONSP (elt) && + check_test (test, key, XCAR (elt), keyed) == test_not_unboundp) + { + XUNGCPRO (elt); + return XCDR (elt); + } + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + if (!CONSP (tree)) { RETURN_UNGCPRO (tree); ＠＠ -9225,8 +9210,8 ＠＠ Boolint test_not_unboundp, Lisp_Object test, Lisp_Object key, int depth) { - Lisp_Object tree_saved = tree, tailed = alist, tortoise = tree, keyed = Qnil; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + Lisp_Object tree_saved = tree, tortoise = tree, keyed = Qnil; + struct gcpro gcpro1, gcpro2; int count = 0; if (depth + lisp_eval_depth > max_lisp_eval_depth) ＠＠ -9234,7 +9219,7 ＠＠ stack_overflow ("Stack overflow in nsublis", tree); } - GCPRO4 (tailed, alist, tree_saved, keyed); + GCPRO2 (tree_saved, keyed); while (CONSP (tree)) { ＠＠ -9242,11 +9227,10 ＠＠ keyed = KEY (key, XCAR (tree)); { - EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail) + GC_EXTERNAL_LIST_LOOP_2 (elt, alist) { - tailed = tail; - - if (check_test (test, key, elt_car, keyed) == test_not_unboundp) + if (CONSP (elt) && + check_test (test, key, XCAR (elt), keyed) == test_not_unboundp) { CHECK_LISP_WRITEABLE (tree); /* See comment in sublis() on using elt_cdr. */ ＠＠ -9255,6 +9239,7 ＠＠ break; } } + END_GC_EXTERNAL_LIST_LOOP (elt); } if (!replaced) ＠＠ -9270,19 +9255,18 ＠＠ replaced = 0; { - EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail) + GC_EXTERNAL_LIST_LOOP_2 (elt, alist) { - tailed = tail; - - if (check_test (test, key, elt_car, keyed) == test_not_unboundp) + if (CONSP (elt) && + check_test (test, key, XCAR (elt), keyed) == test_not_unboundp) { CHECK_LISP_WRITEABLE (tree); - /* See comment in sublis() on using elt_cdr. */ XSETCDR (tree, XCDR (elt)); tree = Qnil; break; } } + END_GC_EXTERNAL_LIST_LOOP (elt); } if (!NILP (tree)) ＠＠ -9343,16 +9327,16 ＠＠ { /* nsublis() won't attempt to replace a cons handed to it, do that ourselves. */ - EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail) - { - tailed = tail; - - if (check_test (test, key, elt_car, keyed) == test_not_unboundp) - { - /* See comment in sublis() on using elt_cdr. */ - RETURN_UNGCPRO (XCDR (elt)); - } - } + GC_EXTERNAL_LIST_LOOP_2 (elt, alist) + { + if (CONSP (elt) && + check_test (test, key, XCAR (elt), keyed) == test_not_unboundp) + { + XUNGCPRO (elt); + return XCDR (elt); + } + } + END_GC_EXTERNAL_LIST_LOOP (elt); } UNGCPRO; ＠＠ -10523,13 +10507,12 ＠＠ static Lisp_Object venn (Lisp_Object caller, int nargs, Lisp_Object *args, Boolint intersectionp) { - Lisp_Object liszt1 = args[0], liszt2 = args[1], elt = Qnil, tail = Qnil; + Lisp_Object liszt1 = args[0], liszt2 = args[1]; Lisp_Object result = EQ (caller, Qsubsetp) ? Qt : Qnil, result_tail = Qnil; Lisp_Object keyed = Qnil, ignore = Qnil; - Elemcount len; - Boolint test_not_unboundp = 1; - check_test_func_t check_test = NULL; - struct gcpro gcpro1, gcpro2, gcpro3; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; + struct gcpro gcpro1, gcpro2; PARSE_KEYWORDS_8 (caller, nargs, args, 4, (test, key, test_not, stable), NULL, 2, 0); ＠＠ -10552,10 +10535,10 ＠＠ get_check_match_function (&test, test_not, Qnil, Qnil, key, &test_not_unboundp, &check_test); - GCPRO3 (tail, keyed, result); - - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, liszt1, tail, len) + GCPRO2 (keyed, result); + + { + GC_EXTERNAL_LIST_LOOP_2 (elt, liszt1) { keyed = KEY (key, elt); if (NILP (list_position_cons_before (&ignore, keyed, liszt2, ＠＠ -10583,6 +10566,7 ＠＠ } } } + END_GC_EXTERNAL_LIST_LOOP (elt); } UNGCPRO; ＠＠ -10598,7 +10582,7 ＠＠ Elemcount count; Boolint test_not_unboundp = 1; check_test_func_t check_test = NULL; - struct gcpro gcpro1, gcpro2, gcpro3; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; PARSE_KEYWORDS_8 (caller, nargs, args, 3, (test, key, test_not), NULL, 2, 0); ＠＠ -10621,9 +10605,9 ＠＠ get_check_match_function (&test, test_not, Qnil, Qnil, key, &test_not_unboundp, &check_test); - GCPRO3 (tail, keyed, liszt1); - - tortoise_elt = tail = liszt1, count = 0; + tortoise_elt = tail = liszt1, count = 0; + + GCPRO4 (tail, keyed, liszt1, tortoise_elt); while (CONSP (tail) ? (elt = XCAR (tail), 1) : NILP (tail) ? 0 : (signal_malformed_list_error (liszt1), 0)) ＠＠ -10795,11 +10779,10 ＠＠ (int nargs, Lisp_Object *args)) { Lisp_Object liszt1 = args[0], liszt2 = args[1], ignore = Qnil; - Lisp_Object elt = Qnil, tail = Qnil, keyed = Qnil, result, result_tail; - Elemcount len; + Lisp_Object keyed = Qnil, result, result_tail; Boolint test_not_unboundp = 1; check_test_func_t check_test = NULL, check_match = NULL; - struct gcpro gcpro1, gcpro2, gcpro3; + struct gcpro gcpro1, gcpro2; PARSE_KEYWORDS (Funion, nargs, args, 4, (test, key, test_not, stable), NULL); ＠＠ -10821,13 +10804,13 ＠＠ check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key, &test_not_unboundp, &check_test); - GCPRO3 (tail, keyed, result); + GCPRO2 (keyed, result); if (NILP (stable)) { result = liszt2; { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, liszt1, tail, len) + GC_EXTERNAL_LIST_LOOP_2 (elt, liszt1) { keyed = KEY (key, elt); if (NILP (list_position_cons_before (&ignore, keyed, liszt2, ＠＠ -10845,6 +10828,7 ＠＠ result = Fcons (elt, result); } } + END_GC_EXTERNAL_LIST_LOOP (elt); } } else ＠＠ -10858,7 +10842,7 ＠＠ elements in any fashion; providing the functionality for a stable union is an XEmacs extension. */ { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, liszt2, tail, len) + GC_EXTERNAL_LIST_LOOP_2 (elt, liszt2) { if (NILP (list_position_cons_before (&ignore, elt, liszt1, check_match, test_not_unboundp, ＠＠ -10875,6 +10859,7 ＠＠ } } } + END_GC_EXTERNAL_LIST_LOOP (elt); } result = NILP (result) ? liszt1 : nconc2 (Fcopy_list (liszt1), result); ＠＠ -10902,12 +10887,11 ＠＠ */ (int nargs, Lisp_Object *args)) { - Lisp_Object liszt1 = args[0], liszt2 = args[1], elt = Qnil, tail = Qnil; + Lisp_Object liszt1 = args[0], liszt2 = args[1]; Lisp_Object result = Qnil, result_tail = Qnil, keyed = Qnil, ignore = Qnil; - Elemcount len; Boolint test_not_unboundp = 1; check_test_func_t check_match = NULL, check_test = NULL; - struct gcpro gcpro1, gcpro2, gcpro3; + struct gcpro gcpro1, gcpro2; PARSE_KEYWORDS (Fset_exclusive_or, nargs, args, 4, (test, key, test_not, stable), NULL); ＠＠ -10925,9 +10909,9 ＠＠ check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key, &test_not_unboundp, &check_test); - GCPRO3 (tail, keyed, result); - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, liszt1, tail, len) + GCPRO2 (keyed, result); + { + GC_EXTERNAL_LIST_LOOP_2 (elt, liszt1) { keyed = KEY (key, elt); if (NILP (list_position_cons_before (&ignore, keyed, liszt2, ＠＠ -10949,10 +10933,11 ＠＠ } } } - } - - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, liszt2, tail, len) + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + { + GC_EXTERNAL_LIST_LOOP_2 (elt, liszt2) { if (NILP (list_position_cons_before (&ignore, elt, liszt1, check_match, test_not_unboundp, ＠＠ -10973,7 +10958,9 ＠＠ } } } - } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + UNGCPRO; return result; ＠＠ -10998,7 +10985,7 ＠＠ Elemcount count; Boolint test_not_unboundp = 1; check_test_func_t check_match = NULL, check_test = NULL; - struct gcpro gcpro1, gcpro2, gcpro3; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; PARSE_KEYWORDS (Fnset_exclusive_or, nargs, args, 4, (test, key, test_not, stable), NULL); ＠＠ -11016,10 +11003,10 ＠＠ check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key, &test_not_unboundp, &check_test); - GCPRO3 (tail, keyed, result); - tortoise_elt = tail = liszt1, count = 0; + GCPRO4 (tail, keyed, result, tortoise_elt); + while (CONSP (tail) ? (elt = XCAR (tail), 1) : NILP (tail) ? 0 : (signal_malformed_list_error (liszt1), 0)) { diff -r 25c10648ffba -r e99b473303e3 src/lisp.h --- a/src/lisp.h Sat Apr 02 16:18:07 2011 +0100 +++ b/src/lisp.h Mon Apr 04 00:20:09 2011 +0100 ＠＠ -2123,6 +2123,16 ＠＠ PRIVATE_EXTERNAL_LIST_LOOP_6 (elt, list, len_##elt, tail, \ tortoise_##elt, CIRCULAR_LIST_SUSPICION_LENGTH) +#define GC_EXTERNAL_LIST_LOOP_3(elt, list, tail) \ +do { \ + XGCDECL3 (elt); \ + Lisp_Object elt, tail, tortoise_##elt; \ + EMACS_INT len_##elt; \ + XGCPRO3 (elt, elt, tail, tortoise_##elt); \ + PRIVATE_EXTERNAL_LIST_LOOP_6 (elt, list, len_##elt, tail, \ + tortoise_##elt, \ + CIRCULAR_LIST_SUSPICION_LENGTH) + #define EXTERNAL_LIST_LOOP_4_NO_DECLARE(elt, list, tail, len) \ Lisp_Object tortoise_##elt; \ PRIVATE_EXTERNAL_LIST_LOOP_6 (elt, list, len, tail, \ ＠＠ -2134,6 +2144,15 ＠＠ PRIVATE_EXTERNAL_LIST_LOOP_6 (elt, list, len, tail, \ tortoise_##elt, CIRCULAR_LIST_SUSPICION_LENGTH) +#define GC_EXTERNAL_LIST_LOOP_4(elt, list, tail, len) \ +do { \ + XGCDECL3 (elt); \ + Lisp_Object elt, tail, tortoise_##elt; \ + XGCPRO3 (elt, elt, tail, tortoise_##elt); \ + PRIVATE_EXTERNAL_LIST_LOOP_6 (elt, list, len, tail, \ + tortoise_##elt, \ + CIRCULAR_LIST_SUSPICION_LENGTH) + #define PRIVATE_UNVERIFIED_LIST_LOOP_7(elt, list, len, hare, \ tortoise, suspicion_length, \ signalp) \ -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

commit: Use GC_EXTERNAL_LIST_LOOP_* where appropriate, fns.c 13 years

Aidan Kehoe

changeset: 5393:e99b473303e3 tag: tip user: Aidan Kehoe <kehoea(a)parhasard.net> date: Mon Apr 04 00:20:09 2011 +0100 files: src/ChangeLog src/fns.c src/lisp.h description: Use GC_EXTERNAL_LIST_LOOP_* where appropriate, fns.c src/ChangeLog addition: 2011-04-04 Aidan Kehoe <kehoea(a)parhasard.net> * lisp.h (GC_EXTERNAL_LIST_LOOP_3, GC_EXTERNAL_LIST_LOOP_4): New. * fns.c (count_with_tail, list_position_cons_before, FassocX): * fns.c (FrassocX, position, FdeleteX, FremoveX): * fns.c (list_delete_duplicates_from_end): * fns.c (Fdelete_duplicates, Fremove_duplicates, Freduce): * fns.c (Fnsubstitute, Fsubstitute, sublis, nsublis, Fnsublis): * fns.c (venn, nvenn, Funion, Fset_exclusive_or, Fnset_exclusive_or): Use GC_EXTERNAL_LIST_LOOP_* in the sequence functions in fns.c where appropriate, there were some corner cases where my old approach was unsafe (mainly if the circularity checking's tortoise lost GCPRO protection. Add GC_EXTERNAL_LIST_LOOP_{3,4}, analogous to GC_EXTERNAL_LIST_LOOP_2. diff -r 25c10648ffba -r e99b473303e3 src/ChangeLog --- a/src/ChangeLog Sat Apr 02 16:18:07 2011 +0100 +++ b/src/ChangeLog Mon Apr 04 00:20:09 2011 +0100 ＠＠ -1,3 +1,19 ＠＠ +2011-04-04 Aidan Kehoe <kehoea(a)parhasard.net> + + * lisp.h (GC_EXTERNAL_LIST_LOOP_3, GC_EXTERNAL_LIST_LOOP_4): New. + * fns.c (count_with_tail, list_position_cons_before, FassocX): + * fns.c (FrassocX, position, FdeleteX, FremoveX): + * fns.c (list_delete_duplicates_from_end): + * fns.c (Fdelete_duplicates, Fremove_duplicates, Freduce): + * fns.c (Fnsubstitute, Fsubstitute, sublis, nsublis, Fnsublis): + * fns.c (venn, nvenn, Funion, Fset_exclusive_or, Fnset_exclusive_or): + Use GC_EXTERNAL_LIST_LOOP_* in the sequence functions in fns.c + where appropriate, there were some corner cases where my old + approach was unsafe (mainly if the circularity checking's tortoise + lost GCPRO protection. + Add GC_EXTERNAL_LIST_LOOP_{3,4}, analogous to + GC_EXTERNAL_LIST_LOOP_2. + 2011-03-24 Jerry James <james(a)xemacs.org> * alloc.c (listu): Assemble the list in the right order so we don't diff -r 25c10648ffba -r e99b473303e3 src/fns.c --- a/src/fns.c Sat Apr 02 16:18:07 2011 +0100 +++ b/src/fns.c Mon Apr 04 00:20:09 2011 +0100 ＠＠ -1009,9 +1009,6 ＠＠ if (CONSP (sequence)) { - Lisp_Object elt, tail = Qnil; - struct gcpro gcpro1; - if (EQ (caller, Qcount) && !NILP (from_end) && (!EQ (key, Qnil) || check_test == check_other_nokey || check_test == check_if_nokey)) ＠＠ -1026,8 +1023,6 ＠＠ start, end); } - GCPRO1 (tail); - /* If COUNT is non-nil and FROM-END is t, we can give the tail containing the last match, since that's what #'remove* is interested in (a zero or negative COUNT won't ever reach ＠＠ -1039,7 +1034,7 ＠＠ } { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len) + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) { if (!(ii < ending)) { ＠＠ -1060,9 +1055,8 ＠＠ ii++; } - } - - UNGCPRO; + END_GC_EXTERNAL_LIST_LOOP (elt); + } if ((ii < starting || (ii < ending && !NILP (end))) && encountered != counting) ＠＠ -2622,18 +2616,18 ＠＠ Boolint reverse_test_order, Lisp_Object start, Lisp_Object end) { - struct gcpro gcpro1, gcpro2; - Lisp_Object elt = Qnil, tail = list, tail_before = Qnil; - Elemcount len, ii = 0, starting = XINT (start); + struct gcpro gcpro1; + Lisp_Object tail_before = Qnil; + Elemcount ii = 0, starting = XINT (start); Elemcount ending = NILP (end) ? EMACS_INT_MAX : XINT (end); - GCPRO2 (elt, tail); + GCPRO1 (tail_before); if (check_test == check_eq_nokey) { /* TEST is #'eq, no need to call any C functions, and the test order won't be visible. */ - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, list, tail, len) + EXTERNAL_LIST_LOOP_3 (elt, list, tail) { if (starting <= ii && ii < ending && EQ (item, elt) == test_not_unboundp) ＠＠ -2654,15 +2648,17 ＠＠ } else { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, list, tail, len) + GC_EXTERNAL_LIST_LOOP_3 (elt, list, tail) { if (starting <= ii && ii < ending && (reverse_test_order ? check_test (test, key, elt, item) : - check_test (test, key, item, elt)) == test_not_unboundp) + check_test (test, key, item, elt)) == test_not_unboundp) { *cons_out = tail_before; - RETURN_UNGCPRO (make_integer (ii)); + XUNGCPRO (elt); + UNGCPRO; + return make_integer (ii); } else { ＠＠ -2674,6 +2670,7 ＠＠ ii++; tail_before = tail; } + END_GC_EXTERNAL_LIST_LOOP (elt); } RETURN_UNGCPRO (Qnil); ＠＠ -2860,22 +2857,16 ＠＠ } else { - Lisp_Object tailed = alist; - struct gcpro gcpro1; - - GCPRO1 (tailed); - { - EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail) - { - tailed = tail; - - if (check_test (test, key, item, elt_car) == test_not_unboundp) - { - RETURN_UNGCPRO (elt); - } - } - } - UNGCPRO; + GC_EXTERNAL_LIST_LOOP_2 (elt, alist) + { + if (CONSP (elt) && + check_test (test, key, item, XCAR (elt)) == test_not_unboundp) + { + XUNGCPRO (elt); + return elt; + } + } + END_GC_EXTERNAL_LIST_LOOP (elt); } return Qnil; ＠＠ -2969,22 +2960,16 ＠＠ } else { - struct gcpro gcpro1; - Lisp_Object tailed = alist; - - GCPRO1 (tailed); - { - EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail) - { - tailed = tail; - - if (check_test (test, key, item, elt_cdr) == test_not_unboundp) - { - RETURN_UNGCPRO (elt); - } - } - } - UNGCPRO; + GC_EXTERNAL_LIST_LOOP_2 (elt, alist) + { + if (CONSP (elt) && + check_test (test, key, item, XCDR (elt)) == test_not_unboundp) + { + XUNGCPRO (elt); + return elt; + } + } + END_GC_EXTERNAL_LIST_LOOP (elt); } return Qnil; ＠＠ -3014,9 +2999,6 ＠＠ if (CONSP (sequence)) { - Lisp_Object elt, tail = Qnil; - struct gcpro gcpro1; - if (!(starting < ending)) { check_sequence_range (sequence, start, end, Flength (sequence)); ＠＠ -3025,10 +3007,8 ＠＠ return Qnil; } - GCPRO1 (tail); - - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len) + { + GC_EXTERNAL_LIST_LOOP_2 (elt, sequence) { if (starting <= ii && ii < ending && check_test (test, key, item, elt) == test_not_unboundp) ＠＠ -3038,7 +3018,7 ＠＠ if (NILP (from_end)) { - UNGCPRO; + XUNGCPRO (elt); return result; } } ＠＠ -3049,9 +3029,8 ＠＠ ii++; } - } - - UNGCPRO; + END_GC_EXTERNAL_LIST_LOOP (elt); + } if (ii < starting || (ii < ending && !NILP (end))) { ＠＠ -3259,12 +3238,11 ＠＠ */ (int nargs, Lisp_Object *args)) { - Lisp_Object item = args[0], sequence = args[1], tail = sequence; + Lisp_Object item = args[0], sequence = args[1]; Elemcount starting = 0, ending = EMACS_INT_MAX, counting = EMACS_INT_MAX; Elemcount len, ii = 0, encountered = 0, presenting = 0; Boolint test_not_unboundp = 1; check_test_func_t check_test = NULL; - struct gcpro gcpro1; PARSE_KEYWORDS (FdeleteX, nargs, args, 9, (test, if_not, if_, test_not, key, start, end, from_end, ＠＠ -3309,14 +3287,15 ＠＠ if (CONSP (sequence)) { - Lisp_Object prev_tail_list_elt = Qnil, list_elt = Qnil; + Lisp_Object prev_tail_list_elt = Qnil, ignore = Qnil; Elemcount list_len = 0, deleted = 0; + struct gcpro gcpro1; if (!NILP (count) && !NILP (from_end)) { /* Both COUNT and FROM-END were specified; we need to traverse the list twice. */ - Lisp_Object present = count_with_tail (&list_elt, nargs, args, + Lisp_Object present = count_with_tail (&ignore, nargs, args, QdeleteX); if (ZEROP (present)) ＠＠ -3334,11 +3313,11 ＠＠ presenting = presenting <= counting ? 0 : presenting - counting; } - GCPRO1 (tail); + GCPRO1 (prev_tail_list_elt); ii = -1; { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (list_elt, sequence, tail, list_len) + GC_EXTERNAL_LIST_LOOP_4 (list_elt, sequence, tail, list_len) { ii++; ＠＠ -3369,6 +3348,7 ＠＠ } } } + END_GC_EXTERNAL_LIST_LOOP (list_elt); } UNGCPRO; ＠＠ -3606,10 +3586,9 ＠＠ Lisp_Object item = args[0], sequence = args[1], matched_count = Qnil, tail = Qnil; Elemcount starting = 0, ending = EMACS_INT_MAX, counting = EMACS_INT_MAX; - Elemcount len, ii = 0, encountered = 0, presenting = 0; - Boolint test_not_unboundp = 1; - check_test_func_t check_test = NULL; - struct gcpro gcpro1; + Elemcount ii = 0, encountered = 0, presenting = 0; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; PARSE_KEYWORDS (FremoveX, nargs, args, 9, (test, if_not, if_, test_not, key, start, end, from_end, ＠＠ -3657,8 +3636,8 ＠＠ if (!ZEROP (matched_count)) { - Lisp_Object elt, tailing = Qnil, result = Qnil, result_tail = Qnil; - GCPRO1 (tailing); + Lisp_Object result = Qnil, result_tail = Qnil; + struct gcpro gcpro1, gcpro2; if (!NILP (count) && !NILP (from_end)) { ＠＠ -3672,18 +3651,21 ＠＠ presenting = presenting <= counting ? 0 : presenting - counting; } - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tailing, len) + GCPRO2 (result, tail); + { + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tailing) { if (EQ (tail, tailing)) { + XUNGCPRO (elt); + if (NILP (result)) { - RETURN_UNGCPRO (XCDR (tail)); + return XCDR (tail); } XSETCDR (result_tail, XCDR (tail)); - RETURN_UNGCPRO (result); + return result; } else if (starting <= ii && ii < ending && (check_test (test, key, item, elt) == test_not_unboundp) ＠＠ -3709,8 +3691,8 ＠＠ ii++; } - } - + END_GC_EXTERNAL_LIST_LOOP (elt); + } UNGCPRO; if (ii < starting || (ii < ending && !NILP (end))) ＠＠ -3829,12 +3811,12 ＠＠ Lisp_Object start, Lisp_Object end, Boolint copy) { - Lisp_Object checking = Qnil, elt, tail, result = list; + Lisp_Object checking = Qnil, result = list; Lisp_Object keyed, positioned, position_cons = Qnil, result_tail; Elemcount len = XINT (Flength (list)), pos, starting = XINT (start); Elemcount ending = (NILP (end) ? len : XINT (end)), greatest_pos_seen = -1; Elemcount ii = 0; - struct gcpro gcpro1, gcpro2; + struct gcpro gcpro1; /* We can't delete (or remove) as we go, because that breaks START and END. We could if END were nil, and that would change an ON(N + 2) ＠＠ -3854,10 +3836,10 ＠＠ memset (&(deleting->bits), 0, sizeof (long) * BIT_VECTOR_LONG_STORAGE (len)); - GCPRO2 (tail, keyed); - - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, list, tail, len) + GCPRO1 (keyed); + + { + GC_EXTERNAL_LIST_LOOP_3 (elt, list, tail) { if (!(starting <= ii && ii <= ending) || bit_vector_bit (deleting, ii)) { ＠＠ -3884,6 +3866,7 ＠＠ } ii++; } + END_GC_EXTERNAL_LIST_LOOP (elt); } UNGCPRO; ＠＠ -3899,7 +3882,7 ＠＠ ii = 1; { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, list, tail, len) + EXTERNAL_LIST_LOOP_3 (elt, list, tail) { if (ii == greatest_pos_seen) { ＠＠ -3917,7 +3900,7 ＠＠ } else { - EXTERNAL_LIST_LOOP_DELETE_IF (elt0, list, + EXTERNAL_LIST_LOOP_DELETE_IF (elt, list, bit_vector_bit (deleting, ii++)); } } ＠＠ -3945,8 +3928,8 ＠＠ */ (int nargs, Lisp_Object *args)) { - Lisp_Object sequence = args[0], tail = sequence, keyed = Qnil, elt = Qnil; - Lisp_Object elt0 = Qnil, positioned = Qnil, ignore = Qnil; + Lisp_Object sequence = args[0], keyed = Qnil; + Lisp_Object positioned = Qnil, ignore = Qnil; Elemcount starting = 0, ending = EMACS_INT_MAX, len, ii = 0, jj = 0; Boolint test_not_unboundp = 1; check_test_func_t check_test = NULL; ＠＠ -3978,10 +3961,10 ＠＠ Lisp_Object prev_tail = Qnil; Elemcount deleted = 0; - GCPRO2 (tail, keyed); - - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len) + GCPRO2 (keyed, prev_tail); + + { + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) { if (starting <= ii && ii < ending) { ＠＠ -4012,9 +3995,10 ＠＠ ii++; } - } - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt0, sequence, tail, len) + END_GC_EXTERNAL_LIST_LOOP (elt); + } + { + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) { if (!(starting <= ii && ii <= ending)) { ＠＠ -4023,7 +4007,7 ＠＠ continue; } - keyed = KEY (key, elt0); + keyed = KEY (key, elt); positioned = list_position_cons_before (&ignore, keyed, XCDR (tail), check_test, test_not_unboundp, ＠＠ -4052,7 +4036,9 ＠＠ ii++; } - } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + UNGCPRO; if ((ii < starting || (ii < ending && !NILP (end)))) ＠＠ -4072,6 +4058,8 ＠＠ } else if (STRINGP (sequence)) { + Lisp_Object elt = Qnil; + if (EQ (Qidentity, key)) { /* We know all the elements will be characters; set check_test to ＠＠ -4090,7 +4078,6 ＠＠ Ibyte *cursor = XSTRING_DATA (sequence), *startp = cursor; Elemcount deleted = 0; - elt = Qnil; GCPRO1 (elt); while (cursor_offset < byte_len) ＠＠ -4245,6 +4232,7 ＠＠ Elemcount deleted = 0; Lisp_Object *content = XVECTOR_DATA (sequence); struct Lisp_Bit_Vector *deleting; + Lisp_Object elt = Qnil; len = XVECTOR_LENGTH (sequence); check_sequence_range (sequence, start, end, make_integer (len)); ＠＠ -4328,6 +4316,7 ＠＠ and KEY arguments, which may be non-deterministic from our perspective, we need the same algorithm as for vectors. */ struct Lisp_Bit_Vector *deleting; + Lisp_Object elt = Qnil; len = bit_vector_length (bv); ＠＠ -4429,13 +4418,13 ＠＠ */ (int nargs, Lisp_Object *args)) { - Lisp_Object sequence = args[0], tail = sequence, keyed, positioned = Qnil; + Lisp_Object sequence = args[0], keyed, positioned = Qnil; Lisp_Object result = sequence, result_tail = result, cursor = Qnil; - Lisp_Object cons_with_shared_tail = Qnil, elt, elt0; - Elemcount starting = 0, ending = EMACS_INT_MAX, len, ii = 0; - Boolint test_not_unboundp = 1; - check_test_func_t check_test = NULL; - struct gcpro gcpro1, gcpro2, gcpro3; + Lisp_Object cons_with_shared_tail = Qnil; + Elemcount starting = 0, ending = EMACS_INT_MAX, ii = 0; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; + struct gcpro gcpro1, gcpro2; PARSE_KEYWORDS (Fremove_duplicates, nargs, args, 6, (test, key, test_not, start, end, from_end), ＠＠ -4469,10 +4458,10 ＠＠ { Lisp_Object ignore = Qnil; - GCPRO3 (tail, keyed, result); - - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len) + GCPRO2 (keyed, result); + + { + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) { if (starting <= ii && ii <= ending) { ＠＠ -4500,10 +4489,11 ＠＠ ii++; } - } - - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt0, sequence, tail, len) + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + { + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) { if (!(starting <= ii && ii <= ending)) { ＠＠ -4516,7 +4506,7 ＠＠ removed cons to this one. Otherwise, the tail of the output list is shared with the input list, which is OK. */ - keyed = KEY (key, elt0); + keyed = KEY (key, elt); positioned = list_position_cons_before (&ignore, keyed, XCDR (tail), check_test, test_not_unboundp, ＠＠ -4548,7 +4538,9 ＠＠ ii++; } - } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + UNGCPRO; if ((ii < starting || (ii < ending && !NILP (end)))) ＠＠ -7932,10 +7924,9 ＠＠ { if (NILP (from_end)) { - struct gcpro gcpro1, gcpro2; - Lisp_Object tailed = Qnil; - - GCPRO2 (tailed, accum); + struct gcpro gcpro1; + + GCPRO1 (accum); if (!UNBOUNDP (initial_value)) { ＠＠ -7943,11 +7934,8 ＠＠ } else if (ending - starting) { - EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) - { - /* KEY may amputate the list behind us; make sure what - remains to be processed is still reachable. */ - tailed = tail; + GC_EXTERNAL_LIST_LOOP_2 (elt, sequence) + { if (ii == starting) { accum = KEY (key, elt); ＠＠ -7956,18 +7944,15 ＠＠ } ++ii; } + END_GC_EXTERNAL_LIST_LOOP (elt); } ii = 0; if (ending - starting) { - EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) - { - /* KEY or FUNCTION may amputate the list behind us; make - sure what remains to be processed is still - reachable. */ - tailed = tail; + GC_EXTERNAL_LIST_LOOP_2 (elt, sequence) + { if (ii >= starting) { if (ii < ending) ＠＠ -7981,6 +7966,7 ＠＠ } ++ii; } + END_GC_EXTERNAL_LIST_LOOP (elt); } UNGCPRO; ＠＠ -8703,13 +8689,12 ＠＠ */ (int nargs, Lisp_Object *args)) { - Lisp_Object new_ = args[0], item = args[1], sequence = args[2], tail = Qnil; + Lisp_Object new_ = args[0], item = args[1], sequence = args[2]; Lisp_Object object_, position0; Elemcount starting = 0, ending = EMACS_INT_MAX, encountered = 0; Elemcount len, ii = 0, counting = EMACS_INT_MAX, presenting = 0; Boolint test_not_unboundp = 1; check_test_func_t check_test = NULL; - struct gcpro gcpro1; PARSE_KEYWORDS (Fnsubstitute, nargs, args, 9, (test, if_, if_not, test_not, key, start, end, count, ＠＠ -8751,11 +8736,9 ＠＠ if (CONSP (sequence)) { - Lisp_Object elt; - if (!NILP (count) && !NILP (from_end)) { - Lisp_Object present = count_with_tail (&elt, nargs - 1, args + 1, + Lisp_Object present = count_with_tail (&object_, nargs - 1, args + 1, Qnsubstitute); if (ZEROP (present)) ＠＠ -8767,9 +8750,8 ＠＠ presenting = presenting <= counting ? 0 : presenting - counting; } - GCPRO1 (tail); - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len) + { + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) { if (!(ii < ending)) { ＠＠ -8791,8 +8773,8 ＠＠ ii++; } - } - UNGCPRO; + END_GC_EXTERNAL_LIST_LOOP (elt); + } if ((ii < starting || (ii < ending && !NILP (end))) && encountered < counting) ＠＠ -8964,10 +8946,10 ＠＠ (int nargs, Lisp_Object *args)) { Lisp_Object new_ = args[0], item = args[1], sequence = args[2], tail = Qnil; - Lisp_Object elt, tailing = Qnil, result = Qnil, result_tail = Qnil; + Lisp_Object result = Qnil, result_tail = Qnil; Lisp_Object object, position0, matched_count; Elemcount starting = 0, ending = EMACS_INT_MAX, encountered = 0; - Elemcount len, ii = 0, counting = EMACS_INT_MAX, presenting = 0; + Elemcount ii = 0, counting = EMACS_INT_MAX, presenting = 0; Boolint test_not_unboundp = 1; check_test_func_t check_test = NULL; struct gcpro gcpro1; ＠＠ -9044,19 +9026,22 ＠＠ presenting = presenting <= counting ? 0 : presenting - counting; } - GCPRO1 (tailing); - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tailing, len) + GCPRO1 (result); + { + GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tailing) { if (EQ (tail, tailing)) { + XUNGCPRO (elt); + UNGCPRO; + if (NILP (result)) { - RETURN_UNGCPRO (XCDR (tail)); + return XCDR (tail); } XSETCDR (result_tail, XCDR (tail)); - RETURN_UNGCPRO (result); + return result; } else if (starting <= ii && ii < ending && (check_test (test, key, item, elt) == test_not_unboundp) ＠＠ -9090,6 +9075,7 ＠＠ ii++; } + END_GC_EXTERNAL_LIST_LOOP (elt); } UNGCPRO; ＠＠ -9138,28 +9124,27 ＠＠ check_test_func_t check_test, Boolint test_not_unboundp, Lisp_Object test, Lisp_Object key, int depth) { - Lisp_Object keyed = KEY (key, tree), tailed = alist, aa, dd; - struct gcpro gcpro1, gcpro2, gcpro3; + Lisp_Object keyed = KEY (key, tree), aa, dd; + struct gcpro gcpro1; if (depth + lisp_eval_depth > max_lisp_eval_depth) { stack_overflow ("Stack overflow in sublis", tree); } - GCPRO3 (tailed, alist, tree); - { - EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail) - { - tailed = tail; - - if (check_test (test, key, elt_car, keyed) == test_not_unboundp) - { - /* Don't use elt_cdr, it is helpful to allow TEST or KEY to - modify the alist while it executes. */ - RETURN_UNGCPRO (XCDR (elt)); - } - } - } + { + GC_EXTERNAL_LIST_LOOP_2 (elt, alist) + { + if (CONSP (elt) && + check_test (test, key, XCAR (elt), keyed) == test_not_unboundp) + { + XUNGCPRO (elt); + return XCDR (elt); + } + } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + if (!CONSP (tree)) { RETURN_UNGCPRO (tree); ＠＠ -9225,8 +9210,8 ＠＠ Boolint test_not_unboundp, Lisp_Object test, Lisp_Object key, int depth) { - Lisp_Object tree_saved = tree, tailed = alist, tortoise = tree, keyed = Qnil; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + Lisp_Object tree_saved = tree, tortoise = tree, keyed = Qnil; + struct gcpro gcpro1, gcpro2; int count = 0; if (depth + lisp_eval_depth > max_lisp_eval_depth) ＠＠ -9234,7 +9219,7 ＠＠ stack_overflow ("Stack overflow in nsublis", tree); } - GCPRO4 (tailed, alist, tree_saved, keyed); + GCPRO2 (tree_saved, keyed); while (CONSP (tree)) { ＠＠ -9242,11 +9227,10 ＠＠ keyed = KEY (key, XCAR (tree)); { - EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail) + GC_EXTERNAL_LIST_LOOP_2 (elt, alist) { - tailed = tail; - - if (check_test (test, key, elt_car, keyed) == test_not_unboundp) + if (CONSP (elt) && + check_test (test, key, XCAR (elt), keyed) == test_not_unboundp) { CHECK_LISP_WRITEABLE (tree); /* See comment in sublis() on using elt_cdr. */ ＠＠ -9255,6 +9239,7 ＠＠ break; } } + END_GC_EXTERNAL_LIST_LOOP (elt); } if (!replaced) ＠＠ -9270,19 +9255,18 ＠＠ replaced = 0; { - EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail) + GC_EXTERNAL_LIST_LOOP_2 (elt, alist) { - tailed = tail; - - if (check_test (test, key, elt_car, keyed) == test_not_unboundp) + if (CONSP (elt) && + check_test (test, key, XCAR (elt), keyed) == test_not_unboundp) { CHECK_LISP_WRITEABLE (tree); - /* See comment in sublis() on using elt_cdr. */ XSETCDR (tree, XCDR (elt)); tree = Qnil; break; } } + END_GC_EXTERNAL_LIST_LOOP (elt); } if (!NILP (tree)) ＠＠ -9343,16 +9327,16 ＠＠ { /* nsublis() won't attempt to replace a cons handed to it, do that ourselves. */ - EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail) - { - tailed = tail; - - if (check_test (test, key, elt_car, keyed) == test_not_unboundp) - { - /* See comment in sublis() on using elt_cdr. */ - RETURN_UNGCPRO (XCDR (elt)); - } - } + GC_EXTERNAL_LIST_LOOP_2 (elt, alist) + { + if (CONSP (elt) && + check_test (test, key, XCAR (elt), keyed) == test_not_unboundp) + { + XUNGCPRO (elt); + return XCDR (elt); + } + } + END_GC_EXTERNAL_LIST_LOOP (elt); } UNGCPRO; ＠＠ -10523,13 +10507,12 ＠＠ static Lisp_Object venn (Lisp_Object caller, int nargs, Lisp_Object *args, Boolint intersectionp) { - Lisp_Object liszt1 = args[0], liszt2 = args[1], elt = Qnil, tail = Qnil; + Lisp_Object liszt1 = args[0], liszt2 = args[1]; Lisp_Object result = EQ (caller, Qsubsetp) ? Qt : Qnil, result_tail = Qnil; Lisp_Object keyed = Qnil, ignore = Qnil; - Elemcount len; - Boolint test_not_unboundp = 1; - check_test_func_t check_test = NULL; - struct gcpro gcpro1, gcpro2, gcpro3; + Boolint test_not_unboundp = 1; + check_test_func_t check_test = NULL; + struct gcpro gcpro1, gcpro2; PARSE_KEYWORDS_8 (caller, nargs, args, 4, (test, key, test_not, stable), NULL, 2, 0); ＠＠ -10552,10 +10535,10 ＠＠ get_check_match_function (&test, test_not, Qnil, Qnil, key, &test_not_unboundp, &check_test); - GCPRO3 (tail, keyed, result); - - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, liszt1, tail, len) + GCPRO2 (keyed, result); + + { + GC_EXTERNAL_LIST_LOOP_2 (elt, liszt1) { keyed = KEY (key, elt); if (NILP (list_position_cons_before (&ignore, keyed, liszt2, ＠＠ -10583,6 +10566,7 ＠＠ } } } + END_GC_EXTERNAL_LIST_LOOP (elt); } UNGCPRO; ＠＠ -10598,7 +10582,7 ＠＠ Elemcount count; Boolint test_not_unboundp = 1; check_test_func_t check_test = NULL; - struct gcpro gcpro1, gcpro2, gcpro3; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; PARSE_KEYWORDS_8 (caller, nargs, args, 3, (test, key, test_not), NULL, 2, 0); ＠＠ -10621,9 +10605,9 ＠＠ get_check_match_function (&test, test_not, Qnil, Qnil, key, &test_not_unboundp, &check_test); - GCPRO3 (tail, keyed, liszt1); - - tortoise_elt = tail = liszt1, count = 0; + tortoise_elt = tail = liszt1, count = 0; + + GCPRO4 (tail, keyed, liszt1, tortoise_elt); while (CONSP (tail) ? (elt = XCAR (tail), 1) : NILP (tail) ? 0 : (signal_malformed_list_error (liszt1), 0)) ＠＠ -10795,11 +10779,10 ＠＠ (int nargs, Lisp_Object *args)) { Lisp_Object liszt1 = args[0], liszt2 = args[1], ignore = Qnil; - Lisp_Object elt = Qnil, tail = Qnil, keyed = Qnil, result, result_tail; - Elemcount len; + Lisp_Object keyed = Qnil, result, result_tail; Boolint test_not_unboundp = 1; check_test_func_t check_test = NULL, check_match = NULL; - struct gcpro gcpro1, gcpro2, gcpro3; + struct gcpro gcpro1, gcpro2; PARSE_KEYWORDS (Funion, nargs, args, 4, (test, key, test_not, stable), NULL); ＠＠ -10821,13 +10804,13 ＠＠ check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key, &test_not_unboundp, &check_test); - GCPRO3 (tail, keyed, result); + GCPRO2 (keyed, result); if (NILP (stable)) { result = liszt2; { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, liszt1, tail, len) + GC_EXTERNAL_LIST_LOOP_2 (elt, liszt1) { keyed = KEY (key, elt); if (NILP (list_position_cons_before (&ignore, keyed, liszt2, ＠＠ -10845,6 +10828,7 ＠＠ result = Fcons (elt, result); } } + END_GC_EXTERNAL_LIST_LOOP (elt); } } else ＠＠ -10858,7 +10842,7 ＠＠ elements in any fashion; providing the functionality for a stable union is an XEmacs extension. */ { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, liszt2, tail, len) + GC_EXTERNAL_LIST_LOOP_2 (elt, liszt2) { if (NILP (list_position_cons_before (&ignore, elt, liszt1, check_match, test_not_unboundp, ＠＠ -10875,6 +10859,7 ＠＠ } } } + END_GC_EXTERNAL_LIST_LOOP (elt); } result = NILP (result) ? liszt1 : nconc2 (Fcopy_list (liszt1), result); ＠＠ -10902,12 +10887,11 ＠＠ */ (int nargs, Lisp_Object *args)) { - Lisp_Object liszt1 = args[0], liszt2 = args[1], elt = Qnil, tail = Qnil; + Lisp_Object liszt1 = args[0], liszt2 = args[1]; Lisp_Object result = Qnil, result_tail = Qnil, keyed = Qnil, ignore = Qnil; - Elemcount len; Boolint test_not_unboundp = 1; check_test_func_t check_match = NULL, check_test = NULL; - struct gcpro gcpro1, gcpro2, gcpro3; + struct gcpro gcpro1, gcpro2; PARSE_KEYWORDS (Fset_exclusive_or, nargs, args, 4, (test, key, test_not, stable), NULL); ＠＠ -10925,9 +10909,9 ＠＠ check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key, &test_not_unboundp, &check_test); - GCPRO3 (tail, keyed, result); - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, liszt1, tail, len) + GCPRO2 (keyed, result); + { + GC_EXTERNAL_LIST_LOOP_2 (elt, liszt1) { keyed = KEY (key, elt); if (NILP (list_position_cons_before (&ignore, keyed, liszt2, ＠＠ -10949,10 +10933,11 ＠＠ } } } - } - - { - EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, liszt2, tail, len) + END_GC_EXTERNAL_LIST_LOOP (elt); + } + + { + GC_EXTERNAL_LIST_LOOP_2 (elt, liszt2) { if (NILP (list_position_cons_before (&ignore, elt, liszt1, check_match, test_not_unboundp, ＠＠ -10973,7 +10958,9 ＠＠ } } } - } + END_GC_EXTERNAL_LIST_LOOP (elt); + } + UNGCPRO; return result; ＠＠ -10998,7 +10985,7 ＠＠ Elemcount count; Boolint test_not_unboundp = 1; check_test_func_t check_match = NULL, check_test = NULL; - struct gcpro gcpro1, gcpro2, gcpro3; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; PARSE_KEYWORDS (Fnset_exclusive_or, nargs, args, 4, (test, key, test_not, stable), NULL); ＠＠ -11016,9 +11003,9 ＠＠ check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key, &test_not_unboundp, &check_test); - GCPRO3 (tail, keyed, result); - tortoise_elt = tail = liszt1, count = 0; + + GCPRO4 (tail, keyed, result, tortoise_elt); while (CONSP (tail) ? (elt = XCAR (tail), 1) : NILP (tail) ? 0 : (signal_malformed_list_error (liszt1), 0)) diff -r 25c10648ffba -r e99b473303e3 src/lisp.h --- a/src/lisp.h Sat Apr 02 16:18:07 2011 +0100 +++ b/src/lisp.h Mon Apr 04 00:20:09 2011 +0100 ＠＠ -2123,6 +2123,16 ＠＠ PRIVATE_EXTERNAL_LIST_LOOP_6 (elt, list, len_##elt, tail, \ tortoise_##elt, CIRCULAR_LIST_SUSPICION_LENGTH) +#define GC_EXTERNAL_LIST_LOOP_3(elt, list, tail) \ +do { \ + XGCDECL3 (elt); \ + Lisp_Object elt, tail, tortoise_##elt; \ + EMACS_INT len_##elt; \ + XGCPRO3 (elt, elt, tail, tortoise_##elt); \ + PRIVATE_EXTERNAL_LIST_LOOP_6 (elt, list, len_##elt, tail, \ + tortoise_##elt, \ + CIRCULAR_LIST_SUSPICION_LENGTH) + #define EXTERNAL_LIST_LOOP_4_NO_DECLARE(elt, list, tail, len) \ Lisp_Object tortoise_##elt; \ PRIVATE_EXTERNAL_LIST_LOOP_6 (elt, list, len, tail, \ ＠＠ -2133,6 +2143,15 ＠＠ EMACS_INT len; \ PRIVATE_EXTERNAL_LIST_LOOP_6 (elt, list, len, tail, \ tortoise_##elt, CIRCULAR_LIST_SUSPICION_LENGTH) + +#define GC_EXTERNAL_LIST_LOOP_4(elt, list, tail, len) \ +do { \ + XGCDECL3 (elt); \ + Lisp_Object elt, tail, tortoise_##elt; \ + XGCPRO3 (elt, elt, tail, tortoise_##elt); \ + PRIVATE_EXTERNAL_LIST_LOOP_6 (elt, list, len, tail, \ + tortoise_##elt, \ + CIRCULAR_LIST_SUSPICION_LENGTH) #define PRIVATE_UNVERIFIED_LIST_LOOP_7(elt, list, len, hare, \ tortoise, suspicion_length, \ _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

Re: [COMMIT 21.5]: lisp/minibuf.el 13 years

Aidan Kehoe

Ar an triú lá de mí Aibréan, scríobh Julian Bradfield: > I've been running with my change in 21.4 since then, and never had a > problem. > > Actually, the whole minibuffer thing is a bit of a festering > mess. There are three different definitions of the top-level > minibuffer: > (1) The buffer named "*Minibuf-0*" (or "*Minibuf-0" as the case may be) > (2) The buffer in Vminibuffer_zero These two are the same object (since #'kill-buffer refuses to kill the buffer stored in Vminibuffer_zero by reinit_complex_vars_of_minibuf(), which has the name " *Minibuf-0*", and since buffer names are unique). Neither is necessarily the top-level minibuffer if enable-recursive-minibuffers is non-nil. > (3) The buffer currently displaying in the active minibuffer window This will be the buffer " *Minibuf-0*" if enable-recursive-minibuffers is non-nil. > One really ought to go through and sort it all out, I guess. I don’t get the impression it’s *that* bad. But if you have a proposed change, shout. -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

Re: [COMMIT 21.5]: lisp/minibuf.el 13 years

Aidan Kehoe

Ar an dara lá de mí Aibréan, scríobh Vin Shelton: > This looks right to me and it's been applied to 21.5 - is there any > reason I shouldn't apply it to 21.4? There’s no reason not to apply it to 21.4, and thanks for applying the other patches just now! -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

XEmacs-Patches April 2011