* lisp/emacs-lisp/cl.el (flet): Mark obsolete.

* lisp/emacs-lisp/cl-macs.el (cl-flet*): New macro.
* lisp/vc/vc-rcs.el (vc-rcs-annotate-command, vc-rcs-parse):
* lisp/progmodes/js.el (js-c-fill-paragraph):
* lisp/progmodes/ebrowse.el (ebrowse-switch-member-buffer-to-sibling-class)
(ebrowse-switch-member-buffer-to-derived-class):
* test/automated/ert-x-tests.el (ert-test-run-tests-interactively-2):
* lisp/play/5x5.el (5x5-solver): Use cl-flet.

Fixes: debbugs:11780

9 files changed, 148 insertions, 113 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 180f87e46b0..cb70d88b849 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,13 @@
 2012-06-27  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+	* emacs-lisp/cl.el (flet): Mark obsolete.
+	* emacs-lisp/cl-macs.el (cl-flet*): New macro.
+	* vc/vc-rcs.el (vc-rcs-annotate-command, vc-rcs-parse):
+	* progmodes/js.el (js-c-fill-paragraph):
+	* progmodes/ebrowse.el (ebrowse-switch-member-buffer-to-sibling-class)
+	(ebrowse-switch-member-buffer-to-derived-class):
+	* play/5x5.el (5x5-solver): Use cl-flet.
+
 	* emacs-lisp/cl.el: Use lexical-binding.  Fix flet (bug#11780).
 	(cl--symbol-function): New macro.
 	(cl--letf, cl--letf*): Use it.
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el
index f7eaa3b9f9c..4d7e1ecc8b0 100644
--- a/lisp/emacs-lisp/cl-loaddefs.el
+++ b/lisp/emacs-lisp/cl-loaddefs.el
@@ -260,12 +260,12 @@ Remove from SYMBOL's plist the property PROPNAME and its value.
 ;;;;;;  cl-deftype cl-defstruct cl-callf2 cl-callf cl-rotatef cl-shiftf
 ;;;;;;  cl-remf cl-psetf cl-declare cl-the cl-locally cl-multiple-value-setq
 ;;;;;;  cl-multiple-value-bind cl-symbol-macrolet cl-macrolet cl-labels
-;;;;;;  cl-flet cl-progv cl-psetq cl-do-all-symbols cl-do-symbols
+;;;;;;  cl-flet* cl-flet cl-progv cl-psetq cl-do-all-symbols cl-do-symbols
 ;;;;;;  cl-dotimes cl-dolist cl-do* cl-do cl-loop cl-return-from
 ;;;;;;  cl-return cl-block cl-etypecase cl-typecase cl-ecase cl-case
 ;;;;;;  cl-load-time-value cl-eval-when cl-destructuring-bind cl-function
 ;;;;;;  cl-defmacro cl-defun cl-gentemp cl-gensym) "cl-macs" "cl-macs.el"
-;;;;;;  "41a15289eda7e6ae03ac9edd86bbb1a6")
+;;;;;;  "e7bb76130254614df1603a1c1e89cb49")
 ;;; Generated autoloads from cl-macs.el
 
 (autoload 'cl-gensym "cl-macs" "\
@@ -492,6 +492,14 @@ Like `cl-labels' but the definitions are not recursive.
 
 (put 'cl-flet 'lisp-indent-function '1)
 
+(autoload 'cl-flet* "cl-macs" "\
+Make temporary function definitions.
+Like `cl-flet' but the definitions can refer to previous ones.
+
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t)
+
+(put 'cl-flet* 'lisp-indent-function '1)
+
 (autoload 'cl-labels "cl-macs" "\
 Make temporary function bindings.
 The bindings can be recursive.  Assumes the use of `lexical-binding'.
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index eaa988bfb58..39e230cb32c 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1570,7 +1570,6 @@ a `let' form, except that the list of symbols can be computed at run-time."
           (setq cl--labels-convert-cache (cons f res))
           res))))))
 
-;;; This should really have some way to shadow 'byte-compile properties, etc.
 ;;;###autoload
 (defmacro cl-flet (bindings &rest body)
   "Make temporary function definitions.
@@ -1596,6 +1595,18 @@ Like `cl-labels' but the definitions are not recursive.
              (cons (cons 'function #'cl--labels-convert) newenv)))))))
 
 ;;;###autoload
