comparison lisp/emacs-lisp/bytecomp.el @ 83635:9c01792a3ce8

Merge from emacs--devo--0 Patches applied: * emacs--devo--0 (patch 793-802) - Update from CVS - Remove RCS keywords - Merge from emacs--rel--22 * emacs--rel--22 (patch 42-50) - Update from CVS - Merge from gnus--rel--5.10 - Gnus ChangeLog tweaks * gnus--rel--5.10 (patch 229-232) - Merge from emacs--devo--0, emacs--rel--22 - ChangeLog tweak - Update from CVS Revision: [e-mail]/emacs--multi-tty--0--patch-23

83634:391cce03f832

		(when (and (symbolp s) (not (memq s old-autoloads)))
		  (push s byte-compile-noruntime-functions))
		(when (and (consp s) (eq t (car s)))
		  (push (cdr s) old-autoloads)))))))
      (when (memq 'cl-functions byte-compile-warnings)
	(let ((hist-new load-history)
	      (hist-nil-new current-load-list))
	  ;; Go through load-history, look for newly loaded files
	  ;; and mark all the functions defined therein.
	  (while (and hist-new (not (eq hist-new hist-orig)))
	    (let ((xs (pop hist-new))
		  old-autoloads)
	      ;; Make sure the file was not already loaded before.
	      (when (and (equal (car xs) "cl") (not (assoc (car xs) hist-orig)))
		(byte-compile-find-cl-functions)))))))))

