Mercurial > hg > xemacs-beta

changeset 5445:6506fcb40fcf

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merged with trunk.
author Mats Lidell <matsl@xemacs.org>
date Fri, 31 Dec 2010 00:27:29 +0100
parents 388762703a21 (current diff) d0bb90d90736 (diff)
children 08059af55218
files lisp/ChangeLog lisp/byte-optimize.el lisp/cl-extra.el lisp/cl-macs.el lisp/cl.el lisp/iso8859-1.el lisp/simple.el lisp/subr.el lisp/update-elc.el lisp/x-misc.el src/ChangeLog src/abbrev.c src/chartab.c src/elhash.c src/floatfns.c src/general-slots.h src/general.c src/lisp.h tests/ChangeLog tests/automated/lisp-tests.el
diffstat 20 files changed, 405 insertions(+), 128 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sun Dec 26 01:48:40 2010 +0100
+++ b/lisp/ChangeLog	Fri Dec 31 00:27:29 2010 +0100
@@ -1,3 +1,79 @@
+2010-12-30  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* x-misc.el (device-x-display):
+	Provide this function, documented in the Lispref for years, but
+	not existing previously.  Thank you Julian Bradfield, thank you
+	Jeff Mincy.
+
+2010-12-30  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* simple.el (assoc-ignore-case): Remove a duplicate definition of
+	this function (it's already in subr.el).
+	* iso8859-1.el (char-width):
+	On non-Mule, make this function equivalent to that produced by
+	(constantly 1), but preserve its docstring.
+	* subr.el (subst-char-in-string): Define this in terms of
+	#'substitute, #'nsubstitute.
+	(string-width): Define this using #'reduce and #'char-width.
+	(char-width): Give this a simpler definition, it makes far more
+	sense to check for mule at load time and redefine, as we do in
+	iso8859-1.el. 
+	(store-substring): Implement this in terms of #'replace, now
+	#'replace is cheap.
+
+2010-12-30  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* update-elc.el (lisp-files-needed-for-byte-compilation)
+	(lisp-files-needing-early-byte-compilation):
+	cl-macs belongs in the former, not the latter, it is as
+	fundamental as bytecomp.el.
+
+2010-12-30  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl.el:
+	Provde the Common Lisp program-error, type-error as error
+	symbols. This doesn't nearly go far enough for anyone using the
+	Common Lisp errors.
+
+2010-12-29  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-macs.el (delete-duplicates):
+	If the form has an incorrect number of arguments, don't attempt a
+	compiler macroexpansion.
+
+2010-12-29  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-macs.el (cl-safe-expr-p):
+	Forms that start with the symbol lambda are also safe.
+
+2010-12-29  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-macs.el (= < > <= >=):
+	For these functions' compiler macros, the optimisation is safe
+	even if the first and the last arguments have side effects, since
+	they're only used the once.
+
+2010-12-29  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-macs.el (inline-side-effect-free-compiler-macros):
+	Unroll a loop here at macro-expansion time, so these compiler
+	macros are compiled.  Use #'eql instead of #'eq in a couple of
+	places for better style.
+
+2010-12-29  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-extra.el (notany, notevery): Avoid some dynamic scope
+	stupidity with local variable names in these functions, when they
+	weren't prefixed with cl-; go into some more detail in the doc
+	strings.
+
+2010-12-29  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* byte-optimize.el (side-effect-free-fns): #'remove, #'remq are
+	free of side-effects.
+	(side-effect-and-error-free-fns):
+	Drop dot, dot-marker from the list.
+
 2010-11-17  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* cl-extra.el (coerce):
--- a/lisp/byte-optimize.el	Sun Dec 26 01:48:40 2010 +0100
+++ b/lisp/byte-optimize.el	Fri Dec 31 00:27:29 2010 +0100
@@ -1243,7 +1243,7 @@
 	 marker-buffer max member memq min mod
 	 next-window nth nthcdr number-to-string numerator
 	 parse-colon-path plist-get previous-window
-	 radians-to-degrees rassq regexp-quote reverse round
+	 radians-to-degrees rassq rassoc remove remq regexp-quote reverse round
 	 sin sqrt string< string= string-equal string-lessp string-to-char
 	 string-to-int string-to-number substring symbol-plist symbol-value
 	 symbol-name symbol-function symbol
@@ -1269,7 +1269,7 @@
 	 current-buffer
 	 ;; XEmacs: extent functions, frame-live-p, various other stuff
 	 devicep device-live-p
-	 dot dot-marker eobp eolp eq eql equal eventp extentp
+	 eobp eolp eq eql equal eventp extentp
 	 extent-live-p fixnump floatingp floatp framep frame-live-p
 	 get-largest-window get-lru-window
 	 hash-table-p
--- a/lisp/cl-extra.el	Sun Dec 26 01:48:40 2010 +0100
+++ b/lisp/cl-extra.el	Fri Dec 31 00:27:29 2010 +0100
@@ -126,13 +126,23 @@
   `(lambda (&rest arguments) ,@(if documentation (list documentation))
      (not (apply ',function arguments))))
 
-(defun notany (cl-pred cl-seq &rest cl-rest)
-  "Return true if PREDICATE is false of every element of SEQ or SEQs."
-  (not (apply 'some cl-pred cl-seq cl-rest)))
+(defun notany (cl-predicate cl-seq &rest cl-rest)
+  "Return true if PREDICATE is false of every element of SEQUENCE.
+
+With optional SEQUENCES, call PREDICATE each time with as many arguments as
+there are SEQUENCES (plus one for the element from SEQUENCE).
+
+arguments: (PREDICATE SEQUENCES &rest SEQUENCES)"
+  (not (apply 'some cl-predicate cl-seq cl-rest)))
 
-(defun notevery (cl-pred cl-seq &rest cl-rest)
-  "Return true if PREDICATE is false of some element of SEQ or SEQs."
-  (not (apply 'every cl-pred cl-seq cl-rest)))
+(defun notevery (cl-predicate cl-seq &rest cl-rest)
+  "Return true if PREDICATE is false of some element of SEQUENCE.
+
+With optional SEQUENCES, call PREDICATE each time with as many arguments as
+there are SEQUENCES (plus one for the element from SEQUENCE).
+
+arguments: (PREDICATE SEQUENCES &rest SEQUENCES)"
+  (not (apply 'every cl-predicate cl-seq cl-rest)))
 
 ;;; Support for `loop'.
 (defalias 'cl-map-keymap 'map-keymap)
--- a/lisp/cl-macs.el	Sun Dec 26 01:48:40 2010 +0100
+++ b/lisp/cl-macs.el	Fri Dec 31 00:27:29 2010 +0100
@@ -109,7 +109,8 @@
 
 ;;; Check if no side effects.
 (defun cl-safe-expr-p (x)
-  (or (not (and (consp x) (not (memq (car x) '(quote function function*)))))
+  (or (not (and (consp x) (not (memq (car x)
+                                     '(quote function function* lambda)))))
       (and (symbolp (car x))
 	   (or (memq (car x) cl-simple-funcs)
 	       (memq (car x) cl-safe-funcs)
@@ -3484,56 +3485,60 @@
 ;; XEmacs; inline delete-duplicates if it's called with one of the
 ;; common compile-time constant tests and an optional :from-end
 ;; argument, we want the speed in font-lock.el.
-(define-compiler-macro delete-duplicates (&whole form cl-seq &rest cl-keys)
-  (if (not (or (memq (car-safe cl-seq)
-		     ;; No need to check for a list at runtime with
-		     ;; these. We could expand the list, but these are all
-		     ;; the functions in the relevant context at the moment.
-		     '(nreverse append nconc mapcan mapcar string-to-list))
-	       (and (listp cl-seq) (equal (butlast cl-seq) '(the list)))))
-      form
-    (cond
-     ((or (plists-equal cl-keys '(:test 'eq) t)
-	  (plists-equal cl-keys '(:test #'eq) t))
-      `(let* ((begin ,cl-seq)
-	      cl-seq)
-	(while (memq (car begin) (cdr begin))
-	  (setq begin (cdr begin)))
-	(setq cl-seq begin)
-	(while (cddr cl-seq)
-	  (if (memq (cadr cl-seq) (cddr cl-seq))
-	      (setcdr (cdr cl-seq) (cddr cl-seq)))
-	  (setq cl-seq (cdr cl-seq)))
-	begin))
-     ((or (plists-equal cl-keys '(:test 'eq :from-end t) t)
-	  (plists-equal cl-keys '(:test #'eq :from-end t) t))
-      `(let* ((begin ,cl-seq)
-	      (cl-seq begin))
-	(while cl-seq
-	  (setq cl-seq (setcdr cl-seq
-			       (delq (car cl-seq) (cdr cl-seq)))))
-	begin))
-     ((or (plists-equal cl-keys '(:test 'equal) t)
-	  (plists-equal cl-keys '(:test #'equal) t))
-      `(let* ((begin ,cl-seq)
-	      cl-seq)
-	(while (member (car begin) (cdr begin))
-	  (setq begin (cdr begin)))
-	(setq cl-seq begin)
-	(while (cddr cl-seq)
-	  (if (member (cadr cl-seq) (cddr cl-seq))
-	      (setcdr (cdr cl-seq) (cddr cl-seq)))
-	  (setq cl-seq (cdr cl-seq)))
-	begin))
-     ((or (plists-equal cl-keys '(:test 'equal :from-end t) t)
-	  (plists-equal cl-keys '(:test #'equal :from-end t) t))
-      `(let* ((begin ,cl-seq)
-	      (cl-seq begin))
-	(while cl-seq
-	  (setq cl-seq (setcdr cl-seq (delete (car cl-seq)
-					      (cdr cl-seq)))))
-	begin))
-     (t form))))
+(define-compiler-macro delete-duplicates (&whole form &rest cl-keys)
+  (let ((cl-seq (if cl-keys (pop cl-keys))))
+    (if (or 
+	 (not (or (memq (car-safe cl-seq)
+			;; No need to check for a list at runtime with
+			;; these. We could expand the list, but these are all
+			;; the functions in the relevant context at the moment.
+			'(nreverse append nconc mapcan mapcar string-to-list))
+		 (and (listp cl-seq) (equal (butlast cl-seq) '(the list)))))
+	 ;; Wrong number of arguments.
+	 (not (cdr form)))
+	form
+      (cond
+       ((or (plists-equal cl-keys '(:test 'eq) t)
+	    (plists-equal cl-keys '(:test #'eq) t))
+	`(let* ((begin ,cl-seq)
+		cl-seq)
+	  (while (memq (car begin) (cdr begin))
+	    (setq begin (cdr begin)))
+	  (setq cl-seq begin)
+	  (while (cddr cl-seq)
+	    (if (memq (cadr cl-seq) (cddr cl-seq))
+		(setcdr (cdr cl-seq) (cddr cl-seq)))
+	    (setq cl-seq (cdr cl-seq)))
+	  begin))
+       ((or (plists-equal cl-keys '(:test 'eq :from-end t) t)
+	    (plists-equal cl-keys '(:test #'eq :from-end t) t))
+	`(let* ((begin ,cl-seq)
+		(cl-seq begin))
+	  (while cl-seq
+	    (setq cl-seq (setcdr cl-seq
+				 (delq (car cl-seq) (cdr cl-seq)))))
+	  begin))
+       ((or (plists-equal cl-keys '(:test 'equal) t)
+	    (plists-equal cl-keys '(:test #'equal) t))
+	`(let* ((begin ,cl-seq)
+		cl-seq)
+	  (while (member (car begin) (cdr begin))
+	    (setq begin (cdr begin)))
+	  (setq cl-seq begin)
+	  (while (cddr cl-seq)
+	    (if (member (cadr cl-seq) (cddr cl-seq))
+		(setcdr (cdr cl-seq) (cddr cl-seq)))
+	    (setq cl-seq (cdr cl-seq)))
+	  begin))
+       ((or (plists-equal cl-keys '(:test 'equal :from-end t) t)
+	    (plists-equal cl-keys '(:test #'equal :from-end t) t))
+	`(let* ((begin ,cl-seq)
+		(cl-seq begin))
+	  (while cl-seq
+	    (setq cl-seq (setcdr cl-seq (delete (car cl-seq)
+						(cdr cl-seq)))))
+	  begin))
+       (t 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
@@ -3750,7 +3755,7 @@
          (put function 'cl-compiler-macro
               #'(lambda (form &rest arguments)
                   (if (or (null (nthcdr 3 form))
-                          (notevery #'cl-safe-expr-p (cdr form)))
+                          (notevery #'cl-safe-expr-p (butlast (cdr arguments))))
                       form
                     (cons 'and (mapcon
                                 #'(lambda (rest)
@@ -3760,22 +3765,28 @@
                                 (cdr form)))))))
      '(= < > <= >=))
 
-(mapc
- #'(lambda (y)
-     (put (car y) 'side-effect-free t)
-     (put (car y) 'byte-compile 'cl-byte-compile-compiler-macro)
-     (put (car y) 'cl-compiler-macro
-	  (list 'lambda '(w x)
-		(if (symbolp (cadr y))
-		    (list 'list (list 'quote (cadr y))
-			  (list 'list (list 'quote (caddr y)) 'x))
-		  (cons 'list (cdr y))))))
- '((first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x)
+;; XEmacs; unroll this loop at macro-expansion time, so the compiler macros
+;; are byte-compiled.
+(macrolet
+    ((inline-side-effect-free-compiler-macros (&rest details)
+       (cons
+        'progn
+        (loop
+          for (function . details) in details
+          nconc `((put ',function 'side-effect-free t)
+                  (define-compiler-macro ,function (&whole form x)
+                    ,(if (symbolp (car details))
+                         (reduce #'(lambda (object1 object2)
+                                     `(list ',object1 ,object2))
+                                 details :from-end t :initial-value 'x)
+                       (cons 'list details))))))))
+  (inline-side-effect-free-compiler-macros
+   (first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x)
    (fifth 'nth 4 x) (sixth 'nth 5 x) (seventh 'nth 6 x)
    (eighth 'nth 7 x) (ninth 'nth 8 x) (tenth 'nth 9 x)
    (rest 'cdr x) (plusp '> x 0) (minusp '< x 0)
-   (oddp  'eq (list 'logand x 1) 1)
-   (evenp 'eq (list 'logand x 1) 0)
+   (oddp  'eql (list 'logand x 1) 1)
+   (evenp 'eql (list 'logand x 1) 0)
    (caar car car) (cadr car cdr) (cdar cdr car) (cddr cdr cdr)
    (caaar car caar) (caadr car cadr) (cadar car cdar)
    (caddr car cddr) (cdaar cdr caar) (cdadr cdr cadr)
--- a/lisp/cl.el	Sun Dec 26 01:48:40 2010 +0100
+++ b/lisp/cl.el	Fri Dec 31 00:27:29 2010 +0100
@@ -601,6 +601,19 @@
 ;; XEmacs change
 (define-error 'cl-assertion-failed "Assertion failed")
 
+;; XEmacs; provide a milquetoast amount of compatibility in our error symbols.
+(define-error 'type-error "Wrong type" 'wrong-type-argument)
+(define-error 'program-error "Error in your program" 'invalid-argument)
+
+(map-plist
+ #'(lambda (key value)
+     (mapc #'(lambda (error)
+               (put error 'error-conditions
+                    (cons key (get error 'error-conditions))))
+           value))
+ '(program-error (wrong-number-of-arguments invalid-keyword-argument)
+   type-error (wrong-type-argument malformed-list circular-list)))
+
 ;; XEmacs change: omit the autoload rules; we handle those a different way
 
 ;;; Define data for indentation and edebug.
--- a/lisp/iso8859-1.el	Sun Dec 26 01:48:40 2010 +0100
+++ b/lisp/iso8859-1.el	Fri Dec 31 00:27:29 2010 +0100
@@ -82,6 +82,17 @@
 ;; by default.
 (setq-default ctl-arrow #xA0)
 
+(when (and (compiled-function-p (symbol-function 'char-width))
+	   (not (featurep 'mule)))
+  (defalias 'char-width
+    (let ((constantly (constantly 1)))
+     (make-byte-code (compiled-function-arglist constantly)
+		     (compiled-function-instructions constantly)
+		     (compiled-function-constants constantly)
+		     (compiled-function-stack-depth constantly)
+		     (compiled-function-doc-string
+		      (symbol-function 'char-width))))))
+
 ;; Shouldn't be necessary, but one file in the packages uses it:
 (provide 'iso8859-1) 
 
--- a/lisp/simple.el	Sun Dec 26 01:48:40 2010 +0100
+++ b/lisp/simple.el	Fri Dec 31 00:27:29 2010 +0100
@@ -3330,11 +3330,6 @@
 ;; keyboard-quit
 ;; buffer-quit-function
 ;; keyboard-escape-quit
-
-(defun assoc-ignore-case (key alist)
-  "Like `assoc', but assumes KEY is a string and ignores case when comparing."
-  (assoc* key alist :test #'equalp))
-
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;                          mail composition code                        ;;
--- a/lisp/subr.el	Sun Dec 26 01:48:40 2010 +0100
+++ b/lisp/subr.el	Fri Dec 31 00:27:29 2010 +0100
@@ -763,14 +763,8 @@
 (defun subst-char-in-string (fromchar tochar string &optional inplace)
   "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
 Unless optional argument INPLACE is non-nil, return a new string."
-  (let ((i (length string))
-	(newstr (if inplace string (copy-sequence string))))
-    (while (> i 0)
-      (setq i (1- i))
-      (if (eq (aref newstr i) fromchar)
-	  (aset newstr i tochar)))
-    newstr))
-
+  (funcall (if inplace #'nsubstitute #'substitute) tochar fromchar
+	   (the string string) :test #'eq))
 
 ;; XEmacs addition:
 (defun replace-in-string (str regexp newtext &optional literal)
@@ -959,23 +953,11 @@
 the characters in STRING, which may not accurately represent the actual
 display width when using a window system.  With no international support,
 simply returns the length of the string."
-  (if (featurep 'mule)
-      (let ((col 0)
-	    (len (length string))
-	    (i 0))
-	(with-fboundp '(charset-width char-charset)
-	  (while (< i len)
-	    (setq col (+ col (charset-width (char-charset (aref string i)))))
-	    (setq i (1+ i))))
-	col)
-    (length string)))
+  (reduce #'+ (the string string) :initial-value 0 :key #'char-width))
 
 (defun char-width (character)
   "Return number of columns a CHARACTER occupies when displayed."
-  (if (featurep 'mule)
-      (with-fboundp '(charset-width char-charset)
-	(charset-width (char-charset character)))
-    1))
+  (charset-width (char-charset character)))
 
 ;; The following several functions are useful in GNU Emacs 20 because
 ;; of the multibyte "characters" the internal representation of which
@@ -1001,18 +983,9 @@
 
 (defun store-substring (string idx obj)
   "Embed OBJ (string or character) at index IDX of STRING."
-  (let* ((str (cond ((stringp obj) obj)
-		    ((characterp obj) (char-to-string obj))
-		    (t (error
-			"Invalid argument (should be string or character): %s"
-			obj))))
-	 (string-len (length string))
-	 (len (length str))
-	 (i 0))
-    (while (and (< i len) (< idx string-len))
-      (aset string idx (aref str i))
-      (setq idx (1+ idx) i (1+ i)))
-    string))
+  (if (stringp obj)
+      (replace (the string string) obj :start1 idx)
+    (prog1 string (aset string idx obj))))
 
 ;; From FSF 21.1; ELLIPSES is XEmacs addition.
 
--- a/lisp/update-elc.el	Sun Dec 26 01:48:40 2010 +0100
+++ b/lisp/update-elc.el	Fri Dec 31 00:27:29 2010 +0100
@@ -100,6 +100,7 @@
 ;; .elc's.
 (defvar lisp-files-needed-for-byte-compilation
   '("bytecomp"
+    "cl-macs"
     "byte-optimize"))
 
 ;; Lisp files not in `lisp-files-needed-for-byte-compilation' that need
@@ -108,8 +109,7 @@
 (defvar lisp-files-needing-early-byte-compilation
   '("easy-mmode"
     "autoload"
-    "shadow"
-    "cl-macs"))
+    "shadow"))
 
 (defvar unbytecompiled-lisp-files
   '("paths.el"
--- a/lisp/x-misc.el	Sun Dec 26 01:48:40 2010 +0100
+++ b/lisp/x-misc.el	Fri Dec 31 00:27:29 2010 +0100
@@ -84,4 +84,10 @@
       (x-bogosity-check-resource name class type))
   (x-get-resource name class type locale nil 'warn))
 
+(defun device-x-display (&optional device)
+  "If DEVICE is an X11 device, return its DISPLAY.
+
+DEVICE defaults to the selected device."
+  (and (eq 'x (device-type device)) (device-connection device)))
+
 ;;; x-misc.el ends here
--- a/src/ChangeLog	Sun Dec 26 01:48:40 2010 +0100
+++ b/src/ChangeLog	Fri Dec 31 00:27:29 2010 +0100
@@ -1,3 +1,26 @@
+2010-12-30  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* lisp.h (DECLARE_N_KEYWORDS_8, DECLARE_N_KEYWORDS_9)
+	(CHECK_N_KEYWORDS_8, CHECK_N_KEYWORDS_9):
+	Support up to nine keywords in the PARSE_KEYWORDS() macro.
+
+2010-12-30  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* elhash.c (syms_of_elhash): 
+	* chartab.c (syms_of_chartab):
+	* abbrev.c (syms_of_abbrev):
+	* general-slots.h:
+	Move Qcount, Q_default, Q_test to general-slots.h, they're about
+	to be used by other files. Rename Q_default to Q_default_, for the
+	sake of the PARSE_KEYWORDS macro (given that default is a reserved
+	identifier in C). Add SYMBOL_KEYWORD_GENERAL(), analogous to
+	SYMBOL_GENERAL() to make this easier.
+
+2010-12-29  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* floatfns.c (Ffloat): If we've been handed a bigfloat here, it's
+	appropriate to give the same bigfloat back.
+
 2010-11-30  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* fns.c (Ffill):
--- a/src/abbrev.c	Sun Dec 26 01:48:40 2010 +0100
+++ b/src/abbrev.c	Fri Dec 31 00:27:29 2010 +0100
@@ -73,7 +73,7 @@
 /* Hook to run before expanding any abbrev.  */
 Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook;
 
-Lisp_Object Qsystem_type, Qcount;
+Lisp_Object Qsystem_type;
 
 struct abbrev_match_mapper_closure
 {
@@ -556,9 +556,6 @@
 void
 syms_of_abbrev (void)
 {
-  DEFSYMBOL(Qcount);
-  Qcount = intern ("count");
-  staticpro (&Qcount);
   DEFSYMBOL(Qsystem_type);
   Qsystem_type = intern ("system-type");
   DEFSYMBOL (Qpre_abbrev_expand_hook);
--- a/src/chartab.c	Sun Dec 26 01:48:40 2010 +0100
+++ b/src/chartab.c	Fri Dec 31 00:27:29 2010 +0100
@@ -40,7 +40,7 @@
 #include "chartab.h"
 #include "syntax.h"
 
-Lisp_Object Qchar_tablep, Qchar_table, Q_default;
+Lisp_Object Qchar_tablep, Qchar_table;
 
 Lisp_Object Vall_syntax_tables;
 
@@ -1579,7 +1579,7 @@
 	    {
 	      type = value;
 	    }
-	  else if (EQ (key, Q_default))
+	  else if (EQ (key, Q_default_))
 	    {
 	      default_ = value;
 	    }
@@ -1624,7 +1624,11 @@
       check_valid_char_table_value (default_, XCHAR_TABLE_TYPE (chartab),
 				    ERROR_ME);
       set_char_table_default (chartab, default_);
-      set_char_table_default (XCHAR_TABLE (chartab)->mirror_table, default_);
+      if (!NILP (XCHAR_TABLE (chartab)->mirror_table))
+        {
+          set_char_table_default (XCHAR_TABLE (chartab)->mirror_table,
+                                  default_);
+        }
     }
 
   while (!NILP (dataval))
@@ -1900,7 +1904,6 @@
 
   DEFSYMBOL (Qchar_table);
   DEFSYMBOL_MULTIWORD_PREDICATE (Qchar_tablep);
-  DEFKEYWORD (Q_default);
 
   DEFSUBR (Fchar_table_p);
   DEFSUBR (Fchar_table_type_list);
@@ -1955,7 +1958,7 @@
 
   define_structure_type_keyword (st, Q_type, chartab_type_validate);
   define_structure_type_keyword (st, Q_data, chartab_data_validate);
-  define_structure_type_keyword (st, Q_default, chartab_default_validate);
+  define_structure_type_keyword (st, Q_default_, chartab_default_validate);
 }
 
 void
--- a/src/elhash.c	Sun Dec 26 01:48:40 2010 +0100
+++ b/src/elhash.c	Fri Dec 31 00:27:29 2010 +0100
@@ -91,7 +91,7 @@
 static Lisp_Object Qweakness, Qvalue, Qkey_or_value, Qkey_and_value;
 static Lisp_Object Vall_weak_hash_tables;
 static Lisp_Object Qrehash_size, Qrehash_threshold;
-static Lisp_Object Q_size, Q_test, Q_weakness, Q_rehash_size, Q_rehash_threshold;
+static Lisp_Object Q_size, Q_weakness, Q_rehash_size, Q_rehash_threshold;
 static Lisp_Object Vhash_table_test_eq, Vhash_table_test_eql;
 static Lisp_Object Vhash_table_test_weak_list;
 
@@ -2289,7 +2289,6 @@
   DEFSYMBOL (Qnon_weak);     /* obsolete */
 
   DEFKEYWORD (Q_data);
-  DEFKEYWORD (Q_test);
   DEFKEYWORD (Q_size);
   DEFKEYWORD (Q_rehash_size);
   DEFKEYWORD (Q_rehash_threshold);
--- a/src/floatfns.c	Sun Dec 26 01:48:40 2010 +0100
+++ b/src/floatfns.c	Fri Dec 31 00:27:29 2010 +0100
@@ -787,6 +787,11 @@
   if (FLOATP (number))		/* give 'em the same float back */
     return number;
 
+  if (BIGFLOATP (number))
+    {
+      return number;
+    }
+
   return Ffloat (wrong_type_argument (Qnumberp, number));
 }
 
--- a/src/general-slots.h	Sun Dec 26 01:48:40 2010 +0100
+++ b/src/general-slots.h	Fri Dec 31 00:27:29 2010 +0100
@@ -30,6 +30,8 @@
    SYMBOL_KEYWORD (Q_foo); declares a keyword symbol ":foo"
    SYMBOL_GENERAL (Qfoo, "bar"); declares a symbol named "bar" but stored in
      the variable Qfoo
+   SYMBOL_KEYWORD_GENERAL (Q_foo_, ":bar"); declares a keyword named ":bar"
+      but stored in the variable Q_foo_. 
 
 To sort the crap in this file, use the following:
 
@@ -90,6 +92,7 @@
 SYMBOL (Qconsole);
 SYMBOL (Qcontrol_1);
 SYMBOL (Qcopies);
+SYMBOL (Qcount);
 SYMBOL_MODULE_API (Qcritical);
 SYMBOL (Qctext);
 SYMBOL (Qcurrent);
@@ -100,6 +103,9 @@
 SYMBOL (Qdead);
 SYMBOL (Qdebug);
 SYMBOL (Qdefault);
+/* We name the C variable corresponding to the keyword Q_default_, not
+   Q_default, to allow it to be useful with PARSE_KEYWORDS (). */
+SYMBOL_KEYWORD_GENERAL (Q_default_, ":default");
 SYMBOL_MODULE_API (Qdelete);
 SYMBOL (Qdelq);
 SYMBOL (Qdescription);
@@ -268,6 +274,7 @@
 SYMBOL_KEYWORD (Q_start);
 SYMBOL (Qstream);
 SYMBOL (Qstring);
+SYMBOL (Qstring_match);
 SYMBOL_KEYWORD (Q_style);
 SYMBOL_KEYWORD (Q_suffix);
 SYMBOL (Qsubtype);
@@ -277,6 +284,7 @@
 SYMBOL (Qsystem_default);
 SYMBOL (Qterminal);
 SYMBOL (Qtest);
+SYMBOL_KEYWORD (Q_test);
 SYMBOL (Qtext);
 SYMBOL_KEYWORD (Q_text);
 SYMBOL (Qthis_command);
--- a/src/general.c	Sun Dec 26 01:48:40 2010 +0100
+++ b/src/general.c	Fri Dec 31 00:27:29 2010 +0100
@@ -27,8 +27,9 @@
 
 #define SYMBOL(fou) Lisp_Object fou
 #define SYMBOL_MODULE_API(fou) Lisp_Object fou
-#define SYMBOL_KEYWORD(la_cle_est_fou) Lisp_Object la_cle_est_fou
+#define SYMBOL_KEYWORD(la_cle_est_folle) Lisp_Object la_cle_est_folle
 #define SYMBOL_GENERAL(tout_le_monde, est_fou) Lisp_Object tout_le_monde
+#define SYMBOL_KEYWORD_GENERAL(ponle, la_clave) Lisp_Object ponle
 
 #include "general-slots.h"
 
@@ -36,6 +37,7 @@
 #undef SYMBOL_MODULE_API
 #undef SYMBOL_KEYWORD
 #undef SYMBOL_GENERAL
+#undef SYMBOL_KEYWORD_GENERAL
 
 void
 syms_of_general (void)
@@ -44,10 +46,13 @@
 #define SYMBOL_MODULE_API(loco) DEFSYMBOL (loco)
 #define SYMBOL_KEYWORD(meshugeneh) DEFKEYWORD (meshugeneh)
 #define SYMBOL_GENERAL(vachement, fou) defsymbol (&vachement, fou)
+#define SYMBOL_KEYWORD_GENERAL(bescheuert, gaaanz_bescheuert)	\
+	defkeyword (&bescheuert, gaaanz_bescheuert)
 
 #include "general-slots.h"
 
 #undef SYMBOL
 #undef SYMBOL_KEYWORD
 #undef SYMBOL_GENERAL
+#undef SYMBOL_KEYWORD_GENERAL
 }
--- a/src/lisp.h	Sun Dec 26 01:48:40 2010 +0100
+++ b/src/lisp.h	Fri Dec 31 00:27:29 2010 +0100
@@ -3639,6 +3639,10 @@
   DECLARE_N_KEYWORDS_5(a,b,c,d,e), f = Qnil
 #define DECLARE_N_KEYWORDS_7(a,b,c,d,e,f,g)     \
   DECLARE_N_KEYWORDS_6(a,b,c,d,e,f), g = Qnil
+#define DECLARE_N_KEYWORDS_8(a,b,c,d,e,f,g,h)	\
+  DECLARE_N_KEYWORDS_7(a,b,c,d,e,f,g), h = Qnil
+#define DECLARE_N_KEYWORDS_9(a,b,c,d,e,f,g,h,i)	\
+  DECLARE_N_KEYWORDS_8(a,b,c,d,e,f,g,h), i = Qnil
 
 #define CHECK_N_KEYWORDS_1(a)                                           \
     else if (EQ (pk_key, Q_##a)) { a = pk_value; }
@@ -3654,6 +3658,12 @@
     else if (EQ (pk_key, Q_##f)) { f = pk_value; }
 #define CHECK_N_KEYWORDS_7(a,b,c,d,e,f,g)   CHECK_N_KEYWORDS_6(a,b,c,d,e,f) \
     else if (EQ (pk_key, Q_##g)) { g = pk_value; }
+#define CHECK_N_KEYWORDS_8(a,b,c,d,e,f,g,h)		\
+  CHECK_N_KEYWORDS_7(a,b,c,d,e,f,g)			\
+  else if (EQ (pk_key, Q_##h)) { h = pk_value; }
+#define CHECK_N_KEYWORDS_9(a,b,c,d,e,f,g,h,i)		\
+  CHECK_N_KEYWORDS_8(a,b,c,d,e,f,g,h)			\
+  else if (EQ (pk_key, Q_##i)) { i = pk_value; }
 
 Boolint non_nil_allow_other_keys_p (Elemcount offset, int nargs,
                                     Lisp_Object *args);
@@ -5303,9 +5313,11 @@
 /* Defined in general.c */
 #define SYMBOL(fou) extern Lisp_Object fou
 #define SYMBOL_MODULE_API(fou) extern MODULE_API Lisp_Object fou
-#define SYMBOL_KEYWORD(la_cle_est_fou) extern Lisp_Object la_cle_est_fou
+#define SYMBOL_KEYWORD(la_cle_est_folle) extern Lisp_Object la_cle_est_folle
 #define SYMBOL_GENERAL(tout_le_monde, est_fou) \
   extern Lisp_Object tout_le_monde
+#define SYMBOL_KEYWORD_GENERAL(y_compris_ben, mais_que_peut_on_faire) \
+  extern Lisp_Object y_compris_ben
 
 #include "general-slots.h"
 
@@ -5313,6 +5325,7 @@
 #undef SYMBOL_MODULE_API
 #undef SYMBOL_KEYWORD
 #undef SYMBOL_GENERAL
+#undef SYMBOL_KEYWORD_GENERAL
 
 extern Lisp_Object Qeq;
 extern Lisp_Object Qeql;
--- a/tests/ChangeLog	Sun Dec 26 01:48:40 2010 +0100
+++ b/tests/ChangeLog	Fri Dec 31 00:27:29 2010 +0100
@@ -1,3 +1,11 @@
+2010-12-30  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* automated/lisp-tests.el (wrong-type-argument): Add a missing
+	parenthesis here.
+	Make sure #'count #'position #'find #'delete* #'remove* #'reduce
+	#'delete-duplicates #'remove-duplicates #'replace #'mismatch
+	#'search sanity check their :start and :end keyword arguments.
+
 2010-11-20  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* automated/lisp-tests.el:
--- a/tests/automated/lisp-tests.el	Sun Dec 26 01:48:40 2010 +0100
+++ b/tests/automated/lisp-tests.el	Fri Dec 31 00:27:29 2010 +0100
@@ -2547,7 +2547,7 @@
 (Check-Error wrong-type-argument
              (fill "1 2 3 4 5" ?1 :start (float most-positive-fixnum)))
 (Check-Error wrong-type-argument
-             (fill #*10101010 1 :start (float most-positive-fixnum))
+             (fill #*10101010 1 :start (float most-positive-fixnum)))
 (Check-Error wrong-type-argument
              (fill '(1 2 3 4 5) 1 :end (float most-positive-fixnum)))
 (Check-Error wrong-type-argument
@@ -2667,4 +2667,125 @@
                (replace '(1 2 3 4 5) [5 4 3 2 1]
                         :end2 (1+ most-positive-fixnum))))
 
+(symbol-macrolet
+    ((list-length 2048) (vector-length 512) (string-length (* 8192 2)))
+  (let ((list
+         ;; CIRCULAR_LIST_SUSPICION_LENGTH is 1024, it's helpful if this list
+         ;; is longer than that.
+         (make-list list-length 'make-list)) 
+        (vector (make-vector vector-length 'make-vector))
+        (bit-vector (make-bit-vector vector-length 1))
+        (string (make-string string-length
+                             (or (decode-char 'ucs #x20ac) ?\xFF)))
+        (item 'cons))
+    (dolist (function '(count position find delete* remove* reduce))
+      (Check-Error args-out-of-range
+                   (funcall function item list
+                            :start (1+ list-length) :end (1+ list-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function item list
+                            :start -1 :end list-length))
+      (Check-Error args-out-of-range
+                   (funcall function item list :end (* 2 list-length)))
+      (Check-Error args-out-of-range
+                   (funcall function item vector
+                            :start (1+ vector-length) :end (1+ vector-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function item vector :start -1))
+      (Check-Error args-out-of-range
+                   (funcall function item vector :end (* 2 vector-length)))
+      (Check-Error args-out-of-range
+                   (funcall function item bit-vector
+                            :start (1+ vector-length) :end (1+ vector-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function item bit-vector :start -1))
+      (Check-Error args-out-of-range
+                   (funcall function item bit-vector :end (* 2 vector-length)))
+      (Check-Error args-out-of-range
+                   (funcall function item string
+                            :start (1+ string-length) :end (1+ string-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function item string :start -1))
+      (Check-Error args-out-of-range
+                   (funcall function item string :end (* 2 string-length))))
+    (dolist (function '(delete-duplicates remove-duplicates))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence list)
+                            :start (1+ list-length) :end (1+ list-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function (copy-sequence list)
+                            :start -1 :end list-length))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence list)
+                            :end (* 2 list-length)))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence vector)
+                            :start (1+ vector-length) :end (1+ vector-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function (copy-sequence vector) :start -1))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence vector)
+                            :end (* 2 vector-length)))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence bit-vector)
+                            :start (1+ vector-length) :end (1+ vector-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function (copy-sequence bit-vector) :start -1))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence bit-vector)
+                            :end (* 2 vector-length)))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence string)
+                            :start (1+ string-length) :end (1+ string-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function (copy-sequence string) :start -1))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence string)
+                            :end (* 2 string-length))))
+    (dolist (function '(replace mismatch search))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence list) (copy-sequence list)
+                            :start1 (1+ list-length) :end1 (1+ list-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function (copy-sequence list) (copy-sequence list)
+                            :start1 -1 :end1 list-length))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence list) (copy-sequence list)
+                            :end1 (* 2 list-length)))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence vector)
+                            (copy-sequence vector) :start1 (1+ vector-length)
+                            :end1 (1+ vector-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function (copy-sequence vector)
+                            (copy-sequence vector) :start1 -1))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence vector)
+                            (copy-sequence vector)
+                            :end1 (* 2 vector-length)))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence bit-vector)
+                            (copy-sequence bit-vector)
+                            :start1 (1+ vector-length)
+                            :end1 (1+ vector-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function (copy-sequence bit-vector)
+                            (copy-sequence bit-vector) :start1 -1))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence bit-vector)
+                            (copy-sequence bit-vector)
+                            :end1 (* 2 vector-length)))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence string)
+                            (copy-sequence string)
+                            :start1 (1+ string-length)
+                            :end1 (1+ string-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function (copy-sequence string)
+                            (copy-sequence string) :start1 -1))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence string)
+                            (copy-sequence string)
+                            :end1 (* 2 string-length))))))
+
 ;;; end of lisp-tests.el