procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(cl-map-keymap): Redefine as alias.

Browse source 
(cl-map-keymap-recursively): Use map-keymap.
(cl-macroexpand-all): Don't quote functions.
This commit is contained in:
Stefan Monnier 2003-05-04 00:44:25 +00:00
parent 0d7a020af5
commit 09dae035eb
1 changed files with 6 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

21
lisp/emacs-lisp/cl-extra.el
View file

@ -203,26 +203,12 @@ If so, return the true (non-nil) value returned by PREDICATE."
(not (apply 'every cl-pred cl-seq cl-rest))) (not (apply 'every cl-pred cl-seq cl-rest)))
;;; Support for `loop'. ;;; Support for `loop'.
(defun cl-map-keymap (cl-func cl-map) (defalias 'cl-map-keymap 'map-keymap)
(while (symbolp cl-map) (setq cl-map (symbol-function cl-map)))
(if (listp cl-map)
(let ((cl-p cl-map))
(while (consp (setq cl-p (cdr cl-p)))
(cond ((consp (car cl-p))
(funcall cl-func (car (car cl-p)) (cdr (car cl-p))))
((or (vectorp (car cl-p)) (char-table-p (car cl-p)))
(cl-map-keymap cl-func (car cl-p)))
((eq (car cl-p) 'keymap)
(setq cl-p nil)))))
(let ((cl-i -1))
(while (< (setq cl-i (1+ cl-i)) (length cl-map))
(if (aref cl-map cl-i)
(funcall cl-func cl-i (aref cl-map cl-i)))))))
(defun cl-map-keymap-recursively (cl-func-rec cl-map &optional cl-base) (defun cl-map-keymap-recursively (cl-func-rec cl-map &optional cl-base)
(or cl-base (or cl-base
(setq cl-base (copy-sequence [0]))) (setq cl-base (copy-sequence [0])))
(cl-map-keymap (map-keymap
(function (function
(lambda (cl-key cl-bind) (lambda (cl-key cl-bind)
(aset cl-base (1- (length cl-base)) cl-key) (aset cl-base (1- (length cl-base)) cl-key)
@ -721,11 +707,10 @@ This also does some trivial optimizations to make the form prettier."
(sublis sub (nreverse decls)) (sublis sub (nreverse decls))
(list (list
(list* 'list '(quote apply) (list* 'list '(quote apply)
(list 'list '(quote quote)
(list 'function (list 'function
(list* 'lambda (list* 'lambda
(append new (cadadr form)) (append new (cadadr form))
(sublis sub body)))) (sublis sub body)))
(nconc (mapcar (function (nconc (mapcar (function
(lambda (x) (lambda (x)
(list 'list '(quote quote) x))) (list 'list '(quote quote) x)))