changeset 82791:25892386493b

(byte-compile-output-docform, byte-compile-output-as-comment): Use with-current-buffer rather than a weird set-buffer&prog1 combination.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Thu, 23 Aug 2007 19:58:31 +0000
parents 346e6c150fa0
children c657f0071d5d
files lisp/ChangeLog lisp/emacs-lisp/bytecomp.el
diffstat 2 files changed, 112 insertions(+), 112 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Thu Aug 23 19:56:16 2007 +0000
+++ b/lisp/ChangeLog	Thu Aug 23 19:58:31 2007 +0000
@@ -1,5 +1,9 @@
 2007-08-23  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+	* emacs-lisp/bytecomp.el (byte-compile-output-docform)
+	(byte-compile-output-as-comment): Use with-current-buffer rather than
+	a weird set-buffer&prog1 combination.
+
 	* emacs-lisp/byte-opt.el (byte-optimize-if): Move `progn' out of the test
 	so as to optimise cases where the `progn's result is constant.
 
--- a/lisp/emacs-lisp/bytecomp.el	Thu Aug 23 19:56:16 2007 +0000
+++ b/lisp/emacs-lisp/bytecomp.el	Thu Aug 23 19:58:31 2007 +0000
@@ -2037,85 +2037,83 @@
   ;; We need to examine byte-compile-dynamic-docstrings
   ;; in the input buffer (now current), not in the output buffer.
   (let ((dynamic-docstrings byte-compile-dynamic-docstrings))
-    (set-buffer
-     (prog1 (current-buffer)
-       (set-buffer outbuffer)
-       (let (position)
-
-	 ;; Insert the doc string, and make it a comment with #@LENGTH.
-	 (and (>= (nth 1 info) 0)
-	      dynamic-docstrings
-	      (not byte-compile-compatibility)
-	      (progn
-		;; Make the doc string start at beginning of line
-		;; for make-docfile's sake.
-		(insert "\n")
-		(setq position
-		      (byte-compile-output-as-comment
-		       (nth (nth 1 info) form) nil))
-		(setq position (- (position-bytes position) (point-min) -1))
-		;; If the doc string starts with * (a user variable),
-		;; negate POSITION.
-		(if (and (stringp (nth (nth 1 info) form))
-			 (> (length (nth (nth 1 info) form)) 0)
-			 (eq (aref (nth (nth 1 info) form) 0) ?*))
-		    (setq position (- position)))))
-
-	 (if preface
-	     (progn
-	       (insert preface)
-	       (prin1 name outbuffer)))
-	 (insert (car info))
-	 (let ((print-escape-newlines t)
-	       (print-quoted t)
-	       ;; For compatibility with code before print-circle,
-	       ;; use a cons cell to say that we want
-	       ;; print-gensym-alist not to be cleared
-	       ;; between calls to print functions.
-	       (print-gensym '(t))
-	       (print-circle	       ; handle circular data structures
-		(not byte-compile-disable-print-circle))
-	       print-gensym-alist    ; was used before print-circle existed.
-	       (print-continuous-numbering t)
-	       print-number-table
-	       (index 0))
-	   (prin1 (car form) outbuffer)
-	   (while (setq form (cdr form))
-	     (setq index (1+ index))
-	     (insert " ")
-	     (cond ((and (numberp specindex) (= index specindex)
-			 ;; Don't handle the definition dynamically
-			 ;; if it refers (or might refer)
-			 ;; to objects already output
-			 ;; (for instance, gensyms in the arg list).
-			 (let (non-nil)
-			   (dotimes (i (length print-number-table))
-			     (if (aref print-number-table i)
-				 (setq non-nil t)))
-			   (not non-nil)))
-		    ;; Output the byte code and constants specially
-		    ;; for lazy dynamic loading.
-		    (let ((position
-			   (byte-compile-output-as-comment
-			    (cons (car form) (nth 1 form))
-			    t)))
-		      (setq position (- (position-bytes position) (point-min) -1))
-		      (princ (format "(#$ . %d) nil" position) outbuffer)
-		      (setq form (cdr form))
-		      (setq index (1+ index))))
-		   ((= index (nth 1 info))
-		    (if position
-			(princ (format (if quoted "'(#$ . %d)"  "(#$ . %d)")
-				       position)
-			       outbuffer)
-		      (let ((print-escape-newlines nil))
-			(goto-char (prog1 (1+ (point))
-				     (prin1 (car form) outbuffer)))
-			(insert "\\\n")
-			(goto-char (point-max)))))
-		   (t
-		    (prin1 (car form) outbuffer)))))
-	 (insert (nth 2 info))))))
+    (with-current-buffer outbuffer
+      (let (position)
+
+        ;; Insert the doc string, and make it a comment with #@LENGTH.
+        (and (>= (nth 1 info) 0)
+             dynamic-docstrings
+             (not byte-compile-compatibility)
+             (progn
+               ;; Make the doc string start at beginning of line
+               ;; for make-docfile's sake.
+               (insert "\n")
+               (setq position
+                     (byte-compile-output-as-comment
+                      (nth (nth 1 info) form) nil))
+               (setq position (- (position-bytes position) (point-min) -1))
+               ;; If the doc string starts with * (a user variable),
+               ;; negate POSITION.
+               (if (and (stringp (nth (nth 1 info) form))
+                        (> (length (nth (nth 1 info) form)) 0)
+                        (eq (aref (nth (nth 1 info) form) 0) ?*))
+                   (setq position (- position)))))
+
+        (if preface
+            (progn
+              (insert preface)
+              (prin1 name outbuffer)))
+        (insert (car info))
+        (let ((print-escape-newlines t)
+              (print-quoted t)
+              ;; For compatibility with code before print-circle,
+              ;; use a cons cell to say that we want
+              ;; print-gensym-alist not to be cleared
+              ;; between calls to print functions.
+              (print-gensym '(t))
+              (print-circle             ; handle circular data structures
+               (not byte-compile-disable-print-circle))
+              print-gensym-alist     ; was used before print-circle existed.
+              (print-continuous-numbering t)
+              print-number-table
+              (index 0))
+          (prin1 (car form) outbuffer)
+          (while (setq form (cdr form))
+            (setq index (1+ index))
+            (insert " ")
+            (cond ((and (numberp specindex) (= index specindex)
+                        ;; Don't handle the definition dynamically
+                        ;; if it refers (or might refer)
+                        ;; to objects already output
+                        ;; (for instance, gensyms in the arg list).
+                        (let (non-nil)
+                          (dotimes (i (length print-number-table))
+                            (if (aref print-number-table i)
+                                (setq non-nil t)))
+                          (not non-nil)))
+                   ;; Output the byte code and constants specially
+                   ;; for lazy dynamic loading.
+                   (let ((position
+                          (byte-compile-output-as-comment
+                           (cons (car form) (nth 1 form))
+                           t)))
+                     (setq position (- (position-bytes position) (point-min) -1))
+                     (princ (format "(#$ . %d) nil" position) outbuffer)
+                     (setq form (cdr form))
+                     (setq index (1+ index))))
+                  ((= index (nth 1 info))
+                   (if position
+                       (princ (format (if quoted "'(#$ . %d)"  "(#$ . %d)")
+                                      position)
+                              outbuffer)
+                     (let ((print-escape-newlines nil))
+                       (goto-char (prog1 (1+ (point))
+                                    (prin1 (car form) outbuffer)))
+                       (insert "\\\n")
+                       (goto-char (point-max)))))
+                  (t
+                   (prin1 (car form) outbuffer)))))
+        (insert (nth 2 info)))))
   nil)
 
 (defun byte-compile-keep-pending (form &optional handler)
@@ -2401,39 +2399,37 @@
 ;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting.
 (defun byte-compile-output-as-comment (exp quoted)
   (let ((position (point)))
-    (set-buffer
-     (prog1 (current-buffer)
-       (set-buffer outbuffer)
-
-       ;; Insert EXP, and make it a comment with #@LENGTH.
-       (insert " ")
-       (if quoted
-	   (prin1 exp outbuffer)
-	 (princ exp outbuffer))
-       (goto-char position)
-       ;; Quote certain special characters as needed.
-       ;; get_doc_string in doc.c does the unquoting.
-       (while (search-forward "\^A" nil t)
-	 (replace-match "\^A\^A" t t))
-       (goto-char position)
-       (while (search-forward "\000" nil t)
-	 (replace-match "\^A0" t t))
-       (goto-char position)
-       (while (search-forward "\037" nil t)
-	 (replace-match "\^A_" t t))
-       (goto-char (point-max))
-       (insert "\037")
-       (goto-char position)
-       (insert "#@" (format "%d" (- (position-bytes (point-max))
-				    (position-bytes position))))
-
-       ;; Save the file position of the object.
-       ;; Note we should add 1 to skip the space
-       ;; that we inserted before the actual doc string,
-       ;; and subtract 1 to convert from an 1-origin Emacs position
-       ;; to a file position; they cancel.
-       (setq position (point))
-       (goto-char (point-max))))
+    (with-current-buffer outbuffer
+
+      ;; Insert EXP, and make it a comment with #@LENGTH.
+      (insert " ")
+      (if quoted
+          (prin1 exp outbuffer)
+        (princ exp outbuffer))
+      (goto-char position)
+      ;; Quote certain special characters as needed.
+      ;; get_doc_string in doc.c does the unquoting.
+      (while (search-forward "\^A" nil t)
+        (replace-match "\^A\^A" t t))
+      (goto-char position)
+      (while (search-forward "\000" nil t)
+        (replace-match "\^A0" t t))
+      (goto-char position)
+      (while (search-forward "\037" nil t)
+        (replace-match "\^A_" t t))
+      (goto-char (point-max))
+      (insert "\037")
+      (goto-char position)
+      (insert "#@" (format "%d" (- (position-bytes (point-max))
+                                   (position-bytes position))))
+
+      ;; Save the file position of the object.
+      ;; Note we should add 1 to skip the space
+      ;; that we inserted before the actual doc string,
+      ;; and subtract 1 to convert from an 1-origin Emacs position
+      ;; to a file position; they cancel.
+      (setq position (point))
+      (goto-char (point-max)))
     position))