mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-23 10:34:07 +00:00
cl-lib.el: Partial revert of "2015-04-05 Rationalize c[ad]+r"
* lisp/emacs-lisp/cl-lib.el: Partial revert of "2015-04-05 Rationalize use of c[ad]+r", so as to keep the "cl-" prefix on all cl-lib definitions.
This commit is contained in:
Stefan Monnier
parent
5194890891
commit
26f8a38497
@ -1468,7 +1468,7 @@ after that many seconds of idle time."
|
||||
(dolist (record compacted-vars)
|
||||
(let*
|
||||
((var (car record))
|
||||
(deser-fun (caddr (assq var desktop-var-serdes-funs))))
|
||||
(deser-fun (nth 2 (assq var desktop-var-serdes-funs))))
|
||||
(if deser-fun (set var (funcall deser-fun (cadr record))))))))
|
||||
result))))
|
||||
|
||||
|
||||
@ -612,7 +612,7 @@ This function assumes that the events can be stored in a string."
|
||||
((eq (car ev) 'switch-frame))
|
||||
((equal ev '(menu-bar))
|
||||
(push 'menu-bar result))
|
||||
((equal (cadadr ev) '(menu-bar))
|
||||
((equal (cl-cadadr ev) '(menu-bar))
|
||||
(push (vector 'menu-bar (car ev)) result))
|
||||
;; It would be nice to do pop-up menus, too, but not enough
|
||||
;; info is recorded in macros to make this possible.
|
||||
|
||||
@ -385,8 +385,8 @@ Signal an error if X is not a list."
|
||||
(null x)
|
||||
(signal 'wrong-type-argument (list 'listp x 'x))))
|
||||
|
||||
(cl--defalias 'cl-third 'caddr "Return the third element of the list X.")
|
||||
(cl--defalias 'cl-fourth 'cadddr "Return the fourth element of the list X.")
|
||||
(cl--defalias 'cl-third 'cl-caddr "Return the third element of the list X.")
|
||||
(cl--defalias 'cl-fourth 'cl-cadddr "Return the fourth element of the list X.")
|
||||
|
||||
(defsubst cl-fifth (x)
|
||||
"Return the fifth element of the list X."
|
||||
@ -418,159 +418,126 @@ Signal an error if X is not a list."
|
||||
(declare (gv-setter (lambda (store) `(setcar (nthcdr 9 ,x) ,store))))
|
||||
(nth 9 x))
|
||||
|
||||
(defun caaar (x)
|
||||
(defun cl-caaar (x)
|
||||
"Return the `car' of the `car' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(car (car (car x))))
|
||||
|
||||
(defun caadr (x)
|
||||
(defun cl-caadr (x)
|
||||
"Return the `car' of the `car' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(car (car (cdr x))))
|
||||
|
||||
(defun cadar (x)
|
||||
(defun cl-cadar (x)
|
||||
"Return the `car' of the `cdr' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(car (cdr (car x))))
|
||||
|
||||
(defun caddr (x)
|
||||
(defun cl-caddr (x)
|
||||
"Return the `car' of the `cdr' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(car (cdr (cdr x))))
|
||||
|
||||
(defun cdaar (x)
|
||||
(defun cl-cdaar (x)
|
||||
"Return the `cdr' of the `car' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(cdr (car (car x))))
|
||||
|
||||
(defun cdadr (x)
|
||||
(defun cl-cdadr (x)
|
||||
"Return the `cdr' of the `car' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(cdr (car (cdr x))))
|
||||
|
||||
(defun cddar (x)
|
||||
(defun cl-cddar (x)
|
||||
"Return the `cdr' of the `cdr' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(cdr (cdr (car x))))
|
||||
|
||||
(defun cdddr (x)
|
||||
(defun cl-cdddr (x)
|
||||
"Return the `cdr' of the `cdr' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(cdr (cdr (cdr x))))
|
||||
|
||||
(defun caaaar (x)
|
||||
(defun cl-caaaar (x)
|
||||
"Return the `car' of the `car' of the `car' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(car (car (car (car x)))))
|
||||
|
||||
(defun caaadr (x)
|
||||
(defun cl-caaadr (x)
|
||||
"Return the `car' of the `car' of the `car' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(car (car (car (cdr x)))))
|
||||
|
||||
(defun caadar (x)
|
||||
(defun cl-caadar (x)
|
||||
"Return the `car' of the `car' of the `cdr' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(car (car (cdr (car x)))))
|
||||
|
||||
(defun caaddr (x)
|
||||
(defun cl-caaddr (x)
|
||||
"Return the `car' of the `car' of the `cdr' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(car (car (cdr (cdr x)))))
|
||||
|
||||
(defun cadaar (x)
|
||||
(defun cl-cadaar (x)
|
||||
"Return the `car' of the `cdr' of the `car' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(car (cdr (car (car x)))))
|
||||
|
||||
(defun cadadr (x)
|
||||
(defun cl-cadadr (x)
|
||||
"Return the `car' of the `cdr' of the `car' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(car (cdr (car (cdr x)))))
|
||||
|
||||
(defun caddar (x)
|
||||
(defun cl-caddar (x)
|
||||
"Return the `car' of the `cdr' of the `cdr' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(car (cdr (cdr (car x)))))
|
||||
|
||||
(defun cadddr (x)
|
||||
(defun cl-cadddr (x)
|
||||
"Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(car (cdr (cdr (cdr x)))))
|
||||
|
||||
(defun cdaaar (x)
|
||||
(defun cl-cdaaar (x)
|
||||
"Return the `cdr' of the `car' of the `car' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(cdr (car (car (car x)))))
|
||||
|
||||
(defun cdaadr (x)
|
||||
(defun cl-cdaadr (x)
|
||||
"Return the `cdr' of the `car' of the `car' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(cdr (car (car (cdr x)))))
|
||||
|
||||
(defun cdadar (x)
|
||||
(defun cl-cdadar (x)
|
||||
"Return the `cdr' of the `car' of the `cdr' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(cdr (car (cdr (car x)))))
|
||||
|
||||
(defun cdaddr (x)
|
||||
(defun cl-cdaddr (x)
|
||||
"Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(cdr (car (cdr (cdr x)))))
|
||||
|
||||
(defun cddaar (x)
|
||||
(defun cl-cddaar (x)
|
||||
"Return the `cdr' of the `cdr' of the `car' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(cdr (cdr (car (car x)))))
|
||||
|
||||
(defun cddadr (x)
|
||||
(defun cl-cddadr (x)
|
||||
"Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(cdr (cdr (car (cdr x)))))
|
||||
|
||||
(defun cdddar (x)
|
||||
(defun cl-cdddar (x)
|
||||
"Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(cdr (cdr (cdr (car x)))))
|
||||
|
||||
(defun cddddr (x)
|
||||
(defun cl-cddddr (x)
|
||||
"Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(declare (compiler-macro internal--compiler-macro-cXXr))
|
||||
(cdr (cdr (cdr (cdr x)))))
|
||||
|
||||
;; Generate aliases cl-cXXr for all the above defuns, and mark them obsolete.
|
||||
(eval-when-compile
|
||||
(defun gen-cXXr--rawname (n bits)
|
||||
"Generate and return a string like \"adad\" corresponding to N.
|
||||
BITS is the number of a's and d's.
|
||||
The \"corresponding\" means each bit of N is converted to an \"a\" (for zero)
|
||||
or a \"d\" (for one)."
|
||||
(let ((name (make-string bits ?a))
|
||||
(mask (lsh 1 (1- bits)))
|
||||
(elt 0))
|
||||
(while (< elt bits)
|
||||
(if (/= (logand n mask) 0)
|
||||
(aset name elt ?d))
|
||||
(setq elt (1+ elt)
|
||||
mask (lsh mask -1)))
|
||||
name))
|
||||
|
||||
(defmacro gen-cXXr-all-cl-aliases (bits)
|
||||
"Generate cl- aliases for all defuns `c[ad]+r' with BITS a's and d's.
|
||||
Also mark the aliases as obsolete."
|
||||
`(progn
|
||||
,@(mapcar
|
||||
(lambda (n)
|
||||
(let* ((raw (gen-cXXr--rawname n bits))
|
||||
(old (intern (concat "cl-c" raw "r")))
|
||||
(new (intern (concat "c" raw "r"))))
|
||||
`(progn (defalias ',old ',new)
|
||||
(make-obsolete ',old ',new "25.1"))))
|
||||
(number-sequence 0 (1- (lsh 1 bits)))))))
|
||||
|
||||
(gen-cXXr-all-cl-aliases 3)
|
||||
(gen-cXXr-all-cl-aliases 4)
|
||||
|
||||
;;(defun last* (x &optional n)
|
||||
;; "Returns the last link in the list LIST.
|
||||
;;With optional argument N, returns Nth-to-last link (default 1)."
|
||||
|
||||
@ -74,19 +74,8 @@
|
||||
;; `internal--compiler-macro-cXXr' in subr.el. If you amend either
|
||||
;; one, you may want to amend the other, too.
|
||||
;;;###autoload
|
||||
(defun cl--compiler-macro-cXXr (form x)
|
||||
(let* ((head (car form))
|
||||
(n (symbol-name (car form)))
|
||||
(i (- (length n) 2)))
|
||||
(if (not (string-match "c[ad]+r\\'" n))
|
||||
(if (and (fboundp head) (symbolp (symbol-function head)))
|
||||
(cl--compiler-macro-cXXr (cons (symbol-function head) (cdr form))
|
||||
x)
|
||||
(error "Compiler macro for cXXr applied to non-cXXr form"))
|
||||
(while (> i (match-beginning 0))
|
||||
(setq x (list (if (eq (aref n i) ?a) 'car 'cdr) x))
|
||||
(setq i (1- i)))
|
||||
x)))
|
||||
(define-obsolete-function-alias 'cl--compiler-macro-cXXr
|
||||
'internal--compiler-macro-cXXr "25.1")
|
||||
|
||||
;;; Some predicates for analyzing Lisp forms.
|
||||
;; These are used by various
|
||||
@ -503,7 +492,7 @@ its argument list allows full Common Lisp conventions."
|
||||
(while (and (eq (car args) '&aux) (pop args))
|
||||
(while (and args (not (memq (car args) cl--lambda-list-keywords)))
|
||||
(if (consp (car args))
|
||||
(if (and cl--bind-enquote (cadar args))
|
||||
(if (and cl--bind-enquote (cl-cadar args))
|
||||
(cl--do-arglist (caar args)
|
||||
`',(cadr (pop args)))
|
||||
(cl--do-arglist (caar args) (cadr (pop args))))
|
||||
@ -587,7 +576,7 @@ its argument list allows full Common Lisp conventions."
|
||||
(if (eq ?_ (aref name 0))
|
||||
(setq name (substring name 1)))
|
||||
(intern (format ":%s" name)))))
|
||||
(varg (if (consp (car arg)) (cadar arg) (car arg)))
|
||||
(varg (if (consp (car arg)) (cl-cadar arg) (car arg)))
|
||||
(def (if (cdr arg) (cadr arg)
|
||||
;; The ordering between those two or clauses is
|
||||
;; irrelevant, since in practice only one of the two
|
||||
@ -1191,10 +1180,10 @@ For more details, see Info node `(cl)Loop Facility'.
|
||||
(if (memq (car cl--loop-args) '(downto above))
|
||||
(error "Must specify `from' value for downward cl-loop"))
|
||||
(let* ((down (or (eq (car cl--loop-args) 'downfrom)
|
||||
(memq (caddr cl--loop-args)
|
||||
(memq (nth 2 cl--loop-args)
|
||||
'(downto above))))
|
||||
(excl (or (memq (car cl--loop-args) '(above below))
|
||||
(memq (caddr cl--loop-args)
|
||||
(memq (nth 2 cl--loop-args)
|
||||
'(above below))))
|
||||
(start (and (memq (car cl--loop-args)
|
||||
'(from upfrom downfrom))
|
||||
@ -1294,7 +1283,7 @@ For more details, see Info node `(cl)Loop Facility'.
|
||||
(temp-idx
|
||||
(if (eq (car cl--loop-args) 'using)
|
||||
(if (and (= (length (cadr cl--loop-args)) 2)
|
||||
(eq (caadr cl--loop-args) 'index))
|
||||
(eq (cl-caadr cl--loop-args) 'index))
|
||||
(cadr (cl--pop2 cl--loop-args))
|
||||
(error "Bad `using' clause"))
|
||||
(make-symbol "--cl-idx--"))))
|
||||
@ -1326,8 +1315,8 @@ For more details, see Info node `(cl)Loop Facility'.
|
||||
(other
|
||||
(if (eq (car cl--loop-args) 'using)
|
||||
(if (and (= (length (cadr cl--loop-args)) 2)
|
||||
(memq (caadr cl--loop-args) hash-types)
|
||||
(not (eq (caadr cl--loop-args) word)))
|
||||
(memq (cl-caadr cl--loop-args) hash-types)
|
||||
(not (eq (cl-caadr cl--loop-args) word)))
|
||||
(cadr (cl--pop2 cl--loop-args))
|
||||
(error "Bad `using' clause"))
|
||||
(make-symbol "--cl-var--"))))
|
||||
@ -1389,8 +1378,8 @@ For more details, see Info node `(cl)Loop Facility'.
|
||||
(other
|
||||
(if (eq (car cl--loop-args) 'using)
|
||||
(if (and (= (length (cadr cl--loop-args)) 2)
|
||||
(memq (caadr cl--loop-args) key-types)
|
||||
(not (eq (caadr cl--loop-args) word)))
|
||||
(memq (cl-caadr cl--loop-args) key-types)
|
||||
(not (eq (cl-caadr cl--loop-args) word)))
|
||||
(cadr (cl--pop2 cl--loop-args))
|
||||
(error "Bad `using' clause"))
|
||||
(make-symbol "--cl-var--"))))
|
||||
@ -1614,7 +1603,7 @@ If BODY is `setq', then use SPECS for assignments rather than for bindings."
|
||||
(let ((temps nil) (new nil))
|
||||
(when par
|
||||
(let ((p specs))
|
||||
(while (and p (or (symbolp (car-safe (car p))) (null (cadar p))))
|
||||
(while (and p (or (symbolp (car-safe (car p))) (null (cl-cadar p))))
|
||||
(setq p (cdr p)))
|
||||
(when p
|
||||
(setq par nil)
|
||||
@ -1689,7 +1678,7 @@ such that COMBO is equivalent to (and . CLAUSES)."
|
||||
(setq clauses (cons (nconc (butlast (car clauses))
|
||||
(if (eq (car-safe (cadr clauses))
|
||||
'progn)
|
||||
(cdadr clauses)
|
||||
(cl-cdadr clauses)
|
||||
(list (cadr clauses))))
|
||||
(cddr clauses)))
|
||||
;; A final (progn ,@A t) is moved outside of the `and'.
|
||||
@ -1831,7 +1820,7 @@ from OBARRAY.
|
||||
(let (,(car spec))
|
||||
(mapatoms #'(lambda (,(car spec)) ,@body)
|
||||
,@(and (cadr spec) (list (cadr spec))))
|
||||
,(caddr spec))))
|
||||
,(nth 2 spec))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro cl-do-all-symbols (spec &rest body)
|
||||
@ -2108,9 +2097,9 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
|
||||
;; FIXME: For N bindings, this will traverse `body' N times!
|
||||
(macroexpand-all (macroexp-progn body)
|
||||
(cons (list (symbol-name (caar bindings))
|
||||
(cadar bindings))
|
||||
(cl-cadar bindings))
|
||||
macroexpand-all-environment))))
|
||||
(if (or (null (cdar bindings)) (cddar bindings))
|
||||
(if (or (null (cdar bindings)) (cl-cddar bindings))
|
||||
(macroexp--warn-and-return
|
||||
(format "Malformed `cl-symbol-macrolet' binding: %S"
|
||||
(car bindings))
|
||||
@ -2219,7 +2208,7 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C).
|
||||
((and (eq (car-safe spec) 'warn) (boundp 'byte-compile-warnings))
|
||||
(while (setq spec (cdr spec))
|
||||
(if (consp (car spec))
|
||||
(if (eq (cadar spec) 0)
|
||||
(if (eq (cl-cadar spec) 0)
|
||||
(byte-compile-disable-warning (caar spec))
|
||||
(byte-compile-enable-warning (caar spec)))))))
|
||||
nil)
|
||||
@ -2663,9 +2652,9 @@ non-nil value, that slot cannot be set via `setf'.
|
||||
(t `(and (consp cl-x)
|
||||
(memq (nth ,pos cl-x) ,tag-symbol))))))
|
||||
pred-check (and pred-form (> safety 0)
|
||||
(if (and (eq (caadr pred-form) 'vectorp)
|
||||
(if (and (eq (cl-caadr pred-form) 'vectorp)
|
||||
(= safety 1))
|
||||
(cons 'and (cdddr pred-form))
|
||||
(cons 'and (cl-cdddr pred-form))
|
||||
`(,predicate cl-x))))
|
||||
(let ((pos 0) (descp descs))
|
||||
(while descp
|
||||
@ -3093,14 +3082,14 @@ macro that returns its `&whole' argument."
|
||||
cl-fifth cl-sixth cl-seventh
|
||||
cl-eighth cl-ninth cl-tenth
|
||||
cl-rest cl-endp cl-plusp cl-minusp
|
||||
caaar caadr cadar
|
||||
caddr cdaar cdadr
|
||||
cddar cdddr caaaar
|
||||
caaadr caadar caaddr
|
||||
cadaar cadadr caddar
|
||||
cadddr cdaaar cdaadr
|
||||
cdadar cdaddr cddaar
|
||||
cddadr cdddar cddddr))
|
||||
cl-caaar cl-caadr cl-cadar
|
||||
cl-caddr cl-cdaar cl-cdadr
|
||||
cl-cddar cl-cdddr cl-caaaar
|
||||
cl-caaadr cl-caadar cl-caaddr
|
||||
cl-cadaar cl-cadadr cl-caddar
|
||||
cl-cadddr cl-cdaaar cl-cdaadr
|
||||
cl-cdadar cl-cdaddr cl-cddaar
|
||||
cl-cddadr cl-cdddar cl-cddddr))
|
||||
(put y 'side-effect-free t))
|
||||
|
||||
;;; Things that are inline.
|
||||
|
||||
@ -259,6 +259,30 @@
|
||||
copy-list
|
||||
ldiff
|
||||
list*
|
||||
cddddr
|
||||
cdddar
|
||||
cddadr
|
||||
cddaar
|
||||
cdaddr
|
||||
cdadar
|
||||
cdaadr
|
||||
cdaaar
|
||||
cadddr
|
||||
caddar
|
||||
cadadr
|
||||
cadaar
|
||||
caaddr
|
||||
caadar
|
||||
caaadr
|
||||
caaaar
|
||||
cdddr
|
||||
cddar
|
||||
cdadr
|
||||
cdaar
|
||||
caddr
|
||||
cadar
|
||||
caadr
|
||||
caaar
|
||||
tenth
|
||||
ninth
|
||||
eighth
|
||||
@ -373,7 +397,7 @@ lexical closures as in Common Lisp.
|
||||
(macroexpand-all
|
||||
`(cl-symbol-macrolet
|
||||
,(mapcar (lambda (x)
|
||||
`(,(car x) (symbol-value ,(caddr x))))
|
||||
`(,(car x) (symbol-value ,(nth 2 x))))
|
||||
vars)
|
||||
,@body)
|
||||
(cons (cons 'function #'cl--function-convert)
|
||||
@ -386,20 +410,20 @@ lexical closures as in Common Lisp.
|
||||
;; dynamic scoping, since with lexical scoping we'd need
|
||||
;; (let ((foo <val>)) ...foo...).
|
||||
`(progn
|
||||
,@(mapcar (lambda (x) `(defvar ,(caddr x))) vars)
|
||||
(let ,(mapcar (lambda (x) (list (caddr x) (cadr x))) vars)
|
||||
,@(mapcar (lambda (x) `(defvar ,(nth 2 x))) vars)
|
||||
(let ,(mapcar (lambda (x) (list (nth 2 x) (nth 1 x))) vars)
|
||||
,(cl-sublis (mapcar (lambda (x)
|
||||
(cons (caddr x)
|
||||
`',(caddr x)))
|
||||
(cons (nth 2 x)
|
||||
`',(nth 2 x)))
|
||||
vars)
|
||||
ebody)))
|
||||
`(let ,(mapcar (lambda (x)
|
||||
(list (caddr x)
|
||||
(list (nth 2 x)
|
||||
`(make-symbol ,(format "--%s--" (car x)))))
|
||||
vars)
|
||||
(setf ,@(apply #'append
|
||||
(mapcar (lambda (x)
|
||||
(list `(symbol-value ,(caddr x)) (cadr x)))
|
||||
(list `(symbol-value ,(nth 2 x)) (nth 1 x)))
|
||||
vars)))
|
||||
,ebody))))
|
||||
|
||||
|
||||
@ -809,7 +809,7 @@ For the description of FORCE-ONSCREEN, see `frameset-restore'.
|
||||
When forced onscreen, frames wider than the monitor's workarea are converted
|
||||
to fullwidth, and frames taller than the workarea are converted to fullheight.
|
||||
NOTE: This only works for non-iconified frames."
|
||||
(pcase-let* ((`(,left ,top ,width ,height) (cdadr (frame-monitor-attributes frame)))
|
||||
(pcase-let* ((`(,left ,top ,width ,height) (cl-cdadr (frame-monitor-attributes frame)))
|
||||
(right (+ left width -1))
|
||||
(bottom (+ top height -1))
|
||||
(fr-left (frameset-compute-pos (frame-parameter frame 'left) left right))
|
||||
|
||||
@ -2162,7 +2162,7 @@ If optional arg SILENT is non-nil, do not display progress messages."
|
||||
(eq ibuffer-always-show-last-buffer
|
||||
:nomini)
|
||||
(minibufferp (cadr bufs)))
|
||||
(caddr bufs)
|
||||
(nth 2 bufs)
|
||||
(cadr bufs))
|
||||
(ibuffer-current-buffers-with-marks bufs)
|
||||
ibuffer-display-maybe-show-predicates)))
|
||||
@ -2194,7 +2194,7 @@ If optional arg SILENT is non-nil, do not display progress messages."
|
||||
(require 'ibuf-ext))
|
||||
(let* ((sortdat (assq ibuffer-sorting-mode
|
||||
ibuffer-sorting-functions-alist))
|
||||
(func (caddr sortdat)))
|
||||
(func (nth 2 sortdat)))
|
||||
(let ((result
|
||||
;; actually sort the buffers
|
||||
(if (and sortdat func)
|
||||
|
||||
@ -644,7 +644,7 @@ by using `Footnote-back-to-message'."
|
||||
(interactive "*P")
|
||||
(let ((num
|
||||
(if footnote-text-marker-alist
|
||||
(if (< (point) (cadar (last footnote-pointer-marker-alist)))
|
||||
(if (< (point) (cl-cadar (last footnote-pointer-marker-alist)))
|
||||
(Footnote-make-hole)
|
||||
(1+ (caar (last footnote-text-marker-alist))))
|
||||
1)))
|
||||
|
||||
@ -869,7 +869,7 @@ association to the service from D-Bus."
|
||||
;; Service.
|
||||
(string-equal service (cadr e))
|
||||
;; Non-empty object path.
|
||||
(caddr e)
|
||||
(nth 2 e)
|
||||
(throw :found t)))))
|
||||
dbus-registered-objects-table)
|
||||
nil))))
|
||||
@ -1474,7 +1474,7 @@ name of the property, and its value. If there are no properties,
|
||||
bus service path dbus-interface-properties
|
||||
"GetAll" :timeout 500 interface)
|
||||
result)
|
||||
(add-to-list 'result (cons (car dict) (caadr dict)) 'append)))))
|
||||
(add-to-list 'result (cons (car dict) (cl-caadr dict)) 'append)))))
|
||||
|
||||
(defun dbus-register-property
|
||||
(bus service path interface property access value
|
||||
@ -1672,7 +1672,7 @@ and \"org.freedesktop.DBus.Properties.GetAll\", which is slow."
|
||||
(if (cadr entry2)
|
||||
;; "sv".
|
||||
(dolist (entry3 (cadr entry2))
|
||||
(setcdr entry3 (caadr entry3)))
|
||||
(setcdr entry3 (cl-caadr entry3)))
|
||||
(setcdr entry2 nil)))))
|
||||
|
||||
;; Fallback: collect the information. Slooow!
|
||||
|
||||
@ -47,6 +47,8 @@
|
||||
|
||||
(require 'wid-edit)
|
||||
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
|
||||
(eval-and-compile
|
||||
(if (not (fboundp 'make-overlay))
|
||||
(require 'overlay)))
|
||||
@ -698,7 +700,7 @@ If ERROR is non-nil, report an error if there is none."
|
||||
(let ((result (eudc-query (list (cons 'name name)) '(email)))
|
||||
email)
|
||||
(if (null (cdr result))
|
||||
(setq email (cdaar result))
|
||||
(setq email (cl-cdaar result))
|
||||
(error "Multiple match--use the query form"))
|
||||
(if error
|
||||
(if email
|
||||
@ -716,7 +718,7 @@ If ERROR is non-nil, report an error if there is none."
|
||||
(let ((result (eudc-query (list (cons 'name name)) '(phone)))
|
||||
phone)
|
||||
(if (null (cdr result))
|
||||
(setq phone (cdaar result))
|
||||
(setq phone (cl-cdaar result))
|
||||
(error "Multiple match--use the query form"))
|
||||
(if error
|
||||
(if phone
|
||||
|
||||
@ -81,7 +81,7 @@ are returned"
|
||||
(eudc-ph-do-request "fields")
|
||||
(if full-records
|
||||
(eudc-ph-parse-query-result)
|
||||
(mapcar 'caar (eudc-ph-parse-query-result))))
|
||||
(mapcar #'caar (eudc-ph-parse-query-result))))
|
||||
|
||||
(defun eudc-ph-parse-query-result (&optional fields)
|
||||
"Return a list of alists of key/values from in `eudc-ph-process-buffer'.
|
||||
|
||||
@ -2148,7 +2148,7 @@ activity. Only run if the buffer is not visible and
|
||||
(when (and (listp x) (listp (cadr x)))
|
||||
(setcdr x (if (> (length (cdr x)) 1)
|
||||
(rcirc-make-trees (cdr x))
|
||||
(setcdr x (list (cdadr x)))))))
|
||||
(setcdr x (list (cl-cdadr x)))))))
|
||||
alist)))
|
||||
|
||||
;;; /commands these are called with 3 args: PROCESS, TARGET, which is
|
||||
@ -2693,7 +2693,7 @@ the only argument."
|
||||
(defun rcirc-handler-KICK (process sender args _text)
|
||||
(let* ((channel (car args))
|
||||
(nick (cadr args))
|
||||
(reason (caddr args))
|
||||
(reason (nth 2 args))
|
||||
(message (concat nick " " channel " " reason)))
|
||||
(rcirc-print process sender "KICK" channel message t)
|
||||
;; print in private chat buffer if it exists
|
||||
@ -2777,7 +2777,7 @@ the only argument."
|
||||
"RPL_AWAY"
|
||||
(let* ((nick (cadr args))
|
||||
(rec (assoc-string nick rcirc-nick-away-alist))
|
||||
(away-message (caddr args)))
|
||||
(away-message (nth 2 args)))
|
||||
(when (or (not rec)
|
||||
(not (string= (cdr rec) away-message)))
|
||||
;; away message has changed
|
||||
@ -2806,7 +2806,7 @@ the only argument."
|
||||
(let ((buffer (or (rcirc-get-buffer process (cadr args))
|
||||
(rcirc-get-temp-buffer-create process (cadr args)))))
|
||||
(with-current-buffer buffer
|
||||
(setq rcirc-topic (caddr args)))))
|
||||
(setq rcirc-topic (nth 2 args)))))
|
||||
|
||||
(defun rcirc-handler-333 (process sender args _text)
|
||||
"333 says who set the topic and when.
|
||||
@ -2814,16 +2814,16 @@ Not in rfc1459.txt"
|
||||
(let ((buffer (or (rcirc-get-buffer process (cadr args))
|
||||
(rcirc-get-temp-buffer-create process (cadr args)))))
|
||||
(with-current-buffer buffer
|
||||
(let ((setter (caddr args))
|
||||
(let ((setter (nth 2 args))
|
||||
(time (current-time-string
|
||||
(seconds-to-time
|
||||
(string-to-number (cadddr args))))))
|
||||
(string-to-number (cl-cadddr args))))))
|
||||
(rcirc-print process sender "TOPIC" (cadr args)
|
||||
(format "%s (%s on %s)" rcirc-topic setter time))))))
|
||||
|
||||
(defun rcirc-handler-477 (process sender args _text)
|
||||
"ERR_NOCHANMODES"
|
||||
(rcirc-print process sender "477" (cadr args) (caddr args)))
|
||||
(rcirc-print process sender "477" (cadr args) (nth 2 args)))
|
||||
|
||||
(defun rcirc-handler-MODE (process sender args _text)
|
||||
(let ((target (car args))
|
||||
@ -2883,9 +2883,9 @@ Passwords are stored in `rcirc-authinfo' (which see)."
|
||||
(dolist (i rcirc-authinfo)
|
||||
(let ((process (rcirc-buffer-process))
|
||||
(server (car i))
|
||||
(nick (caddr i))
|
||||
(nick (nth 2 i))
|
||||
(method (cadr i))
|
||||
(args (cdddr i)))
|
||||
(args (cl-cdddr i)))
|
||||
(when (and (string-match server rcirc-server))
|
||||
(if (and (memq method '(nickserv chanserv bitlbee))
|
||||
(string-match nick rcirc-nick))
|
||||
|
||||
@ -702,7 +702,7 @@ If there is no such item, return nil."
|
||||
(let ((item-path (secrets-item-path collection item)))
|
||||
(unless (secrets-empty-path item-path)
|
||||
(dbus-byte-array-to-string
|
||||
(caddr
|
||||
(nth 2
|
||||
(dbus-call-method
|
||||
:session secrets-service item-path secrets-interface-item
|
||||
"GetSecret" :object-path secrets-session-path))))))
|
||||
|
||||
@ -322,7 +322,7 @@ Quit current game \\[5x5-quit-game]"
|
||||
(save-excursion
|
||||
(goto-char grid-org)
|
||||
(beginning-of-line (+ 1 (/ 5x5-y-scale 2)))
|
||||
(let ((solution-grid (cdadr 5x5-solver-output)))
|
||||
(let ((solution-grid (cl-cdadr 5x5-solver-output)))
|
||||
(dotimes (y 5x5-grid-size)
|
||||
(save-excursion
|
||||
(forward-char (+ 1 (/ (1+ 5x5-x-scale) 2)))
|
||||
@ -747,9 +747,9 @@ Solutions are sorted from least to greatest Hamming weight."
|
||||
;; The Hamming Weight is computed by matrix reduction
|
||||
;; with an ad-hoc operator.
|
||||
(math-reduce-vec
|
||||
;; (cadadr '(vec (mod x 2))) => x
|
||||
(lambda (r x) (+ (if (integerp r) r (cadadr r))
|
||||
(cadadr x)))
|
||||
;; (cl-cadadr '(vec (mod x 2))) => x
|
||||
(lambda (r x) (+ (if (integerp r) r (cl-cadadr r))
|
||||
(cl-cadadr x)))
|
||||
solution); car
|
||||
(5x5-vec-to-grid
|
||||
(calcFunc-arrange solution 5x5-grid-size));cdr
|
||||
|
||||
@ -792,8 +792,8 @@ TOTAL is the total number of letters in the ciphertext."
|
||||
(while temp-list
|
||||
(insert (caar temp-list)
|
||||
(format "%4d%3d%% "
|
||||
(cadar temp-list)
|
||||
(/ (* 100 (cadar temp-list)) total)))
|
||||
(cl-cadar temp-list)
|
||||
(/ (* 100 (cl-cadar temp-list)) total)))
|
||||
(setq temp-list (nthcdr 4 temp-list)))
|
||||
(insert ?\n)
|
||||
(setq freq-list (cdr freq-list)
|
||||
|
||||
@ -277,7 +277,7 @@ BITS must be of length nrings. Start at START-TIME."
|
||||
;; Disable display of line and column numbers, for speed.
|
||||
(line-number-mode nil) (column-number-mode nil))
|
||||
;; do it!
|
||||
(hanoi-n bits rings (car poles) (cadr poles) (caddr poles)
|
||||
(hanoi-n bits rings (nth 0 poles) (nth 1 poles) (nth 2 poles)
|
||||
start-time))
|
||||
(message "Done"))
|
||||
(setq buffer-read-only t)
|
||||
|
||||
@ -663,8 +663,8 @@ that form should be displayed.")
|
||||
(setq tok (cadr tokens))
|
||||
(if (eq (car tokens) 'hif-lparen)
|
||||
(if (and (hif-if-valid-identifier-p tok)
|
||||
(eq (caddr tokens) 'hif-rparen))
|
||||
(setq tokens (cdddr tokens))
|
||||
(eq (nth 2 tokens) 'hif-rparen))
|
||||
(setq tokens (cl-cdddr tokens))
|
||||
(error "#define followed by non-identifier: %S" tok))
|
||||
(setq tok (car tokens)
|
||||
tokens (cdr tokens))
|
||||
@ -730,7 +730,7 @@ detecting self-reference."
|
||||
result))
|
||||
;; Argument list is nil, direct expansion
|
||||
(setq rep (hif-expand-token-list
|
||||
(caddr rep) ; Macro's token list
|
||||
(nth 2 rep) ; Macro's token list
|
||||
tok expand_list))
|
||||
;; Replace all remaining references immediately
|
||||
(setq remains (cl-substitute tok rep remains))
|
||||
|
||||
@ -1577,7 +1577,7 @@ if the range was altered."
|
||||
(funcall field (ses-sym-rowcol min))))
|
||||
;; This range has changed size.
|
||||
(setq ses-relocate-return 'range))
|
||||
`(ses-range ,min ,max ,@(cdddr range)))))
|
||||
`(ses-range ,min ,max ,@(cl-cdddr range)))))
|
||||
|
||||
(defun ses-relocate-all (minrow mincol rowincr colincr)
|
||||
"Alter all cell values, symbols, formulas, and reference-lists to relocate
|
||||
|
||||
Loading…
Reference in New Issue
Block a user