summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
authorKaroly Lorentey <lorentey@elte.hu>2004-02-02 19:19:08 +0000
committerKaroly Lorentey <lorentey@elte.hu>2004-02-02 19:19:08 +0000
commitd3a6748c5b378a86fc8408222c7dd26e47218af9 (patch)
tree33f9334088634447425b8c926dd45d1e83fa80e2 /lisp/emacs-lisp
parent465fc071a1aa48e87f37bff460410eec921eaa53 (diff)
parentd83a97ab5fbcde063e4a87042cd721a23f13fbe0 (diff)
downloademacs-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.el148
-rw-r--r--lisp/emacs-lisp/easy-mmode.el19
-rw-r--r--lisp/emacs-lisp/lisp.el25
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.