carbon2-commit: Add various Common Lisp character functions, making porting CL code easier.
13 years, 10 months
Aidan Kehoe
Aidan Kehoe
changeset: 5459:aa78b0b0b289
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sun Apr 17 11:14:38 2011 +0100
files: lisp/ChangeLog lisp/cl-extra.el lisp/descr-text.el
description:
Add various Common Lisp character functions, making porting CL code easier.
2011-04-17 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-extra.el:
* cl-extra.el ('char<): New.
* cl-extra.el ('char>=): New.
* cl-extra.el ('char>): New.
* cl-extra.el ('char<=): New.
* cl-extra.el (alpha-char-p): New.
* cl-extra.el (graphic-char-p): New.
* cl-extra.el (standard-char-p): New.
* cl-extra.el (char-name): New.
* cl-extra.el (name-char): New.
* cl-extra.el (upper-case-p): New.
* cl-extra.el (lower-case-p): New.
* cl-extra.el (both-case-p): New.
* cl-extra.el (char-upcase): New.
* cl-extra.el (char-downcase): New.
* cl-extra.el (integer-length): New.
Add various functions dealing (mainly) with characters, making
some Common Lisp code easier to port.
* descr-text.el (describe-char-unicode-data):
Add an autoload for this function, used by #'char-name.
diff -r 5ec4534daf16 -r aa78b0b0b289 lisp/ChangeLog
--- a/lisp/ChangeLog Thu Apr 14 08:40:18 2011 -0400
+++ b/lisp/ChangeLog Sun Apr 17 11:14:38 2011 +0100
＠＠ -1,3 +1,26 ＠＠
+2011-04-17 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-extra.el:
+ * cl-extra.el ('char<): New.
+ * cl-extra.el ('char>=): New.
+ * cl-extra.el ('char>): New.
+ * cl-extra.el ('char<=): New.
+ * cl-extra.el (alpha-char-p): New.
+ * cl-extra.el (graphic-char-p): New.
+ * cl-extra.el (standard-char-p): New.
+ * cl-extra.el (char-name): New.
+ * cl-extra.el (name-char): New.
+ * cl-extra.el (upper-case-p): New.
+ * cl-extra.el (lower-case-p): New.
+ * cl-extra.el (both-case-p): New.
+ * cl-extra.el (char-upcase): New.
+ * cl-extra.el (char-downcase): New.
+ * cl-extra.el (integer-length): New.
+ Add various functions dealing (mainly) with characters, making
+ some Common Lisp code easier to port.
+ * descr-text.el (describe-char-unicode-data):
+ Add an autoload for this function, used by #'char-name.
+
2011-04-12 Aidan Kehoe <kehoea(a)parhasard.net>
* mule/mule-win32-init.el (windows-874):
diff -r 5ec4534daf16 -r aa78b0b0b289 lisp/cl-extra.el
--- a/lisp/cl-extra.el Thu Apr 14 08:40:18 2011 -0400
+++ b/lisp/cl-extra.el Sun Apr 17 11:14:38 2011 +0100
＠＠ -690,6 +690,138 ＠＠
(setq float-negative-epsilon (* x 2))))))
(cl-float-limits))
+;; No type-checking here, we should add it.
+(defalias 'char< '<)
+(defalias 'char>= '>=)
+(defalias 'char> '>)
+(defalias 'char<= '<=)
+
+;;; Character functions.
+(defun* digit-char-p (character &optional (radix 10))
+ "Return non-nil if CHARACTER represents a digit in base RADIX.
+
+RADIX defaults to ten. The actual non-nil value returned is the integer
+value of the character in base RADIX."
+ (check-type character character)
+ (check-type radix integer)
+ (if (<= radix 10)
+ (and (<= ?0 character (+ ?0 radix -1)) (- character ?0))
+ (or (and (<= ?0 character ?9) (- character ?0))
+ (and (<= ?a character (+ ?a (setq radix (- radix 11))))
+ (+ character (- 10 ?a)))
+ (and (<= ?A character (+ ?A radix))
+ (+ character (- 10 ?A))))))
+
+(defun* digit-char (weight &optional (radix 10))
+ "Return a character representing the integer WEIGHT in base RADIX.
+
+RADIX defaults to ten. If no such character exists, return nil."
+ (check-type weight integer)
+ (check-type radix integer)
+ (and (natnump weight) (< weight radix)
+ (if (< weight 10)
+ (int-char (+ ?0 weight))
+ (int-char (+ ?A (- weight 10))))))
+
+(defun alpha-char-p (character)
+ "Return t if CHARACTER is alphabetic, in some alphabet.
+
+Han characters are regarded as alphabetic."
+ (check-type character character)
+ (and (eql ?w (char-syntax character (standard-syntax-table)))
+ (not (<= ?0 character ?9))))
+
+(defun graphic-char-p (character)
+ "Return t if CHARACTER is not a control character.
+
+Control characters are those in the range ?\\x00 to ?\\x15 and ?\\x7f to
+?\\x9f, inclusive."
+ (check-type character character)
+ (not (or (<= ?\x00 character ?\x1f) (<= ?\x7f character ?\x9f))))
+
+(defun standard-char-p (character)
+ "Return t if CHARACTER is one of Common Lisp's standard characters.
+
+These are the non-control ASCII characters, plus the newline character."
+ (check-type character character)
+ (or (<= ?\x20 character ?\x7e) (eql character ?\n)))
+
+(symbol-macrolet
+ ((names '((?\x08 . "Backspace") (?\x09 . "Tab") (?\x0a . "Newline")
+ (?\x0C . "Page") (?\x0d . "Return") (?\x20 . "Space")
+ (?\x7f . "Rubout"))))
+
+ (defun char-name (character)
+ "Return a string naming CHARACTER.
+
+For the limited number of characters where the character name has been
+specified by Common Lisp, this always returns the appropriate string
+name. Otherwise, `char-name' requires that the Unicode database be
+available; see `describe-char-unicode-data'."
+ (check-type character character)
+ (or (cdr (assq character names))
+ (let ((unicode-data
+ (assoc "Name" (describe-char-unicode-data character))))
+ (and unicode-data
+ (if (string-match "^<[^>]+>$" (cadr unicode-data))
+ (format "U%04X" (char-to-unicode character))
+ (replace-in-string (cadr unicode-data) " " "_" t))))))
+
+ (defun name-char (name)
+ "Return a character with name NAME, a string."
+ (or (car (rassoc* name names :test #'equalp))
+ (if (string-match "^[uU][0-9A-Fa-f]+$" name)
+ (unicode-to-char (string-to-number (subseq name 1) 16))
+ (with-current-buffer (get-buffer-create " *Unicode Data*")
+ (require 'descr-text)
+ (when (zerop (buffer-size))
+ ;; Don't use -literally in case of DOS line endings.
+ (insert-file-contents describe-char-unicodedata-file))
+ (goto-char (point-min))
+ (setq case-fold-search nil)
+ (and (re-search-forward (format #r"^\([0-9A-F]\{4,6\}\);%s;"
+ (upcase (replace-in-string
+ name "_" " " t))) nil t)
+ (unicode-to-char (string-to-number (match-string 1) 16))))))))
+
+(defun upper-case-p (character)
+ "Return t if CHARACTER is majuscule in the standard case table."
+ (and (stringp character) (check-type character character))
+ (with-case-table (standard-case-table)
+ (not (eq character (downcase character)))))
+
+(defun lower-case-p (character)
+ "Return t if CHARACTER is minuscule in the standard case table."
+ (and (stringp character) (check-type character character))
+ (with-case-table (standard-case-table)
+ (not (eq character (upcase character)))))
+
+(defun both-case-p (character)
+ "Return t if CHARACTER has case information in the standard case table."
+ (and (stringp character) (check-type character character))
+ (with-case-table (standard-case-table)
+ (or (not (eq character (upcase character)))
+ (not (eq character (downcase character))))))
+
+(defun char-upcase (character)
+ "If CHARACTER is lowercase, return its corresponding uppercase character.
+Otherwise, return CHARACTER."
+ (and (stringp character) (check-type character character))
+ (with-case-table (standard-case-table) (upcase character)))
+
+(defun char-downcase (character)
+ "If CHARACTER is uppercase, return its corresponding lowercase character.
+Otherwise, return CHARACTER."
+ (and (stringp character) (check-type character character))
+ (with-case-table (standard-case-table) (downcase character)))
+
+(defun integer-length (integer)
+ "Return the number of bits need to represent INTEGER in two's complement."
+ (ecase (signum integer)
+ (0 0)
+ (-1 (1- (length (format "%b" (- integer)))))
+ (1 (length (format "%b" integer)))))
+
(run-hooks 'cl-extra-load-hook)
;; XEmacs addition
diff -r 5ec4534daf16 -r aa78b0b0b289 lisp/descr-text.el
--- a/lisp/descr-text.el Thu Apr 14 08:40:18 2011 -0400
+++ b/lisp/descr-text.el Sun Apr 17 11:14:38 2011 +0100
＠＠ -675,6 +675,7 ＠＠
database-file-name)))
;; End XEmacs additions.
+;;;###autoload
(defun describe-char-unicode-data (char)
"Return a list of Unicode data for unicode CHAR.
Each element is a list of a property description and the property value.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Merge tty display color cells change that I couldn't push.
13 years, 10 months
Jeff Sparkes
Jeff Sparkes
changeset: 5458:5ec4534daf16
parent: 5456:a63e666bb68a
parent: 5457:5256fedd50e6
user: Jeff Sparkes <jsparkes(a)gmail.com>
date: Thu Apr 14 08:40:18 2011 -0400
files: src/ChangeLog
description:
Merge tty display color cells change that I couldn't push.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: issue 757 - tty device metric for num-color-cells
13 years, 10 months
Jeff Sparkes
Jeff Sparkes
changeset: 5457:5256fedd50e6
parent: 5441:d363790fd936
user: Jeff Sparkes <jsparkes(a)gmail.com>
date: Mon Mar 28 09:25:15 2011 -0400
files: src/ChangeLog src/console-tty-impl.h src/device-tty.c src/device.c src/redisplay-tty.c
description:
issue 757 - tty device metric for num-color-cells
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2011-03-28 Jeff Sparkes <jsparkes(a)gmail.com>
* console-tty-impl.h (struct tty_console): Add field for number of
displayable colors.
* device-tty.c (tty_device_system_metrics): Return metrics for
num-color-cells and num-bit-planes. Tracker issue 757.
* device.c: There are two required args for device-system-metric.
* redisplay-tty.c (init_tty_for_redisplay): Retrieve number of
colors from terminal description. Default to 2 if none found.
diff -r d363790fd936 -r 5256fedd50e6 src/ChangeLog
--- a/src/ChangeLog Wed Mar 23 00:08:35 2011 +0100
+++ b/src/ChangeLog Mon Mar 28 09:25:15 2011 -0400
＠＠ -1,3 +1,13 ＠＠
+2011-03-28 Jeff Sparkes <jsparkes(a)gmail.com>
+
+ * console-tty-impl.h (struct tty_console): Add field for number of
+ displayable colors.
+ * device-tty.c (tty_device_system_metrics): Return metrics for
+ num-color-cells and num-bit-planes. Tracker issue 757.
+ * device.c: There are two required args for device-system-metric.
+ * redisplay-tty.c (init_tty_for_redisplay): Retrieve number of
+ colors from terminal description. Default to 2 if none found.
+
2011-03-20 Mats Lidell <matsl(a)xemacs.org>
* alloca.c (find_stack_direction):
diff -r d363790fd936 -r 5256fedd50e6 src/console-tty-impl.h
--- a/src/console-tty-impl.h Wed Mar 23 00:08:35 2011 +0100
+++ b/src/console-tty-impl.h Mon Mar 28 09:25:15 2011 -0400
＠＠ -62,6 +62,8 ＠＠
int height;
int width;
+
+ int colors;
/* The count of frame number. */
int frame_count;
diff -r d363790fd936 -r 5256fedd50e6 src/device-tty.c
--- a/src/device-tty.c Wed Mar 23 00:08:35 2011 +0100
+++ b/src/device-tty.c Mon Mar 28 09:25:15 2011 -0400
＠＠ -196,6 +196,10 ＠＠
case DM_size_device:
return Fcons (make_int (CONSOLE_TTY_DATA (con)->width),
make_int (CONSOLE_TTY_DATA (con)->height));
+ case DM_num_bit_planes:
+ return make_int (log2 (CONSOLE_TTY_DATA (con)->colors));
+ case DM_num_color_cells:
+ return make_int (CONSOLE_TTY_DATA (con)->colors);
default: /* No such device metric property for TTY devices */
return Qunbound;
}
diff -r d363790fd936 -r 5256fedd50e6 src/device.c
--- a/src/device.c Wed Mar 23 00:08:35 2011 +0100
+++ b/src/device.c Mon Mar 28 09:25:15 2011 -0400
＠＠ -1057,8 +1057,8 ＠＠
return DEVICE_PRINTER_P (decode_device (device)) ? Qt : Qnil;
}
-DEFUN ("device-system-metric", Fdevice_system_metric, 1, 3, 0, /*
-Get a metric for DEVICE as provided by the system.
+DEFUN ("device-system-metric", Fdevice_system_metric, 2, 3, 0, /*
+Get DEVICE METRIC as provided by the system.
METRIC must be a symbol specifying requested metric. Note that the metrics
returned are these provided by the system internally, not read from resources,
diff -r d363790fd936 -r 5256fedd50e6 src/redisplay-tty.c
--- a/src/redisplay-tty.c Wed Mar 23 00:08:35 2011 +0100
+++ b/src/redisplay-tty.c Mon Mar 28 09:25:15 2011 -0400
＠＠ -1116,6 +1116,13 ＠＠
if (CONSOLE_TTY_DATA (c)->width <= 0 || CONSOLE_TTY_DATA (c)->height <= 0)
return TTY_SIZE_UNSPECIFIED;
+ CONSOLE_TTY_DATA (c)->colors = tgetnum("Co");
+ if (CONSOLE_TTY_DATA (c)->colors == 0)
+ CONSOLE_TTY_DATA (c)->colors = tgetnum("colors");
+ if (CONSOLE_TTY_DATA (c)->colors == 0)
+ /* There is always foreground and background. */
+ CONSOLE_TTY_DATA (c)->colors = 2;
+
/*
* Initialize cursor motion information.
*/
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: No longer create windows-874 as a Win32-specific coding system; thanks Mats!
13 years, 10 months
Aidan Kehoe
Aidan Kehoe
changeset: 5456:a63e666bb68a
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
carbon2-commit: Drop support for Thai-XTIS, which was always non-standard and never used.
13 years, 10 months
Aidan Kehoe
Aidan Kehoe
changeset: 5455:75469840109b
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
carbon2-commit: Correct some nesting of GCPRO and UNGCPRO, thank you Mats' buildbot!
13 years, 10 months
Aidan Kehoe
Aidan Kehoe
changeset: 5453:484b437fc7b4
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
carbon2-commit: Use GC_EXTERNAL_LIST_LOOP_* where appropriate, fns.c
13 years, 10 months
Aidan Kehoe
Aidan Kehoe
changeset: 5452:e99b473303e3
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
carbon2-commit: #'cadr, #'caddr, #'cadddr; document some equivalences.
13 years, 10 months
Aidan Kehoe
Aidan Kehoe
changeset: 5451:25c10648ffba
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat Apr 02 16:18:07 2011 +0100
files: lisp/ChangeLog lisp/cl.el
description:
#'cadr, #'caddr, #'cadddr; document some equivalences.
lisp/ChangeLog addition:
2011-04-02 Aidan Kehoe <kehoea(a)parhasard.net>
* cl.el (cadr, caddr, cadddr):
Document some equivalences for these functions.
diff -r f9dc75bdbdc4 -r 25c10648ffba lisp/ChangeLog
--- a/lisp/ChangeLog Sat Apr 02 16:13:20 2011 +0100
+++ b/lisp/ChangeLog Sat Apr 02 16:18:07 2011 +0100
＠＠ -1,3 +1,8 ＠＠
+2011-04-02 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl.el (cadr, caddr, cadddr):
+ Document some equivalences for these functions.
+
2011-04-02 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecomp.el (byte-compile-output-preface): New.
diff -r f9dc75bdbdc4 -r 25c10648ffba lisp/cl.el
--- a/lisp/cl.el Sat Apr 02 16:13:20 2011 +0100
+++ b/lisp/cl.el Sat Apr 02 16:18:07 2011 +0100
＠＠ -425,7 +425,7 ＠＠
(car (car x)))
(defun cadr (x)
- "Return the `car' of the `cdr' of X."
+ "Return the `car' of the `cdr' of X. Equivalent to `(second X)'."
(car (cdr x)))
(defun cdar (x)
＠＠ -449,7 +449,8 ＠＠
(car (cdr (car x))))
(defun caddr (x)
- "Return the `car' of the `cdr' of the `cdr' of X."
+ "Return the `car' of the `cdr' of the `cdr' of X.
+Equivalent to `(third X)'."
(car (cdr (cdr x))))
(defun cdaar (x)
＠＠ -497,7 +498,8 ＠＠
(car (cdr (cdr (car x)))))
(defun cadddr (x)
- "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
+ "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X.
+Equivalent to `(fourth X)'."
(car (cdr (cdr (cdr x)))))
(defun cdaaar (x)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Implement #'load-time-value less hackishly, by modifying the byte compiler.
13 years, 10 months
Aidan Kehoe
Aidan Kehoe
changeset: 5450:f9dc75bdbdc4
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat Apr 02 16:13:20 2011 +0100
files: lisp/ChangeLog lisp/bytecomp.el lisp/cl-macs.el
description:
Implement #'load-time-value less hackishly, by modifying the byte compiler.
2011-04-02 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecomp.el (byte-compile-output-preface): New.
* bytecomp.el (byte-compile-output-file-form):
* bytecomp.el (byte-compile-output-docform):
* bytecomp.el (byte-compile-file-form):
* bytecomp.el (byte-compile-file-form-defmumble):
* bytecomp.el (symbol-value):
* bytecomp.el (byte-compile-symbol-value): New.
* cl-macs.el (load-time-value):
No longer implement load-time-value by very hackishly redefining
#'byte-compile-file-form-defmumble, instead make the appropriate
changes in #'byte-compile-file-form-defmumble and
#'byte-compile-file-form instead. We also add a specific byte-compile
method for #'symbol-value, using the add-properties-to-a-gensym
approach that worked for #'block and #'return-from.
diff -r 593d9f73a7e8 -r f9dc75bdbdc4 lisp/ChangeLog
--- a/lisp/ChangeLog Sat Apr 02 17:04:38 2011 +0900
+++ b/lisp/ChangeLog Sat Apr 02 16:13:20 2011 +0100
＠＠ -1,3 +1,20 ＠＠
+2011-04-02 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * bytecomp.el (byte-compile-output-preface): New.
+ * bytecomp.el (byte-compile-output-file-form):
+ * bytecomp.el (byte-compile-output-docform):
+ * bytecomp.el (byte-compile-file-form):
+ * bytecomp.el (byte-compile-file-form-defmumble):
+ * bytecomp.el (symbol-value):
+ * bytecomp.el (byte-compile-symbol-value): New.
+ * cl-macs.el (load-time-value):
+ No longer implement load-time-value by very hackishly redefining
+ #'byte-compile-file-form-defmumble, instead make the appropriate
+ changes in #'byte-compile-file-form-defmumble and
+ #'byte-compile-file-form instead. We also add a specific byte-compile
+ method for #'symbol-value, using the add-properties-to-a-gensym
+ approach that worked for #'block and #'return-from.
+
2011-03-29 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-extra.el (cl-finite-do, cl-float-limits):
diff -r 593d9f73a7e8 -r f9dc75bdbdc4 lisp/bytecomp.el
--- a/lisp/bytecomp.el Sat Apr 02 17:04:38 2011 +0900
+++ b/lisp/bytecomp.el Sat Apr 02 16:13:20 2011 +0100
＠＠ -455,6 +455,9 ＠＠
"Alist of variables bound in the context of the current form,
that is, the current lexical environment. This list lives partly
on the specbind stack. The cdr of each cell is an integer bitmask.")
+(defvar byte-compile-output-preface nil
+ "Form to output before current by `byte-compile-output-file-form'
+This is used for implementing `load-time-value'.")
(defvar byte-compile-force-escape-quoted nil
"If t, `byte-compile-maybe-reset-coding' always chooses `escape-quoted'
＠＠ -1977,8 +1980,12 ＠＠
(not byte-compile-emacs19-compatibility))
'(t) nil))
print-gensym-alist)
+ (when byte-compile-output-preface
+ (princ "\n(progn " byte-compile-outbuffer)
+ (prin1 byte-compile-output-preface byte-compile-outbuffer))
(princ "\n" byte-compile-outbuffer)
(prin1 form byte-compile-outbuffer)
+ (when byte-compile-output-preface (princ ")" byte-compile-outbuffer))
nil)))
(defun byte-compile-output-docform (preface name info form specindex quoted)
＠＠ -2016,12 +2023,6 ＠＠
(> (length (nth (nth 1 info) form)) 0)
(char= (aref (nth (nth 1 info) form) 0) ?*))
(setq position (- position)))))
-
- (if preface
- (progn
- (insert preface)
- (prin1 name byte-compile-outbuffer)))
- (insert (car info))
(let ((print-escape-newlines t)
(print-readably t) ; print #[] for bytecode, 'x for (quote x)
;; Use a cons cell to say that we want
＠＠ -2032,6 +2033,15 ＠＠
'(t) nil))
print-gensym-alist
(index 0))
+ (when byte-compile-output-preface
+ (princ "\n(progn " byte-compile-outbuffer)
+ (prin1 byte-compile-output-preface byte-compile-outbuffer))
+ (byte-compile-flush-pending)
+ (if preface
+ (progn
+ (insert preface)
+ (prin1 name byte-compile-outbuffer)))
+ (insert (car info))
(prin1 (car form) byte-compile-outbuffer)
(while (setq form (cdr form))
(setq index (1+ index))
＠＠ -2058,7 +2068,9 ＠＠
(goto-char (point-max)))))
(t
(prin1 (car form) byte-compile-outbuffer)))))
- (insert (nth 2 info))))))
+ (insert (nth 2 info))
+ (when byte-compile-output-preface
+ (princ ")" byte-compile-outbuffer))))))
nil)
(defvar for-effect) ; ## Kludge! This should be an arg, not a special.
＠＠ -2094,6 +2106,7 ＠＠
(defun byte-compile-file-form (form)
(let ((byte-compile-current-form nil) ; close over this for warnings.
+ (byte-compile-output-preface nil)
handler)
(cond
((not (consp form))
＠＠ -2329,11 +2342,11 ＠＠
(code (byte-compile-byte-code-maker new-one))
(docform-info
(cond ((atom code) ; compiled-function-p
- (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]")))
+ (if macrop '(" '(macro . #[" 4 "]))") '(" #[" 4 "])")))
((eq (car code) 'quote)
(setq code new-one)
- (if macrop '(" '(macro " 2 ")") '(" '(" 2 ")")))
- ((if macrop '(" (cons 'macro (" 5 "))") '(" (" 5 ")"))))))
+ (if macrop '(" '(macro " 2 "))") '(" '(" 2 "))")))
+ ((if macrop '(" (cons 'macro (" 5 ")))") '(" (" 5 "))"))))))
(if this-one
(setcdr this-one new-one)
(set this-kind
＠＠ -2360,18 +2373,16 ＠＠
;; printed to the file.
(if (consp code)
code
- (nconc (list
- (compiled-function-arglist code)
- (compiled-function-instructions code)
- (compiled-function-constants code)
- (compiled-function-stack-depth code)
- (compiled-function-doc-string code))
+ (list* (compiled-function-arglist code)
+ (compiled-function-instructions code)
+ (compiled-function-constants code)
+ (compiled-function-stack-depth code)
+ (compiled-function-doc-string code)
(if (commandp code)
(list (nth 1 (compiled-function-interactive code))))))
(and (atom code) byte-compile-dynamic
1)
nil))
- (princ ")" byte-compile-outbuffer)
nil)))
;; Print Lisp object EXP in the output file, inside a comment,
＠＠ -3143,7 +3154,7 ＠＠
(byte-defop-compiler car 1)
(byte-defop-compiler cdr 1)
(byte-defop-compiler length 1)
-(byte-defop-compiler symbol-value 1)
+(byte-defop-compiler symbol-value)
(byte-defop-compiler symbol-function 1)
(byte-defop-compiler (1+ byte-add1) 1)
(byte-defop-compiler (1- byte-sub1) 1)
＠＠ -4314,6 +4325,29 ＠＠
(byte-compile-body (cdr (cdr form)))
(byte-compile-out 'byte-temp-output-buffer-show 0))
+(defun byte-compile-symbol-value (form)
+ (symbol-macrolet ((not-present '#:not-present))
+ (let ((cl-load-time-value-form not-present)
+ (byte-compile-bound-variables byte-compile-bound-variables) gensym)
+ (and (consp (cadr form))
+ (eq 'quote (caadr form))
+ (setq gensym (cadadr form))
+ (symbolp gensym)
+ (setq cl-load-time-value-form
+ (get gensym 'cl-load-time-value-form not-present)))
+ (unless (eq cl-load-time-value-form not-present)
+ (setq byte-compile-bound-variables
+ (acons gensym byte-compile-global-bit
+ byte-compile-bound-variables)
+ byte-compile-output-preface
+ (byte-compile-top-level
+ (if byte-compile-output-preface
+ `(progn (setq ,gensym ,cl-load-time-value-form)
+ ,byte-compile-output-preface)
+ `(setq ,gensym ,cl-load-time-value-form))
+ t 'file)))
+ (byte-compile-one-arg form))))
+
(defun byte-compile-multiple-value-call (form)
(if (< (length form) 2)
(progn
diff -r 593d9f73a7e8 -r f9dc75bdbdc4 lisp/cl-macs.el
--- a/lisp/cl-macs.el Sat Apr 02 17:04:38 2011 +0900
+++ b/lisp/cl-macs.el Sat Apr 02 16:13:20 2011 +0100
＠＠ -621,25 +621,15 ＠＠
(defmacro load-time-value (form &optional read-only)
"Like `progn', but evaluates the body at load time.
The result of the body appears to the compiler as a quoted constant."
- (if (cl-compiling-file)
- (let* ((temp (gentemp "--cl-load-time--"))
- (set (list 'set (list 'quote temp) form)))
- (if (and (fboundp 'byte-compile-file-form-defmumble)
- (boundp 'this-kind) (boundp 'that-one))
- (fset 'byte-compile-file-form
- (list 'lambda '(form)
- (list 'fset '(quote byte-compile-file-form)
- (list 'quote
- (symbol-function 'byte-compile-file-form)))
- (list 'byte-compile-file-form (list 'quote set))
- '(byte-compile-file-form form)))
- ;; XEmacs change
- (print set (symbol-value ;;'outbuffer
- 'byte-compile-output-buffer
- )))
- (list 'symbol-value (list 'quote temp)))
- (list 'quote (eval form))))
-
+ (let ((gensym (gensym)))
+ ;; The body of this macro really should be (cons 'progn form), with the
+ ;; hairier stuff in a shadowed version in
+ ;; byte-compile-initial-macro-environment. That doesn't work because
+ ;; cl-macs.el doesn't respect byte-compile-macro-environment, which is
+ ;; something we should change.
+ (put gensym 'cl-load-time-value-form form)
+ (set gensym (eval form))
+ `(symbol-value ',gensym)))
;;; Conditional control structures.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: New FAQ Q2.5.7 on troubleshooting duplicate auto-autoloads.
13 years, 10 months
Stephen J. Turnbull
Stephen J. Turnbull
changeset: 5449:593d9f73a7e8
user: Stephen J. Turnbull <stephen(a)xemacs.org>
date: Sat Apr 02 17:04:38 2011 +0900
files: man/ChangeLog man/xemacs-faq.texi
description:
New FAQ Q2.5.7 on troubleshooting duplicate auto-autoloads.
Nodes Top, Installation, Q2.5.6: Update menus and node links for Q2.5.7.
diff -r f560f6608937 -r 593d9f73a7e8 man/ChangeLog
--- a/man/ChangeLog Wed Mar 30 15:07:15 2011 -0600
+++ b/man/ChangeLog Sat Apr 02 17:04:38 2011 +0900
＠＠ -1,3 +1,12 ＠＠
+2011-04-02 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * xemacs-faq.texi (Q2.5.7):
+ New node on troubleshooting duplicate auto-autoloads.
+ (Top):
+ (Installation):
+ (Q2.5.6):
+ Update menus and node links for Q2.5.7.
+
2011-03-24 Jerry James <james(a)xemacs.org>
* internals/internals.texi (Creating a Window-System Type):
diff -r f560f6608937 -r 593d9f73a7e8 man/xemacs-faq.texi
--- a/man/xemacs-faq.texi Wed Mar 30 15:07:15 2011 -0600
+++ b/man/xemacs-faq.texi Sat Apr 02 17:04:38 2011 +0900
＠＠ -327,6 +327,7 ＠＠
* Q2.5.4:: Startup warnings about deducing proper fonts?
* Q2.5.5:: Warnings from incorrect key modifiers.
* Q2.5.6:: XEmacs 21.1 on Windows used to spawn an ugly console window on every startup. Has that been fixed?
+* Q2.5.7:: XEmacs issues messages about ``auto-autoloads already loaded.''
3 Editing Functions
＠＠ -3149,6 +3150,7 ＠＠
* Q2.5.4:: Startup warnings about deducing proper fonts?
* Q2.5.5:: Warnings from incorrect key modifiers.
* Q2.5.6:: XEmacs 21.1 on Windows used to spawn an ugly console window on every startup. Has that been fixed?
+* Q2.5.7:: XEmacs issues messages about ``auto-autoloads already loaded.''
＠end menu
＠unnumberedsec 2.0: Installation (General)
＠＠ -4567,7 +4569,7 ＠＠
EOF
＠end example
-＠node Q2.5.6, , Q2.5.5, Installation
+＠node Q2.5.6, Q2.5.7, Q2.5.5, Installation
＠unnumberedsubsec Q2.5.6: XEmacs 21.1 on Windows used to spawn an ugly console window on every startup. Has that been fixed?
Yes.
＠＠ -4616,6 +4618,54 ＠＠
just creates and immediately hides a console when necessary, and
works around the "no useful stdio" problem by creating its own console
window as necessary to display messages in.)
+
+＠node Q2.5.7, , Q2.5.6, Installation
+＠unnumberedsubsec Q2.5.7: XEmacs issues messages about ``auto-autoloads already loaded.''
+
+On Sat, 05 Mar 2011 11:54:47 -0500, in Message-ID:
+<4D726AD7.7020303＠(a)gmail.com> on xemacs-beta, Raymond Toy reported:
+
+＠quotation
+[N]ow every time I start xemacs, I get 100+ error messages stating that
+the auto-autoload for every package has already been loaded.
+＠end quotation
+
+This occurs if you have duplicate packages installed on your load-path.
+To detect exactly which paths are duplicated, use ＠kbd{M-x
+list-load-path-shadows}. If you have a small number of duplicated
+libraries, it is probably one or more packages available both in the
+XEmacs distribution and in third-party distributions. If you prefer the
+third-party version, use ＠kbd{M-x list-packages} to get the package
+management UI, and uninstall the particular packages. Removal of third
+party packages must be done manually, if you wish to keep the version
+distributed by XEmacs.
+
+When you have many duplicate packages, a common cause is that XEmacs
+finds ＠emph{package root directories} that are duplicates of each other.
+This can occur in some automounter configurations, or when the roots
+share some subtrees via symlinks. In this case, you will get a warning
+for ＠emph{all} of the packages you have installed. Although this is
+basically a site configuration problem, please report these cases.
+XEmacs is already aware of many automounter artifacts, and automatically
+adjusts for them. Code is being added to try to detect symlinks. We
+may not be able to handle every case, but we'd like to know about them,
+and where possible incorporate workarounds.
+
+Package root directories are specified at configuration time via the
+＠code{--prefix}, ＠code{--exec-prefix}, and the ＠samp{--with-*-packages}
+options; at runtime relative to the XEmacs binary (＠file{../share} and
+＠file{..} (for run-in-place)); and at runtime via the
+＠samp{EMACS*PACKAGES} environment variables. Unless you have special
+needs, it is best to install XEmacs and the packages (configuring with
+＠code{--with-prefix=$prefix} for XEmacs and by untarring the SUMOs in
+＠file{＠code{$prefix}/share/xemacs/}.
+
+Note that older versions of XEmacs (21.1, 21.4, and early releases of
+21.5) by default expect the packages to be installed under
+＠file{＠code{$prefix}/lib} rather than ＠file{＠code{$prefix}/share}. See
+the documentation for ＠file{configure} for how to point XEmacs at
+＠file{＠code{$prefix}/share/xemacs/} if that is preferred, or older
+XEmacsen need to share packages with recent versions.
＠node Editing, Display, Installation, Top
＠unnumbered 3 Editing Functions
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments