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.
+2015-04-05 Alan Mackenzie <acm@muc.de>
+
+ 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 <rms@gnu.org>
* mail/rmail.el (rmail-show-message-1): When displaying a mime message,
(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))))
((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.
(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."
(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)."
(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))
(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))))
(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
(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))
(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--"))))
(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--"))))
(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--"))))
(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)
(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'.
(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)
;; 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))
((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)
(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
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.
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
(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)
;; dynamic scoping, since with lexical scoping we'd need
;; (let ((foo <val>)) ...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))))
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))
(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)))
(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)
(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)))
;; Service.
(string-equal service (cadr e))
;; Non-empty object path.
- (cl-caddr e)
+ (caddr e)
(throw :found t)))))
dbus-registered-objects-table)
nil))))
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
(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!
(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))))
;; 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)))
;; 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)
((eq 'first method)
(setq result
(eudc-add-field-to-records (cons (car field)
- (eudc-cadr field))
+ (cadr field))
result)))
((eq 'concat method)
(setq result
(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
(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
;; 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))
(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
(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
(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'.
(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)
(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)))
\f
;;; /commands these are called with 3 args: PROCESS, TARGET, which is
(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
"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
(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.
(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))
(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))
(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))))))
(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)))
;; 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
(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)
;; 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)
(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))
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))
(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
\f
;;;; 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)
projects / emacs.git / commitdiff