11:57 p.m.
changeset: 5367:8b70d37ab80e
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Tue Mar 08 23:57:21 2011 +0000
files: lisp/ChangeLog lisp/cl-macs.el lisp/etags.el lisp/frame.el
description:
Use Common Lisp-derived builtins in a few more places in core Lisp.
2011-03-08 Aidan Kehoe <kehoea(a)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.
diff -r f00192e1cd49 -r 8b70d37ab80e lisp/ChangeLog
--- 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(a)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(a)parhasard.net>
* buff-menu.el (list-buffers-noselect):
diff -r f00192e1cd49 -r 8b70d37ab80e lisp/cl-macs.el
--- 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))))
diff -r f00192e1cd49 -r 8b70d37ab80e lisp/etags.el
--- 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
diff -r f00192e1cd49 -r 8b70d37ab80e lisp/frame.el
--- 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))))
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches