bug#11780: 24.1.50; vc-annotate fails for files in RCS. ("cl.el" `flet' problem?)

[Stefan Monnier <monnier@iro.umontreal.ca>]

>> Does the patch below fix things?
> Well no, because there are multiple `flet's in the file and that's not
> the one giving the immediate error.

Duh, right.  I have a patch to make flet behave as before, but that
behavior is a real horror, so I'd really prefer to move away from it:
cl-flet implements the Common-Lisp semantics, which is a lot saner.

Does the patch below fix things, this time?


        Stefan


=== modified file 'lisp/emacs-lisp/cl-macs.el'
--- lisp/emacs-lisp/cl-macs.el	2012-06-23 04:24:06 +0000
+++ lisp/emacs-lisp/cl-macs.el	2012-06-27 12:58:16 +0000
@@ -1570,7 +1570,6 @@
           (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 @@
              (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'.

=== modified file 'lisp/vc/vc-rcs.el'
--- lisp/vc/vc-rcs.el	2012-06-06 01:28:08 +0000
+++ lisp/vc/vc-rcs.el	2012-06-27 13:06:53 +0000
@@ -679,7 +679,7 @@
     ;; Apply reverse-chronological edits on the trunk, computing and
     ;; accumulating forward-chronological edits after some point, for
     ;; later.
-    (flet ((r/d/a () (vector pre
+    (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)))
@@ -769,7 +769,7 @@
                  ht)
         (setq maxw (max w maxw))))
     (let ((padding (make-string maxw 32)))
-      (flet ((pad (w) (substring-no-properties padding w))
+      (cl-flet ((pad (w) (substring-no-properties padding w))
              (render (rda &rest ls)
                      (propertize
                       (apply 'concat
@@ -1306,7 +1306,8 @@
         ;; 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:]'
+    (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)
@@ -1331,7 +1332,7 @@
                     (cons tok (if proc
                                   (funcall proc)
                                 (buffer-substring-no-properties b e))))
-           (k-semi (name &optional proc) (tok+val 'to-semi name proc))
+         (k-semi (name &optional proc) (tok+val #'to-semi name proc))
            (gather () (let ((pairs `(,e ,@@-holes ,b))
                             acc)
                         (while pairs
@@ -1340,15 +1341,15 @@
                                 acc)
                           (setq pairs (cddr pairs)))
                         (apply 'concat acc)))
-           (k-one@ (name &optional later) (tok+val 'to-one@ name
+         (k-one@ (name &optional later) (tok+val #'to-one@ name
                                                    (if later
                                                        (lambda () t)
-                                                     'gather))))
+                                                   #'gather))))
       (save-excursion
         (goto-char (point-min))
         ;; headers
         (setq context 'headers)
-        (flet ((hpush (name &optional proc)
+        (cl-flet ((hpush (name &optional proc)
                       (push (k-semi name proc) headers)))
           (hpush 'head)
           (when (at 'branch)
@@ -1391,7 +1392,7 @@
                                (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,7 +1422,8 @@
               ;; 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)
+          (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.
@@ -1429,7 +1431,7 @@
                                    ;; Thanks B.Mandelbrot, for complex sum.
                                    ;; O beauteous math! --the Unvexed Bum
                                    (unless asc
-                                     (setq sub 'buffer-substring-no-properties))
+                              (setq sub #'buffer-substring-no-properties))
                                    (gather))))
             (while (and (sw)
                         (not (eobp))
@@ -1449,8 +1451,8 @@
                   (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)