Mercurial > hg > xemacs-beta

--- a/lisp/ChangeLog	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/ChangeLog	Tue May 01 16:17:42 2012 +0100
@@ -1,3 +1,92 @@
+2012-05-01  Aidan Kehoe  <kehoea@parhasard.net>
+
+	Avoid #'delq in core code, for the sake of style and a (very
+	slightly) smaller binary.
+
+	* behavior.el (disable-behavior):
+	* behavior.el (compute-behavior-group-children):
+	* buff-menu.el (buffers-tab-items):
+	* byte-optimize.el (byte-optimize-delay-constants-math):
+	* byte-optimize.el (byte-optimize-logmumble):
+	* byte-optimize.el (byte-decompile-bytecode-1):
+	* byte-optimize.el (byte-optimize-lapcode):
+	* bytecomp.el:
+	* bytecomp.el (byte-compile-arglist-warn):
+	* bytecomp.el (byte-compile-warn-about-unresolved-functions):
+	* bytecomp.el (byte-compile-lambda):
+	* bytecomp.el (byte-compile-out-toplevel):
+	* bytecomp.el (byte-compile-insert):
+	* bytecomp.el (byte-compile-defalias-warn):
+	* cl-macs.el (cl-upcase-arg):
+	* cl-macs.el (cl-transform-lambda):
+	* cl-macs.el (cl-do-proclaim):
+	* cl-macs.el (defstruct):
+	* cl-macs.el (cl-make-type-test):
+	* cl-macs.el (define-compiler-macro):
+	* cl-macs.el (delete-duplicates):
+	* cus-edit.el (widget-face-value-delete):
+	* cus-edit.el (face-history):
+	* easymenu.el (easy-menu-remove):
+	* files.el (files-fetch-hook-value):
+	* files.el (file-expand-wildcards):
+	* font-lock.el (font-lock-update-removed-keyword-alist):
+	* font-lock.el (font-lock-remove-keywords):
+	* frame.el (frame-initialize):
+	* frame.el (frame-notice-user-settings):
+	* frame.el (set-frame-font):
+	* frame.el (delete-other-frames):
+	* frame.el (get-frame-for-buffer-noselect):
+	* gnuserv.el (gnuserv-kill-buffer-function):
+	* gnuserv.el (gnuserv-check-device):
+	* gnuserv.el (gnuserv-kill-client):
+	* gnuserv.el (gnuserv-buffer-done-1):
+	* gtk-font-menu.el (gtk-reset-device-font-menus):
+	* gutter-items.el (buffers-tab-items):
+	* gutter.el (set-gutter-element-visible-p):
+	* info.el (Info-find-file-node):
+	* info.el (Info-history-add):
+	* info.el (Info-build-annotation-completions):
+	* info.el (Info-index):
+	* info.el (Info-reannotate-node):
+	* itimer.el (delete-itimer):
+	* itimer.el (start-itimer):
+	* lib-complete.el (lib-complete:cache-completions):
+	* loadhist.el (unload-feature):
+	* menubar-items.el (build-buffers-menu-internal):
+	* menubar.el (delete-menu-item):
+	* menubar.el (relabel-menu-item):
+	* msw-font-menu.el (mswindows-reset-device-font-menus):
+	* mule/make-coding-system.el (fixed-width-generate-helper):
+	* next-error.el (next-error-find-buffer):
+	* obsolete.el:
+	* obsolete.el (find-non-ascii-charset-string):
+	* obsolete.el (find-non-ascii-charset-region):
+	* occur.el (multi-occur-by-filename-regexp):
+	* occur.el (occur-1):
+	* packages.el (packages-package-hierarchy-directory-names):
+	* packages.el (package-get-key-1):
+	* process.el (setenv):
+	* simple.el (undo):
+	* simple.el (handle-pre-motion-command-current-command-is-motion):
+	* sound.el (load-sound-file):
+	* wid-edit.el (widget-field-value-delete):
+	* wid-edit.el (widget-checklist-match-inline):
+	* wid-edit.el (widget-checklist-match-find):
+	* wid-edit.el (widget-editable-list-delete-at):
+	* wid-edit.el (widget-editable-list-entry-create):
+	* window.el (quit-window):
+	* x-font-menu.el (x-reset-device-font-menus-core):
+
+	1. Replace (delq nil (mapcar ....)) with analogous (mapcan ...)
+	forms; this is in non-dumped files, it was done previously in
+	dumped files.
+	2. Replace (delq FOO (copy-sequence BAR)) with (remove* FOO BAR),
+	where #'eq and #'eql are equivalent
+	3. Replace (delq FOO BAR) with (delete* FOO BAR), where FOO is not
+	a non-fixnum number. Saves a little space in the dumped file
+	(since the compiler macro adds :test #'eq to the delete* call if
+	it's not clear that FOO is not a non-fixnum number).
+
 2012-05-01  Aidan Kehoe  <kehoea@parhasard.net>

 	* byte-optimize.el (byte-optimize-form-code-walker):
--- a/lisp/behavior.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/behavior.el	Tue May 01 16:17:42 2012 +0100
@@ -403,7 +403,7 @@
       (message "Disabling behavior %s...done" behavior)
       (let ((within-behavior-enabling-disabling t))
 	(customize-set-variable 'enabled-behavior-list
-				(delq behavior enabled-behavior-list))))))
+				(delete* behavior enabled-behavior-list))))))

 (defun compute-behavior-group-children (group hash)
   "Compute the actual children for GROUP and its subgroups.
--- a/lisp/buff-menu.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/buff-menu.el	Tue May 01 16:17:42 2012 +0100
@@ -860,10 +860,10 @@
 		 (not in-deletion)
 		 (not (eq first-buf (window-buffer (selected-window frame)))))
 	(setq buffers (cons (window-buffer (selected-window frame))
-			    (delq first-buf buffers))))
+			    (delete* first-buf buffers))))
       ;; if we're in deletion ignore the current buffer
       (when in-deletion
-	(setq buffers (delq (current-buffer) buffers))
+	(setq buffers (delete* (current-buffer) buffers))
 	(setq first-buf (car buffers)))
       ;; filter buffers
       (when buffers-tab-filter-functions
--- a/lisp/byte-optimize.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/byte-optimize.el	Tue May 01 16:17:42 2012 +0100
@@ -710,7 +710,7 @@
 			    (apply fun (mapcar 'float constants))
 			    (float (apply fun constants)))))
 		(setq form orig)
