emacs: lisp/emacs-lisp/bytecomp.el comparison

comparison 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

comparison

equal deleted inserted replaced

-:67601f702028
+:27d11c1d4e46
 		   x)
 		  x))))
 (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
 "If non-nil, this is a variable that shouldn't be reported as obsolete.")
 ;; Return the position of the start of the page in the log buffer.
 ;; But do nothing in batch mode.
 (defun byte-compile-log-file ()
 (and (not (equal byte-compile-current-file byte-compile-last-logged-file))
 (not noninteractive)
-(save-excursion
+(with-current-buffer (get-buffer-create "*Compile-Log*")
-	 (set-buffer (get-buffer-create "*Compile-Log*"))
 	 (goto-char (point-max))
 	 (let* ((inhibit-read-only t)
 		(dir (and byte-compile-current-file
 			  (file-name-directory byte-compile-current-file)))
 		(was-same (equal default-directory dir))
 (setq arg (prefix-numeric-value arg)))
 (if noninteractive
 nil
 (save-some-buffers)
 (force-mode-line-update))
-(save-current-buffer
+(with-current-buffer (get-buffer-create "*Compile-Log*")
-(set-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)
 (compilation-mode))
 (let ((directories (list (expand-file-name directory)))
 ;; to save it first.
 (or noninteractive
 (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)
 (let ((byte-compile-current-file filename)
 	(set-auto-coding-for-load t)
 	target-file input-buffer output-buffer
 	byte-compile-dest-file)
 (setq target-file (byte-compile-dest-file filename))
 (setq byte-compile-dest-file target-file)
-(save-excursion
+(with-current-buffer
 (setq input-buffer (get-buffer-create " *Compiler Input*"))
-(set-buffer input-buffer)
 (erase-buffer)
 (setq buffer-file-coding-system nil)
 ;; Always compile an Emacs Lisp file as multibyte
 ;; unless the file itself forces unibyte with -*-coding: raw-text;-*-
 (set-buffer-multibyte t)
 			       (looking-at ";"))
 		   (forward-line 1))
 		 (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)
 	;; Make warnings about unresolved functions
 	;; give the end of the file as their position.
 list that represents a doc string reference.
 `autoload' and `custom-declare-variable' need that."
 ;; 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
+(with-current-buffer outbuffer
-(prog1 (current-buffer)
+(let (position)
-(set-buffer outbuffer)
-(let (position)
+;; Insert the doc string, and make it a comment with #@LENGTH.
+(and (>= (nth 1 info) 0)
-	 ;; Insert the doc string, and make it a comment with #@LENGTH.
+dynamic-docstrings
-	 (and (>= (nth 1 info) 0)
+(not byte-compile-compatibility)
-	      dynamic-docstrings
+(progn
-	      (not byte-compile-compatibility)
+;; Make the doc string start at beginning of line
-	      (progn
+;; for make-docfile's sake.
-		;; Make the doc string start at beginning of line
+(insert "\n")
-		;; for make-docfile's sake.
+(setq position
-		(insert "\n")
+(byte-compile-output-as-comment
-		(setq position
+(nth (nth 1 info) form) nil))
-		      (byte-compile-output-as-comment
+(setq position (- (position-bytes position) (point-min) -1))
-		       (nth (nth 1 info) form) nil))
+;; If the doc string starts with * (a user variable),
-		(setq position (- (position-bytes position) (point-min) -1))
+;; negate POSITION.
-		;; If the doc string starts with * (a user variable),
+(if (and (stringp (nth (nth 1 info) form))
-		;; negate POSITION.
+(> (length (nth (nth 1 info) form)) 0)
-		(if (and (stringp (nth (nth 1 info) form))
+(eq (aref (nth (nth 1 info) form) 0) ?*))
-			 (> (length (nth (nth 1 info) form)) 0)
+(setq position (- position)))))
-			 (eq (aref (nth (nth 1 info) form) 0) ?*))
-		    (setq position (- position)))))
+(if preface
+(progn
-	 (if preface
+(insert preface)
-	     (progn
+(prin1 name outbuffer)))
-	       (insert preface)
+(insert (car info))
-	       (prin1 name outbuffer)))
+(let ((print-escape-newlines t)
-	 (insert (car info))
+(print-quoted t)
-	 (let ((print-escape-newlines t)
+;; For compatibility with code before print-circle,
-	       (print-quoted t)
+;; use a cons cell to say that we want
-	       ;; For compatibility with code before print-circle,
+;; print-gensym-alist not to be cleared
-	       ;; use a cons cell to say that we want
+;; between calls to print functions.
-	       ;; print-gensym-alist not to be cleared
+(print-gensym '(t))
-	       ;; between calls to print functions.
+(print-circle             ; handle circular data structures
-	       (print-gensym '(t))
+(not byte-compile-disable-print-circle))
-	       (print-circle	       ; handle circular data structures
+print-gensym-alist     ; was used before print-circle existed.
-		(not byte-compile-disable-print-circle))
+(print-continuous-numbering t)
-	       print-gensym-alist    ; was used before print-circle existed.
+print-number-table
-	       (print-continuous-numbering t)
+(index 0))
-	       print-number-table
+(prin1 (car form) outbuffer)
-	       (index 0))
+(while (setq form (cdr form))
-	   (prin1 (car form) outbuffer)
+(setq index (1+ index))
-	   (while (setq form (cdr form))
+(insert " ")
-	     (setq index (1+ index))
+(cond ((and (numberp specindex) (= index specindex)
-	     (insert " ")
+;; Don't handle the definition dynamically
-	     (cond ((and (numberp specindex) (= index specindex)
+;; if it refers (or might refer)
-			 ;; Don't handle the definition dynamically
+;; to objects already output
-			 ;; if it refers (or might refer)
+;; (for instance, gensyms in the arg list).
-			 ;; to objects already output
+(let (non-nil)
-			 ;; (for instance, gensyms in the arg list).
+(dotimes (i (length print-number-table))
-			 (let (non-nil)
+(if (aref print-number-table i)
-			   (dotimes (i (length print-number-table))
+(setq non-nil t)))
-			     (if (aref print-number-table i)
+(not non-nil)))
-				 (setq non-nil t)))
+;; Output the byte code and constants specially
-			   (not non-nil)))
+;; for lazy dynamic loading.
-		    ;; Output the byte code and constants specially
+(let ((position
-		    ;; for lazy dynamic loading.
+(byte-compile-output-as-comment
-		    (let ((position
+(cons (car form) (nth 1 form))
-			   (byte-compile-output-as-comment
+t)))
-			    (cons (car form) (nth 1 form))
+(setq position (- (position-bytes position) (point-min) -1))
-			    t)))
+(princ (format "(#$ . %d) nil" position) outbuffer)
-		      (setq position (- (position-bytes position) (point-min) -1))
+(setq form (cdr form))
-		      (princ (format "(#$ . %d) nil" position) outbuffer)
+(setq index (1+ index))))
-		      (setq form (cdr form))
+((= index (nth 1 info))
-		      (setq index (1+ index))))
+(if position
-		   ((= index (nth 1 info))
+(princ (format (if quoted "'(#$ . %d)"  "(#$ . %d)")
-		    (if position
+position)
-			(princ (format (if quoted "'(#$ . %d)"  "(#$ . %d)")
+outbuffer)
-				       position)
+(let ((print-escape-newlines nil))
-			       outbuffer)
+(goto-char (prog1 (1+ (point))
-		      (let ((print-escape-newlines nil))
+(prin1 (car form) outbuffer)))
-			(goto-char (prog1 (1+ (point))
+(insert "\\\n")
-				     (prin1 (car form) outbuffer)))
+(goto-char (point-max)))))
-			(insert "\\\n")
+(t
-			(goto-char (point-max)))))
+(prin1 (car form) outbuffer)))))
-		   (t
+(insert (nth 2 info)))))
-		    (prin1 (car form) outbuffer)))))
-	 (insert (nth 2 info))))))
 nil)
 (defun byte-compile-keep-pending (form &optional handler)
 (if (memq byte-optimize '(t source))
 (setq form (byte-optimize-form form t)))
 ;; Print Lisp object EXP in the output file, inside a comment,
 ;; and return the file position it will have.
 ;; 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
+(with-current-buffer outbuffer
-(prog1 (current-buffer)
-(set-buffer outbuffer)
+;; Insert EXP, and make it a comment with #@LENGTH.
+(insert " ")
-;; Insert EXP, and make it a comment with #@LENGTH.
+(if quoted
-(insert " ")
+(prin1 exp outbuffer)
-(if quoted
+(princ exp outbuffer))
-	   (prin1 exp outbuffer)
+(goto-char position)
-	 (princ exp outbuffer))
+;; Quote certain special characters as needed.
-(goto-char position)
+;; get_doc_string in doc.c does the unquoting.
-;; Quote certain special characters as needed.
+(while (search-forward "\^A" nil t)
-;; get_doc_string in doc.c does the unquoting.
+(replace-match "\^A\^A" t t))
-(while (search-forward "\^A" nil t)
+(goto-char position)
-	 (replace-match "\^A\^A" t t))
+(while (search-forward "\000" nil t)
-(goto-char position)
+(replace-match "\^A0" t t))
-(while (search-forward "\000" nil t)
+(goto-char position)
-	 (replace-match "\^A0" t t))
+(while (search-forward "\037" nil t)
-(goto-char position)
+(replace-match "\^A_" t t))
-(while (search-forward "\037" nil t)
+(goto-char (point-max))
-	 (replace-match "\^A_" t t))
+(insert "\037")
-(goto-char (point-max))
+(goto-char position)
-(insert "\037")
+(insert "#@" (format "%d" (- (position-bytes (point-max))
-(goto-char position)
+(position-bytes 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
-;; Save the file position of the object.
+;; that we inserted before the actual doc string,
-;; Note we should add 1 to skip the space
+;; and subtract 1 to convert from an 1-origin Emacs position
-;; that we inserted before the actual doc string,
+;; to a file position; they cancel.
-;; and subtract 1 to convert from an 1-origin Emacs position
+(setq position (point))
-;; to a file position; they cancel.
+(goto-char (point-max)))
-(setq position (point))
-(goto-char (point-max))))
 position))
 ;;;###autoload

Mercurial > emacs

comparison lisp/emacs-lisp/bytecomp.el @ 83676:27d11c1d4e46