(defun byte-compile-eval-before-compile (form)

  (when (and (symbolp (car form))
	     (stringp (nth 1 form))
	     (get (car form) 'byte-compile-format-like))
    (let ((nfields (with-temp-buffer
		     (insert (nth 1 form))
		     (goto-char 1)
		     (let ((n 0))
		       (while (re-search-forward "%." nil t)
			 (unless (eq ?% (char-after (1+ (match-beginning 0))))
			   (setq n (1+ n))))
		       n)))

  (put elt 'byte-compile-format-like t))

;; Warn if a custom definition fails to specify :group.
(defun byte-compile-nogroup-warn (form)
  (let ((keyword-args (cdr (cdr (cdr (cdr form)))))
	(name (cadr form)))
    (or (not (eq (car-safe name) 'quote))
	(and (eq (car form) 'custom-declare-group)
	     (equal name ''emacs))
	(plist-get keyword-args :group)
	(not (and (consp name) (eq (car name) 'quote)))
	(byte-compile-warn
	 "%s for `%s' fails to specify containing group"
	 (cdr (assq (car form)
		    '((custom-declare-group . defgroup)
		      (custom-declare-face . defface)
		      (custom-declare-variable . defcustom))))
	 (cadr name)))))

;; Warn if the function or macro is being redefined with a different
;; number of arguments.
(defun byte-compile-arglist-warn (form macrop)
  (let ((old (byte-compile-fdefinition (nth 1 form) macrop)))

	;;	  (byte-compile-warnings (if (eq byte-compile-warnings t)
	;;				     byte-compile-warning-types
	;;				   byte-compile-warnings))
	)
    (byte-compile-close-variables
     (save-excursion
       (setq outbuffer
	     (set-buffer (get-buffer-create " *Compiler Output*")))
       (set-buffer-multibyte t)
       (erase-buffer)
       ;;	 (emacs-lisp-mode)
       (setq case-fold-search nil)
       ;; This is a kludge.  Some operating systems (OS/2, DOS) need to

       ;; they should write their data.  Advise them that .elc files
       ;; need to be written carefully.
       (setq overwrite-mode 'overwrite-mode-binary))
     (displaying-byte-compile-warnings
      (and filename (byte-compile-insert-header filename inbuffer outbuffer))
      (save-excursion
	(set-buffer inbuffer)
	(goto-char 1)

	;; Compile the forms from the input buffer.
	(while (progn
		 (while (progn (skip-chars-forward " \t\n\^l")
			       (looking-at ";"))

(defun byte-compile-insert-header (filename inbuffer outbuffer)
  (set-buffer inbuffer)
  (let ((dynamic-docstrings byte-compile-dynamic-docstrings)
	(dynamic byte-compile-dynamic))
    (set-buffer outbuffer)
    (goto-char 1)
    ;; The magic number of .elc files is ";ELC", or 0x3B454C43.  After
    ;; that is the file-format version number (18, 19 or 20) as a
    ;; byte, followed by some nulls.  The primary motivation for doing
    ;; this is to get some binary characters up in the first line of
    ;; the file so that `diff' will simply say "Binary files differ"

      (setq tail (cdr tail))))
  form)

(put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
(defun byte-compile-file-form-require (form)
  (let ((old-load-list current-load-list)
	(args (mapcar 'eval (cdr form))))
    (apply 'require args)
    ;; Detect (require 'cl) in a way that works even if cl is already loaded.
    (if (member (car args) '("cl" cl))
	(setq byte-compile-warnings
	      (remq 'cl-functions byte-compile-warnings))))

83635:9c01792a3ce8

		(when (and (symbolp s) (not (memq s old-autoloads)))
		  (push s byte-compile-noruntime-functions))
		(when (and (consp s) (eq t (car s)))
		  (push (cdr s) old-autoloads)))))))
      (when (memq 'cl-functions byte-compile-warnings)
	(let ((hist-new load-history))
	  ;; Go through load-history, look for newly loaded files
	  ;; and mark all the functions defined therein.
	  (while (and hist-new (not (eq hist-new hist-orig)))
	    (let ((xs (pop hist-new)))
	      ;; Make sure the file was not already loaded before.
	      (when (and (equal (car xs) "cl") (not (assoc (car xs) hist-orig)))
		(byte-compile-find-cl-functions)))))))))

(defun byte-compile-eval-before-compile (form)

  (when (and (symbolp (car form))
	     (stringp (nth 1 form))
	     (get (car form) 'byte-compile-format-like))
    (let ((nfields (with-temp-buffer
		     (insert (nth 1 form))
		     (goto-char (point-min))
		     (let ((n 0))
		       (while (re-search-forward "%." nil t)
			 (unless (eq ?% (char-after (1+ (match-beginning 0))))
			   (setq n (1+ n))))
		       n)))

  (put elt 'byte-compile-format-like t))

;; Warn if a custom definition fails to specify :group.
(defun byte-compile-nogroup-warn (form)
  (let ((keyword-args (cdr (cdr (cdr (cdr form)))))
        (name (cadr form)))
    (or (not (eq (car-safe name) 'quote))
        (and (eq (car form) 'custom-declare-group)
             (equal name ''emacs))
        (plist-get keyword-args :group)
        (not (and (consp name) (eq (car name) 'quote)))
        (byte-compile-warn
         "%s for `%s' fails to specify containing group"
         (cdr (assq (car form)
                    '((custom-declare-group . defgroup)
                      (custom-declare-face . defface)
                      (custom-declare-variable . defcustom))))
         (cadr name)))))

;; Warn if the function or macro is being redefined with a different
;; number of arguments.
(defun byte-compile-arglist-warn (form macrop)
  (let ((old (byte-compile-fdefinition (nth 1 form) macrop)))

	;;	  (byte-compile-warnings (if (eq byte-compile-warnings t)
	;;				     byte-compile-warning-types
	;;				   byte-compile-warnings))
	)
    (byte-compile-close-variables
     (with-current-buffer
         (setq outbuffer (get-buffer-create " *Compiler Output*"))
       (set-buffer-multibyte t)
       (erase-buffer)
       ;;	 (emacs-lisp-mode)
       (setq case-fold-search nil)
       ;; This is a kludge.  Some operating systems (OS/2, DOS) need to

       ;; they should write their data.  Advise them that .elc files
       ;; need to be written carefully.
       (setq overwrite-mode 'overwrite-mode-binary))
     (displaying-byte-compile-warnings
      (and filename (byte-compile-insert-header filename inbuffer outbuffer))
      (with-current-buffer inbuffer
	(goto-char (point-min))

	;; Compile the forms from the input buffer.
	(while (progn
		 (while (progn (skip-chars-forward " \t\n\^l")
			       (looking-at ";"))

(defun byte-compile-insert-header (filename inbuffer outbuffer)
  (set-buffer inbuffer)
  (let ((dynamic-docstrings byte-compile-dynamic-docstrings)
	(dynamic byte-compile-dynamic))
    (set-buffer outbuffer)
    (goto-char (point-min))
    ;; The magic number of .elc files is ";ELC", or 0x3B454C43.  After
    ;; that is the file-format version number (18, 19 or 20) as a
    ;; byte, followed by some nulls.  The primary motivation for doing
    ;; this is to get some binary characters up in the first line of
    ;; the file so that `diff' will simply say "Binary files differ"

      (setq tail (cdr tail))))
  form)

(put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
(defun byte-compile-file-form-require (form)
  (let ((args (mapcar 'eval (cdr form))))
    (apply 'require args)
    ;; Detect (require 'cl) in a way that works even if cl is already loaded.
    (if (member (car args) '("cl" cl))
	(setq byte-compile-warnings
	      (remq 'cl-functions byte-compile-warnings))))