-	      (setq form (nconc (delq nil form)
+	      (setq form (nconc (delete* nil form)
 				(list (apply fun (nreverse constants)))))))))
     form))

@@ -787,7 +787,7 @@
    (cond ((memq 0 form)
 	  (setq form (if (eq (car form) 'logand)
 			 (cons 'progn (cdr form))
-		       (delq 0 (copy-sequence form)))))
+		       (remove* 0 form))))
 	 ((and (eq (car-safe form) 'logior)
 	       (memq -1 form))
 	  (cons 'progn (cdr form)))
@@ -1462,7 +1462,7 @@
 	       ;; this addr is jumped to
 	       (setcdr rest (cons (cons nil (cdr tmp))
 				  (cdr rest)))
-	       (setq tags (delq tmp tags))
+	       (setq tags (delete* tmp tags))
 	       (setq rest (cdr rest))))
 	(setq rest (cdr rest))))
     (if tags (error "optimizer error: missed tags %s" tags))
@@ -1591,11 +1591,11 @@
 	       (cond ((= tmp 1)
 		      (byte-compile-log-lap
  		       "  %s discard\t-->\t<deleted>" lap0)
-		      (setq lap (delq lap0 (delq lap1 lap))))
+		      (setq lap (delete* lap0 (delete* lap1 lap))))
 		     ((= tmp 0)
 		      (byte-compile-log-lap
 		       "  %s discard\t-->\t<deleted> discard" lap0)
-		      (setq lap (delq lap0 lap)))
+		      (setq lap (delete* lap0 lap)))
 		     ((= tmp -1)
 		      (byte-compile-log-lap
 		       "  %s discard\t-->\tdiscard discard" lap0)
@@ -1608,7 +1608,7 @@
 	      ((and (memq (car lap0) byte-goto-ops)
 		    (eq (cdr lap0) lap1))
 	       (cond ((eq (car lap0) 'byte-goto)
-		      (setq lap (delq lap0 lap))
+		      (setq lap (delete* lap0 lap))
 		      (setq tmp "<deleted>"))
 		     ((memq (car lap0) byte-goto-always-pop-ops)
 		      (setcar lap0 (setq tmp 'byte-discard))
@@ -1665,7 +1665,7 @@
 	       (byte-compile-log-lap "  dup %s discard\t-->\t%s" lap1 lap1)
 	       (setq keep-going t
 		     rest (cdr rest))
-	       (setq lap (delq lap0 (delq lap2 lap))))
+	       (setq lap (delete* lap0 (delete* lap2 lap))))
 	      ;;
 	      ;; not goto-X-if-nil              -->  goto-X-if-non-nil
 	      ;; not goto-X-if-non-nil          -->  goto-X-if-nil
@@ -1685,7 +1685,7 @@
 	       (setcar lap1 (if (eq (car lap1) 'byte-goto-if-nil)
 				'byte-goto-if-not-nil
 				'byte-goto-if-nil))
-	       (setq lap (delq lap0 lap))
+	       (setq lap (delete* lap0 lap))
 	       (setq keep-going t))
 	      ;;
 	      ;; goto-X-if-nil     goto-Y X:  -->  goto-Y-if-non-nil X:
@@ -1702,7 +1702,7 @@
 		 (byte-compile-log-lap "  %s %s %s:\t-->\t%s %s:"
 				       lap0 lap1 lap2
 				       (cons inverse (cdr lap1)) lap2)
-		 (setq lap (delq lap0 lap))
+		 (setq lap (delete* lap0 lap))
 		 (setcar lap1 inverse)
 		 (setq keep-going t)))
 	      ;;
@@ -1717,13 +1717,13 @@
 		      (byte-compile-log-lap "  %s %s\t-->\t<deleted>"
 					    lap0 lap1)
 		      (setq rest (cdr rest)
-			    lap (delq lap0 (delq lap1 lap))))
+			    lap (delete* lap0 (delete* lap1 lap))))
 		     (t
 		      (if (memq (car lap1) byte-goto-always-pop-ops)
 			  (progn
 			    (byte-compile-log-lap "  %s %s\t-->\t%s"
 			     lap0 lap1 (cons 'byte-goto (cdr lap1)))
-			    (setq lap (delq lap0 lap)))
+			    (setq lap (delete* lap0 lap)))
 			(byte-compile-log-lap "  %s %s\t-->\t%s" lap0 lap1
 			 (cons 'byte-goto (cdr lap1))))
 		      (setcar lap1 'byte-goto)))
@@ -1768,7 +1768,7 @@
 	       (while (setq tmp2 (rassq lap0 tmp3))
 		 (setcdr tmp2 lap1)
 		 (setq tmp3 (cdr (memq tmp2 tmp3))))
-	       (setq lap (delq lap0 lap)
+	       (setq lap (delete* lap0 lap)
 		     keep-going t))
 	      ;;
 	      ;; unused-TAG: --> <deleted>
@@ -1777,7 +1777,7 @@
 		    (not (rassq lap0 lap)))
 	       (and (memq byte-optimize-log '(t byte))
 		    (byte-compile-log "  unused tag %d removed" (nth 1 lap0)))
-	       (setq lap (delq lap0 lap)
+	       (setq lap (delete* lap0 lap)
 		     keep-going t))
 	      ;;
 	      ;; goto   ... --> goto   <delete until TAG or end>
@@ -1832,10 +1832,10 @@
 				       byte-save-restriction))
 		    (< 0 (cdr lap1)))
 	       (if (zerop (setcdr lap1 (1- (cdr lap1))))
-		   (delq lap1 rest))
+		   (delete* lap1 rest))
 	       (if (eq (car lap0) 'byte-varbind)
 		   (setcar rest (cons 'byte-discard 0))
-		 (setq lap (delq lap0 lap)))
+		 (setq lap (delete* lap0 lap)))
 	       (byte-compile-log-lap "  %s %s\t-->\t%s %s"
 		 lap0 (cons (car lap1) (1+ (cdr lap1)))
 		 (if (eq (car lap0) 'byte-varbind)
@@ -1922,7 +1922,7 @@
 			  (setcdr tmp (cons (byte-compile-make-tag)
 					    (cdr tmp))))
 		      (setcdr lap1 (car (cdr tmp)))
-		      (setq lap (delq lap0 lap))))
+		      (setq lap (delete* lap0 lap))))
 	       (setq keep-going t))
 	      ;;
 	      ;; X: varref-Y    ...     varset-Y goto-X  -->
@@ -2058,7 +2058,7 @@
 				   (cons 'byte-unbind
 					 (+ (cdr lap0) (cdr lap1))))
 	     (setq keep-going t)
-	     (setq lap (delq lap0 lap))
+	     (setq lap (delete* lap0 lap))
 	     (setcdr lap1 (+ (cdr lap1) (cdr lap0))))
 	    )
       (setq rest (cdr rest)))
