Mercurial > emacs
diff lisp/emacs-lisp/bytecomp.el @ 83676:27d11c1d4e46
Merge from emacs--devo--0
Patches applied:
* emacs--devo--0 (patch 857-862)
- Update from CVS
- Merge from emacs--rel--22
- Update from CVS: lisp/emacs-lisp/avl-tree.el: New file.
* emacs--rel--22 (patch 97-100)
- Update from CVS
- Merge from gnus--rel--5.10
* gnus--rel--5.10 (patch 246-247)
- Update from CVS
Revision: emacs@sv.gnu.org/emacs--multi-tty--0--patch-38
| author | Miles Bader <miles@gnu.org> |
|---|---|
| date | Mon, 27 Aug 2007 09:21:49 +0000 |
| parents | 92ccd83174e6 |
| children | cbeb8c965cdb b83d0dadb2a7 |
line wrap: on
line diff
--- a/lisp/emacs-lisp/bytecomp.el Mon Aug 27 08:16:42 2007 +0000 +++ b/lisp/emacs-lisp/bytecomp.el Mon Aug 27 09:21:49 2007 +0000 @@ -385,7 +385,7 @@ (defvar byte-compile-interactive-only-functions '(beginning-of-buffer end-of-buffer replace-string replace-regexp - insert-file insert-buffer insert-file-literally) + insert-file insert-buffer insert-file-literally previous-line next-line) "List of commands that are not meant to be called from Lisp.") (defvar byte-compile-not-obsolete-var nil @@ -1010,8 +1010,7 @@ (defun byte-compile-log-file () (and (not (equal byte-compile-current-file byte-compile-last-logged-file)) (not noninteractive) - (save-excursion - (set-buffer (get-buffer-create "*Compile-Log*")) + (with-current-buffer (get-buffer-create "*Compile-Log*") (goto-char (point-max)) (let* ((inhibit-read-only t) (dir (and byte-compile-current-file @@ -1548,8 +1547,7 @@ nil (save-some-buffers) (force-mode-line-update)) - (save-current-buffer - (set-buffer (get-buffer-create "*Compile-Log*")) + (with-current-buffer (get-buffer-create "*Compile-Log*") (setq default-directory (expand-file-name directory)) ;; compilation-mode copies value of default-directory. (unless (eq major-mode 'compilation-mode) @@ -1651,7 +1649,7 @@ (let ((b (get-file-buffer (expand-file-name filename)))) (if (and b (buffer-modified-p b) (y-or-n-p (format "Save buffer %s first? " (buffer-name b)))) - (save-excursion (set-buffer b) (save-buffer))))) + (with-current-buffer b (save-buffer))))) ;; Force logging of the file name for each file compiled. (setq byte-compile-last-logged-file nil) @@ -1661,9 +1659,8 @@ byte-compile-dest-file) (setq target-file (byte-compile-dest-file filename)) (setq byte-compile-dest-file target-file) - (save-excursion - (setq input-buffer (get-buffer-create " *Compiler Input*")) - (set-buffer input-buffer) + (with-current-buffer + (setq input-buffer (get-buffer-create " *Compiler Input*")) (erase-buffer) (setq buffer-file-coding-system nil) ;; Always compile an Emacs Lisp file as multibyte @@ -1864,7 +1861,13 @@ (not (eobp))) (setq byte-compile-read-position (point) byte-compile-last-position byte-compile-read-position) - (let ((form (read inbuffer))) + (let* ((old-style-backquotes nil) + (form (read inbuffer))) + ;; Warn about the use of old-style backquotes. + (when old-style-backquotes + (byte-compile-warn "!! The file uses old-style backquotes !! +This functionality has been obsolete for more than 10 years already +and will be removed soon. See (elisp)Backquote in the manual.")) (byte-compile-file-form form))) ;; Compile pending forms at end of file. (byte-compile-flush-pending) @@ -2037,85 +2040,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 +2402,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))