carbon2-commit: Merge improvements in defun-movement docstrings.
Michael Sperber
sperber-guest at alioth.debian.org
Sat Nov 14 09:33:50 EST 2009
changeset: 4769:5690bb2e7a44
parent: 4768:7eef89a3d41f
parent: 4767:ebca981a0012
user: Stephen J. Turnbull <stephen at xemacs.org>
date: Sun Nov 01 15:54:15 2009 +0900
files: lisp/ChangeLog
description:
Merge improvements in defun-movement docstrings.
diff -r 7eef89a3d41f -r 5690bb2e7a44 lib-src/ChangeLog
--- a/lib-src/ChangeLog Fri Oct 09 05:10:03 2009 +0900
+++ b/lib-src/ChangeLog Sun Nov 01 15:54:15 2009 +0900
@@ -1,3 +1,9 @@
+2009-10-26 Jerry James <james at xemacs.org>
+
+ * insert-data-in-exec.c: Add BSD header, with permission of
+ Olivier Galibert. See xemacs-beta message with ID
+ <20091013224104.GA2573 at dspnet.fr.eu.org>.
+
2009-08-15 It's me FKtPp ;) <m_pupil at yahoo.com.cn>
* gnuclient.c (main): Do not set start point position if user
diff -r 7eef89a3d41f -r 5690bb2e7a44 lib-src/insert-data-in-exec.c
--- a/lib-src/insert-data-in-exec.c Fri Oct 09 05:10:03 2009 +0900
+++ b/lib-src/insert-data-in-exec.c Sun Nov 01 15:54:15 2009 +0900
@@ -1,4 +1,33 @@
-/* Copies the dump file inside the xemacs executable */
+/* Copies the dump file inside the xemacs executable.
+ Copyright (C) 2003-2004 Olivier Galibert.
+ Copyright (C) 2003 Larry McVoy.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ 1. Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ 2. Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL LARRY
+MCVOY, THE XEMACS PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+The views and conclusions contained in the software and documentation are those
+of the authors and should not be interpreted as representing official policies,
+either expressed or implied, of the XEmacs Project.
+
+The "key" array is the work of Larry McVoy. See
+http://lkml.org/lkml/2003/7/11/141 for more information. */
#include <stdio.h>
#include <stdlib.h>
diff -r 7eef89a3d41f -r 5690bb2e7a44 lisp/ChangeLog
--- a/lisp/ChangeLog Fri Oct 09 05:10:03 2009 +0900
+++ b/lisp/ChangeLog Sun Nov 01 15:54:15 2009 +0900
@@ -5,6 +5,64 @@
(beginning-of-defun):
(end-of-defun):
Make docstrings stop lying.
+
+2009-10-30 Aidan Kehoe <kehoea at parhasard.net>
+
+ * cl-macs.el (regexp-quote):
+ If STRING is constant, call regexp-quote at compile time.
+
+2009-10-24 Aidan Kehoe <kehoea at parhasard.net>
+
+ * files.el (default-file-system-ignore-case): New variable.
+ (file-system-case-alist): New variable.
+ (file-system-ignore-case-p):
+ New function; return t if file names under PATH should be treated
+ case-insensitively.
+ * minibuf.el (read-file-name-1, read-file-name-internal-1)
+ (read-file-name-internal-1):
+ * package-admin.el (package-admin-check-manifest):
+ Use file-system-ignore-case-p instead of checking system-type
+ directly in these functions. (Even though minibuf.el is dumped
+ before files.el, the function is only called in interactive usage,
+ there's no dump time order dependency here.)
+
+2009-10-19 Aidan Kehoe <kehoea at parhasard.net>
+
+ * bytecomp.el (byte-compile-default-warnings):
+ Add two new warning types, discarded-consing (basically use of
+ mapcar instead of mapc where its result is discarded) and
+ quoted-lambda (use of a lambda expression quoted as data in a
+ function context).
+ (byte-compile-warnings): Document the new warnings.
+ (byte-compile-fset, byte-compile-funarg): Implement the
+ quoted-lambda warning option.
+ (byte-compile-mapcar): Renamed to byte-compile-maybe-mapc.
+ (byte-compile-maybe-mapc, byte-compile-maplist):
+ Implement the discarded-consing warning option.
+ Add more functions that should be compiled using
+ byte-compile-funarg, notably mapvector, mapc-internal,
+ map-char-table.
+ * cl-macs.el (mapcar*):
+ If we know at compile time that there are no CL options being
+ used, use the mapcar subr, not the byte-coded function.
+
+2009-10-12 Aidan Kehoe <kehoea at parhasard.net>
+
+ * cl-macs.el (mapc):
+ New compiler macro, use mapc-internal at
+ compile time if we're not using the Common Lisp functionality.
+ * bytecomp.el (byte-compile-mapcar, byte-compile-maplist): New.
+ If the return value of mapcar is being discarded, compile it to a
+ mapc-internal call instead, and warn, because the programmer
+ probably can't rely on always being compiled by an XEmacs that
+ does this. Similarly for maplist and mapl; and use
+ byte-compile-funarg for map, mapl, mapcan, mapcon.
+
+2009-10-12 Aidan Kehoe <kehoea at parhasard.net>
+
+ * cl-macs.el (delete-duplicates):
+ Fix another bug in the delete-duplicates compiler macro, thank you
+ the byte compiler.
2009-10-07 Andreas Roehler <andreas.roehler at online.de>
diff -r 7eef89a3d41f -r 5690bb2e7a44 lisp/bytecomp.el
--- a/lisp/bytecomp.el Fri Oct 09 05:10:03 2009 +0900
+++ b/lisp/bytecomp.el Sun Nov 01 15:54:15 2009 +0900
@@ -117,6 +117,12 @@
;;; 'obsolete (obsolete variables and functions)
;;; 'pedantic (references to Emacs-compatible
;;; symbols)
+;;; 'discarded-consing (use of mapcar instead of
+;;; mapc, and similar)
+;;; 'quoted-lambda (quoting a lambda expression
+;;; as data, not as a function,
+;;; and using it in a function
+;;; context )
;;; byte-compile-emacs19-compatibility Whether the compiler should
;;; generate .elc files which can be loaded into
;;; generic emacs 19.
@@ -361,7 +367,8 @@
;; byte-compile-warning-types in FSF.
(defvar byte-compile-default-warnings
- '(redefine callargs subr-callargs free-vars unresolved unused-vars obsolete)
+ '(redefine callargs subr-callargs free-vars unresolved unused-vars obsolete
+ discarded-consing quoted-lambda)
"*The warnings used when byte-compile-warnings is t.")
(defvar byte-compile-warnings t
@@ -377,6 +384,12 @@
versa, or redefined to take a different number of arguments.
obsolete use of an obsolete function or variable.
pedantic warn of use of compatible symbols.
+ discarded-consing
+ calls to (some) functions that allocate memory, where that
+ memory is immediately discarded; canonically, the use of
+ mapcar instead of mapc
+ quoted-lambda passing a lambda expression not quoted as a function, as a
+ function argument
The default set is specified by `byte-compile-default-warnings' and
normally encompasses all possible warnings.
@@ -1073,7 +1086,8 @@
(verbose byte-compile-verbose (t nil) val)
(new-bytecodes byte-compile-new-bytecodes (t nil) val)
(warnings byte-compile-warnings
- ((callargs subr-callargs redefine free-vars unused-vars unresolved))
+ ((callargs subr-callargs redefine free-vars unused-vars
+ unresolved discarded-consing quoted-lambda))
val)))
;; XEmacs addition
@@ -3502,7 +3516,8 @@
(if (stringp (car body)) (setq body (cdr body)))
(if (eq 'interactive (car-safe (car body))) (setq body (cdr body)))
(if (and (consp (car body))
- (not (eq 'byte-code (car (car body)))))
+ (not (eq 'byte-code (car (car body))))
+ (memq 'quoted-lambda byte-compile-warnings))
(byte-compile-warn
"A quoted lambda form is the second argument of fset. This is probably
not what you want, as that lambda cannot be compiled. Consider using
@@ -3515,11 +3530,35 @@
(byte-compile-normal-call
(let ((fn (nth 1 form)))
(if (and (eq (car-safe fn) 'quote)
- (eq (car-safe (nth 1 fn)) 'lambda))
+ (eq (car-safe (nth 1 fn)) 'lambda)
+ (or
+ (null (memq 'quoted-lambda byte-compile-warnings))
+ (byte-compile-warn
+ "Passing a quoted lambda to #'%s, forcing function quoting"
+ (car form))))
(cons (car form)
(cons (cons 'function (cdr fn))
(cdr (cdr form))))
form))))
+
+;; XEmacs change; don't cons up the list if it's going to be immediately
+;; discarded.
+(defun byte-compile-maybe-mapc (form)
+ (and for-effect
+ (or (null (memq 'discarded-consing byte-compile-warnings))
+ (byte-compile-warn
+ "Discarding the result of #'%s; maybe you meant #'mapc?"
+ (car form)))
+ (setq form (cons 'mapc-internal (cdr form))))
+ (byte-compile-funarg form))
+
+(defun byte-compile-maplist (form)
+ (and for-effect
+ (or (null (memq 'discarded-consing byte-compile-warnings))
+ (byte-compile-warn
+ "Discarding the result of #'maplist; maybe you meant #'mapl?"))
+ (setq form (cons 'mapl (cdr form))))
+ (byte-compile-funarg form))
;; (function foo) must compile like 'foo, not like (symbol-function 'foo).
;; Otherwise it will be incompatible with the interpreter,
@@ -3698,9 +3737,27 @@
(byte-defop-compiler-1 while)
(byte-defop-compiler-1 funcall)
(byte-defop-compiler-1 apply byte-compile-funarg)
-(byte-defop-compiler-1 mapcar byte-compile-funarg)
+(byte-defop-compiler-1 mapcar byte-compile-maybe-mapc)
+(byte-defop-compiler-1 mapvector byte-compile-maybe-mapc)
+(byte-defop-compiler-1 mapc byte-compile-funarg)
+(byte-defop-compiler-1 mapc-internal byte-compile-funarg)
(byte-defop-compiler-1 mapatoms byte-compile-funarg)
(byte-defop-compiler-1 mapconcat byte-compile-funarg)
+(byte-defop-compiler-1 map byte-compile-funarg)
+(byte-defop-compiler-1 maplist byte-compile-maplist)
+(byte-defop-compiler-1 mapl byte-compile-funarg)
+(byte-defop-compiler-1 mapcan byte-compile-funarg)
+(byte-defop-compiler-1 mapcon byte-compile-funarg)
+(byte-defop-compiler-1 map-char-table byte-compile-funarg)
+(byte-defop-compiler-1 map-database byte-compile-funarg)
+(byte-defop-compiler-1 map-extent-children byte-compile-funarg)
+(byte-defop-compiler-1 map-extents byte-compile-funarg)
+(byte-defop-compiler-1 map-plist byte-compile-funarg)
+(byte-defop-compiler-1 map-range-table byte-compile-funarg)
+(byte-defop-compiler-1 map-syntax-table byte-compile-funarg)
+(byte-defop-compiler-1 mapcar-extents byte-compile-funarg)
+(byte-defop-compiler-1 mapcar* byte-compile-funarg)
+(byte-defop-compiler-1 maphash byte-compile-funarg)
(byte-defop-compiler-1 let)
(byte-defop-compiler-1 let*)
diff -r 7eef89a3d41f -r 5690bb2e7a44 lisp/cl-macs.el
--- a/lisp/cl-macs.el Fri Oct 09 05:10:03 2009 +0900
+++ b/lisp/cl-macs.el Sun Nov 01 15:54:15 2009 +0900
@@ -3240,7 +3240,7 @@
begin)
;; Call cl-delete-duplicates explicitly, to avoid the form
;; getting compiler-macroexpanded again:
- (cl-delete-duplicates begin ,(third form) ,(fourth form) nil))))
+ (cl-delete-duplicates begin ',cl-keys nil))))
((and (= 4 (length form))
(eq :test (third form))
(or (equal '(quote equal) (fourth form))
@@ -3255,9 +3255,29 @@
begin)
;; Call cl-delete-duplicates explicitly, to avoid the form
;; getting compiler-macroexpanded again:
- (cl-delete-duplicates begin ,(third form) ,(fourth form) nil))))
+ (cl-delete-duplicates begin ',cl-keys nil))))
(t
form))))
+
+;; XEmacs change, the GNU mapc doesn't accept the Common Lisp args, so this
+;; change isn't helpful.
+(define-compiler-macro mapc (&whole form cl-func cl-seq &rest cl-rest)
+ (if cl-rest
+ form
+ (cons 'mapc-internal (cdr form))))
+
+(define-compiler-macro mapcar* (&whole form cl-func cl-x &rest cl-rest)
+ (if cl-rest
+ form
+ (cons 'mapcar (cdr form))))
+
+;; XEmacs; it's perfectly reasonable, and often much clearer to those
+;; reading the code, to call regexp-quote on a constant string, which is
+;; something we can optimise here easily.
+(define-compiler-macro regexp-quote (&whole form string)
+ (if (stringp string)
+ (regexp-quote string)
+ form))
(mapc
#'(lambda (y)
diff -r 7eef89a3d41f -r 5690bb2e7a44 lisp/files.el
--- a/lisp/files.el Fri Oct 09 05:10:03 2009 +0900
+++ b/lisp/files.el Sun Nov 01 15:54:15 2009 +0900
@@ -4514,4 +4514,39 @@
;; END SYNC WITH FSF 21.2.
+;; XEmacs:
+(defvar default-file-system-ignore-case (and
+ (memq system-type '(windows-nt
+ cygwin32
+ darwin))
+ t)
+ "What `file-system-ignore-case-p' returns by default.
+This is in the case that nothing in `file-system-case-alist' matches.")
+
+;; Question; do any of the Linuxes mount Windows partitions in a fixed
+;; place?
+(defvar file-system-case-alist nil
+ "Alist to decide where file name case is significant.
+
+The format is ((PATTERN . VAL) ...), where PATTERN is a regular expression
+matching a file name, and VAL is t if corresponding file names are
+case-insensitive, nil if corresponding file names are case sensitive. Only
+the first match will be used.
+
+This list is used by `file-system-ignore-case-p', itself used in tab
+completion; see also `default-file-system-ignore-case'.")
+
+(defun file-system-ignore-case-p (path)
+ "Return t if PATH resides on a file system with case-insensitive names.
+Otherwise, return nil. See `file-system-case-alist' and
+`default-file-system-ignore-case'."
+ (check-argument-type #'stringp path)
+ (if file-system-case-alist
+ (loop
+ for (pattern . val)
+ in file-system-case-alist
+ do (and (string-match pattern path) (return val))
+ finally (return default-file-system-ignore-case))
+ default-file-system-ignore-case))
+
;;; files.el ends here
diff -r 7eef89a3d41f -r 5690bb2e7a44 lisp/minibuf.el
--- a/lisp/minibuf.el Fri Oct 09 05:10:03 2009 +0900
+++ b/lisp/minibuf.el Sun Nov 01 15:54:15 2009 +0900
@@ -1698,9 +1698,7 @@
(add-one-shot-hook
'minibuffer-setup-hook
(lambda ()
- ;; #### SCREAM! Create a `file-system-ignore-case'
- ;; function, so this kind of stuff is generalized!
- (and (eq system-type 'windows-nt)
+ (and (file-system-ignore-case-p (or dir default-directory))
(set (make-local-variable 'completion-ignore-case) t))
(set
(make-local-variable
@@ -1777,6 +1775,8 @@
string))
;; Not doing environment-variable completion hack
(let* ((orig (if (equal string "") nil string))
+ (completion-ignore-case (file-system-ignore-case-p
+ (or dir default-directory)))
(sstring (if orig (substitute-in-file-name string) string))
(specdir (if orig (file-name-directory sstring) nil))
(name (if orig (file-name-nondirectory sstring) string))
@@ -1814,6 +1814,8 @@
name)))
;; An odd number of trailing $'s
(let* ((start (match-beginning 3))
+ (completion-ignore-case (file-system-ignore-case-p
+ (or dir default-directory)))
(env (substring string
(cond ((= start (length string))
;; "...$"
diff -r 7eef89a3d41f -r 5690bb2e7a44 lisp/package-admin.el
--- a/lisp/package-admin.el Fri Oct 09 05:10:03 2009 +0900
+++ b/lisp/package-admin.el Sun Nov 01 15:54:15 2009 +0900
@@ -279,106 +279,98 @@
PKG-OUTBUF is the buffer that holds the output from `tar', and PKG-TOPDIR
is the top-level directory under which the package was installed."
(let ((manifest-buf " *pkg-manifest*")
- (old-case-fold-search case-fold-search)
+ (case-fold-search (file-system-ignore-case-p pkg-topdir))
regexp package-name pathname regexps)
- (unwind-protect
- (save-excursion ;; Probably redundant.
- (set-buffer (get-buffer pkg-outbuf)) ;; Probably already the current buffer.
- (goto-char (point-min))
+ (save-excursion ;; Probably redundant.
+ (set-buffer (get-buffer pkg-outbuf)) ;; Probably already the current buffer.
+ (goto-char (point-min))
+ (setq regexp (concat "\\bpkginfo"
+ (char-to-string directory-sep-char)
+ "MANIFEST\\...*"))
- ;; Make filenames case-insensitive, if necessary
- (if (eq system-type 'windows-nt)
- (setq case-fold-search t))
+ ;; Look for the manifest.
+ (if (not (re-search-forward regexp nil t))
+ (progn
+ ;; We didn't find a manifest. Make one.
- (setq regexp (concat "\\bpkginfo"
- (char-to-string directory-sep-char)
- "MANIFEST\\...*"))
+ ;; Yuk. We weren't passed the package name, and so we have
+ ;; to dig for it. Look for it as the subdirectory name below
+ ;; "lisp", or "man".
+ ;; Here, we don't use a single regexp because we want to search
+ ;; the directories for a package name in a particular order.
+ (if (catch 'done
+ (let ((dirs '("lisp" "man"))
+ rexp)
+ (while dirs
+ (setq rexp (concat "\\b" (car dirs)
+ "[\\/]\\([^\\/]+\\)[\//]"))
+ (if (re-search-forward rexp nil t)
+ (throw 'done t))
+ (setq dirs (cdr dirs)))))
+ (progn
+ (setq package-name (buffer-substring (match-beginning 1)
+ (match-end 1)))
- ;; Look for the manifest.
- (if (not (re-search-forward regexp nil t))
- (progn
- ;; We didn't find a manifest. Make one.
+ ;; Get and erase the manifest buffer
+ (setq manifest-buf (get-buffer-create manifest-buf))
+ (buffer-disable-undo manifest-buf)
+ (erase-buffer manifest-buf)
- ;; Yuk. We weren't passed the package name, and so we have
- ;; to dig for it. Look for it as the subdirectory name below
- ;; "lisp", or "man".
- ;; Here, we don't use a single regexp because we want to search
- ;; the directories for a package name in a particular order.
- (if (catch 'done
- (let ((dirs '("lisp" "man"))
- rexp)
- (while dirs
- (setq rexp (concat "\\b" (car dirs)
- "[\\/]\\([^\\/]+\\)[\//]"))
- (if (re-search-forward rexp nil t)
- (throw 'done t))
- (setq dirs (cdr dirs)))))
- (progn
- (setq package-name (buffer-substring (match-beginning 1)
- (match-end 1)))
+ ;; Now, scan through the output buffer, looking for
+ ;; file and directory names.
+ (goto-char (point-min))
+ ;; for each line ...
+ (while (< (point) (point-max))
+ (beginning-of-line)
+ (setq pathname nil)
- ;; Get and erase the manifest buffer
- (setq manifest-buf (get-buffer-create manifest-buf))
- (buffer-disable-undo manifest-buf)
- (erase-buffer manifest-buf)
+ ;; scan through the regexps, looking for a pathname
+ (if (catch 'found-path
+ (setq regexps package-admin-tar-filename-regexps)
+ (while regexps
+ (if (looking-at (car regexps))
+ (progn
+ (setq pathname
+ (buffer-substring
+ (match-beginning 1)
+ (match-end 1)))
+ (throw 'found-path t)))
+ (setq regexps (cdr regexps))))
+ (progn
+ ;; found a pathname -- add it to the manifest
+ ;; buffer
+ (save-excursion
+ (set-buffer manifest-buf)
+ (goto-char (point-max))
+ (insert pathname "\n"))))
+ (forward-line 1))
- ;; Now, scan through the output buffer, looking for
- ;; file and directory names.
- (goto-char (point-min))
- ;; for each line ...
- (while (< (point) (point-max))
- (beginning-of-line)
- (setq pathname nil)
+ ;; Processed all lines.
+ ;; Now, create the file, pkginfo/MANIFEST.<pkgname>
- ;; scan through the regexps, looking for a pathname
- (if (catch 'found-path
- (setq regexps package-admin-tar-filename-regexps)
- (while regexps
- (if (looking-at (car regexps))
- (progn
- (setq pathname
- (buffer-substring
- (match-beginning 1)
- (match-end 1)))
- (throw 'found-path t)))
- (setq regexps (cdr regexps))))
- (progn
- ;; found a pathname -- add it to the manifest
- ;; buffer
- (save-excursion
- (set-buffer manifest-buf)
- (goto-char (point-max))
- (insert pathname "\n"))))
- (forward-line 1))
-
- ;; Processed all lines.
- ;; Now, create the file, pkginfo/MANIFEST.<pkgname>
-
- ;; We use `expand-file-name' instead of `concat',
- ;; for portability.
- (setq pathname (expand-file-name "pkginfo"
- pkg-topdir))
- ;; Create pkginfo, if necessary
- (if (not (file-directory-p pathname))
- (make-directory pathname))
- (setq pathname (expand-file-name
- (concat "MANIFEST." package-name)
- pathname))
- (save-excursion
- (set-buffer manifest-buf)
- ;; Put the files in sorted order
- (if-fboundp 'sort-lines
- (sort-lines nil (point-min) (point-max))
- (warn "`xemacs-base' not installed, MANIFEST.%s not sorted"
- package-name))
- ;; Write the file.
- ;; Note that using `write-region' *BYPASSES* any check
- ;; to see if XEmacs is currently editing/visiting the
- ;; file.
- (write-region (point-min) (point-max) pathname))
- (kill-buffer manifest-buf))))))
- ;; Restore old case-fold-search status
- (setq case-fold-search old-case-fold-search))))
+ ;; We use `expand-file-name' instead of `concat',
+ ;; for portability.
+ (setq pathname (expand-file-name "pkginfo"
+ pkg-topdir))
+ ;; Create pkginfo, if necessary
+ (if (not (file-directory-p pathname))
+ (make-directory pathname))
+ (setq pathname (expand-file-name
+ (concat "MANIFEST." package-name)
+ pathname))
+ (save-excursion
+ (set-buffer manifest-buf)
+ ;; Put the files in sorted order
+ (if-fboundp 'sort-lines
+ (sort-lines nil (point-min) (point-max))
+ (warn "`xemacs-base' not installed, MANIFEST.%s not sorted"
+ package-name))
+ ;; Write the file.
+ ;; Note that using `write-region' *BYPASSES* any check
+ ;; to see if XEmacs is currently editing/visiting the
+ ;; file.
+ (write-region (point-min) (point-max) pathname))
+ (kill-buffer manifest-buf))))))))
;;;###autoload
(defun package-admin-add-binary-package (file &optional pkg-dir)
diff -r 7eef89a3d41f -r 5690bb2e7a44 src/ChangeLog
--- a/src/ChangeLog Fri Oct 09 05:10:03 2009 +0900
+++ b/src/ChangeLog Sun Nov 01 15:54:15 2009 +0900
@@ -1,3 +1,50 @@
+2009-10-26 Aidan Kehoe <kehoea at parhasard.net>
+
+ * config.h.in (REALPATH_CORRECTS_CASE):
+ New #define, available on Darwin.
+ * realpath.c (readlink_or_correct_case):
+ On Darwin, use realpath(3)'s case correction to get the canonical
+ case for a file; thank you Robert Delius Royar!
+
+2009-10-11 Michael Sperber <mike at xemacs.org>
+
+ * event-stream.c (post_command_hook): Run `post-command-hook'
+ without INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION -
+ deleting other windows off that hook is legitimate.
+
+2009-10-08 Jerry James <james at xemacs.org>
+
+ * bytecode.c (bytecode_arithop): Make divide-by-zero errors
+ noncontinuable.
+ * floatfns.c (arith_error2): New macro for signaling divide-by-zero.
+ (ceiling_two_fixnum): Handle a value returned from a continuable error.
+ (ceiling_two_bignum): Ditto.
+ (ceiling_two_ratio): Ditto.
+ (ceiling_two_bigfloat): Ditto.
+ (ceiling_two_float): Ditto.
+ (floor_two_fixnum): Ditto.
+ (floor_two_bignum): Ditto.
+ (floor_two_ratio): Ditto.
+ (floor_two_bigfloat): Ditto.
+ (floor_two_float): Ditto.
+ (round_two_fixnum): Ditto.
+ (round_two_bignum): Ditto.
+ (round_two_ratio): Ditto.
+ (round_two_bigfloat): Ditto.
+ (round_two_float): Ditto.
+ (truncate_two_fixnum): Ditto.
+ (truncate_two_bignum): Ditto.
+ (truncate_two_ratio): Ditto.
+ (truncate_two_bigfloat): Ditto.
+ (truncate_two_float): Ditto.
+ (truncate_one_ratio): Truncating zero should result in zero.
+
+2009-10-10 Aidan Kehoe <kehoea at parhasard.net>
+
+ * rangetab.c (Frange_table_type):
+ Correct the docstring for this function, don't reuse that of
+ Frange_table_p.
+
2009-10-05 Jerry James <james at xemacs.org>
* emacs.c (main_1): Check the return value of dup() to quiet gcc.
diff -r 7eef89a3d41f -r 5690bb2e7a44 src/bytecode.c
--- a/src/bytecode.c Fri Oct 09 05:10:03 2009 +0900
+++ b/src/bytecode.c Sun Nov 01 15:54:15 2009 +0900
@@ -432,7 +432,8 @@
ival1 *= ival2; break;
#endif
case Bquo:
- if (ival2 == 0) Fsignal (Qarith_error, Qnil);
+ if (ival2 == 0)
+ signal_error_2 (Qarith_error, "division by zero", obj1, obj2);
ival1 /= ival2;
break;
case Bmax: if (ival1 < ival2) ival1 = ival2; break;
@@ -458,7 +459,7 @@
break;
case Bquo:
if (bignum_sign (XBIGNUM_DATA (obj2)) == 0)
- Fsignal (Qarith_error, Qnil);
+ signal_error_2 (Qarith_error, "division by zero", obj1, obj2);
bignum_div (scratch_bignum, XBIGNUM_DATA (obj1),
XBIGNUM_DATA (obj2));
break;
@@ -486,7 +487,7 @@
break;
case Bquo:
if (ratio_sign (XRATIO_DATA (obj2)) == 0)
- Fsignal (Qarith_error, Qnil);
+ signal_error_2 (Qarith_error, "division by zero", obj1, obj2);
ratio_div (scratch_ratio, XRATIO_DATA (obj1), XRATIO_DATA (obj2));
break;
case Bmax:
@@ -518,7 +519,7 @@
break;
case Bquo:
if (bigfloat_sign (XBIGFLOAT_DATA (obj2)) == 0)
- Fsignal (Qarith_error, Qnil);
+ signal_error_2 (Qarith_error, "division by zero", obj1, obj2);
bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (obj1),
XBIGFLOAT_DATA (obj2));
break;
@@ -540,7 +541,8 @@
case Bdiff: dval1 -= dval2; break;
case Bmult: dval1 *= dval2; break;
case Bquo:
- if (dval2 == 0.0) Fsignal (Qarith_error, Qnil);
+ if (dval2 == 0.0)
+ signal_error_2 (Qarith_error, "division by zero", obj1, obj2);
dval1 /= dval2;
break;
case Bmax: if (dval1 < dval2) dval1 = dval2; break;
@@ -585,7 +587,8 @@
case Bdiff: ival1 -= ival2; break;
case Bmult: ival1 *= ival2; break;
case Bquo:
- if (ival2 == 0) Fsignal (Qarith_error, Qnil);
+ if (ival2 == 0)
+ signal_error_2 (Qarith_error, "division by zero", obj1, obj2);
ival1 /= ival2;
break;
case Bmax: if (ival1 < ival2) ival1 = ival2; break;
@@ -603,7 +606,8 @@
case Bdiff: dval1 -= dval2; break;
case Bmult: dval1 *= dval2; break;
case Bquo:
- if (dval2 == 0) Fsignal (Qarith_error, Qnil);
+ if (dval2 == 0)
+ signal_error_2 (Qarith_error, "division by zero", obj1, obj2);
dval1 /= dval2;
break;
case Bmax: if (dval1 < dval2) dval1 = dval2; break;
diff -r 7eef89a3d41f -r 5690bb2e7a44 src/config.h.in
--- a/src/config.h.in Fri Oct 09 05:10:03 2009 +0900
+++ b/src/config.h.in Sun Nov 01 15:54:15 2009 +0900
@@ -339,6 +339,11 @@
#undef HAVE_LTDL
#undef DLSYM_NEEDS_UNDERSCORE
#undef HAVE_SHLIB
+
+/* Darwin; realpath corrects for case: */
+#ifdef HAVE_DYLD
+#define REALPATH_CORRECTS_CASE 1
+#endif
#undef HAVE_LIBINTL
#undef HAVE_LIBDNET
diff -r 7eef89a3d41f -r 5690bb2e7a44 src/event-stream.c
--- a/src/event-stream.c Fri Oct 09 05:10:03 2009 +0900
+++ b/src/event-stream.c Sun Nov 01 15:54:15 2009 +0900
@@ -4383,7 +4383,7 @@
safe_run_hook_trapping_problems
(Qcommand, Qpost_command_hook,
- INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION);
+ 0);
#if 0 /* FSF Emacs */
if (!NILP (current_buffer->mark_active))
diff -r 7eef89a3d41f -r 5690bb2e7a44 src/floatfns.c
--- a/src/floatfns.c Fri Oct 09 05:10:03 2009 +0900
+++ b/src/floatfns.c Sun Nov 01 15:54:15 2009 +0900
@@ -108,6 +108,8 @@
#define arith_error(op,arg) \
Fsignal (Qarith_error, list2 (build_msg_string (op), arg))
+#define arith_error2(op,a1,a2) \
+ Fsignal (Qarith_error, list3 (build_msg_string (op), a1, a2))
#define range_error(op,arg) \
Fsignal (Qrange_error, list2 (build_msg_string (op), arg))
#define range_error2(op,a1,a2) \
@@ -889,7 +891,6 @@
BIGFLOAT, return_float); \
return conversion##_one_mundane_arg (number, divisor, \
return_float)
-
#define CONVERT_WITHOUT_NUMBER_TYPES(conversion, return_float) \
if (!NILP (divisor)) \
@@ -943,23 +944,23 @@
#define MAYBE_ONE_ARG_BIGNUM(converse, return_float) \
if (BIGNUM_P (number)) \
- return conversion##_one_bignum (number, divisor, return_float)
+ return conversion##_one_bignum (number, divisor, return_float)
#else
#define MAYBE_TWO_ARGS_BIGNUM(conversion, return_float)
-#define MAYBE_ONE_ARG_BIGNUM(converse, return_float)
+#define MAYBE_ONE_ARG_BIGNUM(converse, return_float)
#endif
-#ifdef HAVE_RATIO
+#ifdef HAVE_RATIO
#define MAYBE_TWO_ARGS_RATIO(conversion, return_float) \
case RATIO_T: \
return conversion##_two_ratio (number, divisor, return_float)
#define MAYBE_ONE_ARG_RATIO(conversion, return_float) \
if (RATIOP (number)) \
- return conversion##_one_ratio (number, divisor, return_float)
+ return conversion##_one_ratio (number, divisor, return_float)
#else
#define MAYBE_TWO_ARGS_RATIO(conversion, return_float)
-#define MAYBE_ONE_ARG_RATIO(converse, return_float)
+#define MAYBE_ONE_ARG_RATIO(converse, return_float)
#endif
#ifdef HAVE_BIGFLOAT
@@ -969,10 +970,10 @@
#define MAYBE_ONE_ARG_BIGFLOAT(conversion, return_float) \
if (BIGFLOATP (number)) \
- return conversion##_one_bigfloat (number, divisor, return_float)
+ return conversion##_one_bigfloat (number, divisor, return_float)
#else
#define MAYBE_TWO_ARGS_BIGFLOAT(conversion, return_float)
-#define MAYBE_ONE_ARG_BIGFLOAT(converse, return_float)
+#define MAYBE_ONE_ARG_BIGFLOAT(converse, return_float)
#endif
#define MAYBE_TWO_ARGS_WITH_NUMBER_TYPES(convers, upcase, return_float) \
@@ -1015,7 +1016,7 @@
EMACS_INT i3 = 0, i4 = 0;
if (i2 == 0)
- Fsignal (Qarith_error, Qnil);
+ return arith_error2 ("ceiling", number, divisor);
/* With C89's integer /, the result is implementation-defined if either
operand is negative, so use only nonnegative operands. Here we do
@@ -1080,9 +1081,7 @@
Lisp_Object res0, res1;
if (bignum_sign (XBIGNUM_DATA (divisor)) == 0)
- {
- Fsignal (Qarith_error, Qnil);
- }
+ return arith_error2 ("ceiling", number, divisor);
bignum_ceil (scratch_bignum, XBIGNUM_DATA (number), XBIGNUM_DATA (divisor));
@@ -1112,9 +1111,7 @@
Lisp_Object res0, res1;
if (ratio_sign (XRATIO_DATA (divisor)) == 0)
- {
- Fsignal (Qarith_error, Qnil);
- }
+ return arith_error2 ("ceiling", number, divisor);
ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor));
@@ -1149,9 +1146,7 @@
Lisp_Object res0;
if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0)
- {
- Fsignal (Qarith_error, Qnil);
- }
+ return arith_error2 ("ceiling", number, divisor);
bigfloat_set_prec (scratch_bigfloat, max (XBIGFLOAT_GET_PREC (number),
XBIGFLOAT_GET_PREC (divisor)));
@@ -1248,12 +1243,10 @@
double f2 = extract_float (divisor);
double f0, remain;
Lisp_Object res0;
-
+
if (f2 == 0.0)
- {
- Fsignal (Qarith_error, Qnil);
- }
-
+ return arith_error2 ("ceiling", number, divisor);
+
IN_FLOAT2 (f0 = ceil (f1 / f2), MAYBE_EFF("ceiling"), number, divisor);
IN_FLOAT2 (remain = f1 - (f0 * f2), MAYBE_EFF("ceiling"), number, divisor);
@@ -1306,7 +1299,7 @@
#ifdef HAVE_BIGNUM
else if (BIGNUMP (number))
{
- return values2 (make_float
+ return values2 (make_float
(bignum_to_double (XBIGNUM_DATA (number))),
Qzero);
}
@@ -1323,7 +1316,7 @@
return values2 (number, Qzero);
}
}
-
+
MAYBE_CHAR_OR_MARKER (ceiling);
return Ffceiling (wrong_type_argument (Qnumberp, number), divisor);
@@ -1339,9 +1332,7 @@
Lisp_Object res0;
if (i2 == 0)
- {
- Fsignal (Qarith_error, Qnil);
- }
+ return arith_error2 ("floor", number, divisor);
/* With C89's integer /, the result is implementation-defined if either
operand is negative, so use only nonnegative operands. Notice also that
@@ -1373,9 +1364,7 @@
Lisp_Object res0, res1;
if (bignum_sign (XBIGNUM_DATA (divisor)) == 0)
- {
- Fsignal (Qarith_error, Qnil);
- }
+ return arith_error2 ("floor", number, divisor);
bignum_floor (scratch_bignum, XBIGNUM_DATA (number),
XBIGNUM_DATA (divisor));
@@ -1412,9 +1401,7 @@
Lisp_Object res0, res1;
if (ratio_sign (XRATIO_DATA (divisor)) == 0)
- {
- Fsignal (Qarith_error, Qnil);
- }
+ return arith_error2 ("floor", number, divisor);
ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor));
@@ -1449,9 +1436,7 @@
Lisp_Object res0;
if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0)
- {
- Fsignal (Qarith_error, Qnil);
- }
+ return arith_error2 ("floor", number, divisor);
bigfloat_set_prec (scratch_bigfloat, max (XBIGFLOAT_GET_PREC (number),
XBIGFLOAT_GET_PREC (divisor)));
@@ -1546,12 +1531,10 @@
double f1 = extract_float (number);
double f2 = extract_float (divisor);
double f0, remain;
-
+
if (f2 == 0.0)
- {
- Fsignal (Qarith_error, Qnil);
- }
-
+ return arith_error2 ("floor", number, divisor);
+
IN_FLOAT2 (f0 = floor (f1 / f2), MAYBE_EFF ("floor"), number, divisor);
IN_FLOAT2 (remain = f1 - (f0 * f2), MAYBE_EFF ("floor"), number, divisor);
@@ -1621,17 +1604,14 @@
/* Algorithm taken from cl-extra.el, now to be found as cl-round in
tests/automated/lisp-tests.el. */
static Lisp_Object
-round_two_fixnum (Lisp_Object number, Lisp_Object divisor,
- int return_float)
+round_two_fixnum (Lisp_Object number, Lisp_Object divisor, int return_float)
{
EMACS_INT i1 = XREALINT (number);
EMACS_INT i2 = XREALINT (divisor);
EMACS_INT i0, hi2, flooring, floored, flsecond;
if (i2 == 0)
- {
- Fsignal (Qarith_error, Qnil);
- }
+ return arith_error2 ("round", number, divisor);
hi2 = i2 < 0 ? -( -i2 / 2) : i2 / 2;
@@ -1716,15 +1696,12 @@
}
static Lisp_Object
-round_two_bignum (Lisp_Object number, Lisp_Object divisor,
- int return_float)
+round_two_bignum (Lisp_Object number, Lisp_Object divisor, int return_float)
{
Lisp_Object res0, res1;
if (bignum_sign (XBIGNUM_DATA (divisor)) == 0)
- {
- Fsignal (Qarith_error, Qnil);
- }
+ return arith_error2 ("round", number, divisor);
round_two_bignum_1 (XBIGNUM_DATA (number), XBIGNUM_DATA (divisor),
&res0, &res1);
@@ -1750,12 +1727,10 @@
Lisp_Object res0, res1;
if (ratio_sign (XRATIO_DATA (divisor)) == 0)
- {
- Fsignal (Qarith_error, Qnil);
- }
+ return arith_error2 ("round", number, divisor);
ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor));
-
+
round_two_bignum_1 (ratio_numerator (scratch_ratio),
ratio_denominator (scratch_ratio), &res0, &res1);
@@ -1766,7 +1741,7 @@
ratio_set_bignum (scratch_ratio2, XBIGNUM_DATA (res0));
ratio_mul (scratch_ratio, scratch_ratio2, XRATIO_DATA (divisor));
ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio);
-
+
res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio));
}
@@ -1853,9 +1828,7 @@
XBIGFLOAT_GET_PREC (divisor));
if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0)
- {
- Fsignal (Qarith_error, Qnil);
- }
+ return arith_error2 ("round", number, divisor);
bigfloat_init (divided);
bigfloat_set_prec (divided, prec);
@@ -1866,7 +1839,7 @@
bigfloat_set_prec (scratch_bigfloat, prec);
bigfloat_set_prec (scratch_bigfloat2, prec);
-
+
bigfloat_mul (scratch_bigfloat, XBIGFLOAT_DATA (res0),
XBIGFLOAT_DATA (divisor));
bigfloat_sub (scratch_bigfloat2, XBIGFLOAT_DATA (number),
@@ -1921,7 +1894,7 @@
Lisp_Object res0 = round_one_bigfloat_1 (XBIGFLOAT_DATA (number));
Lisp_Object res1;
- bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (number),
+ bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (number),
XBIGFLOAT_DATA (res0));
res1 = make_bigfloat_bf (scratch_bigfloat);
@@ -1948,12 +1921,12 @@
double f1 = extract_float (number);
double f2 = extract_float (divisor);
double f0, remain;
-
+
if (f2 == 0.0)
- Fsignal (Qarith_error, Qnil);
+ return arith_error2 ("round", number, divisor);
IN_FLOAT2 ((f0 = emacs_rint (f1 / f2)), MAYBE_EFF ("round"), number,
- divisor);
+ divisor);
IN_FLOAT2 (remain = f1 - (f0 * f2), MAYBE_EFF ("round"), number, divisor);
if (return_float)
@@ -1973,7 +1946,7 @@
double d;
/* Screw the prevailing rounding mode. */
IN_FLOAT ((d = emacs_rint (XFLOAT_DATA (number))), MAYBE_EFF ("round"),
- number);
+ number);
if (return_float)
{
@@ -1982,7 +1955,7 @@
else
{
return values2 ((float_to_int (d, MAYBE_EFF ("round"), number,
- Qunbound)),
+ Qunbound)),
make_float (XFLOAT_DATA (number) - d));
}
}
@@ -2014,11 +1987,11 @@
if (return_float)
{
- return Ffround (wrong_type_argument (Qnumberp, number), divisor);
+ return Ffround (wrong_type_argument (Qnumberp, number), divisor);
}
else
{
- return Fround (wrong_type_argument (Qnumberp, number), divisor);
+ return Fround (wrong_type_argument (Qnumberp, number), divisor);
}
}
@@ -2031,7 +2004,7 @@
EMACS_INT i0;
if (i2 == 0)
- Fsignal (Qarith_error, Qnil);
+ return arith_error2 ("truncate", number, divisor);
/* We're truncating towards zero, so apart from avoiding the C89
implementation-defined behaviour with truncation and negative numbers,
@@ -2058,9 +2031,7 @@
Lisp_Object res0;
if (bignum_sign (XBIGNUM_DATA (divisor)) == 0)
- {
- Fsignal (Qarith_error, Qnil);
- }
+ return arith_error2 ("truncate", number, divisor);
bignum_div (scratch_bignum, XBIGNUM_DATA (number),
XBIGNUM_DATA (divisor));
@@ -2096,9 +2067,7 @@
Lisp_Object res0;
if (ratio_sign (XRATIO_DATA (divisor)) == 0)
- {
- Fsignal (Qarith_error, Qnil);
- }
+ return arith_error2 ("truncate", number, divisor);
ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor));
@@ -2138,9 +2107,7 @@
XBIGFLOAT_GET_PREC (divisor));
if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0)
- {
- Fsignal (Qarith_error, Qnil);
- }
+ return arith_error2 ("truncate", number, divisor);
bigfloat_set_prec (scratch_bigfloat, prec);
bigfloat_set_prec (scratch_bigfloat2, prec);
@@ -2162,7 +2129,7 @@
res0 = make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat));
#endif /* HAVE_BIGNUM */
}
-
+
bigfloat_mul (scratch_bigfloat2, scratch_bigfloat, XBIGFLOAT_DATA (divisor));
bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (number), scratch_bigfloat2);
@@ -2178,9 +2145,7 @@
Lisp_Object res0;
if (ratio_sign (XRATIO_DATA (number)) == 0)
- {
- Fsignal (Qarith_error, Qnil);
- }
+ return Qzero;
bignum_div (scratch_bignum, XRATIO_NUMERATOR (number),
XRATIO_DENOMINATOR (number));
@@ -2234,7 +2199,7 @@
bigfloat_sub (scratch_bigfloat2, XBIGFLOAT_DATA (number), scratch_bigfloat);
return
- values2 (res0,
+ values2 (res0,
Fcanonicalize_number (make_bigfloat_bf (scratch_bigfloat2)));
}
#endif /* HAVE_BIGFLOAT */
@@ -2247,11 +2212,9 @@
double f2 = extract_float (divisor);
double f0, remain;
Lisp_Object res0;
-
+
if (f2 == 0.0)
- {
- Fsignal (Qarith_error, Qnil);
- }
+ return arith_error2 ("truncate", number, divisor);
res0 = float_to_int (f1 / f2, MAYBE_EFF ("truncate"), number, Qunbound);
f0 = extract_float (res0);
@@ -2325,7 +2288,7 @@
Return the smallest integer no less than NUMBER. (Round toward +inf.)
With optional argument DIVISOR, return the smallest integer no less than
-the quotient of NUMBER and DIVISOR.
+the quotient of NUMBER and DIVISOR.
This function returns multiple values; see `multiple-value-bind' and
`multiple-value-call'. The second returned value is the remainder in the
diff -r 7eef89a3d41f -r 5690bb2e7a44 src/rangetab.c
--- a/src/rangetab.c Fri Oct 09 05:10:03 2009 +0900
+++ b/src/rangetab.c Sun Nov 01 15:54:15 2009 +0900
@@ -290,7 +290,10 @@
}
DEFUN ("range-table-type", Frange_table_type, 1, 1, 0, /*
-Return non-nil if OBJECT is a range table.
+Return the type of RANGE-TABLE.
+
+This will be a symbol describing how ranges in RANGE-TABLE function at their
+ends; see `make-range-table'.
*/
(range_table))
{
diff -r 7eef89a3d41f -r 5690bb2e7a44 src/realpath.c
--- a/src/realpath.c Fri Oct 09 05:10:03 2009 +0900
+++ b/src/realpath.c Sun Nov 01 15:54:15 2009 +0900
@@ -78,6 +78,11 @@
DOES NOT ZERO TERMINATE!!!!!
*/
+#ifdef REALPATH_CORRECTS_CASE /* Darwin */
+#include <sys/param.h>
+#include <stdlib.h>
+#endif
+
static int
readlink_or_correct_case (const Ibyte *name, Ibyte *buf, Bytecount size,
#ifndef WIN32_ANY
@@ -88,8 +93,52 @@
)
{
#ifndef WIN32_ANY
+#ifdef REALPATH_CORRECTS_CASE
+ /* Darwin's realpath corrects file name case, so we want to use that
+ here, as well as our own, non-case-correcting, implementation
+ further down in this file.
+
+ It might be reasonable to incorporate case correction in our own
+ realpath implementation, which would help things with
+ case-insensitive file systems on Linux; one way to do this would
+ be to make sure that init_initial_directory and
+ get_initial_directory always give the correct case. */
+ int n = qxe_readlink (name, buf, (size_t) size);
+ Extbyte realpath_buf[PATH_MAX], *tmp;
+ DECLARE_EISTRING (realpathing);
+
+ if (n >= 0 || errno != EINVAL)
+ return n;
+
+ eicpy_rawz (realpathing, name);
+ eito_external (realpathing, Qfile_name);
+ tmp = realpath (eiextdata (realpathing), realpath_buf);
+
+ if (!tmp)
+ return -1;
+
+ if (0 == memcmp (eiextdata (realpathing), realpath_buf,
+ eiextlen (realpathing)))
+ {
+ /* No case change needed; tell the caller that. */
+ errno = EINVAL;
+ return -1;
+ }
+
+ eireset (realpathing);
+ eicpy_ext (realpathing, realpath_buf, Qfile_name);
+ if (eilen (realpathing) > size)
+ {
+ errno = ERANGE;
+ return -1;
+ }
+
+ memcpy (buf, eidata (realpathing), eilen (realpathing));
+ return eilen (realpathing);
+#else /* !REALPATH_CORRECTS_CASE */
return qxe_readlink (name, buf, (size_t) size);
-#else
+#endif /* REALPATH_CORRECTS_CASE */
+#else /* defined (WIN32_ANY) */
# ifdef CYGWIN
Ibyte *tmp;
int n = qxe_readlink (name, buf, (size_t) size);
diff -r 7eef89a3d41f -r 5690bb2e7a44 tests/ChangeLog
--- a/tests/ChangeLog Fri Oct 09 05:10:03 2009 +0900
+++ b/tests/ChangeLog Sun Nov 01 15:54:15 2009 +0900
@@ -1,3 +1,13 @@
+2009-10-12 Aidan Kehoe <kehoea at parhasard.net>
+
+ * automated/mule-tests.el :
+ Revert to the old Unicode mapping for scaron once we're finished
+ testing it.
+ Don't check the fixed-width coding systems with odd line endings
+ for ASCII-transparency; maybe we should, but that would require
+ that invalid sequence characters for on-disk ?\x0a be generated by
+ Macintosh line-ending coding systems, for example.
+
2009-10-05 Jerry James <jamesjer at xemacs.org>
* gtk/event-stream-tests.el: Add GPL v2 or later notice with
diff -r 7eef89a3d41f -r 5690bb2e7a44 tests/automated/ccl-tests.el
--- a/tests/automated/ccl-tests.el Fri Oct 09 05:10:03 2009 +0900
+++ b/tests/automated/ccl-tests.el Sun Nov 01 15:54:15 2009 +0900
@@ -132,7 +132,7 @@
"CCL TEST temporary coding-system."
'(mnemonic "CCL-TEST"
eol-type lf
- safe-chars t
+ safe-charsets t
decode ccl-test-decoder
encode ccl-test-encoder))))
diff -r 7eef89a3d41f -r 5690bb2e7a44 tests/automated/mule-tests.el
--- a/tests/automated/mule-tests.el Fri Oct 09 05:10:03 2009 +0900
+++ b/tests/automated/mule-tests.el Sun Nov 01 15:54:15 2009 +0900
@@ -427,12 +427,15 @@
;;---------------------------------------------------------------
(let* ((scaron (make-char 'latin-iso8859-2 57)))
;; Used to try #x0000, but you can't change ASCII or Latin-1
- (loop for code in '(#x0100 #x2222 #x4444 #xffff) do
+ (loop
+ for code in '(#x0100 #x2222 #x4444 #xffff)
+ with initial-unicode = (char-to-unicode scaron)
+ do
(progn
(set-unicode-conversion scaron code)
(Assert (eq code (char-to-unicode scaron)))
- (Assert (eq scaron (unicode-to-char code '(latin-iso8859-2))))))
-
+ (Assert (eq scaron (unicode-to-char code '(latin-iso8859-2)))))
+ finally (set-unicode-conversion scaron initial-unicode))
(Check-Error wrong-type-argument (set-unicode-conversion scaron -10000)))
(dolist (utf-8-char
@@ -531,17 +534,16 @@
collect i))
do
(when (and (eq 'fixed-width (coding-system-type coding-system))
- ;; Don't check the coding systems with autodetect, they are
- ;; not round-trip compatible for the possible line-ending
- ;; characters.
- (string-match #r"-\(unix\|dos\|mac\)$"
- (symbol-name coding-system)))
+ ;; Don't check the coding systems with odd line endings
+ ;; (maybe we should):
+ (eq 'lf (coding-system-eol-type coding-system)))
;; These coding systems are round-trip compatible with themselves.
(Assert (equal (encode-coding-string
(decode-coding-string all-possible-octets
coding-system)
coding-system)
- all-possible-octets))))
+ all-possible-octets)
+ (format "checking %s is transparent" coding-system))))
;;---------------------------------------------------------------
;; Test charset-in-* functions
More information about the XEmacs-Patches
mailing list