+(defmacro cl-flet* (bindings &rest body)
+  "Make temporary function definitions.
+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)))
+  (cond
+   ((null bindings) (macroexp-progn body))
+   ((null (cdr bindings)) `(cl-flet ,bindings ,@body))
+   (t `(cl-flet (,(pop bindings)) (cl-flet* ,bindings ,@body)))))
+
+;;;###autoload
 (defmacro cl-labels (bindings &rest body)
   "Make temporary function bindings.
 The bindings can be recursive.  Assumes the use of `lexical-binding'.
@@ -2257,6 +2268,7 @@ STRING is an optional description of the desired type."
 
 ;;;###autoload
 (defmacro cl-assert (form &optional show-args string &rest args)
+  ;; FIXME: This is actually not compatible with Common-Lisp's `assert'.
   "Verify that FORM returns non-nil; signal an error if not.
 Second arg SHOW-ARGS means to include arguments of FORM in message.
 Other args STRING and ARGS... are arguments to be passed to `error'.
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index 7996af4e02d..0b6d9cd2223 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -461,11 +461,13 @@ Common Lisp.
 
 ;; This should really have some way to shadow 'byte-compile properties, etc.
 (defmacro flet (bindings &rest body)
-  "Make temporary function definitions.
-This is an analogue of `let' that operates on the function cell of FUNC
-rather than its value cell.  The FORMs are evaluated with the specified
-function definitions in place, then the definitions are undone (the FUNCs
-go back to their previous definitions, or lack thereof).
+  "Make temporary overriding function definitions.
+This is an analogue of a dynamically scoped `let' that operates on the function
+cell of FUNCs rather than their value cell.
+If you want the Common-Lisp style of `flet', you should use `cl-flet'.
+The FORMs are evaluated with the specified function definitions in place,
+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))
@@ -491,6 +493,7 @@ will not work - use `labels' instead" (symbol-name (car x))))
                 (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.
diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el
index b2fffb49840..c0a642941f4 100644
--- a/lisp/play/5x5.el
+++ b/lisp/play/5x5.el
@@ -568,14 +568,14 @@ to complete the 5x5.
 
 Solutions are sorted from least to greatest Hamming weight."
   (require 'calc-ext)
-  (flet ((5x5-mat-mode-2
-	  (a)
-	  (math-map-vec
-	   (lambda (y)
-	     (math-map-vec
-	      (lambda (x) `(mod ,x 2))
-	      y))
-	   a)))
+  (cl-flet ((5x5-mat-mode-2
+             (a)
+             (math-map-vec
+              (lambda (y)
+                (math-map-vec
+                 (lambda (x) `(mod ,x 2))
+                 y))
+              a)))
     (let* (calc-command-flags
 	   (grid-size-squared (* 5x5-grid-size 5x5-grid-size))
 
@@ -658,8 +658,8 @@ Solutions are sorted from least to greatest Hamming weight."
 		       (cdr (5x5-mat-mode-2
 			     '(vec (vec 0 1 1 1 0 1 0 1 0 1 1 1 0 1
 					1 1 0 1 0 1 0 1 1 1 0)
-				   (vec 1 1 0 1 1 0 0 0 0 0 1 1 0 1
-					1 0 0 0 0 0 1 1 0 1 1)))))
+                               (vec 1 1 0 1 1 0 0 0 0 0 1 1 0 1
+                                    1 0 0 0 0 0 1 1 0 1 1)))))
 	       (calcFunc-trn id))))
 
 	   (inv-base-change
diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el
index 5c2ba080d31..ce190d25157 100644
--- a/lisp/progmodes/ebrowse.el
+++ b/lisp/progmodes/ebrowse.el
@@ -2957,10 +2957,10 @@ Prefix arg INC specifies which one."
   (let ((containing-list ebrowse--tree)
 	index cls
 	(supers (ebrowse-direct-base-classes ebrowse--displayed-class)))
-    (flet ((trees-alist (trees)
-			(loop for tr in trees
-			      collect (cons (ebrowse-cs-name
-					     (ebrowse-ts-class tr)) tr))))
+    (cl-flet ((trees-alist (trees)
+                           (loop for tr in trees
+                                 collect (cons (ebrowse-cs-name
+                                                (ebrowse-ts-class tr)) tr))))
       (when supers
 	(let ((tree (if (second supers)
 			(ebrowse-completing-read-value
@@ -2985,11 +2985,11 @@ Prefix arg INC specifies which one."
 Prefix arg ARG says which class should be displayed.  Default is
 the first derived class."
   (interactive "P")
-  (flet ((ebrowse-tree-obarray-as-alist ()
-					(loop for s in (ebrowse-ts-subclasses
-							ebrowse--displayed-class)
-					      collect (cons (ebrowse-cs-name
-							     (ebrowse-ts-class s)) s))))
+  (cl-flet ((ebrowse-tree-obarray-as-alist ()
+               (loop for s in (ebrowse-ts-subclasses
+                               ebrowse--displayed-class)
+                     collect (cons (ebrowse-cs-name
+                                    (ebrowse-ts-class s)) s))))
     (let ((subs (or (ebrowse-ts-subclasses ebrowse--displayed-class)
 		    (error "No derived classes"))))
       (if (and arg (second subs))
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index cdc3ef1c2e0..2e943be412b 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -1821,15 +1821,15 @@ nil."
 (defun js-c-fill-paragraph (&optional justify)
   "Fill the paragraph with `c-fill-paragraph'."
   (interactive "*P")
-  (flet ((c-forward-sws
-          (&optional limit)
-          (js--forward-syntactic-ws limit))
-         (c-backward-sws
-          (&optional limit)
-          (js--backward-syntactic-ws limit))
-         (c-beginning-of-macro
-          (&optional limit)
-          (js--beginning-of-macro limit)))
+  (letf (((symbol-function 'c-forward-sws)
+          (lambda (&optional limit)
+            (js--forward-syntactic-ws limit)))
+         ((symbol-function 'c-backward-sws)
+          (lambda (&optional limit)
+            (js--backward-syntactic-ws limit)))
+         ((symbol-function 'c-beginning-of-macro)
+          (lambda (&optional limit)
+            (js--beginning-of-macro limit))))
     (let ((fill-paragraph-function 'c-fill-paragraph))
       (c-fill-paragraph justify))))
 
diff --git a/lisp/ses.el b/lisp/ses.el
index a6a6aa91b5c..7429653c7de 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -3380,21 +3380,23 @@ Use `math-format-value' as a printer for Calc objects."
 	    (setq iter (cdr iter))))
 	(setq result ret)))
 
-    (flet ((vectorize-*1
-	    (clean result)
-	    (cons clean (cons (quote 'vec) (apply 'append result))))
-	   (vectorize-*2
-	    (clean result)
-	    (cons clean (cons (quote 'vec) (mapcar (lambda (x)
-						     (cons  clean (cons (quote 'vec) x)))
-						   result)))))
+    (cl-flet ((vectorize-*1
+               (clean result)
+               (cons clean (cons (quote 'vec) (apply 'append result))))
+              (vectorize-*2
+               (clean result)
+               (cons clean (cons (quote 'vec)
+                                 (mapcar (lambda (x)
+                                           (cons  clean (cons (quote 'vec) x)))
+                                         result)))))
       (case vectorize
 	((nil) (cons clean (apply 'append result)))
 	((*1) (vectorize-*1 clean result))
 	((*2) (vectorize-*2 clean result))
-	((*) (if (cdr result)
-	       (vectorize-*2 clean result)
-	     (vectorize-*1 clean result)))))))
+	((*) (funcall (if (cdr result)
+                          #'vectorize-*2
+                        #'vectorize-*1)
+                      clean result))))))
 
 (defun ses-delete-blanks (&rest args)
   "Return ARGS reversed, with the blank elements (nil and *skip*) removed."
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index 104e6fd59e3..4f50e1c8690 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -679,9 +679,9 @@ Optional arg REVISION is a revision to annotate from."
     ;; Apply reverse-chronological edits on the trunk, computing and
     ;; accumulating forward-chronological edits after some point, for
     ;; later.
-    (flet ((r/d/a () (vector pre
-                             (cdr (assq 'date meta))
-                             (cdr (assq 'author meta)))))
+    (cl-flet ((r/d/a () (vector pre
+                                (cdr (assq 'date meta))
+                                (cdr (assq 'author meta)))))
       (while (when (setq pre cur cur (cdr (assq 'next meta)))
                (not (string= "" cur)))
         (setq
@@ -769,16 +769,16 @@ Optional arg REVISION is a revision to annotate from."
                  ht)
         (setq maxw (max w maxw))))
     (let ((padding (make-string maxw 32)))
-      (flet ((pad (w) (substring-no-properties padding w))
-             (render (rda &rest ls)
-                     (propertize
-                      (apply 'concat
-                             (format-time-string "%Y-%m-%d" (aref rda 1))
-                             "  "
-                             (aref rda 0)
-                             ls)
-                      :vc-annotate-prefix t
-                      :vc-rcs-r/d/a rda)))
+      (cl-flet ((pad (w) (substring-no-properties padding w))
+                (render (rda &rest ls)
+                        (propertize
+                         (apply 'concat
+                                (format-time-string "%Y-%m-%d" (aref rda 1))
+                                "  "
+                                (aref rda 0)
+                                ls)
+                         :vc-annotate-prefix t
+                         :vc-rcs-r/d/a rda)))
         (maphash
          (if all-me
              (lambda (rda w)
@@ -1306,50 +1306,51 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
         ;; to "de-@@-format" the printed representation as the first step
         ;; to translating it into some value.  See internal func `gather'.
         @-holes)
-    (flet ((sw () (skip-chars-forward " \t\n")) ; i.e., `[:space:]'
-           (at (tag) (save-excursion (eq tag (read buffer))))
-           (to-eol () (buffer-substring-no-properties
-                       (point) (progn (forward-line 1)
-                                      (1- (point)))))
-           (to-semi () (setq b (point)
-                             e (progn (search-forward ";")
-                                      (1- (point)))))
-           (to-one@ () (setq @-holes nil
-                             b (progn (search-forward "@") (point))
-                             e (progn (while (and (search-forward "@")
-                                                  (= ?@ (char-after))
-                                                  (progn
-                                                    (push (point) @-holes)
-                                                    (forward-char 1)
-                                                    (push (point) @-holes))))
-                                      (1- (point)))))
-           (tok+val (set-b+e name &optional proc)
-                    (unless (eq name (setq tok (read buffer)))
-                      (error "Missing `%s' while parsing %s" name context))
-                    (sw)
-                    (funcall set-b+e)
-                    (cons tok (if proc
-                                  (funcall proc)
-                                (buffer-substring-no-properties b e))))
-           (k-semi (name &optional proc) (tok+val 'to-semi name proc))
-           (gather () (let ((pairs `(,e ,@@-holes ,b))
-                            acc)
-                        (while pairs
-                          (push (buffer-substring-no-properties
-                                 (cadr pairs) (car pairs))
-                                acc)
-                          (setq pairs (cddr pairs)))
-                        (apply 'concat acc)))
-           (k-one@ (name &optional later) (tok+val 'to-one@ name
-                                                   (if later
-                                                       (lambda () t)
-                                                     'gather))))
+    (cl-flet*
+        ((sw () (skip-chars-forward " \t\n")) ; i.e., `[:space:]'
+         (at (tag) (save-excursion (eq tag (read buffer))))
+         (to-eol () (buffer-substring-no-properties
+                     (point) (progn (forward-line 1)
+                                    (1- (point)))))
+         (to-semi () (setq b (point)
+                           e (progn (search-forward ";")
+                                    (1- (point)))))
+         (to-one@ () (setq @-holes nil
+                           b (progn (search-forward "@") (point))
+                           e (progn (while (and (search-forward "@")
+                                                (= ?@ (char-after))
+                                                (progn
+                                                  (push (point) @-holes)
+                                                  (forward-char 1)
+                                                  (push (point) @-holes))))
+                                    (1- (point)))))
+         (tok+val (set-b+e name &optional proc)
+                  (unless (eq name (setq tok (read buffer)))
+                    (error "Missing `%s' while parsing %s" name context))
+                  (sw)
+                  (funcall set-b+e)
+                  (cons tok (if proc
+                                (funcall proc)
+                              (buffer-substring-no-properties b e))))
+         (k-semi (name &optional proc) (tok+val #'to-semi name proc))
+         (gather () (let ((pairs `(,e ,@@-holes ,b))
+                          acc)
+                      (while pairs
+                        (push (buffer-substring-no-properties
+                               (cadr pairs) (car pairs))
+                              acc)
+                        (setq pairs (cddr pairs)))
+                      (apply 'concat acc)))
+         (k-one@ (name &optional later) (tok+val #'to-one@ name
+                                                 (if later
+                                                     (lambda () t)
+                                                   #'gather))))
       (save-excursion
         (goto-char (point-min))
         ;; headers
         (setq context 'headers)
-        (flet ((hpush (name &optional proc)
-                      (push (k-semi name proc) headers)))
+        (cl-flet ((hpush (name &optional proc)
+                         (push (k-semi name proc) headers)))
           (hpush 'head)
           (when (at 'branch)
             (hpush 'branch))
@@ -1391,7 +1392,7 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
                                (when (< (car ls) 100)
                                  (setcar ls (+ 1900 (car ls))))
                                (apply 'encode-time (nreverse ls)))))
-                  ,@(mapcar 'k-semi '(author state))
+                  ,@(mapcar #'k-semi '(author state))
                   ,(k-semi 'branches
                            (lambda ()
                              (split-string
@@ -1421,16 +1422,17 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
               ;; only the former since it behaves identically to the
               ;; latter in the absence of "@@".)
               sub)
-          (flet ((incg (beg end) (let ((b beg) (e end) @-holes)
-                                   (while (and asc (< (car asc) e))
-                                     (push (pop asc) @-holes))
-                                   ;; Self-deprecate when work is done.
-                                   ;; Folding many dimensions into one.
-                                   ;; Thanks B.Mandelbrot, for complex sum.
-                                   ;; O beauteous math! --the Unvexed Bum
-                                   (unless asc
-                                     (setq sub 'buffer-substring-no-properties))
-                                   (gather))))
+          (cl-flet ((incg (beg end)
+                          (let ((b beg) (e end) @-holes)
+                            (while (and asc (< (car asc) e))
+                              (push (pop asc) @-holes))
+                            ;; Self-deprecate when work is done.
+                            ;; Folding many dimensions into one.
+                            ;; Thanks B.Mandelbrot, for complex sum.
+                            ;; O beauteous math! --the Unvexed Bum
+                            (unless asc
+                              (setq sub #'buffer-substring-no-properties))
+                            (gather))))
             (while (and (sw)
                         (not (eobp))
                         (setq context (to-eol)
@@ -1449,8 +1451,8 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
                   (setcdr (cadr rev) (gather))
                 (if @-holes
                     (setq asc (nreverse @-holes)
-                          sub 'incg)
-                  (setq sub 'buffer-substring-no-properties))
+                          sub #'incg)
+                  (setq sub #'buffer-substring-no-properties))
                 (goto-char b)
                 (setq acc nil)
                 (while (< (point) e)