Merge from emacs--devo--0

Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-294

13 files changed, 550 insertions, 164 deletions

diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el
index 50d2f41f7ae..486a02d2c6b 100644
--- a/lisp/emacs-lisp/authors.el
+++ b/lisp/emacs-lisp/authors.el
@@ -418,24 +418,6 @@ author and what he did in hash table TABLE.  See the description of
 	  (nconc entry (list (cons action 1))))))))
 
 
-(defun authors-process-lines (program &rest args)
-  "Execute PROGRAM with ARGS, returning its output as a list of lines.
-Signal an error if the program returns with a non-zero exit status."
-  (with-temp-buffer
-    (let ((status (apply 'call-process program nil (current-buffer) nil args)))
-      (unless (eq status 0)
-	(error "%s exited with status %s" program status))
-      (goto-char (point-min))
-      (let (lines)
-	(while (not (eobp))
-	  (setq lines (cons (buffer-substring-no-properties
-			     (line-beginning-position)
-			     (line-end-position))
-			    lines))
-	  (forward-line 1))
-	(nreverse lines)))))
-
-
 (defun authors-canonical-author-name (author)
   "Return a canonicalized form of AUTHOR, an author name.
 If AUTHOR has an alias, use that.  Remove email addresses.  Capitalize
@@ -605,7 +587,7 @@ Result is a buffer *Authors* containing authorship information, and a
 buffer *Authors Errors* containing references to unknown files."
   (interactive "DEmacs source directory: ")
   (setq root (expand-file-name root))
-  (let ((logs (authors-process-lines "find" root "-name" "ChangeLog*"))
+  (let ((logs (process-lines "find" root "-name" "ChangeLog*"))
 	(table (make-hash-table :test 'equal))
 	(buffer-name "*Authors*")
 	authors-checked-files-alist
@@ -617,7 +599,7 @@ buffer *Authors Errors* containing references to unknown files."
       (when (string-match "ChangeLog\\(.[0-9]+\\)?$" log)
 	(message "Scanning %s..." log)
 	(authors-scan-change-log log table)))
-    (let ((els (authors-process-lines "find" root "-name" "*.el")))
+    (let ((els (process-lines "find" root "-name" "*.el")))
       (dolist (file els)
 	(message "Scanning %s..." file)
 	(authors-scan-el file table)))
diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el
index a2a929d9601..4940e2fd8c6 100644
--- a/lisp/emacs-lisp/backquote.el
+++ b/lisp/emacs-lisp/backquote.el
@@ -92,7 +92,7 @@ For example (backquote-list* 'a 'b 'c) => (a b . c)"
   "Symbol used to represent a splice inside a backquote.")
 
 ;;;###autoload
-(defmacro backquote (arg)
+(defmacro backquote (structure)
   "Argument STRUCTURE describes a template to build.
 
 The whole structure acts as if it were quoted except for certain
@@ -106,7 +106,7 @@ b              => (ba bb bc)		; assume b has this value
 `(a ,@b c)     => (a ba bb bc c)	; splice in the value of b
 
 Vectors work just like lists.  Nested backquotes are permitted."
-  (cdr (backquote-process arg)))
+  (cdr (backquote-process structure)))
 
 ;; GNU Emacs has no reader macros
 
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index bc864aab490..eb8c80af145 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -185,6 +185,7 @@
 ;;; Code:
 
 (require 'bytecomp)
+(eval-when-compile (require 'cl))
 
 (defun byte-compile-log-lap-1 (format &rest args)
   (if (aref byte-code-vector 0)
@@ -276,6 +277,8 @@
 	      ;; Isn't it an error for `string' not to be unibyte??  --stef
 	      (if (fboundp 'string-as-unibyte)
 		  (setq string (string-as-unibyte string)))
+	      ;; `byte-compile-splice-in-already-compiled-code'
+	      ;; takes care of inlining the body.
 	      (cons `(lambda ,(aref fn 0)
 		       (byte-code ,string ,(aref fn 2) ,(aref fn 3)))
 		    (cdr form)))
@@ -625,13 +628,24 @@
 ;;
 ;; It is now safe to optimize code such that it introduces new bindings.
 
-;; I'd like this to be a defsubst, but let's not be self-referential...
-(defmacro byte-compile-trueconstp (form)
-  ;; Returns non-nil if FORM is a non-nil constant.
-  `(cond ((consp ,form) (eq (car ,form) 'quote))
-	 ((not (symbolp ,form)))
-	 ((eq ,form t))
-	 ((keywordp ,form))))
+(defsubst byte-compile-trueconstp (form)
+  "Return non-nil if FORM always evaluates to a non-nil value."
+  (cond ((consp form)
+         (case (car form)
+           (quote (cadr form))
+           (progn (byte-compile-trueconstp (car (last (cdr form)))))))
+        ((not (symbolp form)))
+        ((eq form t))
+        ((keywordp form))))
+
+(defsubst byte-compile-nilconstp (form)
+  "Return non-nil if FORM always evaluates to a nil value."
+  (cond ((consp form)
+         (case (car form)
+           (quote (null (cadr form)))
+           (progn (byte-compile-nilconstp (car (last (cdr form)))))))
+        ((not (symbolp form)) nil)
+        ((null form))))
 
 ;; If the function is being called with constant numeric args,
 ;; evaluate as much as possible at compile-time.  This optimizer
@@ -990,17 +1004,17 @@
     (setq rest form)
     (while (setq rest (cdr rest))
       (cond ((byte-compile-trueconstp (car-safe (car rest)))
-	     (cond ((eq rest (cdr form))
-		    (setq form
-			  (if (cdr (car rest))
-			      (if (cdr (cdr (car rest)))
-				  (cons 'progn (cdr (car rest)))
-				(nth 1 (car rest)))
-			    (car (car rest)))))
+             ;; This branch will always be taken: kill the subsequent ones.
+	     (cond ((eq rest (cdr form)) ;First branch of `cond'.
+		    (setq form `(progn ,@(car rest))))
 		   ((cdr rest)
 		    (setq form (copy-sequence form))
 		    (setcdr (memq (car rest) form) nil)))
-	     (setq rest nil)))))
+	     (setq rest nil))
+            ((and (consp (car rest))
+                  (byte-compile-nilconstp (caar rest)))
+             ;; This branch will never be taken: kill its body.
+             (setcdr (car rest) nil)))))
   ;;
   ;; Turn (cond (( <x> )) ... ) into (or <x> (cond ... ))
   (if (eq 'cond (car-safe form))
@@ -1031,11 +1045,9 @@
                      (byte-optimize-if
                       `(if ,(car (last clause)) ,@(nthcdr 2 form)))))))
           ((byte-compile-trueconstp clause)
-	   (nth 2 form))
-	  ((null clause)
-	   (if (nthcdr 4 form)
-	       (cons 'progn (nthcdr 3 form))
-	     (nth 3 form)))
+	   `(progn ,clause ,(nth 2 form)))
+	  ((byte-compile-nilconstp clause)
+           `(progn ,clause ,@(nthcdr 3 form)))
 	  ((nth 2 form)
 	   (if (equal '(nil) (nthcdr 3 form))
 	       (list 'if clause (nth 2 form))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 27ee27eda92..82866a07ff7 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1053,6 +1053,9 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
 (defun byte-compile-warning-series (&rest ignore)
   nil)
 
+;; (compile-mode) will cause this to be loaded.
+(declare-function compilation-forget-errors "compile" ())
+
 ;; Log the start of a file in *Compile-Log*, and mark it as done.
 ;; Return the position of the start of the page in the log buffer.
 ;; But do nothing in batch mode.
@@ -1258,7 +1261,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
 		  (byte-compile-fdefinition (car form) t)))
 	 (sig (if (and def (not (eq def t)))
 		  (byte-compile-arglist-signature
-		   (if (eq 'lambda (car-safe def))
+		   (if (memq (car-safe def) '(declared lambda))
 		       (nth 1 def)
 		     (if (byte-code-function-p def)
 			 (aref def 0)
@@ -2274,18 +2277,17 @@ list that represents a doc string reference.
     (byte-compile-nogroup-warn form))
   (when (byte-compile-warning-enabled-p 'free-vars)
     (push (nth 1 (nth 1 form)) byte-compile-bound-variables))
+  ;; Don't compile the expression because it may be displayed to the user.
+  ;; (when (eq (car-safe (nth 2 form)) 'quote)
+  ;;   ;; (nth 2 form) is meant to evaluate to an expression, so if we have the
+  ;;   ;; final value already, we can byte-compile it.
+  ;;   (setcar (cdr (nth 2 form))
+  ;;           (byte-compile-top-level (cadr (nth 2 form)) nil 'file)))
   (let ((tail (nthcdr 4 form)))
     (while tail
-      ;; If there are any (function (lambda ...)) expressions, compile
-      ;; those functions.
-      (if (and (consp (car tail))
-	       (eq (car (car tail)) 'function)
-	       (consp (nth 1 (car tail))))
-	  (setcar tail (byte-compile-lambda (nth 1 (car tail))))
-	;; Likewise for a bare lambda.
-	(if (and (consp (car tail))
-		 (eq (car (car tail)) 'lambda))
-	    (setcar tail (byte-compile-lambda (car tail)))))
+      (unless (keywordp (car tail))      ;No point optimizing keywords.
+        ;; Compile the keyword arguments.
+        (setcar tail (byte-compile-top-level (car tail) nil 'file)))
       (setq tail (cdr tail))))
   form)
 
@@ -2817,6 +2819,20 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 	 (cdr body))
 	(body
 	 (list body))))
+
+(put 'declare-function 'byte-hunk-handler 'byte-compile-declare-function)
+(defun byte-compile-declare-function (form)
+  (push (cons (nth 1 form)
+              (if (and (> (length form) 3)
+                       (listp (nth 3 form)))
+                  (list 'declared (nth 3 form))
+                t))                     ; arglist not specified
+        byte-compile-function-environment)
+  ;; We are stating that it _will_ be defined at runtime.
+  (setq byte-compile-noruntime-functions
+        (delq (nth 1 form) byte-compile-noruntime-functions))
+  nil)
+
 
 ;; This is the recursive entry point for compiling each subform of an
 ;; expression.
@@ -3496,12 +3512,12 @@ That command is designed for interactive use only" fn))
 
 ;; Return the list of items in CONDITION-PARAM that match PRED-LIST.
 ;; Only return items that are not in ONLY-IF-NOT-PRESENT.
-(defun byte-compile-find-bound-condition (condition-param 
-					  pred-list 
+(defun byte-compile-find-bound-condition (condition-param
+					  pred-list
 					  &optional only-if-not-present)
   (let ((result nil)
 	(nth-one nil)
-	(cond-list 
+	(cond-list
 	 (if (memq (car-safe condition-param) pred-list)
 	     ;; The condition appears by itself.
 	     (list condition-param)
@@ -3509,7 +3525,7 @@ That command is designed for interactive use only" fn))
 	   ;; `and' arguments.
 	   (when (eq 'and (car-safe condition-param))
 	     (cdr condition-param)))))
-    
+
     (dolist (crt cond-list)
       (when (and (memq (car-safe crt) pred-list)
 		 (eq 'quote (car-safe (setq nth-one (nth 1 crt))))
@@ -3531,10 +3547,10 @@ being undefined will be suppressed.
 If CONDITION's value is (not (featurep 'emacs)) or (featurep 'xemacs),
 that suppresses all warnings during execution of BODY."
   (declare (indent 1) (debug t))
-  `(let* ((fbound-list (byte-compile-find-bound-condition 
-			,condition (list 'fboundp) 
+  `(let* ((fbound-list (byte-compile-find-bound-condition
+			,condition (list 'fboundp)
 			byte-compile-unresolved-functions))
-	  (bound-list (byte-compile-find-bound-condition 
+	  (bound-list (byte-compile-find-bound-condition
 		       ,condition (list 'boundp 'default-boundp)))
 	  ;; Maybe add to the bound list.
 	  (byte-compile-bound-variables
@@ -4264,7 +4280,7 @@ Must be used only with `-batch', and kills Emacs on completion.
 For example, invoke `emacs -batch -f batch-byte-recompile-directory .'.
 
 Optional argument ARG is passed as second argument ARG to
-`batch-recompile-directory'; see there for its possible values
+`byte-recompile-directory'; see there for its possible values
 and corresponding effects."
   ;; command-line-args-left is what is left of the command line (startup.el)
   (defvar command-line-args-left)	;Avoid 'free variable' warning
diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el
new file mode 100644
index 00000000000..9fc8a9e61e7
--- /dev/null
+++ b/lisp/emacs-lisp/check-declare.el
@@ -0,0 +1,311 @@
+;;; check-declare.el --- Check declare-function statements
+
+;; Copyright (C) 2007 Free Software Foundation, Inc.
+
+;; Author: Glenn Morris <rgm@gnu.org>
+;; Keywords: lisp, tools, maint
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; The byte-compiler often warns about undefined functions that you
+;; know will actually be defined when it matters.  The `declare-function'
+;; statement allows you to suppress these warnings.  This package
+;; checks that all such statements in a file or directory are accurate.
+;; The entry points are `check-declare-file' and `check-declare-directory'.
+
+;; For more information, see Info node `elisp(Declaring Functions)'.
+
+;;; TODO:
+
+;;; Code:
+
+(defconst check-declare-warning-buffer "*Check Declarations Warnings*"
+  "Name of buffer used to display any `check-declare' warnings.")
+
+(defun check-declare-locate (file basefile)
+  "Return the full path of FILE.
+Expands files with a \".c\" extension relative to the Emacs
+\"src/\" directory.  Otherwise, `locate-library' searches for FILE.
+If that fails, expands FILE relative to BASEFILE's directory part.
+The returned file might not exist.  If FILE has an \"ext:\" prefix, so does
+the result."
+  (let ((ext (string-match "^ext:" file))
+        tfile)
+    (if ext
+        (setq file (substring file 4)))
+    (setq file
+          (if (string-equal "c" (file-name-extension file))
+              (expand-file-name file (expand-file-name "src" source-directory))
+            (if (setq tfile (locate-library (file-name-nondirectory file)))
+                (progn
+                  (setq tfile
+                        (replace-regexp-in-string "\\.elc\\'" ".el" tfile))
+                  (if (and (not (file-exists-p tfile))
+                           (file-exists-p (concat tfile ".gz")))
+                      (concat tfile ".gz")
+                    tfile))
+              (setq tfile (expand-file-name file
+                                            (file-name-directory basefile)))
+              (if (or (file-exists-p tfile)
+                      (string-match "\\.el\\'" tfile))
+                  tfile
+                (concat tfile ".el")))))
+    (if ext (concat "ext:" file)
+      file)))
+
+(defun check-declare-scan (file)
+  "Scan FILE for `declare-function' calls.
+Return a list with elements of the form (FNFILE FN ARGLIST FILEONLY),
+where only the first two elements need be present.  This claims that FNFILE
+defines FN, with ARGLIST.  FILEONLY non-nil means only check that FNFILE
+exists, not that it defines FN.  This is for function definitions that we
+don't know how to recognize (e.g. some macros)."
+  (let ((m (format "Scanning %s..." file))
+        alist fnfile fn arglist fileonly)
+    (message "%s" m)
+    (with-temp-buffer
+      (insert-file-contents file)
+      (while (re-search-forward
+              "^[ \t]*(declare-function[ \t]+\\(\\S-+\\)[ \t]+\
+\"\\(\\S-+\\)\"" nil t)
+        (setq fn (match-string 1)
+              fnfile (match-string 2)
+              fnfile (check-declare-locate fnfile (expand-file-name file))
+              arglist (progn
+                        (skip-chars-forward " \t\n")
+                        ;; Use `t' to distinguish no arglist
+                        ;; specified from an empty one.
+                        (if (looking-at "\\((\\|nil\\|t\\)")
+                            (read (current-buffer))
+                          t))
+              fileonly (progn
+                        (skip-chars-forward " \t\n")
+                        (if (looking-at "\\(t\\|'\\sw+\\)")
+                            (match-string 1)))
+              alist (cons (list fnfile fn arglist fileonly) alist))))
+    (message "%sdone" m)
+    alist))
+
+(defun check-declare-errmsg (errlist &optional full)
+  "Return a string with the number of errors in ERRLIST, if any.
+Normally just counts the number of elements in ERRLIST.
+With optional argument FULL, sums the number of elements in each element."
+  (if errlist
+      (let ((l (length errlist)))
+        (when full
+          (setq l 0)
+          (dolist (e errlist)
+            (setq l (1+ l))))
+        (format "%d problem%s found" l (if (= l 1) "" "s")))
+    "OK"))
+
+(autoload 'byte-compile-arglist-signature "bytecomp")
+
+(defun check-declare-verify (fnfile fnlist)
+  "Check that FNFILE contains function definitions matching FNLIST.
+Each element of FNLIST has the form (FILE FN ARGLIST FILEONLY), where
+only the first two elements need be present.  This means FILE claimed FN
+was defined in FNFILE with the specified ARGLIST.  FILEONLY non-nil means
+to only check that FNFILE exists, not that it actually defines FN.
+
+Returns nil if all claims are found to be true, otherwise a list
+of errors with elements of the form \(FILE FN TYPE), where TYPE
+is a string giving details of the error."
+  (let ((m (format "Checking %s..." fnfile))
+        (cflag (string-equal "c" (file-name-extension fnfile)))
+        (ext (string-match "^ext:" fnfile))
+        re fn sig siglist arglist type errlist minargs maxargs)
+    (message "%s" m)
+    (if ext
+        (setq fnfile (substring fnfile 4)))
+    (if (file-exists-p fnfile)
+        (with-temp-buffer
+          (insert-file-contents fnfile)
+          ;; defsubst's don't _have_ to be known at compile time.
+          (setq re (format (if cflag
+                               "^[ \t]*\\(DEFUN\\)[ \t]*([ \t]*\"%s\""
+                             "^[ \t]*(\\(fset[ \t]+'\\|def\\(?:un\\|subst\\|\
+ine-\\(?:derived\\|generic\\|\\(?:global\\(?:ized\\)?-\\)?minor\\)-mode\
+\\|\\(?:ine-obsolete-function-\\)?alias[ \t]+'\\)\\)\
+\[ \t]*%s\\([ \t;]+\\|$\\)")
+                           (regexp-opt (mapcar 'cadr fnlist) t)))
+          (while (re-search-forward re nil t)
+            (skip-chars-forward " \t\n")
+            (setq fn (match-string 2)
+                  type (match-string 1)
+                  ;; (min . max) for a fixed number of arguments, or
+                  ;; arglists with optional elements.
+                  ;; (min) for arglists with &rest.
+                  ;; sig = 'err means we could not find an arglist.
+                  sig (cond (cflag
+                             (or
+                              (when (re-search-forward "," nil t 3)
+                                (skip-chars-forward " \t\n")
+                                ;; Assuming minargs and maxargs on same line.
+                                (when (looking-at "\\([0-9]+\\)[ \t]*,[ \t]*\
+\\([0-9]+\\|MANY\\|UNEVALLED\\)")
+                                  (setq minargs (string-to-number
+                                                 (match-string 1))
+                                        maxargs (match-string 2))
+                                  (cons minargs (unless (string-match "[^0-9]"
+                                                                      maxargs)
+                                                 (string-to-number
+                                                  maxargs)))))
+                              'err))
+                            ((string-match
+                              "\\`define-\\(derived\\|generic\\)-mode\\'"
+                              type)
+                             '(0 . 0))
+                            ((string-match
+                              "\\`define\\(-global\\(ized\\)?\\)?-minor-mode\\'"
+                              type)
+                             '(0 . 1))
+                            ;; Prompt to update.
+                            ((string-match
+                              "\\`define-obsolete-function-alias\\>"
+                              type)
+                             'obsolete)
+                            ;; Can't easily check arguments in these cases.
+                            ((string-match "\\`\\(defalias\\|fset\\)\\>" type)
+                             t)
+                            ((looking-at "\\((\\|nil\\)")
+                             (byte-compile-arglist-signature
+                              (read (current-buffer))))
+                            (t
+                             'err))
+                  ;; alist of functions and arglist signatures.
+                  siglist (cons (cons fn sig) siglist)))))
+    (dolist (e fnlist)
+      (setq arglist (nth 2 e)
+            type
+            (if (not re)
+                "file not found"
+              (if (not (setq sig (assoc (cadr e) siglist)))
+                  (unless (nth 3 e)     ; fileonly
+                    "function not found")
+                (setq sig (cdr sig))
+                (cond ((eq sig 'obsolete) ; check even when no arglist specified
+                       "obsolete alias")
+                      ;; arglist t means no arglist specified, as
+                      ;; opposed to an empty arglist.
+                      ((eq arglist t) nil)
+                      ((eq sig t) nil) ; eg defalias - can't check arguments
+                      ((eq sig 'err)
+                       "arglist not found") ; internal error
+                      ((not (equal (byte-compile-arglist-signature
+                                    arglist)
+                                   sig))
+                       "arglist mismatch")))))
+      (when type
+        (setq errlist (cons (list (car e) (cadr e) type) errlist))))
+    (message "%s%s" m
+             (if (or re (not ext))
+                 (check-declare-errmsg errlist)
+               (progn
+                 (setq errlist nil)
+                 "skipping external file")))
+    errlist))
+
+(defun check-declare-sort (alist)
+  "Sort a list with elements FILE (FNFILE ...).
+Returned list has elements FNFILE (FILE ...)."
+  (let (file fnfile rest sort a)
+    (dolist (e alist)
+      (setq file (car e))
+      (dolist (f (cdr e))
+        (setq fnfile (car f)
+              rest (cdr f))
+        (if (setq a (assoc fnfile sort))
+            (setcdr a (append (cdr a) (list (cons file rest))))
+          (setq sort (cons (list fnfile (cons file rest)) sort)))))
+    sort))
+
+(defun check-declare-warn (file fn fnfile type)
+  "Warn that FILE made a false claim about FN in FNFILE.
+TYPE is a string giving the nature of the error.  Warning is displayed in
+`check-declare-warning-buffer'."
+  (display-warning 'check-declare
+                   (format "%s said `%s' was defined in %s: %s"
+                           (file-name-nondirectory file) fn
+                           (file-name-nondirectory fnfile)
+                           type)
+                   nil check-declare-warning-buffer))
+
+(defun check-declare-files (&rest files)
+  "Check veracity of all `declare-function' statements in FILES.
+Return a list of any errors found."
+  (let (alist err errlist)
+    (dolist (file files)
+      (setq alist (cons (cons file (check-declare-scan file)) alist)))
+    ;; Sort so that things are ordered by the files supposed to
+    ;; contain the defuns.
+    (dolist (e (check-declare-sort alist))
+      (if (setq err (check-declare-verify (car e) (cdr e)))
+          (setq errlist (cons (cons (car e) err) errlist))))
+    (if (get-buffer check-declare-warning-buffer)
+        (kill-buffer check-declare-warning-buffer))
+    ;; Sort back again so that errors are ordered by the files
+    ;; containing the declare-function statements.
+    (dolist (e (check-declare-sort errlist))
+        (dolist (f (cdr e))
+          (check-declare-warn (car e) (cadr f) (car f) (nth 2 f))))
+    errlist))
+
+;;;###autoload
+(defun check-declare-file (file)
+  "Check veracity of all `declare-function' statements in FILE.
+See `check-declare-directory' for more information."
+  (interactive "fFile to check: ")
+  (or (file-exists-p file)
+      (error "File `%s' not found" file))
+  (let ((m (format "Checking %s..." file))
+        errlist)
+    (message "%s" m)
+    (setq errlist (check-declare-files file))
+    (message "%s%s" m (check-declare-errmsg errlist))
+    errlist))
+
+;;;###autoload
+(defun check-declare-directory (root)
+  "Check veracity of all `declare-function' statements under directory ROOT.
+Returns non-nil if any false statements are found.  For this to
+work correctly, the statements must adhere to the format
+described in the documentation of `declare-function'."
+  (interactive "DDirectory to check: ")
+  (or (file-directory-p (setq root (expand-file-name root)))
+      (error "Directory `%s' not found" root))
+  (let ((m "Checking `declare-function' statements...")
+        (m2 "Finding files with declarations...")
+        errlist files)
+    (message "%s" m)
+    (message "%s" m2)
+    (setq files (process-lines "find" root "-name" "*.el"
+                                 "-exec" "grep" "-l"
+                                 "^[ 	]*(declare-function" "{}" ";"))
+    (message "%s%d found" m2 (length files))
+    (when files
+      (setq errlist (apply 'check-declare-files files))
+      (message "%s%s" m (check-declare-errmsg errlist t))
+      errlist)))
+
+(provide 'check-declare)
+
+;; arch-tag: a4d6cdc4-deb7-4502-b327-0e4ef3d82d96
+;;; check-declare.el ends here.
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index b802d8acd43..d6c23de0be8 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -116,10 +116,15 @@ whenever this expression's value is non-nil.
 INCLUDE is an expression; this item is only visible if this
 expression has a non-nil value.  `:included' is an alias for `:visible'.
 
+   :label FORM
+
+FORM is an expression that will be dynamically evaluated and whose
+value will be used for the menu entry's text label (the default is NAME).
+
    :suffix FORM
 
 FORM is an expression that will be dynamically evaluated and whose
-value will be concatenated to the menu entry's NAME.
+value will be concatenated to the menu entry's label.
 
    :style STYLE
 
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index b3c7c339030..24e26827f7c 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -149,10 +149,14 @@ See the functions `find-function' and `find-variable'."
   ;; the same name.
   (if (string-match "\\.el\\(c\\(\\..*\\)?\\)\\'" library)
       (setq library (replace-match "" t t library)))
-  (or (locate-file library
-		   (or find-function-source-path load-path)
-		   (append (find-library-suffixes) load-file-rep-suffixes))
-      (error "Can't find library %s" library)))
+  (or 
+   (locate-file library
+		(or find-function-source-path load-path)
+		(find-library-suffixes))
+   (locate-file library
+		(or find-function-source-path load-path)
+		load-file-rep-suffixes)
+   (error "Can't find library %s" library)))
 
 (defvar find-function-C-source-directory
   (let ((dir (expand-file-name "src" source-directory)))
diff --git a/lisp/emacs-lisp/gulp.el b/lisp/emacs-lisp/gulp.el
index 9e0795c8822..5ff2b8f564c 100644
--- a/lisp/emacs-lisp/gulp.el
+++ b/lisp/emacs-lisp/gulp.el
@@ -78,6 +78,9 @@ Thanks.")
   :type 'string
   :group 'gulp)
 
+(declare-function mail-subject "sendmail" ())
+(declare-function mail-send "sendmail" ())
+
 (defun gulp-send-requests (dir &optional time)
   "Send requests for updates to the authors of Lisp packages in directory DIR.
 For each maintainer, the message consists of `gulp-request-header',
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 788be284cda..65bbade816e 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -175,9 +175,10 @@ normal recipe (see `beginning-of-defun').  Major modes can define this
 if defining `defun-prompt-regexp' is not sufficient to handle the mode's
 needs.
 
-The function (of no args) should go to the line on which the current
-defun starts, and return non-nil, or should return nil if it can't
-find the beginning.")
+The function takes the same argument as `beginning-of-defun' and should
+behave similarly, returning non-nil if it found the beginning of a defun.
+Ideally it should move to a point right before an open-paren which encloses
+the body of the defun.")
 
 (defun beginning-of-defun (&optional arg)
   "Move backward to the beginning of a defun.
@@ -218,12 +219,22 @@ is called as a function to find the defun's beginning."
   (unless arg (setq arg 1))
   (cond
    (beginning-of-defun-function
-    (if (> arg 0)
-	(dotimes (i arg)
-	  (funcall beginning-of-defun-function))
-      ;; Better not call end-of-defun-function directly, in case
-      ;; it's not defined.
-      (end-of-defun (- arg))))
+    (condition-case nil
+        (funcall beginning-of-defun-function arg)
+      ;; We used to define beginning-of-defun-function as taking no argument
+      ;; but that makes it impossible to implement correct forward motion:
+      ;; we used to use end-of-defun for that, but it's not supposed to do
+      ;; the same thing (it moves to the end of a defun not to the beginning
+      ;; of the next).
+      ;; In case the beginning-of-defun-function uses the old calling
+      ;; convention, fallback on the old implementation.
+      (wrong-number-of-arguments
+       (if (> arg 0)
+           (dotimes (i arg)
+             (funcall beginning-of-defun-function))
+         ;; Better not call end-of-defun-function directly, in case
+         ;; it's not defined.
+         (end-of-defun (- arg))))))
 
    ((or defun-prompt-regexp open-paren-in-column-0-is-defun-start)
     (and (< arg 0) (not (eobp)) (forward-char 1))
@@ -286,11 +297,11 @@ is called as a function to find the defun's beginning."
 	     (goto-char (if arg-+ve floor ceiling))
 	     nil))))))))
 
-(defvar end-of-defun-function nil
-  "If non-nil, function for function `end-of-defun' to call.
-This is used to find the end of the defun instead of using the normal
-recipe (see `end-of-defun').  Major modes can define this if the
-normal method is not appropriate.")
+(defvar end-of-defun-function #'forward-sexp
+  "Function for `end-of-defun' to call.
+This is used to find the end of the defun.
+It is called with no argument, right after calling `beginning-of-defun-raw'.
+So the function can assume that point is at the beginning of the defun body.")
 
 (defun buffer-end (arg)
   "Return the \"far end\" position of the buffer, in direction ARG.
@@ -315,45 +326,38 @@ is called as a function to find the defun's end."
       (and transient-mark-mode mark-active)
       (push-mark))
   (if (or (null arg) (= arg 0)) (setq arg 1))
-  (if end-of-defun-function
-      (if (> arg 0)
-	  (dotimes (i arg)
-	    (funcall end-of-defun-function))
-	;; Better not call beginning-of-defun-function
-	;; directly, in case it's not defined.
-	(beginning-of-defun (- arg)))
-    (let ((first t))
-      (while (and (> arg 0) (< (point) (point-max)))
-	(let ((pos (point)))
-	  (while (progn
-		   (if (and first
-			    (progn
-			      (end-of-line 1)
-			      (beginning-of-defun-raw 1)))
-		       nil
-		     (or (bobp) (forward-char -1))
-		     (beginning-of-defun-raw -1))
-		   (setq first nil)
-		   (forward-list 1)
-		   (skip-chars-forward " \t")
-		   (if (looking-at "\\s<\\|\n")
-		       (forward-line 1))
-		   (<= (point) pos))))
-	(setq arg (1- arg)))
-      (while (< arg 0)
-	(let ((pos (point)))
-	  (beginning-of-defun-raw 1)
-	  (forward-sexp 1)
-	  (forward-line 1)
-	  (if (>= (point) pos)
-	      (if (beginning-of-defun-raw 2)
-		  (progn
-		    (forward-list 1)
-		    (skip-chars-forward " \t")
-		    (if (looking-at "\\s<\\|\n")
-			(forward-line 1)))
-		(goto-char (point-min)))))
-	(setq arg (1+ arg))))))
+  (while (> arg 0)
+    (let ((pos (point)))
+      (end-of-line 1)
+      (beginning-of-defun-raw 1)
+      (while (unless (eobp)
+               (funcall end-of-defun-function)
+               (skip-chars-forward " \t")
+               (if (looking-at "\\s<\\|\n")
+                   (forward-line 1))
+               ;; If we started after the end of the previous function, then
+               ;; try again with the next one.
+               (when (<= (point) pos)
+                 (or (bobp) (forward-char -1))
+                 (beginning-of-defun-raw -1)
+                 'try-again))))
+    (setq arg (1- arg)))
+  (while (< arg 0)
+    (let ((pos (point)))
+      (while (unless (bobp)
+               (beginning-of-line 1)
+               (beginning-of-defun-raw 1)
+               (let ((beg (point)))
+                 (funcall end-of-defun-function)
+                 (skip-chars-forward " \t")
+                 (if (looking-at "\\s<\\|\n")
+                     (forward-line 1))
+                 ;; If we started from within the function just found, then
+                 ;; try again with the previous one.
+                 (when (>= (point) pos)
+                   (goto-char beg)
+                   'try-again)))))
+    (setq arg (1+ arg))))
 
 (defun mark-defun (&optional allow-extend)
   "Put mark at end of this defun, point at beginning.
@@ -562,12 +566,47 @@ character."
 		;; "Unbalanced parentheses", but those may not be so
 		;; accurate/helpful, e.g. quotes may actually be
 		;; mismatched.
-  		(error "Unmatched bracket or quote"))
-    (error (cond ((eq 'scan-error (car data))
-		  (goto-char (nth 2 data))
-		  (error "Unmatched bracket or quote"))
-		 (t (signal (car data) (cdr data)))))))
+  		(error "Unmatched bracket or quote"))))
 
+(defun field-complete (table &optional predicate)
+  (let* ((pattern (field-string-no-properties))
+         (completion (try-completion pattern table predicate)))
+    (cond ((eq completion t))
+          ((null completion)
+           (message "Can't find completion for \"%s\"" pattern)
+           (ding))
+          ((not (string= pattern completion))
+           (delete-region (field-beginning) (field-end))
+           (insert completion)
+           ;; Don't leave around a completions buffer that's out of date.
+           (let ((win (get-buffer-window "*Completions*" 0)))
+             (if win (with-selected-window win (bury-buffer)))))
+          (t
+           (let ((minibuf-is-in-use
+                  (eq (minibuffer-window) (selected-window))))
+             (unless minibuf-is-in-use
+               (message "Making completion list..."))
+             (let ((list (all-completions pattern table predicate)))
+               (setq list (sort list 'string<))
+               (or (eq predicate 'fboundp)
+                   (let (new)
+                     (while list
+                       (setq new (cons (if (fboundp (intern (car list)))
+                                           (list (car list) " <f>")
+                                         (car list))
+                                       new))
+                       (setq list (cdr list)))
+                     (setq list (nreverse new))))
+               (if (> (length list) 1)
+                   (with-output-to-temp-buffer "*Completions*"
+                     (display-completion-list list pattern))
+                 ;; Don't leave around a completions buffer that's
+                 ;; out of date.
+                 (let ((win (get-buffer-window "*Completions*" 0)))
+                   (if win (with-selected-window win (bury-buffer))))))
+             (unless minibuf-is-in-use
+               (message "Making completion list...%s" "done")))))))
+
 (defun lisp-complete-symbol (&optional predicate)
   "Perform completion on Lisp symbol preceding point.
 Compare that symbol against the known Lisp symbols.
diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el
index 93cf434292a..d9ce48e23a6 100644
--- a/lisp/emacs-lisp/ring.el
+++ b/lisp/emacs-lisp/ring.el
@@ -51,8 +51,8 @@
 (defun ring-p (x)
   "Return t if X is a ring; nil otherwise."
   (and (consp x) (integerp (car x))
-       (consp (cdr x)) (integerp (car (cdr x)))
-       (vectorp (cdr (cdr x)))))
+       (consp (cdr x)) (integerp (cadr x))
+       (vectorp (cddr x))))
 
 ;;;###autoload
 (defun make-ring (size)
@@ -60,11 +60,11 @@
   (cons 0 (cons 0 (make-vector size nil))))
 
 (defun ring-insert-at-beginning (ring item)
-  "Add to RING the item ITEM.  Add it at the front, as the oldest item."
-  (let* ((vec (cdr (cdr ring)))
+  "Add to RING the item ITEM, at the front, as the oldest item."
+  (let* ((vec (cddr ring))
          (veclen (length vec))
          (hd (car ring))
-         (ln (car (cdr ring))))
+         (ln (cadr ring)))
     (setq ln (min veclen (1+ ln))
           hd (ring-minus1 hd veclen))
     (aset vec hd item)
@@ -73,16 +73,16 @@
 
 (defun ring-plus1 (index veclen)
   "Return INDEX+1, with wraparound."
-  (let ((new-index (+ index 1)))
+  (let ((new-index (1+ index)))
     (if (= new-index veclen) 0 new-index)))
 
 (defun ring-minus1 (index veclen)
   "Return INDEX-1, with wraparound."
-  (- (if (= 0 index) veclen index) 1))
+  (- (if (zerop index) veclen index) 1))
 
 (defun ring-length (ring)
   "Return the number of elements in the RING."
-  (car (cdr ring)))
+  (cadr ring))
 
 (defun ring-index (index head ringlen veclen)
   "Convert nominal ring index INDEX to an internal index.
@@ -95,26 +95,26 @@ VECLEN is the size of the vector in the ring."
 
 (defun ring-empty-p (ring)
   "Return t if RING is empty; nil otherwise."
-  (zerop (car (cdr ring))))
+  (zerop (cadr ring)))
 
 (defun ring-size (ring)
   "Return the size of RING, the maximum number of elements it can contain."
-  (length (cdr (cdr ring))))
+  (length (cddr ring)))
 
 (defun ring-copy (ring)
   "Return a copy of RING."
-  (let* ((vec (cdr (cdr ring)))
-	 (hd  (car ring))
-	 (ln  (car (cdr ring))))
+  (let ((vec (cddr ring))
+	(hd  (car ring))
+	(ln  (cadr ring)))
     (cons hd (cons ln (copy-sequence vec)))))
 
 (defun ring-insert (ring item)
   "Insert onto ring RING the item ITEM, as the newest (last) item.
 If the ring is full, dump the oldest item to make room."
-  (let* ((vec (cdr (cdr ring)))
+  (let* ((vec (cddr ring))
          (veclen (length vec))
          (hd (car ring))
-         (ln (car (cdr ring))))
+         (ln (cadr ring)))
     (prog1
         (aset vec (mod (+ hd ln) veclen) item)
       (if (= ln veclen)
@@ -128,13 +128,13 @@ numeric, remove the element indexed."
   (if (ring-empty-p ring)
       (error "Ring empty")
     (let* ((hd (car ring))
-           (ln (car (cdr ring)))
-           (vec (cdr (cdr ring)))
+           (ln (cadr ring))
+           (vec (cddr ring))
            (veclen (length vec))
            (tl (mod (1- (+ hd ln)) veclen))
            oldelt)
-      (if (null index)
-          (setq index (1- ln)))
+      (when (null index)
+	(setq index (1- ln)))
       (setq index (ring-index index hd ln veclen))
       (setq oldelt (aref vec index))
       (while (/= index tl)
@@ -152,7 +152,9 @@ INDEX need not be <= the ring length; the appropriate modulo operation
 will be performed."
   (if (ring-empty-p ring)
       (error "Accessing an empty ring")
-    (let* ((hd (car ring))  (ln (car (cdr ring)))  (vec (cdr (cdr ring))))
+    (let ((hd (car ring))
+	  (ln (cadr ring))
+	  (vec (cddr ring)))
       (aref vec (ring-index index hd ln (length vec))))))
 
 (defun ring-elements (ring)
@@ -165,15 +167,12 @@ will be performed."
       (push (aref vect (mod (+ start var) size)) lst))))
 
 (defun ring-member (ring item)
-  "Return index of ITEM if on RING, else nil.  Comparison via `equal'.
-The index is 0-based."
-  (let ((ind 0)
-        (len (1- (ring-length ring)))
-        (memberp nil))
-    (while (and (<= ind len)
-                (not (setq memberp (equal item (ring-ref ring ind)))))
-      (setq ind (1+ ind)))
-    (and memberp ind)))
+  "Return index of ITEM if on RING, else nil.
+Comparison is done via `equal'.  The index is 0-based."
+  (catch 'found
+    (dotimes (ind (ring-length ring) nil)
+      (when (equal item (ring-ref ring ind))
+	(throw 'found ind)))))
 
 (defun ring-next (ring item)
   "Return the next item in the RING, after ITEM.
@@ -190,12 +189,12 @@ Raise error if ITEM is not in the RING."
     (ring-ref ring (ring-minus1 curr-index (ring-length ring)))))
 
 (defun ring-insert+extend (ring item &optional grow-p)
-  "Like ring-insert, but if GROW-P is non-nil, then enlarge ring.
+  "Like `ring-insert', but if GROW-P is non-nil, then enlarge ring.
 Insert onto ring RING the item ITEM, as the newest (last) item.
 If the ring is full, behavior depends on GROW-P:
   If GROW-P is non-nil, enlarge the ring to accommodate the new item.
   If GROW-P is nil, dump the oldest item to make room for the new."
-  (let* ((vec (cdr (cdr ring)))
+  (let* ((vec (cddr ring))
 	 (veclen (length vec))
 	 (hd (car ring))
 	 (ringlen (ring-length ring)))
@@ -218,7 +217,8 @@ If the RING is full, behavior depends on GROW-P:
   If GROW-P is non-nil, enlarge the ring to accommodate the new ITEM.
   If GROW-P is nil, dump the oldest item to make room for the new."
   (let (ind)
-    (while (setq ind (ring-member ring item)) (ring-remove ring ind)))
+    (while (setq ind (ring-member ring item))
+      (ring-remove ring ind)))
   (ring-insert+extend ring item grow-p))
 
 (defun ring-convert-sequence-to-ring (seq)
@@ -227,13 +227,11 @@ If SEQ is already a ring, return it."
   (if (ring-p seq)
       seq
     (let* ((size (length seq))
-           (ring (make-ring size))
-           (count 0))
-      (while (< count size)
-        (if (or (ring-empty-p ring)
-                (not (equal (ring-ref ring 0) (elt seq count))))
-            (ring-insert-at-beginning ring (elt seq count)))
-        (setq count (1+ count)))
+           (ring (make-ring size)))
+      (dotimes (count size)
+        (when (or (ring-empty-p ring)
+		  (not (equal (ring-ref ring 0) (elt seq count))))
+	  (ring-insert-at-beginning ring (elt seq count))))
       ring)))
 
 ;;; provide ourself:
diff --git a/lisp/emacs-lisp/tcover-ses.el b/lisp/emacs-lisp/tcover-ses.el
index 27ddeb25718..a0097ef9052 100644
--- a/lisp/emacs-lisp/tcover-ses.el
+++ b/lisp/emacs-lisp/tcover-ses.el
@@ -1,6 +1,7 @@
 ;;;; testcover-ses.el -- Example use of `testcover' to test "SES"
 
-;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
+;;   Free Software Foundation, Inc.
 
 ;; Author: Jonathan Yavner <jyavner@engineer.com>
 ;; Maintainer: Jonathan Yavner <jyavner@engineer.com>
@@ -26,6 +27,17 @@
 (defvar ses-initial-global-parameters)
 (defvar ses-mode-map)
 
+(declare-function ses-set-curcell "ses")
+(declare-function ses-update-cells "ses")
+(declare-function ses-load "ses")
+(declare-function ses-vector-delete "ses")
+(declare-function ses-create-header-string "ses")
+(declare-function ses-read-cell "ses")
+(declare-function ses-read-symbol "ses")
+(declare-function ses-command-hook "ses")
+(declare-function ses-jump "ses")
+
+
 ;;;Here are some macros that exercise SES.  Set `pause' to t if you want the
 ;;;macros to pause after each step.
 (let* ((pause nil)
diff --git a/lisp/emacs-lisp/tcover-unsafep.el b/lisp/emacs-lisp/tcover-unsafep.el
index b999ce63b8c..42c3ebef4e7 100644
--- a/lisp/emacs-lisp/tcover-unsafep.el
+++ b/lisp/emacs-lisp/tcover-unsafep.el
@@ -111,6 +111,7 @@
     )
   "A-list of (FORM . REASON)... that`unsafep' should decide are unsafe.")
 
+(declare-function unsafep-function "unsafep" (fun))
 
 ;;;#########################################################################
 (defun testcover-unsafep ()
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 0fed5962fcb..b11f7ca9d5c 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -356,6 +356,9 @@ This function is called, by name, directly by the C code."
   "Non-nil if EVENT is a timeout event."
   (and (listp event) (eq (car event) 'timer-event)))
 
+
+(declare-function diary-entry-time "diary-lib" (s))
+
 ;;;###autoload
 (defun run-at-time (time repeat function &rest args)
   "Perform an action at time TIME.