diff options
| author | Dave Love | 2000-05-05 20:01:01 +0000 |
|---|---|---|
| committer | Dave Love | 2000-05-05 20:01:01 +0000 |
| commit | 64a4c526f4597d4d89ff6cac775a3a5b818ad596 (patch) | |
| tree | 768f1646d2ba419db02286c79199f98549f698fa | |
| parent | 056565f7fbe975d1a942d7ecc1d994b82b403ee2 (diff) | |
| download | emacs-64a4c526f4597d4d89ff6cac775a3a5b818ad596.tar.gz emacs-64a4c526f4597d4d89ff6cac775a3a5b818ad596.zip | |
Doc fixes; mainly avoid duplicating arg
list in doc string. Don't quote keyword symbols.
| -rw-r--r-- | lisp/ChangeLog | 7 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 78 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-seq.el | 76 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl.el | 8 |
4 files changed, 87 insertions, 82 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6fcfc311566..7715ec5dfd6 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,10 @@ | |||
| 1 | 2000-05-05 Dave Love <fx@gnu.org> | ||
| 2 | |||
| 3 | * emacs-lisp/cl-macs.el: Doc fixes; mainly avoid duplicating arg | ||
| 4 | list in doc string. Don't quote keyword symbols. | ||
| 5 | * emacs-lisp/cl.el: Likewise | ||
| 6 | * emacs-lisp/cl-seq.el: Likewise | ||
| 7 | |||
| 1 | 2000-05-05 Gerd Moellmann <gerd@gnu.org> | 8 | 2000-05-05 Gerd Moellmann <gerd@gnu.org> |
| 2 | 9 | ||
| 3 | * abbrev.el (abbrev-mode): Make ARG optional. | 10 | * abbrev.el (abbrev-mode): Make ARG optional. |
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 50b5735f6a2..3dd84648945 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el | |||
| @@ -127,7 +127,7 @@ and BODY is implicitly surrounded by (block NAME ...)." | |||
| 127 | (if (car res) (list 'progn (car res) form) form))) | 127 | (if (car res) (list 'progn (car res) form) form))) |
| 128 | 128 | ||
| 129 | (defmacro function* (func) | 129 | (defmacro function* (func) |
| 130 | "(function* SYMBOL-OR-LAMBDA): introduce a function. | 130 | "Introduce a function. |
| 131 | Like normal `function', except that if argument is a lambda form, its | 131 | Like normal `function', except that if argument is a lambda form, its |
| 132 | ARGLIST allows full Common Lisp conventions." | 132 | ARGLIST allows full Common Lisp conventions." |
| 133 | (if (eq (car-safe func) 'lambda) | 133 | (if (eq (car-safe func) 'lambda) |
| @@ -352,13 +352,13 @@ If `load' is in WHEN, BODY is evaluated when loaded after top-level compile. | |||
| 352 | If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level." | 352 | If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level." |
| 353 | (if (and (fboundp 'cl-compiling-file) (cl-compiling-file) | 353 | (if (and (fboundp 'cl-compiling-file) (cl-compiling-file) |
| 354 | (not cl-not-toplevel) (not (boundp 'for-effect))) ; horrible kludge | 354 | (not cl-not-toplevel) (not (boundp 'for-effect))) ; horrible kludge |
| 355 | (let ((comp (or (memq 'compile when) (memq ':compile-toplevel when))) | 355 | (let ((comp (or (memq 'compile when) (memq :compile-toplevel when))) |
| 356 | (cl-not-toplevel t)) | 356 | (cl-not-toplevel t)) |
| 357 | (if (or (memq 'load when) (memq ':load-toplevel when)) | 357 | (if (or (memq 'load when) (memq :load-toplevel when)) |
| 358 | (if comp (cons 'progn (mapcar 'cl-compile-time-too body)) | 358 | (if comp (cons 'progn (mapcar 'cl-compile-time-too body)) |
| 359 | (list* 'if nil nil body)) | 359 | (list* 'if nil nil body)) |
| 360 | (progn (if comp (eval (cons 'progn body))) nil))) | 360 | (progn (if comp (eval (cons 'progn body))) nil))) |
| 361 | (and (or (memq 'eval when) (memq ':execute when)) | 361 | (and (or (memq 'eval when) (memq :execute when)) |
| 362 | (cons 'progn body)))) | 362 | (cons 'progn body)))) |
| 363 | 363 | ||
| 364 | (defun cl-compile-time-too (form) | 364 | (defun cl-compile-time-too (form) |
| @@ -369,7 +369,7 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level." | |||
| 369 | (cons 'progn (mapcar 'cl-compile-time-too (cdr form)))) | 369 | (cons 'progn (mapcar 'cl-compile-time-too (cdr form)))) |
| 370 | ((eq (car-safe form) 'eval-when) | 370 | ((eq (car-safe form) 'eval-when) |
| 371 | (let ((when (nth 1 form))) | 371 | (let ((when (nth 1 form))) |
| 372 | (if (or (memq 'eval when) (memq ':execute when)) | 372 | (if (or (memq 'eval when) (memq :execute when)) |
| 373 | (list* 'eval-when (cons 'compile when) (cddr form)) | 373 | (list* 'eval-when (cons 'compile when) (cddr form)) |
| 374 | form))) | 374 | form))) |
| 375 | (t (eval form) form))) | 375 | (t (eval form) form))) |
| @@ -397,7 +397,7 @@ The result of the body appears to the compiler as a quoted constant." | |||
| 397 | ;;; Conditional control structures. | 397 | ;;; Conditional control structures. |
| 398 | 398 | ||
| 399 | (defmacro case (expr &rest clauses) | 399 | (defmacro case (expr &rest clauses) |
| 400 | "(case EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value. | 400 | "Eval EXPR and choose from CLAUSES on that value. |
| 401 | Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared | 401 | Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared |
| 402 | against each key in each KEYLIST; the corresponding BODY is evaluated. | 402 | against each key in each KEYLIST; the corresponding BODY is evaluated. |
| 403 | If no clause succeeds, case returns nil. A single atom may be used in | 403 | If no clause succeeds, case returns nil. A single atom may be used in |
| @@ -430,12 +430,12 @@ Key values are compared by `eql'." | |||
| 430 | (list 'let (list (list temp expr)) body)))) | 430 | (list 'let (list (list temp expr)) body)))) |
| 431 | 431 | ||
| 432 | (defmacro ecase (expr &rest clauses) | 432 | (defmacro ecase (expr &rest clauses) |
| 433 | "(ecase EXPR CLAUSES...): like `case', but error if no case fits. | 433 | "Like `case', but error if no case fits. |
| 434 | `otherwise'-clauses are not allowed." | 434 | `otherwise'-clauses are not allowed." |
| 435 | (list* 'case expr (append clauses '((ecase-error-flag))))) | 435 | (list* 'case expr (append clauses '((ecase-error-flag))))) |
| 436 | 436 | ||
| 437 | (defmacro typecase (expr &rest clauses) | 437 | (defmacro typecase (expr &rest clauses) |
| 438 | "(typecase EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value. | 438 | "Evals EXPR, chooses from CLAUSES on that value. |
| 439 | Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it | 439 | Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it |
| 440 | satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds, | 440 | satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds, |
| 441 | typecase returns nil. A TYPE of `t' or `otherwise' is allowed only in the | 441 | typecase returns nil. A TYPE of `t' or `otherwise' is allowed only in the |
| @@ -460,7 +460,7 @@ final clause, and matches if no other keys match." | |||
| 460 | (list 'let (list (list temp expr)) body)))) | 460 | (list 'let (list (list temp expr)) body)))) |
| 461 | 461 | ||
| 462 | (defmacro etypecase (expr &rest clauses) | 462 | (defmacro etypecase (expr &rest clauses) |
| 463 | "(etypecase EXPR CLAUSES...): like `typecase', but error if no case fits. | 463 | "Like `typecase', but error if no case fits. |
| 464 | `otherwise'-clauses are not allowed." | 464 | `otherwise'-clauses are not allowed." |
| 465 | (list* 'typecase expr (append clauses '((ecase-error-flag))))) | 465 | (list* 'typecase expr (append clauses '((ecase-error-flag))))) |
| 466 | 466 | ||
| @@ -468,7 +468,7 @@ final clause, and matches if no other keys match." | |||
| 468 | ;;; Blocks and exits. | 468 | ;;; Blocks and exits. |
| 469 | 469 | ||
| 470 | (defmacro block (name &rest body) | 470 | (defmacro block (name &rest body) |
| 471 | "(block NAME BODY...): define a lexically-scoped block named NAME. | 471 | "Define a lexically-scoped block named NAME. |
| 472 | NAME may be any symbol. Code inside the BODY forms can call `return-from' | 472 | NAME may be any symbol. Code inside the BODY forms can call `return-from' |
| 473 | to jump prematurely out of the block. This differs from `catch' and `throw' | 473 | to jump prematurely out of the block. This differs from `catch' and `throw' |
| 474 | in two respects: First, the NAME is an unevaluated symbol rather than a | 474 | in two respects: First, the NAME is an unevaluated symbol rather than a |
| @@ -502,19 +502,19 @@ called from BODY." | |||
| 502 | (if cl-found (setcdr cl-found t))) | 502 | (if cl-found (setcdr cl-found t))) |
| 503 | (byte-compile-normal-call (cons 'throw (cdr cl-form)))) | 503 | (byte-compile-normal-call (cons 'throw (cdr cl-form)))) |
| 504 | 504 | ||
| 505 | (defmacro return (&optional res) | 505 | (defmacro return (&optional result) |
| 506 | "(return [RESULT]): return from the block named nil. | 506 | "Return from the block named nil. |
| 507 | This is equivalent to `(return-from nil RESULT)'." | 507 | This is equivalent to `(return-from nil RESULT)'." |
| 508 | (list 'return-from nil res)) | 508 | (list 'return-from nil result)) |
| 509 | 509 | ||
| 510 | (defmacro return-from (name &optional res) | 510 | (defmacro return-from (name &optional result) |
| 511 | "(return-from NAME [RESULT]): return from the block named NAME. | 511 | "Return from the block named NAME. |
| 512 | This jump out to the innermost enclosing `(block NAME ...)' form, | 512 | This jump out to the innermost enclosing `(block NAME ...)' form, |
| 513 | returning RESULT from that form (or nil if RESULT is omitted). | 513 | returning RESULT from that form (or nil if RESULT is omitted). |
| 514 | This is compatible with Common Lisp, but note that `defun' and | 514 | This is compatible with Common Lisp, but note that `defun' and |
| 515 | `defmacro' do not create implicit blocks as they do in Common Lisp." | 515 | `defmacro' do not create implicit blocks as they do in Common Lisp." |
| 516 | (let ((name2 (intern (format "--cl-block-%s--" name)))) | 516 | (let ((name2 (intern (format "--cl-block-%s--" name)))) |
| 517 | (list 'cl-block-throw (list 'quote name2) res))) | 517 | (list 'cl-block-throw (list 'quote name2) result))) |
| 518 | 518 | ||
| 519 | 519 | ||
| 520 | ;;; The "loop" macro. | 520 | ;;; The "loop" macro. |
| @@ -1168,7 +1168,7 @@ before assigning any symbols SYM to the corresponding values." | |||
| 1168 | ;;; Binding control structures. | 1168 | ;;; Binding control structures. |
| 1169 | 1169 | ||
| 1170 | (defmacro progv (symbols values &rest body) | 1170 | (defmacro progv (symbols values &rest body) |
| 1171 | "(progv SYMBOLS VALUES BODY...): bind SYMBOLS to VALUES dynamically in BODY. | 1171 | "Bind SYMBOLS to VALUES dynamically in BODY. |
| 1172 | The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists. | 1172 | The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists. |
| 1173 | Each SYMBOL in the first list is bound to the corresponding VALUE in the | 1173 | Each SYMBOL in the first list is bound to the corresponding VALUE in the |
| 1174 | second list (or made unbound if VALUES is shorter than SYMBOLS); then the | 1174 | second list (or made unbound if VALUES is shorter than SYMBOLS); then the |
| @@ -1253,7 +1253,7 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...)." | |||
| 1253 | 1253 | ||
| 1254 | (defvar cl-closure-vars nil) | 1254 | (defvar cl-closure-vars nil) |
| 1255 | (defmacro lexical-let (bindings &rest body) | 1255 | (defmacro lexical-let (bindings &rest body) |
| 1256 | "(lexical-let BINDINGS BODY...): like `let', but lexically scoped. | 1256 | "Like `let', but lexically scoped. |
| 1257 | The main visible difference is that lambdas inside BODY will create | 1257 | The main visible difference is that lambdas inside BODY will create |
| 1258 | lexical closures as in Common Lisp." | 1258 | lexical closures as in Common Lisp." |
| 1259 | (let* ((cl-closure-vars cl-closure-vars) | 1259 | (let* ((cl-closure-vars cl-closure-vars) |
| @@ -1295,7 +1295,7 @@ lexical closures as in Common Lisp." | |||
| 1295 | ebody)))) | 1295 | ebody)))) |
| 1296 | 1296 | ||
| 1297 | (defmacro lexical-let* (bindings &rest body) | 1297 | (defmacro lexical-let* (bindings &rest body) |
| 1298 | "(lexical-let* BINDINGS BODY...): like `let*', but lexically scoped. | 1298 | "Like `let*', but lexically scoped. |
| 1299 | The main visible difference is that lambdas inside BODY will create | 1299 | The main visible difference is that lambdas inside BODY will create |
| 1300 | lexical closures as in Common Lisp." | 1300 | lexical closures as in Common Lisp." |
| 1301 | (if (null bindings) (cons 'progn body) | 1301 | (if (null bindings) (cons 'progn body) |
| @@ -1528,7 +1528,7 @@ Example: (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))." | |||
| 1528 | (defsetf gethash (x h &optional d) (store) (list 'cl-puthash x store h)) | 1528 | (defsetf gethash (x h &optional d) (store) (list 'cl-puthash x store h)) |
| 1529 | (defsetf nth (n x) (store) (list 'setcar (list 'nthcdr n x) store)) | 1529 | (defsetf nth (n x) (store) (list 'setcar (list 'nthcdr n x) store)) |
| 1530 | (defsetf subseq (seq start &optional end) (new) | 1530 | (defsetf subseq (seq start &optional end) (new) |
| 1531 | (list 'progn (list 'replace seq new ':start1 start ':end1 end) new)) | 1531 | (list 'progn (list 'replace seq new :start1 start :end1 end) new)) |
| 1532 | (defsetf symbol-function fset) | 1532 | (defsetf symbol-function fset) |
| 1533 | (defsetf symbol-plist setplist) | 1533 | (defsetf symbol-plist setplist) |
| 1534 | (defsetf symbol-value set) | 1534 | (defsetf symbol-value set) |
| @@ -1819,7 +1819,7 @@ before assigning any PLACEs to the corresponding values." | |||
| 1819 | (cl-setf-do-store (nth 1 method) (list 'cdr temp))))))) | 1819 | (cl-setf-do-store (nth 1 method) (list 'cdr temp))))))) |
| 1820 | 1820 | ||
| 1821 | (defmacro remf (place tag) | 1821 | (defmacro remf (place tag) |
| 1822 | "(remf PLACE TAG): remove TAG from property list PLACE. | 1822 | "Remove TAG from property list PLACE. |
| 1823 | PLACE may be a symbol, or any generalized variable allowed by `setf'. | 1823 | PLACE may be a symbol, or any generalized variable allowed by `setf'. |
| 1824 | The form returns true if TAG was found and removed, nil otherwise." | 1824 | The form returns true if TAG was found and removed, nil otherwise." |
| 1825 | (let* ((method (cl-setf-do-modify place t)) | 1825 | (let* ((method (cl-setf-do-modify place t)) |
| @@ -1978,7 +1978,7 @@ Like `callf', but PLACE is the second argument of FUNC, not the first." | |||
| 1978 | rargs))))))) | 1978 | rargs))))))) |
| 1979 | 1979 | ||
| 1980 | (defmacro define-modify-macro (name arglist func &optional doc) | 1980 | (defmacro define-modify-macro (name arglist func &optional doc) |
| 1981 | "(define-modify-macro NAME ARGLIST FUNC): define a `setf'-like modify macro. | 1981 | "Define a `setf'-like modify macro. |
| 1982 | If NAME is called, it combines its PLACE argument with the other arguments | 1982 | If NAME is called, it combines its PLACE argument with the other arguments |
| 1983 | from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)" | 1983 | from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)" |
| 1984 | (if (memq '&key arglist) (error "&key not allowed in define-modify-macro")) | 1984 | (if (memq '&key arglist) (error "&key not allowed in define-modify-macro")) |
| @@ -2025,31 +2025,31 @@ copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors." | |||
| 2025 | (while opts | 2025 | (while opts |
| 2026 | (let ((opt (if (consp (car opts)) (caar opts) (car opts))) | 2026 | (let ((opt (if (consp (car opts)) (caar opts) (car opts))) |
| 2027 | (args (cdr-safe (cl-pop opts)))) | 2027 | (args (cdr-safe (cl-pop opts)))) |
| 2028 | (cond ((eq opt ':conc-name) | 2028 | (cond ((eq opt :conc-name) |
| 2029 | (if args | 2029 | (if args |
| 2030 | (setq conc-name (if (car args) | 2030 | (setq conc-name (if (car args) |
| 2031 | (symbol-name (car args)) "")))) | 2031 | (symbol-name (car args)) "")))) |
| 2032 | ((eq opt ':constructor) | 2032 | ((eq opt :constructor) |
| 2033 | (if (cdr args) | 2033 | (if (cdr args) |
| 2034 | (cl-push args constrs) | 2034 | (cl-push args constrs) |
| 2035 | (if args (setq constructor (car args))))) | 2035 | (if args (setq constructor (car args))))) |
| 2036 | ((eq opt ':copier) | 2036 | ((eq opt :copier) |
| 2037 | (if args (setq copier (car args)))) | 2037 | (if args (setq copier (car args)))) |
| 2038 | ((eq opt ':predicate) | 2038 | ((eq opt :predicate) |
| 2039 | (if args (setq predicate (car args)))) | 2039 | (if args (setq predicate (car args)))) |
| 2040 | ((eq opt ':include) | 2040 | ((eq opt :include) |
| 2041 | (setq include (car args) | 2041 | (setq include (car args) |
| 2042 | include-descs (mapcar (function | 2042 | include-descs (mapcar (function |
| 2043 | (lambda (x) | 2043 | (lambda (x) |
| 2044 | (if (consp x) x (list x)))) | 2044 | (if (consp x) x (list x)))) |
| 2045 | (cdr args)))) | 2045 | (cdr args)))) |
| 2046 | ((eq opt ':print-function) | 2046 | ((eq opt :print-function) |
| 2047 | (setq print-func (car args))) | 2047 | (setq print-func (car args))) |
| 2048 | ((eq opt ':type) | 2048 | ((eq opt :type) |
| 2049 | (setq type (car args))) | 2049 | (setq type (car args))) |
| 2050 | ((eq opt ':named) | 2050 | ((eq opt :named) |
| 2051 | (setq named t)) | 2051 | (setq named t)) |
| 2052 | ((eq opt ':initial-offset) | 2052 | ((eq opt :initial-offset) |
| 2053 | (setq descs (nconc (make-list (car args) '(cl-skip-slot)) | 2053 | (setq descs (nconc (make-list (car args) '(cl-skip-slot)) |
| 2054 | descs))) | 2054 | descs))) |
| 2055 | (t | 2055 | (t |
| @@ -2140,7 +2140,7 @@ copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors." | |||
| 2140 | (list 'nth pos 'cl-x)))))) forms) | 2140 | (list 'nth pos 'cl-x)))))) forms) |
| 2141 | (cl-push (cons accessor t) side-eff) | 2141 | (cl-push (cons accessor t) side-eff) |
| 2142 | (cl-push (list 'define-setf-method accessor '(cl-x) | 2142 | (cl-push (list 'define-setf-method accessor '(cl-x) |
| 2143 | (if (cadr (memq ':read-only (cddr desc))) | 2143 | (if (cadr (memq :read-only (cddr desc))) |
| 2144 | (list 'error (format "%s is a read-only slot" | 2144 | (list 'error (format "%s is a read-only slot" |
| 2145 | accessor)) | 2145 | accessor)) |
| 2146 | (list 'cl-struct-setf-expander 'cl-x | 2146 | (list 'cl-struct-setf-expander 'cl-x |
| @@ -2229,12 +2229,12 @@ copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors." | |||
| 2229 | 2229 | ||
| 2230 | ;;; Types and assertions. | 2230 | ;;; Types and assertions. |
| 2231 | 2231 | ||
| 2232 | (defmacro deftype (name args &rest body) | 2232 | (defmacro deftype (name arglist &rest body) |
| 2233 | "(deftype NAME ARGLIST BODY...): define NAME as a new data type. | 2233 | "Define NAME as a new data type. |
| 2234 | The type name can then be used in `typecase', `check-type', etc." | 2234 | The type name can then be used in `typecase', `check-type', etc." |
| 2235 | (list 'eval-when '(compile load eval) | 2235 | (list 'eval-when '(compile load eval) |
| 2236 | (cl-transform-function-property | 2236 | (cl-transform-function-property |
| 2237 | name 'cl-deftype-handler (cons (list* '&cl-defs ''('*) args) body)))) | 2237 | name 'cl-deftype-handler (cons (list* '&cl-defs ''('*) arglist) body)))) |
| 2238 | 2238 | ||
| 2239 | (defun cl-make-type-test (val type) | 2239 | (defun cl-make-type-test (val type) |
| 2240 | (if (memq type '(character string-char)) (setq type '(integer 0 255))) | 2240 | (if (memq type '(character string-char)) (setq type '(integer 0 255))) |
| @@ -2404,7 +2404,7 @@ Otherwise, return result of last FORM." | |||
| 2404 | ;;; Compiler macros. | 2404 | ;;; Compiler macros. |
| 2405 | 2405 | ||
| 2406 | (defmacro define-compiler-macro (func args &rest body) | 2406 | (defmacro define-compiler-macro (func args &rest body) |
| 2407 | "(define-compiler-macro FUNC ARGLIST BODY...): Define a compiler-only macro. | 2407 | "Define a compiler-only macro. |
| 2408 | This is like `defmacro', but macro expansion occurs only if the call to | 2408 | This is like `defmacro', but macro expansion occurs only if the call to |
| 2409 | FUNC is compiled (i.e., not interpreted). Compiler macros should be used | 2409 | FUNC is compiled (i.e., not interpreted). Compiler macros should be used |
| 2410 | for optimizing the way calls to FUNC are compiled; the form returned by | 2410 | for optimizing the way calls to FUNC are compiled; the form returned by |
| @@ -2505,7 +2505,7 @@ surrounded by (block NAME ...)." | |||
| 2505 | (t form))) | 2505 | (t form))) |
| 2506 | 2506 | ||
| 2507 | (define-compiler-macro member* (&whole form a list &rest keys) | 2507 | (define-compiler-macro member* (&whole form a list &rest keys) |
| 2508 | (let ((test (and (= (length keys) 2) (eq (car keys) ':test) | 2508 | (let ((test (and (= (length keys) 2) (eq (car keys) :test) |
| 2509 | (cl-const-expr-val (nth 1 keys))))) | 2509 | (cl-const-expr-val (nth 1 keys))))) |
| 2510 | (cond ((eq test 'eq) (list 'memq a list)) | 2510 | (cond ((eq test 'eq) (list 'memq a list)) |
| 2511 | ((eq test 'equal) (list 'member a list)) | 2511 | ((eq test 'equal) (list 'member a list)) |
| @@ -2527,7 +2527,7 @@ surrounded by (block NAME ...)." | |||
| 2527 | (t form)))) | 2527 | (t form)))) |
| 2528 | 2528 | ||
| 2529 | (define-compiler-macro assoc* (&whole form a list &rest keys) | 2529 | (define-compiler-macro assoc* (&whole form a list &rest keys) |
| 2530 | (let ((test (and (= (length keys) 2) (eq (car keys) ':test) | 2530 | (let ((test (and (= (length keys) 2) (eq (car keys) :test) |
| 2531 | (cl-const-expr-val (nth 1 keys))))) | 2531 | (cl-const-expr-val (nth 1 keys))))) |
| 2532 | (cond ((eq test 'eq) (list 'assq a list)) | 2532 | (cond ((eq test 'eq) (list 'assq a list)) |
| 2533 | ((eq test 'equal) (list 'assoc a list)) | 2533 | ((eq test 'equal) (list 'assoc a list)) |
| @@ -2538,7 +2538,7 @@ surrounded by (block NAME ...)." | |||
| 2538 | 2538 | ||
| 2539 | (define-compiler-macro adjoin (&whole form a list &rest keys) | 2539 | (define-compiler-macro adjoin (&whole form a list &rest keys) |
| 2540 | (if (and (cl-simple-expr-p a) (cl-simple-expr-p list) | 2540 | (if (and (cl-simple-expr-p a) (cl-simple-expr-p list) |
| 2541 | (not (memq ':key keys))) | 2541 | (not (memq :key keys))) |
| 2542 | (list 'if (list* 'member* a list keys) list (list 'cons a list)) | 2542 | (list 'if (list* 'member* a list keys) list (list 'cons a list)) |
| 2543 | form)) | 2543 | form)) |
| 2544 | 2544 | ||
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index eaac88a4e22..90fba3cfe3a 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el | |||
| @@ -68,9 +68,9 @@ | |||
| 68 | (let* ((var (if (consp x) (car x) x)) | 68 | (let* ((var (if (consp x) (car x) x)) |
| 69 | (mem (list 'car (list 'cdr (list 'memq (list 'quote var) | 69 | (mem (list 'car (list 'cdr (list 'memq (list 'quote var) |
| 70 | 'cl-keys))))) | 70 | 'cl-keys))))) |
| 71 | (if (eq var ':test-not) | 71 | (if (eq var :test-not) |
| 72 | (setq mem (list 'and mem (list 'setq 'cl-test mem) t))) | 72 | (setq mem (list 'and mem (list 'setq 'cl-test mem) t))) |
| 73 | (if (eq var ':if-not) | 73 | (if (eq var :if-not) |
| 74 | (setq mem (list 'and mem (list 'setq 'cl-if mem) t))) | 74 | (setq mem (list 'and mem (list 'setq 'cl-if mem) t))) |
| 75 | (list (intern | 75 | (list (intern |
| 76 | (format "cl-%s" (substring (symbol-name var) 1))) | 76 | (format "cl-%s" (substring (symbol-name var) 1))) |
| @@ -139,7 +139,7 @@ Keywords supported: :start :end :from-end :initial-value :key" | |||
| 139 | (or (listp cl-seq) (setq cl-seq (append cl-seq nil))) | 139 | (or (listp cl-seq) (setq cl-seq (append cl-seq nil))) |
| 140 | (setq cl-seq (subseq cl-seq cl-start cl-end)) | 140 | (setq cl-seq (subseq cl-seq cl-start cl-end)) |
| 141 | (if cl-from-end (setq cl-seq (nreverse cl-seq))) | 141 | (if cl-from-end (setq cl-seq (nreverse cl-seq))) |
| 142 | (let ((cl-accum (cond ((memq ':initial-value cl-keys) cl-initial-value) | 142 | (let ((cl-accum (cond ((memq :initial-value cl-keys) cl-initial-value) |
| 143 | (cl-seq (cl-check-key (cl-pop cl-seq))) | 143 | (cl-seq (cl-check-key (cl-pop cl-seq))) |
| 144 | (t (funcall cl-func))))) | 144 | (t (funcall cl-func))))) |
| 145 | (if cl-from-end | 145 | (if cl-from-end |
| @@ -225,8 +225,8 @@ Keywords supported: :test :test-not :key :count :start :end :from-end" | |||
| 225 | (if cl-i | 225 | (if cl-i |
| 226 | (let ((cl-res (apply 'delete* cl-item (append cl-seq nil) | 226 | (let ((cl-res (apply 'delete* cl-item (append cl-seq nil) |
| 227 | (append (if cl-from-end | 227 | (append (if cl-from-end |
| 228 | (list ':end (1+ cl-i)) | 228 | (list :end (1+ cl-i)) |
| 229 | (list ':start cl-i)) | 229 | (list :start cl-i)) |
| 230 | cl-keys)))) | 230 | cl-keys)))) |
| 231 | (if (listp cl-seq) cl-res | 231 | (if (listp cl-seq) cl-res |
| 232 | (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))) | 232 | (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))) |
| @@ -249,8 +249,8 @@ Keywords supported: :test :test-not :key :count :start :end :from-end" | |||
| 249 | (and (cdr cl-p) | 249 | (and (cdr cl-p) |
| 250 | (apply 'delete* cl-item | 250 | (apply 'delete* cl-item |
| 251 | (copy-sequence (cdr cl-p)) | 251 | (copy-sequence (cdr cl-p)) |
| 252 | ':start 0 ':end (1- cl-end) | 252 | :start 0 :end (1- cl-end) |
| 253 | ':count (1- cl-count) cl-keys)))) | 253 | :count (1- cl-count) cl-keys)))) |
| 254 | cl-seq)) | 254 | cl-seq)) |
| 255 | cl-seq))))) | 255 | cl-seq))))) |
| 256 | 256 | ||
| @@ -259,14 +259,14 @@ Keywords supported: :test :test-not :key :count :start :end :from-end" | |||
| 259 | This is a non-destructive function; it makes a copy of SEQ if necessary | 259 | This is a non-destructive function; it makes a copy of SEQ if necessary |
| 260 | to avoid corrupting the original SEQ. | 260 | to avoid corrupting the original SEQ. |
| 261 | Keywords supported: :key :count :start :end :from-end" | 261 | Keywords supported: :key :count :start :end :from-end" |
| 262 | (apply 'remove* nil cl-list ':if cl-pred cl-keys)) | 262 | (apply 'remove* nil cl-list :if cl-pred cl-keys)) |
| 263 | 263 | ||
| 264 | (defun remove-if-not (cl-pred cl-list &rest cl-keys) | 264 | (defun remove-if-not (cl-pred cl-list &rest cl-keys) |
| 265 | "Remove all items not satisfying PREDICATE in SEQ. | 265 | "Remove all items not satisfying PREDICATE in SEQ. |
| 266 | This is a non-destructive function; it makes a copy of SEQ if necessary | 266 | This is a non-destructive function; it makes a copy of SEQ if necessary |
| 267 | to avoid corrupting the original SEQ. | 267 | to avoid corrupting the original SEQ. |
| 268 | Keywords supported: :key :count :start :end :from-end" | 268 | Keywords supported: :key :count :start :end :from-end" |
| 269 | (apply 'remove* nil cl-list ':if-not cl-pred cl-keys)) | 269 | (apply 'remove* nil cl-list :if-not cl-pred cl-keys)) |
| 270 | 270 | ||
| 271 | (defun delete* (cl-item cl-seq &rest cl-keys) | 271 | (defun delete* (cl-item cl-seq &rest cl-keys) |
| 272 | "Remove all occurrences of ITEM in SEQ. | 272 | "Remove all occurrences of ITEM in SEQ. |
| @@ -314,17 +314,15 @@ Keywords supported: :test :test-not :key :count :start :end :from-end" | |||
| 314 | "Remove all items satisfying PREDICATE in SEQ. | 314 | "Remove all items satisfying PREDICATE in SEQ. |
| 315 | This is a destructive function; it reuses the storage of SEQ whenever possible. | 315 | This is a destructive function; it reuses the storage of SEQ whenever possible. |
| 316 | Keywords supported: :key :count :start :end :from-end" | 316 | Keywords supported: :key :count :start :end :from-end" |
| 317 | (apply 'delete* nil cl-list ':if cl-pred cl-keys)) | 317 | (apply 'delete* nil cl-list :if cl-pred cl-keys)) |
| 318 | 318 | ||
| 319 | (defun delete-if-not (cl-pred cl-list &rest cl-keys) | 319 | (defun delete-if-not (cl-pred cl-list &rest cl-keys) |
| 320 | "Remove all items not satisfying PREDICATE in SEQ. | 320 | "Remove all items not satisfying PREDICATE in SEQ. |
| 321 | This is a destructive function; it reuses the storage of SEQ whenever possible. | 321 | This is a destructive function; it reuses the storage of SEQ whenever possible. |
| 322 | Keywords supported: :key :count :start :end :from-end" | 322 | Keywords supported: :key :count :start :end :from-end" |
| 323 | (apply 'delete* nil cl-list ':if-not cl-pred cl-keys)) | 323 | (apply 'delete* nil cl-list :if-not cl-pred cl-keys)) |
| 324 | 324 | ||
| 325 | (or (and (fboundp 'delete) (subrp (symbol-function 'delete))) | 325 | (defun remove (x y) (remove* x y :test 'equal)) |
| 326 | (defalias 'delete (function (lambda (x y) (delete* x y ':test 'equal))))) | ||
| 327 | (defun remove (x y) (remove* x y ':test 'equal)) | ||
| 328 | (defun remq (x y) (if (memq x y) (delq x (copy-list y)) y)) | 326 | (defun remq (x y) (if (memq x y) (delq x (copy-list y)) y)) |
| 329 | 327 | ||
| 330 | (defun remove-duplicates (cl-seq &rest cl-keys) | 328 | (defun remove-duplicates (cl-seq &rest cl-keys) |
| @@ -394,22 +392,22 @@ Keywords supported: :test :test-not :key :count :start :end :from-end" | |||
| 394 | (or cl-from-end | 392 | (or cl-from-end |
| 395 | (progn (cl-set-elt cl-seq cl-i cl-new) | 393 | (progn (cl-set-elt cl-seq cl-i cl-new) |
| 396 | (setq cl-i (1+ cl-i) cl-count (1- cl-count)))) | 394 | (setq cl-i (1+ cl-i) cl-count (1- cl-count)))) |
| 397 | (apply 'nsubstitute cl-new cl-old cl-seq ':count cl-count | 395 | (apply 'nsubstitute cl-new cl-old cl-seq :count cl-count |
| 398 | ':start cl-i cl-keys)))))) | 396 | :start cl-i cl-keys)))))) |
| 399 | 397 | ||
| 400 | (defun substitute-if (cl-new cl-pred cl-list &rest cl-keys) | 398 | (defun substitute-if (cl-new cl-pred cl-list &rest cl-keys) |
| 401 | "Substitute NEW for all items satisfying PREDICATE in SEQ. | 399 | "Substitute NEW for all items satisfying PREDICATE in SEQ. |
| 402 | This is a non-destructive function; it makes a copy of SEQ if necessary | 400 | This is a non-destructive function; it makes a copy of SEQ if necessary |
| 403 | to avoid corrupting the original SEQ. | 401 | to avoid corrupting the original SEQ. |
| 404 | Keywords supported: :key :count :start :end :from-end" | 402 | Keywords supported: :key :count :start :end :from-end" |
| 405 | (apply 'substitute cl-new nil cl-list ':if cl-pred cl-keys)) | 403 | (apply 'substitute cl-new nil cl-list :if cl-pred cl-keys)) |
| 406 | 404 | ||
| 407 | (defun substitute-if-not (cl-new cl-pred cl-list &rest cl-keys) | 405 | (defun substitute-if-not (cl-new cl-pred cl-list &rest cl-keys) |
| 408 | "Substitute NEW for all items not satisfying PREDICATE in SEQ. | 406 | "Substitute NEW for all items not satisfying PREDICATE in SEQ. |
| 409 | This is a non-destructive function; it makes a copy of SEQ if necessary | 407 | This is a non-destructive function; it makes a copy of SEQ if necessary |
| 410 | to avoid corrupting the original SEQ. | 408 | to avoid corrupting the original SEQ. |
| 411 | Keywords supported: :key :count :start :end :from-end" | 409 | Keywords supported: :key :count :start :end :from-end" |
| 412 | (apply 'substitute cl-new nil cl-list ':if-not cl-pred cl-keys)) | 410 | (apply 'substitute cl-new nil cl-list :if-not cl-pred cl-keys)) |
| 413 | 411 | ||
| 414 | (defun nsubstitute (cl-new cl-old cl-seq &rest cl-keys) | 412 | (defun nsubstitute (cl-new cl-old cl-seq &rest cl-keys) |
| 415 | "Substitute NEW for OLD in SEQ. | 413 | "Substitute NEW for OLD in SEQ. |
| @@ -447,13 +445,13 @@ Keywords supported: :test :test-not :key :count :start :end :from-end" | |||
| 447 | "Substitute NEW for all items satisfying PREDICATE in SEQ. | 445 | "Substitute NEW for all items satisfying PREDICATE in SEQ. |
| 448 | This is a destructive function; it reuses the storage of SEQ whenever possible. | 446 | This is a destructive function; it reuses the storage of SEQ whenever possible. |
| 449 | Keywords supported: :key :count :start :end :from-end" | 447 | Keywords supported: :key :count :start :end :from-end" |
| 450 | (apply 'nsubstitute cl-new nil cl-list ':if cl-pred cl-keys)) | 448 | (apply 'nsubstitute cl-new nil cl-list :if cl-pred cl-keys)) |
| 451 | 449 | ||
| 452 | (defun nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys) | 450 | (defun nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys) |
| 453 | "Substitute NEW for all items not satisfying PREDICATE in SEQ. | 451 | "Substitute NEW for all items not satisfying PREDICATE in SEQ. |
| 454 | This is a destructive function; it reuses the storage of SEQ whenever possible. | 452 | This is a destructive function; it reuses the storage of SEQ whenever possible. |
| 455 | Keywords supported: :key :count :start :end :from-end" | 453 | Keywords supported: :key :count :start :end :from-end" |
| 456 | (apply 'nsubstitute cl-new nil cl-list ':if-not cl-pred cl-keys)) | 454 | (apply 'nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys)) |
| 457 | 455 | ||
| 458 | (defun find (cl-item cl-seq &rest cl-keys) | 456 | (defun find (cl-item cl-seq &rest cl-keys) |
| 459 | "Find the first occurrence of ITEM in LIST. | 457 | "Find the first occurrence of ITEM in LIST. |
| @@ -466,13 +464,13 @@ Keywords supported: :test :test-not :key :start :end :from-end" | |||
| 466 | "Find the first item satisfying PREDICATE in LIST. | 464 | "Find the first item satisfying PREDICATE in LIST. |
| 467 | Return the matching ITEM, or nil if not found. | 465 | Return the matching ITEM, or nil if not found. |
| 468 | Keywords supported: :key :start :end :from-end" | 466 | Keywords supported: :key :start :end :from-end" |
| 469 | (apply 'find nil cl-list ':if cl-pred cl-keys)) | 467 | (apply 'find nil cl-list :if cl-pred cl-keys)) |
| 470 | 468 | ||
| 471 | (defun find-if-not (cl-pred cl-list &rest cl-keys) | 469 | (defun find-if-not (cl-pred cl-list &rest cl-keys) |
| 472 | "Find the first item not satisfying PREDICATE in LIST. | 470 | "Find the first item not satisfying PREDICATE in LIST. |
| 473 | Return the matching ITEM, or nil if not found. | 471 | Return the matching ITEM, or nil if not found. |
| 474 | Keywords supported: :key :start :end :from-end" | 472 | Keywords supported: :key :start :end :from-end" |
| 475 | (apply 'find nil cl-list ':if-not cl-pred cl-keys)) | 473 | (apply 'find nil cl-list :if-not cl-pred cl-keys)) |
| 476 | 474 | ||
| 477 | (defun position (cl-item cl-seq &rest cl-keys) | 475 | (defun position (cl-item cl-seq &rest cl-keys) |
| 478 | "Find the first occurrence of ITEM in LIST. | 476 | "Find the first occurrence of ITEM in LIST. |
| @@ -507,13 +505,13 @@ Keywords supported: :test :test-not :key :start :end :from-end" | |||
| 507 | "Find the first item satisfying PREDICATE in LIST. | 505 | "Find the first item satisfying PREDICATE in LIST. |
| 508 | Return the index of the matching item, or nil if not found. | 506 | Return the index of the matching item, or nil if not found. |
| 509 | Keywords supported: :key :start :end :from-end" | 507 | Keywords supported: :key :start :end :from-end" |
| 510 | (apply 'position nil cl-list ':if cl-pred cl-keys)) | 508 | (apply 'position nil cl-list :if cl-pred cl-keys)) |
| 511 | 509 | ||
| 512 | (defun position-if-not (cl-pred cl-list &rest cl-keys) | 510 | (defun position-if-not (cl-pred cl-list &rest cl-keys) |
| 513 | "Find the first item not satisfying PREDICATE in LIST. | 511 | "Find the first item not satisfying PREDICATE in LIST. |
| 514 | Return the index of the matching item, or nil if not found. | 512 | Return the index of the matching item, or nil if not found. |
| 515 | Keywords supported: :key :start :end :from-end" | 513 | Keywords supported: :key :start :end :from-end" |
| 516 | (apply 'position nil cl-list ':if-not cl-pred cl-keys)) | 514 | (apply 'position nil cl-list :if-not cl-pred cl-keys)) |
| 517 | 515 | ||
| 518 | (defun count (cl-item cl-seq &rest cl-keys) | 516 | (defun count (cl-item cl-seq &rest cl-keys) |
| 519 | "Count the number of occurrences of ITEM in LIST. | 517 | "Count the number of occurrences of ITEM in LIST. |
| @@ -531,12 +529,12 @@ Keywords supported: :test :test-not :key :start :end" | |||
| 531 | (defun count-if (cl-pred cl-list &rest cl-keys) | 529 | (defun count-if (cl-pred cl-list &rest cl-keys) |
| 532 | "Count the number of items satisfying PREDICATE in LIST. | 530 | "Count the number of items satisfying PREDICATE in LIST. |
| 533 | Keywords supported: :key :start :end" | 531 | Keywords supported: :key :start :end" |
| 534 | (apply 'count nil cl-list ':if cl-pred cl-keys)) | 532 | (apply 'count nil cl-list :if cl-pred cl-keys)) |
| 535 | 533 | ||
| 536 | (defun count-if-not (cl-pred cl-list &rest cl-keys) | 534 | (defun count-if-not (cl-pred cl-list &rest cl-keys) |
| 537 | "Count the number of items not satisfying PREDICATE in LIST. | 535 | "Count the number of items not satisfying PREDICATE in LIST. |
| 538 | Keywords supported: :key :start :end" | 536 | Keywords supported: :key :start :end" |
| 539 | (apply 'count nil cl-list ':if-not cl-pred cl-keys)) | 537 | (apply 'count nil cl-list :if-not cl-pred cl-keys)) |
| 540 | 538 | ||
| 541 | (defun mismatch (cl-seq1 cl-seq2 &rest cl-keys) | 539 | (defun mismatch (cl-seq1 cl-seq2 &rest cl-keys) |
| 542 | "Compare SEQ1 with SEQ2, return index of first mismatching element. | 540 | "Compare SEQ1 with SEQ2, return index of first mismatching element. |
| @@ -586,9 +584,9 @@ Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end" | |||
| 586 | (setq cl-pos (cl-position cl-first cl-seq2 | 584 | (setq cl-pos (cl-position cl-first cl-seq2 |
| 587 | cl-start2 cl-end2 cl-from-end)) | 585 | cl-start2 cl-end2 cl-from-end)) |
| 588 | (apply 'mismatch cl-seq1 cl-seq2 | 586 | (apply 'mismatch cl-seq1 cl-seq2 |
| 589 | ':start1 (1+ cl-start1) ':end1 cl-end1 | 587 | :start1 (1+ cl-start1) :end1 cl-end1 |
| 590 | ':start2 (1+ cl-pos) ':end2 (+ cl-pos cl-len) | 588 | :start2 (1+ cl-pos) :end2 (+ cl-pos cl-len) |
| 591 | ':from-end nil cl-keys)) | 589 | :from-end nil cl-keys)) |
| 592 | (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos)))) | 590 | (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos)))) |
| 593 | (and (< cl-start2 cl-end2) cl-pos))))) | 591 | (and (< cl-start2 cl-end2) cl-pos))))) |
| 594 | 592 | ||
| @@ -645,13 +643,13 @@ Keywords supported: :test :test-not :key" | |||
| 645 | "Find the first item satisfying PREDICATE in LIST. | 643 | "Find the first item satisfying PREDICATE in LIST. |
| 646 | Return the sublist of LIST whose car matches. | 644 | Return the sublist of LIST whose car matches. |
| 647 | Keywords supported: :key" | 645 | Keywords supported: :key" |
| 648 | (apply 'member* nil cl-list ':if cl-pred cl-keys)) | 646 | (apply 'member* nil cl-list :if cl-pred cl-keys)) |
| 649 | 647 | ||
| 650 | (defun member-if-not (cl-pred cl-list &rest cl-keys) | 648 | (defun member-if-not (cl-pred cl-list &rest cl-keys) |
| 651 | "Find the first item not satisfying PREDICATE in LIST. | 649 | "Find the first item not satisfying PREDICATE in LIST. |
| 652 | Return the sublist of LIST whose car matches. | 650 | Return the sublist of LIST whose car matches. |
| 653 | Keywords supported: :key" | 651 | Keywords supported: :key" |
| 654 | (apply 'member* nil cl-list ':if-not cl-pred cl-keys)) | 652 | (apply 'member* nil cl-list :if-not cl-pred cl-keys)) |
| 655 | 653 | ||
| 656 | (defun cl-adjoin (cl-item cl-list &rest cl-keys) | 654 | (defun cl-adjoin (cl-item cl-list &rest cl-keys) |
| 657 | (if (cl-parsing-keywords (:key) t | 655 | (if (cl-parsing-keywords (:key) t |
| @@ -677,12 +675,12 @@ Keywords supported: :test :test-not :key" | |||
| 677 | (defun assoc-if (cl-pred cl-list &rest cl-keys) | 675 | (defun assoc-if (cl-pred cl-list &rest cl-keys) |
| 678 | "Find the first item whose car satisfies PREDICATE in LIST. | 676 | "Find the first item whose car satisfies PREDICATE in LIST. |
| 679 | Keywords supported: :key" | 677 | Keywords supported: :key" |
| 680 | (apply 'assoc* nil cl-list ':if cl-pred cl-keys)) | 678 | (apply 'assoc* nil cl-list :if cl-pred cl-keys)) |
| 681 | 679 | ||
| 682 | (defun assoc-if-not (cl-pred cl-list &rest cl-keys) | 680 | (defun assoc-if-not (cl-pred cl-list &rest cl-keys) |
| 683 | "Find the first item whose car does not satisfy PREDICATE in LIST. | 681 | "Find the first item whose car does not satisfy PREDICATE in LIST. |
| 684 | Keywords supported: :key" | 682 | Keywords supported: :key" |
| 685 | (apply 'assoc* nil cl-list ':if-not cl-pred cl-keys)) | 683 | (apply 'assoc* nil cl-list :if-not cl-pred cl-keys)) |
| 686 | 684 | ||
| 687 | (defun rassoc* (cl-item cl-alist &rest cl-keys) | 685 | (defun rassoc* (cl-item cl-alist &rest cl-keys) |
| 688 | "Find the first item whose cdr matches ITEM in LIST. | 686 | "Find the first item whose cdr matches ITEM in LIST. |
| @@ -699,12 +697,12 @@ Keywords supported: :test :test-not :key" | |||
| 699 | (defun rassoc-if (cl-pred cl-list &rest cl-keys) | 697 | (defun rassoc-if (cl-pred cl-list &rest cl-keys) |
| 700 | "Find the first item whose cdr satisfies PREDICATE in LIST. | 698 | "Find the first item whose cdr satisfies PREDICATE in LIST. |
| 701 | Keywords supported: :key" | 699 | Keywords supported: :key" |
| 702 | (apply 'rassoc* nil cl-list ':if cl-pred cl-keys)) | 700 | (apply 'rassoc* nil cl-list :if cl-pred cl-keys)) |
| 703 | 701 | ||
| 704 | (defun rassoc-if-not (cl-pred cl-list &rest cl-keys) | 702 | (defun rassoc-if-not (cl-pred cl-list &rest cl-keys) |
| 705 | "Find the first item whose cdr does not satisfy PREDICATE in LIST. | 703 | "Find the first item whose cdr does not satisfy PREDICATE in LIST. |
| 706 | Keywords supported: :key" | 704 | Keywords supported: :key" |
| 707 | (apply 'rassoc* nil cl-list ':if-not cl-pred cl-keys)) | 705 | (apply 'rassoc* nil cl-list :if-not cl-pred cl-keys)) |
| 708 | 706 | ||
| 709 | (defun union (cl-list1 cl-list2 &rest cl-keys) | 707 | (defun union (cl-list1 cl-list2 &rest cl-keys) |
| 710 | "Combine LIST1 and LIST2 using a set-union operation. | 708 | "Combine LIST1 and LIST2 using a set-union operation. |
| @@ -829,13 +827,13 @@ Keywords supported: :test :test-not :key" | |||
| 829 | "Substitute NEW for elements matching PREDICATE in TREE (non-destructively). | 827 | "Substitute NEW for elements matching PREDICATE in TREE (non-destructively). |
| 830 | Return a copy of TREE with all matching elements replaced by NEW. | 828 | Return a copy of TREE with all matching elements replaced by NEW. |
| 831 | Keywords supported: :key" | 829 | Keywords supported: :key" |
| 832 | (apply 'sublis (list (cons nil cl-new)) cl-tree ':if cl-pred cl-keys)) | 830 | (apply 'sublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys)) |
| 833 | 831 | ||
| 834 | (defun subst-if-not (cl-new cl-pred cl-tree &rest cl-keys) | 832 | (defun subst-if-not (cl-new cl-pred cl-tree &rest cl-keys) |
| 835 | "Substitute NEW for elts not matching PREDICATE in TREE (non-destructively). | 833 | "Substitute NEW for elts not matching PREDICATE in TREE (non-destructively). |
| 836 | Return a copy of TREE with all non-matching elements replaced by NEW. | 834 | Return a copy of TREE with all non-matching elements replaced by NEW. |
| 837 | Keywords supported: :key" | 835 | Keywords supported: :key" |
| 838 | (apply 'sublis (list (cons nil cl-new)) cl-tree ':if-not cl-pred cl-keys)) | 836 | (apply 'sublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys)) |
| 839 | 837 | ||
| 840 | (defun nsubst (cl-new cl-old cl-tree &rest cl-keys) | 838 | (defun nsubst (cl-new cl-old cl-tree &rest cl-keys) |
| 841 | "Substitute NEW for OLD everywhere in TREE (destructively). | 839 | "Substitute NEW for OLD everywhere in TREE (destructively). |
| @@ -848,13 +846,13 @@ Keywords supported: :test :test-not :key" | |||
| 848 | "Substitute NEW for elements matching PREDICATE in TREE (destructively). | 846 | "Substitute NEW for elements matching PREDICATE in TREE (destructively). |
| 849 | Any element of TREE which matches is changed to NEW (via a call to `setcar'). | 847 | Any element of TREE which matches is changed to NEW (via a call to `setcar'). |
| 850 | Keywords supported: :key" | 848 | Keywords supported: :key" |
| 851 | (apply 'nsublis (list (cons nil cl-new)) cl-tree ':if cl-pred cl-keys)) | 849 | (apply 'nsublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys)) |
| 852 | 850 | ||
| 853 | (defun nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys) | 851 | (defun nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys) |
| 854 | "Substitute NEW for elements not matching PREDICATE in TREE (destructively). | 852 | "Substitute NEW for elements not matching PREDICATE in TREE (destructively). |
| 855 | Any element of TREE which matches is changed to NEW (via a call to `setcar'). | 853 | Any element of TREE which matches is changed to NEW (via a call to `setcar'). |
| 856 | Keywords supported: :key" | 854 | Keywords supported: :key" |
| 857 | (apply 'nsublis (list (cons nil cl-new)) cl-tree ':if-not cl-pred cl-keys)) | 855 | (apply 'nsublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys)) |
| 858 | 856 | ||
| 859 | (defun sublis (cl-alist cl-tree &rest cl-keys) | 857 | (defun sublis (cl-alist cl-tree &rest cl-keys) |
| 860 | "Perform substitutions indicated by ALIST in TREE (non-destructively). | 858 | "Perform substitutions indicated by ALIST in TREE (non-destructively). |
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index 8d7c826f261..790e4c9b6e3 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el | |||
| @@ -123,7 +123,7 @@ Floating-point numbers of equal value are `eql', but they may not be `eq'." | |||
| 123 | ;;; can safely be used in .emacs files. | 123 | ;;; can safely be used in .emacs files. |
| 124 | 124 | ||
| 125 | (defmacro incf (place &optional x) | 125 | (defmacro incf (place &optional x) |
| 126 | "(incf PLACE [X]): increment PLACE by X (1 by default). | 126 | "Increment PLACE by X (1 by default). |
| 127 | PLACE may be a symbol, or any generalized variable allowed by `setf'. | 127 | PLACE may be a symbol, or any generalized variable allowed by `setf'. |
| 128 | The return value is the incremented value of PLACE." | 128 | The return value is the incremented value of PLACE." |
| 129 | (if (symbolp place) | 129 | (if (symbolp place) |
| @@ -131,7 +131,7 @@ The return value is the incremented value of PLACE." | |||
| 131 | (list 'callf '+ place (or x 1)))) | 131 | (list 'callf '+ place (or x 1)))) |
| 132 | 132 | ||
| 133 | (defmacro decf (place &optional x) | 133 | (defmacro decf (place &optional x) |
| 134 | "(decf PLACE [X]): decrement PLACE by X (1 by default). | 134 | "Decrement PLACE by X (1 by default). |
| 135 | PLACE may be a symbol, or any generalized variable allowed by `setf'. | 135 | PLACE may be a symbol, or any generalized variable allowed by `setf'. |
| 136 | The return value is the decremented value of PLACE." | 136 | The return value is the decremented value of PLACE." |
| 137 | (if (symbolp place) | 137 | (if (symbolp place) |
| @@ -139,7 +139,7 @@ The return value is the decremented value of PLACE." | |||
| 139 | (list 'callf '- place (or x 1)))) | 139 | (list 'callf '- place (or x 1)))) |
| 140 | 140 | ||
| 141 | (defmacro pop (place) | 141 | (defmacro pop (place) |
| 142 | "(pop PLACE): remove and return the head of the list stored in PLACE. | 142 | "Remove and return the head of the list stored in PLACE. |
| 143 | Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more | 143 | Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more |
| 144 | careful about evaluating each argument only once and in the right order. | 144 | careful about evaluating each argument only once and in the right order. |
| 145 | PLACE may be a symbol, or any generalized variable allowed by `setf'." | 145 | PLACE may be a symbol, or any generalized variable allowed by `setf'." |
| @@ -148,7 +148,7 @@ PLACE may be a symbol, or any generalized variable allowed by `setf'." | |||
| 148 | (cl-do-pop place))) | 148 | (cl-do-pop place))) |
| 149 | 149 | ||
| 150 | (defmacro push (x place) | 150 | (defmacro push (x place) |
| 151 | "(push X PLACE): insert X at the head of the list stored in PLACE. | 151 | "Insert X at the head of the list stored in PLACE. |
| 152 | Analogous to (setf PLACE (cons X PLACE)), though more careful about | 152 | Analogous to (setf PLACE (cons X PLACE)), though more careful about |
| 153 | evaluating each argument only once and in the right order. PLACE may | 153 | evaluating each argument only once and in the right order. PLACE may |
| 154 | be a symbol, or any generalized variable allowed by `setf'." | 154 | be a symbol, or any generalized variable allowed by `setf'." |