mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-16 17:24:23 +00:00
Don't quote lambdas in emacs-lisp/*.el
* lisp/emacs-lisp/cl-seq.el (cl--parsing-keywords, cl-sort): * lisp/emacs-lisp/cl-macs.el (cl-typecase): * lisp/emacs-lisp/cl-extra.el (cl-some, cl-every) (cl--map-keymap-recursively): * lisp/emacs-lisp/advice.el (ad-insert-argument-access-forms): * lisp/emacs-lisp/edebug.el (edebug-sort-alist) (edebug-set-windows): * lisp/emacs-lisp/pp.el (pp-display-expression): * lisp/emacs-lisp/regi.el (regi-interpret): Don't quote lambdas.
This commit is contained in:
Stefan Kangas
parent
4a8c1120f5
commit
f0f2c8563b
7 changed files with 89 additions and 102 deletions
|
|
@ -2370,28 +2370,26 @@ The assignment starts at position INDEX."
|
|||
(defun ad-insert-argument-access-forms (definition arglist)
|
||||
"Expands arg-access text macros in DEFINITION according to ARGLIST."
|
||||
(ad-substitute-tree
|
||||
(function
|
||||
(lambda (form)
|
||||
(or (eq form 'ad-arg-bindings)
|
||||
(and (memq (car-safe form)
|
||||
'(ad-get-arg ad-get-args ad-set-arg ad-set-args))
|
||||
(integerp (car-safe (cdr form)))))))
|
||||
(function
|
||||
(lambda (form)
|
||||
(if (eq form 'ad-arg-bindings)
|
||||
(ad-retrieve-args-form arglist)
|
||||
(let ((accessor (car form))
|
||||
(index (car (cdr form)))
|
||||
(val (car (cdr (ad-insert-argument-access-forms
|
||||
(cdr form) arglist)))))
|
||||
(cond ((eq accessor 'ad-get-arg)
|
||||
(ad-get-argument arglist index))
|
||||
((eq accessor 'ad-set-arg)
|
||||
(ad-set-argument arglist index val))
|
||||
((eq accessor 'ad-get-args)
|
||||
(ad-get-arguments arglist index))
|
||||
((eq accessor 'ad-set-args)
|
||||
(ad-set-arguments arglist index val)))))))
|
||||
(lambda (form)
|
||||
(or (eq form 'ad-arg-bindings)
|
||||
(and (memq (car-safe form)
|
||||
'(ad-get-arg ad-get-args ad-set-arg ad-set-args))
|
||||
(integerp (car-safe (cdr form))))))
|
||||
(lambda (form)
|
||||
(if (eq form 'ad-arg-bindings)
|
||||
(ad-retrieve-args-form arglist)
|
||||
(let ((accessor (car form))
|
||||
(index (car (cdr form)))
|
||||
(val (car (cdr (ad-insert-argument-access-forms
|
||||
(cdr form) arglist)))))
|
||||
(cond ((eq accessor 'ad-get-arg)
|
||||
(ad-get-argument arglist index))
|
||||
((eq accessor 'ad-set-arg)
|
||||
(ad-set-argument arglist index val))
|
||||
((eq accessor 'ad-get-args)
|
||||
(ad-get-arguments arglist index))
|
||||
((eq accessor 'ad-set-args)
|
||||
(ad-set-arguments arglist index val))))))
|
||||
definition))
|
||||
|
||||
;; @@@ Mapping argument lists:
|
||||
|
|
|
|||
|
|
@ -209,10 +209,10 @@ non-nil value.
|
|||
\n(fn PREDICATE SEQ...)"
|
||||
(if (or cl-rest (nlistp cl-seq))
|
||||
(catch 'cl-some
|
||||
(apply 'cl-map nil
|
||||
(function (lambda (&rest cl-x)
|
||||
(let ((cl-res (apply cl-pred cl-x)))
|
||||
(if cl-res (throw 'cl-some cl-res)))))
|
||||
(apply #'cl-map nil
|
||||
(lambda (&rest cl-x)
|
||||
(let ((cl-res (apply cl-pred cl-x)))
|
||||
(if cl-res (throw 'cl-some cl-res))))
|
||||
cl-seq cl-rest) nil)
|
||||
(let ((cl-x nil))
|
||||
(while (and cl-seq (not (setq cl-x (funcall cl-pred (pop cl-seq))))))
|
||||
|
|
@ -224,9 +224,9 @@ non-nil value.
|
|||
\n(fn PREDICATE SEQ...)"
|
||||
(if (or cl-rest (nlistp cl-seq))
|
||||
(catch 'cl-every
|
||||
(apply 'cl-map nil
|
||||
(function (lambda (&rest cl-x)
|
||||
(or (apply cl-pred cl-x) (throw 'cl-every nil))))
|
||||
(apply #'cl-map nil
|
||||
(lambda (&rest cl-x)
|
||||
(or (apply cl-pred cl-x) (throw 'cl-every nil)))
|
||||
cl-seq cl-rest) t)
|
||||
(while (and cl-seq (funcall cl-pred (car cl-seq)))
|
||||
(setq cl-seq (cdr cl-seq)))
|
||||
|
|
@ -249,14 +249,13 @@ non-nil value.
|
|||
(or cl-base
|
||||
(setq cl-base (copy-sequence [0])))
|
||||
(map-keymap
|
||||
(function
|
||||
(lambda (cl-key cl-bind)
|
||||
(aset cl-base (1- (length cl-base)) cl-key)
|
||||
(if (keymapp cl-bind)
|
||||
(cl--map-keymap-recursively
|
||||
cl-func-rec cl-bind
|
||||
(vconcat cl-base (list 0)))
|
||||
(funcall cl-func-rec cl-base cl-bind))))
|
||||
(lambda (cl-key cl-bind)
|
||||
(aset cl-base (1- (length cl-base)) cl-key)
|
||||
(if (keymapp cl-bind)
|
||||
(cl--map-keymap-recursively
|
||||
cl-func-rec cl-bind
|
||||
(vconcat cl-base (list 0)))
|
||||
(funcall cl-func-rec cl-base cl-bind)))
|
||||
cl-map))
|
||||
|
||||
;;;###autoload
|
||||
|
|
|
|||
|
|
@ -819,16 +819,15 @@ final clause, and matches if no other keys match.
|
|||
(cons
|
||||
'cond
|
||||
(mapcar
|
||||
(function
|
||||
(lambda (c)
|
||||
(cons (cond ((eq (car c) 'otherwise) t)
|
||||
((eq (car c) 'cl--ecase-error-flag)
|
||||
`(error "cl-etypecase failed: %s, %s"
|
||||
,temp ',(reverse type-list)))
|
||||
(t
|
||||
(push (car c) type-list)
|
||||
`(cl-typep ,temp ',(car c))))
|
||||
(or (cdr c) '(nil)))))
|
||||
(lambda (c)
|
||||
(cons (cond ((eq (car c) 'otherwise) t)
|
||||
((eq (car c) 'cl--ecase-error-flag)
|
||||
`(error "cl-etypecase failed: %s, %s"
|
||||
,temp ',(reverse type-list)))
|
||||
(t
|
||||
(push (car c) type-list)
|
||||
`(cl-typep ,temp ',(car c))))
|
||||
(or (cdr c) '(nil))))
|
||||
clauses)))))
|
||||
|
||||
;;;###autoload
|
||||
|
|
@ -2763,7 +2762,7 @@ Supported keywords for slots are:
|
|||
(unless (cl--struct-name-p name)
|
||||
(signal 'wrong-type-argument (list 'cl-struct-name-p name 'name)))
|
||||
(setq descs (cons '(cl-tag-slot)
|
||||
(mapcar (function (lambda (x) (if (consp x) x (list x))))
|
||||
(mapcar (lambda (x) (if (consp x) x (list x)))
|
||||
descs)))
|
||||
(while opts
|
||||
(let ((opt (if (consp (car opts)) (caar opts) (car opts)))
|
||||
|
|
@ -2790,9 +2789,8 @@ Supported keywords for slots are:
|
|||
;; we include EIEIO classes rather than cl-structs!
|
||||
(when include-name (error "Can't :include more than once"))
|
||||
(setq include-name (car args))
|
||||
(setq include-descs (mapcar (function
|
||||
(lambda (x)
|
||||
(if (consp x) x (list x))))
|
||||
(setq include-descs (mapcar (lambda (x)
|
||||
(if (consp x) x (list x)))
|
||||
(cdr args))))
|
||||
((eq opt :print-function)
|
||||
(setq print-func (car args)))
|
||||
|
|
|
|||
|
|
@ -69,10 +69,9 @@
|
|||
(list 'or (list 'memq '(car cl-keys-temp)
|
||||
(list 'quote
|
||||
(mapcar
|
||||
(function
|
||||
(lambda (x)
|
||||
(if (consp x)
|
||||
(car x) x)))
|
||||
(lambda (x)
|
||||
(if (consp x)
|
||||
(car x) x))
|
||||
(append kwords
|
||||
other-keys))))
|
||||
'(car (cdr (memq (quote :allow-other-keys)
|
||||
|
|
@ -668,9 +667,9 @@ This is a destructive function; it reuses the storage of SEQ if possible.
|
|||
(cl--parsing-keywords (:key) ()
|
||||
(if (memq cl-key '(nil identity))
|
||||
(sort cl-seq cl-pred)
|
||||
(sort cl-seq (function (lambda (cl-x cl-y)
|
||||
(funcall cl-pred (funcall cl-key cl-x)
|
||||
(funcall cl-key cl-y)))))))))
|
||||
(sort cl-seq (lambda (cl-x cl-y)
|
||||
(funcall cl-pred (funcall cl-key cl-x)
|
||||
(funcall cl-key cl-y))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun cl-stable-sort (cl-seq cl-pred &rest cl-keys)
|
||||
|
|
|
|||
|
|
@ -309,9 +309,8 @@ A lambda list keyword is a symbol that starts with `&'."
|
|||
(defun edebug-sort-alist (alist function)
|
||||
;; Return the ALIST sorted with comparison function FUNCTION.
|
||||
;; This uses 'sort so the sorting is destructive.
|
||||
(sort alist (function
|
||||
(lambda (e1 e2)
|
||||
(funcall function (car e1) (car e2))))))
|
||||
(sort alist (lambda (e1 e2)
|
||||
(funcall function (car e1) (car e2)))))
|
||||
|
||||
;; Not used.
|
||||
'(defmacro edebug-save-restriction (&rest body)
|
||||
|
|
@ -407,14 +406,13 @@ Return the result of the last expression in BODY."
|
|||
(if (listp window-info)
|
||||
(mapcar (lambda (one-window-info)
|
||||
(if one-window-info
|
||||
(apply (function
|
||||
(lambda (window buffer point start hscroll)
|
||||
(if (edebug-window-live-p window)
|
||||
(progn
|
||||
(set-window-buffer window buffer)
|
||||
(set-window-point window point)
|
||||
(set-window-start window start)
|
||||
(set-window-hscroll window hscroll)))))
|
||||
(apply (lambda (window buffer point start hscroll)
|
||||
(if (edebug-window-live-p window)
|
||||
(progn
|
||||
(set-window-buffer window buffer)
|
||||
(set-window-point window point)
|
||||
(set-window-start window start)
|
||||
(set-window-hscroll window hscroll))))
|
||||
one-window-info)))
|
||||
window-info)
|
||||
(set-window-configuration window-info)))
|
||||
|
|
|
|||
|
|
@ -94,27 +94,25 @@ after OUT-BUFFER-NAME."
|
|||
;; This function either decides not to display it at all
|
||||
;; or displays it in the usual way.
|
||||
(temp-buffer-show-function
|
||||
(function
|
||||
(lambda (buf)
|
||||
(with-current-buffer buf
|
||||
(goto-char (point-min))
|
||||
(end-of-line 1)
|
||||
(if (or (< (1+ (point)) (point-max))
|
||||
(>= (- (point) (point-min)) (frame-width)))
|
||||
(let ((temp-buffer-show-function old-show-function)
|
||||
(old-selected (selected-window))
|
||||
(window (display-buffer buf)))
|
||||
(goto-char (point-min)) ; expected by some hooks ...
|
||||
(make-frame-visible (window-frame window))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(select-window window)
|
||||
(run-hooks 'temp-buffer-show-hook))
|
||||
(when (window-live-p old-selected)
|
||||
(select-window old-selected))
|
||||
(message "See buffer %s." out-buffer-name)))
|
||||
(message "%s" (buffer-substring (point-min) (point)))
|
||||
))))))
|
||||
(lambda (buf)
|
||||
(with-current-buffer buf
|
||||
(goto-char (point-min))
|
||||
(end-of-line 1)
|
||||
(if (or (< (1+ (point)) (point-max))
|
||||
(>= (- (point) (point-min)) (frame-width)))
|
||||
(let ((temp-buffer-show-function old-show-function)
|
||||
(old-selected (selected-window))
|
||||
(window (display-buffer buf)))
|
||||
(goto-char (point-min)) ; expected by some hooks ...
|
||||
(make-frame-visible (window-frame window))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(select-window window)
|
||||
(run-hooks 'temp-buffer-show-hook))
|
||||
(when (window-live-p old-selected)
|
||||
(select-window old-selected))
|
||||
(message "See buffer %s." out-buffer-name)))
|
||||
(message "%s" (buffer-substring (point-min) (point))))))))
|
||||
(with-output-to-temp-buffer out-buffer-name
|
||||
(pp expression)
|
||||
(with-current-buffer standard-output
|
||||
|
|
|
|||
|
|
@ -163,18 +163,15 @@ useful information:
|
|||
;; let's find the special tags and remove them from the working
|
||||
;; frame. note that only the last special tag is used.
|
||||
(mapc
|
||||
(function
|
||||
(lambda (entry)
|
||||
(let ((pred (car entry))
|
||||
(func (car (cdr entry))))
|
||||
(cond
|
||||
((eq pred 'begin) (setq begin-tag func))
|
||||
((eq pred 'end) (setq end-tag func))
|
||||
((eq pred 'every) (setq every-tag func))
|
||||
(t
|
||||
(setq working-frame (append working-frame (list entry))))
|
||||
) ; end-cond
|
||||
)))
|
||||
(lambda (entry)
|
||||
(let ((pred (car entry))
|
||||
(func (car (cdr entry))))
|
||||
(cond
|
||||
((eq pred 'begin) (setq begin-tag func))
|
||||
((eq pred 'end) (setq end-tag func))
|
||||
((eq pred 'every) (setq every-tag func))
|
||||
(t
|
||||
(setq working-frame (append working-frame (list entry)))))))
|
||||
frame) ; end-mapcar
|
||||
|
||||
;; execute the begin entry
|
||||
|
|
|
|||
Loading…
Reference in a new issue