--- a/lisp/ChangeLog	Sat Jan 22 00:59:20 2011 +0100
+++ b/lisp/ChangeLog	Mon Feb 07 21:22:17 2011 +0100
@@ -1,3 +1,82 @@
+2011-02-07  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* bytecomp.el:
+	* bytecomp.el (byte-compile-initial-macro-environment):
+	Shadow `block', `return-from' here, we implement them differently
+	when byte-compiling.
+
+	* bytecomp.el (byte-compile-active-blocks): New.
+	* bytecomp.el (byte-compile-block-1): New.
+	* bytecomp.el (byte-compile-return-from-1): New.
+	* bytecomp.el (return-from-1): New.
+	* bytecomp.el (block-1): New.
+	These are two aliases that exist to have their own associated
+	byte-compile functions, which functions implement `block' and
+	`return-from'.
+
+	* cl-extra.el (cl-macroexpand-all):
+	Fix a bug here when macros in the environment have been compiled.
+
+	* cl-macs.el (block):
+	* cl-macs.el (return):
+	* cl-macs.el (return-from):
+	Be more careful about lexical scope in these macros.
+
+	* cl.el:
+	* cl.el ('cl-block-wrapper): Removed.
+	* cl.el ('cl-block-throw): Removed.
+	These aren't needed in code generated by this XEmacs. They
+	shouldn't be needed in code generated by XEmacs 21.4, but if it
+	turns out the packages do need them, we can put them back.
+
+2011-01-30  Mike Sperber  <mike@xemacs.org>
+
+	* font-lock.el (font-lock-fontify-pending-extents): Don't fail if
+	`font-lock-mode' is unset, which can happen in the middle of
+	`revert-buffer'.
+
+2011-01-23  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-macs.el (delete):
+	* cl-macs.el (delq):
+	* cl-macs.el (remove):
+	* cl-macs.el (remq):
+	Don't use the compiler macro if these functions were given the
+	wrong number of arguments, as happens in lisp-tests.el.
+	* cl-seq.el (remove, remq): Removed.
+	I added these to subr.el, and forgot to remove them from here.
+
+2011-01-22  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* bytecomp.el (byte-compile-setq, byte-compile-set):
+	Remove kludge allowing keywords' values to be set, all the code
+	that does that is gone.
+
+	* cl-compat.el (elt-satisfies-test-p):
+	* faces.el (set-face-parent):
+	* faces.el (face-doc-string):
+	* gtk-font-menu.el:
+	* gtk-font-menu.el (gtk-reset-device-font-menus):
+	* msw-font-menu.el:
+	* msw-font-menu.el (mswindows-reset-device-font-menus):
+	* package-get.el (package-get-installedp):
+	* select.el (select-convert-from-image-data):
+	* sound.el:
+	* sound.el (load-sound-file):
+	* x-font-menu.el (x-reset-device-font-menus-core):
+	Don't quote keywords, they're self-quoting, and the
+	win from backward-compatibility is sufficiently small now that the
+	style problem overrides it.
+
+2011-01-22  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-macs.el (block, return-from): Require that NAME be a symbol
+	in these macros, as always documented in the #'block docstring and
+	as required by Common Lisp.
+	* descr-text.el (unidata-initialize-unihan-database):
+	Correct the use of non-symbols in #'block and #'return-from in
+	this function.
+
 2011-01-15  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* cl-extra.el (concatenate): Accept more complicated TYPEs in this

--- a/lisp/bytecomp.el	Sat Jan 22 00:59:20 2011 +0100
+++ b/lisp/bytecomp.el	Mon Feb 07 21:22:17 2011 +0100
@@ -509,7 +509,11 @@
 		    "%s is not of type %s" form type)))
 	   (if byte-compile-delete-errors
 	       form
-	     (funcall (cdr (symbol-function 'the)) type form)))))
+	     (funcall (cdr (symbol-function 'the)) type form))))
+    (return-from .
+      ,#'(lambda (name &optional result) `(return-from-1 ',name ,result)))
+    (block .
+      ,#'(lambda (name &rest body) `(block-1 ',name ,@body))))
   "The default macro-environment passed to macroexpand by the compiler.
 Placing a macro here will cause a macro to have different semantics when
 expanded by the compiler as when expanded by the interpreter.")
@@ -3727,13 +3731,10 @@
 	    ;; Odd number of args?  Let `set' get the error.
 	    (byte-compile-form `(set ',var) for-effect)
 	  (setq val (pop args))
-	  (if (keywordp var)
-	      ;; (setq :foo ':foo) compatibility kludge
-	      (byte-compile-form `(set ',var ,val) (if args t for-effect))
-	    (byte-compile-form val)
-	    (unless (or args for-effect)
-	      (byte-compile-out 'byte-dup 0))
-	    (byte-compile-variable-ref 'byte-varset var))))))
+          (byte-compile-form val)
+          (unless (or args for-effect)
+            (byte-compile-out 'byte-dup 0))
+          (byte-compile-variable-ref 'byte-varset var)))))
   (setq for-effect nil))
 
 (defun byte-compile-set (form)
@@ -3743,11 +3744,10 @@
   (let ((symform (nth 1 form))
 	(valform (nth 2 form))
 	sym)
-    (if (and (= (length form) 3)
-	     (= (safe-length symform) 2)
+    (if (and (eql (length form) 3)
+	     (eql (safe-length symform) 2)
 	     (eq (car symform) 'quote)
-	     (symbolp (setq sym (car (cdr symform))))
-	     (not (byte-compile-constant-symbol-p sym)))
+	     (symbolp (setq sym (car (cdr symform)))))
 	(byte-compile-setq `(setq ,sym ,valform))
       (byte-compile-two-args form))))
 
@@ -4184,6 +4184,8 @@
 ;;; other tricky macro-like special-operators
 
 (byte-defop-compiler-1 catch)
+(byte-defop-compiler-1 block-1)
+(byte-defop-compiler-1 return-from-1)
 (byte-defop-compiler-1 unwind-protect)
 (byte-defop-compiler-1 condition-case)
 (byte-defop-compiler-1 save-excursion)
@@ -4198,6 +4200,39 @@
     (byte-compile-top-level (cons 'progn (cdr (cdr form))) for-effect))
   (byte-compile-out 'byte-catch 0))
 
+;; `return-from' and `block' are different from `throw' and `catch' when it
+;; comes to scope and extent. These differences are implemented for
+;; interpreted code in cl-macs.el, in compiled code in bytecomp.el. There's
+;; a certain amount of bootstrapping needed for the latter, and until this
+;; is done return-from and block behave as throw and catch in their scope
+;; and extent. This is only relevant to people working on bytecomp.el.
+
+(defalias 'return-from-1 'throw)
+(defalias 'block-1 'catch)
+
+(defvar byte-compile-active-blocks nil)
+
+(defun byte-compile-block-1 (form)
+  (let* ((name (nth 1 (nth 1 form)))
+	 (elt (list name (copy-symbol name) nil))
+	 (byte-compile-active-blocks (cons elt byte-compile-active-blocks))
+	 (body (byte-compile-top-level (cons 'progn (cddr form)))))
+    (if (nth 2 elt)
+	(byte-compile-catch `(catch ',(nth 1 elt) ,body))
+      (byte-compile-form body))))
+
+(defun byte-compile-return-from-1 (form)
+  (let* ((name (nth 1 (nth 1 form)))
+	 (assq (assq name byte-compile-active-blocks)))
+    (if assq
+	(setf (nth 2 assq) t)
+      (byte-compile-warn
+       "return-from: %S: no current lexical block with this name"
+       name))
+    (byte-compile-throw
+     `(throw ',(or (nth 1 assq) (copy-symbol name))
+             ,@(nthcdr 2 form)))))
+
 (defun byte-compile-unwind-protect (form)
   (byte-compile-push-constant
    (byte-compile-top-level-body (cdr (cdr form)) t))

--- a/lisp/cl-compat.el	Sat Jan 22 00:59:20 2011 +0100
+++ b/lisp/cl-compat.el	Mon Feb 07 21:22:17 2011 +0100
@@ -73,9 +73,9 @@
   (assq key klist))
 
 (defun elt-satisfies-test-p (item elt klist)
-  (let ((test-not (cdr (assq ':test-not klist)))
-	(test (cdr (assq ':test klist)))
-	(key (cdr (assq ':key klist))))
+  (let ((test-not (cdr (assq :test-not klist)))
+	(test (cdr (assq :test klist)))
+	(key (cdr (assq :key klist))))
     (if key (setq elt (funcall key elt)))
     (if test-not (not (funcall test-not item elt))
       (funcall (or test 'eql) item elt))))

--- a/lisp/cl-extra.el	Sat Jan 22 00:59:20 2011 +0100
+++ b/lisp/cl-extra.el	Mon Feb 07 21:22:17 2011 +0100
@@ -656,8 +656,11 @@
 				     '((quote --cl-rest--)))))))
 		 (list (car form) (list* 'lambda (cadadr form) body))))
 	   (let ((found (assq (cadr form) env)))
-	     ;; XEmacs: cadr/caddr operate on nil without errors
-	     (if (eq (cadr (caddr found)) 'cl-labels-args)
+	     ;; XEmacs: cadr/caddr operate on nil without errors. But the
+	     ;; macro definition may be compiled, in which case there's
+	     ;; nothing for us to do.
+	     (if (and (listp (cdr found))
+		      (eq (cadr (caddr found)) 'cl-labels-args))
 		 (cl-macroexpand-all (cadr (caddr (cadddr found))) env)
 	       form))))
 	((memq (car form) '(defun defmacro))

--- a/lisp/cl-macs.el	Sat Jan 22 00:59:20 2011 +0100
+++ b/lisp/cl-macs.el	Mon Feb 07 21:22:17 2011 +0100
@@ -730,6 +730,7 @@
 
 
 ;;; Blocks and exits.
+(defvar cl-active-block-names nil)
 
 ;;;###autoload
 (defmacro block (name &rest body)
@@ -739,45 +740,19 @@
 in two respects:  First, the NAME is an unevaluated symbol rather than a
 quoted symbol or other form; and second, NAME is lexically rather than
 dynamically scoped:  Only references to it within BODY will work.  These
-references may appear inside macro expansions, but not inside functions
-called from BODY."
-  (if (cl-safe-expr-p (cons 'progn body)) (cons 'progn body)
-    (list 'cl-block-wrapper
-	  (list* 'catch (list 'quote (intern (format "--cl-block-%s--" name)))
-		 body))))
-
-(defvar cl-active-block-names nil)
-
-(put 'cl-block-wrapper 'byte-compile
-     #'(lambda (cl-form)
-         (if (/= (length cl-form) 2)
-             (byte-compile-warn-wrong-args cl-form 1))
-
-         (if (fboundp 'byte-compile-form-do-effect)  ; Check for optimizing
-						     ; compiler
-             (progn
-               (let* ((cl-entry (cons (nth 1 (nth 1 (nth 1 cl-form))) nil))
-                      (cl-active-block-names (cons cl-entry
-                                                   cl-active-block-names))
-                      (cl-body (byte-compile-top-level
-                                (cons 'progn (cddr (nth 1 cl-form))))))
-                 (if (cdr cl-entry)
-                     (byte-compile-form (list 'catch (nth 1 (nth 1 cl-form))
-                                              cl-body))
-                   (byte-compile-form cl-body))))
-           (byte-compile-form (nth 1 cl-form)))))
-
-(put 'cl-block-throw 'byte-compile
-     #'(lambda (cl-form)
-         (let ((cl-found (assq (nth 1 (nth 1 cl-form)) cl-active-block-names)))
-           (if cl-found (setcdr cl-found t)))
-         (byte-compile-throw (cons 'throw (cdr cl-form)))))
+references may appear inside macro expansions and in lambda expressions, but
+not inside other functions called from BODY."
+  (let ((cl-active-block-names (acons name (copy-symbol name)
+				      cl-active-block-names))
+	(body (cons 'progn body)))
+    `(catch ',(cdar cl-active-block-names)
+      ,(cl-macroexpand-all body cl-macro-environment))))
 
 ;;;###autoload
 (defmacro return (&optional result)
   "Return from the block named nil.
 This is equivalent to `(return-from nil RESULT)'."
-  (list 'return-from nil result))
+  `(return-from nil ,result))
 
 ;;;###autoload
 (defmacro return-from (name &optional result)
@@ -786,9 +761,8 @@
 returning RESULT from that form (or nil if RESULT is omitted).
 This is compatible with Common Lisp, but note that `defun' and
 `defmacro' do not create implicit blocks as they do in Common Lisp."
-  (let ((name2 (intern (format "--cl-block-%s--" name))))
-    (list 'cl-block-throw (list 'quote name2) result)))
-
+  `(throw ',(or (cdr (assq name cl-active-block-names)) (copy-symbol name))
+	  ,result))
 
 ;;; The "loop" macro.
 
@@ -3341,42 +3315,49 @@
     form))
 
 (define-compiler-macro delete (&whole form &rest args)
-  (symbol-macrolet
-      ((not-constant '#:not-constant))
-    (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
-      (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
-	       (or (symbolp cl-const-expr-val) (fixnump cl-const-expr-val)
-		   (characterp cl-const-expr-val)))
-	  (cons 'delete* (cdr form))
-	`(delete* ,@(cdr form) :test #'equal)))))
+  (if (eql 3 (length form))
+      (symbol-macrolet ((not-constant '#:not-constant))
+        (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
+          (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
+                   (or (symbolp cl-const-expr-val) (fixnump cl-const-expr-val)
+                       (characterp cl-const-expr-val)))
+              (cons 'delete* (cdr form))
+            `(delete* ,@(cdr form) :test #'equal))))
+    form))
 
 (define-compiler-macro delq (&whole form &rest args)
-  (symbol-macrolet
-      ((not-constant '#:not-constant))
-    (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
-      (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
-	       (not (cl-non-fixnum-number-p cl-const-expr-val)))
-	  (cons 'delete* (cdr form))
-	`(delete* ,@(cdr form) :test #'eq)))))
+  (if (eql 3 (length form))
+      (symbol-macrolet
+          ((not-constant '#:not-constant))
+        (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
+          (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
+                   (not (cl-non-fixnum-number-p cl-const-expr-val)))
+              (cons 'delete* (cdr form))
+            `(delete* ,@(cdr form) :test #'eq))))
+    form))
 
 (define-compiler-macro remove (&whole form &rest args)
-  (symbol-macrolet
-      ((not-constant '#:not-constant))
-    (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
-      (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
-	       (or (symbolp cl-const-expr-val) (fixnump cl-const-expr-val)
-		   (characterp cl-const-expr-val)))
-	  (cons 'remove* (cdr form))
-	`(remove* ,@(cdr form) :test #'equal)))))
+  (if (eql 3 (length form))
+      (symbol-macrolet
+          ((not-constant '#:not-constant))
+        (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
+          (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
+                   (or (symbolp cl-const-expr-val) (fixnump cl-const-expr-val)
+                       (characterp cl-const-expr-val)))
+              (cons 'remove* (cdr form))
+            `(remove* ,@(cdr form) :test #'equal))))
+    form))
 
 (define-compiler-macro remq (&whole form &rest args)
-  (symbol-macrolet
-      ((not-constant '#:not-constant))
-    (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
-      (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
-	       (not (cl-non-fixnum-number-p cl-const-expr-val)))
-	  (cons 'remove* (cdr form))
-	`(remove* ,@(cdr form) :test #'eq)))))
+  (if (eql 3 (length form))
+      (symbol-macrolet
+          ((not-constant '#:not-constant))
+        (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
+          (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
+                   (not (cl-non-fixnum-number-p cl-const-expr-val)))
+              (cons 'remove* (cdr form))
+            `(remove* ,@(cdr form) :test #'eq))))
+    form))
  
 (macrolet
     ((define-foo-if-compiler-macros (&rest alist)

--- a/lisp/cl-seq.el	Sat Jan 22 00:59:20 2011 +0100
+++ b/lisp/cl-seq.el	Mon Feb 07 21:22:17 2011 +0100
@@ -54,26 +54,6 @@
 ;; scope (e.g. a variable called start bound in this file and one in a
 ;; user-supplied test predicate may well interfere with each other).
 
-;; XEmacs change: these two are in subr.el in GNU Emacs.
-(defun remove (cl-item cl-seq)
-  "Remove all occurrences of ITEM in SEQUENCE, testing with `equal'.
-
-This is a non-destructive function; it makes a copy of SEQUENCE if necessary
-to avoid corrupting the original SEQUENCE.
-Also see: `remove*', `delete', `delete*'
-
-arguments: (ITEM SEQUENCE)"
-  (remove* cl-item cl-seq :test #'equal))
-
-(defun remq (cl-item cl-seq)
-  "Remove all occurrences of ITEM in SEQUENCE, comparing with `eq'.
-
-This is a non-destructive function; it makes a copy of SEQUENCE to avoid
-corrupting the original LIST.  See also the more general `remove*'.
-
-arguments: (ITEM SEQUENCE)"
-  (remove* cl-item cl-seq :test #'eq))
-
 (defun remove-if (cl-predicate cl-seq &rest cl-keys)
   "Remove all items satisfying PREDICATE in SEQUENCE.
 

--- a/lisp/cl.el	Sat Jan 22 00:59:20 2011 +0100
+++ b/lisp/cl.el	Mon Feb 07 21:22:17 2011 +0100
@@ -203,19 +203,6 @@
 
 (defalias 'cl-map-extents 'map-extents)
 
-;;; Blocks and exits.
-
-;; This used to be #'identity, but that didn't preserve multiple values in
-;; interpreted code. #'and isn't great either, there's no error on too many
-;; arguments passed to it when interpreted. Fortunately most of the places
-;; where cl-block-wrapper is called are generated from old, established
-;; macros, so too many arguments resulting from human error is unlikely; and
-;; the byte compile handler in cl-macs.el warns if more than one arg is
-;; passed to it.
-(defalias 'cl-block-wrapper 'and)
-
-(defalias 'cl-block-throw 'throw)
-
 ;;; XEmacs; multiple values are in eval.c and cl-macs.el. 
 
 ;;; We no longer support `multiple-value-apply', which was ill-conceived to

--- a/lisp/descr-text.el	Sat Jan 22 00:59:20 2011 +0100
+++ b/lisp/descr-text.el	Mon Feb 07 21:22:17 2011 +0100
@@ -596,7 +596,7 @@
 					(concat message
 						(make-string
 						 (mod loop-count 44) ?.)))
-	  (block 'dealing-with-chars
+	  (block dealing-with-chars
 	    (when (= buffer-size (- (point-max) (point-min)))
 	      ;; If we're in the body of the file, we need to delete the
 	      ;; character info for the last character, and set offset-end
@@ -635,13 +635,13 @@
 	    (while t
 	      (when (= (point) (point-max))
 		;; We're at the end of this part of the file.
-		(return-from 'dealing-with-chars))
+		(return-from dealing-with-chars))
 
 	      (unless (re-search-forward "^\\(U\\+[0-9A-F]\\{4,6\\}\\)\t"
 					 nil t)
 		;; We're probably in the comments at the start of the
 		;; file. No need to look for character info.
-		(return-from 'dealing-with-chars))
+		(return-from dealing-with-chars))
 
 	      ;; Store where the character started. 
 	      (beginning-of-line)

--- a/lisp/faces.el	Sat Jan 22 00:59:20 2011 +0100
+++ b/lisp/faces.el	Mon Feb 07 21:22:17 2011 +0100
@@ -416,7 +416,7 @@
                              how-to-add))
         (set-difference built-in-face-specifiers
                         '(display-table background-pixmap inherit)))
-  (set-face-background-pixmap face (vector 'inherit ':face parent)
+  (set-face-background-pixmap face (vector 'inherit :face parent)
 			      locale tag-set how-to-add)
   nil)
 

--- a/lisp/font-lock.el	Sat Jan 22 00:59:20 2011 +0100
+++ b/lisp/font-lock.el	Mon Feb 07 21:22:17 2011 +0100
@@ -1475,51 +1475,55 @@
   (save-match-data
     (maphash
      #'(lambda (buffer dummy)
-	 ;; remove first, to avoid infinite reprocessing if error
-	 (remhash buffer font-lock-pending-buffer-table)
-	 (when (buffer-live-p buffer)
-	   (clear-range-table font-lock-range-table)
-	   (with-current-buffer buffer
-	     (save-excursion
-	       (save-restriction
-		 ;; if we don't widen, then the C code in
-		 ;; syntactically-sectionize will fail to realize that
-		 ;; we're inside a comment. #### We don't actually use
-		 ;; syntactically-sectionize any more.  Do we still
-		 ;; need the widen?
-		 (widen)
-		 (map-extents
-		  #'(lambda (ex dummy-maparg)
-		      ;; first expand the ranges to full lines,
-		      ;; because that is what will be fontified;
-		      ;; then use a range table to merge the
-		      ;; ranges. (we could also do this simply using
-		      ;; text properties.  the range table code was
-		      ;; here from a previous version of this code
-		      ;; and works just as well.)
-		      (let* ((beg (extent-start-position ex))
-			     (end (extent-end-position ex))
-			     (beg (progn (goto-char beg)
-					 (beginning-of-line)
-					 (point)))
-			     (end (progn (goto-char end)
-					 (forward-line 1)
-					 (point))))
-			(put-range-table beg end t
-					 font-lock-range-table)))
-		  nil nil nil nil nil 'font-lock-pending t)
-		 ;; clear all pending extents first in case of error below.
-		 (put-text-property (point-min) (point-max)
-				    'font-lock-pending nil)
-		 (map-range-table
-		  #'(lambda (beg end val)
+	 (catch 'exit
+	   ;; font-lock-mode may be temporarily unset during `revert-buffer'
+	   (if (not font-lock-mode)
+	       (throw 'exit nil))
+	   ;; remove first, to avoid infinite reprocessing if error
+	   (remhash buffer font-lock-pending-buffer-table)
+	   (when (buffer-live-p buffer)
+	     (clear-range-table font-lock-range-table)
+	     (with-current-buffer buffer
+	       (save-excursion
+		 (save-restriction
+		   ;; if we don't widen, then the C code in
+		   ;; syntactically-sectionize will fail to realize that
+		   ;; we're inside a comment. #### We don't actually use
+		   ;; syntactically-sectionize any more.  Do we still
+		   ;; need the widen?
+		   (widen)
+		   (map-extents
+		    #'(lambda (ex dummy-maparg)
+			;; first expand the ranges to full lines,
+			;; because that is what will be fontified;
+			;; then use a range table to merge the
+			;; ranges. (we could also do this simply using
+			;; text properties.  the range table code was
+			;; here from a previous version of this code
+			;; and works just as well.)
+			(let* ((beg (extent-start-position ex))
+			       (end (extent-end-position ex))
+			       (beg (progn (goto-char beg)
+					   (beginning-of-line)
+					   (point)))
+			       (end (progn (goto-char end)
+					   (forward-line 1)
+					   (point))))
+			  (put-range-table beg end t
+					   font-lock-range-table)))
+		    nil nil nil nil nil 'font-lock-pending t)
+		   ;; clear all pending extents first in case of error below.
+		   (put-text-property (point-min) (point-max)
+				      'font-lock-pending nil)
+		   (map-range-table
+		    #'(lambda (beg end val)
 			;; This creates some unnecessary progress gauges.
 ;;			(if (and (= beg (point-min))
 ;;				 (= end (point-max)))
 ;;			    (font-lock-fontify-buffer)
 ;;			  (font-lock-fontify-region beg end)))
-		      (font-lock-fontify-region beg end))
-		  font-lock-range-table))))))
+			(font-lock-fontify-region beg end))
+		    font-lock-range-table)))))))
      font-lock-pending-buffer-table)))
 
 ;; Syntactic fontification functions.

--- a/lisp/gtk-font-menu.el	Sat Jan 22 00:59:20 2011 +0100
+++ b/lisp/gtk-font-menu.el	Mon Feb 07 21:22:17 2011 +0100
@@ -166,19 +166,19 @@
       (mapcar (lambda (x)
 		(vector x
 			(list 'font-menu-set-font x nil nil)
-			':style 'radio ':active nil ':selected nil))
+			:style 'radio :active nil :selected nil))
 	      families)
       (mapcar (lambda (x)
 		(vector (if (/= 0 (% x 10))
 			    (number-to-string (/ x 10.0))
 			  (number-to-string (/ x 10)))
 			(list 'font-menu-set-font nil nil x)
-			':style 'radio ':active nil ':selected nil))
+			:style 'radio :active nil :selected nil))
 	      sizes)
       (mapcar (lambda (x)
 		(vector x
 			(list 'font-menu-set-font nil x nil)
-			':style 'radio ':active nil ':selected nil))
+			:style 'radio :active nil :selected nil))
 	      weights)))
     (cdr dev-cache)))
 

--- a/lisp/msw-font-menu.el	Sat Jan 22 00:59:20 2011 +0100
+++ b/lisp/msw-font-menu.el	Mon Feb 07 21:22:17 2011 +0100
@@ -138,17 +138,17 @@
 	(mapcar (lambda (x)
 		  (vector x
 			  (list 'font-menu-set-font x nil nil)
-			  ':style 'radio ':active nil ':selected nil))
+			  :style 'radio :active nil :selected nil))
 		families)
 	(mapcar (lambda (x)
 		  (vector (int-to-string x)
 			  (list 'font-menu-set-font nil nil x)
-			  ':style 'radio ':active nil ':selected nil))
+			  :style 'radio :active nil :selected nil))
 		sizes)
 	(mapcar (lambda (x)
 		  (vector x
 			  (list 'font-menu-set-font nil x nil)
-			  ':style 'radio ':active nil ':selected nil))
+			  :style 'radio :active nil :selected nil))
 		weights)))
       (cdr dev-cache)))
 

--- a/lisp/package-get.el	Sat Jan 22 00:59:20 2011 +0100
+++ b/lisp/package-get.el	Mon Feb 07 21:22:17 2011 +0100
@@ -1238,7 +1238,7 @@
   ;; Use packages-package-list which contains name and version
   (equal (plist-get
 	  (package-get-info-find-package packages-package-list
-					 package) ':version)
+					 package) :version)
 	 (if (floatp version)
 	     version
 	   (string-to-number version))))

--- a/lisp/select.el	Sat Jan 22 00:59:20 2011 +0100
+++ b/lisp/select.el	Mon Feb 07 21:22:17 2011 +0100
@@ -765,7 +765,7 @@
 corresponding to that data as an end-glyph extent property of that space. "
   (let* ((str (make-string 1 ?\ ))
 	 (extent (make-extent 0 1 str))
-	 (glyph (make-glyph (vector image-type ':data value))))
+	 (glyph (make-glyph (vector image-type :data value))))
     (when glyph
       (set-extent-property extent 'invisible t)
       (set-extent-property extent 'start-open t)

--- a/lisp/sound.el	Sat Jan 22 00:59:20 2011 +0100
+++ b/lisp/sound.el	Mon Feb 07 21:22:17 2011 +0100
@@ -179,8 +179,8 @@
     (setq sound-alist (cons
 		       (nconc (list sound-name)
 			      (if (and volume (not (eq 0 volume)))
-				  (list ':volume volume))
-			      (list ':sound data))
+				  (list :volume volume))
+			      (list :sound data))
 		       sound-alist)))
   sound-name)
 

--- a/lisp/x-font-menu.el	Sat Jan 22 00:59:20 2011 +0100
+++ b/lisp/x-font-menu.el	Mon Feb 07 21:22:17 2011 +0100
@@ -251,21 +251,21 @@
      (vector
       cache
       (mapcar (lambda (x)
-		(vector x
+                (vector x
 			(list 'font-menu-set-font x nil nil)
-			':style 'radio ':active nil ':selected nil))
+			:style 'radio :active nil :selected nil))
 	      families)
       (mapcar (lambda (x)
 		(vector (if (/= 0 (% x 10))
 			    (number-to-string (/ x 10.0))
 			  (number-to-string (/ x 10)))
 			(list 'font-menu-set-font nil nil x)
-			':style 'radio ':active nil ':selected nil))
+			:style 'radio :active nil :selected nil))
 	      sizes)
       (mapcar (lambda (x)
 		(vector x
 			(list 'font-menu-set-font nil x nil)
-			':style 'radio ':active nil ':selected nil))
+			:style 'radio :active nil :selected nil))
 	      weights)))
     (cdr dev-cache)))
 

--- a/src/ChangeLog	Sat Jan 22 00:59:20 2011 +0100
+++ b/src/ChangeLog	Mon Feb 07 21:22:17 2011 +0100
@@ -1,3 +1,74 @@
+2011-02-07  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* keymap.c (describe_map_sort_predicate): Correct the order of
+	arguments to map_keymap_sort_predicate() here. Thanks again, Mats.
+
+2011-02-06  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* symbols.c (Fapropos_internal):
+	Supply check_string_lessp_nokey explicitly as the CHECK_MERGE
+	argument to list_sort(), NULL no longer works. Thank you Mats
+	Lidell in IRC!
+
+2011-02-05  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* fns.c:
+	* fns.c (check_lss_key, check_lss_key_car): New.
+	* fns.c (check_string_lessp_key check_string_lessp_key_car): New.
+	* fns.c (get_merge_predicate): New.
+	* fns.c (list_merge):
+	* fns.c (array_merge):
+	* fns.c (list_array_merge_into_list):
+	* fns.c (list_list_merge_into_array):
+	* fns.c (list_array_merge_into_array):
+	* fns.c (Fmerge):
+	* fns.c (list_sort):
+	* fns.c (array_sort):
+	* fns.c (FsortX):
+	* fns.c (syms_of_fns):
+	* lisp.h:
+	Move #'sort, #'merge to using the same test approach as is used in
+	the functions that take TEST, TEST-NOT and KEY arguments.  This
+	allows us to avoid the Ffuncall() overhead when the most common
+	PREDICATE arguments are supplied, in particular #'< and
+	#'string-lessp.
+
+	* fontcolor-msw.c (sort_font_list_function):
+	* fontcolor-msw.c (mswindows_enumerate_fonts):
+	* dired.c:
+	* dired.c (Fdirectory_files):
+	* fileio.c:
+	* fileio.c (build_annotations):
+	* fileio.c (syms_of_fileio):
+	* keymap.c:
+	* keymap.c (keymap_submaps):
+	* keymap.c (map_keymap_sort_predicate):
+	* keymap.c (describe_map_sort_predicate):
+	* keymap.c (describe_map):
+	Change the various C predicates passed to list_sort () and
+	list_merge () to fit the new calling convention, returning
+	non-zero if the first argument is less than the second, zero
+	otherwise.
+
+2011-01-30  Michael Sperber  <mike@xemacs.org>
+
+	* redisplay.h: 
+	* redisplay.c: 
+	(redisplay_cancel_ritual_suicide): 
+	* eval.c (throw_or_bomb_out_unsafe): 
+	* device-x.c (x_IO_error_handler): Don't commit suicide when an X
+	device dies.
+
+2011-01-23  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* file-coding.c (complex_vars_of_file_coding):
+	* intl-win32.c (complex_vars_of_intl_win32):
+	* profile.c (Fget_profiling_info):
+	* unicode.c (complex_vars_of_unicode):
+	Replace various awkward calls to nconc2 () with list6 () with
+	analogous calls to Ben's relatively-recently introduced listu (),
+	constructing a list from an arbitrary number of C arguments.
+
 2011-01-18  Mike Sperber  <mike@xemacs.org>
 
 	* s/freebsd.h: Zap. Not really needed anymore, and it has unclear

--- a/src/abbrev.c	Sat Jan 22 00:59:20 2011 +0100
+++ b/src/abbrev.c	Mon Feb 07 21:22:17 2011 +0100
@@ -522,7 +522,7 @@
   map_obarray (table, record_symbol, &symbols);
   /* map_obarray (table, record_symbol, &closure); */
   symbols = XCDR (symbols);
-  symbols = list_sort (symbols, NULL, Qstring_lessp, Qidentity);
+  symbols = list_sort (symbols, check_string_lessp_nokey, Qnil, Qnil);
 
   if (!NILP (readable))
     {

--- a/src/device-x.c	Sat Jan 22 00:59:20 2011 +0100
+++ b/src/device-x.c	Mon Feb 07 21:22:17 2011 +0100
@@ -1253,7 +1253,8 @@
       DEVICE_X_BEING_DELETED (d) = 1;
     }
 
-  throw_or_bomb_out (Qtop_level, Qnil, 0, Qnil, Qnil);
+  redisplay_cancel_ritual_suicide();
+  throw_or_bomb_out_unsafe (Qtop_level, Qnil, 0, Qnil, Qnil);
 
   RETURN_NOT_REACHED (0);
 }

--- a/src/dired.c	Sat Jan 22 00:59:20 2011 +0100
+++ b/src/dired.c	Mon Feb 07 21:22:17 2011 +0100
@@ -179,7 +179,7 @@
   unbind_to (speccount);	/* This will close the dir */
 
   if (NILP (nosort))
-    list = list_sort (Fnreverse (list), NULL, Qstring_lessp, Qidentity);
+    list = list_sort (Fnreverse (list), check_string_lessp_nokey, Qnil, Qnil);
 
   RETURN_UNGCPRO (list);
 }

--- a/src/eval.c	Sat Jan 22 00:59:20 2011 +0100
+++ b/src/eval.c	Mon Feb 07 21:22:17 2011 +0100
@@ -1800,22 +1800,13 @@
   LONGJMP (c->jmp, 1);
 }
 
-DECLARE_DOESNT_RETURN (throw_or_bomb_out (Lisp_Object, Lisp_Object, int,
+DECLARE_DOESNT_RETURN (throw_or_bomb_out_unsafe (Lisp_Object, Lisp_Object, int,
 					  Lisp_Object, Lisp_Object));
 
 DOESNT_RETURN
-throw_or_bomb_out (Lisp_Object tag, Lisp_Object val, int bomb_out_p,
-		   Lisp_Object sig, Lisp_Object data)
-{
-#ifdef DEFEND_AGAINST_THROW_RECURSION
-  /* die if we recurse more than is reasonable */
-  assert (++throw_level <= 20);
-#endif
-
-#ifdef ERROR_CHECK_TRAPPING_PROBLEMS
-  check_proper_critical_section_nonlocal_exit_protection ();
-#endif
-
+throw_or_bomb_out_unsafe (Lisp_Object tag, Lisp_Object val, int bomb_out_p,
+			  Lisp_Object sig, Lisp_Object data)
+{
   /* If bomb_out_p is t, this is being called from Fsignal as a
      "last resort" when there is no handler for this error and
       the debugger couldn't be invoked, so we are throwing to
@@ -1855,6 +1846,24 @@
         call1 (Qreally_early_error_handler, Fcons (sig, data));
     }
 }
+  
+DECLARE_DOESNT_RETURN (throw_or_bomb_out (Lisp_Object, Lisp_Object, int,
+					  Lisp_Object, Lisp_Object));
+
+DOESNT_RETURN
+throw_or_bomb_out (Lisp_Object tag, Lisp_Object val, int bomb_out_p,
+		   Lisp_Object sig, Lisp_Object data)
+{
+#ifdef DEFEND_AGAINST_THROW_RECURSION
+  /* die if we recurse more than is reasonable */
+  assert (++throw_level <= 20);
+#endif
+
+#ifdef ERROR_CHECK_TRAPPING_PROBLEMS
+  check_proper_critical_section_nonlocal_exit_protection ();
+#endif
+  throw_or_bomb_out_unsafe (tag, val, bomb_out_p, sig, data);
+}
 
 /* See above, where CATCHLIST is defined, for a description of how
    Fthrow() works.

--- a/src/file-coding.c	Sat Jan 22 00:59:20 2011 +0100
+++ b/src/file-coding.c	Mon Feb 07 21:22:17 2011 +0100
@@ -4815,142 +4815,143 @@
   Fmake_coding_system_internal
     (Qconvert_eol_cr, Qconvert_eol,
      build_defer_string ("Convert CR to LF"),
-     nconc2 (list6 (Qdocumentation,
-		    build_defer_string (
+     listu (Qdocumentation,
+            build_defer_string (
 "Converts CR (used to mark the end of a line on Macintosh systems) to LF\n"
 "(used internally and under Unix to mark the end of a line)."),
-		    Qmnemonic, build_ascstring ("CR->LF"),
-		    Qsubtype, Qcr),
-	     /* VERY IMPORTANT!  Tell make-coding-system not to generate
-		subsidiaries -- it needs the coding systems we're creating
+            Qmnemonic, build_ascstring ("CR->LF"),
+            Qsubtype, Qcr,
+            /* VERY IMPORTANT!  Tell make-coding-system not to generate
+               subsidiaries -- it needs the coding systems we're creating
 		to do so! */
-	     list4 (Qeol_type, Qlf,
-                    Qsafe_charsets, Qt)));
-
+            Qeol_type, Qlf,
+            Qsafe_charsets, Qt,
+            Qunbound));
   Fmake_coding_system_internal
     (Qconvert_eol_lf, Qconvert_eol,
      build_defer_string ("Convert LF to LF (do nothing)"),
-     nconc2 (list6 (Qdocumentation,
-		    build_defer_string (
-"Do nothing."),
-		    Qmnemonic, build_ascstring ("LF->LF"),
-		    Qsubtype, Qlf),
-	     /* VERY IMPORTANT!  Tell make-coding-system not to generate
+     listu (Qdocumentation,
+            build_defer_string ("Do nothing."),
+            Qmnemonic, build_ascstring ("LF->LF"),
+            Qsubtype, Qlf,
+            /* VERY IMPORTANT!  Tell make-coding-system not to generate
 		subsidiaries -- it needs the coding systems we're creating
 		to do so! */
-	     list4 (Qeol_type, Qlf,
-                    Qsafe_charsets, Qt)));
+	    Qeol_type, Qlf,
+            Qsafe_charsets, Qt,
+            Qunbound));
 
   Fmake_coding_system_internal
     (Qconvert_eol_crlf, Qconvert_eol,
      build_defer_string ("Convert CRLF to LF"),
-     nconc2 (list6 (Qdocumentation,
-		    build_defer_string (
+     listu (Qdocumentation,
+            build_defer_string (
 "Converts CR+LF (used to mark the end of a line on Macintosh systems) to LF\n"
 "(used internally and under Unix to mark the end of a line)."),
-		    Qmnemonic, build_ascstring ("CRLF->LF"),
-		    Qsubtype, Qcrlf),
-
-	     /* VERY IMPORTANT!  Tell make-coding-system not to generate
-		subsidiaries -- it needs the coding systems we're creating
-		to do so! */
-	     list4 (Qeol_type, Qlf,
-                    Qsafe_charsets, Qt)));
+            Qmnemonic, build_ascstring ("CRLF->LF"),
+            Qsubtype, Qcrlf,
+            /* VERY IMPORTANT!  Tell make-coding-system not to generate
+               subsidiaries -- it needs the coding systems we're creating
+               to do so! */
+            Qeol_type, Qlf,
+            Qsafe_charsets, Qt,
+            Qunbound));
 
   Fmake_coding_system_internal
     (Qconvert_eol_autodetect, Qconvert_eol,
      build_defer_string ("Autodetect EOL type"),
-     nconc2 (list6 (Qdocumentation,
-		    build_defer_string (
-"Autodetect the end-of-line type."),
-		    Qmnemonic, build_ascstring ("Auto-EOL"),
-		    Qsubtype, Qnil),
-	     /* VERY IMPORTANT!  Tell make-coding-system not to generate
-		subsidiaries -- it needs the coding systems we're creating
-		to do so! */
-	     list4 (Qeol_type, Qlf,
-                    Qsafe_charsets, Qt)));
+     listu (Qdocumentation,
+            build_defer_string ("Autodetect the end-of-line type."),
+            Qmnemonic, build_ascstring ("Auto-EOL"),
+            Qsubtype, Qnil,
+            /* VERY IMPORTANT!  Tell make-coding-system not to generate
+               subsidiaries -- it needs the coding systems we're creating
+               to do so! */
+            Qeol_type, Qlf,
+            Qsafe_charsets, Qt,
+            Qunbound));
 
   Fmake_coding_system_internal
     (Qundecided, Qundecided,
      build_defer_string ("Undecided (auto-detect)"),
-     nconc2 (list4 (Qdocumentation,
-		    build_defer_string
-		    ("Automatically detects the correct encoding."),
-		    Qmnemonic, build_ascstring ("Auto")),
-	     list6 (Qdo_eol, Qt, Qdo_coding, Qt,
-		    /* We do EOL detection ourselves so we don't need to be
-		       wrapped in an EOL detector. (It doesn't actually hurt,
-		       though, I don't think.) */
-		    Qeol_type, Qlf)));
+     listu (Qdocumentation,
+            build_defer_string ("Automatically detects the correct encoding."),
+            Qmnemonic, build_ascstring ("Auto"),
+            Qdo_eol, Qt, Qdo_coding, Qt,
+            /* We do EOL detection ourselves so we don't need to be
+               wrapped in an EOL detector. (It doesn't actually hurt,
+               though, I don't think.) */
+            Qeol_type, Qlf,
+            Qunbound));
 
   Fmake_coding_system_internal
     (intern ("undecided-dos"), Qundecided,
      build_defer_string ("Undecided (auto-detect) (CRLF)"),
-     nconc2 (list4 (Qdocumentation,
-		    build_defer_string
-		    ("Automatically detects the correct encoding; EOL type of CRLF forced."),
-		    Qmnemonic, build_ascstring ("Auto")),
-	     list4 (Qdo_coding, Qt,
-		    Qeol_type, Qcrlf)));
+     listu (Qdocumentation,
+            build_defer_string
+            ("Automatically detects the correct encoding; EOL type of CRLF forced."),
+            Qmnemonic, build_ascstring ("Auto"),
+            Qdo_coding, Qt,
+            Qeol_type, Qcrlf,
+            Qunbound));
 
   Fmake_coding_system_internal
     (intern ("undecided-unix"), Qundecided,
      build_defer_string ("Undecided (auto-detect) (LF)"),
-     nconc2 (list4 (Qdocumentation,
-		    build_defer_string
-		    ("Automatically detects the correct encoding; EOL type of LF forced."),
-		    Qmnemonic, build_ascstring ("Auto")),
-	     list4 (Qdo_coding, Qt,
-		    Qeol_type, Qlf)));
+     listu (Qdocumentation,
+            build_defer_string
+            ("Automatically detects the correct encoding; EOL type of LF forced."),
+            Qmnemonic, build_ascstring ("Auto"),
+            Qdo_coding, Qt,
+            Qeol_type, Qlf,
+            Qunbound));;
 
   Fmake_coding_system_internal
     (intern ("undecided-mac"), Qundecided,
      build_defer_string ("Undecided (auto-detect) (CR)"),
-     nconc2 (list4 (Qdocumentation,
-		    build_defer_string
-		    ("Automatically detects the correct encoding; EOL type of CR forced."),
-		    Qmnemonic, build_ascstring ("Auto")),
-	     list4 (Qdo_coding, Qt,
-		    Qeol_type, Qcr)));
+     listu (Qdocumentation,
+            build_defer_string
+            ("Automatically detects the correct encoding; EOL type of CR forced."),
+            Qmnemonic, build_ascstring ("Auto"),
+            Qdo_coding, Qt,
+            Qeol_type, Qcr,
+            Qunbound));
 
   /* Need to create this here or we're really screwed. */
   Fmake_coding_system_internal
     (Qraw_text, Qno_conversion,
      build_defer_string ("Raw Text"),
-     nconc2 (list4 (Qdocumentation,
-                    build_defer_string ("Raw text converts only line-break "
-                                      "codes, and acts otherwise like "
-                                      "`binary'."),
-                    Qmnemonic, build_ascstring ("Raw")),
+     listu (Qdocumentation,
+            build_defer_string ("Raw text converts only line-break "
+                                "codes, and acts otherwise like "
+                                "`binary'."),
+            Qmnemonic, build_ascstring ("Raw"),
 #ifdef MULE
-             list2 (Qsafe_charsets, list3 (Vcharset_ascii, Vcharset_control_1,
-                                           Vcharset_latin_iso8859_1))));
-
-#else
-             Qnil));
+            Qsafe_charsets, list3 (Vcharset_ascii, Vcharset_control_1,
+                                   Vcharset_latin_iso8859_1),
+
 #endif
+            Qunbound));
+
 
   Fmake_coding_system_internal
     (Qbinary, Qno_conversion,
      build_defer_string ("Binary"),
-     nconc2 (list6 (Qdocumentation,
-                    build_defer_string (
+     listu (Qdocumentation,
+            build_defer_string (
 "This coding system is as close as it comes to doing no conversion.\n"
 "On input, each byte is converted directly into the character\n"
 "with the corresponding code -- i.e. from the `ascii', `control-1',\n"
 "or `latin-1' character sets.  On output, these characters are\n"
 "converted back to the corresponding bytes, and other characters\n"
 "are converted to the default character, i.e. `~'."),
-                    Qeol_type, Qlf,
-                    Qmnemonic, build_ascstring ("Binary")),
+            Qeol_type, Qlf,
+            Qmnemonic, build_ascstring ("Binary"),
 #ifdef MULE
-             list2 (Qsafe_charsets, list3 (Vcharset_ascii, Vcharset_control_1,
-                                           Vcharset_latin_iso8859_1))));
-
-#else
-             Qnil));
+            Qsafe_charsets, list3 (Vcharset_ascii, Vcharset_control_1,
+                                   Vcharset_latin_iso8859_1),
 #endif
+            Qunbound));
 
   /* Formerly aliased to raw-text!  Completely bogus and not even the same
      as FSF Emacs. */

--- a/src/fileio.c	Sat Jan 22 00:59:20 2011 +0100
+++ b/src/fileio.c	Mon Feb 07 21:22:17 2011 +0100
@@ -130,8 +130,6 @@
 Lisp_Object Qauto_save_error;
 Lisp_Object Qauto_saving;
 
-Lisp_Object Qcar_less_than_car;
-
 Lisp_Object Qcompute_buffer_file_truename;
 
 Lisp_Object QSin_expand_file_name;
@@ -3675,7 +3673,8 @@
 	  annotations = Qnil;
 	}
       Flength (res);     /* Check basic validity of return value */
-      annotations = list_merge (annotations, res, NULL, Qlss, Qcar);
+      annotations = list_merge (annotations, res, check_lss_key_car, Qnil,
+				Qnil);
       p = Fcdr (p);
     }
 
@@ -3706,7 +3705,8 @@
 	  annotations = Qnil;
 	}
       Flength (res);
-      annotations = list_merge (annotations, res, NULL, Qlss, Qcar);
+      annotations = list_merge (annotations, res, check_lss_key_car, Qnil,
+				Qnil);
       p = Fcdr (p);
     }
 
@@ -4379,7 +4379,6 @@
   DEFSYMBOL (Qwrite_region);
   DEFSYMBOL (Qverify_visited_file_modtime);
   DEFSYMBOL (Qset_visited_file_modtime);
-  DEFSYMBOL (Qcar_less_than_car); /* Vomitous! */
   DEFSYMBOL (Qexcl);
 
   DEFSYMBOL (Qauto_save_hook);

--- a/src/fns.c	Sat Jan 22 00:59:20 2011 +0100
+++ b/src/fns.c	Mon Feb 07 21:22:17 2011 +0100
@@ -61,7 +61,7 @@
 Lisp_Object Q_test_not, Q_count, Qnsubstitute, Qdelete_duplicates, Qmismatch;
 
 Lisp_Object Qintersection, Qset_difference, Qnset_difference;
-Lisp_Object Qnunion, Qnintersection, Qsubsetp;
+Lisp_Object Qnunion, Qnintersection, Qsubsetp, Qcar_less_than_car;
 
 Lisp_Object Qbase64_conversion_error;
 
@@ -208,9 +208,6 @@
 /* Various test functions for #'member*, #'assoc* and the other functions
    that take both TEST and KEY arguments.  */
 
-typedef Boolint (*check_test_func_t) (Lisp_Object test, Lisp_Object key,
-				      Lisp_Object item, Lisp_Object elt);
-
 static Boolint
 check_eq_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
 		Lisp_Object item, Lisp_Object elt)
@@ -437,7 +434,84 @@
 
   return !NILP (elt1);
 }
-
+
+static Boolint
+check_lss_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
+		 Lisp_Object elt1, Lisp_Object elt2)
+{
+  return bytecode_arithcompare (elt1, elt2) < 0;
+}
+
+static Boolint
+check_lss_key (Lisp_Object UNUSED (test), Lisp_Object key,
+	       Lisp_Object elt1, Lisp_Object elt2)
+{
+  Lisp_Object args[] = { key, elt1, elt2 };
+  struct gcpro gcpro1;
+
+  GCPRO1 (args[0]);
+  gcpro1.nvars = countof (args);
+  args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
+  args[1] = key;
+  args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
+  UNGCPRO;
+
+  return bytecode_arithcompare (args[0], args[1]) < 0;
+}
+
+Boolint
+check_lss_key_car (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
+		   Lisp_Object elt1, Lisp_Object elt2)
+{
+  struct gcpro gcpro1, gcpro2;
+
+  GCPRO2 (elt1, elt2);
+  elt1 = CONSP (elt1) ? XCAR (elt1) : Fcar (elt1);
+  elt2 = CONSP (elt2) ? XCAR (elt2) : Fcar (elt2);
+  UNGCPRO;
+
+  return bytecode_arithcompare (elt1, elt2) < 0;
+}
+
+Boolint
+check_string_lessp_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
+			  Lisp_Object elt1, Lisp_Object elt2)
+{
+  return !NILP (Fstring_lessp (elt1, elt2));
+}
+
+static Boolint
+check_string_lessp_key (Lisp_Object UNUSED (test), Lisp_Object key,
+			Lisp_Object elt1, Lisp_Object elt2)
+{
+  Lisp_Object args[] = { key, elt1, elt2 };
+  struct gcpro gcpro1;
+
+  GCPRO1 (args[0]);
+  gcpro1.nvars = countof (args);
+  args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
+  args[1] = key;
+  args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
+  UNGCPRO;
+
+  return !NILP (Fstring_lessp (args[0], args[1]));
+}
+
+static Boolint
+check_string_lessp_key_car (Lisp_Object UNUSED (test),
+			    Lisp_Object UNUSED (key),
+			    Lisp_Object elt1, Lisp_Object elt2)
+{
+  struct gcpro gcpro1, gcpro2;
+
+  GCPRO2 (elt1, elt2);
+  elt1 = CONSP (elt1) ? XCAR (elt1) : Fcar (elt1);
+  elt2 = CONSP (elt2) ? XCAR (elt2) : Fcar (elt2);
+  UNGCPRO;
+
+  return !NILP (Fstring_lessp (elt1, elt2));
+}
+
 static check_test_func_t
 get_check_match_function_1 (Lisp_Object item,
 			    Lisp_Object *test_inout, Lisp_Object test_not,
@@ -644,6 +718,72 @@
 				     test_not_unboundp_out, test_func_out);
 }
 
+/* Given PREDICATE and KEY, return a C function pointer appropriate for use
+   in deciding whether one given elements of a sequence is less than
+   another. */
+
+static check_test_func_t
+get_merge_predicate (Lisp_Object predicate, Lisp_Object key)
+{
+  predicate = indirect_function (predicate, 1);
+
+  if (NILP (key))
+    {
+      key = Qidentity;
+    }
+  else
+    {
+      key = indirect_function (key, 1);
+      if (EQ (key, XSYMBOL_FUNCTION (Qidentity)))
+	{
+	  key = Qidentity;
+	}
+    }
+
+  if (EQ (key, Qidentity) && EQ (predicate,
+				 XSYMBOL_FUNCTION (Qcar_less_than_car)))
+    {
+      key = XSYMBOL_FUNCTION (Qcar);
+      predicate = XSYMBOL_FUNCTION (Qlss);
+    }
+
+  if (EQ (predicate, XSYMBOL_FUNCTION (Qlss)))
+    {
+      if (EQ (key, Qidentity))
+	{
+	  return check_lss_nokey;
+	}
+
+      if (EQ (key, XSYMBOL_FUNCTION (Qcar)))
+	{
+	  return check_lss_key_car;
+	}
+
+      return check_lss_key;
+    }
+
+  if (EQ (predicate, XSYMBOL_FUNCTION (Qstring_lessp)))
+    {
+      if (EQ (key, Qidentity))
+	{
+	  return check_string_lessp_nokey;
+	}
+
+      if (EQ (key, XSYMBOL_FUNCTION (Qcar)))
+	{
+	  return check_string_lessp_key_car;
+	}
+
+      return check_string_lessp_key;
+    }
+
+  if (EQ (key, Qidentity))
+    {
+      return check_other_nokey;
+    }
+
+  return check_match_other_key;
+}
 
 DEFUN ("identity", Fidentity, 1, 1, 0, /*
 Return the argument unchanged.
@@ -4692,58 +4832,10 @@
   return result;
 }
 
-static Lisp_Object
-c_merge_predicate_key (Lisp_Object obj1, Lisp_Object obj2,
-                       Lisp_Object pred, Lisp_Object key_func)
-{
-  struct gcpro gcpro1;
-  Lisp_Object args[3];
-
-  /* We could use call2() and call3() here, but we're called O(nlogn) times
-     for a sequence of length n, it make some sense to inline them. */
-  args[0] = key_func;
-  args[1] = obj1;
-  args[2] = Qnil;
-
-  GCPRO1 (args[0]);
-  gcpro1.nvars = countof (args);
-
-  obj1 = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
-
-  args[1] = obj2;
-  obj2 = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
-
-  args[0] = pred;
-  args[1] = obj1;
-  args[2] = obj2;
-
-  RETURN_UNGCPRO (IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args)));
-}
-
-static Lisp_Object
-c_merge_predicate_nokey (Lisp_Object obj1, Lisp_Object obj2,
-                         Lisp_Object pred, Lisp_Object UNUSED (key_func))
-{
-  struct gcpro gcpro1;
-  Lisp_Object args[3];
-
-  /* This is (almost) the implementation of call2, it makes some sense to
-     inline it here. */
-  args[0] = pred;
-  args[1] = obj1;
-  args[2] = obj2;
-
-  GCPRO1 (args[0]);
-  gcpro1.nvars = countof (args);
-
-  RETURN_UNGCPRO (IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args)));
-}
-
 Lisp_Object
 list_merge (Lisp_Object org_l1, Lisp_Object org_l2,
-            Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object,
-                                        Lisp_Object, Lisp_Object),
-            Lisp_Object predicate, Lisp_Object key_func)
+	    check_test_func_t check_merge,
+	    Lisp_Object predicate, Lisp_Object key)
 {
   Lisp_Object value;
   Lisp_Object tail;
@@ -4760,15 +4852,8 @@
   tortoises[0] = org_l1;
   tortoises[1] = org_l2; 
 
-  if (NULL == c_predicate)
-    {
-      c_predicate = EQ (key_func, Qidentity) ?
-        c_merge_predicate_nokey : c_merge_predicate_key;
-    }
-
-  /* It is sufficient to protect org_l1 and org_l2.
-     When l1 and l2 are updated, we copy the new values
-     back into the org_ vars.  */
+  /* It is sufficient to protect org_l1 and org_l2.  When l1 and l2 are
+     updated, we copy the new values back into the org_ vars.  */
 
   GCPRO5 (org_l1, org_l2, predicate, value, tortoises[0]);
   gcpro5.nvars = 2;
@@ -4792,7 +4877,7 @@
 	  return value;
 	}
 
-      if (NILP (c_predicate (Fcar (l2), Fcar (l1), predicate, key_func)))
+      if (check_merge (predicate, key, Fcar (l2), Fcar (l1)) == 0)
 	{
 	  tem = l1;
 	  l1 = Fcdr (l1);
@@ -4854,9 +4939,8 @@
 array_merge (Lisp_Object *dest, Elemcount dest_len,
              Lisp_Object *front, Elemcount front_len,
              Lisp_Object *back, Elemcount back_len,
-             Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object,
-                                         Lisp_Object, Lisp_Object),
-             Lisp_Object predicate, Lisp_Object key_func)
+	     check_test_func_t check_merge,
+             Lisp_Object predicate, Lisp_Object key)
 {
   Elemcount ii, fronting, backing;
   Lisp_Object *front_staging = front;
@@ -4918,8 +5002,8 @@
           return;
         }
 
-      if (NILP (c_predicate (back_staging[backing], front_staging[fronting],
-                             predicate, key_func)))
+      if (check_merge (predicate, key, back_staging[backing],
+		       front_staging[fronting]) == 0)
         {
           dest[ii] = front_staging[fronting];
           ++fronting;
@@ -4937,11 +5021,8 @@
 static Lisp_Object
 list_array_merge_into_list (Lisp_Object list,
                             Lisp_Object *array, Elemcount array_len,
-                            Lisp_Object (*c_predicate) (Lisp_Object,
-                                                        Lisp_Object,
-                                                        Lisp_Object,
-                                                        Lisp_Object),
-                            Lisp_Object predicate, Lisp_Object key_func,
+			    check_test_func_t check_merge,
+                            Lisp_Object predicate, Lisp_Object key,
                             Boolint reverse_order)
 {
   Lisp_Object tail = Qnil, value = Qnil, tortoise = list;
@@ -4980,10 +5061,8 @@
 
 
       if (reverse_order ?
-          !NILP (c_predicate (Fcar (list), array [array_index], predicate,
-                              key_func)) :
-          NILP (c_predicate (array [array_index], Fcar (list), predicate,
-                             key_func)))
+	  check_merge (predicate, key, Fcar (list), array [array_index])
+	  : !check_merge (predicate, key, array [array_index], Fcar (list)))
         {
           if (NILP (tail))
             {
@@ -5029,11 +5108,8 @@
 static void
 list_list_merge_into_array (Lisp_Object *output, Elemcount output_len,
                             Lisp_Object list_one, Lisp_Object list_two,
-                            Lisp_Object (*c_predicate) (Lisp_Object,
-                                                        Lisp_Object,
-                                                        Lisp_Object,
-                                                        Lisp_Object),
-                            Lisp_Object predicate, Lisp_Object key_func)
+			    check_test_func_t check_merge,
+                            Lisp_Object predicate, Lisp_Object key)
 {
   Elemcount output_index = 0;
 
@@ -5059,8 +5135,8 @@
           return;
         }
 
-      if (NILP (c_predicate (Fcar (list_two), Fcar (list_one), predicate,
-                             key_func)))
+      if (check_merge (predicate, key, Fcar (list_two), Fcar (list_one))
+	  == 0)
         {
           output [output_index] = XCAR (list_one);
           list_one = XCDR (list_one);
@@ -5081,11 +5157,8 @@
 list_array_merge_into_array (Lisp_Object *output, Elemcount output_len,
                              Lisp_Object list,
                              Lisp_Object *array, Elemcount array_len,
-                             Lisp_Object (*c_predicate) (Lisp_Object,
-                                                         Lisp_Object,
-                                                         Lisp_Object,
-                                                         Lisp_Object),
-                             Lisp_Object predicate, Lisp_Object key_func,
+			     check_test_func_t check_merge,
+                             Lisp_Object predicate, Lisp_Object key,
                              Boolint reverse_order)
 {
   Elemcount output_index = 0, array_index = 0;
@@ -5119,10 +5192,8 @@
         }
 
       if (reverse_order ? 
-          !NILP (c_predicate (Fcar (list), array [array_index], predicate,
-                              key_func)) :
-          NILP (c_predicate (array [array_index], Fcar (list), predicate,
-                             key_func)))
+	  check_merge (predicate, key, Fcar (list), array [array_index]) :
+	  !check_merge (predicate, key, array [array_index], Fcar (list)))
         {
           output [output_index] = XCAR (list);
           list = XCDR (list);
@@ -5170,8 +5241,7 @@
 {
   Lisp_Object type = args[0], sequence_one = args[1], sequence_two = args[2],
     predicate = args[3], result = Qnil;
-  Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object, Lisp_Object,
-			      Lisp_Object);
+  check_test_func_t check_merge = NULL;
 
   PARSE_KEYWORDS (Fmerge, nargs, args, 1, (key), NULL);
 
@@ -5180,8 +5250,7 @@
 
   CHECK_KEY_ARGUMENT (key);
 
-  c_predicate = EQ (key, Qidentity) ?
-    c_merge_predicate_nokey : c_merge_predicate_key;
+  check_merge = get_merge_predicate (predicate, key);
 
   if (EQ (type, Qlist) && (LISTP (sequence_one) || LISTP (sequence_two)))
     {
@@ -5197,7 +5266,7 @@
         }
       else if (CONSP (sequence_one) && CONSP (sequence_two))
 	{
-	  result = list_merge (sequence_one, sequence_two, c_predicate,
+	  result = list_merge (sequence_one, sequence_two, check_merge,
                                predicate, key);
 	}
       else
@@ -5239,8 +5308,7 @@
 
           result = list_array_merge_into_list (sequence_one,
                                                array_storage, array_length,
-                                               c_predicate,
-                                               predicate, key,
+                                               check_merge, predicate, key,
                                                reverse_order);
         }
     }
@@ -5304,8 +5372,7 @@
         {
           list_list_merge_into_array (output + 1, output_len - 1,
                                       sequence_one, sequence_two,
-                                      c_predicate, predicate,
-                                      key);
+                                      check_merge, predicate, key);
         }
       else if (LISTP (sequence_one))
         {
@@ -5313,8 +5380,7 @@
                                        sequence_one,
                                        sequence_two_storage,
                                        sequence_two_len,
-                                       c_predicate, predicate,
-                                       key, 0);
+                                       check_merge, predicate, key, 0);
         }
       else if (LISTP (sequence_two))
         {
@@ -5322,15 +5388,14 @@
                                        sequence_two,
                                        sequence_one_storage,
                                        sequence_one_len,
-                                       c_predicate, predicate,
-                                       key, 1);
+                                       check_merge, predicate, key, 1);
         }
       else
         {
           array_merge (output + 1, output_len - 1,
                        sequence_one_storage, sequence_one_len,
                        sequence_two_storage, sequence_two_len,
-                       c_predicate, predicate,
+                       check_merge, predicate,
                        key);
         }
 
@@ -5347,13 +5412,9 @@
   return result;
 }
 
-/* The sort function should return non-nil if OBJ1 < OBJ2, nil otherwise.
-   NOTE: This is backwards from the way qsort() works. */
 Lisp_Object
-list_sort (Lisp_Object list,
-           Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object, 
-                                       Lisp_Object, Lisp_Object),
-           Lisp_Object predicate, Lisp_Object key_func)
+list_sort (Lisp_Object list, check_test_func_t check_merge,
+	   Lisp_Object predicate, Lisp_Object key)
 {
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
   Lisp_Object back, tem;
@@ -5363,29 +5424,22 @@
   if (XINT (len) < 2)
     return list;
 
-  if (NULL == c_predicate)
-    {
-      c_predicate = EQ (key_func, Qidentity) ? c_merge_predicate_nokey :
-        c_merge_predicate_key;
-    }
-
   len = make_int (XINT (len) / 2 - 1);
   tem = Fnthcdr (len, list);
   back = Fcdr (tem);
   Fsetcdr (tem, Qnil);
 
-  GCPRO4 (front, back, predicate, key_func);
-  front = list_sort (front, c_predicate, predicate, key_func);
-  back = list_sort (back, c_predicate, predicate, key_func);
-
-  RETURN_UNGCPRO (list_merge (front, back, c_predicate, predicate, key_func));
+  GCPRO4 (front, back, predicate, key);
+  front = list_sort (front, check_merge, predicate, key);
+  back = list_sort (back, check_merge, predicate, key);
+
+  RETURN_UNGCPRO (list_merge (front, back, check_merge, predicate, key));
 }
 
 static void
 array_sort (Lisp_Object *array, Elemcount array_len,
-            Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object, 
-                                        Lisp_Object, Lisp_Object),
-            Lisp_Object predicate, Lisp_Object key_func)
+	    check_test_func_t check_merge,
+	    Lisp_Object predicate, Lisp_Object key)
 {
   Elemcount split;
 
@@ -5394,11 +5448,11 @@
 
   split = array_len / 2;
 
-  array_sort (array, split, c_predicate, predicate, key_func);
-  array_sort (array + split, array_len - split, c_predicate, predicate,
-	      key_func);
+  array_sort (array, split, check_merge, predicate, key);
+  array_sort (array + split, array_len - split, check_merge, predicate,
+	      key);
   array_merge (array, array_len, array, split, array + split,
-	       array_len - split, c_predicate, predicate, key_func);
+	       array_len - split, check_merge, predicate, key);
 }            
 
 DEFUN ("sort*", FsortX, 2, MANY, 0, /*
@@ -5421,8 +5475,7 @@
 {
   Lisp_Object sequence = args[0], predicate = args[1];
   Lisp_Object *sequence_carray;
-  Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object, Lisp_Object,
-                              Lisp_Object);
+  check_test_func_t check_merge = NULL;
   Elemcount sequence_len, i;
 
   PARSE_KEYWORDS (FsortX, nargs, args, 1, (key), NULL);
@@ -5431,17 +5484,16 @@
 
   CHECK_KEY_ARGUMENT (key);
 
-  c_predicate = EQ (key, Qidentity) ?
-    c_merge_predicate_nokey : c_merge_predicate_key;
+  check_merge = get_merge_predicate (predicate, key);
 
   if (LISTP (sequence))
     {
-      sequence = list_sort (sequence, c_predicate, predicate, key);
+      sequence = list_sort (sequence, check_merge, predicate, key);
     }
   else if (VECTORP (sequence))
     {
       array_sort (XVECTOR_DATA (sequence), XVECTOR_LENGTH (sequence),
-                  c_predicate, predicate, key);
+                  check_merge, predicate, key);
     }
   else if (STRINGP (sequence))
     {
@@ -5452,7 +5504,7 @@
       STRING_DATA_TO_OBJECT_ARRAY (strdata, sequence_carray, i, sequence_len);
 
       /* No GCPRO necessary, characters are immediate. */
-      array_sort (sequence_carray, sequence_len, c_predicate, predicate, key);
+      array_sort (sequence_carray, sequence_len, check_merge, predicate, key);
 
       strdata = XSTRING_DATA (sequence);
 
@@ -5474,7 +5526,7 @@
       BIT_VECTOR_TO_OBJECT_ARRAY (v, sequence_carray, i, sequence_len);
 
       /* No GCPRO necessary, bits are immediate. */
-      array_sort (sequence_carray, sequence_len, c_predicate, predicate, key);
+      array_sort (sequence_carray, sequence_len, check_merge, predicate, key);
 
       for (i = 0; i < sequence_len; ++i)
         {
@@ -11696,6 +11748,7 @@
   DEFSYMBOL (Qintersection);
   DEFSYMBOL (Qnintersection);
   DEFSYMBOL (Qsubsetp);
+  DEFSYMBOL (Qcar_less_than_car);
   DEFSYMBOL (Qset_difference);
   DEFSYMBOL (Qnset_difference);
   DEFSYMBOL (Qnunion);

--- a/src/fontcolor-msw.c	Sat Jan 22 00:59:20 2011 +0100
+++ b/src/fontcolor-msw.c	Mon Feb 07 21:22:17 2011 +0100
@@ -1196,10 +1196,9 @@
    "family::::charset" for TrueType fonts, "family::size::charset"
    otherwise. */
 
-static Lisp_Object
-sort_font_list_function (Lisp_Object obj1, Lisp_Object obj2,
-			 Lisp_Object UNUSED (pred),
-                         Lisp_Object UNUSED (key_function))
+static Boolint
+sort_font_list_function (Lisp_Object UNUSED (pred), Lisp_Object UNUSED (key),
+			 Lisp_Object obj1, Lisp_Object obj2)
 {
   Ibyte *font1, *font2;
   Ibyte *c1, *c2;
@@ -1213,16 +1212,16 @@
     5. Courier New over other families.
   */
 
-  /* The sort function should return non-nil if OBJ1 < OBJ2, nil otherwise.
-     NOTE: This is backwards from the way qsort() works. */
+  /* The sort function should return non-zero if OBJ1 < OBJ2, zero
+     otherwise. */
 
   t1 = !NILP (XCDR (obj1));
   t2 = !NILP (XCDR (obj2));
 
   if (t1 && !t2)
-    return Qt;
+    return 1;
   if (t2 && !t1)
-    return Qnil;
+    return 0;
 
   font1 = XSTRING_DATA (XCAR (obj1));
   font2 = XSTRING_DATA (XCAR (obj2));
@@ -1234,9 +1233,9 @@
   t2 = !qxestrcasecmp_ascii (c2 + 1, "western");
 
   if (t1 && !t2)
-    return Qt;
+    return 1;
   if (t2 && !t1)
-    return Qnil;
+    return 0;
 
   c1 -= 2;
   c2 -= 2;
@@ -1244,9 +1243,9 @@
   t2 = *c2 == ':';
 
   if (t1 && !t2)
-    return Qt;
+    return 1;
   if (t2 && !t1)
-    return Qnil;
+    return 0;
 
   if (!t1 && !t2)
     {
@@ -1259,25 +1258,25 @@
       t2 = qxeatoi (c2 + 1) - 10;
 
       if (abs (t1) < abs (t2))
-	return Qt;
+	return 1;
       else if (abs (t2) < abs (t1))
-	return Qnil;
+	return 0;
       else if (t1 < t2)
 	/* Prefer a smaller font over a larger one just as far away
 	   because the smaller one won't upset the total line height if it's
 	   just a few chars. */
-	return Qt;
+	return 1;
     }
 
   t1 = !qxestrncasecmp_ascii (font1, "courier new:", 12);
   t2 = !qxestrncasecmp_ascii (font2, "courier new:", 12);
 
   if (t1 && !t2)
-    return Qt;
+    return 1;
   if (t2 && !t1)
-    return Qnil;
+    return 0;
 
-  return Qnil;
+  return 0;
 }
 
 /*

--- a/src/intl-win32.c	Sat Jan 22 00:59:20 2011 +0100
+++ b/src/intl-win32.c	Mon Feb 07 21:22:17 2011 +0100
@@ -2356,14 +2356,15 @@
   Fmake_coding_system_internal
     (Qmswindows_unicode, Qunicode,
      build_defer_string ("MS Windows Unicode"),
-     nconc2 (list4 (Qdocumentation,
-		    build_defer_string (
+     listu (Qdocumentation,
+            build_defer_string (
 "Converts to the Unicode encoding for Windows API calls.\n"
 "This encoding is equivalent to standard UTF16, little-endian."
 ),
-		    Qmnemonic, build_ascstring ("MSW-U")),
-	     list4 (Qunicode_type, Qutf_16,
-		    Qlittle_endian, Qt)));
+            Qmnemonic, build_ascstring ("MSW-U"),
+            Qunicode_type, Qutf_16,
+            Qlittle_endian, Qt,
+            Qunbound));
 
 #ifdef MULE
   /* Just temporarily.  This will get fixed in mule-msw-init.el. */

--- a/src/keymap.c	Sat Jan 22 00:59:20 2011 +0100
+++ b/src/keymap.c	Mon Feb 07 21:22:17 2011 +0100
@@ -735,10 +735,9 @@
   return 0;
 }
 
-static Lisp_Object map_keymap_sort_predicate (Lisp_Object obj1,
-                                              Lisp_Object obj2,
-                                              Lisp_Object pred,
-                                              Lisp_Object key_func);
+static Boolint map_keymap_sort_predicate (Lisp_Object pred, Lisp_Object key,
+					  Lisp_Object obj1, Lisp_Object obj2);
+					  
 
 static Lisp_Object
 keymap_submaps (Lisp_Object keymap)
@@ -762,7 +761,7 @@
 		     &keymap_submaps_closure);
       /* keep it sorted so that the result of accessible-keymaps is ordered */
       k->sub_maps_cache = list_sort (result, map_keymap_sort_predicate,
-                                     Qnil, Qidentity);
+                                     Qnil, Qnil);
       UNGCPRO;
     }
   return k->sub_maps_cache;
@@ -2894,10 +2893,9 @@
 /* used by map_keymap_sorted(), describe_map_sort_predicate(),
    and keymap_submaps().
  */
-static Lisp_Object
-map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
-                           Lisp_Object UNUSED (pred),
-                           Lisp_Object UNUSED (key_func))
+static Boolint
+map_keymap_sort_predicate (Lisp_Object UNUSED (pred), Lisp_Object UNUSED (key),
+			   Lisp_Object obj1, Lisp_Object obj2)
 {
   /* obj1 and obj2 are conses with keysyms in their cars.  Cdrs are ignored.
    */
@@ -2910,12 +2908,12 @@
   obj2 = XCAR (obj2);
 
   if (EQ (obj1, obj2))
-    return Qnil;
+    return 0;
   bit1 = MODIFIER_HASH_KEY_BITS (obj1);
   bit2 = MODIFIER_HASH_KEY_BITS (obj2);
 
-  /* If either is a symbol with a Qcharacter_of_keysym property, then sort it by
-     that code instead of alphabetically.
+  /* If either is a symbol with a Qcharacter_of_keysym property, then sort
+     it by that code instead of alphabetically.
      */
   if (! bit1 && SYMBOLP (obj1))
     {
@@ -2940,7 +2938,7 @@
 
   /* all symbols (non-ASCIIs) come after characters (ASCIIs) */
   if (XTYPE (obj1) != XTYPE (obj2))
-    return SYMBOLP (obj2) ? Qt : Qnil;
+    return SYMBOLP (obj2);
 
   if (! bit1 && CHARP (obj1)) /* they're both ASCII */
     {
@@ -2948,24 +2946,24 @@
       int o2 = XCHAR (obj2);
       if (o1 == o2 &&		/* If one started out as a symbol and the */
 	  sym1_p != sym2_p)	/* other didn't, the symbol comes last. */
-	return sym2_p ? Qt : Qnil;
-
-      return o1 < o2 ? Qt : Qnil;	/* else just compare them */
+	return sym2_p;
+
+      return o1 < o2;		/* else just compare them */
     }
 
   /* else they're both symbols.  If they're both buckys, then order them. */
   if (bit1 && bit2)
-    return bit1 < bit2 ? Qt : Qnil;
+    return bit1 < bit2;
 
   /* if only one is a bucky, then it comes later */
   if (bit1 || bit2)
-    return bit2 ? Qt : Qnil;
+    return bit2;
 
   /* otherwise, string-sort them. */
   {
     Ibyte *s1 = XSTRING_DATA (XSYMBOL (obj1)->name);
     Ibyte *s2 = XSTRING_DATA (XSYMBOL (obj2)->name);
-    return 0 > qxestrcmp (s1, s2) ? Qt : Qnil;
+    return 0 > qxestrcmp (s1, s2);
   }
 }
 
@@ -4085,10 +4083,10 @@
 			    *(closure->list));
 }
 
-
-static Lisp_Object
-describe_map_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
-			     Lisp_Object pred, Lisp_Object key_func)
+static Boolint
+describe_map_sort_predicate (Lisp_Object pred, Lisp_Object key_func,
+			     Lisp_Object obj1, Lisp_Object obj2)
+			     
 {
   /* obj1 and obj2 are conses of the form
      ( ( <keysym> . <modifiers> ) . <binding> )
@@ -4100,9 +4098,9 @@
   bit1 = XINT (XCDR (obj1));
   bit2 = XINT (XCDR (obj2));
   if (bit1 != bit2)
-    return bit1 < bit2 ? Qt : Qnil;
+    return bit1 < bit2;
   else
-    return map_keymap_sort_predicate (obj1, obj2, pred, key_func);
+    return map_keymap_sort_predicate (pred, key_func, obj1, obj2);
 }
 
 /* Elide 2 or more consecutive numeric keysyms bound to the same thing,
@@ -4210,7 +4208,7 @@
 
   if (!NILP (list))
     {
-      list = list_sort (list, describe_map_sort_predicate, Qnil, Qidentity);
+      list = list_sort (list, describe_map_sort_predicate, Qnil, Qnil);
       buffer_insert_ascstring (buf, "\n");
       while (!NILP (list))
 	{

--- a/src/lisp.h	Sat Jan 22 00:59:20 2011 +0100
+++ b/src/lisp.h	Mon Feb 07 21:22:17 2011 +0100
@@ -4720,6 +4720,10 @@
                                                      Lisp_Object, int,
                                                      Lisp_Object, Lisp_Object));
 
+MODULE_API DECLARE_DOESNT_RETURN (throw_or_bomb_out_unsafe (Lisp_Object,
+							    Lisp_Object, int,
+							    Lisp_Object, Lisp_Object));
+
 MODULE_API DECLARE_DOESNT_RETURN (signal_error_1 (Lisp_Object, Lisp_Object));
 void maybe_signal_error_1 (Lisp_Object, Lisp_Object, Lisp_Object,
 			   Error_Behavior);
@@ -5242,15 +5246,19 @@
 EXFUN (Fsubseq, 3);
 EXFUN (Fvalid_plist_p, 1);
 
+extern Boolint check_lss_key_car (Lisp_Object, Lisp_Object, Lisp_Object,
+				  Lisp_Object);
+extern Boolint check_string_lessp_nokey (Lisp_Object, Lisp_Object,
+					 Lisp_Object, Lisp_Object);
+
+typedef Boolint (*check_test_func_t) (Lisp_Object test, Lisp_Object key,
+				      Lisp_Object item, Lisp_Object elt);
+
 Lisp_Object list_merge (Lisp_Object org_l1, Lisp_Object org_l2,
-                        Lisp_Object (*c_predicate) (Lisp_Object o1,
-                                                    Lisp_Object o2,
-                                                    Lisp_Object pred,
-                                                    Lisp_Object keyf),
+			check_test_func_t check_merge,
                         Lisp_Object predicate, Lisp_Object key_func);
 Lisp_Object list_sort (Lisp_Object list,
-                       Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object, 
-                                                   Lisp_Object, Lisp_Object),
+		       check_test_func_t check_merge,
                        Lisp_Object predicate, Lisp_Object key_func);
 
 void bump_string_modiff (Lisp_Object);

--- a/src/profile.c	Sat Jan 22 00:59:20 2011 +0100
+++ b/src/profile.c	Mon Feb 07 21:22:17 2011 +0100
@@ -540,15 +540,16 @@
       unbind_to (count);
     }
 
-  retv = nconc2 (list6 (Qtiming, closure.timing, Qtotal_timing,
-			copy_hash_table_or_blank (Vtotal_timing_profile_table),
-			Qcall_count,
-			copy_hash_table_or_blank (Vcall_count_profile_table)),
-		 list4 (Qgc_usage,
-			copy_hash_table_or_blank (Vgc_usage_profile_table),
-			Qtotal_gc_usage,
-			copy_hash_table_or_blank (Vtotal_gc_usage_profile_table
-						  )));
+  retv = listu (Qtiming, closure.timing,
+                Qtotal_timing,
+                copy_hash_table_or_blank (Vtotal_timing_profile_table),
+                Qcall_count,
+                copy_hash_table_or_blank (Vcall_count_profile_table),
+                Qgc_usage,
+                copy_hash_table_or_blank (Vgc_usage_profile_table),
+                Qtotal_gc_usage,
+                copy_hash_table_or_blank (Vtotal_gc_usage_profile_table),
+                Qunbound);
   unbind_to (depth);
   return retv;
 }

--- a/src/redisplay.c	Sat Jan 22 00:59:20 2011 +0100
+++ b/src/redisplay.c	Mon Feb 07 21:22:17 2011 +0100
@@ -6686,12 +6686,25 @@
   unbind_to (depth);
 }
 
+static int the_ritual_suicide_has_been_cancelled = 0;
+
+void
+redisplay_cancel_ritual_suicide(void)
+{
+  the_ritual_suicide_has_been_cancelled = 1;
+}
+
 #ifdef ERROR_CHECK_TRAPPING_PROBLEMS
 
 static Lisp_Object
 commit_ritual_suicide (Lisp_Object UNUSED (ceci_nest_pas_une_pipe))
 {
-  assert (!in_display);
+  if (!the_ritual_suicide_has_been_cancelled)
+    {
+      assert (!in_display);
+    }
+  else
+    the_ritual_suicide_has_been_cancelled = 0;
   return Qnil;
 }
 

--- a/src/redisplay.h	Sat Jan 22 00:59:20 2011 +0100
+++ b/src/redisplay.h	Mon Feb 07 21:22:17 2011 +0100
@@ -846,4 +846,6 @@
 int enter_redisplay_critical_section_if (Boolint from_outside);
 void exit_redisplay_critical_section_if (Boolint from_outside, int depth);
 
+void redisplay_cancel_ritual_suicide(void);
+
 #endif /* INCLUDED_redisplay_h_ */

--- a/src/symbols.c	Sat Jan 22 00:59:20 2011 +0100
+++ b/src/symbols.c	Mon Feb 07 21:22:17 2011 +0100
@@ -506,8 +506,8 @@
   closure.accumulation = Qnil;
   GCPRO1 (closure.accumulation);
   map_obarray (Vobarray, apropos_mapper, &closure);
-  closure.accumulation = list_sort (closure.accumulation, NULL, Qstring_lessp,
-                                    Qidentity);
+  closure.accumulation = list_sort (closure.accumulation,
+				    check_string_lessp_nokey, Qnil, Qnil);
   UNGCPRO;
   return closure.accumulation;
 }

--- a/src/unicode.c	Sat Jan 22 00:59:20 2011 +0100
+++ b/src/unicode.c	Mon Feb 07 21:22:17 2011 +0100
@@ -3292,8 +3292,8 @@
   Fmake_coding_system_internal
     (Qutf_8, Qunicode,
      build_defer_string ("UTF-8"),
-     nconc2 (list4 (Qdocumentation,
-		    build_defer_string (
+     listu (Qdocumentation,
+            build_defer_string (
 "UTF-8 Unicode encoding -- ASCII-compatible 8-bit variable-width encoding\n"
 "sharing the following principles with the Mule-internal encoding:\n"
 "\n"
@@ -3315,6 +3315,7 @@
 "  -- Given only the leading byte, you know how many following bytes\n"
 "     are present.\n"
 ),
-		    Qmnemonic, build_ascstring ("UTF8")),
-	     list2 (Qunicode_type, Qutf_8)));
+            Qmnemonic, build_ascstring ("UTF8"),
+            Qunicode_type, Qutf_8,
+            Qunbound));
 }

--- a/tests/ChangeLog	Sat Jan 22 00:59:20 2011 +0100
+++ b/tests/ChangeLog	Mon Feb 07 21:22:17 2011 +0100
@@ -1,3 +1,25 @@
+2011-02-07  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* automated/lisp-tests.el:
+	Test lexical scope for `block', `return-from'; add a
+	Known-Bug-Expect-Failure for a contorted example that fails when
+	byte-compiled.
+
+2011-01-23  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* automated/lisp-tests.el:
+	When sanity-checking :start and :end keyword arguments, loop at
+	macroexpansion time, not runtime, allowing us to pick up any
+	compiler macros and giving a clearer *Test-Log* buffer.
+
+2011-01-23  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* automated/lisp-tests.el (test-fun):
+	#'delete* and friends can now throw a wrong-type-argument if
+	handed a non-sequence; accept this too when checking for an error
+	when passing a fixnum as the SEQUENCE argument.
+	Check #'remove*, #'remove and #'remq too.
+
 2011-01-15  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* automated/lisp-tests.el (list): Test #'concatenate, especially

--- a/tests/automated/lisp-tests.el	Sat Jan 22 00:59:20 2011 +0100
+++ b/tests/automated/lisp-tests.el	Mon Feb 07 21:22:17 2011 +0100
@@ -791,19 +791,21 @@
       `(progn
 	 (Check-Error wrong-number-of-arguments (,fun))
 	 (Check-Error wrong-number-of-arguments (,fun nil))
-	 (Check-Error malformed-list (,fun nil 1))
+	 (Check-Error (malformed-list wrong-type-argument) (,fun nil 1))
 	 ,@(loop for n in '(1 2 2000)
 	     collect `(Check-Error circular-list (,fun 1 (make-circular-list ,n))))))
      (test-funs (&rest funs) `(progn ,@(loop for fun in funs collect `(test-fun ,fun)))))
 
-  (test-funs member* member old-member 
-	     memq   old-memq
-	     assoc* assoc  old-assoc
-	     rassoc* rassoc old-rassoc
-	     rassq  old-rassq
-	     delete* delete old-delete
-	     delq   old-delq
-	     remassoc remassq remrassoc remrassq))
+  (test-funs member* member memq 
+             assoc* assoc assq 
+             rassoc* rassoc rassq 
+             delete* delete delq 
+             remove* remove remq 
+             old-member old-memq 
+             old-assoc old-assq 
+             old-rassoc old-rassq 
+             old-delete old-delq 
+             remassoc remassq remrassoc remrassq))
 
 (let ((x '((1 . 2) 3 (4 . 5))))
   (Assert (eq (assoc  1 x) (car x)))
@@ -2678,115 +2680,154 @@
         (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))))))
+    (macrolet
+        ((construct-item-sequence-checks (&rest functions)
+           (cons
+            'progn
+            (mapcan
+             #'(lambda (function)
+                 `((Check-Error args-out-of-range
+                                (,function item list
+                                           :start (1+ list-length)
+                                           :end (1+ list-length)))
+                   (Check-Error wrong-type-argument
+                                (,function item list :start -1
+                                           :end list-length))
+                   (Check-Error args-out-of-range
+                                (,function item list :end (* 2 list-length)))
+                   (Check-Error args-out-of-range
+                                (,function item vector
+                                           :start (1+ vector-length)
+                                           :end (1+ vector-length)))
+                   (Check-Error wrong-type-argument
+                                (,function item vector :start -1))
+                   (Check-Error args-out-of-range
+                                (,function item vector
+                                           :end (* 2 vector-length)))
+                   (Check-Error args-out-of-range
+                                (,function item bit-vector
+                                           :start (1+ vector-length)
+                                           :end (1+ vector-length)))
+                   (Check-Error wrong-type-argument
+                                (,function item bit-vector :start -1))
+                   (Check-Error args-out-of-range
+                                (,function item bit-vector
+                                           :end (* 2 vector-length)))
+                   (Check-Error args-out-of-range
+                                (,function item string
+                                           :start (1+ string-length)
+                                           :end (1+ string-length)))
+                   (Check-Error wrong-type-argument
+                                (,function item string :start -1))
+                   (Check-Error args-out-of-range
+                                (,function item string
+                                           :end (* 2 string-length)))))
+             functions)))
+         (construct-one-sequence-checks (&rest functions)
+           (cons
+            'progn
+            (mapcan
+             #'(lambda (function)
+                 `((Check-Error args-out-of-range
+                                (,function (copy-sequence list)
+                                           :start (1+ list-length)
+                                           :end (1+ list-length)))
+                   (Check-Error wrong-type-argument
+                                (,function (copy-sequence list)
+                                           :start -1 :end list-length))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence list)
+                                           :end (* 2 list-length)))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence vector)
+                                           :start (1+ vector-length)
+                                           :end (1+ vector-length)))
+                   (Check-Error wrong-type-argument
+                                (,function (copy-sequence vector) :start -1))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence vector)
+                                           :end (* 2 vector-length)))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence bit-vector)
+                                           :start (1+ vector-length)
+                                           :end (1+ vector-length)))
+                   (Check-Error wrong-type-argument
+                                (,function (copy-sequence bit-vector)
+                                           :start -1))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence bit-vector)
+                                           :end (* 2 vector-length)))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence string)
+                                           :start (1+ string-length)
+                                           :end (1+ string-length)))
+                   (Check-Error wrong-type-argument
+                                (,function (copy-sequence string) :start -1))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence string)
+                                           :end (* 2 string-length)))))
+             functions)))
+         (construct-two-sequence-checks (&rest functions)
+           (cons
+            'progn
+            (mapcan
+             #'(lambda (function)
+                 `((Check-Error args-out-of-range
+                                (,function (copy-sequence list)
+                                           (copy-sequence list)
+                                           :start1 (1+ list-length)
+                                           :end1 (1+ list-length)))
+                   (Check-Error wrong-type-argument
+                                (,function (copy-sequence list)
+                                           (copy-sequence list)
+                                           :start1 -1 :end1 list-length))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence list)
+                                           (copy-sequence list)
+                                           :end1 (* 2 list-length)))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence vector)
+                                           (copy-sequence vector)
+                                           :start1 (1+ vector-length)
+                                           :end1 (1+ vector-length)))
+                   (Check-Error wrong-type-argument
+                                (,function
+                                 (copy-sequence vector)
+                                 (copy-sequence vector) :start1 -1))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence vector)
+                                           (copy-sequence vector)
+                                           :end1 (* 2 vector-length)))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence bit-vector)
+                                           (copy-sequence bit-vector)
+                                           :start1 (1+ vector-length)
+                                           :end1 (1+ vector-length)))
+                   (Check-Error wrong-type-argument
+                                (,function (copy-sequence bit-vector)
+                                           (copy-sequence bit-vector)
+                                           :start1 -1))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence bit-vector)
+                                           (copy-sequence bit-vector)
+                                           :end1 (* 2 vector-length)))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence string)
+                                           (copy-sequence string)
+                                           :start1 (1+ string-length)
+                                           :end1 (1+ string-length)))
+                   (Check-Error wrong-type-argument
+                                (,function (copy-sequence string)
+                                           (copy-sequence string) :start1 -1))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence string)
+                                           (copy-sequence string)
+                                           :end1 (* 2 string-length)))))
+             functions))))
+      (construct-item-sequence-checks count position find delete* remove*
+                                      reduce)
+      (construct-one-sequence-checks delete-duplicates remove-duplicates)
+      (construct-two-sequence-checks replace mismatch search))))
 
 (let* ((list (list 1 2 3 4 5 6 7 120 'hi-there '#:everyone))
        (vector (map 'vector #'identity list))
@@ -2828,4 +2869,33 @@
 					 (subseq bit-vector 0 4)
 					 (append (subseq bit-vector 4) nil)))))
 
+;;-----------------------------------------------------
+;; Test `block', `return-from'
+;;-----------------------------------------------------
+(Assert (eql 1 (block outer
+		 (flet ((outtahere (n) (return-from outer n)))
+		   (block outer (outtahere 1)))
+		 2))
+	"checking `block' and `return-from' are lexically scoped correctly")
+
+;; Other tests are available in Paul Dietz' test suite, and pass. The above,
+;; which we used to fail, is based on a test in the Hyperspec. We still
+;; behave incorrectly when compiled for the contorted-example function of
+;; CLTL2, whence the following test:
+
+(flet ((needs-lexical-context (first second third)
+	 (if (eql 0 first)
+	     (funcall second)
+	   (block awkward
+	     (+ 5 (needs-lexical-context
+		   (1- first)
+		   third
+		   #'(lambda () (return-from awkward 0)))
+		first)))))
+  (if (compiled-function-p (symbol-function 'needs-lexical-context))
+      (Known-Bug-Expect-Failure
+       (Assert (eql 0 (needs-lexical-context 2 nil nil))
+	"the function special operator doesn't create a lexical context."))
+    (Assert (eql 0 (needs-lexical-context 2 nil nil)))))
+
 ;;; end of lisp-tests.el