Commit a464a6c7 authored by Stefan Monnier's avatar Stefan Monnier

More CL cleanups and reduction of use of cl.el.

* woman.el, winner.el, vc/vc-rcs.el, vc/vc-hooks.el, vc/vc-hg.el:
* vc/vc-git.el, vc/vc-dir.el, vc/vc-bzr.el, vc/vc-annotate.el:
* textmodes/tex-mode.el, textmodes/sgml-mode.el, tar-mode.el:
* strokes.el, ses.el, server.el, progmodes/js.el, progmodes/gdb-mi.el:
* progmodes/flymake.el, progmodes/ebrowse.el, progmodes/compile.el:
* play/tetris.el, play/snake.el, play/pong.el, play/landmark.el:
* play/hanoi.el, play/decipher.el, play/5x5.el, nxml/nxml-mode.el:
* net/secrets.el, net/quickurl.el, midnight.el, mail/footnote.el:
* image-dired.el, ibuffer.el, ibuf-macs.el, ibuf-ext.el, hexl.el:
* eshell/eshell.el, eshell/esh-io.el, eshell/esh-ext.el:
* eshell/esh-cmd.el, eshell/em-ls.el, eshell/em-hist.el:
* eshell/em-cmpl.el, eshell/em-banner.el:
* url/url.el, url/url-queue.el, url/url-parse.el, url/url-http.el:
* url/url-future.el, url/url-dav.el, url/url-cookie.el:
* calendar/parse-time.el, test/eshell.el: Use cl-lib.
* wid-browse.el, wdired.el, vc/vc.el, vc/vc-mtn.el, vc/vc-cvs.el:
* vc/vc-arch.el, tree-widget.el, textmodes/texinfo.el:
* textmodes/refill.el, textmodes/css-mode.el, term/tvi970.el:
* term/ns-win.el, term.el, shell.el, ps-samp.el:
* progmodes/perl-mode.el, progmodes/pascal.el, progmodes/gud.el:
* progmodes/glasses.el, progmodes/etags.el, progmodes/cwarn.el:
* play/gamegrid.el, play/bubbles.el, novice.el, notifications.el:
* net/zeroconf.el, net/xesam.el, net/snmp-mode.el, net/mairix.el:
* net/ldap.el, net/eudc.el, net/browse-url.el, man.el:
* mail/mailheader.el, mail/feedmail.el:
* url/url-util.el, url/url-privacy.el, url/url-nfs.el, url/url-misc.el:
* url/url-methods.el, url/url-gw.el, url/url-file.el, url/url-expand.el:
Dont use CL.
* ibuf-ext.el (ibuffer-mark-old-buffers): Use float-time.
* eshell/esh-opt.el (eshell-eval-using-options): Quote code with
`lambda' rather than with `quote'.
(eshell-do-opt): Adjust accordingly.
(eshell-process-option): Simplify.
* eshell/esh-var.el:
* eshell/em-script.el: Require `esh-opt' for eshell-eval-using-options.
* emacs-pcase.el (pcase--dontcare-upats, pcase--let*)
(pcase--expand, pcase--u1): Rename pcase's internal `dontcare' pattern
to `pcase--dontcare'.
* emacs-cl.el (labels): Mark obsolete.
(cl--letf, letf): Move to cl-lib.
(cl--letf*, letf*): Remove.
* emacs-cl-lib.el (cl-nth-value): Use defalias.
* emacs-cl-macs.el (cl-dolist, cl-dotimes): Add indent rule.
(cl-progv): Rewrite.
(cl--letf, cl-letf): Move from cl.el.
(cl-letf*): New macro.
* emacs-cl-extra.el (cl--progv-before, cl--progv-after): Remove.
parent c214e35e
2012-07-11 Stefan Monnier <monnier@iro.umontreal.ca>
More CL cleanups and reduction of use of cl.el.
* woman.el, winner.el, vc/vc-rcs.el, vc/vc-hooks.el, vc/vc-hg.el:
* vc/vc-git.el, vc/vc-dir.el, vc/vc-bzr.el, vc/vc-annotate.el:
* textmodes/tex-mode.el, textmodes/sgml-mode.el, tar-mode.el:
* strokes.el, ses.el, server.el, progmodes/js.el, progmodes/gdb-mi.el:
* progmodes/flymake.el, progmodes/ebrowse.el, progmodes/compile.el:
* play/tetris.el, play/snake.el, play/pong.el, play/landmark.el:
* play/hanoi.el, play/decipher.el, play/5x5.el, nxml/nxml-mode.el:
* net/secrets.el, net/quickurl.el, midnight.el, mail/footnote.el:
* image-dired.el, ibuffer.el, ibuf-macs.el, ibuf-ext.el, hexl.el:
* eshell/eshell.el, eshell/esh-io.el, eshell/esh-ext.el:
* eshell/esh-cmd.el, eshell/em-ls.el, eshell/em-hist.el:
* eshell/em-cmpl.el, eshell/em-banner.el:
* calendar/parse-time.el: Use cl-lib.
* wid-browse.el, wdired.el, vc/vc.el, vc/vc-mtn.el, vc/vc-cvs.el:
* vc/vc-arch.el, tree-widget.el, textmodes/texinfo.el:
* textmodes/refill.el, textmodes/css-mode.el, term/tvi970.el:
* term/ns-win.el, term.el, shell.el, ps-samp.el:
* progmodes/perl-mode.el, progmodes/pascal.el, progmodes/gud.el:
* progmodes/glasses.el, progmodes/etags.el, progmodes/cwarn.el:
* play/gamegrid.el, play/bubbles.el, novice.el, notifications.el:
* net/zeroconf.el, net/xesam.el, net/snmp-mode.el, net/mairix.el:
* net/ldap.el, net/eudc.el, net/browse-url.el, man.el:
* mail/mailheader.el, mail/feedmail.el: Don't use CL.
* ibuf-ext.el (ibuffer-mark-old-buffers): Use float-time.
* eshell/esh-opt.el (eshell-eval-using-options): Quote code with
`lambda' rather than with `quote'.
(eshell-do-opt): Adjust accordingly.
(eshell-process-option): Simplify.
* eshell/esh-var.el:
* eshell/em-script.el: Require `esh-opt' for eshell-eval-using-options.
* emacs-lisp/pcase.el (pcase--dontcare-upats, pcase--let*)
(pcase--expand, pcase--u1): Rename pcase's internal `dontcare' pattern
to `pcase--dontcare'.
* emacs-lisp/cl.el (labels): Mark obsolete.
(cl--letf, letf): Move to cl-lib.
(cl--letf*, letf*): Remove.
* emacs-lisp/cl-lib.el (cl-nth-value): Use defalias.
* emacs-lisp/cl-macs.el (cl-dolist, cl-dotimes): Add indent rule.
(cl-progv): Rewrite.
(cl--letf, cl-letf): Move from cl.el.
(cl-letf*): New macro.
* emacs-lisp/cl-extra.el (cl--progv-before, cl--progv-after): Remove.
2012-07-11 Michael Albinus <michael.albinus@gmx.de>
* net/ange-ftp.el (ange-ftp-cf1): Update the files cache.
......
......@@ -34,7 +34,7 @@
;;; Code:
(eval-when-compile (require 'cl)) ;and ah ain't kiddin' 'bout it
(eval-when-compile (require 'cl-lib))
(defvar parse-time-digits (make-vector 256 nil))
......@@ -43,8 +43,8 @@
(defvar parse-time-val)
(unless (aref parse-time-digits ?0)
(loop for i from ?0 to ?9
do (aset parse-time-digits i (- i ?0))))
(cl-loop for i from ?0 to ?9
do (aset parse-time-digits i (- i ?0))))
(defsubst digit-char-p (char)
(aref parse-time-digits char))
......@@ -92,11 +92,11 @@
(index 0)
(c nil))
(while (< index end)
(while (and (< index end) ;skip invalid characters
(while (and (< index end) ;Skip invalid characters.
(not (setq c (parse-time-string-chars (aref string index)))))
(incf index))
(cl-incf index))
(setq start index all-digits (eq c ?0))
(while (and (< (incf index) end) ;scan valid characters
(while (and (< (cl-incf index) end) ;Scan valid characters.
(setq c (parse-time-string-chars (aref string index))))
(setq all-digits (and all-digits (eq c ?0))))
(if (<= index end)
......
......@@ -313,25 +313,6 @@ If so, return the true (non-nil) value returned by PREDICATE.
(t (make-frame-visible frame)))
val)
;;; Support for `cl-progv'.
(defvar cl--progv-save)
;;;###autoload
(defun cl--progv-before (syms values)
(while syms
(push (if (boundp (car syms))
(cons (car syms) (symbol-value (car syms)))
(car syms)) cl--progv-save)
(if values
(set (pop syms) (pop values))
(makunbound (pop syms)))))
(defun cl--progv-after ()
(while cl--progv-save
(if (consp (car cl--progv-save))
(set (car (car cl--progv-save)) (cdr (car cl--progv-save)))
(makunbound (car cl--progv-save)))
(pop cl--progv-save)))
;;; Numbers.
......
......@@ -230,12 +230,13 @@ one value."
"Apply FUNCTION to ARGUMENTS, taking multiple values into account.
This implementation only handles the case where there is only one argument.")
(defsubst cl-nth-value (n expression)
(cl--defalias 'cl-nth-value #'nth
"Evaluate EXPRESSION to get multiple values and return the Nth one.
This handles multiple values in Common Lisp style, but it does not work
right when EXPRESSION calls an ordinary Emacs Lisp function that returns just
one value."
(nth n expression))
one value.
\(fn N EXPRESSION)")
;;; Declarations.
......
......@@ -624,7 +624,7 @@ Key values are compared by `eql'.
;;;###autoload
(defmacro cl-ecase (expr &rest clauses)
"Like `cl-case', but error if no cl-case fits.
"Like `cl-case', but error if no case fits.
`otherwise'-clauses are not allowed.
\n(fn EXPR (KEYLIST BODY...)...)"
(declare (indent 1) (debug cl-case))
......@@ -1482,7 +1482,8 @@ Then evaluate RESULT to get return value, default nil.
An implicit nil block is established around the loop.
\(fn (VAR LIST [RESULT]) BODY...)"
(declare (debug ((symbolp form &optional form) cl-declarations body)))
(declare (debug ((symbolp form &optional form) cl-declarations body))
(indent 1))
`(cl-block nil
(,(if (eq 'cl-dolist (symbol-function 'dolist)) 'cl--dolist 'dolist)
,spec ,@body)))
......@@ -1495,7 +1496,7 @@ to COUNT, exclusive. Then evaluate RESULT to get return value, default
nil.
\(fn (VAR COUNT [RESULT]) BODY...)"
(declare (debug cl-dolist))
(declare (debug cl-dolist) (indent 1))
`(cl-block nil
(,(if (eq 'cl-dotimes (symbol-function 'dotimes)) 'cl--dotimes 'dotimes)
,spec ,@body)))
......@@ -1546,10 +1547,19 @@ second list (or made unbound if VALUES is shorter than SYMBOLS); then the
BODY forms are executed and their result is returned. This is much like
a `let' form, except that the list of symbols can be computed at run-time."
(declare (indent 2) (debug (form form body)))
`(let ((cl--progv-save nil))
(unwind-protect
(progn (cl--progv-before ,symbols ,values) ,@body)
(cl--progv-after))))
(let ((bodyfun (make-symbol "body"))
(binds (make-symbol "binds"))
(syms (make-symbol "syms"))
(vals (make-symbol "vals")))
`(progn
(defvar ,bodyfun)
(let* ((,syms ,symbols)
(,vals ,values)
(,bodyfun (lambda () ,@body))
(,binds ()))
(while ,syms
(push (list (pop ,syms) (list 'quote (pop ,vals))) ,binds))
(eval (list 'let ,binds '(funcall ,bodyfun)))))))
(defvar cl--labels-convert-cache nil)
......@@ -1600,7 +1610,7 @@ Like `cl-labels' but the definitions are not recursive.
Like `cl-flet' but the definitions can refer to previous ones.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
(declare (indent 1) (debug ((&rest (cl-defun)) cl-declarations body)))
(declare (indent 1) (debug cl-flet))
(cond
((null bindings) (macroexp-progn body))
((null (cdr bindings)) `(cl-flet ,bindings ,@body))
......@@ -1609,7 +1619,8 @@ Like `cl-flet' but the definitions can refer to previous ones.
;;;###autoload
(defmacro cl-labels (bindings &rest body)
"Make temporary function bindings.
The bindings can be recursive. Assumes the use of `lexical-binding'.
The bindings can be recursive and the scoping is lexical, but capturing them
in closures will only work if `lexical-binding' is in use.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
(declare (indent 1) (debug cl-flet))
......@@ -1911,6 +1922,86 @@ Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
(macroexp-let* `((,temp ,getter))
`(progn ,(funcall setter form) nil))))))
;; FIXME: `letf' is unsatisfactory because it does not really "restore" the
;; previous state. If the getter/setter loses information, that info is
;; not recovered.
(defun cl--letf (bindings simplebinds binds body)
;; It's not quite clear what the semantics of cl-letf should be.
;; E.g. in (cl-letf ((PLACE1 VAL1) (PLACE2 VAL2)) BODY), while it's clear
;; that the actual assignments ("bindings") should only happen after
;; evaluating VAL1 and VAL2, it's not clear when the sub-expressions of
;; PLACE1 and PLACE2 should be evaluated. Should we have
;; PLACE1; VAL1; PLACE2; VAL2; bind1; bind2
;; or
;; VAL1; VAL2; PLACE1; PLACE2; bind1; bind2
;; or
;; VAL1; VAL2; PLACE1; bind1; PLACE2; bind2
;; Common-Lisp's `psetf' does the first, so we'll do the same.
(if (null bindings)
(if (and (null binds) (null simplebinds)) (macroexp-progn body)
`(let* (,@(mapcar (lambda (x)
(pcase-let ((`(,vold ,getter ,_setter ,_vnew) x))
(list vold getter)))
binds)
,@simplebinds)
(unwind-protect
,(macroexp-progn
(append
(delq nil
(mapcar (lambda (x)
(pcase x
;; If there's no vnew, do nothing.
(`(,_vold ,_getter ,setter ,vnew)
(funcall setter vnew))))
binds))
body))
,@(mapcar (lambda (x)
(pcase-let ((`(,vold ,_getter ,setter ,_vnew) x))
(funcall setter vold)))
binds))))
(let ((binding (car bindings)))
(gv-letplace (getter setter) (car binding)
(macroexp-let2 nil vnew (cadr binding)
(if (symbolp (car binding))
;; Special-case for simple variables.
(cl--letf (cdr bindings)
(cons `(,getter ,(if (cdr binding) vnew getter))
simplebinds)
binds body)
(cl--letf (cdr bindings) simplebinds
(cons `(,(make-symbol "old") ,getter ,setter
,@(if (cdr binding) (list vnew)))
binds)
body)))))))
;;;###autoload
(defmacro cl-letf (bindings &rest body)
"Temporarily bind to PLACEs.
This is the analogue of `let', but with generalized variables (in the
sense of `setf') for the PLACEs. Each PLACE is set to the corresponding
VALUE, then the BODY forms are executed. On exit, either normally or
because of a `throw' or error, the PLACEs are set back to their original
values. Note that this macro is *not* available in Common Lisp.
As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
the PLACE is not modified before executing BODY.
\(fn ((PLACE VALUE) ...) BODY...)"
(declare (indent 1) (debug ((&rest (gate gv-place &optional form)) body)))
(if (and (not (cdr bindings)) (cdar bindings) (symbolp (caar bindings)))
`(let ,bindings ,@body)
(cl--letf bindings () () body)))
;;;###autoload
(defmacro cl-letf* (bindings &rest body)
"Temporarily bind to PLACEs.
Like `cl-letf' but where the bindings are performed one at a time,
rather than all at the end (i.e. like `let*' rather than like `let')."
(declare (indent 1) (debug cl-letf))
(dolist (binding (reverse bindings))
(setq body (list `(cl-letf (,binding) ,@body))))
(macroexp-progn body))
;;;###autoload
(defmacro cl-callf (func place &rest args)
"Set PLACE to (FUNC PLACE ARGS...).
......
......@@ -222,7 +222,7 @@
callf2
callf
letf*
letf
;; letf
rotatef
shiftf
remf
......@@ -449,16 +449,6 @@ Common Lisp.
(setq body (list `(lexical-let (,(pop bindings)) ,@body))))
(car body)))
(defmacro cl--symbol-function (symbol)
"Like `symbol-function' but return `cl--unbound' if not bound."
;; (declare (gv-setter (lambda (store)
;; `(if (eq ,store 'cl--unbound)
;; (fmakunbound ,symbol) (fset ,symbol ,store)))))
`(if (fboundp ,symbol) (symbol-function ,symbol) 'cl--unbound))
(gv-define-setter cl--symbol-function (store symbol)
`(if (eq ,store 'cl--unbound) (fmakunbound ,symbol) (fset ,symbol ,store)))
;; This should really have some way to shadow 'byte-compile properties, etc.
(defmacro flet (bindings &rest body)
"Make temporary overriding function definitions.
......@@ -470,38 +460,36 @@ then the definitions are undone (the FUNCs go back to their previous
definitions, or lack thereof).
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
(declare (indent 1) (debug cl-flet))
`(letf* ,(mapcar
(lambda (x)
(if (or (and (fboundp (car x))
(eq (car-safe (symbol-function (car x))) 'macro))
(cdr (assq (car x) macroexpand-all-environment)))
(error "Use `labels', not `flet', to rebind macro names"))
(let ((func `(cl-function
(lambda ,(cadr x)
(cl-block ,(car x) ,@(cddr x))))))
(when (cl--compiling-file)
;; Bug#411. It would be nice to fix this.
(and (get (car x) 'byte-compile)
(error "Byte-compiling a redefinition of `%s' \
(declare (indent 1) (debug cl-flet)
(obsolete "Use either `cl-flet' or `cl-letf'." "24.2"))
`(letf ,(mapcar
(lambda (x)
(if (or (and (fboundp (car x))
(eq (car-safe (symbol-function (car x))) 'macro))
(cdr (assq (car x) macroexpand-all-environment)))
(error "Use `labels', not `flet', to rebind macro names"))
(let ((func `(cl-function
(lambda ,(cadr x)
(cl-block ,(car x) ,@(cddr x))))))
(when (cl--compiling-file)
;; Bug#411. It would be nice to fix this.
(and (get (car x) 'byte-compile)
(error "Byte-compiling a redefinition of `%s' \
will not work - use `labels' instead" (symbol-name (car x))))
;; FIXME This affects the rest of the file, when it
;; should be restricted to the flet body.
(and (boundp 'byte-compile-function-environment)
(push (cons (car x) (eval func))
byte-compile-function-environment)))
(list `(symbol-function ',(car x)) func)))
bindings)
;; FIXME This affects the rest of the file, when it
;; should be restricted to the flet body.
(and (boundp 'byte-compile-function-environment)
(push (cons (car x) (eval func))
byte-compile-function-environment)))
(list `(symbol-function ',(car x)) func)))
bindings)
,@body))
(make-obsolete 'flet "Use either `cl-flet' or `letf'." "24.2")
(defmacro labels (bindings &rest body)
"Make temporary function bindings.
This is like `flet', except the bindings are lexical instead of dynamic.
Unlike `flet', this macro is fully compliant with the Common Lisp standard.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
(declare (indent 1) (debug cl-flet))
Like `cl-labels' except that the lexical scoping is handled via `lexical-let'
rather than relying on `lexical-binding'."
(declare (indent 1) (debug cl-flet) (obsolete 'cl-labels "24.2"))
(let ((vars nil) (sets nil) (newenv macroexpand-all-environment))
(dolist (binding bindings)
;; It's important that (not (eq (symbol-name var1) (symbol-name var2)))
......@@ -521,93 +509,24 @@ Unlike `flet', this macro is fully compliant with the Common Lisp standard.
;; not 100% compatible: not worth the trouble to add them to cl-lib.el, but we
;; still need to support old users of cl.el.
;; FIXME: `letf' is unsatisfactory because it does not really "restore" the
;; previous state. If the getter/setter loses information, that info is
;; not recovered.
(defun cl--letf (bindings simplebinds binds body)
;; It's not quite clear what the semantics of let! should be.
;; E.g. in (let! ((PLACE1 VAL1) (PLACE2 VAL2)) BODY), while it's clear
;; that the actual assignments ("bindings") should only happen after
;; evaluating VAL1 and VAL2, it's not clear when the sub-expressions of
;; PLACE1 and PLACE2 should be evaluated. Should we have
;; PLACE1; VAL1; PLACE2; VAL2; bind1; bind2
;; or
;; VAL1; VAL2; PLACE1; PLACE2; bind1; bind2
;; or
;; VAL1; VAL2; PLACE1; bind1; PLACE2; bind2
;; Common-Lisp's `psetf' does the first, so we'll do the same.
(if (null bindings)
(if (and (null binds) (null simplebinds)) (macroexp-progn body)
`(let* (,@(mapcar (lambda (x)
(pcase-let ((`(,vold ,getter ,_setter ,_vnew) x))
(list vold getter)))
binds)
,@simplebinds)
(unwind-protect
,(macroexp-progn (append
(mapcar (lambda (x) (pcase x
(`(,_vold ,_getter ,setter ,vnew)
(funcall setter vnew))))
binds)
body))
,@(mapcar (lambda (x) (pcase-let ((`(,vold ,_getter ,setter ,_vnew) x))
(funcall setter vold)))
binds))))
(let ((binding (car bindings)))
(if (eq (car-safe (car binding)) 'symbol-function)
(setcar (car binding) 'cl--symbol-function))
(gv-letplace (getter setter) (car binding)
(macroexp-let2 nil vnew (cadr binding)
(if (symbolp (car binding))
;; Special-case for simple variables.
(cl--letf (cdr bindings)
(cons `(,getter ,(if (cdr binding) vnew getter))
simplebinds)
binds body)
(cl--letf (cdr bindings) simplebinds
(cons `(,(make-symbol "old") ,getter ,setter
,@(if (cdr binding) (list vnew)))
binds)
body)))))))
(defmacro cl--symbol-function (symbol)
"Like `symbol-function' but return `cl--unbound' if not bound."
;; (declare (gv-setter (lambda (store)
;; `(if (eq ,store 'cl--unbound)
;; (fmakunbound ,symbol) (fset ,symbol ,store)))))
`(if (fboundp ,symbol) (symbol-function ,symbol) 'cl--unbound))
(gv-define-setter cl--symbol-function (store symbol)
`(if (eq ,store 'cl--unbound) (fmakunbound ,symbol) (fset ,symbol ,store)))
(defmacro letf (bindings &rest body)
"Temporarily bind to PLACEs.
This is the analogue of `let', but with generalized variables (in the
sense of `setf') for the PLACEs. Each PLACE is set to the corresponding
VALUE, then the BODY forms are executed. On exit, either normally or
because of a `throw' or error, the PLACEs are set back to their original
values. Note that this macro is *not* available in Common Lisp.
As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
the PLACE is not modified before executing BODY.
\(fn ((PLACE VALUE) ...) BODY...)"
(declare (indent 1) (debug ((&rest (gate gv-place &optional form)) body)))
(cl--letf bindings () () body))
(defun cl--letf* (bindings body)
(if (null bindings)
(macroexp-progn body)
(let ((binding (car bindings)))
(if (symbolp (car binding))
;; Special-case for simple variables.
(macroexp-let* (list (if (cdr binding) binding
(list (car binding) (car binding))))
(cl--letf* (cdr bindings) body))
(if (eq (car-safe (car binding)) 'symbol-function)
(setcar (car binding) 'cl--symbol-function))
(gv-letplace (getter setter) (car binding)
(macroexp-let2 macroexp-copyable-p vnew (cadr binding)
(macroexp-let2 nil vold getter
`(unwind-protect
(progn
,(if (cdr binding) (funcall setter vnew))
,(cl--letf* (cdr bindings) body))
,(funcall setter vold)))))))))
(defmacro letf* (bindings &rest body)
(declare (indent 1) (debug letf))
(cl--letf* bindings body))
"Dynamically scoped let-style bindings for places.
Like `cl-letf', but with some extra backward compatibility."
;; Like cl-letf, but with special handling of symbol-function.
`(cl-letf ,(mapcar (lambda (x) (if (eq (car-safe (car x)) 'symbol-function)
`((cl--symbol-function ,@(cdar x)) ,@(cdr x))
x))
bindings)
,@body))
(defun cl--gv-adapt (cl-gv do)
;; This function is used by all .elc files that use define-setf-expander and
......
......@@ -466,6 +466,9 @@ Return nil if there are no more forms, t otherwise."
(add-to-list 'elint-features name)
;; cl loads cl-macs in an opaque manner.
;; Since cl-macs requires cl, we can just process cl-macs.
;; FIXME: AFAIK, `cl' now behaves properly and does not need any
;; special treatment any more. Can someone who understands this
;; code confirm? --Stef
(and (eq name 'cl) (not elint-doing-cl)
;; We need cl if elint-form is to be able to expand cl macros.
(require 'cl)
......
......@@ -64,7 +64,7 @@
;; (defconst pcase--memoize-1 (make-hash-table :test 'eq))
;; (defconst pcase--memoize-2 (make-hash-table :weakness 'key :test 'equal))
(defconst pcase--dontcare-upats '(t _ dontcare))
(defconst pcase--dontcare-upats '(t _ pcase--dontcare))
(def-edebug-spec
pcase-UPAT
......@@ -154,11 +154,12 @@ like `(,a . ,(pred (< a))) or, with more checks:
(pcase--expand
(cadr binding)
`((,(car binding) ,(pcase--let* bindings body))
;; We can either signal an error here, or just use `dontcare' which
;; generates more efficient code. In practice, if we use `dontcare'
;; we will still often get an error and the few cases where we don't
;; do not matter that much, so it's a better choice.
(dontcare nil)))))))
;; We can either signal an error here, or just use `pcase--dontcare'
;; which generates more efficient code. In practice, if we use
;; `pcase--dontcare' we will still often get an error and the few
;; cases where we don't do not matter that much, so
;; it's a better choice.
(pcase--dontcare nil)))))))
;;;###autoload
(defmacro pcase-let* (bindings &rest body)
......@@ -275,7 +276,7 @@ of the form (UPAT EXP)."
vars))))
cases))))
(dolist (case cases)
(unless (or (memq case used-cases) (eq (car case) 'dontcare))
(unless (or (memq case used-cases) (eq (car case) 'pcase--dontcare))
(message "Redundant pcase pattern: %S" (car case))))
(macroexp-let* defs main))))
......@@ -575,7 +576,7 @@ Otherwise, it defers to REST which is a list of branches of the form
(upat (cdr cdrpopmatches)))
(cond
((memq upat '(t _)) (pcase--u1 matches code vars rest))
((eq upat 'dontcare) :pcase--dontcare)
((eq upat 'pcase--dontcare) :pcase--dontcare)
((memq (car-safe upat) '(guard pred))
(if (eq (car upat) 'pred) (put sym 'pcase-used t))
(let* ((splitrest
......
......@@ -39,7 +39,7 @@
;;; Code:
(eval-when-compile
(require 'cl)
(require 'cl-lib)
(require 'esh-mode)
(require 'eshell))
......@@ -77,10 +77,10 @@ This can be any sexp, and should end with at least two newlines."
;; `insert', because `insert' doesn't know how to interact with the
;; I/O code used by Eshell
(unless eshell-non-interactive-p
(assert eshell-mode)
(assert eshell-banner-message)
(cl-assert eshell-mode)
(cl-assert eshell-banner-message)
(let ((msg (eval eshell-banner-message)))
(assert msg)
(cl-assert msg)
(eshell-interactive-print msg))))
(provide 'em-banner)
......
......@@ -70,7 +70,7 @@
;;; Code:
(eval-when-compile
(require 'cl)
(require 'cl-lib)
(require 'eshell))
(require 'esh-util)
......@@ -358,7 +358,7 @@ to writing a completion function."
(nconc posns (list pos)))
(setq pos (1+ pos))))
(setq posns (cdr posns))