carbon2-commit: Preserve the relation btw. file-name-coding-system & the 'file-name c-s alias.
16 years, 2 months
Aidan Kehoe
Aidan Kehoe
changeset: 4615:774e5c7522bf0681f0ecf0ab015d9ec8dcb35486
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Tue Jan 13 12:07:27 2009 +0000
files: lisp/ChangeLog lisp/mule/mule-cmds.el
description:
Preserve the relation btw. file-name-coding-system & the 'file-name c-s alias.
lisp/ChangeLog addition:
2009-01-13 Aidan Kehoe <kehoea(a)parhasard.net>
* mule/mule-cmds.el (set-language-environment-coding-systems):
Fix a cosmetic bug; the relationship between
file-name-coding-system and the file-name coding system alias
established in coding.el wasn't being maintained. See Katsumi
Yamaoka's comment in http://mid.gmane.org/b4m4p03bt43.fsf＠jpl.org .
diff -r eecd28508f4ad62d51fe5144021a20f9d8594d0a -r 774e5c7522bf0681f0ecf0ab015d9ec8dcb35486 lisp/ChangeLog
--- a/lisp/ChangeLog Sun Jan 11 13:18:42 2009 +0000
+++ b/lisp/ChangeLog Tue Jan 13 12:07:27 2009 +0000
＠＠ -1,3 +1,11 ＠＠ 2009-01-11 Aidan Kehoe <kehoea＠parhasa
+2009-01-13 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * mule/mule-cmds.el (set-language-environment-coding-systems):
+ Fix a cosmetic bug; the relationship between
+ file-name-coding-system and the file-name coding system alias
+ established in coding.el wasn't being maintained. See Katsumi
+ Yamaoka's comment in http://mid.gmane.org/b4m4p03bt43.fsf＠jpl.org .
+
2009-01-11 Aidan Kehoe <kehoea(a)parhasard.net>
* subr.el: Correct a comment, we now have #'syntax-after in
diff -r eecd28508f4ad62d51fe5144021a20f9d8594d0a -r 774e5c7522bf0681f0ecf0ab015d9ec8dcb35486 lisp/mule/mule-cmds.el
--- a/lisp/mule/mule-cmds.el Sun Jan 11 13:18:42 2009 +0000
+++ b/lisp/mule/mule-cmds.el Tue Jan 13 12:07:27 2009 +0000
＠＠ -1410,15 +1410,17 ＠＠ of buffer-file-coding-system set by this
(error
(warn "Invalid native-coding-system %s in language environment %s"
native language-name)))
- (define-coding-system-alias 'file-name
- (or
- (let ((fncs (assq system-type system-type-file-name-coding)))
- (and fncs (cdr fncs)))
- 'native))
- ;; Set the default keyboard and terminal coding systems to the native
- ;; coding system of the language environment.
- ;;
- (setq keyboard-coding-system native
+ ;; These variables have magic handlers to make setting them equivalent
+ ;; to setting the file-name, terminal and keyboard coding system
+ ;; aliases. See coding.el.
+ (setq file-name-coding-system
+ (or
+ (let ((fncs (assq system-type system-type-file-name-coding)))
+ (and fncs (cdr fncs)))
+ native)
+ ;; Set the default keyboard and terminal coding systems to the
+ ;; native coding system of the language environment.
+ keyboard-coding-system native
terminal-coding-system native)
;; And do the same for any TTYs.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Docstring spelling fixes.
16 years, 2 months
Aidan Kehoe
Aidan Kehoe
changeset: 4616:de0228446b18b1ff1d5a0c4411fdbae51781cf71
user: "Ville SkyttÀ <scop(a)xemacs.org>"
date: Sun Jan 18 11:55:53 2009 +0200
files: lisp/ChangeLog lisp/font.el
description:
Docstring spelling fixes.
diff -r 774e5c7522bf0681f0ecf0ab015d9ec8dcb35486 -r de0228446b18b1ff1d5a0c4411fdbae51781cf71 lisp/ChangeLog
--- a/lisp/ChangeLog Tue Jan 13 12:07:27 2009 +0000
+++ b/lisp/ChangeLog Sun Jan 18 11:55:53 2009 +0200
＠＠ -1,3 +1,8 ＠＠ 2009-01-13 Aidan Kehoe <kehoea＠parhasa
+2009-01-18 Ville Skyttä <scop(a)xemacs.org>
+
+ * font.el (font-*-p): Docstring spelling fix.
+ (set-font-*-p): Ditto.
+
2009-01-13 Aidan Kehoe <kehoea(a)parhasard.net>
* mule/mule-cmds.el (set-language-environment-coding-systems):
diff -r 774e5c7522bf0681f0ecf0ab015d9ec8dcb35486 -r de0228446b18b1ff1d5a0c4411fdbae51781cf71 lisp/font.el
--- a/lisp/font.el Tue Jan 13 12:07:27 2009 +0000
+++ b/lisp/font.el Sun Jan 18 11:55:53 2009 +0200
＠＠ -216,13 +216,13 ＠＠ for use in the 'weight' field of an X fo
"Bitmask for whether a font is to be rendered in %s or not."
attr))
(defun ,(intern (format "font-%s-p" attr)) (fontobj)
- ,(format "Whether FONTOBJ will be renderd in `%s' or not." attr)
+ ,(format "Whether FONTOBJ will be rendered in `%s' or not." attr)
(if (/= 0 (logand (font-style fontobj)
,(intern (format "font-%s-mask" attr))))
t
nil))
(defun ,(intern (format "set-font-%s-p" attr)) (fontobj val)
- ,(format "Set whether FONTOBJ will be renderd in `%s' or not."
+ ,(format "Set whether FONTOBJ will be rendered in `%s' or not."
attr)
(cond
(val
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Add #'subr-arity, API taken from GNU, implementation our own.
16 years, 2 months
Aidan Kehoe
Aidan Kehoe
changeset: 4614:eecd28508f4ad62d51fe5144021a20f9d8594d0a
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sun Jan 11 13:18:42 2009 +0000
files: lisp/ChangeLog lisp/subr.el tests/ChangeLog tests/automated/lisp-tests.el
description:
Add #'subr-arity, API taken from GNU, implementation our own.
lisp/ChangeLog addition:
2009-01-11 Aidan Kehoe <kehoea(a)parhasard.net>
* subr.el: Correct a comment, we now have #'syntax-after in
syntax.el.
(subr-arity): New.
Docstring and API taken initially from GNU's data.c, revision
1.275, GPLv2.
tests/ChangeLog addition:
2009-01-11 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el ():
Test #'subr-arity, recently added to subr.el.
diff -r 302136a857ecc128b6e4d6824ddab892e88ea6a0 -r eecd28508f4ad62d51fe5144021a20f9d8594d0a lisp/ChangeLog
--- a/lisp/ChangeLog Sat Jan 03 15:41:34 2009 +0000
+++ b/lisp/ChangeLog Sun Jan 11 13:18:42 2009 +0000
＠＠ -1,3 +1,11 ＠＠ 2009-01-01 Stephen J. Turnbull <stephe
+2009-01-11 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * subr.el: Correct a comment, we now have #'syntax-after in
+ syntax.el.
+ (subr-arity): New.
+ Docstring and API taken initially from GNU's data.c, revision
+ 1.275, GPLv2.
+
2009-01-01 Stephen J. Turnbull <stephen(a)xemacs.org>
* descr-text.el (describe-char-unicodedata-file):
diff -r 302136a857ecc128b6e4d6824ddab892e88ea6a0 -r eecd28508f4ad62d51fe5144021a20f9d8594d0a lisp/subr.el
--- a/lisp/subr.el Sat Jan 03 15:41:34 2009 +0000
+++ b/lisp/subr.el Sun Jan 11 13:18:42 2009 +0000
＠＠ -1699,7 +1699,7 ＠＠ one is kept."
;; (defun make-syntax-table (&optional oldtable) in syntax.el.
-;; (defun syntax-after (pos) #### doesn't exist.
+;; (defun syntax-after (pos) in syntax.el.
;; global-set-key, local-set-key, global-unset-key, local-unset-key in
;; keymap.el.
＠＠ -1742,4 +1742,24 ＠＠ in Lisp; do not use it in performance-cr
list (nconc list '(?\\ ?-)))))
(apply #'string list)))
+;; XEmacs addition to subr.el; docstring and API taken initially from GNU's
+;; data.c, revision 1.275, GPLv2.
+(defun subr-arity (subr)
+ "Return minimum and maximum number of args allowed for SUBR.
+SUBR must be a built-in function (not just a symbol that refers to one).
+The returned value is a pair (MIN . MAX). MIN is the minimum number
+of args. MAX is the maximum number or the symbol `many', for a
+function with `&rest' args, or `unevalled' for a special form.
+
+See also `special-form-p', `subr-min-args', `subr-max-args',
+`function-allows-args'. "
+ (check-argument-type #'subrp subr)
+ (cons (subr-min-args subr)
+ (cond
+ ((special-form-p subr)
+ 'unevalled)
+ ((null (subr-max-args subr))
+ 'many)
+ (t (subr-max-args subr)))))
+
;;; subr.el ends here
diff -r 302136a857ecc128b6e4d6824ddab892e88ea6a0 -r eecd28508f4ad62d51fe5144021a20f9d8594d0a tests/ChangeLog
--- a/tests/ChangeLog Sat Jan 03 15:41:34 2009 +0000
+++ b/tests/ChangeLog Sun Jan 11 13:18:42 2009 +0000
＠＠ -1,3 +1,8 ＠＠ 2009-01-03 Aidan Kehoe <kehoea＠parhasa
+2009-01-11 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el ():
+ Test #'subr-arity, recently added to subr.el.
+
2009-01-03 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/ccl-tests.el (ccl-test-setup):
diff -r 302136a857ecc128b6e4d6824ddab892e88ea6a0 -r eecd28508f4ad62d51fe5144021a20f9d8594d0a tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Sat Jan 03 15:41:34 2009 +0000
+++ b/tests/automated/lisp-tests.el Sun Jan 11 13:18:42 2009 +0000
＠＠ -888,6 +888,20 ＠＠
(defun test-fun ,arglist nil)
(check-function-argcounts '(lambda ,arglist nil) ,min ,max)
(check-function-argcounts (byte-compile '(lambda ,arglist nil)) ,min ,max))))
+
+;; Test subr-arity.
+(loop for (function-name arity) in
+ '((let (1 . unevalled))
+ (prog1 (1 . unevalled))
+ (list (0 . many))
+ (type-of (1 . 1))
+ (garbage-collect (0 . 0)))
+ do (Assert (equal (subr-arity (symbol-function function-name)) arity)))
+
+(Check-Error wrong-type-argument (subr-arity
+ (lambda () (message "Hi there!"))))
+
+(Check-Error wrong-type-argument (subr-arity nil))
;;-----------------------------------------------------
;; Detection of cyclic variable indirection loops
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Correct the CCL programs used by the coding system in ccl-tests.el.
16 years, 2 months
Aidan Kehoe
Aidan Kehoe
changeset: 4612:baf6c66f6f474dd9edfa216794aa9c300ff128c6
parent: 4610:ebc01476e352f6765d1f269a30b2f7ed7095db72
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat Jan 03 15:24:14 2009 +0000
files: tests/ChangeLog tests/automated/ccl-tests.el
description:
Correct the CCL programs used by the coding system in ccl-tests.el.
2009-01-03 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/ccl-tests.el (ccl-test-setup):
Use sane CCL programs for decoding and encoding with the test CCL
coding system by default. Correct a spelling in the docstring, add
a safe-chars property so that we don't confuse
query-coding-tests.el.
(ccl-test-suites):
Explicitly re-initialise the CCL programs for the test coding
system once finished.
diff -r ebc01476e352f6765d1f269a30b2f7ed7095db72 -r baf6c66f6f474dd9edfa216794aa9c300ff128c6 tests/ChangeLog
--- a/tests/ChangeLog Tue Dec 30 20:33:30 2008 +0000
+++ b/tests/ChangeLog Sat Jan 03 15:24:14 2009 +0000
＠＠ -1,3 +1,14 ＠＠ 2008-12-28 Aidan Kehoe <kehoea＠parhasa
+2009-01-03 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/ccl-tests.el (ccl-test-setup):
+ Use sane CCL programs for decoding and encoding with the test CCL
+ coding system by default. Correct a spelling in the docstring, add
+ a safe-chars property so that we don't confuse
+ query-coding-tests.el.
+ (ccl-test-suites):
+ Explicitly re-initialise the CCL programs for the test coding
+ system once finished.
+
2008-12-28 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/query-coding-tests.el:
diff -r ebc01476e352f6765d1f269a30b2f7ed7095db72 -r baf6c66f6f474dd9edfa216794aa9c300ff128c6 tests/automated/ccl-tests.el
--- a/tests/automated/ccl-tests.el Tue Dec 30 20:33:30 2008 +0000
+++ b/tests/automated/ccl-tests.el Sat Jan 03 15:24:14 2009 +0000
＠＠ -117,21 +117,22 ＠＠
(defun ccl-test-setup ()
(define-ccl-program
ccl-test-decoder
- '(1 (read r0)
- (loop
- (write-read-repeat r0))))
+ '(1 (loop
+ (read r0)
+ (write-repeat r0))))
(define-ccl-program
ccl-test-encoder
- '(1 (read r0)
- (loop
- (write-read-repeat r0))))
+ '(1 (loop
+ (read r0)
+ (write-repeat r0))))
(or (find-coding-system 'ccl-test-coding-system)
(make-coding-system
'ccl-test-coding-system
'ccl
- "CCL TEST temprary coding-system."
+ "CCL TEST temporary coding-system."
'(mnemonic "CCL-TEST"
eol-type lf
+ safe-chars t
decode ccl-test-decoder
encode ccl-test-encoder))))
＠＠ -601,7 +602,9 ＠＠
(ccl-test-simple-read-and-write)
(ccl-test-read-write-multibyte-character)
(ccl-test-ccl-call)
- (ccl-test-map-instructions))
+ (ccl-test-map-instructions)
+ ;; Re-initialise the coding system:
+ (ccl-test-setup))
;;; start tests only when ccl-execute is enabled.
(if (fboundp 'ccl-execute)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Fix build broken by descr-text.el defcustom.
16 years, 2 months
Aidan Kehoe
Aidan Kehoe
changeset: 4611:16c9098dd3d2459c112fd2f8080f6b57c7099d10
user: Stephen J. Turnbull <stephen(a)xemacs.org>
date: Thu Jan 01 16:37:48 2009 +0900
files: lisp/ChangeLog lisp/descr-text.el
description:
Fix build broken by descr-text.el defcustom.
diff -r ebc01476e352f6765d1f269a30b2f7ed7095db72 -r 16c9098dd3d2459c112fd2f8080f6b57c7099d10 lisp/ChangeLog
--- a/lisp/ChangeLog Tue Dec 30 20:33:30 2008 +0000
+++ b/lisp/ChangeLog Thu Jan 01 16:37:48 2009 +0900
＠＠ -1,3 +1,8 ＠＠ 2008-12-30 Aidan Kehoe <kehoea＠parhasa
+2009-01-01 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * descr-text.el (describe-char-unicodedata-file):
+ Nuke build-breaking computation from defcustom initializer.
+
2008-12-30 Aidan Kehoe <kehoea(a)parhasard.net>
* make-docfile.el:
diff -r ebc01476e352f6765d1f269a30b2f7ed7095db72 -r 16c9098dd3d2459c112fd2f8080f6b57c7099d10 lisp/descr-text.el
--- a/lisp/descr-text.el Tue Dec 30 20:33:30 2008 +0000
+++ b/lisp/descr-text.el Thu Jan 01 16:37:48 2009 +0900
＠＠ -207,40 +207,18 ＠＠ otherwise."
(insert "There are text properties here:\n")
(describe-property-list properties)))))
-(defcustom describe-char-unicodedata-file
- ;; XEmacs change; initialise this by default, using Perl.
- (let ((have-perl
- (member-if
- #'(lambda (path)
- (file-exists-p (format "%s%cperl" path directory-sep-char)))
- exec-path))
- installprivlib res)
- (when have-perl
- (setq installprivlib
- (with-string-as-buffer-contents ""
- (shell-command "perl -V:installprivlib" t)
- ;; 1+ because buffer offsets start at one.
- (delete-region 1 (1+ (length "installprivlib='")))
- ;; Delete the final newline, semicolon and quotation mark.
- (delete-region (- (point-max) 3) (point-max))))
- (cond
- ((file-exists-p
- (setq res
- (format "%s%cunicore%cUnicodeData.txt"
- installprivlib directory-sep-char directory-sep-char))))
- ((file-exists-p
- (setq res
- (format "%s%cunicode%cUnicodeData.txt"
- installprivlib directory-sep-char directory-sep-char)))))
- res))
+;; XEmacs change
+(defcustom describe-char-unicodedata-file nil
"Location of Unicode data file.
This is the UnicodeData.txt file from the Unicode Consortium, used for
diagnostics. If it is non-nil `describe-char' will print data
looked up from it. This facility is mostly of use to people doing
multilingual development.
-This is a fairly large file, typically installed with Perl.
-At the time of writing it is at the URL
+This is a fairly large file, installed on many systems by Perl, in the
+`unicore' subdirectory of the Perl library tree \(\"perl -V:installprivlib\"
+will tell you where that is.) You can also get the current version from the
+Unicode Consortium at the URL
`http://www.unicode.org/Public/UNIDATA/UnicodeData.txt'.
It is possible to build a DBM or Berkeley index cache for this file, so that
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Add check-coding-systems-region, test it and others, fix some bugs.
16 years, 2 months
Aidan Kehoe
Aidan Kehoe
changeset: 4609:e6a7054a9c3063f1257ae9f66c5dfdef7f02bf4c
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sun Dec 28 22:51:14 2008 +0000
files: lisp/ChangeLog lisp/coding.el lisp/unicode.el tests/ChangeLog tests/automated/query-coding-tests.el
description:
Add check-coding-systems-region, test it and others, fix some bugs.
tests/ChangeLog addition:
2008-12-28 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/query-coding-tests.el:
Add tests for #'unencodable-char-position,
#'check-coding-systems-region, #'encode-coding-char. Remove some
debugging statements.
lisp/ChangeLog addition:
2008-12-28 Aidan Kehoe <kehoea(a)parhasard.net>
* coding.el (query-coding-region):
(query-coding-string):
Make these defsubsts, they're short enough and they're called
explicitly rarely enough that it make some sense. The alternative
would be compiler macros that avoid the binding of the arguments.
(unencodable-char-position):
Document where the docstring and API are from.
Correct a special case for zero--check-argument-type returns nil
when it succeeds, we can't usefully chain its result in an and
here.
(check-coding-systems-region): New. API taken from GNU; docstring
and implementation are independent.
(encode-coding-char):
Add an optional third argument, as used by recent GNU. Document
the origen of the docstring.
(default-query-coding-region): Add a short docstring to the
non-Mule implementation of this function.
* unicode.el:
Don't set the query-coding-function property for unicode coding
systems if we're on non-mule. Unintern
unicode-query-coding-region, unicode-query-coding-skip-chars-arg
in the same context.
diff -r 80e0588fb42f5f7d5530de33cdc64d6cbafdb026 -r e6a7054a9c3063f1257ae9f66c5dfdef7f02bf4c lisp/ChangeLog
--- a/lisp/ChangeLog Sun Dec 28 14:55:02 2008 +0000
+++ b/lisp/ChangeLog Sun Dec 28 22:51:14 2008 +0000
＠＠ -1,3 +1,28 ＠＠ 2008-12-28 Aidan Kehoe <kehoea＠parhasa
+2008-12-28 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * coding.el (query-coding-region):
+ (query-coding-string):
+ Make these defsubsts, they're short enough and they're called
+ explicitly rarely enough that it make some sense. The alternative
+ would be compiler macros that avoid the binding of the arguments.
+ (unencodable-char-position):
+ Document where the docstring and API are from.
+ Correct a special case for zero--check-argument-type returns nil
+ when it succeeds, we can't usefully chain its result in an and
+ here.
+ (check-coding-systems-region): New. API taken from GNU; docstring
+ and implementation are independent.
+ (encode-coding-char):
+ Add an optional third argument, as used by recent GNU. Document
+ the origen of the docstring.
+ (default-query-coding-region): Add a short docstring to the
+ non-Mule implementation of this function.
+ * unicode.el:
+ Don't set the query-coding-function property for unicode coding
+ systems if we're on non-mule. Unintern
+ unicode-query-coding-region, unicode-query-coding-skip-chars-arg
+ in the same context.
+
2008-12-28 Aidan Kehoe <kehoea(a)parhasard.net>
* coding.el (default-query-coding-region):
diff -r 80e0588fb42f5f7d5530de33cdc64d6cbafdb026 -r e6a7054a9c3063f1257ae9f66c5dfdef7f02bf4c lisp/coding.el
--- a/lisp/coding.el Sun Dec 28 14:55:02 2008 +0000
+++ b/lisp/coding.el Sun Dec 28 22:51:14 2008 +0000
＠＠ -398,7 +398,7 ＠＠ addition, characters that can be safely
(values nil ranges)
(values t nil))))))
-(defun query-coding-region (start end coding-system &optional buffer
+(defsubst query-coding-region (start end coding-system &optional buffer
errorp highlight)
"Work out whether CODING-SYSTEM can losslessly encode a region.
＠＠ -423,7 +423,7 ＠＠ describing the positions of the unencoda
#'default-query-coding-region)
start end coding-system buffer errorp highlight))
-(defun query-coding-string (string coding-system &optional errorp highlight)
+(defsubst query-coding-string (string coding-system &optional errorp highlight)
"Work out whether CODING-SYSTEM can losslessly encode STRING.
CODING-SYSTEM is the coding system to check.
＠＠ -446,6 +446,7 ＠＠ describing the positions of the unencoda
;; ### Will highlight work here?
errorp highlight)))
+;; Function docstring and API are taken from GNU coding.c version 1.353, GPLv2.
(defun unencodable-char-position (start end coding-system
&optional count string)
"Return position of first un-encodable character in a region.
＠＠ -486,9 +487,9 ＠＠ in the string."
(check-argument-type #'integer-or-marker-p start)
(check-argument-type #'integer-or-marker-p end)
(check-coding-system coding-system)
- (and count (check-argument-type #'natnump count)
- ;; Special-case zero, sigh.
- (if (zerop count) (setq count 1)))
+ (when count (check-argument-type #'natnump count)
+ ;; Special-case zero, sigh.
+ (if (zerop count) (setq count 1)))
(and string (check-argument-type #'stringp string))
(if string
(with-temp-buffer
＠＠ -496,9 +497,64 ＠＠ in the string."
(funcall thunk start end coding-system count))
(funcall thunk start end coding-system count))))
-(defun encode-coding-char (char coding-system)
+;; XEmacs; this is a GPLv3 function in coding.c in GNU. This is why we have
+;; both a very divergent docstring and a very divergent implementation.
+(defun check-coding-systems-region (begin end coding-system-list)
+ "Can coding systems in CODING-SYSTEM-LIST encode text in a region?
+
+CODING-SYSTEM-LIST must be a list of coding systems. BEGIN and END are
+normally buffer positions delimiting the region. If some coding system in
+CODING-SYSTEM-LIST cannot encode the entire region, the return value of this
+function is an alist mapping coding system names to lists of individual
+buffer positions (not ranges) that the individual coding systems cannot
+encode.
+
+If all coding systems in CODING-SYSTEM-LIST can encode the region,
+this function returns t. This conflicts with the documented, but not
+with the observed, GNU behavior.
+
+If BEGIN is a string, `check-coding-systems-region' ignores END, and checks
+whether the coding systems can encode BEGIN. The alist that is returned
+uses zero-based string indices, not one-based buffer positions.
+
+This function is for GNU compatibility. See also `query-coding-region'."
+ (let ((thunk
+ #'(lambda (begin end coding-system-list stringp)
+ (loop
+ for coding-system in coding-system-list
+ with result = nil
+ with intermediate = nil
+ with range-lambda = (if stringp
+ #'(lambda (begin end value)
+ (while (< begin end)
+ (push (1- begin) intermediate)
+ (incf begin)))
+ #'(lambda (begin end value)
+ (while (< begin end)
+ (push begin intermediate)
+ (incf begin))))
+ do (setq coding-system (check-coding-system coding-system))
+ (multiple-value-bind (encoded ranges)
+ (query-coding-region begin end coding-system)
+ (unless encoded
+ (setq intermediate (list (coding-system-name coding-system)))
+ (map-range-table range-lambda ranges)
+ (push (nreverse intermediate) result)))
+ finally return (or result t)))))
+ (if (stringp begin)
+ (with-temp-buffer
+ (insert begin)
+ (funcall thunk (point-min) (point-max) coding-system-list t))
+ (check-argument-type #'integer-or-marker-p begin)
+ (check-argument-type #'integer-or-marker-p end)
+ (funcall thunk begin end coding-system-list nil))))
+
+;; XEmacs; docstring taken from GNU, international/mule-cmds.el, revision
+;; 1.311, GPLv2.
+(defun encode-coding-char (char coding-system &optional charset)
"Encode CHAR by CODING-SYSTEM and return the resulting string.
-If CODING-SYSTEM can't safely encode CHAR, return nil."
+If CODING-SYSTEM can't safely encode CHAR, return nil.
+The optional third argument CHARSET is, for the moment, ignored."
(check-argument-type #'characterp char)
(multiple-value-bind (succeededp)
(query-coding-string char coding-system)
＠＠ -509,7 +565,9 ＠＠ If CODING-SYSTEM can't safely encode CHA
;; If we're under non-Mule, every XEmacs character can be encoded
;; with every XEmacs coding system.
(fset #'default-query-coding-region
- #'(lambda (&rest ignored) (values t nil)))
+ #'(lambda (&rest ignored)
+ "Stub `query-coding-region' implementation. Always succeeds."
+ (values t nil)))
(unintern 'default-query-coding-region-safe-charset-skip-chars-map))
;;; coding.el ends here
diff -r 80e0588fb42f5f7d5530de33cdc64d6cbafdb026 -r e6a7054a9c3063f1257ae9f66c5dfdef7f02bf4c lisp/unicode.el
--- a/lisp/unicode.el Sun Dec 28 14:55:02 2008 +0000
+++ b/lisp/unicode.el Sun Dec 28 22:51:14 2008 +0000
＠＠ -678,6 +678,7 ＠＠ mapping from the error sequences to the
(loop
for coding-system in (coding-system-list)
+ initially (unless (featurep 'mule) (return))
do (when (eq 'unicode (coding-system-type coding-system))
(coding-system-put coding-system 'query-coding-function
#'unicode-query-coding-region)))
＠＠ -691,7 +692,8 ＠＠ mapping from the error sequences to the
(mapcar #'unintern
'(ccl-encode-to-ucs-2 unicode-error-default-translation-table
unicode-invalid-regexp-range frob-unicode-errors-region
- unicode-error-translate-region)))
+ unicode-error-translate-region unicode-query-coding-region
+ unicode-query-coding-skip-chars-arg)))
;; #### UTF-7 is not yet implemented, and it's tricky to do. There's
;; an implementation in appendix A.1 of the Unicode Standard, Version
diff -r 80e0588fb42f5f7d5530de33cdc64d6cbafdb026 -r e6a7054a9c3063f1257ae9f66c5dfdef7f02bf4c tests/ChangeLog
--- a/tests/ChangeLog Sun Dec 28 14:55:02 2008 +0000
+++ b/tests/ChangeLog Sun Dec 28 22:51:14 2008 +0000
＠＠ -1,3 +1,10 ＠＠ 2008-12-28 Aidan Kehoe <kehoea＠parhasa
+2008-12-28 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/query-coding-tests.el:
+ Add tests for #'unencodable-char-position,
+ #'check-coding-systems-region, #'encode-coding-char. Remove some
+ debugging statements.
+
2008-12-28 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/query-coding-tests.el:
diff -r 80e0588fb42f5f7d5530de33cdc64d6cbafdb026 -r e6a7054a9c3063f1257ae9f66c5dfdef7f02bf4c tests/automated/query-coding-tests.el
--- a/tests/automated/query-coding-tests.el Sun Dec 28 14:55:02 2008 +0000
+++ b/tests/automated/query-coding-tests.el Sun Dec 28 22:51:14 2008 +0000
＠＠ -91,58 +91,31 ＠＠
coding-system))
(multiple-value-bind (query-coding-succeeded query-coding-table)
(query-coding-region (point-min) (point-max) coding-system)
- (q-c-debug "checking type, coding-system, q-c-s, q-c-t %S"
- (list (coding-system-type coding-system)
- coding-system query-coding-succeeded
- query-coding-table))
- (unless (and (eq t query-coding-succeeded)
- (null query-coding-table))
- (q-c-debug "(eq t query-coding-succeeded) %S, (\
-null query-coding-table) %S" (eq t query-coding-succeeded)
- (null query-coding-table)))
- (Assert (eq t query-coding-succeeded))
- (Assert (null query-coding-table)))
- (q-c-debug "testing the ASCII strings for %S" coding-system)
+ (Assert (eq t query-coding-succeeded))
+ (Assert (null query-coding-table)))
(multiple-value-bind (query-coding-succeeded query-coding-table)
(query-coding-string ascii-chars-string coding-system)
- (unless (and (eq t query-coding-succeeded)
- (null query-coding-table))
- (q-c-debug "(eq t query-coding-succeeded) %S, (\
-null query-coding-table) %S" (eq t query-coding-succeeded)
- (null query-coding-table)))
(Assert (eq t query-coding-succeeded))
(Assert (null query-coding-table))))
- (q-c-debug "past the loop through the coding systems")
(delete-region (point-min) (point-max))
;; Check for success from the two Latin-1 coding systems
(insert latin-1-chars-string)
- (q-c-debug "point is now %S" (point))
(multiple-value-bind (query-coding-succeeded query-coding-table)
(query-coding-region (point-min) (point-max) 'iso-8859-1-unix)
(Assert (eq t query-coding-succeeded))
(Assert (null query-coding-table)))
- (q-c-debug "point is now %S" (point))
(multiple-value-bind (query-coding-succeeded query-coding-table)
(query-coding-string (buffer-string) 'iso-8859-1-unix)
(Assert (eq t query-coding-succeeded))
(Assert (null query-coding-table)))
- (q-c-debug "point is now %S" (point))
(multiple-value-bind (query-coding-succeeded query-coding-table)
(query-coding-string (buffer-string) 'iso-latin-1-with-esc-unix)
(Assert (eq t query-coding-succeeded))
(Assert (null query-coding-table)))
- (q-c-debug "point is now %S" (point))
;; Make it fail, check that it fails correctly
(insert (decode-char 'ucs #x20AC)) ;; EURO SIGN
(multiple-value-bind (query-coding-succeeded query-coding-table)
(query-coding-region (point-min) (point-max) 'iso-8859-1-unix)
- (unless (and (null query-coding-succeeded)
- (equal query-coding-table
- #s(range-table type start-closed-end-open data
- ((257 258) t))))
- (q-c-debug "dealing with %S" 'iso-8859-1-unix)
- (q-c-debug "query-coding-succeeded not null, query-coding-table \
-%S" query-coding-table))
(Assert (null query-coding-succeeded))
(Assert (equal query-coding-table
#s(range-table type start-closed-end-open data
＠＠ -153,12 +126,6 ＠＠ null query-coding-table) %S" (eq t query
;; Stupidly, this succeeds. The behaviour is compatible with
;; GNU, though, and we encourage people not to use
;; iso-latin-1-with-esc-unix anyway:
-
- (unless (and query-coding-succeeded
- (null query-coding-table))
- (q-c-debug "dealing with %S" 'iso-latin-1-with-esc-unix)
- (q-c-debug "query-coding-succeeded %S, query-coding-table \
-%S" query-coding-succeeded query-coding-table))
(Assert query-coding-succeeded)
(Assert (null query-coding-table)))
;; Check that it errors correctly.
＠＠ -186,13 +153,6 ＠＠ null query-coding-table) %S" (eq t query
(insert ?\x80)
(multiple-value-bind (query-coding-succeeded query-coding-table)
(query-coding-region (point-min) (point-max) 'windows-1252-unix)
- (unless (and (null query-coding-succeeded)
- (equal query-coding-table
- #s(range-table type start-closed-end-open data
- ((257 258) t))))
- (q-c-debug "dealing with %S" 'windows-1252-unix)
- (q-c-debug "query-coding-succeeded not null, query-coding-table \
-%S" query-coding-table))
(Assert (null query-coding-succeeded))
(Assert (equal query-coding-table
#s(range-table type start-closed-end-open data
＠＠ -212,17 +172,6 ＠＠ null query-coding-table) %S" (eq t query
(Assert (null query-coding-table)))
(multiple-value-bind (query-coding-succeeded query-coding-table)
(query-coding-region (point-min) (point-max) 'windows-1252-unix)
- (unless (and (null query-coding-succeeded)
- (equal query-coding-table
- #s(range-table type start-closed-end-open
- data ((129 131) t (132 133) t
- (139 140) t (141 146) t
- (155 156) t (157 161) t
- (162 170) t (173 176) t
- (178 187) t (189 192) t
- (193 257) t))))
- (q-c-debug "query-coding-succeeded not null, query-coding-table \
-%S" query-coding-table))
(Assert (null query-coding-succeeded))
(Assert (equal query-coding-table
#s(range-table type start-closed-end-open
＠＠ -290,4 +239,68 ＠＠ null query-coding-table) %S" (eq t query
(query-coding-region (point-min) 173 coding-system nil t)
(text-conversion-error
(setq text-conversion-error-signalled t)))
- (Assert (null text-conversion-error-signalled))))))
+ (Assert (null text-conversion-error-signalled)))
+
+ ;; Now to test #'encode-coding-char. Most of the functionality was
+ ;; tested in the query-coding-region tests above, so we don't go into
+ ;; as much detail here.
+ (Assert (null (encode-coding-char
+ (decode-char 'ucs #x20ac) 'iso-8859-1)))
+ (Assert (equal "\x80" (encode-coding-char
+ (decode-char 'ucs #x20ac) 'windows-1252)))
+ (delete-region (point-min) (point-max))
+
+ ;; And #'unencodable-char-position.
+ (insert latin-1-chars-string)
+ (insert (decode-char 'ucs #x20ac))
+ (Assert (= 257 (unencodable-char-position (point-min) (point-max)
+ 'iso-8859-1)))
+ (Assert (equal '(257) (unencodable-char-position (point-min) (point-max)
+ 'iso-8859-1 1)))
+ ;; Compatiblity, sigh:
+ (Assert (equal '(257) (unencodable-char-position (point-min) (point-max)
+ 'iso-8859-1 0)))
+ (dotimes (i 6) (insert (decode-char 'ucs #x20ac)))
+ ;; Check if it stops at one:
+ (Assert (equal '(257) (unencodable-char-position (point-min) (point-max)
+ 'iso-8859-1 1)))
+ ;; Check if it stops at four:
+ (Assert (equal '(260 259 258 257)
+ (unencodable-char-position (point-min) (point-max)
+ 'iso-8859-1 4)))
+ ;; Check whether it stops at seven:
+ (Assert (equal '(263 262 261 260 259 258 257)
+ (unencodable-char-position (point-min) (point-max)
+ 'iso-8859-1 7)))
+ ;; Check that it still stops at seven:
+ (Assert (equal '(263 262 261 260 259 258 257)
+ (unencodable-char-position (point-min) (point-max)
+ 'iso-8859-1 2000)))
+ ;; Now, #'check-coding-systems-region.
+ ;; UTF-8 should certainly be able to encode these characters:
+ (Assert (eq t (check-coding-systems-region (point-min) (point-max)
+ '(utf-8))))
+ (Assert (equal '((iso-8859-1 257 258 259 260 261 262 263)
+ (windows-1252 129 131 132 133 134 135 136 137 138 139
+ 140 141 143 146 147 148 149 150 151 152
+ 153 154 155 156 157 159 160))
+ (sort
+ (check-coding-systems-region (point-min) (point-max)
+ '(utf-8 iso-8859-1
+ windows-1252))
+ ;; (The sort is to make the algorithm irrelevant.)
+ #'(lambda (left right)
+ (string< (car left) (car right))))))
+ ;; Ensure that the indices are all decreased by one when passed a
+ ;; string:
+ (Assert (equal '((iso-8859-1 256 257 258 259 260 261 262)
+ (windows-1252 128 130 131 132 133 134 135 136 137 138
+ 139 140 142 145 146 147 148 149 150 151
+ 152 153 154 155 156 158 159))
+ (sort
+ (check-coding-systems-region (buffer-string) nil
+ '(utf-8 iso-8859-1
+ windows-1252))
+ #'(lambda (left right)
+ (string< (car left) (car right)))))))))
+
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Add #'query-coding-region tests; do the work necessary to get them running.
16 years, 2 months
Aidan Kehoe
Aidan Kehoe
changeset: 4607:1d74a1d115ee2c6484333b2d37dd5fce9fe05ad6
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sun Dec 28 14:46:24 2008 +0000
files: lisp/ChangeLog lisp/code-init.el lisp/coding.el lisp/mule/chinese.el lisp/mule/devanagari.el lisp/mule/hebrew.el lisp/mule/iso-with-esc.el lisp/mule/japanese.el lisp/mule/korean.el lisp/mule/latin.el lisp/mule/mule-coding.el lisp/mule/thai-xtis.el lisp/unicode.el src/ChangeLog src/coding-system-slots.h src/file-coding.c src/file-coding.h tests/ChangeLog tests/automated/query-coding-tests.el
description:
Add #'query-coding-region tests; do the work necessary to get them running.
lisp/ChangeLog addition:
2008-12-28 Aidan Kehoe <kehoea(a)parhasard.net>
* coding.el (default-query-coding-region):
Declare using defun*, so we can #'return-from to it on
encountering a safe-charsets value of t. Comment out a few
debug messages.
(query-coding-region):
Correct the docstring, it deals with a region, not a string.
(unencodable-char-position):
Correct the implementation for non-nil COUNT, special-case a zero
value for count, treat it as one. Don't rely on dynamic scope when
calling the main lambda.
* unicode.el (unicode-query-coding-region):
Comment out some debug messages here.
* mule/mule-coding.el (8-bit-fixed-query-coding-region):
Comment out some debug messages here.
* code-init.el (raw-text):
Add a safe-charsets property to this coding system.
* mule/korean.el (iso-2022-int-1):
* mule/korean.el (euc-kr):
* mule/korean.el (iso-2022-kr):
Add safe-charsets properties for these coding systems.
* mule/japanese.el (iso-2022-jp):
* mule/japanese.el (jis7):
* mule/japanese.el (jis8):
* mule/japanese.el (shift-jis):
* mule/japanese.el (iso-2022-jp-1978-irv):
* mule/japanese.el (euc-jp):
Add safe-charsets properties for all these coding systems.
* mule/iso-with-esc.el:
Add safe-charsets properties to all the coding systems in
here. Comment on the downside of a safe-charsets value of t for
iso-latin-1-with-esc.
* mule/hebrew.el (ctext-hebrew):
Add a safe-charsets property for this coding system.
* mule/devanagari.el (in-is13194-devanagari):
Add a safe-charsets property for this coding system.
* mule/chinese.el (cn-gb-2312):
* mule/chinese.el (hz-gb-2312):
* mule/chinese.el (big5):
Add safe-charsets properties for these coding systems.
* mule/latin.el (iso-8859-14):
Add an implementation for this, using #'make-8-bit-coding-system.
* mule/mule-coding.el (ctext):
* mule/mule-coding.el (iso-2022-8bit-ss2):
* mule/mule-coding.el (iso-2022-7bit-ss2):
* mule/mule-coding.el (iso-2022-jp-2):
* mule/mule-coding.el (iso-2022-7bit):
* mule/mule-coding.el (iso-2022-8):
* mule/mule-coding.el (escape-quoted):
* mule/mule-coding.el (iso-2022-lock):
Add safe-charsets properties for all these coding systems.
src/ChangeLog addition:
2008-12-28 Aidan Kehoe <kehoea(a)parhasard.net>
* file-coding.c (Fmake_coding_system):
Document our use of the safe-chars and safe-charsets properties,
and the differences compared to GNU.
(make_coding_system_1): Don't drop the safe-chars and
safe-charsets properties.
(Fcoding_system_property): Return the safe-chars and safe-charsets
properties when asked for them.
* file-coding.h (CODING_SYSTEM_SAFE_CHARSETS):
* coding-system-slots.h:
Make the safe-chars and safe-charsets slots available in these
headers.
tests/ChangeLog addition:
2008-12-28 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/query-coding-tests.el:
New file, testing the functionality of #'query-coding-region and
#'query-coding-string.
diff -r 84d618b355f5fccd22634d6415a59a9339281ad4 -r 1d74a1d115ee2c6484333b2d37dd5fce9fe05ad6 lisp/ChangeLog
--- a/lisp/ChangeLog Sat Aug 09 13:15:09 2008 +0200
+++ b/lisp/ChangeLog Sun Dec 28 14:46:24 2008 +0000
＠＠ -1,3 +1,57 ＠＠ 2008-08-09 Aidan Kehoe <kehoea＠parhasa
+2008-12-28 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * coding.el (default-query-coding-region):
+ Declare using defun*, so we can #'return-from to it on
+ encountering a safe-charsets value of t. Comment out a few
+ debug messages.
+ (query-coding-region):
+ Correct the docstring, it deals with a region, not a string.
+ (unencodable-char-position):
+ Correct the implementation for non-nil COUNT, special-case a zero
+ value for count, treat it as one. Don't rely on dynamic scope when
+ calling the main lambda.
+ * unicode.el (unicode-query-coding-region):
+ Comment out some debug messages here.
+ * mule/mule-coding.el (8-bit-fixed-query-coding-region):
+ Comment out some debug messages here.
+
+ * code-init.el (raw-text):
+ Add a safe-charsets property to this coding system.
+ * mule/korean.el (iso-2022-int-1):
+ * mule/korean.el (euc-kr):
+ * mule/korean.el (iso-2022-kr):
+ Add safe-charsets properties for these coding systems.
+ * mule/japanese.el (iso-2022-jp):
+ * mule/japanese.el (jis7):
+ * mule/japanese.el (jis8):
+ * mule/japanese.el (shift-jis):
+ * mule/japanese.el (iso-2022-jp-1978-irv):
+ * mule/japanese.el (euc-jp):
+ Add safe-charsets properties for all these coding systems.
+ * mule/iso-with-esc.el:
+ Add safe-charsets properties to all the coding systems in
+ here. Comment on the downside of a safe-charsets value of t for
+ iso-latin-1-with-esc.
+ * mule/hebrew.el (ctext-hebrew):
+ Add a safe-charsets property for this coding system.
+ * mule/devanagari.el (in-is13194-devanagari):
+ Add a safe-charsets property for this coding system.
+ * mule/chinese.el (cn-gb-2312):
+ * mule/chinese.el (hz-gb-2312):
+ * mule/chinese.el (big5):
+ Add safe-charsets properties for these coding systems.
+ * mule/latin.el (iso-8859-14):
+ Add an implementation for this, using #'make-8-bit-coding-system.
+ * mule/mule-coding.el (ctext):
+ * mule/mule-coding.el (iso-2022-8bit-ss2):
+ * mule/mule-coding.el (iso-2022-7bit-ss2):
+ * mule/mule-coding.el (iso-2022-jp-2):
+ * mule/mule-coding.el (iso-2022-7bit):
+ * mule/mule-coding.el (iso-2022-8):
+ * mule/mule-coding.el (escape-quoted):
+ * mule/mule-coding.el (iso-2022-lock):
+ Add safe-charsets properties for all these coding systems.
+
2008-08-09 Aidan Kehoe <kehoea(a)parhasard.net>
* mule/mule-coding.el (make-8-bit-coding-system):
diff -r 84d618b355f5fccd22634d6415a59a9339281ad4 -r 1d74a1d115ee2c6484333b2d37dd5fce9fe05ad6 lisp/code-init.el
--- a/lisp/code-init.el Sat Aug 09 13:15:09 2008 +0200
+++ b/lisp/code-init.el Sun Dec 28 14:46:24 2008 +0000
＠＠ -394,4 +394,6 ＠＠ For more information, see `reset-coding-
(reset-language-environment)
+(coding-system-put 'raw-text 'safe-charsets '(ascii control-1 latin-iso8859-1))
+
;;; code-init.el ends here
diff -r 84d618b355f5fccd22634d6415a59a9339281ad4 -r 1d74a1d115ee2c6484333b2d37dd5fce9fe05ad6 lisp/coding.el
--- a/lisp/coding.el Sat Aug 09 13:15:09 2008 +0200
+++ b/lisp/coding.el Sun Dec 28 14:46:24 2008 +0000
＠＠ -300,8 +300,8 ＠＠ this function has been called, this will
(extent-face extent))
(delete-extent extent))) buffer begin end))
-(defun default-query-coding-region (begin end coding-system
- &optional buffer errorp highlightp)
+(defun* default-query-coding-region (begin end coding-system
+ &optional buffer errorp highlightp)
"The default `query-coding-region' implementation.
Uses the `safe-charsets' and `safe-chars' coding system properties.
＠＠ -324,8 +324,11 ＠＠ addition, characters that can be safely
(gethash safe-charsets
default-query-coding-region-safe-charset-skip-chars-map))
(ranges (make-range-table))
- fail-range-start fail-range-end previous-fail char-after
+ fail-range-start fail-range-end char-after
looking-at-arg failed extent)
+ ;; Coding systems with a value of t for safe-charsets support everything.
+ (when (eq t safe-charsets)
+ (return-from default-query-coding-region (values t nil)))
(unless skip-chars-arg
(setq skip-chars-arg
(puthash safe-charsets
＠＠ -355,9 +358,9 ＠＠ addition, characters that can be safely
(goto-char begin buffer)
(skip-chars-forward skip-chars-arg end buffer)
(while (< (point buffer) end)
- (message
- "fail-range-start is %S, previous-fail %S, point is %S, end is %S"
- fail-range-start previous-fail (point buffer) end)
+ ; (message
+ ; "fail-range-start is %S, point is %S, end is %S"
+ ; fail-range-start (point buffer) end)
(setq char-after (char-after (point buffer) buffer)
fail-range-start (point buffer))
(while (and
＠＠ -411,8 +414,8 ＠＠ region using `query-coding-warning-face'
This function returns a list; the intention is that callers use
`multiple-value-bind' or the related CL multiple value functions to deal
-with it. The first element is `t' if the string can be encoded using
-CODING-SYSTEM, or `nil' if not. The second element is `nil' if the string
+with it. The first element is `t' if the region can be encoded using
+CODING-SYSTEM, or `nil' if not. The second element is `nil' if the region
can be encoded using CODING-SYSTEM; otherwise, it is a range table
describing the positions of the unencodable characters. See
`make-range-table'."
＠＠ -456,33 +459,42 ＠＠ If optional 5th argument STRING is non-n
If optional 5th argument STRING is non-nil, it is a string to search
for un-encodable characters. In that case, START and END are indexes
in the string."
- (flet ((thunk ()
- (multiple-value-bind (result ranges)
- (query-coding-region start end coding-system)
- (if result
- ;; If query-coding-region thinks the entire region is
- ;; encodable, result will be t, and the thunk should
- ;; return nil, because there are no unencodable
- ;; positions in the region.
- nil
- (if count
- (block counted
- (map-range-table
- #'(lambda (begin end value)
- (while (and (<= begin end) (<= begin count))
- (push begin result)
- (incf begin))
- (if (> begin count) (return-from counted)))
- ranges))
- (map-range-table
- #'(lambda (begin end value)
- (while (<= begin end)
- (push begin result)
- (incf begin))) ranges))
- result))))
+ (let ((thunk
+ #'(lambda (start end coding-system &optional count)
+ (multiple-value-bind (result ranges)
+ (query-coding-region start end coding-system)
+ (if result
+ nil
+ (block worked-it-all-out
+ (if count
+ (map-range-table
+ #'(lambda (begin end value)
+ (while (and (< begin end)
+ (< (length result) count))
+ (push begin result)
+ (incf begin))
+ (when (= (length result) count)
+ (return-from worked-it-all-out result)))
+ ranges)
+ (map-range-table
+ #'(lambda (begin end value)
+ (return-from worked-it-all-out begin))
+ ranges))
+ (assert (not (null count)) t
+ "We should never reach this point with null COUNT.")
+ result))))))
+ (check-argument-type #'integer-or-marker-p start)
+ (check-argument-type #'integer-or-marker-p end)
+ (check-coding-system coding-system)
+ (and count (check-argument-type #'natnump count)
+ ;; Special-case zero, sigh.
+ (if (zerop count) (setq count 1)))
+ (and string (check-argument-type #'stringp string))
(if string
- (with-temp-buffer (insert string) (thunk))
- (thunk))))
+ (with-temp-buffer
+ (insert string)
+ (funcall thunk start end coding-system count))
+ (funcall thunk start end coding-system count))))
(defun encode-coding-char (char coding-system)
"Encode CHAR by CODING-SYSTEM and return the resulting string.
diff -r 84d618b355f5fccd22634d6415a59a9339281ad4 -r 1d74a1d115ee2c6484333b2d37dd5fce9fe05ad6 lisp/mule/chinese.el
--- a/lisp/mule/chinese.el Sat Aug 09 13:15:09 2008 +0200
+++ b/lisp/mule/chinese.el Sun Dec 28 14:46:24 2008 +0000
＠＠ -157,6 +157,7 ＠＠
charset-g1 chinese-gb2312
charset-g2 chinese-sisheng
charset-g3 t
+ safe-charsets (ascii chinese-gb2312 chinese-sisheng)
mnemonic "Zh-GB/EUC"
documentation
"Chinese EUC (Extended Unix Code), the standard Chinese encoding on Unix.
＠＠ -190,6 +191,7 ＠＠ G2: Sisheng (PinYin - ZhuYin)"
"Hz/ZW (Chinese)"
'(mnemonic "Zh-GB/Hz"
eol-type lf
+ safe-charsets (ascii chinese-gb2312)
post-read-conversion post-read-decode-hz
pre-write-conversion pre-write-encode-hz
documentation "Hz/ZW 7-bit encoding for Chinese GB2312 (MIME:HZ-GB-2312)"
＠＠ -259,6 +261,7 ＠＠ Uses the GB2312 character set."))
'big5 'big5
"Big5"
'(mnemonic "Zh/Big5"
+ safe-charsets (ascii chinese-big5-1 chinese-big5-2)
documentation
"A non-modal encoding formed by five large Taiwanese companies
\(hence \"Big5\") to produce a character set and encoding for
diff -r 84d618b355f5fccd22634d6415a59a9339281ad4 -r 1d74a1d115ee2c6484333b2d37dd5fce9fe05ad6 lisp/mule/devanagari.el
--- a/lisp/mule/devanagari.el Sat Aug 09 13:15:09 2008 +0200
+++ b/lisp/mule/devanagari.el Sun Dec 28 14:46:24 2008 +0000
＠＠ -50,6 +50,7 ＠＠
charset-g2 t
charset-g3 t
mnemonic "In-13194"
+ safe-charsets (ascii indian-is13194)
documentation
"8-bit encoding for ASCII (MSB=0) and IS13194-Devanagari (MSB=1)"
safe-charsets (ascii indian-is13194)
diff -r 84d618b355f5fccd22634d6415a59a9339281ad4 -r 1d74a1d115ee2c6484333b2d37dd5fce9fe05ad6 lisp/mule/hebrew.el
--- a/lisp/mule/hebrew.el Sat Aug 09 13:15:09 2008 +0200
+++ b/lisp/mule/hebrew.el Sun Dec 28 14:46:24 2008 +0000
＠＠ -92,6 +92,7 ＠＠
charset-g1 hebrew-iso8859-8
charset-g2 t
charset-g3 t
+ safe-charsets (ascii hebrew-iso8859-8)
mnemonic "CText/Hbrw"
))
diff -r 84d618b355f5fccd22634d6415a59a9339281ad4 -r 1d74a1d115ee2c6484333b2d37dd5fce9fe05ad6 lisp/mule/iso-with-esc.el
--- a/lisp/mule/iso-with-esc.el Sat Aug 09 13:15:09 2008 +0200
+++ b/lisp/mule/iso-with-esc.el Sun Dec 28 14:46:24 2008 +0000
＠＠ -28,6 +28,10 ＠＠
;;; Code:
+;; It is not particularly reasonable that iso-latin-1-with-esc has a
+;; value of t for the safe-charsets property. We discourage its use,
+;; though, and this behaviour is compatible with GNU.
+
;;;###autoload
(define-coding-system-alias 'iso-latin-1-with-esc 'iso-2022-8)
＠＠ -38,6 +42,7 ＠＠
charset-g1 latin-iso8859-2
charset-g2 t
charset-g3 t
+ safe-charsets (ascii latin-iso8859-2)
mnemonic "MIME/Ltn-2"))
;;;###autoload
＠＠ -47,6 +52,7 ＠＠
charset-g1 latin-iso8859-3
charset-g2 t
charset-g3 t
+ safe-charsets (ascii latin-iso8859-3)
mnemonic "MIME/Ltn-3"))
;;;###autoload
＠＠ -56,6 +62,7 ＠＠
charset-g1 latin-iso8859-4
charset-g2 t
charset-g3 t
+ safe-charsets (ascii latin-iso8859-4)
mnemonic "MIME/Ltn-4"))
;;;###autoload
＠＠ -63,6 +70,7 ＠＠
'iso-latin-9-with-esc 'iso2022
"ISO 4873 conforming 8-bit code (ASCII + Latin 9; aka Latin-1 with Euro)"
'(mnemonic "MIME/Ltn-9" ; bletch
+ safe-charsets (ascii latin-iso8859-15)
eol-type nil
charset-g0 ascii
charset-g1 latin-iso8859-15
＠＠ -76,6 +84,7 ＠＠
charset-g1 latin-iso8859-9
charset-g2 t
charset-g3 t
+ safe-charsets (ascii latin-iso8859-9)
mnemonic "MIME/Ltn-5"))
;;;###autoload
＠＠ -86,6 +95,7 ＠＠
charset-g1 cyrillic-iso8859-5
charset-g2 t
charset-g3 t
+ safe-charsets (ascii cyrillic-iso8859-5)
mnemonic "ISO8/Cyr"))
;;;###autoload
＠＠ -97,6 +107,7 ＠＠
charset-g2 t
charset-g3 t
no-iso6429 t
+ safe-charsets (ascii hebrew-iso8859-8)
mnemonic "MIME/Hbrw"))
;;;###autoload
＠＠ -106,6 +117,7 ＠＠
charset-g1 greek-iso8859-7
charset-g2 t
charset-g3 t
+ safe-charsets (ascii greek-iso8859-7)
mnemonic "Grk"))
;; ISO 8859-6 is such a useless character set that it seems a waste of
＠＠ -201,5 +213,6 ＠＠
charset-g2 t
charset-g3 t
no-iso6429 t
+ safe-charsets (ascii arabic-iso8859-6)
mnemonic "MIME/Arbc"))
diff -r 84d618b355f5fccd22634d6415a59a9339281ad4 -r 1d74a1d115ee2c6484333b2d37dd5fce9fe05ad6 lisp/mule/japanese.el
--- a/lisp/mule/japanese.el Sat Aug 09 13:15:09 2008 +0200
+++ b/lisp/mule/japanese.el Sun Dec 28 14:46:24 2008 +0000
＠＠ -195,6 +195,8 ＠＠
seven t
input-charset-conversion ((latin-jisx0201 ascii)
(japanese-jisx0208-1978 japanese-jisx0208))
+ safe-charsets (ascii japanese-jisx0208-1978 japanese-jisx0208
+ latin-jisx0201 japanese-jisx0212 katakana-jisx0201)
mnemonic "MULE/7bit"
documentation
"Coding system used for communication with mail and news in Japan."
＠＠ -210,6 +212,7 ＠＠
lock-shift t
input-charset-conversion ((latin-jisx0201 ascii)
(japanese-jisx0208-1978 japanese-jisx0208))
+ safe-charsets (latin-jisx0201 ascii japanese-jisx0208-1978 japanese-jisx0208)
mnemonic "JIS7"
documentation
"Old JIS 7-bit encoding; mostly superseded by ISO-2022-JP.
＠＠ -224,6 +227,8 ＠＠ Uses locking-shift (SI/SO) to select hal
short t
input-charset-conversion ((latin-jisx0201 ascii)
(japanese-jisx0208-1978 japanese-jisx0208))
+ safe-charsets (latin-jisx0201 ascii japanese-jisx0208-1978
+ japanese-jisx0208)
mnemonic "JIS8"
documentation
"Old JIS 8-bit encoding; mostly superseded by ISO-2022-JP.
＠＠ -261,6 +266,8 ＠＠ Uses high bytes for half-width katakana.
"Shift-JIS"
'(mnemonic "Ja/SJIS"
documentation "The standard Japanese encoding in MS Windows."
+ safe-charsets (ascii japanese-jisx0208 japanese-jisx0208-1978
+ latin-jisx0201 katakana-jisx0201)
))
;; A former name?
＠＠ -286,6 +293,8 ＠＠ Uses high bytes for half-width katakana.
seven t
output-charset-conversion ((ascii latin-jisx0201)
(japanese-jisx0208 japanese-jisx0208-1978))
+ safe-charsets (ascii latin-jisx0201 japanese-jisx0208
+ japanese-jisx0208-1978)
documentation
"This is a coding system used for old JIS terminals. It's an ISO
2022 based 7-bit encoding for Japanese JISX0208-1978 and JISX0201-Roman."
＠＠ -314,6 +323,7 ＠＠ 2022 based 7-bit encoding for Japanese J
charset-g1 japanese-jisx0208
charset-g2 katakana-jisx0201
charset-g3 japanese-jisx0212
+ safe-charsets (ascii japanese-jisx0208 katakana-jisx0201 japanese-jisx0212)
short t
mnemonic "Ja/EUC"
documentation
diff -r 84d618b355f5fccd22634d6415a59a9339281ad4 -r 1d74a1d115ee2c6484333b2d37dd5fce9fe05ad6 lisp/mule/korean.el
--- a/lisp/mule/korean.el Sat Aug 09 13:15:09 2008 +0200
+++ b/lisp/mule/korean.el Sun Dec 28 14:46:24 2008 +0000
＠＠ -57,6 +57,7 ＠＠
"ISO-2022-INT-1 (Korean)"
'(charset-g0 ascii
charset-g1 korean-ksc5601
+ safe-charsets (ascii korean-ksc5601)
short t
seven t
lock-shift t
＠＠ -92,6 +93,7 ＠＠
'(charset-g0 ascii
charset-g1 korean-ksc5601
mnemonic "ko/EUC"
+ safe-charsets (ascii korean-ksc5601)
documentation
"Korean EUC (Extended Unix Code), the standard Korean encoding on Unix.
This follows the same overall EUC principles (see the description under
＠＠ -122,6 +124,7 ＠＠ G1: Korean-KSC5601"
force-g1-on-output t
seven t
lock-shift t
+ safe-charsets (ascii korean-ksc5601)
mnemonic "Ko/7bit"
documentation "Coding-System used for communication with mail in Korea."
eol-type lf))
diff -r 84d618b355f5fccd22634d6415a59a9339281ad4 -r 1d74a1d115ee2c6484333b2d37dd5fce9fe05ad6 lisp/mule/latin.el
--- a/lisp/mule/latin.el Sat Aug 09 13:15:09 2008 +0200
+++ b/lisp/mule/latin.el Sun Dec 28 14:46:24 2008 +0000
＠＠ -630,6 +630,43 ＠＠ See also `iso-8859-2' and `window-1252'
(#xDC #xFC) ;; U WITH DIAERESIS
(#xDD #xFD) ;; Y WITH ACUTE
(#xDE #xFE))) ;; Y WITH CIRCUMFLEX
+
+(make-8-bit-coding-system
+ 'iso-8859-14
+ '((#xA1 ?\u1E02) ;; LATIN CAPITAL LETTER B WITH DOT ABOVE
+ (#xA2 ?\u1E03) ;; LATIN SMALL LETTER B WITH DOT ABOVE
+ (#xA4 ?\u010A) ;; LATIN CAPITAL LETTER C WITH DOT ABOVE
+ (#xA5 ?\u010B) ;; LATIN SMALL LETTER C WITH DOT ABOVE
+ (#xA6 ?\u1E0A) ;; LATIN CAPITAL LETTER D WITH DOT ABOVE
+ (#xA8 ?\u1E80) ;; LATIN CAPITAL LETTER W WITH GRAVE
+ (#xAA ?\u1E82) ;; LATIN CAPITAL LETTER W WITH ACUTE
+ (#xAB ?\u1E0B) ;; LATIN SMALL LETTER D WITH DOT ABOVE
+ (#xAC ?\u1EF2) ;; LATIN CAPITAL LETTER Y WITH GRAVE
+ (#xAF ?\u0178) ;; LATIN CAPITAL LETTER Y WITH DIAERESIS
+ (#xB0 ?\u1E1E) ;; LATIN CAPITAL LETTER F WITH DOT ABOVE
+ (#xB1 ?\u1E1F) ;; LATIN SMALL LETTER F WITH DOT ABOVE
+ (#xB2 ?\u0120) ;; LATIN CAPITAL LETTER G WITH DOT ABOVE
+ (#xB3 ?\u0121) ;; LATIN SMALL LETTER G WITH DOT ABOVE
+ (#xB4 ?\u1E40) ;; LATIN CAPITAL LETTER M WITH DOT ABOVE
+ (#xB5 ?\u1E41) ;; LATIN SMALL LETTER M WITH DOT ABOVE
+ (#xB7 ?\u1E56) ;; LATIN CAPITAL LETTER P WITH DOT ABOVE
+ (#xB8 ?\u1E81) ;; LATIN SMALL LETTER W WITH GRAVE
+ (#xB9 ?\u1E57) ;; LATIN SMALL LETTER P WITH DOT ABOVE
+ (#xBA ?\u1E83) ;; LATIN SMALL LETTER W WITH ACUTE
+ (#xBB ?\u1E60) ;; LATIN CAPITAL LETTER S WITH DOT ABOVE
+ (#xBC ?\u1EF3) ;; LATIN SMALL LETTER Y WITH GRAVE
+ (#xBD ?\u1E84) ;; LATIN CAPITAL LETTER W WITH DIAERESIS
+ (#xBE ?\u1E85) ;; LATIN SMALL LETTER W WITH DIAERESIS
+ (#xBF ?\u1E61) ;; LATIN SMALL LETTER S WITH DOT ABOVE
+ (#xD0 ?\u0174) ;; LATIN CAPITAL LETTER W WITH CIRCUMFLEX
+ (#xD7 ?\u1E6A) ;; LATIN CAPITAL LETTER T WITH DOT ABOVE
+ (#xDE ?\u0176) ;; LATIN CAPITAL LETTER Y WITH CIRCUMFLEX
+ (#xF0 ?\u0175) ;; LATIN SMALL LETTER W WITH CIRCUMFLEX
+ (#xF7 ?\u1E6B) ;; LATIN SMALL LETTER T WITH DOT ABOVE
+ (#xFE ?\u0177)) ;; LATIN SMALL LETTER Y WITH CIRCUMFLEX
+ "ISO-8859-14 (Latin-8)"
+ '(mnemonic "Latin 8"
+ aliases (iso-latin-8 latin-8)))
;; The syntax table code for ISO 8859-15 and ISO 8859-16 requires that the
diff -r 84d618b355f5fccd22634d6415a59a9339281ad4 -r 1d74a1d115ee2c6484333b2d37dd5fce9fe05ad6 lisp/mule/mule-coding.el
--- a/lisp/mule/mule-coding.el Sat Aug 09 13:15:09 2008 +0200
+++ b/lisp/mule/mule-coding.el Sun Dec 28 14:46:24 2008 +0000
＠＠ -104,6 +104,7 ＠＠ The allowable range of REGISTER is 0 thr
'(charset-g0 ascii
charset-g1 latin-iso8859-1
eol-type nil
+ safe-charsets t ;; Reasonable
mnemonic "CText"))
(make-coding-system
＠＠ -113,6 +114,9 ＠＠ The allowable range of REGISTER is 0 thr
charset-g1 latin-iso8859-1
charset-g2 t ;; unspecified but can be used later.
short t
+ safe-charsets (ascii katakana-jisx0201 japanese-jisx0208-1978
+ japanese-jisx0208 japanese-jisx0212 japanese-jisx0213-1
+ japanese-jisx0213-2)
mnemonic "ISO8/SS"
documentation "ISO 2022 based 8-bit encoding using SS2 for 96-charset"
))
＠＠ -124,6 +128,7 ＠＠ The allowable range of REGISTER is 0 thr
charset-g2 t ;; unspecified but can be used later.
seven t
short t
+ safe-charsets t
mnemonic "ISO7/SS"
documentation "ISO 2022 based 7-bit encoding using SS2 for 96-charset"
eol-type nil))
＠＠ -136,6 +141,7 ＠＠ The allowable range of REGISTER is 0 thr
charset-g2 t ;; unspecified but can be used later.
seven t
short t
+ safe-charsets t
mnemonic "ISO7/SS"
eol-type nil))
＠＠ -145,6 +151,7 ＠＠ The allowable range of REGISTER is 0 thr
'(charset-g0 ascii
seven t
short t
+ safe-charsets t
mnemonic "ISO7"
documentation "ISO-2022-based 7-bit encoding using only G0"
))
＠＠ -158,6 +165,7 ＠＠ The allowable range of REGISTER is 0 thr
'(charset-g0 ascii
charset-g1 latin-iso8859-1
short t
+ safe-charsets t
mnemonic "ISO8"
documentation "ISO-2022 eight-bit coding system. No single-shift or locking-shift."
))
＠＠ -169,6 +177,7 ＠＠ The allowable range of REGISTER is 0 thr
charset-g1 latin-iso8859-1
eol-type lf
escape-quoted t
+ safe-charsets t
mnemonic "ESC/Quot"
documentation "ISO-2022 eight-bit coding system with escape quoting; used for .ELC files."
))
＠＠ -180,6 +189,7 ＠＠ The allowable range of REGISTER is 0 thr
charset-g1 t ;; unspecified but can be used later.
seven t
lock-shift t
+ safe-charsets t
mnemonic "ISO7/Lock"
documentation "ISO-2022 coding system using Locking-Shift for 96-charset."
))
＠＠ -574,14 +584,14 ＠＠ See that the documentation of `query-cod
(goto-char begin buffer)
(skip-chars-forward skip-chars-arg end buffer)
(while (< (point buffer) end)
- (message
- "fail-range-start is %S, previous-fail %S, point is %S, end is %S"
- fail-range-start previous-fail (point buffer) end)
+ ; (message
+ ; "fail-range-start is %S, previous-fail %S, point is %S, end is %S"
+ ; fail-range-start previous-fail (point buffer) end)
(setq char-after (char-after (point buffer) buffer)
fail-range-start (point buffer))
- (message "arguments are %S %S"
- (< (point buffer) end)
- (not (gethash (encode-char char-after 'ucs) from-unicode)))
+ ; (message "arguments are %S %S"
+ ; (< (point buffer) end)
+ ; (not (gethash (encode-char char-after 'ucs) from-unicode)))
(while (and
(< (point buffer) end)
(not (gethash (encode-char char-after 'ucs) from-unicode)))
＠＠ -593,7 +603,7 ＠＠ See that the documentation of `query-cod
;; system; check the characters past it.
(forward-char 1 buffer)
;; The character actually failed.
- (message "past the move through, point now %S" (point buffer))
+ ; (message "past the move through, point now %S" (point buffer))
(when errorp
(error 'text-conversion-error
(format "Cannot encode %s using coding system"
＠＠ -608,12 +618,12 ＠＠ See that the documentation of `query-cod
(point-max buffer)))
t ranges)
(when highlightp
- (message "highlighting")
+ ; (message "highlighting")
(setq extent (make-extent fail-range-start fail-range-end buffer))
(set-extent-priority extent (+ mouse-highlight-priority 2))
(set-extent-face extent 'query-coding-warning-face))
(skip-chars-forward skip-chars-arg end buffer)))
- (message "about to give the result, ranges %S" ranges)
+ ; (message "about to give the result, ranges %S" ranges)
(if failed
(values nil ranges)
(values t nil)))))
diff -r 84d618b355f5fccd22634d6415a59a9339281ad4 -r 1d74a1d115ee2c6484333b2d37dd5fce9fe05ad6 lisp/mule/thai-xtis.el
--- a/lisp/mule/thai-xtis.el Sat Aug 09 13:15:09 2008 +0200
+++ b/lisp/mule/thai-xtis.el Sun Dec 28 14:46:24 2008 +0000
＠＠ -355,6 +355,7 ＠＠
`(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))
(make-coding-system
diff -r 84d618b355f5fccd22634d6415a59a9339281ad4 -r 1d74a1d115ee2c6484333b2d37dd5fce9fe05ad6 lisp/unicode.el
--- a/lisp/unicode.el Sat Aug 09 13:15:09 2008 +0200
+++ b/lisp/unicode.el Sun Dec 28 14:46:24 2008 +0000
＠＠ -626,7 +626,7 ＠＠ mapping from the error sequences to the
(let* ((skip-chars-arg unicode-query-coding-skip-chars-arg)
(ranges (make-range-table))
(looking-at-arg (concat "[" skip-chars-arg "]"))
- fail-range-start fail-range-end previous-fail char-after failed
+ fail-range-start fail-range-end char-after failed
extent)
(save-excursion
(when highlightp
＠＠ -638,8 +638,8 ＠＠ mapping from the error sequences to the
(skip-chars-forward skip-chars-arg end buffer)
(while (< (point buffer) end)
; (message
-; "fail-range-start is %S, previous-fail %S, point is %S, end is %S"
-; fail-range-start previous-fail (point buffer) end)
+; "fail-range-start is %S, point is %S, end is %S"
+; fail-range-start (point buffer) end)
(setq char-after (char-after (point buffer) buffer)
fail-range-start (point buffer))
(while (and
＠＠ -647,7 +647,6 ＠＠ mapping from the error sequences to the
(not (looking-at looking-at-arg))
(= -1 (char-to-unicode char-after)))
(forward-char 1 buffer)
- (message "what?!?")
(setq char-after (char-after (point buffer) buffer)
failed t))
(if (= fail-range-start (point buffer))
diff -r 84d618b355f5fccd22634d6415a59a9339281ad4 -r 1d74a1d115ee2c6484333b2d37dd5fce9fe05ad6 src/ChangeLog
--- a/src/ChangeLog Sat Aug 09 13:15:09 2008 +0200
+++ b/src/ChangeLog Sun Dec 28 14:46:24 2008 +0000
＠＠ -1,3 +1,17 ＠＠ 2008-08-05 Aidan Kehoe <kehoea＠parhasa
+2008-12-28 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * file-coding.c (Fmake_coding_system):
+ Document our use of the safe-chars and safe-charsets properties,
+ and the differences compared to GNU.
+ (make_coding_system_1): Don't drop the safe-chars and
+ safe-charsets properties.
+ (Fcoding_system_property): Return the safe-chars and safe-charsets
+ properties when asked for them.
+ * file-coding.h (CODING_SYSTEM_SAFE_CHARSETS):
+ * coding-system-slots.h:
+ Make the safe-chars and safe-charsets slots available in these
+ headers.
+
2008-08-05 Aidan Kehoe <kehoea(a)parhasard.net>
* mule-charset.c (complex_vars_of_mule_charset):
diff -r 84d618b355f5fccd22634d6415a59a9339281ad4 -r 1d74a1d115ee2c6484333b2d37dd5fce9fe05ad6 src/coding-system-slots.h
--- a/src/coding-system-slots.h Sat Aug 09 13:15:09 2008 +0200
+++ b/src/coding-system-slots.h Sun Dec 28 14:46:24 2008 +0000
＠＠ -105,6 +105,10 ＠＠ Boston, MA 02111-1307, USA. */
coding system). */
MARKED_SLOT (canonical)
+ MARKED_SLOT (safe_charsets)
+
+ MARKED_SLOT (safe_chars)
+
#undef MARKED_SLOT
#undef MARKED_SLOT_ARRAY
#undef CODING_SYSTEM_SLOT_DECLARATION
diff -r 84d618b355f5fccd22634d6415a59a9339281ad4 -r 1d74a1d115ee2c6484333b2d37dd5fce9fe05ad6 src/file-coding.c
--- a/src/file-coding.c Sat Aug 09 13:15:09 2008 +0200
+++ b/src/file-coding.c Sun Dec 28 14:46:24 2008 +0000
＠＠ -1125,9 +1125,9 ＠＠ make_coding_system_1 (Lisp_Object name_o
else if (EQ (key, Qtranslation_table_for_encode))
;
else if (EQ (key, Qsafe_chars))
- ;
+ CODING_SYSTEM_SAFE_CHARS (cs) = value;
else if (EQ (key, Qsafe_charsets))
- ;
+ CODING_SYSTEM_SAFE_CHARSETS (cs) = value;
else if (EQ (key, Qmime_charset))
;
else if (EQ (key, Qvalid_codes))
＠＠ -1326,20 +1326,7 ＠＠ ignored:
`translation-table-for-encode'
The value is a translation table to be applied on encoding. This is
not applicable to CCL-based coding systems.
-
-`safe-chars'
- The value is a char table. If a character has non-nil value in it,
- the character is safely supported by the coding system. This
- overrides the specification of safe-charsets.
-
-`safe-charsets'
- The value is a list of charsets safely supported by the coding
- system. The value t means that all charsets Emacs handles are
- supported. Even if some charset is not in this list, it doesn't
- mean that the charset can't be encoded in the coding system;
- it just means that some other receiver of text encoded
- in the coding system won't be able to handle that charset.
-
+
`mime-charset'
The value is a symbol of which name is `MIME-charset' parameter of
the coding system.
＠＠ -1350,7 +1337,27 ＠＠ ignored:
In the former case, the integer value is a valid byte code. In the
latter case, the integers specifies the range of valid byte codes.
-
+The following properties are used by `default-query-coding-region',
+the default implementation of `query-coding-region'. This
+implementation and these properties are not used by the Unicode coding
+systems, nor by those CCL coding systems created with
+`make-8-bit-coding-system'.
+
+`safe-chars'
+ The value is a char table. If a character has non-nil value in it,
+ the character is safely supported by the coding system.
+ Under XEmacs, for the moment, this is used in addition to the
+ `safe-charsets' property. It does not override it as it does
+ under GNU Emacs. #### We need to consider if we should keep this
+ behaviour.
+
+`safe-charsets'
+ The value is a list of charsets safely supported by the coding
+ system. For coding systems based on ISO 2022, XEmacs may try to
+ encode characters outside these character sets, but outside of
+ East Asia and East Asian coding systems, it is unlikely that
+ consumers of the data will understand XEmacs' encoding.
+ The value t means that all XEmacs character sets handles are supported.
The following additional property is recognized if TYPE is `convert-eol':
＠＠ -1862,6 +1869,10 ＠＠ Return the PROP property of CODING-SYSTE
return XCODING_SYSTEM_POST_READ_CONVERSION (coding_system);
else if (EQ (prop, Qpre_write_conversion))
return XCODING_SYSTEM_PRE_WRITE_CONVERSION (coding_system);
+ else if (EQ (prop, Qsafe_charsets))
+ return XCODING_SYSTEM_SAFE_CHARSETS (coding_system);
+ else if (EQ (prop, Qsafe_chars))
+ return XCODING_SYSTEM_SAFE_CHARS (coding_system);
else
{
Lisp_Object value = CODESYSMETH_OR_GIVEN (XCODING_SYSTEM (coding_system),
diff -r 84d618b355f5fccd22634d6415a59a9339281ad4 -r 1d74a1d115ee2c6484333b2d37dd5fce9fe05ad6 src/file-coding.h
--- a/src/file-coding.h Sat Aug 09 13:15:09 2008 +0200
+++ b/src/file-coding.h Sun Dec 28 14:46:24 2008 +0000
＠＠ -583,6 +583,8 ＠＠ do { \
#define CODING_SYSTEM_AUTO_EOL_WRAPPER(codesys) ((codesys)->auto_eol_wrapper)
#define CODING_SYSTEM_SUBSIDIARY_PARENT(codesys) ((codesys)->subsidiary_parent)
#define CODING_SYSTEM_CANONICAL(codesys) ((codesys)->canonical)
+#define CODING_SYSTEM_SAFE_CHARSETS(codesys) ((codesys)->safe_charsets)
+#define CODING_SYSTEM_SAFE_CHARS(codesys) ((codesys)->safe_chars)
#define CODING_SYSTEM_CHAIN_CHAIN(codesys) \
(CODING_SYSTEM_TYPE_DATA (codesys, chain)->chain)
＠＠ -623,6 +625,10 ＠＠ do { \
CODING_SYSTEM_SUBSIDIARY_PARENT (XCODING_SYSTEM (codesys))
#define XCODING_SYSTEM_CANONICAL(codesys) \
CODING_SYSTEM_CANONICAL (XCODING_SYSTEM (codesys))
+#define XCODING_SYSTEM_SAFE_CHARSETS(codesys) \
+ CODING_SYSTEM_SAFE_CHARSETS (XCODING_SYSTEM (codesys))
+#define XCODING_SYSTEM_SAFE_CHARS(codesys) \
+ CODING_SYSTEM_SAFE_CHARS (XCODING_SYSTEM (codesys))
#define XCODING_SYSTEM_CHAIN_CHAIN(codesys) \
CODING_SYSTEM_CHAIN_CHAIN (XCODING_SYSTEM (codesys))
diff -r 84d618b355f5fccd22634d6415a59a9339281ad4 -r 1d74a1d115ee2c6484333b2d37dd5fce9fe05ad6 tests/ChangeLog
--- a/tests/ChangeLog Sat Aug 09 13:15:09 2008 +0200
+++ b/tests/ChangeLog Sun Dec 28 14:46:24 2008 +0000
＠＠ -1,3 +1,9 ＠＠ 2008-05-21 Aidan Kehoe <kehoea＠parhasa
+2008-12-28 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/query-coding-tests.el:
+ New file, testing the functionality of #'query-coding-region and
+ #'query-coding-string.
+
2008-05-21 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/mule-tests.el (featurep):
diff -r 84d618b355f5fccd22634d6415a59a9339281ad4 -r 1d74a1d115ee2c6484333b2d37dd5fce9fe05ad6 tests/automated/query-coding-tests.el
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/automated/query-coding-tests.el Sun Dec 28 14:46:24 2008 +0000
＠＠ -0,0 +1,293 ＠＠
+;; Copyright (C) 2008 Free Software Foundation, Inc. -*- coding: iso-8859-1 -*-
+
+;; Author: Aidan Kehoe <kehoea(a)parhasard.net>
+;; Maintainer: Aidan Kehoe <kehoea(a)parhasard.net>
+;; Created: 2008
+;; Keywords: tests, query-coding-region
+
+;; 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: Not in FSF.
+
+;;; Commentary:
+
+;; Test the query-coding-region and query-coding-string implementations for
+;; some well-known coding systems.
+
+(require 'bytecomp)
+
+(defun q-c-debug (&rest aerger)
+ (let ((standard-output (get-buffer-create "query-coding-debug"))
+ (fmt (condition-case nil
+ (and (stringp (first aerger))
+ (apply #'format aerger))
+ (error nil))))
+ (if fmt
+ (progn
+ (princ (apply #'format aerger))
+ (terpri))
+ (princ "--> ")
+ (let ((i 1))
+ (dolist (sgra aerger)
+ (if (> i 1) (princ " "))
+ (princ (format "%d. " i))
+ (prin1 sgra)
+ (incf i))
+ (terpri)))))
+
+;; Comment this out if debugging:
+(defalias 'q-c-debug #'ignore)
+
+(when (featurep 'mule)
+ (let ((ascii-chars-string (apply #'string
+ (loop for i from #x0 to #x7f
+ collect (int-to-char i))))
+ (latin-1-chars-string (apply #'string
+ (loop for i from #x0 to #xff
+ collect (int-to-char i))))
+ unix-coding-system text-conversion-error-signalled)
+ (with-temp-buffer
+ (insert ascii-chars-string)
+ ;; First, check all the coding systems that are ASCII-transparent for
+ ;; ASCII-transparency in the check.
+ (dolist (coding-system
+ (delete-duplicates
+ (mapcar #'(lambda (coding-system)
+ (unless (coding-system-alias-p coding-system)
+ ;; We're only interested in the version with
+ ;; Unix line endings right now.
+ (setq unix-coding-system
+ (subsidiary-coding-system
+ (coding-system-base coding-system) 'lf))
+ (when (and
+ ;; ASCII-transparent
+ (equal ascii-chars-string
+ (encode-coding-string
+ ascii-chars-string
+ unix-coding-system))
+ (not
+ (memq (coding-system-type
+ unix-coding-system)
+ '(undecided chain))))
+ unix-coding-system)))
+ (coding-system-list nil))
+:test #'eq))
+ (q-c-debug "looking at coding system %S" (coding-system-name
+ coding-system))
+ (multiple-value-bind (query-coding-succeeded query-coding-table)
+ (query-coding-region (point-min) (point-max) coding-system)
+ (q-c-debug "checking type, coding-system, q-c-s, q-c-t %S"
+ (list (coding-system-type coding-system)
+ coding-system query-coding-succeeded
+ query-coding-table))
+ (unless (and (eq t query-coding-succeeded)
+ (null query-coding-table))
+ (q-c-debug "(eq t query-coding-succeeded) %S, (\
+null query-coding-table) %S" (eq t query-coding-succeeded)
+ (null query-coding-table)))
+ (Assert (eq t query-coding-succeeded))
+ (Assert (null query-coding-table)))
+ (q-c-debug "testing the ASCII strings for %S" coding-system)
+ (multiple-value-bind (query-coding-succeeded query-coding-table)
+ (query-coding-string ascii-chars-string coding-system)
+ (unless (and (eq t query-coding-succeeded)
+ (null query-coding-table))
+ (q-c-debug "(eq t query-coding-succeeded) %S, (\
+null query-coding-table) %S" (eq t query-coding-succeeded)
+ (null query-coding-table)))
+ (Assert (eq t query-coding-succeeded))
+ (Assert (null query-coding-table))))
+ (q-c-debug "past the loop through the coding systems")
+ (delete-region (point-min) (point-max))
+ ;; Check for success from the two Latin-1 coding systems
+ (insert latin-1-chars-string)
+ (q-c-debug "point is now %S" (point))
+ (multiple-value-bind (query-coding-succeeded query-coding-table)
+ (query-coding-region (point-min) (point-max) 'iso-8859-1-unix)
+ (Assert (eq t query-coding-succeeded))
+ (Assert (null query-coding-table)))
+ (q-c-debug "point is now %S" (point))
+ (multiple-value-bind (query-coding-succeeded query-coding-table)
+ (query-coding-string (buffer-string) 'iso-8859-1-unix)
+ (Assert (eq t query-coding-succeeded))
+ (Assert (null query-coding-table)))
+ (q-c-debug "point is now %S" (point))
+ (multiple-value-bind (query-coding-succeeded query-coding-table)
+ (query-coding-string (buffer-string) 'iso-latin-1-with-esc-unix)
+ (Assert (eq t query-coding-succeeded))
+ (Assert (null query-coding-table)))
+ (q-c-debug "point is now %S" (point))
+ ;; Make it fail, check that it fails correctly
+ (insert (decode-char 'ucs #x20AC)) ;; EURO SIGN
+ (multiple-value-bind (query-coding-succeeded query-coding-table)
+ (query-coding-region (point-min) (point-max) 'iso-8859-1-unix)
+ (unless (and (null query-coding-succeeded)
+ (equal query-coding-table
+ #s(range-table type start-closed-end-open data
+ ((257 258) t))))
+ (q-c-debug "dealing with %S" 'iso-8859-1-unix)
+ (q-c-debug "query-coding-succeeded not null, query-coding-table \
+%S" query-coding-table))
+ (Assert (null query-coding-succeeded))
+ (Assert (equal query-coding-table
+ #s(range-table type start-closed-end-open data
+ ((257 258) t)))))
+ (multiple-value-bind (query-coding-succeeded query-coding-table)
+ (query-coding-region (point-min) (point-max)
+ 'iso-latin-1-with-esc-unix)
+ ;; Stupidly, this succeeds. The behaviour is compatible with
+ ;; GNU, though, and we encourage people not to use
+ ;; iso-latin-1-with-esc-unix anyway:
+
+ (unless (and query-coding-succeeded
+ (null query-coding-table))
+ (q-c-debug "dealing with %S" 'iso-latin-1-with-esc-unix)
+ (q-c-debug "query-coding-succeeded %S, query-coding-table \
+%S" query-coding-succeeded query-coding-table))
+ (Assert query-coding-succeeded)
+ (Assert (null query-coding-table)))
+ ;; Check that it errors correctly.
+ (setq text-conversion-error-signalled nil)
+ (condition-case nil
+ (query-coding-region (point-min) (point-max) 'iso-8859-1-unix nil t)
+ (text-conversion-error
+ (setq text-conversion-error-signalled t)))
+ (Assert text-conversion-error-signalled)
+ (setq text-conversion-error-signalled nil)
+ (condition-case nil
+ (query-coding-region (point-min) (point-max)
+ 'iso-latin-1-with-esc-unix nil t)
+ (text-conversion-error
+ (setq text-conversion-error-signalled t)))
+ (Assert (null text-conversion-error-signalled))
+ (delete-region (point-min) (point-max))
+ (insert latin-1-chars-string)
+ (decode-coding-region (point-min) (point-max) 'windows-1252-unix)
+ (goto-char (point-max)) ;; #'decode-coding-region just messed up point.
+ (multiple-value-bind (query-coding-succeeded query-coding-table)
+ (query-coding-region (point-min) (point-max) 'windows-1252-unix)
+ (Assert (eq t query-coding-succeeded))
+ (Assert (null query-coding-table)))
+ (insert ?\x80)
+ (multiple-value-bind (query-coding-succeeded query-coding-table)
+ (query-coding-region (point-min) (point-max) 'windows-1252-unix)
+ (unless (and (null query-coding-succeeded)
+ (equal query-coding-table
+ #s(range-table type start-closed-end-open data
+ ((257 258) t))))
+ (q-c-debug "dealing with %S" 'windows-1252-unix)
+ (q-c-debug "query-coding-succeeded not null, query-coding-table \
+%S" query-coding-table))
+ (Assert (null query-coding-succeeded))
+ (Assert (equal query-coding-table
+ #s(range-table type start-closed-end-open data
+ ((257 258) t)))))
+ ;; Try a similar approach with koi8-o, the koi8 variant with
+ ;; support for Old Church Slavonic.
+ (delete-region (point-min) (point-max))
+ (insert latin-1-chars-string)
+ (decode-coding-region (point-min) (point-max) 'koi8-o-unix)
+ (multiple-value-bind (query-coding-succeeded query-coding-table)
+ (query-coding-region (point-min) (point-max) 'koi8-o-unix)
+ (Assert (eq t query-coding-succeeded))
+ (Assert (null query-coding-table)))
+ (multiple-value-bind (query-coding-succeeded query-coding-table)
+ (query-coding-region (point-min) (point-max) 'escape-quoted)
+ (Assert (eq t query-coding-succeeded))
+ (Assert (null query-coding-table)))
+ (multiple-value-bind (query-coding-succeeded query-coding-table)
+ (query-coding-region (point-min) (point-max) 'windows-1252-unix)
+ (unless (and (null query-coding-succeeded)
+ (equal query-coding-table
+ #s(range-table type start-closed-end-open
+ data ((129 131) t (132 133) t
+ (139 140) t (141 146) t
+ (155 156) t (157 161) t
+ (162 170) t (173 176) t
+ (178 187) t (189 192) t
+ (193 257) t))))
+ (q-c-debug "query-coding-succeeded not null, query-coding-table \
+%S" query-coding-table))
+ (Assert (null query-coding-succeeded))
+ (Assert (equal query-coding-table
+ #s(range-table type start-closed-end-open
+ data ((129 131) t (132 133) t (139 140) t
+ (141 146) t (155 156) t (157 161) t
+ (162 170) t (173 176) t (178 187) t
+ (189 192) t (193 257) t)))))
+ (multiple-value-bind (query-coding-succeeded query-coding-table)
+ (query-coding-region (point-min) (point-max) 'koi8-r-unix)
+ (Assert (null query-coding-succeeded))
+ (Assert (equal query-coding-table
+ #s(range-table type start-closed-end-open
+ data ((129 154) t (155 161) t (162 164) t
+ (165 177) t (178 180) t
+ (181 192) t)))))
+ ;; Check that the Unicode coding systems handle characters
+ ;; without Unicode mappings.
+ (delete-region (point-min) (point-max))
+ (insert latin-1-chars-string)
+ (decode-coding-region (point-min) (point-max) 'greek-iso-8bit-with-esc)
+ (dolist (coding-system
+ '(utf-16-mac ucs-4-mac utf-16-little-endian-bom-dos ucs-4-dos
+ utf-16-little-endian-mac utf-16-bom-unix
+ utf-16-little-endian ucs-4 utf-16-dos
+ ucs-4-little-endian-dos utf-16-bom-mac utf-16-bom
+ utf-16-unix utf-32-unix utf-32-little-endian
+ utf-32-dos utf-32 utf-32-little-endian-dos utf-8-bom
+ utf-16-bom-dos ucs-4-unix
+ utf-16-little-endian-bom-unix utf-8-bom-mac
+ utf-32-little-endian-unix utf-16
+ utf-16-little-endian-dos utf-16-little-endian-bom-mac
+ utf-8-bom-dos ucs-4-little-endian-mac utf-8-bom-unix
+ utf-32-little-endian-mac utf-8-dos utf-8-unix
+ utf-32-mac utf-8-mac utf-16-little-endian-unix
+ ucs-4-little-endian ucs-4-little-endian-unix utf-8
+ utf-16-little-endian-bom))
+ (multiple-value-bind (query-coding-succeeded query-coding-table)
+ (query-coding-region (point-min) (point-max) coding-system)
+ (Assert (null query-coding-succeeded))
+ (Assert (equal query-coding-table
+ #s(range-table type start-closed-end-open data
+ ((173 174) t (209 210) t
+ (254 255) t)))))
+ (multiple-value-bind (query-coding-succeeded query-coding-table)
+ (query-coding-region (point-min) 173 coding-system)
+ (Assert (eq t query-coding-succeeded))
+ (Assert (null query-coding-table)))
+ (multiple-value-bind (query-coding-succeeded query-coding-table)
+ (query-coding-region 174 209 coding-system)
+ (Assert (eq t query-coding-succeeded))
+ (Assert (null query-coding-table)))
+ (multiple-value-bind (query-coding-succeeded query-coding-table)
+ (query-coding-region 210 254 coding-system)
+ (Assert (eq t query-coding-succeeded))
+ (Assert (null query-coding-table)))
+ ;; Check that it errors correctly.
+ (setq text-conversion-error-signalled nil)
+ (condition-case nil
+ (query-coding-region (point-min) (point-max) coding-system nil t)
+ (text-conversion-error
+ (setq text-conversion-error-signalled t)))
+ (Assert text-conversion-error-signalled)
+ (setq text-conversion-error-signalled nil)
+ (condition-case nil
+ (query-coding-region (point-min) 173 coding-system nil t)
+ (text-conversion-error
+ (setq text-conversion-error-signalled t)))
+ (Assert (null text-conversion-error-signalled))))))
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: 2008-08-09 Aidan Kehoe <kehoea@parhasard.net>
16 years, 2 months
Aidan Kehoe
Aidan Kehoe
changeset: 4606:84d618b355f5fccd22634d6415a59a9339281ad4
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat Aug 09 13:15:09 2008 +0200
files: lisp/ChangeLog lisp/mule/general-late.el lisp/mule/mule-coding.el
description:
2008-08-09 Aidan Kehoe <kehoea(a)parhasard.net>
* mule/mule-coding.el (make-8-bit-coding-system):
* mule/general-late.el (posix-charset-to-coding-system-hash):
Use #'skip-chars-quote as appropriate.
diff -r 26aae3bacf99fd641cbc1626d3ee5a8572b28703 -r 84d618b355f5fccd22634d6415a59a9339281ad4 lisp/ChangeLog
--- a/lisp/ChangeLog Sat Aug 09 13:11:06 2008 +0200
+++ b/lisp/ChangeLog Sat Aug 09 13:15:09 2008 +0200
＠＠ -1,3 +1,9 ＠＠ 2008-08-09 Aidan Kehoe <kehoea＠parhasa
+2008-08-09 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * mule/mule-coding.el (make-8-bit-coding-system):
+ * mule/general-late.el (posix-charset-to-coding-system-hash):
+ Use #'skip-chars-quote as appropriate.
+
2008-08-09 Aidan Kehoe <kehoea(a)parhasard.net>
* subr.el (skip-chars-quote): New.
＠＠ -6,8 +12,6 ＠＠ 2008-08-09 Aidan Kehoe <kehoea＠parhasa
#'skip-chars-backward.
2008-08-09 Aidan Kehoe <kehoea(a)parhasard.net>
-
- * subr.el (skip-chars-quote): New.
* mule/cyril-util.el: Remove. Use the version in packages instead.
diff -r 26aae3bacf99fd641cbc1626d3ee5a8572b28703 -r 84d618b355f5fccd22634d6415a59a9339281ad4 lisp/mule/general-late.el
--- a/lisp/mule/general-late.el Sat Aug 09 13:11:06 2008 +0200
+++ b/lisp/mule/general-late.el Sat Aug 09 13:15:09 2008 +0200
＠＠ -90,7 +90,7 ＠＠
(setq skip-chars-string
(concat skip-chars-string
(charset-skip-chars-string charset))))
- finally return skip-chars-string))))
+ finally return (skip-chars-quote skip-chars-string)))))
;; At this point in the dump, all the charsets have been loaded. Now, load
;; their Unicode mappings.
diff -r 26aae3bacf99fd641cbc1626d3ee5a8572b28703 -r 84d618b355f5fccd22634d6415a59a9339281ad4 lisp/mule/mule-coding.el
--- a/lisp/mule/mule-coding.el Sat Aug 09 13:11:06 2008 +0200
+++ b/lisp/mule/mule-coding.el Sat Aug 09 13:15:09 2008 +0200
＠＠ -699,7 +699,8 ＠＠ the code for tilde `~'. "
(coding-system-put name 'category
(make-8-bit-choose-category decode-table))
(coding-system-put name '8-bit-fixed-query-skip-chars
- (apply #'string (append decode-table nil)))
+ (skip-chars-quote
+ (apply #'string (append decode-table nil))))
(coding-system-put name '8-bit-fixed-query-from-unicode encode-table)
(coding-system-put name 'query-coding-function
＠＠ -786,7 +787,8 ＠＠ the code for tilde `~'. "
(coding-system-put ',name 'category
',(make-8-bit-choose-category decode-table))
(coding-system-put ',name '8-bit-fixed-query-skip-chars
- ',(apply #'string (append decode-table nil)))
+ ',(skip-chars-quote
+ (apply #'string (append decode-table nil))))
(coding-system-put ',name '8-bit-fixed-query-from-unicode encode-table)
(coding-system-put ',name 'query-coding-function
#'8-bit-fixed-query-coding-region)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Add #'skip-chars-quote to subr.el
16 years, 2 months
Aidan Kehoe
Aidan Kehoe
changeset: 4604:31344162cf9ada294e34a48c10daa1242b6e310e
parent: 4525:89406c31b12521258c83389d19f80440a3a7ce48
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat Aug 09 13:06:24 2008 +0200
files: lisp/ChangeLog lisp/subr.el
description:
Add #'skip-chars-quote to subr.el
2008-08-09 Aidan Kehoe <kehoea(a)parhasard.net>
* subr.el (skip-chars-quote): New.
Given STRING, return a string that means that all characters in
STRING will be skipped when passed to #'skip-chars-forward,
#'skip-chars-backward.
diff -r 89406c31b12521258c83389d19f80440a3a7ce48 -r 31344162cf9ada294e34a48c10daa1242b6e310e lisp/ChangeLog
--- a/lisp/ChangeLog Sat Aug 09 12:13:19 2008 +0200
+++ b/lisp/ChangeLog Sat Aug 09 13:06:24 2008 +0200
＠＠ -1,4 +1,13 ＠＠ 2008-08-09 Aidan Kehoe <kehoea＠parhasa
2008-08-09 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * subr.el (skip-chars-quote): New.
+ Given STRING, return a string that means that all characters in
+ STRING will be skipped when passed to #'skip-chars-forward,
+ #'skip-chars-backward.
+
+2008-08-09 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * subr.el (skip-chars-quote): New.
* mule/cyril-util.el: Remove. Use the version in packages instead.
diff -r 89406c31b12521258c83389d19f80440a3a7ce48 -r 31344162cf9ada294e34a48c10daa1242b6e310e lisp/subr.el
--- a/lisp/subr.el Sat Aug 09 12:13:19 2008 +0200
+++ b/lisp/subr.el Sat Aug 09 13:06:24 2008 +0200
＠＠ -1722,4 +1722,25 ＠＠ one is kept."
;; define-mail-user-agent is in simple.el.
+;; XEmacs; added.
+(defun skip-chars-quote (string)
+ "Return a string that means all characters in STRING will be skipped,
+if passed to `skip-chars-forward' or `skip-chars-backward'.
+
+Ranges and carets are not treated specially. This implementation is
+in Lisp; do not use it in performance-critical code."
+ (let ((list (delete-duplicates (string-to-list string) :test #'=)))
+ (when (equal list '((?- ?\[) (?\[ ?\-)))
+ (error 'invalid-argument
+ "Cannot create `skip-chars-forward' arg from string"
+ string))
+ (when (memq ?\] list)
+ (setq list (cons ?\] (delq ?\] list))))
+ (when (eq ?^ (car list))
+ (setq list (nconc (cdr list) '(?^))))
+ (when (memq ?- list)
+ (setq list (delq ?- list)
+ list (nconc list (list (second list) ?- (second list) ?-))))
+ (apply #'string list)))
+
;;; subr.el ends here
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Merge my change of 2008-05-14 to the query-coding-region code.
16 years, 2 months
Aidan Kehoe
Aidan Kehoe
changeset: 4598:bd1a68c34d44b7e3a1c38dd107903988cde896d5
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Wed May 21 21:49:19 2008 +0200
files: lisp/ChangeLog lisp/mule/mule-coding.el
description:
Merge my change of 2008-05-14 to the query-coding-region code.
2008-05-21 Aidan Kehoe <kehoea(a)parhasard.net>
* mule/mule-coding.el (make-8-bit-choose-category):
Merge my change of 2008-05-14 to the query-coding-region code.
diff -r d9fcb5442c9553e6b09f073cd32d803377989218 -r bd1a68c34d44b7e3a1c38dd107903988cde896d5 lisp/ChangeLog
--- a/lisp/ChangeLog Wed May 21 21:47:42 2008 +0200
+++ b/lisp/ChangeLog Wed May 21 21:49:19 2008 +0200
＠＠ -1,3 +1,8 ＠＠ 2008-05-14 Stephen J. Turnbull <stephe
+2008-05-21 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * mule/mule-coding.el (make-8-bit-choose-category):
+ Merge my change of 2008-05-14 to the query-coding-region code.
+
2008-05-14 Stephen J. Turnbull <stephen(a)xemacs.org>
* subr.el (add-to-list): Fix Aidan's last commit.
diff -r d9fcb5442c9553e6b09f073cd32d803377989218 -r bd1a68c34d44b7e3a1c38dd107903988cde896d5 lisp/mule/mule-coding.el
--- a/lisp/mule/mule-coding.el Wed May 21 21:47:42 2008 +0200
+++ b/lisp/mule/mule-coding.el Wed May 21 21:49:19 2008 +0200
＠＠ -531,7 +531,7 ＠＠ disk to XEmacs characters for some fixed
(check-argument-range (length decode-table) #x100 #x100)
(loop
named category
- for i from #x80 to #xBF
+ for i from #x80 to #x9F
do (unless (= i (aref decode-table i))
(return-from category 'no-conversion))
finally return 'iso-8-1))
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments