changeset 5367:8b70d37ab80e

Use Common Lisp-derived builtins in a few more places in core Lisp. 2011-03-08 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el: * cl-macs.el (loop): * cl-macs.el (cl-expand-do-loop): * cl-macs.el (shiftf): * cl-macs.el (rotatef): * cl-macs.el (assert): * cl-macs.el (cl-defsubst-expand): * etags.el (buffer-tag-table-list): * frame.el: * frame.el (frame-notice-user-settings): * frame.el (minibuffer-frame-list): * frame.el (get-frame-for-buffer-noselect): Use Common Lisp-derived builtins in a few more places, none of them performance-critical, but the style is better.
author Aidan Kehoe <kehoea@parhasard.net>
date Tue, 08 Mar 2011 23:57:21 +0000
parents f00192e1cd49
children ed74d2ca7082
files lisp/ChangeLog lisp/cl-macs.el lisp/etags.el lisp/frame.el
diffstat 4 files changed, 50 insertions(+), 43 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Tue Mar 08 23:41:52 2011 +0000
+++ b/lisp/ChangeLog	Tue Mar 08 23:57:21 2011 +0000
@@ -1,3 +1,20 @@
+2011-03-08  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-macs.el:
+	* cl-macs.el (loop):
+	* cl-macs.el (cl-expand-do-loop):
+	* cl-macs.el (shiftf):
+	* cl-macs.el (rotatef):
+	* cl-macs.el (assert):
+	* cl-macs.el (cl-defsubst-expand):
+	* etags.el (buffer-tag-table-list):
+	* frame.el:
+	* frame.el (frame-notice-user-settings):
+	* frame.el (minibuffer-frame-list):
+	* frame.el (get-frame-for-buffer-noselect):
+	Use Common Lisp-derived builtins in a few more places, none of
+	them performance-critical, but the style is better.
+
 2011-03-08  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* buff-menu.el (list-buffers-noselect):
--- a/lisp/cl-macs.el	Tue Mar 08 23:41:52 2011 +0000
+++ b/lisp/cl-macs.el	Tue Mar 08 23:57:21 2011 +0000
@@ -1066,7 +1066,7 @@
     Specify the name for block surrounding the loop, in place of nil.
     (See `block'.)
 "
-  (if (not (memq t (mapcar 'symbolp (delq nil (delq t (copy-list clauses))))))
+  (if (notany #'symbolp (set-difference clauses '(nil t)))
       (list 'block nil (list* 'while t clauses))
     (let ((loop-name nil)	(loop-bindings nil)
 	  (loop-body nil)	(loop-steps nil)
@@ -1648,12 +1648,12 @@
 		       steps)
 	       (list* 'while (list 'not (car endtest))
 		      (append body
-			      (let ((sets (mapcar
+			      (let ((sets (mapcan
 					   #'(lambda (c)
 					       (and (consp c) (cdr (cdr c))
-						    (list (car c) (nth 2 c))))
+						    (list
+						     (list (car c) (nth 2 c)))))
 					   steps)))
-				(setq sets (delq nil sets))
 				(and sets
 				     (list (cons (if (or star (not (cdr sets)))
 						     'setq 'psetq)
@@ -2579,7 +2579,7 @@
 Example: (shiftf A B C) sets A to B, B to C, and returns the old A.
 Each PLACE may be a symbol, or any generalized variable allowed by `setf'."
   ;; XEmacs change: use iteration instead of recursion
-  (if (not (memq nil (mapcar 'symbolp (butlast (cons place args)))))
+  (if (every #'symbolp (butlast (cons place args)))
       (list* 'prog1 place
 	     (let ((sets nil))
 	       (while args
@@ -2600,7 +2600,7 @@
   "Rotate left among PLACES.
 Example: (rotatef A B C) sets A to B, B to C, and C to A.  It returns nil.
 Each PLACE may be a symbol, or any generalized variable allowed by `setf'."
-  (if (not (memq nil (mapcar 'symbolp places)))
+  (if (every #'symbolp places)
       (and (cdr places)
 	   (let ((sets nil)
 		 (first (car places)))
@@ -3127,11 +3127,7 @@
 omitted, a default message listing FORM itself is used."
   (and (or (not (cl-compiling-file))
 	   (< cl-optimize-speed 3) (= cl-optimize-safety 3))
-       (let ((sargs (and show-args (delq nil (mapcar
-					       #'(lambda (x)
-						   (and (not (cl-const-expr-p x))
-							x))
-					       (cdr form))))))
+       (let ((sargs (and show-args (remove-if #'cl-const-expr-p (cdr form)))))
 	 (list 'progn
 	       (list 'or form
 		     (if string
@@ -3226,13 +3222,12 @@
 (defun cl-defsubst-expand (argns body simple whole unsafe &rest argvs)
   (if (and whole (not (cl-safe-expr-p (cons 'progn argvs)))) whole
     (if (cl-simple-exprs-p argvs) (setq simple t))
-    (let ((lets (delq nil
-		      (mapcar* #'(lambda (argn argv)
-				   (if (or simple (cl-const-expr-p argv))
-				       (progn (setq body (subst argv argn body))
-					      (and unsafe (list argn argv)))
-				     (list argn argv)))
-			       argns argvs))))
+    (let ((lets (mapcan #'(lambda (argn argv)
+			    (if (or simple (cl-const-expr-p argv))
+				(progn (setq body (subst argv argn body))
+				       (and unsafe (list (list argn argv))))
+			      (list (list argn argv))))
+			argns argvs)))
       (if lets (list 'let lets body) body))))
 
 
--- a/lisp/etags.el	Tue Mar 08 23:41:52 2011 +0000
+++ b/lisp/etags.el	Tue Mar 08 23:57:21 2011 +0000
@@ -243,16 +243,15 @@
 	      (push expression result)
 	    (error "Expression in tag-table-alist evaluated to non-string")))))
     (setq result
-	  (mapcar
+	  (mapcan
 	   (lambda (name)
 	     (when (file-directory-p name)
 	       (setq name (concat (file-name-as-directory name) "TAGS")))
 	     (and (file-readable-p name)
 		  ;; get-tag-table-buffer has side-effects
-		  (symbol-value-in-buffer 'buffer-file-name
-					  (get-tag-table-buffer name))))
-	   result))
-    (setq result (delq nil result))
+		  (list (symbol-value-in-buffer 'buffer-file-name
+						(get-tag-table-buffer name))))))
+	   result)
     ;; If no TAGS file has been found, ask the user explicitly.
     ;; #### tags-file-name is *evil*.
     (or result tags-file-name
--- a/lisp/frame.el	Tue Mar 08 23:41:52 2011 +0000
+++ b/lisp/frame.el	Tue Mar 08 23:57:21 2011 +0000
@@ -475,12 +475,13 @@
 	      ;; onto a new frame.  The default-minibuffer-frame
 	      ;; variable must be handled similarly.
 	      (let ((users-of-initial
-		     (filtered-frame-list
+		     (remove-if-not
 		      #'(lambda (frame)
 				  (and (not (eq frame frame-initial-frame))
 				       (eq (window-frame
 					    (minibuffer-window frame))
-					   frame-initial-frame))))))
+					   frame-initial-frame)))
+                      (frame-list))))
 		(if (or users-of-initial
 			(eq default-minibuffer-frame frame-initial-frame))
 
@@ -488,10 +489,11 @@
 		    ;; are only minibuffers.
 		    (let* ((new-surrogate
 			    (car
-			     (or (filtered-frame-list
+			     (or (remove-if-not
 				  #'(lambda (frame)
 				      (eq 'only
-					  (frame-property frame 'minibuffer))))
+					  (frame-property frame 'minibuffer)))
+                                  (frame-list))
 				 (minibuffer-frame-list))))
 			   (new-minibuffer (minibuffer-window new-surrogate)))
 
@@ -674,29 +676,22 @@
 ;; XEmacs change: Emacs has make-frame here.  We have it in C, so no need for
 ;; frame-creation-function.
 
-;; XEmacs addition: support optional DEVICE argument.
+;; XEmacs addition: support optional DEVICE argument, use delete-if-not.
 (defun filtered-frame-list (predicate &optional device)
   "Return a list of all live frames which satisfy PREDICATE.
 If optional second arg DEVICE is non-nil, restrict the frames
  returned to that device."
-  (let ((frames (if device (device-frame-list device)
-		  (frame-list)))
-	good-frames)
-    (while (consp frames)
-      (if (funcall predicate (car frames))
-	  (setq good-frames (cons (car frames) good-frames)))
-      (setq frames (cdr frames)))
-    good-frames))
+  (delete-if-not predicate
+                 (if device (device-frame-list device) (frame-list))))
 
 ;; XEmacs addition: support optional DEVICE argument.
 (defun minibuffer-frame-list (&optional device)
   "Return a list of all frames with their own minibuffers.
 If optional second arg DEVICE is non-nil, restrict the frames
  returned to that device."
-  (filtered-frame-list
-   #'(lambda (frame)
-	       (eq frame (window-frame (minibuffer-window frame))))
-   device))
+  (delete-if-not 
+   #'(lambda (frame) (eq frame (window-frame (minibuffer-window frame))))
+   (if device (device-frame-list device) (frame-list))))
 
 ;; XEmacs omission: Emacs has frames-on-display-list here, but that is
 ;; essentially equivalent to supplying the optional DEVICE argument to
@@ -1745,9 +1740,10 @@
 	       (or (plist-get default-frame-plist 'name)
 		   default-frame-name))
 	     (frames
-	      (sort (filtered-frame-list #'(lambda (x)
-					     (or (frame-visible-p x)
-						 (frame-iconified-p x))))
+	      (sort (remove-if-not #'(lambda (x)
+                                       (or (frame-visible-p x)
+                                           (frame-iconified-p x)))
+                                   (frame-list))
 		    #'(lambda (s1 s2)
 			(cond ((and (frame-visible-p s1)
 				    (not (frame-visible-p s2))))