;; 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)
;; 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))
projects / emacs.git / commitdiff