diff options
author | Karoly Lorentey <lorentey@elte.hu> | 2004-02-02 19:19:08 +0000 |
---|---|---|
committer | Karoly Lorentey <lorentey@elte.hu> | 2004-02-02 19:19:08 +0000 |
commit | d3a6748c5b378a86fc8408222c7dd26e47218af9 (patch) | |
tree | 33f9334088634447425b8c926dd45d1e83fa80e2 /lisp/emacs-lisp | |
parent | 465fc071a1aa48e87f37bff460410eec921eaa53 (diff) | |
parent | d83a97ab5fbcde063e4a87042cd721a23f13fbe0 (diff) | |
download | emacs-d3a6748c5b378a86fc8408222c7dd26e47218af9.tar.gz emacs-d3a6748c5b378a86fc8408222c7dd26e47218af9.tar.bz2 emacs-d3a6748c5b378a86fc8408222c7dd26e47218af9.zip |
Merged in changes from CVS HEAD
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-57
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-58
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-59
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-60
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-61
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-62
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-63
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-64
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-65
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-66
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-67
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-68
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-69
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-71
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 148 | ||||
-rw-r--r-- | lisp/emacs-lisp/easy-mmode.el | 19 | ||||
-rw-r--r-- | lisp/emacs-lisp/lisp.el | 25 |
3 files changed, 121 insertions, 71 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 24d2329b426..6f7e838daf0 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -10,7 +10,7 @@ ;;; This version incorporates changes up to version 2.10 of the ;;; Zawinski-Furuseth compiler. -(defconst byte-compile-version "$Revision: 2.141 $") +(defconst byte-compile-version "$Revision: 2.142 $") ;; This file is part of GNU Emacs. @@ -251,7 +251,9 @@ if you change this variable." :type 'boolean) (defcustom byte-compile-compatibility nil - "*Non-nil means generate output that can run in Emacs 18." + "*Non-nil means generate output that can run in Emacs 18. +This only means that it can run in principle, if it doesn't require +facilities that have been added more recently." :group 'bytecomp :type 'boolean) @@ -444,6 +446,11 @@ Each element looks like (FUNCTIONNAME . DEFINITION). It is Used for warnings when the function is not known to be defined or is later defined with incorrect args.") +(defvar byte-compile-noruntime-functions nil + "Alist of functions called that may not be defined when the compiled code is run. +Used for warnings about calling a function that is defined during compilation +but won't necessarily be defined when the compiled file is loaded.") + (defvar byte-compile-tag-number 0) (defvar byte-compile-output nil "Alist describing contents to put in byte code string. @@ -776,7 +783,7 @@ otherwise pop it") (defun byte-compile-eval (form) "Eval FORM and mark the functions defined therein. -Each function's symbol gets marked with the `byte-compile-noruntime' property." +Each function's symbol gets added to `byte-compile-noruntime-functions'." (let ((hist-orig load-history) (hist-nil-orig current-load-list)) (prog1 (eval form) @@ -794,17 +801,17 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property." (cond ((symbolp s) (unless (memq s old-autoloads) - (put s 'byte-compile-noruntime t))) + (push s byte-compile-noruntime-functions))) ((and (consp s) (eq t (car s))) (push (cdr s) old-autoloads)) ((and (consp s) (eq 'autoload (car s))) - (put (cdr s) 'byte-compile-noruntime t))))))) + (push (cdr s) byte-compile-noruntime-functions))))))) ;; Go through current-load-list for the locally defined funs. (let (old-autoloads) (while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig))) (let ((s (pop hist-nil-new))) (when (and (symbolp s) (not (memq s old-autoloads))) - (put s 'byte-compile-noruntime t)) + (push s byte-compile-noruntime-functions)) (when (and (consp s) (eq t (car s))) (push (cdr s) old-autoloads)))))))))) @@ -1170,10 +1177,11 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property." "requires" "accepts only") (byte-compile-arglist-signature-string sig)))) + (byte-compile-format-warn form) ;; Check to see if the function will be available at runtime ;; and/or remember its arity if it's unknown. (or (and (or sig (fboundp (car form))) ; might be a subr or autoload. - (not (get (car form) 'byte-compile-noruntime))) + (not (memq (car form) byte-compile-noruntime-functions))) (eq (car form) byte-compile-current-form) ; ## this doesn't work ; with recursion. ;; It's a currently-undefined function. @@ -1187,6 +1195,32 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property." (cons (list (car form) n) byte-compile-unresolved-functions))))))) +(defun byte-compile-format-warn (form) + "Warn if FORM is `format'-like with inconsistent args. +Applies if head of FORM is a symbol with non-nil property +`byte-compile-format-like' and first arg is a constant string. +Then check the number of format fields matches the number of +extra args." + (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))) + (nargs (- (length form) 2))) + (unless (= nargs nfields) + (byte-compile-warn + "`%s' called with %d args to fill %d format field(s)" (car form) + nargs nfields))))) + +(dolist (elt '(format message error)) + (put elt 'byte-compile-format-like t)) + ;; Warn if the function or macro is being redefined with a different ;; number of arguments. (defun byte-compile-arglist-warn (form macrop) @@ -1254,7 +1288,7 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property." (let ((func (car-safe form))) (if (and byte-compile-cl-functions (memq func byte-compile-cl-functions) - ;; Aliases which won't have been expended at this point. + ;; Aliases which won't have been expanded at this point. ;; These aren't all aliases of subrs, so not trivial to ;; avoid hardwiring the list. (not (memq func @@ -2453,17 +2487,19 @@ If FORM is a lambda or a macro, byte-compile it as a function." (if (cdr (cdr int)) (byte-compile-warn "malformed interactive spec: %s" (prin1-to-string int))) - ;; If the interactive spec is a call to `list', - ;; don't compile it, because `call-interactively' - ;; looks at the args of `list'. + ;; If the interactive spec is a call to `list', don't + ;; compile it, because `call-interactively' looks at the + ;; args of `list'. Actually, compile it to get warnings, + ;; but don't use the result. (let ((form (nth 1 int))) (while (memq (car-safe form) '(let let* progn save-excursion)) (while (consp (cdr form)) (setq form (cdr form))) (setq form (car form))) - (or (eq (car-safe form) 'list) - (setq int (list 'interactive - (byte-compile-top-level (nth 1 int))))))) + (if (eq (car-safe form) 'list) + (byte-compile-top-level (nth 1 int)) + (setq int (list 'interactive + (byte-compile-top-level (nth 1 int))))))) ((cdr int) (byte-compile-warn "malformed interactive spec: %s" (prin1-to-string int))))) @@ -3265,51 +3301,55 @@ If FORM is a lambda or a macro, byte-compile it as a function." (if ,discard 'byte-goto-if-nil 'byte-goto-if-nil-else-pop)) ,tag)) +(defmacro byte-compile-maybe-guarded (condition &rest body) + "Execute forms in BODY, potentially guarded by CONDITION. +CONDITION is the test in an `if' form or in a `cond' clause. +BODY is to compile the first arm of the if or the body of the +cond clause. If CONDITION is of the form `(foundp 'foo)' +or `(boundp 'foo)', the relevant warnings from BODY about foo +being undefined will be suppressed." + (declare (indent 1) (debug t)) + `(let* ((fbound + (if (eq 'fboundp (car-safe ,condition)) + (and (eq 'quote (car-safe (nth 1 ,condition))) + ;; Ignore if the symbol is already on the + ;; unresolved list. + (not (assq (nth 1 (nth 1 ,condition)) ; the relevant symbol + byte-compile-unresolved-functions)) + (nth 1 (nth 1 ,condition))))) + (bound (if (or (eq 'boundp (car-safe ,condition)) + (eq 'default-boundp (car-safe ,condition))) + (and (eq 'quote (car-safe (nth 1 ,condition))) + (nth 1 (nth 1 ,condition))))) + ;; Maybe add to the bound list. + (byte-compile-bound-variables + (if bound + (cons bound byte-compile-bound-variables) + byte-compile-bound-variables))) + (progn ,@body) + ;; Maybe remove the function symbol from the unresolved list. + (if fbound + (setq byte-compile-unresolved-functions + (delq (assq fbound byte-compile-unresolved-functions) + byte-compile-unresolved-functions))))) + (defun byte-compile-if (form) (byte-compile-form (car (cdr form))) ;; Check whether we have `(if (fboundp ...' or `(if (boundp ...' ;; and avoid warnings about the relevent symbols in the consequent. - (let* ((clause (nth 1 form)) - (fbound (if (eq 'fboundp (car-safe clause)) - (and (eq 'quote (car-safe (nth 1 clause))) - ;; Ignore if the symbol is already on the - ;; unresolved list. - (not (assq - (nth 1 (nth 1 clause)) ; the relevant symbol - byte-compile-unresolved-functions)) - (nth 1 (nth 1 clause))))) - (bound (if (eq 'boundp (car-safe clause)) - (and (eq 'quote (car-safe (nth 1 clause))) - (nth 1 (nth 1 clause))))) - (donetag (byte-compile-make-tag))) + (let ((clause (nth 1 form)) + (donetag (byte-compile-make-tag))) (if (null (nthcdr 3 form)) ;; No else-forms (progn (byte-compile-goto-if nil for-effect donetag) - ;; Maybe add to the bound list. - (let ((byte-compile-bound-variables - (if bound - (cons bound byte-compile-bound-variables) - byte-compile-bound-variables))) + (byte-compile-maybe-guarded clause (byte-compile-form (nth 2 form) for-effect)) - ;; Maybe remove the function symbol from the unresolved list. - (if fbound - (setq byte-compile-unresolved-functions - (delq (assq fbound byte-compile-unresolved-functions) - byte-compile-unresolved-functions))) (byte-compile-out-tag donetag)) (let ((elsetag (byte-compile-make-tag))) (byte-compile-goto 'byte-goto-if-nil elsetag) - ;; As above for the first form. - (let ((byte-compile-bound-variables - (if bound - (cons bound byte-compile-bound-variables) - byte-compile-bound-variables))) - (byte-compile-form (nth 2 form) for-effect)) - (if fbound - (setq byte-compile-unresolved-functions - (delq (assq fbound byte-compile-unresolved-functions) - byte-compile-unresolved-functions))) + (byte-compile-maybe-guarded clause + (byte-compile-form (nth 2 form) for-effect)) (byte-compile-goto 'byte-goto donetag) (byte-compile-out-tag elsetag) (byte-compile-body (cdr (cdr (cdr form))) for-effect) @@ -3332,14 +3372,16 @@ If FORM is a lambda or a macro, byte-compile it as a function." (if (null (cdr clause)) ;; First clause is a singleton. (byte-compile-goto-if t for-effect donetag) - (setq nexttag (byte-compile-make-tag)) - (byte-compile-goto 'byte-goto-if-nil nexttag) - (byte-compile-body (cdr clause) for-effect) - (byte-compile-goto 'byte-goto donetag) - (byte-compile-out-tag nexttag))))) + (setq nexttag (byte-compile-make-tag)) + (byte-compile-goto 'byte-goto-if-nil nexttag) + (byte-compile-maybe-guarded (car clause) + (byte-compile-body (cdr clause) for-effect)) + (byte-compile-goto 'byte-goto donetag) + (byte-compile-out-tag nexttag))))) ;; Last clause (and (cdr clause) (not (eq (car clause) t)) - (progn (byte-compile-form (car clause)) + (progn (byte-compile-maybe-guarded (car clause) + (byte-compile-form (car clause))) (byte-compile-goto-if nil for-effect donetag) (setq clause (cdr clause)))) (byte-compile-body-do-effect clause) diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 01e3e0af5ac..2439fdd4de6 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -1,6 +1,6 @@ ;;; easy-mmode.el --- easy definition for major and minor modes -;; Copyright (C) 1997, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1997,2000,01,02,03,2004 Free Software Foundation, Inc. ;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr> ;; Maintainer: Stefan Monnier <monnier@gnu.org> @@ -433,14 +433,13 @@ found, do widen first and then call NARROWFUN with no args after moving." (let* ((base-name (symbol-name base)) (prev-sym (intern (concat base-name "-prev"))) (next-sym (intern (concat base-name "-next"))) - (check-narrow-maybe (when narrowfun - '(setq was-narrowed-p - (prog1 (or (/= (point-min) 1) - (/= (point-max) - (1+ (buffer-size)))) - (widen))))) + (check-narrow-maybe + (when narrowfun + '(setq was-narrowed + (prog1 (or (< (- (point-max) (point-min)) (buffer-size))) + (widen))))) (re-narrow-maybe (when narrowfun - `(when was-narrowed-p (,narrowfun))))) + `(when was-narrowed (,narrowfun))))) (unless name (setq name base-name)) `(progn (add-to-list 'debug-ignored-errors @@ -451,7 +450,7 @@ found, do widen first and then call NARROWFUN with no args after moving." (unless count (setq count 1)) (if (< count 0) (,prev-sym (- count)) (if (looking-at ,re) (setq count (1+ count))) - (let (was-narrowed-p) + (let (was-narrowed) ,check-narrow-maybe (if (not (re-search-forward ,re nil t count)) (if (looking-at ,re) @@ -472,7 +471,7 @@ found, do widen first and then call NARROWFUN with no args after moving." (interactive) (unless count (setq count 1)) (if (< count 0) (,next-sym (- count)) - (let (was-narrowed-p) + (let (was-narrowed) ,check-narrow-maybe (unless (re-search-backward ,re nil t count) (error "No previous %s" ,name)) diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 7f059d3f99f..4d90abd9f4e 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -188,7 +188,8 @@ If variable `beginning-of-defun-function' is non-nil, its value is called as a function to find the defun's beginning." (interactive "p") (if beginning-of-defun-function - (funcall beginning-of-defun-function) + (dotimes (i (or arg 1)) + (funcall beginning-of-defun-function)) (and arg (< arg 0) (not (eobp)) (forward-char 1)) (and (re-search-backward (if defun-prompt-regexp (concat (if open-paren-in-column-0-is-defun-start @@ -219,7 +220,8 @@ If variable `end-of-defun-function' is non-nil, its value is called as a function to find the defun's end." (interactive "p") (if end-of-defun-function - (funcall end-of-defun-function) + (dotimes (i (or arg 1)) + (funcall end-of-defun-function)) (if (or (null arg) (= arg 0)) (setq arg 1)) (let ((first t)) (while (and (> arg 0) (< (point) (point-max))) @@ -267,10 +269,14 @@ already marked." (end-of-defun) (point)))) (t + ;; Do it in this order for the sake of languages with nested + ;; functions where several can end at the same place as with + ;; the offside rule, e.g. Python. (push-mark (point)) - (end-of-defun) - (push-mark (point) nil t) (beginning-of-defun) + (push-mark (point) nil t) + (end-of-defun) + (exchange-point-and-mark) (re-search-backward "^\n" (- (point) 1) t)))) (defun narrow-to-defun (&optional arg) @@ -280,10 +286,13 @@ Optional ARG is ignored." (interactive) (save-excursion (widen) - (end-of-defun) - (let ((end (point))) - (beginning-of-defun) - (narrow-to-region (point) end)))) + ;; Do it in this order for the sake of languages with nested + ;; functions where several can end at the same place as with the + ;; offside rule, e.g. Python. + (beginning-of-defun) + (let ((beg (point))) + (end-of-defun) + (narrow-to-region beg (point))))) (defun insert-parentheses (arg) "Enclose following ARG sexps in parentheses. Leave point after open-paren. |