(cl-transform-lambda): Preserve the match-data.

2 files changed, 17 insertions, 9 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 067a6291c3e..16edb115181 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,7 @@
+2007-08-16  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * emacs-lisp/cl-macs.el (cl-transform-lambda): Preserve the match-data.
+
 2007-08-16  Glenn Morris  <rgm@gnu.org>
 
         * ps-print.el (ps-font-size): Doc fix.
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 5a79a6424e0..e4a84e44e64 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -266,15 +266,19 @@ its argument list allows full Common Lisp conventions."
              (nconc (nreverse simple-args)
                     (list '&rest (car (pop bind-lets))))
              (nconc (let ((hdr (nreverse header)))
-                      (require 'help-fns)
-                      (cons (help-add-fundoc-usage
-                             (if (stringp (car hdr)) (pop hdr))
-                             ;; orig-args can contain &cl-defs (an internal CL
-                             ;; thingy that I do not understand), so remove it.
-                             (let ((x (memq '&cl-defs orig-args)))
-                               (if (null x) orig-args
-                                 (delq (car x) (remq (cadr x) orig-args)))))
-                            hdr))
+                      ;; Macro expansion can take place in the middle of
+                      ;; apparently harmless computation, so it should not
+                      ;; touch the match-data.
+                      (save-match-data
+                        (require 'help-fns)
+                        (cons (help-add-fundoc-usage
+                               (if (stringp (car hdr)) (pop hdr))
+                               ;; orig-args can contain &cl-defs (an internal
+                               ;; CL thingy I don't understand), so remove it.
+                               (let ((x (memq '&cl-defs orig-args)))
+                                 (if (null x) orig-args
+                                   (delq (car x) (remq (cadr x) orig-args)))))
+                              hdr)))
                     (list (nconc (list 'let* bind-lets)
                                  (nreverse bind-forms) body)))))))