--- a/lisp/bytecomp.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/bytecomp.el	Tue May 01 16:17:42 2012 +0100
@@ -1488,7 +1488,7 @@
 		    (byte-compile-arglist-signature-string (cons min max))))

 	      (setq byte-compile-unresolved-functions
-		    (delq calls byte-compile-unresolved-functions)))))
+		    (delete* calls byte-compile-unresolved-functions)))))
       )))

 ;; If we have compiled any calls to functions which are not known to be
@@ -1503,7 +1503,7 @@
 	   (while rest
 	     (if (assq (car (car rest)) byte-compile-autoload-environment)
 		 (setq byte-compile-unresolved-functions
-		       (delq (car rest) byte-compile-unresolved-functions)))
+		       (delete* (car rest) byte-compile-unresolved-functions)))
 	     (setq rest (cdr rest)))))
      ;; Now warn.
      (if (cdr byte-compile-unresolved-functions)
@@ -2757,8 +2757,7 @@
 	  (let ((new-bindings
 		 (mapcar #'(lambda (x) (cons x byte-compile-arglist-bit))
 			 (and (memq 'free-vars byte-compile-warnings)
-			      (delq '&rest (delq '&optional
-						 (copy-sequence arglist)))))))
+			      (remove* '&rest (remove* '&optional arglist))))))
 	    (nconc new-bindings
 		   (cons 'new-scope byte-compile-bound-variables))))
 	 (body (cdr (cdr fun)))
@@ -2963,7 +2962,7 @@
 				     (cons (nth 1 (car body)) (cdr body))
 				   (cons tmp body))))
 		     (or (eq output-type 'file)
-			 (not (delq nil (mapcar 'consp (cdr (car body))))))))
+                         (notany #'consp (cdar body)))))
 	      (setq rest (cdr rest)))
 	    rest))
       (let ((byte-compile-vector (byte-compile-constants-vector)))
@@ -3814,7 +3813,7 @@
 	 (if (cdr (cdr form))
 	     (byte-compile-out 'byte-insertN (length (cdr form)))
 	   (byte-compile-out 'byte-insert 0)))
-	((memq t (mapcar 'consp (cdr (cdr form))))
+	((some #'consp (cddr form))
 	 (byte-compile-normal-call form))
 	;; We can split it; there is no function call after inserting 1st arg.
 	(t
@@ -4669,7 +4668,7 @@
   (let ((calls (assq new byte-compile-unresolved-functions)))
     (if calls
 	(setq byte-compile-unresolved-functions
-	      (delq calls byte-compile-unresolved-functions)))))
+	      (delete* calls byte-compile-unresolved-functions)))))

 ;;; tags
--- a/lisp/cl-macs.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/cl-macs.el	Tue May 01 16:17:42 2012 +0100
@@ -299,9 +299,9 @@
 	   ;; Clean the list
 	   (let ((p (last arg))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
 	   (if (setq junk (cadr (memq '&cl-defs arg)))
-	       (setq arg (delq '&cl-defs (delq junk arg))))
+	       (setq arg (delete* '&cl-defs (delete* junk arg))))
 	   (if (memq '&cl-quote arg)
-	       (setq arg (delq '&cl-quote arg)))
+	       (setq arg (delete* '&cl-quote arg)))
 	   (mapcar 'cl-upcase-arg arg)))
 	(t arg)))                         ; Maybe we are in initializer

@@ -346,13 +346,13 @@
     (setq args (if (listp args) (copy-list args) (list '&rest args)))
     (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
     (if (setq bind-defs (cadr (memq '&cl-defs args)))
-	(setq args (delq '&cl-defs (delq bind-defs args))
+	(setq args (delete* '&cl-defs (delete* bind-defs args))
 	      bind-defs (cadr bind-defs)))
     (if (setq bind-enquote (memq '&cl-quote args))
-	(setq args (delq '&cl-quote args)))
+	(setq args (delete* '&cl-quote args)))
     (if (memq '&whole args) (error "&whole not currently implemented"))
     (let* ((p (memq '&environment args)) (v (cadr p)))
-      (if p (setq args (nconc (delq (car p) (delq v args))
+      (if p (setq args (nconc (delete* (car p) (delete* v args))
                               `(&aux (,v byte-compile-macro-environment))))))
     (while (and args (symbolp (car args))
 		(not (memq (car args) '(nil &rest &body &key &aux)))
@@ -1916,7 +1916,7 @@
 	   (if (consp (car spec))
 	       (if (eq (cadar spec) 0)
 		   (setq byte-compile-warnings
-			 (delq (caar spec) byte-compile-warnings))
+			 (delete* (caar spec) byte-compile-warnings))
 		 (setq byte-compile-warnings
 		       (adjoin (caar spec) byte-compile-warnings)))))))
   nil)
@@ -2806,7 +2806,7 @@
 				     (caar include-descs) include))
 			  old-descs)
 		    (pop include-descs)))
-	  (setq descs (append old-descs (delq (assq 'cl-tag-slot descs) descs))
+	  (setq descs (append old-descs (delete* (assq 'cl-tag-slot descs) descs))
 		type (car inc-type)
 		named (assq 'cl-tag-slot descs))
 	  (if (cadr inc-type) (setq tag name named t))
@@ -2822,7 +2822,7 @@
 		(error "Illegal :type specifier: %s" type))
 	    (if named (setq tag name)))
 	(setq type 'vector named 'true)))
-    (or named (setq descs (delq (assq 'cl-tag-slot descs) descs)))
+    (or named (setq descs (delete* (assq 'cl-tag-slot descs) descs)))
     (push (list 'defvar tag-symbol) forms)
     (setq pred-form (and named
 			 (let ((pos (- (length descs)
@@ -2896,8 +2896,8 @@
 		(push (cons copier t) side-eff)))
     (if constructor
 	(push (list constructor
-		       (cons '&key (delq nil (copy-sequence slots))))
-		 constrs))
+                    (cons '&key (remove* nil slots)))
+              constrs))
     (while constrs
       (let* ((name (caar constrs))
 	     (args (cadr (pop constrs)))
@@ -2988,7 +2988,7 @@
 	   (cl-make-type-test val (apply (get (car type) 'cl-deftype-handler)
 					 (cdr type))))
 	  ((memq (car-safe type) '(integer float real number))
-	   (delq t (list 'and (cl-make-type-test val (car type))
+	   (delete* t (list 'and (cl-make-type-test val (car type))
 			 (if (memq (cadr type) '(* nil)) t
 			   (if (consp (cadr type)) (list '> val (caadr type))
 			     (list '>= val (cadr type))))
@@ -3086,7 +3086,7 @@
   (list 'eval-when '(compile load eval)
 	(cl-transform-function-property
 	 func 'cl-compiler-macro
-	 (cons (if (memq '&whole args) (delq '&whole args)
+	 (cons (if (memq '&whole args) (delete* '&whole args)
 		 (cons '--cl-whole-arg-- args)) body))
 	(list 'or (list 'get (list 'quote func) '(quote byte-compile))
 	      (list 'put (list 'quote func) '(quote byte-compile)
@@ -3519,7 +3519,7 @@
 		(cl-seq begin))
 	  (while cl-seq
 	    (setq cl-seq (setcdr cl-seq
-				 (delq (car cl-seq) (cdr cl-seq)))))
+				 (delete* (car cl-seq) (cdr cl-seq)))))
 	  begin))
        ((or (plists-equal cl-keys '(:test 'equal) t)
 	    (plists-equal cl-keys '(:test #'equal) t))
--- a/lisp/cus-edit.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/cus-edit.el	Tue May 01 16:17:42 2012 +0100
@@ -2964,7 +2964,7 @@
 (defun widget-face-value-delete (widget)
   ;; Remove the child from the options.
   (let ((child (car (widget-get widget :children))))
-    (setq custom-options (delq child custom-options))
+    (setq custom-options (delete* child custom-options))
     (widget-children-value-delete widget)))

 (defvar face-history nil
--- a/lisp/easymenu.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/easymenu.el	Tue May 01 16:17:42 2012 +0100
@@ -223,7 +223,7 @@
   (when (featurep 'menubar)
     (setq
      ;; Remove this menu from the list of popups we know about.
-     easy-menu-all-popups (delq menu easy-menu-all-popups)
+     easy-menu-all-popups (delete* menu easy-menu-all-popups)
      ;; If there are multiple popup menus available, make the popup menu
      ;; normally shown with button-3 a menu of them. If there is just one,
      ;; make that button show it, and no super-menu.
--- a/lisp/files.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/files.el	Tue May 01 16:17:42 2012 +0100
@@ -2838,7 +2838,7 @@
   (let ((localval (copy-list (symbol-value hook)))
 	(globalval (copy-list (default-value hook))))
     (if (memq t localval)
-	(setq localval (append (delq t localval) (delq t globalval))))
+	(setq localval (append (delete* t localval) (delete* t globalval))))
     localval))

 (defun basic-save-buffer ()
@@ -4065,13 +4065,9 @@
 		(file-directory-p (directory-file-name (car dirs))))
 	(let ((this-dir-contents
 	       ;; Filter out "." and ".."
-	       (delq nil
-		     (mapcar #'(lambda (name)
-				 (unless (string-match "\\`\\.\\.?\\'"
-						       (file-name-nondirectory name))
-				   name))
-			     (directory-files (or (car dirs) ".") full
-					      (wildcard-to-regexp nondir))))))
+               (nset-difference (directory-files (or (car dirs) ".") full
+                                                 (wildcard-to-regexp nondir))
+                                '("." "..") :test #'equal)))
 	  (setq contents
 		(nconc
 		 (if (and (car dirs) (not full))
--- a/lisp/font-lock.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/font-lock.el	Tue May 01 16:17:42 2012 +0100
@@ -987,14 +987,14 @@
 	    ;; A new set of keywords is defined.  Forget all about
 	    ;; our old keywords that should be removed.
 	    (setq font-lock-removed-keywords-alist
-		  (delq cell font-lock-removed-keywords-alist))
+		  (delete* cell font-lock-removed-keywords-alist))
 	  ;; Delete all previously removed keywords.
 	  (dolist (kword keywords)
 	    (setcdr cell (delete kword (cdr cell))))
 	  ;; Delete the mode cell if empty.
 	  (if (null (cdr cell))
 	      (setq font-lock-removed-keywords-alist
-		    (delq cell font-lock-removed-keywords-alist)))))))
+		    (delete* cell font-lock-removed-keywords-alist)))))))

 ;; Written by Anders Lindgren <andersl@andersl.com>.
 ;;
@@ -1053,7 +1053,7 @@
 	       ;; was deleted.
 	       (if (null (cdr top-cell))
 		   (setq font-lock-keywords-alist
-			 (delq top-cell font-lock-keywords-alist))))
+			 (delete* top-cell font-lock-keywords-alist))))
 	     ;; Remember the keyword in case it is not local.
 	     (let ((cell (assq mode font-lock-removed-keywords-alist)))
 	       (if cell
--- a/lisp/frame.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/frame.el	Tue May 01 16:17:42 2012 +0100
@@ -218,7 +218,7 @@
 	;; frame, then we need to create the opening frame.  Make sure
 	;; it has a minibuffer, but let initial-frame-plist omit the
 	;; minibuffer spec.
-	(or (delq terminal-frame (minibuffer-frame-list))
+	(or (delete* terminal-frame (minibuffer-frame-list))
 	    (progn
 	      (setq frame-initial-frame-plist
 		    (append initial-frame-plist default-frame-plist))
@@ -230,8 +230,8 @@
 	      (setq default-minibuffer-frame
 		    (setq frame-initial-frame
 			  (make-frame initial-frame-plist
-				      (car (delq terminal-device
-						 (device-list))))))
+				      (car (delete* terminal-device
+                                                    (device-list))))))
 	      ;; Delete any specifications for window geometry properties
 	      ;; so that we won't reapply them in frame-notice-user-settings.
 	      ;; It would be wrong to reapply them then,
@@ -465,7 +465,7 @@
 	      ;; The initial frame, which we are about to delete, may be
 	      ;; the only frame with a minibuffer.  If it is, create a
 	      ;; new one.
-	      (or (delq frame-initial-frame (minibuffer-frame-list))
+	      (or (delete* frame-initial-frame (minibuffer-frame-list))
 		  (make-initial-minibuffer-frame nil))

 	      ;; If the initial frame is serving as a surrogate
@@ -991,7 +991,7 @@
 	 (face-list-to-change (face-list)))
     (when (eq (device-type) 'mswindows)
       (setq face-list-to-change
-	    (delq 'border-glyph face-list-to-change)))
+	    (delete* 'border-glyph face-list-to-change)))
     ;; FIXME: Is it sufficient to just change the default face, due to
     ;; face inheritance?
     (dolist (face face-list-to-change)
@@ -1325,7 +1325,7 @@
   (unless frame
     (setq frame (selected-frame)))
   (let* ((mini-frame (window-frame (minibuffer-window frame)))
-	 (frames (delq mini-frame (delq frame (frame-list)))))
+	 (frames (delete* mini-frame (delete* frame (frame-list)))))
     (mapc 'delete-frame frames)))

 ;; XEmacs change: we still use delete-frame-hook
@@ -1699,7 +1699,7 @@
 	;; but the selected frame should come first, even if it's occluded,
 	;; to minimize thrashing.
 	(setq frames (cons (selected-frame)
-			   (delq (selected-frame) frames)))
+			   (delete* (selected-frame) frames)))

 	(setq name (symbol-name name))
 	(while frames
@@ -1760,7 +1760,7 @@
 			      (t))))))
 	;; put the selected frame last.  The user wants a new frame,
 	;; so don't reuse the existing one unless forced to.
-	(setq frames (append (delq (selected-frame) frames) (list frames)))
+	(setq frames (append (delete* (selected-frame) frames) (list frames)))
 	(if (or (eq limit 0) ; means create with reckless abandon
 		(< (length frames) limit))
 	    (get-frame-for-buffer-make-new-frame buffer)
--- a/lisp/gnuserv.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/gnuserv.el	Tue May 01 16:17:42 2012 +0100
@@ -551,7 +551,7 @@
 editing has ended."
   (let* ((buf (current-buffer)))
     (dolist (client (gnuserv-buffer-clients buf))
-      (callf2 delq buf (gnuclient-buffers client))
+      (callf2 delete* buf (gnuclient-buffers client))
       ;; If no more buffers, kill the client.
       (when (null (gnuclient-buffers client))
 	(gnuserv-kill-client client)))))
@@ -588,7 +588,7 @@
 	;; killing the device, because it would cause a device-dead
 	;; error when `delete-device' tries to do the job later.
 	(gnuserv-kill-client client t))))
-  (callf2 delq device gnuserv-devices))
+  (callf2 delete* device gnuserv-devices))

 (add-hook 'delete-device-hook 'gnuserv-check-device)

@@ -608,7 +608,7 @@
 the function will not remove the frames associated with the client."
   ;; Order is important: first delete client from gnuserv-clients, to
   ;; prevent gnuserv-buffer-done-1 calling us recursively.
-  (callf2 delq client gnuserv-clients)
+  (callf2 delete* client gnuserv-clients)
   ;; Process the buffers.
   (mapc 'gnuserv-buffer-done-1 (gnuclient-buffers client))
   (unless leave-frame
@@ -636,7 +636,7 @@
 ;; Do away with the buffer.
 (defun gnuserv-buffer-done-1 (buffer)
   (dolist (client (gnuserv-buffer-clients buffer))
-    (callf2 delq buffer (gnuclient-buffers client))
+    (callf2 delete* buffer (gnuclient-buffers client))
     (when (null (gnuclient-buffers client))
       (gnuserv-kill-client client)))
   ;; Get rid of the buffer.
--- a/lisp/gtk-font-menu.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/gtk-font-menu.el	Tue May 01 16:17:42 2012 +0100
@@ -146,7 +146,7 @@
 	       done)
 	     (setq sizes (cons (car common) sizes)))
 	    (setq common (cdr common)))
-	  (setq sizes (delq 0 sizes))))
+	  (setq sizes (delete* 0 sizes))))

     (setq families (sort families 'string-lessp)
 	  weights  (sort weights 'string-lessp)
--- a/lisp/gutter-items.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/gutter-items.el	Tue May 01 16:17:42 2012 +0100
@@ -270,10 +270,10 @@
 		 (not in-deletion)
 		 (not (eq first-buf (window-buffer (selected-window frame)))))
 	(setq buffers (cons (window-buffer (selected-window frame))
-			    (delq first-buf buffers))))
+			    (delete* first-buf buffers))))
       ;; if we're in deletion ignore the current buffer
       (when in-deletion
-	(setq buffers (delq (current-buffer) buffers))
+	(setq buffers (delete* (current-buffer) buffers))
 	(setq first-buf (car buffers)))
       ;; filter buffers
       (when buffers-tab-filter-functions
--- a/lisp/gutter.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/gutter.el	Tue May 01 16:17:42 2012 +0100
@@ -91,7 +91,7 @@
 				      (if visible-p
 					  (if (memq prop spec) spec
 					    (cons prop spec))
-					(delq prop spec))
+					(delete* prop spec))
 				    (if visible-p (list prop))))
    (list prop visible-p)
    'force nil locale tag-set)
--- a/lisp/info.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/info.el	Tue May 01 16:17:42 2012 +0100
@@ -798,7 +798,7 @@
 		  (if (re-search-backward regexp beg t)
 		      (throw 'foo t))))
 	      (setq found nil)
-	      (let ((bufs (delq nil (mapcar 'get-file-buffer
+	      (let ((bufs (delete* nil (mapcar 'get-file-buffer
 					    Info-annotations-path)))
 		    (pattern (if (string-match "\\`<<.*>>\\'" qnode) qnode
 			       (format "\"%s\"\\|<<%s>>" qnode qnode)))
@@ -1384,7 +1384,7 @@
       (let* ((name (format "(%s)%s" (Info-file-name-only file) node))
 	     (found (assoc name Info-history)))
 	(if found
-	    (setq Info-history (delq found Info-history)))
+	    (setq Info-history (delete* found Info-history)))
 	(setq Info-history (cons (list name (- point (point-min))
 				       (and (eq (window-buffer)
 						(current-buffer))
@@ -1702,7 +1702,7 @@
 (defun Info-build-annotation-completions ()
   (or Info-current-annotation-completions
       (save-excursion
-	(let ((bufs (delq nil (mapcar 'get-file-buffer
+	(let ((bufs (delete* nil (mapcar 'get-file-buffer
 				      Info-annotations-path)))
 	      (compl nil))
 	  (while bufs
@@ -2360,7 +2360,7 @@
     ;; Here it is a feature that assoc is case-sensitive.
     (while (setq found (assoc topic matches))
       (setq exact (cons found exact)
-	    matches (delq found matches)))
+	    matches (delete* found matches)))
   (setq Info-index-alternatives (nconc exact matches)
 	Info-index-first-alternative (car Info-index-alternatives))
   (Info-index-next 0)))
@@ -2528,7 +2528,7 @@


 (defun Info-reannotate-node ()
-  (let ((bufs (delq nil (mapcar 'get-file-buffer Info-annotations-path))))
+  (let ((bufs (delete* nil (mapcar 'get-file-buffer Info-annotations-path))))
     (if bufs
 	(let ((ibuf (current-buffer))
 	      (file (concat "\\(" (regexp-quote
--- a/lisp/itimer.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/itimer.el	Tue May 01 16:17:42 2012 +0100
@@ -316,7 +316,7 @@
 (defun delete-itimer (itimer)
   "Deletes ITIMER.  ITIMER may be an itimer or the name of one."
   (check-itimer-coerce-string itimer)
-  (setq itimer-list (delq itimer itimer-list)))
+  (setq itimer-list (delete* itimer itimer-list)))

 (defun start-itimer (name function value &optional restart
 		     is-idle with-args &rest function-arguments)
--- a/lisp/lib-complete.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/lib-complete.el	Tue May 01 16:17:42 2012 +0100
@@ -180,7 +180,7 @@
 	 (new-cache-records (list (list root modtimes table))))
     (if (not cache-entry) nil
       ;; Remove old cache entry
-      (setq lib-complete:cache (delq cache-entry lib-complete:cache))
+      (setq lib-complete:cache (delete* cache-entry lib-complete:cache))
       ;; Copy non-redundant entries from old cache entry
       (while cache-records
 	(if (or (equal root (nth 0 (car cache-records)))
--- a/lisp/loadhist.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/loadhist.el	Tue May 01 16:17:42 2012 +0100
@@ -185,7 +185,7 @@
                  ((consp x)
                   ;; Remove any feature names that this file provided.
                   (if (eq (car x) 'provide)
-                      (setq features (delq (cdr x) features))
+                      (setq features (delete* (cdr x) features))
                     (if (eq (car x) 'module)
                         (setq unloading-module t))))
                  ((and (boundp x)
@@ -201,7 +201,7 @@
        (cdr flist)))
     ;; Delete the load-history element for this file.
     (let ((elt (assoc file load-history)))
-      (setq load-history (delq elt load-history)))
+      (setq load-history (delete* elt load-history)))
     ;; If it is a module, really unload it.
     (if unloading-module
 	(declare-fboundp (unload-module (symbol-name feature))))))
--- a/lisp/menubar-items.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/menubar-items.el	Tue May 01 16:17:42 2012 +0100
@@ -1806,7 +1806,7 @@
 		       (funcall fn buffer)
 		     (funcall fn buffer n))))
 	   (if complex-buffers-menu-p
-	       (delq nil
+	       (delete* nil
 		     (list line
 			   (vector "S%_witch to Buffer"
 				   (list buffers-menu-switch-to-buffer-function
--- a/lisp/menubar.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/menubar.el	Tue May 01 16:17:42 2012 +0100
@@ -352,8 +352,8 @@
       ;; the menubar is the only special case, because other menus begin
       ;; with their name.
       (if (eq parent current-menubar)
-	  (setq current-menubar (delq item parent))
-	(delq item parent))
+	  (setq current-menubar (delete* item parent))
+	(delete* item parent))
       (set-menubar-dirty-flag)
       item)))
--- a/lisp/msw-font-menu.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/msw-font-menu.el	Tue May 01 16:17:42 2012 +0100
@@ -118,7 +118,7 @@
 		 done)
 	       (setq sizes (cons (car common) sizes)))
 	      (setq common (cdr common)))
-	    (setq sizes (delq 0 sizes))))
+	    (setq sizes (delete* 0 sizes))))

       (setq families (sort families 'string-lessp)
 	    weights  (sort weights 'string-lessp)
--- a/lisp/mule/make-coding-system.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/mule/make-coding-system.el	Tue May 01 16:17:42 2012 +0100
@@ -90,7 +90,7 @@

     (loop for char across decode-table
       do (pushnew (char-charset char) known-charsets))
-    (setq known-charsets (delq 'ascii known-charsets))
+    (setq known-charsets (delete* 'ascii known-charsets))

     (loop for known-charset in known-charsets
       do
--- a/lisp/next-error.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/next-error.el	Tue May 01 16:17:42 2012 +0100
@@ -137,14 +137,14 @@
   (or
    ;; 1. If one window on the selected frame displays such buffer, return it.
    (let ((window-buffers
-          (delete-dups
-           (delq nil (mapcar (lambda (w)
-                               (if (next-error-buffer-p
-				    (window-buffer w)
-                                    avoid-current
-                                    extra-test-inclusive extra-test-exclusive)
-                                   (window-buffer w)))
-                             (window-list))))))
+          (delete-duplicates
+           (mapcan #'(lambda (w)
+                       (if (next-error-buffer-p
+                            (window-buffer w)
+                            avoid-current
+                            extra-test-inclusive extra-test-exclusive)
+                           (list (window-buffer w))))
+                   (window-list)))))
      (if (eq (length window-buffers) 1)
          (car window-buffers)))
    ;; 2. If next-error-last-buffer is an acceptable buffer, use that.
--- a/lisp/obsolete.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/obsolete.el	Tue May 01 16:17:42 2012 +0100
@@ -410,7 +410,8 @@
   "Return a list of charsets in the STRING except ascii.
 It might be available for compatibility with Mule 2.3,
 because its `find-charset-string' ignores ASCII charset."
-  (delq 'ascii (and-fboundp 'charsets-in-string (charsets-in-string string))))
+  (delete* 'ascii
+           (and-fboundp 'charsets-in-string (charsets-in-string string))))
 (make-obsolete 'find-non-ascii-charset-string
 	       "use (delq 'ascii (charsets-in-string STRING)) instead.")

@@ -418,8 +419,8 @@
   "Return a list of charsets except ascii in the region between START and END.
 It might be available for compatibility with Mule 2.3,
 because its `find-charset-string' ignores ASCII charset."
-  (delq 'ascii (and-fboundp 'charsets-in-region
-                 (charsets-in-region start end))))
+  (delete* 'ascii (and-fboundp 'charsets-in-region
+                    (charsets-in-region start end))))
 (make-obsolete 'find-non-ascii-charset-region
 	       "use (delq 'ascii (charsets-in-region START END)) instead.")
--- a/lisp/occur.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/occur.el	Tue May 01 16:17:42 2012 +0100
@@ -365,24 +365,21 @@
     (occur-read-primary-args)))
   (when bufregexp
     (occur-1 regexp nlines
-	     (delq nil
-		   (mapcar (lambda (buf)
-			     (when (and (buffer-file-name buf)
-					(string-match bufregexp
-						      (buffer-file-name buf)))
-			       buf))
-			   (buffer-list))))))
+             (mapcan #'(lambda (buf)
+                         (when (and (buffer-file-name buf)
+                                    (string-match bufregexp
+                                                  (buffer-file-name buf)))
+                           (list buf)))
+                     (buffer-list)))))

 (defun occur-1 (regexp nlines bufs &optional buf-name)
   (unless buf-name
     (setq buf-name "*Occur*"))
   (let (occur-buf
-	(active-bufs (delq nil (mapcar #'(lambda (buf)
-					   (when (buffer-live-p buf) buf))
-				       bufs))))
+	(active-bufs (remove-if-not #'buffer-live-p bufs)))
     ;; Handle the case where one of the buffers we're searching is the
     ;; output buffer.  Just rename it.
-    (when (member buf-name (mapcar 'buffer-name active-bufs))
+    (when (position buf-name active-bufs :test #'equal :key #'buffer-name)
       (with-current-buffer (get-buffer buf-name)
 	(rename-uniquely)))
--- a/lisp/packages.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/packages.el	Tue May 01 16:17:42 2012 +0100
@@ -85,12 +85,11 @@
   "Load path for packages last in the load path.")

 (defun packages-package-hierarchy-directory-names ()
-  "Returns a list package hierarchy directory names.
+  "Returns a list of package hierarchy directory names.
 These are the valid immediate directory names of package
 directories, directories with higher priority first"
-  (delq nil `("site-packages"
-              ,(when (featurep 'mule) "mule-packages")
-              "xemacs-packages")))
+  `("site-packages" ,@(when (featurep 'mule) '("mule-packages"))
+    "xemacs-packages"))

 (defun package-get-key-1 (info key)
   "Locate keyword `key' in list."
--- a/lisp/process.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/process.el	Tue May 01 16:17:42 2012 +0100
@@ -707,7 +707,8 @@
 	(cond ((string-match pattern (car scan))
 	       (setq found t)
 	       (if (eq nil value)
-		   (setq process-environment (delq (car scan) process-environment))
+		   (setq process-environment
+                         (delete* (car scan) process-environment))
 		 (setcar scan (concat variable "=" value)))
 	       (setq scan nil)))
 	(setq scan (cdr scan)))
--- a/lisp/simple.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/simple.el	Tue May 01 16:17:42 2012 +0100
@@ -958,7 +958,7 @@
 	(if (fixnump (car tail))
 	    (progn
 	      (setq done t)
-	      (setq buffer-undo-list (delq (car tail) buffer-undo-list))))
+	      (setq buffer-undo-list (delete* (car tail) buffer-undo-list))))
 	(setq tail (cdr tail))))
     (and modified (not (buffer-modified-p))
 	 (delete-auto-save-file-if-necessary recent-save)))
@@ -2100,7 +2100,7 @@
          (loop
            for keysym in motion-keys-for-shifted-motion
            with key = (event-key last-input-event)
-           with mods = (delq 'shift (event-modifiers last-input-event))
+           with mods = (delete* 'shift (event-modifiers last-input-event))
            with char-list = '(?a) ;; Some random character; the list will be
 				  ;; modified in the constants vector over
 				  ;; time.
--- a/lisp/sound.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/sound.el	Tue May 01 16:17:42 2012 +0100
@@ -174,8 +174,7 @@
 	  (erase-buffer))
       (and buf (kill-buffer buf)))
     (let ((old (assq sound-name sound-alist)))
-      ;; some conses in sound-alist might have been dumped with emacs.
-      (if old (setq sound-alist (delq old (copy-sequence sound-alist)))))
+      (if old (setq sound-alist (remove* old sound-alist))))
     (setq sound-alist (cons
 		       (nconc (list sound-name)
 			      (if (and volume (not (eq 0 volume)))
--- a/lisp/wid-edit.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/wid-edit.el	Tue May 01 16:17:42 2012 +0100
@@ -2332,7 +2332,7 @@

 (defun widget-field-value-delete (widget)
   "Remove the widget from the list of active editing fields."
-  (setq widget-field-list (delq widget widget-field-list))
+  (setq widget-field-list (delete* widget widget-field-list))
   ;; These are nil if the :format string doesn't contain `%v'.
   (let ((extent (widget-get widget :field-extent)))
     (when extent
@@ -2676,7 +2676,7 @@
 	       (let ((vals (widget-match-inline answer values)))
 		 (setq found (append found (car vals))
 		       values (cdr vals)
-		       args (delq answer args))))
+		       args (delete* answer args))))
 	      (greedy
 	       (setq rest (append rest (list (car values)))
 		     values (cdr values)))
@@ -2697,7 +2697,7 @@
 	       (let ((match (widget-match-inline answer vals)))
 		 (setq found (cons (cons answer (car match)) found)
 		       vals (cdr match)
-		       args (delq answer args))))
+		       args (delete* answer args))))
 	      (greedy
 	       (setq vals (cdr vals)))
 	      (t
@@ -3091,7 +3091,7 @@
 	      buttons (cdr buttons))
 	(when (eq (widget-get button :widget) child)
 	  (widget-put widget
-		      :buttons (delq button (widget-get widget :buttons)))
+		      :buttons (delete* button (widget-get widget :buttons)))
 	  (widget-delete button))))
     (let ((entry-from (widget-get child :entry-from))
 	  (entry-to (widget-get child :entry-to))
@@ -3102,7 +3102,7 @@
       (delete-region entry-from entry-to)
       (set-marker entry-from nil)
       (set-marker entry-to nil))
-    (widget-put widget :children (delq child (widget-get widget :children))))
+    (widget-put widget :children (delete* child (widget-get widget :children))))
   (widget-setup)
   (widget-apply widget :notify widget))
--- a/lisp/window.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/window.el	Tue May 01 16:17:42 2012 +0100
@@ -580,7 +580,7 @@
     ;; Get rid of the frame, if it has just one dedicated window
     ;; and other visible frames exist.
     (and (or (window-minibuffer-p) (window-dedicated-p window))
-	 (delq frame (visible-frame-list))
+	 (delete* frame (visible-frame-list))
 	 window-solitary
 	 (if (and (eq default-minibuffer-frame frame)
 		  (eql 1 (length (minibuffer-frame-list))))
--- a/lisp/x-font-menu.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/x-font-menu.el	Tue May 01 16:17:42 2012 +0100
@@ -233,7 +233,7 @@
 	       done)
 	     (setq sizes (cons (car common) sizes)))
 	    (setq common (cdr common)))
-	  (setq sizes (delq 0 sizes))))
+	  (setq sizes (delete* 0 sizes))))

     (setq families (sort families 'string-lessp)
 	  weights  (sort weights 'string-lessp)