Mercurial > emacs
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))