# HG changeset patch # User Aidan Kehoe # Date 1335885462 -3600 # Node ID cc6f0266bc367884f3d0d8cda3f82528935743ef # Parent ae2fdb1fd9e0d4b5152eabf54d239866f60d55e6 Avoid #'delq in core Lisp, for the sake of style, a very slightly smaller binary lisp/ChangeLog addition: 2012-05-01 Aidan Kehoe 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). diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/ChangeLog --- 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 + + 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 * byte-optimize.el (byte-optimize-form-code-walker): diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/behavior.el --- 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. diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/buff-menu.el --- 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 diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/byte-optimize.el --- 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" 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 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 "")) ((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" 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: --> @@ -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 @@ -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))) diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/bytecomp.el --- 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 diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/cl-macs.el --- 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)) diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/cus-edit.el --- 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 diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/easymenu.el --- 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. diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/files.el --- 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)) diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/font-lock.el --- 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 . ;; @@ -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 diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/frame.el --- 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) diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/gnuserv.el --- 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. diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/gtk-font-menu.el --- 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) diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/gutter-items.el --- 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 diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/gutter.el --- 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) diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/info.el --- 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 diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/itimer.el --- 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) diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/lib-complete.el --- 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))) diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/loadhist.el --- 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)))))) diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/menubar-items.el --- 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 diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/menubar.el --- 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))) diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/msw-font-menu.el --- 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) diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/mule/make-coding-system.el --- 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 diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/next-error.el --- 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. diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/obsolete.el --- 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.") diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/occur.el --- 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))) diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/packages.el --- 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." diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/process.el --- 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))) diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/simple.el --- 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. diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/sound.el --- 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))) diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/wid-edit.el --- 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)) diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/window.el --- 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)))) diff -r ae2fdb1fd9e0 -r cc6f0266bc36 lisp/x-font-menu.el --- 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)