1 ;;; cl.el --- Compatibility aliases for the old CL library.
3 ;; Copyright (C) 2012 Free Software Foundation, Inc.
5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
6 ;; Keywords: extensions
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;; This is a compatibility file which provides the old names provided by CL
26 ;; before we cleaned up its namespace usage.
33 ;; (defun cl--rename ()
36 ;; (case-fold-search nil)
37 ;; (files '("cl.el" "cl-macs.el" "cl-seq.el" "cl-extra.el")))
38 ;; (dolist (file files)
39 ;; (with-current-buffer (find-file-noselect file)
40 ;; (goto-char (point-min))
41 ;; (while (re-search-forward
42 ;; "^(\\(def[^ \t\n]*\\) +'?\\(\\(\\sw\\|\\s_\\)+\\)" nil t)
43 ;; (let ((name (match-string-no-properties 2))
44 ;; (type (match-string-no-properties 1)))
45 ;; (unless (string-match-p "\\`cl-" name)
47 ;; ((member type '("defvar" "defconst"))
48 ;; (unless (member name vdefs) (push name vdefs)))
49 ;; ((member type '("defun" "defsubst" "defalias" "defmacro"))
50 ;; (unless (member name fdefs) (push name fdefs)))
51 ;; ((member type '("def-edebug-spec" "defsetf" "define-setf-method"
52 ;; "define-compiler-macro"))
54 ;; (t (error "Unknown type %S" type))))))))
55 ;; (let ((re (concat "\\_<" (regexp-opt (append vdefs fdefs)) "\\_>"))
57 ;; (dolist (file files)
58 ;; (with-current-buffer (find-file-noselect file)
59 ;; (goto-char (point-min))
60 ;; (while (re-search-forward re nil t)
61 ;; (replace-match "cl-\\&"))
63 ;; (with-current-buffer (find-file-noselect "cl-rename.el")
64 ;; (dolist (def vdefs)
65 ;; (insert (format "(defvaralias '%s 'cl-%s)\n" def def)))
66 ;; (dolist (def fdefs)
67 ;; (insert (format "(defalias '%s 'cl-%s)\n" def def)))
70 ;; (defun cl--unrename ()
71 ;; ;; Taken from "Naming Conventions" node of the doc.
72 ;; (let* ((names '(defun* defsubst* defmacro* function* member*
73 ;; assoc* rassoc* get* remove* delete*
74 ;; mapcar* sort* floor* ceiling* truncate*
75 ;; round* mod* rem* random*))
76 ;; (files '("cl.el" "cl-lib.el" "cl-macs.el" "cl-seq.el" "cl-extra.el"))
77 ;; (re (concat "\\_<cl-" (regexp-opt (mapcar #'symbol-name names))
79 ;; (dolist (file files)
80 ;; (with-current-buffer (find-file-noselect file)
81 ;; (goto-char (point-min))
82 ;; (while (re-search-forward re nil t)
83 ;; (delete-region (1- (point)) (point)))
86 ;;; Aliases to cl-lib's features.
97 ;; lambda-list-keywords
98 float-negative-epsilon
100 least-negative-normalized-float
101 least-positive-normalized-float
106 ;; custom-print-functions
108 (defvaralias var
(intern (format "cl-%s" var
))))
110 ;; Before overwriting subr.el's `dotimes' and `dolist', let's remember
111 ;; them under a different name, so we can use them in our implementation
112 ;; of `dotimes' and `dolist'.
113 (unless (fboundp 'cl--dotimes
)
114 (defalias 'cl--dotimes
(symbol-function 'dotimes
) "The non-CL `dotimes'."))
115 (unless (fboundp 'cl--dolist
)
116 (defalias 'cl--dolist
(symbol-function 'dolist
) "The non-CL `dolist'."))
120 (random* . cl-random
)
124 (truncate* . cl-truncate
)
125 (ceiling* . cl-ceiling
)
127 (rassoc* . cl-rassoc
)
129 (member* . cl-member
)
130 (delete* . cl-delete
)
131 (remove* . cl-remove
)
132 (defsubst* . cl-defsubst
)
134 (function* . cl-function
)
135 (defmacro* . cl-defmacro
)
137 (mapcar* . cl-mapcar
)
216 define-compiler-macro
230 (define-setf-method . define-setf-expander
)
322 (let ((new (if (consp fun
) (prog1 (cdr fun
) (setq fun
(car fun
)))
323 (intern (format "cl-%s" fun
)))))
325 ;; If `cl-foo' is declare inline, then make `foo' inline as well, and
326 ;; similarly. Same for edebug specifications, indent rules and
327 ;; doc-string position.
328 ;; FIXME: For most of them, we should instead follow aliases
330 (dolist (prop '(byte-optimizer doc-string-elt edebug-form-spec
331 lisp-indent-function
))
333 (put fun prop
(get new prop
))))))
335 ;;; Features provided a bit differently in Elisp.
337 ;; First, the old lexical-let is now better served by `lexical-binding', tho
338 ;; it's not 100% compatible.
340 (defvar cl-closure-vars nil
)
341 (defvar cl--function-convert-cache nil
)
343 (defun cl--function-convert (f)
344 "Special macro-expander for special cases of (function F).
345 The two cases that are handled are:
346 - closure-conversion of lambda expressions for `lexical-let'.
347 - renaming of F when it's a function defined via `cl-labels' or `labels'."
349 (declare-function cl--expr-contains-any
"cl-macs" (x y
))
351 ;; ¡¡Big Ugly Hack!! We can't use a compiler-macro because those are checked
352 ;; *after* handling `function', but we want to stop macroexpansion from
353 ;; being applied infinitely, so we use a cache to return the exact `form'
354 ;; being expanded even though we don't receive it.
355 ((eq f
(car cl--function-convert-cache
)) (cdr cl--function-convert-cache
))
356 ((eq (car-safe f
) 'lambda
)
357 (let ((body (mapcar (lambda (f)
358 (macroexpand-all f macroexpand-all-environment
))
360 (if (and cl-closure-vars
361 (cl--expr-contains-any body cl-closure-vars
))
362 (let* ((new (mapcar 'cl-gensym cl-closure-vars
))
363 (sub (cl-pairlis cl-closure-vars new
)) (decls nil
))
364 (while (or (stringp (car body
))
365 (eq (car-safe (car body
)) 'interactive
))
366 (push (list 'quote
(pop body
)) decls
))
367 (put (car (last cl-closure-vars
)) 'used t
)
368 `(list 'lambda
'(&rest --cl-rest--
)
369 ,@(cl-sublis sub
(nreverse decls
))
372 #'(lambda ,(append new
(cadr f
))
373 ,@(cl-sublis sub body
)))
374 ,@(nconc (mapcar (lambda (x) `(list 'quote
,x
))
376 '((quote --cl-rest--
))))))
377 (let* ((newf `(lambda ,(cadr f
) ,@body
))
378 (res `(function ,newf
)))
379 (setq cl--function-convert-cache
(cons newf res
))
382 (let ((found (assq f macroexpand-all-environment
)))
383 (if (and found
(ignore-errors
384 (eq (cadr (cl-caddr found
)) 'cl-labels-args
)))
385 (cadr (cl-caddr (cl-cadddr found
)))
386 (let ((res `(function ,f
)))
387 (setq cl--function-convert-cache
(cons f res
))
390 (defmacro lexical-let
(bindings &rest body
)
391 "Like `let', but lexically scoped.
392 The main visible difference is that lambdas inside BODY will create
393 lexical closures as in Common Lisp.
394 \n(fn BINDINGS BODY)"
395 (declare (indent 1) (debug let
))
396 (let* ((cl-closure-vars cl-closure-vars
)
397 (vars (mapcar (function
399 (or (consp x
) (setq x
(list x
)))
400 (push (make-symbol (format "--cl-%s--" (car x
)))
402 (set (car cl-closure-vars
) [bad-lexical-ref
])
403 (list (car x
) (cadr x
) (car cl-closure-vars
))))
409 `(,(car x
) (symbol-value ,(cl-caddr x
))))
412 (cons (cons 'function
#'cl--function-convert
)
413 macroexpand-all-environment
))))
414 (if (not (get (car (last cl-closure-vars
)) 'used
))
415 ;; Turn (let ((foo (cl-gensym)))
416 ;; (set foo <val>) ...(symbol-value foo)...)
417 ;; into (let ((foo <val>)) ...(symbol-value 'foo)...).
418 ;; This is good because it's more efficient but it only works with
419 ;; dynamic scoping, since with lexical scoping we'd need
420 ;; (let ((foo <val>)) ...foo...).
422 ,@(mapcar (lambda (x) `(defvar ,(cl-caddr x
))) vars
)
423 (let ,(mapcar (lambda (x) (list (cl-caddr x
) (cadr x
))) vars
)
424 ,(cl-sublis (mapcar (lambda (x)
429 `(let ,(mapcar (lambda (x)
431 `(make-symbol ,(format "--%s--" (car x
)))))
433 (setf ,@(apply #'append
435 (list `(symbol-value ,(cl-caddr x
)) (cadr x
)))
439 (defmacro lexical-let
* (bindings &rest body
)
440 "Like `let*', but lexically scoped.
441 The main visible difference is that lambdas inside BODY, and in
442 successive bindings within BINDINGS, will create lexical closures
443 as in Common Lisp. This is similar to the behavior of `let*' in
445 \n(fn BINDINGS BODY)"
446 (declare (indent 1) (debug let
))
447 (if (null bindings
) (cons 'progn body
)
448 (setq bindings
(reverse bindings
))
450 (setq body
(list `(lexical-let (,(pop bindings
)) ,@body
))))
453 ;; This should really have some way to shadow 'byte-compile properties, etc.
454 (defmacro flet
(bindings &rest body
)
455 "Make temporary function definitions.
456 This is an analogue of `let' that operates on the function cell of FUNC
457 rather than its value cell. The FORMs are evaluated with the specified
458 function definitions in place, then the definitions are undone (the FUNCs
459 go back to their previous definitions, or lack thereof).
461 \(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
462 (declare (indent 1) (debug cl-flet
))
465 (if (or (and (fboundp (car x
))
466 (eq (car-safe (symbol-function (car x
))) 'macro
))
467 (cdr (assq (car x
) macroexpand-all-environment
)))
468 (error "Use `labels', not `flet', to rebind macro names"))
469 (let ((func `(cl-function
471 (cl-block ,(car x
) ,@(cddr x
))))))
472 (when (cl--compiling-file)
473 ;; Bug#411. It would be nice to fix this.
474 (and (get (car x
) 'byte-compile
)
475 (error "Byte-compiling a redefinition of `%s' \
476 will not work - use `labels' instead" (symbol-name (car x
))))
477 ;; FIXME This affects the rest of the file, when it
478 ;; should be restricted to the flet body.
479 (and (boundp 'byte-compile-function-environment
)
480 (push (cons (car x
) (eval func
))
481 byte-compile-function-environment
)))
482 (list `(symbol-function ',(car x
)) func
)))
486 (defmacro labels
(bindings &rest body
)
487 "Make temporary function bindings.
488 This is like `flet', except the bindings are lexical instead of dynamic.
489 Unlike `flet', this macro is fully compliant with the Common Lisp standard.
491 \(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
492 (declare (indent 1) (debug cl-flet
))
493 (let ((vars nil
) (sets nil
) (newenv macroexpand-all-environment
))
494 (dolist (binding bindings
)
495 ;; It's important that (not (eq (symbol-name var1) (symbol-name var2)))
496 ;; because these var's *names* get added to the macro-environment.
497 (let ((var (make-symbol (format "--cl-%s--" (car binding
)))))
499 (push `(cl-function (lambda .
,(cdr binding
))) sets
)
501 (push (cons (car binding
)
502 `(lambda (&rest cl-labels-args
)
503 (cl-list* 'funcall
',var
506 (macroexpand-all `(lexical-let ,vars
(setq ,@sets
) ,@body
) newenv
)))
508 ;; Generalized variables are provided by gv.el, but some details are
509 ;; not 100% compatible: not worth the trouble to add them to cl-lib.el, but we
510 ;; still to support old users of cl.el.
512 ;; FIXME: `letf' is unsatisfactory because it does not really "restore" the
513 ;; previous state. If the getter/setter loses information, that info is
516 (defun cl--letf (bindings simplebinds binds body
)
517 ;; It's not quite clear what the semantics of let! should be.
518 ;; E.g. in (let! ((PLACE1 VAL1) (PLACE2 VAL2)) BODY), while it's clear
519 ;; that the actual assignments ("bindings") should only happen after
520 ;; evaluating VAL1 and VAL2, it's not clear when the sub-expressions of
521 ;; PLACE1 and PLACE2 should be evaluated. Should we have
522 ;; PLACE1; VAL1; PLACE2; VAL2; bind1; bind2
524 ;; VAL1; VAL2; PLACE1; PLACE2; bind1; bind2
526 ;; VAL1; VAL2; PLACE1; bind1; PLACE2; bind2
527 ;; Common-Lisp's `psetf' does the first, so we'll do the same.
529 (if (and (null binds
) (null simplebinds
)) (macroexp-progn body
)
530 `(let* (,@(mapcar (lambda (x)
531 (pcase-let ((`(,vold
,getter
,_setter
,_vnew
) x
))
536 ,(macroexp-progn (append
537 (mapcar (lambda (x) (pcase x
538 (`(,_vold
,_getter
,setter
,vnew
)
539 (funcall setter vnew
))))
542 ,@(mapcar (lambda (x) (pcase-let ((`(,vold
,_getter
,setter
,_vnew
) x
))
543 (funcall setter vold
)))
545 (let ((binding (car bindings
)))
546 (gv-letplace (getter setter
) (car binding
)
547 (macroexp-let2 nil vnew
(cadr binding
)
548 (if (symbolp (car binding
))
549 ;; Special-case for simple variables.
550 (cl--letf (cdr bindings
)
551 (cons `(,getter
,(if (cdr binding
) vnew getter
))
554 (cl--letf (cdr bindings
) simplebinds
555 (cons `(,(make-symbol "old") ,getter
,setter
556 ,@(if (cdr binding
) (list vnew
)))
560 (defmacro letf
(bindings &rest body
)
561 "Temporarily bind to PLACEs.
562 This is the analogue of `let', but with generalized variables (in the
563 sense of `setf') for the PLACEs. Each PLACE is set to the corresponding
564 VALUE, then the BODY forms are executed. On exit, either normally or
565 because of a `throw' or error, the PLACEs are set back to their original
566 values. Note that this macro is *not* available in Common Lisp.
567 As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
568 the PLACE is not modified before executing BODY.
570 \(fn ((PLACE VALUE) ...) BODY...)"
571 (declare (indent 1) (debug ((&rest
(gate gv-place
&optional form
)) body
)))
572 (cl--letf bindings
() () body
))
574 (defun cl--letf* (bindings body
)
576 (macroexp-progn body
)
577 (let ((binding (car bindings
)))
578 (if (symbolp (car binding
))
579 ;; Special-case for simple variables.
580 (macroexp-let* (list (if (cdr binding
) binding
581 (list (car binding
) (car binding
))))
582 (cl--letf* (cdr bindings
) body
))
583 (gv-letplace (getter setter
) (car binding
)
584 (macroexp-let2 macroexp-copyable-p vnew
(cadr binding
)
585 (macroexp-let2 nil vold getter
588 ,(if (cdr binding
) (funcall setter vnew
))
589 ,(cl--letf* (cdr bindings
) body
))
590 ,(funcall setter vold
)))))))))
592 (defmacro letf
* (bindings &rest body
)
593 (declare (indent 1) (debug letf
))
594 (cl--letf* bindings body
))
596 (defun cl--gv-adapt (cl-gv do
)
597 ;; This function is used by all .elc files that use define-setf-expander and
598 ;; were compiled with Emacs>=24.2.
599 (let ((vars (nth 0 cl-gv
))
603 ;; Use cl-sublis as was done in cl-setf-do-modify.
605 (if (macroexp-copyable-p (car vals
))
606 (push (cons (pop vars
) (pop vals
)) substs
)
607 (push (list (pop vars
) (pop vals
)) binds
)))
610 (funcall do
(cl-sublis substs
(nth 4 cl-gv
))
611 ;; We'd like to do something like
612 ;; (lambda ,(nth 2 cl-gv) ,(nth 3 cl-gv)).
614 (macroexp-let2 macroexp-copyable-p v exp
615 (cl-sublis (cons (cons (car (nth 2 cl-gv
)) v
)
619 (defmacro define-setf-expander
(name arglist
&rest body
)
620 "Define a `setf' method.
621 This method shows how to handle `setf's to places of the form (NAME ARGS...).
622 The argument forms ARGS are bound according to ARGLIST, as if NAME were
623 going to be expanded as a macro, then the BODY forms are executed and must
624 return a list of five elements: a temporary-variables list, a value-forms
625 list, a store-variables list (of length one), a store-form, and an access-
626 form. See `gv-define-expander', `gv-define-setter', and `gv-define-expander'
627 for a better and simpler ways to define setf-methods."
629 (&define name cl-lambda-list cl-declarations-or-string def-body
)))
631 ,@(if (stringp (car body
))
632 (list `(put ',name
'setf-documentation
,(pop body
))))
633 (gv-define-expander ,name
635 (lambda (do ,@arglist
)
636 (cl--gv-adapt (progn ,@body
) do
))))))
638 (defmacro defsetf
(name arg1
&rest args
)
639 "Define a `setf' method.
640 This macro is an easy-to-use substitute for `define-setf-expander' that works
641 well for simple place forms. In the simple `defsetf' form, `setf's of
642 the form (setf (NAME ARGS...) VAL) are transformed to function or macro
643 calls of the form (FUNC ARGS... VAL). Example:
645 (cl-defsetf aref aset)
647 Alternate form: (cl-defsetf NAME ARGLIST (STORE) BODY...).
648 Here, the above `setf' call is expanded by binding the argument forms ARGS
649 according to ARGLIST, binding the value form VAL to STORE, then executing
650 BODY, which must return a Lisp form that does the necessary `setf' operation.
651 Actually, ARGLIST and STORE may be bound to temporary variables which are
652 introduced automatically to preserve proper execution order of the arguments.
655 (cl-defsetf nth (n x) (v) `(setcar (nthcdr ,n ,x) ,v))
657 \(fn NAME [FUNC | ARGLIST (STORE) BODY...])"
660 [&or
[symbolp
&optional stringp
]
661 [cl-lambda-list
(symbolp)]]
662 cl-declarations-or-string def-body
)))
663 (if (and (listp arg1
) (consp args
))
664 ;; Like `gv-define-setter' but with `cl-function'.
665 `(gv-define-expander ,name
666 (lambda (do &rest args
)
667 (gv--defsetter ',name
669 (lambda (,@(car args
) ,@arg1
) ,@(cdr args
)))
671 `(gv-define-simple-setter ,name
,arg1
)))
673 ;; FIXME: CL used to provide a setf method for `apply', but I haven't been able
674 ;; to find a case where it worked. The code below tries to handle it as well.
675 ;; (defun cl--setf-apply (form last-witness last)
677 ;; ((not (consp form)) form)
678 ;; ((eq (ignore-errors (car (last form))) last-witness)
679 ;; `(apply #',(car form) ,@(butlast (cdr form)) ,last))
680 ;; ((and (memq (car form) '(let let*))
681 ;; (rassoc (list last-witness) (cadr form)))
682 ;; (let ((rebind (rassoc (list last-witness) (cadr form))))
683 ;; `(,(car form) ,(remq rebind (cadr form))
684 ;; ,@(mapcar (lambda (form) (cl--setf-apply form (car rebind) last))
686 ;; (t (mapcar (lambda (form) (cl--setf-apply form last-witness last)) form))))
687 ;; (gv-define-setter apply (val fun &rest args)
688 ;; (pcase fun (`#',(and (pred symbolp) f) (setq fun f))
689 ;; (_ (error "First arg to apply in setf is not #'SYM: %S" fun)))
690 ;; (let* ((butlast (butlast args))
691 ;; (last (car (last args)))
692 ;; (last-witness (make-symbol "--cl-tailarg--"))
693 ;; (setter (macroexpand `(setf (,fun ,@butlast ,last-witness) ,val)
694 ;; macroexpand-all-environment)))
695 ;; (cl--setf-apply setter last-witness last)))
698 ;; FIXME: CL used to provide get-setf-method, which was used by some
699 ;; setf-expanders, but now that we use gv.el, it is a lot more difficult
700 ;; and in general impossible to provide get-setf-method. Hopefully, it
701 ;; won't be needed. If needed, we'll have to do something nasty along the
703 ;; (defun get-setf-method (place &optional env)
704 ;; (let* ((witness (list 'cl-gsm))
705 ;; (expansion (gv-letplace (getter setter) place
706 ;; `(,witness ,getter ,(funcall setter witness)))))
707 ;; ...find "let prefix" of expansion, extract getter and setter from
708 ;; ...the rest, and build the 5-tuple))
709 (make-obsolete 'get-setf-method
'gv-letplace
"24.2")
711 (defmacro define-modify-macro
(name arglist func
&optional doc
)
712 "Define a `setf'-like modify macro.
713 If NAME is called, it combines its PLACE argument with the other arguments
714 from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)"
716 (&define name cl-lambda-list
;; should exclude &key
717 symbolp
&optional stringp
)))
718 (if (memq '&key arglist
)
719 (error "&key not allowed in define-modify-macro"))
720 (let ((place (make-symbol "--cl-place--")))
721 `(cl-defmacro ,name
(,place
,@arglist
)
723 (,(if (memq '&rest arglist
) #'cl-list
* #'list
)
724 #'cl-callf
',func
,place
725 ,@(cl--arglist-args arglist
)))))
727 ;;; Additional compatibility code.
728 ;; For names that were clean but really aren't needed any more.
730 (define-obsolete-function-alias 'cl-macroexpand
'macroexpand
"24.2")
731 (define-obsolete-variable-alias 'cl-macro-environment
732 'macroexpand-all-environment
"24.2")
733 (define-obsolete-function-alias 'cl-macroexpand-all
'macroexpand-all
"24.2")
736 ;; This is just kept for compatibility with code byte-compiled by Emacs-20.
738 ;; No idea if this might still be needed.
739 (defun cl-not-hash-table (x &optional y
&rest z
)
740 (declare (obsolete nil
"24.2"))
741 (signal 'wrong-type-argument
(list 'cl-hash-table-p
(or y x
))))
743 (defvar cl-builtin-gethash
(symbol-function 'gethash
))
744 (make-obsolete-variable 'cl-builtin-gethash nil
"24.2")
745 (defvar cl-builtin-remhash
(symbol-function 'remhash
))
746 (make-obsolete-variable 'cl-builtin-remhash nil
"24.2")
747 (defvar cl-builtin-clrhash
(symbol-function 'clrhash
))
748 (make-obsolete-variable 'cl-builtin-clrhash nil
"24.2")
749 (defvar cl-builtin-maphash
(symbol-function 'maphash
))
751 (make-obsolete-variable 'cl-builtin-maphash nil
"24.2")
752 (define-obsolete-function-alias 'cl-map-keymap
'map-keymap
"24.2")
753 (define-obsolete-function-alias 'cl-copy-tree
'copy-tree
"24.2")
754 (define-obsolete-function-alias 'cl-gethash
'gethash
"24.2")
755 (define-obsolete-function-alias 'cl-puthash
'puthash
"24.2")
756 (define-obsolete-function-alias 'cl-remhash
'remhash
"24.2")
757 (define-obsolete-function-alias 'cl-clrhash
'clrhash
"24.2")
758 (define-obsolete-function-alias 'cl-maphash
'maphash
"24.2")
759 (define-obsolete-function-alias 'cl-make-hash-table
'make-hash-table
"24.2")
760 (define-obsolete-function-alias 'cl-hash-table-p
'hash-table-p
"24.2")
761 (define-obsolete-function-alias 'cl-hash-table-count
'hash-table-count
"24.2")
763 (defun cl-maclisp-member (item list
)
764 (declare (obsolete member
"24.2"))
765 (while (and list
(not (equal item
(car list
)))) (setq list
(cdr list
)))
768 ;; Used in the expansion of the old `defstruct'.
769 (defun cl-struct-setf-expander (x name accessor pred-form pos
)
770 (declare (obsolete nil
"24.2"))
771 (let* ((temp (make-symbol "--cl-x--")) (store (make-symbol "--cl-store--")))
772 (list (list temp
) (list x
) (list store
)
775 (list `(or ,(cl-subst temp
'cl-x pred-form
)
777 "%s storing a non-%s"
779 ,(if (eq (car (get name
'cl-struct-type
)) 'vector
)
780 `(aset ,temp
,pos
,store
)
784 (while (>= (setq pos
(1- pos
)) 0)
785 (setq xx
`(cdr ,xx
)))
787 `(nthcdr ,pos
,temp
))
789 (list accessor temp
))))