From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Artur Malabarba Newsgroups: gmane.emacs.diffs,gmane.emacs.devel Subject: Re: master 2056db3: Rationalize use of c[ad]+r, expunging cl-c[ad]\{3, 4\}r. Date: Tue, 7 Apr 2015 16:19:03 +0100 Message-ID: References: <20150405125047.6847.66246@vcs.savannah.gnu.org> Reply-To: bruce.connor.am@gmail.com NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset="us-ascii" Content-Transfer-Encoding: 7bit X-Trace: ger.gmane.org 1428419960 25174 80.91.229.3 (7 Apr 2015 15:19:20 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 7 Apr 2015 15:19:20 +0000 (UTC) Cc: emacs-diffs@gnu.org To: emacs-devel , Alan Mackenzie Original-X-From: emacs-diffs-bounces+gnu-emacs-diffs=m.gmane.org@gnu.org Tue Apr 07 17:19:19 2015 Return-path: Envelope-to: gnu-emacs-diffs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1YfVHa-0000OT-E0 for gnu-emacs-diffs@m.gmane.org; Tue, 07 Apr 2015 17:19:18 +0200 Original-Received: from localhost ([::1]:46385 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YfVHZ-0001v7-Lq for gnu-emacs-diffs@m.gmane.org; Tue, 07 Apr 2015 11:19:17 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:35519) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YfVHR-0001ms-7K for emacs-diffs@gnu.org; Tue, 07 Apr 2015 11:19:13 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1YfVHM-0003QR-O2 for emacs-diffs@gnu.org; Tue, 07 Apr 2015 11:19:09 -0400 Original-Received: from mail-la0-x22c.google.com ([2a00:1450:4010:c03::22c]:36478) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YfVHL-0003Q6-VM; Tue, 07 Apr 2015 11:19:04 -0400 Original-Received: by lagv1 with SMTP id v1so44741778lag.3; Tue, 07 Apr 2015 08:19:03 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=mime-version:reply-to:sender:in-reply-to:references:date:message-id :subject:from:to:cc:content-type; bh=hKaCKH5R14kZaF45W+LAsTai9w3IioN4ix2R/1V9NzQ=; b=mdLruOcGMFUC1KoaORBwpZozwCPwzZF4fipsrKYtnnG6/Ta/K3EJn6hmGczEfL9LNj ZXXksvSRYqAnDyIyvxVjKY5VpGn4ZtAUZb+UR7B52Sxo1Un3hoPr+vFviIf0HjKgxES6 oyycrJM3VRPAjjIZ5X2tTNHifEfSunPMRVIcFZ/DIylmQ2+gAHhn/jnCwFfXO0gexYkA 0lJ8hgP2tKgHrE6SF0d0kYxHvvk7mdZz5+d7GCF4BM9GBA/ho89Cn33BFPP9dF8/j9Qd /dC71/OLqibCsqIcYQVuReBdUIEpURaIiGcTbNwsVjhJR596Isk5YxbVR7Qpx9/gm2qS brEA== X-Received: by 10.152.5.72 with SMTP id q8mr18515166laq.73.1428419943136; Tue, 07 Apr 2015 08:19:03 -0700 (PDT) Original-Received: by 10.25.150.131 with HTTP; Tue, 7 Apr 2015 08:19:03 -0700 (PDT) In-Reply-To: X-Google-Sender-Auth: EdOumlyNCfN8ZecF5Y6UOtg50JQ X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-Received-From: 2a00:1450:4010:c03::22c X-BeenThere: emacs-diffs@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: Mailing list for Emacs changes List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-diffs-bounces+gnu-emacs-diffs=m.gmane.org@gnu.org Original-Sender: emacs-diffs-bounces+gnu-emacs-diffs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.diffs:129745 gmane.emacs.devel:185074 Archived-At: I'm getting an error when requiring yasnippet now "(cadar something) is not a valid place expression", and I suspect this may be the commit that caused it. 2015-04-05 13:50 GMT+01:00 Alan Mackenzie : > branch: master > commit 2056db3fada56038664c4fa079ef1e034f64e3a5 > Author: Alan Mackenzie > Commit: Alan Mackenzie > > Rationalize use of c[ad]+r, expunging cl-c[ad]\{3,4\}r. > > Also expunge eudc-c[ad]+r. > > * subr.el (internal--compiler-macro-cXXr): "New" function, copied > from cl--compiler-macro-cXXr. > (caar, cadr, cdar, cddr): Change from defsubsts to defuns with > the above compiler-macro. > > * net/eudc.el (eudc-cadr, eudc-cdar, eudc-caar, eudc-cdaar): Remove. > > * emacs-lisp/cl.el (Top level dolist doing defaliases): Remove > caaar, etc., from list of new alias functions. > > * emacs-lisp/cl-lib.el (cl-caaar, etc): Rename to caaar, etc. > (gen-cXXr--rawname, gen-cXXr-all-cl-aliases): New function/macro > which generate obsolete cl- aliases for caaar, etc. Invoke them. > > * desktop.el: > * edmacro.el: > * emacs-lisp/cl-macs.el: > * frameset.el: > * ibuffer.el: > * mail/footnote.el: > * net/dbus.el: > * net/eudc-export.el: > * net/eudc.el: > * net/eudcb-ph.el: > * net/rcirc.el: > * net/secrets.el: > * play/5x5.el: > * play/decipher.el: > * play/hanoi.el: > * progmodes/hideif.el: > * ses.el: Replace cl-caaar, eudc-cadr, etc. with caaar and cadr, etc. > --- > lisp/ChangeLog | 38 +++++++++++++++++++ > lisp/desktop.el | 2 +- > lisp/edmacro.el | 2 +- > lisp/emacs-lisp/cl-lib.el | 85 ++++++++++++++++++++++++++++++------------- > lisp/emacs-lisp/cl-macs.el | 53 ++++++++++++++------------- > lisp/emacs-lisp/cl.el | 38 ++++---------------- > lisp/frameset.el | 2 +- > lisp/ibuffer.el | 4 +- > lisp/mail/footnote.el | 2 +- > lisp/net/dbus.el | 6 ++-- > lisp/net/eudc-export.el | 2 +- > lisp/net/eudc.el | 32 +++++----------- > lisp/net/eudcb-ph.el | 8 ++-- > lisp/net/rcirc.el | 18 +++++----- > lisp/net/secrets.el | 2 +- > lisp/play/5x5.el | 8 ++-- > lisp/play/decipher.el | 4 +- > lisp/play/hanoi.el | 2 +- > lisp/progmodes/hideif.el | 6 ++-- > lisp/ses.el | 2 +- > lisp/subr.el | 29 +++++++++++++-- > 21 files changed, 202 insertions(+), 143 deletions(-) > > diff --git a/lisp/ChangeLog b/lisp/ChangeLog > index 33e1456..643ea78 100644 > --- a/lisp/ChangeLog > +++ b/lisp/ChangeLog > @@ -1,3 +1,41 @@ > +2015-04-05 Alan Mackenzie > + > + Rationalize use of c[ad]+r, expunging cl-c[ad]\{3,4\}r. > + Also expunge eudc-c[ad]+r. > + > + * subr.el (internal--compiler-macro-cXXr): "New" function, copied > + from cl--compiler-macro-cXXr. > + (caar, cadr, cdar, cddr): Changed from defsubsts to defuns with > + the above compiler-macro. > + > + * net/eudc.el (eudc-cadr, eudc-cdar, eudc-caar, eudc-cdaar): Remove. > + > + * emacs-lisp/cl.el (Top level dolist doing defaliases): Remove > + caaar, etc., from list of new alias functions. > + > + * emacs-lisp/cl-lib.el (cl-caaar, etc): Rename to caaar, etc. > + (gen-cXXr--rawname, gen-cXXr-all-cl-aliases): New function/macro > + which generate obsolete cl- aliases for caaar, etc. Invoke them. > + > + * desktop.el: > + * edmacro.el: > + * emacs-lisp/cl-macs.el: > + * frameset.el: > + * ibuffer.el: > + * mail/footnote.el: > + * net/dbus.el: > + * net/eudc-export.el: > + * net/eudc.el: > + * net/eudcb-ph.el: > + * net/rcirc.el: > + * net/secrets.el: > + * play/5x5.el: > + * play/decipher.el: > + * play/hanoi.el: > + * progmodes/hideif.el: > + * ses.el: Replace cl-caaar, eudc-cadr, etc. with caaar and cadr, > + etc. > + > 2015-04-05 Richard Stallman > > * mail/rmail.el (rmail-show-message-1): When displaying a mime message, > diff --git a/lisp/desktop.el b/lisp/desktop.el > index 3eca5a6..4b76052 100644 > --- a/lisp/desktop.el > +++ b/lisp/desktop.el > @@ -1468,7 +1468,7 @@ after that many seconds of idle time." > (dolist (record compacted-vars) > (let* > ((var (car record)) > - (deser-fun (cl-caddr (assq var desktop-var-serdes-funs)))) > + (deser-fun (caddr (assq var desktop-var-serdes-funs)))) > (if deser-fun (set var (funcall deser-fun (cadr record)))))))) > result)))) > > diff --git a/lisp/edmacro.el b/lisp/edmacro.el > index 84dfd4f..d759160 100644 > --- a/lisp/edmacro.el > +++ b/lisp/edmacro.el > @@ -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 (cl-cadadr ev) '(menu-bar)) > + ((equal (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. > diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el > index 10651cc..3ee5e04 100644 > --- a/lisp/emacs-lisp/cl-lib.el > +++ b/lisp/emacs-lisp/cl-lib.el > @@ -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 'cl-caddr "Return the third element of the list X.") > -(cl--defalias 'cl-fourth 'cl-cadddr "Return the fourth element of the list 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.") > > (defsubst cl-fifth (x) > "Return the fifth element of the list X." > @@ -418,126 +418,159 @@ Signal an error if X is not a list." > (declare (gv-setter (lambda (store) `(setcar (nthcdr 9 ,x) ,store)))) > (nth 9 x)) > > -(defun cl-caaar (x) > +(defun caaar (x) > "Return the `car' of the `car' of the `car' of X." > (declare (compiler-macro cl--compiler-macro-cXXr)) > (car (car (car x)))) > > -(defun cl-caadr (x) > +(defun caadr (x) > "Return the `car' of the `car' of the `cdr' of X." > (declare (compiler-macro cl--compiler-macro-cXXr)) > (car (car (cdr x)))) > > -(defun cl-cadar (x) > +(defun cadar (x) > "Return the `car' of the `cdr' of the `car' of X." > (declare (compiler-macro cl--compiler-macro-cXXr)) > (car (cdr (car x)))) > > -(defun cl-caddr (x) > +(defun caddr (x) > "Return the `car' of the `cdr' of the `cdr' of X." > (declare (compiler-macro cl--compiler-macro-cXXr)) > (car (cdr (cdr x)))) > > -(defun cl-cdaar (x) > +(defun cdaar (x) > "Return the `cdr' of the `car' of the `car' of X." > (declare (compiler-macro cl--compiler-macro-cXXr)) > (cdr (car (car x)))) > > -(defun cl-cdadr (x) > +(defun cdadr (x) > "Return the `cdr' of the `car' of the `cdr' of X." > (declare (compiler-macro cl--compiler-macro-cXXr)) > (cdr (car (cdr x)))) > > -(defun cl-cddar (x) > +(defun cddar (x) > "Return the `cdr' of the `cdr' of the `car' of X." > (declare (compiler-macro cl--compiler-macro-cXXr)) > (cdr (cdr (car x)))) > > -(defun cl-cdddr (x) > +(defun cdddr (x) > "Return the `cdr' of the `cdr' of the `cdr' of X." > (declare (compiler-macro cl--compiler-macro-cXXr)) > (cdr (cdr (cdr x)))) > > -(defun cl-caaaar (x) > +(defun caaaar (x) > "Return the `car' of the `car' of the `car' of the `car' of X." > (declare (compiler-macro cl--compiler-macro-cXXr)) > (car (car (car (car x))))) > > -(defun cl-caaadr (x) > +(defun caaadr (x) > "Return the `car' of the `car' of the `car' of the `cdr' of X." > (declare (compiler-macro cl--compiler-macro-cXXr)) > (car (car (car (cdr x))))) > > -(defun cl-caadar (x) > +(defun caadar (x) > "Return the `car' of the `car' of the `cdr' of the `car' of X." > (declare (compiler-macro cl--compiler-macro-cXXr)) > (car (car (cdr (car x))))) > > -(defun cl-caaddr (x) > +(defun caaddr (x) > "Return the `car' of the `car' of the `cdr' of the `cdr' of X." > (declare (compiler-macro cl--compiler-macro-cXXr)) > (car (car (cdr (cdr x))))) > > -(defun cl-cadaar (x) > +(defun cadaar (x) > "Return the `car' of the `cdr' of the `car' of the `car' of X." > (declare (compiler-macro cl--compiler-macro-cXXr)) > (car (cdr (car (car x))))) > > -(defun cl-cadadr (x) > +(defun cadadr (x) > "Return the `car' of the `cdr' of the `car' of the `cdr' of X." > (declare (compiler-macro cl--compiler-macro-cXXr)) > (car (cdr (car (cdr x))))) > > -(defun cl-caddar (x) > +(defun caddar (x) > "Return the `car' of the `cdr' of the `cdr' of the `car' of X." > (declare (compiler-macro cl--compiler-macro-cXXr)) > (car (cdr (cdr (car x))))) > > -(defun cl-cadddr (x) > +(defun cadddr (x) > "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X." > (declare (compiler-macro cl--compiler-macro-cXXr)) > (car (cdr (cdr (cdr x))))) > > -(defun cl-cdaaar (x) > +(defun cdaaar (x) > "Return the `cdr' of the `car' of the `car' of the `car' of X." > (declare (compiler-macro cl--compiler-macro-cXXr)) > (cdr (car (car (car x))))) > > -(defun cl-cdaadr (x) > +(defun cdaadr (x) > "Return the `cdr' of the `car' of the `car' of the `cdr' of X." > (declare (compiler-macro cl--compiler-macro-cXXr)) > (cdr (car (car (cdr x))))) > > -(defun cl-cdadar (x) > +(defun cdadar (x) > "Return the `cdr' of the `car' of the `cdr' of the `car' of X." > (declare (compiler-macro cl--compiler-macro-cXXr)) > (cdr (car (cdr (car x))))) > > -(defun cl-cdaddr (x) > +(defun cdaddr (x) > "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X." > (declare (compiler-macro cl--compiler-macro-cXXr)) > (cdr (car (cdr (cdr x))))) > > -(defun cl-cddaar (x) > +(defun cddaar (x) > "Return the `cdr' of the `cdr' of the `car' of the `car' of X." > (declare (compiler-macro cl--compiler-macro-cXXr)) > (cdr (cdr (car (car x))))) > > -(defun cl-cddadr (x) > +(defun cddadr (x) > "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X." > (declare (compiler-macro cl--compiler-macro-cXXr)) > (cdr (cdr (car (cdr x))))) > > -(defun cl-cdddar (x) > +(defun cdddar (x) > "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X." > (declare (compiler-macro cl--compiler-macro-cXXr)) > (cdr (cdr (cdr (car x))))) > > -(defun cl-cddddr (x) > +(defun cddddr (x) > "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X." > (declare (compiler-macro cl--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)." > diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el > index f8ddc00..fa6a4bc 100644 > --- a/lisp/emacs-lisp/cl-macs.el > +++ b/lisp/emacs-lisp/cl-macs.el > @@ -70,6 +70,9 @@ > (setq form `(cons ,(car args) ,form))) > form)) > > +;; Note: `cl--compiler-macro-cXXr' has been copied to > +;; `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)) > @@ -500,7 +503,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 (cl-cadar args)) > + (if (and cl--bind-enquote (cadar args)) > (cl--do-arglist (caar args) > `',(cadr (pop args))) > (cl--do-arglist (caar args) (cadr (pop args)))) > @@ -584,7 +587,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)) (cl-cadar arg) (car arg))) > + (varg (if (consp (car arg)) (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 > @@ -1188,10 +1191,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 (cl-caddr cl--loop-args) > + (memq (caddr cl--loop-args) > '(downto above)))) > (excl (or (memq (car cl--loop-args) '(above below)) > - (memq (cl-caddr cl--loop-args) > + (memq (caddr cl--loop-args) > '(above below)))) > (start (and (memq (car cl--loop-args) > '(from upfrom downfrom)) > @@ -1291,7 +1294,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 (cl-caadr cl--loop-args) 'index)) > + (eq (caadr cl--loop-args) 'index)) > (cadr (cl--pop2 cl--loop-args)) > (error "Bad `using' clause")) > (make-symbol "--cl-idx--")))) > @@ -1323,8 +1326,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 (cl-caadr cl--loop-args) hash-types) > - (not (eq (cl-caadr cl--loop-args) word))) > + (memq (caadr cl--loop-args) hash-types) > + (not (eq (caadr cl--loop-args) word))) > (cadr (cl--pop2 cl--loop-args)) > (error "Bad `using' clause")) > (make-symbol "--cl-var--")))) > @@ -1386,8 +1389,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 (cl-caadr cl--loop-args) key-types) > - (not (eq (cl-caadr cl--loop-args) word))) > + (memq (caadr cl--loop-args) key-types) > + (not (eq (caadr cl--loop-args) word))) > (cadr (cl--pop2 cl--loop-args)) > (error "Bad `using' clause")) > (make-symbol "--cl-var--")))) > @@ -1611,7 +1614,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 (cl-cadar p)))) > + (while (and p (or (symbolp (car-safe (car p))) (null (cadar p)))) > (setq p (cdr p))) > (when p > (setq par nil) > @@ -1686,7 +1689,7 @@ such that COMBO is equivalent to (and . CLAUSES)." > (setq clauses (cons (nconc (butlast (car clauses)) > (if (eq (car-safe (cadr clauses)) > 'progn) > - (cl-cdadr clauses) > + (cdadr clauses) > (list (cadr clauses)))) > (cddr clauses))) > ;; A final (progn ,@A t) is moved outside of the `and'. > @@ -1828,7 +1831,7 @@ from OBARRAY. > (let (,(car spec)) > (mapatoms #'(lambda (,(car spec)) ,@body) > ,@(and (cadr spec) (list (cadr spec)))) > - ,(cl-caddr spec)))) > + ,(caddr spec)))) > > ;;;###autoload > (defmacro cl-do-all-symbols (spec &rest body) > @@ -2105,9 +2108,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)) > - (cl-cadar bindings)) > + (cadar bindings)) > macroexpand-all-environment)))) > - (if (or (null (cdar bindings)) (cl-cddar bindings)) > + (if (or (null (cdar bindings)) (cddar bindings)) > (macroexp--warn-and-return > (format "Malformed `cl-symbol-macrolet' binding: %S" > (car bindings)) > @@ -2216,7 +2219,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 (cl-cadar spec) 0) > + (if (eq (cadar spec) 0) > (byte-compile-disable-warning (caar spec)) > (byte-compile-enable-warning (caar spec))))))) > nil) > @@ -2660,9 +2663,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 (cl-caadr pred-form) 'vectorp) > + (if (and (eq (caadr pred-form) 'vectorp) > (= safety 1)) > - (cons 'and (cl-cdddr pred-form)) > + (cons 'and (cdddr pred-form)) > `(,predicate cl-x)))) > (let ((pos 0) (descp descs)) > (while descp > @@ -3090,14 +3093,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 > - 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)) > + caaar caadr cadar > + caddr cdaar cdadr > + cddar cdddr caaaar > + caaadr caadar caaddr > + cadaar cadadr caddar > + cadddr cdaaar cdaadr > + cdadar cdaddr cddaar > + cddadr cdddar cddddr)) > (put y 'side-effect-free t)) > > ;;; Things that are inline. > diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el > index 5da1cea..be7b6f4 100644 > --- a/lisp/emacs-lisp/cl.el > +++ b/lisp/emacs-lisp/cl.el > @@ -259,30 +259,6 @@ > 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 > @@ -397,7 +373,7 @@ lexical closures as in Common Lisp. > (macroexpand-all > `(cl-symbol-macrolet > ,(mapcar (lambda (x) > - `(,(car x) (symbol-value ,(cl-caddr x)))) > + `(,(car x) (symbol-value ,(caddr x)))) > vars) > ,@body) > (cons (cons 'function #'cl--function-convert) > @@ -410,20 +386,20 @@ lexical closures as in Common Lisp. > ;; dynamic scoping, since with lexical scoping we'd need > ;; (let ((foo )) ...foo...). > `(progn > - ,@(mapcar (lambda (x) `(defvar ,(cl-caddr x))) vars) > - (let ,(mapcar (lambda (x) (list (cl-caddr x) (cadr x))) vars) > + ,@(mapcar (lambda (x) `(defvar ,(caddr x))) vars) > + (let ,(mapcar (lambda (x) (list (caddr x) (cadr x))) vars) > ,(cl-sublis (mapcar (lambda (x) > - (cons (cl-caddr x) > - `',(cl-caddr x))) > + (cons (caddr x) > + `',(caddr x))) > vars) > ebody))) > `(let ,(mapcar (lambda (x) > - (list (cl-caddr x) > + (list (caddr x) > `(make-symbol ,(format "--%s--" (car x))))) > vars) > (setf ,@(apply #'append > (mapcar (lambda (x) > - (list `(symbol-value ,(cl-caddr x)) (cadr x))) > + (list `(symbol-value ,(caddr x)) (cadr x))) > vars))) > ,ebody)))) > > diff --git a/lisp/frameset.el b/lisp/frameset.el > index 17fe39b..adff853 100644 > --- a/lisp/frameset.el > +++ b/lisp/frameset.el > @@ -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) (cl-cdadr (frame-monitor-attributes frame))) > + (pcase-let* ((`(,left ,top ,width ,height) (cdadr (frame-monitor-attributes frame))) > (right (+ left width -1)) > (bottom (+ top height -1)) > (fr-left (frameset-compute-pos (frame-parameter frame 'left) left right)) > diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el > index 8bd1e46..837fbae 100644 > --- a/lisp/ibuffer.el > +++ b/lisp/ibuffer.el > @@ -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))) > - (cl-caddr bufs) > + (caddr 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 (cl-caddr sortdat))) > + (func (caddr sortdat))) > (let ((result > ;; actually sort the buffers > (if (and sortdat func) > diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el > index ea67443..d841187 100644 > --- a/lisp/mail/footnote.el > +++ b/lisp/mail/footnote.el > @@ -644,7 +644,7 @@ by using `Footnote-back-to-message'." > (interactive "*P") > (let ((num > (if footnote-text-marker-alist > - (if (< (point) (cl-cadar (last footnote-pointer-marker-alist))) > + (if (< (point) (cadar (last footnote-pointer-marker-alist))) > (Footnote-make-hole) > (1+ (caar (last footnote-text-marker-alist)))) > 1))) > diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el > index b2c1ba8..4f63374 100644 > --- a/lisp/net/dbus.el > +++ b/lisp/net/dbus.el > @@ -869,7 +869,7 @@ association to the service from D-Bus." > ;; Service. > (string-equal service (cadr e)) > ;; Non-empty object path. > - (cl-caddr e) > + (caddr 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) (cl-caadr dict)) 'append))))) > + (add-to-list 'result (cons (car dict) (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 (cl-caadr entry3))) > + (setcdr entry3 (caadr entry3))) > (setcdr entry2 nil))))) > > ;; Fallback: collect the information. Slooow! > diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el > index 0e54d84..ec0914d 100644 > --- a/lisp/net/eudc-export.el > +++ b/lisp/net/eudc-export.el > @@ -174,7 +174,7 @@ LOCATION is used as the phone location for BBDB." > (condition-case err > (setq phone-list (bbdb-parse-phone-number phone)) > (error > - (if (string= "phone number unparsable." (eudc-cadr err)) > + (if (string= "phone number unparsable." (cadr err)) > (if (not (y-or-n-p (format "BBDB claims %S to be unparsable--insert anyway? " phone))) > (error "Phone number unparsable") > (setq phone-list (list (bbdb-string-trim phone)))) > diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el > index cf5d13f..ada9eae 100644 > --- a/lisp/net/eudc.el > +++ b/lisp/net/eudc.el > @@ -105,18 +105,6 @@ > ;; attribute name > (defvar eudc-protocol-has-default-query-attributes nil) > > -(defun eudc-cadr (obj) > - (car (cdr obj))) > - > -(defun eudc-cdar (obj) > - (cdr (car obj))) > - > -(defun eudc-caar (obj) > - (car (car obj))) > - > -(defun eudc-cdaar (obj) > - (cdr (car (car obj)))) > - > (defun eudc-plist-member (plist prop) > "Return t if PROP has a value specified in PLIST." > (if (not (= 0 (% (length plist) 2))) > @@ -555,10 +543,10 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'." > > ;; Search for multiple records > (while (and rec > - (not (listp (eudc-cdar rec)))) > + (not (listp (cdar rec)))) > (setq rec (cdr rec))) > > - (if (null (eudc-cdar rec)) > + (if (null (cdar rec)) > (list record) ; No duplicate attrs in this record > (mapc (function > (lambda (field) > @@ -590,7 +578,7 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'." > ((eq 'first method) > (setq result > (eudc-add-field-to-records (cons (car field) > - (eudc-cadr field)) > + (cadr field)) > result))) > ((eq 'concat method) > (setq result > @@ -710,7 +698,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 (eudc-cdaar result)) > + (setq email (cdaar result)) > (error "Multiple match--use the query form")) > (if error > (if email > @@ -728,7 +716,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 (eudc-cdaar result)) > + (setq phone (cdaar result)) > (error "Multiple match--use the query form")) > (if error > (if phone > @@ -765,8 +753,8 @@ otherwise a list of symbols is returned." > ;; If the same attribute appears more than once, merge > ;; the corresponding values > (while query-alist > - (setq key (eudc-caar query-alist) > - val (eudc-cdar query-alist) > + (setq key (caar query-alist) > + val (cdar query-alist) > cell (assq key query)) > (if cell > (setcdr cell (concat (cdr cell) " " val)) > @@ -863,7 +851,7 @@ see `eudc-inline-expansion-servers'" > (catch 'found > ;; Loop on the servers > (while servers > - (eudc-set-server (eudc-caar servers) (eudc-cdar servers) t) > + (eudc-set-server (caar servers) (cdar servers) t) > > ;; Determine which formats apply in the query-format list > (setq query-formats > @@ -1047,14 +1035,14 @@ queries the server for the existing fields and displays a corresponding form." > (point)) > (setq set-server-p t)) > ((and (eq (car sexp) 'setq) > - (eq (eudc-cadr sexp) 'eudc-server-hotlist)) > + (eq (cadr sexp) 'eudc-server-hotlist)) > (delete-region (save-excursion > (backward-sexp) > (point)) > (point)) > (setq set-hotlist-p t)) > ((and (eq (car sexp) 'provide) > - (equal (eudc-cadr sexp) '(quote eudc-options-file))) > + (equal (cadr sexp) '(quote eudc-options-file))) > (setq provide-p t))) > (if (and provide-p > set-hotlist-p > diff --git a/lisp/net/eudcb-ph.el b/lisp/net/eudcb-ph.el > index 1897e0b..15e15e2 100644 > --- a/lisp/net/eudcb-ph.el > +++ b/lisp/net/eudcb-ph.el > @@ -81,7 +81,7 @@ are returned" > (eudc-ph-do-request "fields") > (if full-records > (eudc-ph-parse-query-result) > - (mapcar 'eudc-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'. > @@ -126,9 +126,9 @@ Fields not in FIELDS are discarded." > (memq current-key fields)) > (if key > (setq record (cons (cons key value) record)) ; New key > - (setcdr (car record) (if (listp (eudc-cdar record)) > - (append (eudc-cdar record) (list value)) > - (list (eudc-cdar record) value)))))))) > + (setcdr (car record) (if (listp (cdar record)) > + (append (cdar record) (list value)) > + (list (cdar record) value)))))))) > (and (not ignore) > (or (null fields) > (eq 'all fields) > diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el > index 74d03f5..b418c51 100644 > --- a/lisp/net/rcirc.el > +++ b/lisp/net/rcirc.el > @@ -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 (cl-cdadr x))))))) > + (setcdr x (list (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 (cl-caddr args)) > + (reason (caddr 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 (cl-caddr args))) > + (away-message (caddr 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 (cl-caddr args))))) > + (setq rcirc-topic (caddr 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 (cl-caddr args)) > + (let ((setter (caddr args)) > (time (current-time-string > (seconds-to-time > - (string-to-number (cl-cadddr args)))))) > + (string-to-number (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) (cl-caddr args))) > + (rcirc-print process sender "477" (cadr args) (caddr 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 (cl-caddr i)) > + (nick (caddr i)) > (method (cadr i)) > - (args (cl-cdddr i))) > + (args (cdddr i))) > (when (and (string-match server rcirc-server)) > (if (and (memq method '(nickserv chanserv bitlbee)) > (string-match nick rcirc-nick)) > diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el > index 45caf7c..f7bb91b 100644 > --- a/lisp/net/secrets.el > +++ b/lisp/net/secrets.el > @@ -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 > - (cl-caddr > + (caddr > (dbus-call-method > :session secrets-service item-path secrets-interface-item > "GetSecret" :object-path secrets-session-path)))))) > diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el > index 0258f1e..8b1b217 100644 > --- a/lisp/play/5x5.el > +++ b/lisp/play/5x5.el > @@ -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 (cl-cdadr 5x5-solver-output))) > + (let ((solution-grid (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 > - ;; (cl-cadadr '(vec (mod x 2))) => x > - (lambda (r x) (+ (if (integerp r) r (cl-cadadr r)) > - (cl-cadadr x))) > + ;; (cadadr '(vec (mod x 2))) => x > + (lambda (r x) (+ (if (integerp r) r (cadadr r)) > + (cadadr x))) > solution); car > (5x5-vec-to-grid > (calcFunc-arrange solution 5x5-grid-size));cdr > diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el > index f42ae90..98a3ae2 100644 > --- a/lisp/play/decipher.el > +++ b/lisp/play/decipher.el > @@ -792,8 +792,8 @@ TOTAL is the total number of letters in the ciphertext." > (while temp-list > (insert (caar temp-list) > (format "%4d%3d%% " > - (cl-cadar temp-list) > - (/ (* 100 (cl-cadar temp-list)) total))) > + (cadar temp-list) > + (/ (* 100 (cadar temp-list)) total))) > (setq temp-list (nthcdr 4 temp-list))) > (insert ?\n) > (setq freq-list (cdr freq-list) > diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el > index b868db6..d273445 100644 > --- a/lisp/play/hanoi.el > +++ b/lisp/play/hanoi.el > @@ -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) (cl-caddr poles) > + (hanoi-n bits rings (car poles) (cadr poles) (caddr poles) > start-time)) > (message "Done")) > (setq buffer-read-only t) > diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el > index 7f2fd92..64913c2 100644 > --- a/lisp/progmodes/hideif.el > +++ b/lisp/progmodes/hideif.el > @@ -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 (cl-caddr tokens) 'hif-rparen)) > - (setq tokens (cl-cdddr tokens)) > + (eq (caddr tokens) 'hif-rparen)) > + (setq tokens (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 > - (cl-caddr rep) ; Macro's token list > + (caddr rep) ; Macro's token list > tok expand_list)) > ;; Replace all remaining references immediately > (setq remains (cl-substitute tok rep remains)) > diff --git a/lisp/ses.el b/lisp/ses.el > index b0a09ff..f42b61c 100644 > --- a/lisp/ses.el > +++ b/lisp/ses.el > @@ -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 ,@(cl-cdddr range))))) > + `(ses-range ,min ,max ,@(cdddr range))))) > > (defun ses-relocate-all (minrow mincol rowincr colincr) > "Alter all cell values, symbols, formulas, and reference-lists to relocate > diff --git a/lisp/subr.el b/lisp/subr.el > index 163a1c4..00acdb6 100644 > --- a/lisp/subr.el > +++ b/lisp/subr.el > @@ -339,20 +339,41 @@ configuration." > > ;;;; List functions. > > -(defsubst caar (x) > +;; Note: `internal--compiler-macro-cXXr' was copied from > +;; `cl--compiler-macro-cXXr' in cl-macs.el. If you amend either one, > +;; you may want to amend the other, too. > +(defun internal--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))) > + (internal--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))) > + > +(defun caar (x) > "Return the car of the car of X." > + (declare (compiler-macro internal--compiler-macro-cXXr)) > (car (car x))) > > -(defsubst cadr (x) > +(defun cadr (x) > "Return the car of the cdr of X." > + (declare (compiler-macro internal--compiler-macro-cXXr)) > (car (cdr x))) > > -(defsubst cdar (x) > +(defun cdar (x) > "Return the cdr of the car of X." > + (declare (compiler-macro internal--compiler-macro-cXXr)) > (cdr (car x))) > > -(defsubst cddr (x) > +(defun cddr (x) > "Return the cdr of the cdr of X." > + (declare (compiler-macro internal--compiler-macro-cXXr)) > (cdr (cdr x))) > > (defun last (list &optional n) > > _______________________________________________ > Emacs-diffs mailing list > Emacs-diffs@gnu.org > https://lists.gnu.org/mailman/listinfo/emacs-diffs