changeset: 5426:8b70d37ab80e user: Aidan Kehoe <kehoea(a)parhasard.net&gt; 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&gt; * 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&gt; + + * 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&gt; * 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