Merge from mainline.

3 files changed, 145 insertions, 162 deletions

diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index dffbf3418ca..f8f8d9b00f2 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -34,8 +34,8 @@
 (require 'help-fns)			;for help-add-fundoc-usage.
 (eval-when-compile (require 'cl))
 
-(defvar generated-autoload-file "loaddefs.el"
-   "File \\[update-file-autoloads] puts autoloads into.
+(defvar generated-autoload-file nil
+  "File into which to write autoload definitions.
 A Lisp file can set this in its local variables section to make
 its autoloads go somewhere else.
 
@@ -198,6 +198,15 @@ or macro definition or a defcustom)."
 ;; the doc-string in FORM.
 ;; Those properties are now set in lisp-mode.el.
 
+(defun autoload-find-generated-file ()
+  "Visit the autoload file for the current buffer, and return its buffer.
+If a buffer is visiting the desired autoload file, return it."
+  (let ((enable-local-variables :safe))
+    ;; We used to use `raw-text' to read this file, but this causes
+    ;; problems when the file contains non-ASCII characters.
+    (find-file-noselect
+     (autoload-ensure-default-file (autoload-generated-file)))))
+
 (defun autoload-generated-file ()
   (expand-file-name generated-autoload-file
                     ;; File-local settings of generated-autoload-file should
@@ -389,7 +398,8 @@ If FILE is being visited in a buffer, the contents of the buffer
 are used.
 Return non-nil in the case where no autoloads were added at point."
   (interactive "fGenerate autoloads for file: ")
-  (autoload-generate-file-autoloads file (current-buffer)))
+  (let ((generated-autoload-file buffer-file-name))
+    (autoload-generate-file-autoloads file (current-buffer))))
 
 (defvar print-readably)
 
@@ -550,15 +560,22 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE
 	(save-buffer)))))
 
 ;;;###autoload
-(defun update-file-autoloads (file &optional save-after)
-  "Update the autoloads for FILE in `generated-autoload-file'
-\(which FILE might bind in its local variables).
-If SAVE-AFTER is non-nil (which is always, when called interactively),
-save the buffer too.
+(defun update-file-autoloads (file &optional save-after outfile)
+  "Update the autoloads for FILE.
+If prefix arg SAVE-AFTER is non-nil, save the buffer too.
+
+If FILE binds `generated-autoload-file' as a file-local variable,
+autoloads are written into that file.  Otherwise, the autoloads
+file is determined by OUTFILE.  If called interactively, prompt
+for OUTFILE; if called from Lisp with OUTFILE nil, use the
+existing value of `generated-autoload-file'.
 
 Return FILE if there was no autoload cookie in it, else nil."
-  (interactive "fUpdate autoloads for file: \np")
-  (let* ((autoload-modified-buffers nil)
+  (interactive (list (read-file-name "Update autoloads for file: ")
+		     current-prefix-arg
+		     (read-file-name "Write autoload definitions to file: ")))
+  (let* ((generated-autoload-file (or outfile generated-autoload-file))
+	 (autoload-modified-buffers nil)
          (no-autoloads (autoload-generate-file-autoloads file)))
     (if autoload-modified-buffers
         (if save-after (autoload-save-buffers))
@@ -576,12 +593,7 @@ removes any prior now out-of-date autoload entries."
     (let* ((buf (current-buffer))
            (existing-buffer (if buffer-file-name buf))
            (found nil))
-      (with-current-buffer
-          ;; We used to use `raw-text' to read this file, but this causes
-          ;; problems when the file contains non-ASCII characters.
-	  (let ((enable-local-variables :safe))
-	    (find-file-noselect
-	     (autoload-ensure-default-file (autoload-generated-file))))
+      (with-current-buffer (autoload-find-generated-file)
         ;; This is to make generated-autoload-file have Unix EOLs, so
         ;; that it is portable to all platforms.
         (or (eq 0 (coding-system-eol-type buffer-file-coding-system))
@@ -640,15 +652,20 @@ removes any prior now out-of-date autoload entries."
 
 ;;;###autoload
 (defun update-directory-autoloads (&rest dirs)
-  "\
-Update loaddefs.el with all the current autoloads from DIRS, and no old ones.
-This uses `update-file-autoloads' (which see) to do its work.
-In an interactive call, you must give one argument, the name
-of a single directory.  In a call from Lisp, you can supply multiple
+  "Update autoload definitions for Lisp files in the directories DIRS.
+In an interactive call, you must give one argument, the name of a
+single directory.  In a call from Lisp, you can supply multiple
 directories as separate arguments, but this usage is discouraged.
 
 The function does NOT recursively descend into subdirectories of the
-directory or directories specified."
+directory or directories specified.
+
+In an interactive call, prompt for a default output file for the
+autoload definitions, and temporarily bind the variable
+`generated-autoload-file' to this value.  When called from Lisp,
+use the existing value of `generated-autoload-file'.  If any Lisp
+file binds `generated-autoload-file' as a file-local variable,
+write its autoloads into the specified file instead."
   (interactive "DUpdate autoloads from directory: ")
   (let* ((files-re (let ((tmp nil))
 		     (dolist (suf (get-load-suffixes)
@@ -664,14 +681,14 @@ directory or directories specified."
          ;; Files with no autoload cookies or whose autoloads go to other
          ;; files because of file-local autoload-generated-file settings.
 	 (no-autoloads nil)
-         (autoload-modified-buffers nil))
+         (autoload-modified-buffers nil)
+	 (generated-autoload-file
+	  (if (called-interactively-p 'interactive)
+	      (read-file-name "Write autoload definitions to file: ")
+	    generated-autoload-file)))
 
-    (with-current-buffer
-	(let ((enable-local-variables :safe))
-	  (find-file-noselect
-	   (autoload-ensure-default-file (autoload-generated-file))))
+    (with-current-buffer (autoload-find-generated-file)
       (save-excursion
-
 	;; Canonicalize file names and remove the autoload file itself.
 	(setq files (delete (file-relative-name buffer-file-name)
 			    (mapcar 'file-relative-name files)))
@@ -748,7 +765,9 @@ directory or directories specified."
 ;;;###autoload
 (defun batch-update-autoloads ()
   "Update loaddefs.el autoloads in batch mode.
-Calls `update-directory-autoloads' on the command line arguments."
+Calls `update-directory-autoloads' on the command line arguments.
+Definitions are written to `generated-autoload-file' (which
+should be non-nil)."
   ;; For use during the Emacs build process only.
   (unless autoload-excludes
     (let* ((ldir (file-name-directory generated-autoload-file))
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 7a119e6bbc0..268698e4128 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -656,14 +656,14 @@ See `defclass' for more information."
 	;; so that users can `setf' the space returned by this function
 	(if acces
 	    (progn
-	      (eieio-defmethod acces
-		(list (if (eq alloc :class) :static :primary)
-		      (list (list 'this cname))
-		      (format
+	      (eieio--defmethod
+               acces (if (eq alloc :class) :static :primary) cname
+               `(lambda (this)
+                  ,(format
 		       "Retrieves the slot `%s' from an object of class `%s'"
 		       name cname)
-		      (list 'if (list 'slot-boundp 'this (list 'quote name))
-			    (list 'eieio-oref 'this (list 'quote name))
+                  (if (slot-boundp this ',name)
+                      (eieio-oref this ',name)
 			    ;; Else - Some error?  nil?
 			    nil)))
 
@@ -683,22 +683,21 @@ See `defclass' for more information."
 	;; If a writer is defined, then create a generic method of that
 	;; name whose purpose is to set the value of the slot.
 	(if writer
-	    (progn
-	      (eieio-defmethod writer
-		(list (list (list 'this cname) 'value)
-		      (format "Set the slot `%s' of an object of class `%s'"
+            (eieio--defmethod
+             writer nil cname
+             `(lambda (this value)
+                ,(format "Set the slot `%s' of an object of class `%s'"
 			      name cname)
-		      `(setf (slot-value this ',name) value)))
-	      ))
+                (setf (slot-value this ',name) value))))
 	;; If a reader is defined, then create a generic method
 	;; of that name whose purpose is to access this slot value.
 	(if reader
-	    (progn
-	      (eieio-defmethod reader
-		(list (list (list 'this cname))
-		      (format "Access the slot `%s' from object of class `%s'"
+            (eieio--defmethod
+             reader nil cname
+             `(lambda (this)
+                ,(format "Access the slot `%s' from object of class `%s'"
 			      name cname)
-		      `(slot-value this ',name)))))
+                (slot-value this ',name))))
 	)
       (setq slots (cdr slots)))
 
@@ -1290,83 +1289,48 @@ Summary:
                      ((typearg class-name) arg2 &optional opt &rest rest)
     \"doc-string\"
      body)"
-  (let* ((key (cond ((or (eq ':BEFORE (car args))
-                         (eq ':before (car args)))
-                     (setq args (cdr args))
-                     :before)
-                    ((or (eq ':AFTER (car args))
-                         (eq ':after (car args)))
-                     (setq args (cdr args))
-                     :after)
-                    ((or (eq ':PRIMARY (car args))
-                         (eq ':primary (car args)))
-                     (setq args (cdr args))
-                     :primary)
-                    ((or (eq ':STATIC (car args))
-                         (eq ':static (car args)))
-                     (setq args (cdr args))
-                     :static)
-                    (t nil)))
+  (let* ((key (if (keywordp (car args)) (pop args)))
 	 (params (car args))
-	 (lamparams
-          (mapcar (lambda (param) (if (listp param) (car param) param))
-                  params))
 	 (arg1 (car params))
-	 (class (if (listp arg1) (nth 1 arg1) nil)))
-    `(eieio-defmethod ',method
-                      '(,@(if key (list key))
-                        ,params)
-                      (lambda ,lamparams ,@(cdr args)))))
-
-(defun eieio-defmethod (method args &optional code)
+	 (class (if (consp arg1) (nth 1 arg1))))
+    `(eieio--defmethod ',method ',key ',class
+                       (lambda ,(if (consp arg1)
+                               (cons (car arg1) (cdr params))
+                             params)
+                         ,@(cdr args)))))
+
+(defun eieio--defmethod (method kind argclass code)
   "Work part of the `defmethod' macro defining METHOD with ARGS."
-  (let ((key nil) (body nil) (firstarg nil) (argfix nil) (argclass nil) loopa)
+  (let ((key
     ;; find optional keys
-    (setq key
-	  (cond ((or (eq ':BEFORE (car args))
-		     (eq ':before (car args)))
-		 (setq args (cdr args))
+         (cond ((or (eq ':BEFORE kind)
+                    (eq ':before kind))
 		 method-before)
-		((or (eq ':AFTER (car args))
-		     (eq ':after (car args)))
-		 (setq args (cdr args))
+               ((or (eq ':AFTER kind)
+                    (eq ':after kind))
 		 method-after)
-		((or (eq ':PRIMARY (car args))
-		     (eq ':primary (car args)))
-		 (setq args (cdr args))
+               ((or (eq ':PRIMARY kind)
+                    (eq ':primary kind))
 		 method-primary)
-		((or (eq ':STATIC (car args))
-		     (eq ':static (car args)))
-		 (setq args (cdr args))
+               ((or (eq ':STATIC kind)
+                    (eq ':static kind))
 		 method-static)
 		;; Primary key
-		(t method-primary)))
-    ;; get body, and fix contents of args to be the arguments of the fn.
-    (setq body (cdr args)
-	  args (car args))
-    (setq loopa args)
-    ;; Create a fixed version of the arguments
-    (while loopa
-      (setq argfix (cons (if (listp (car loopa)) (car (car loopa)) (car loopa))
-			 argfix))
-      (setq loopa (cdr loopa)))
+               (t method-primary))))
     ;; make sure there is a generic
     (eieio-defgeneric
      method
-     (if (stringp (car body))
-	 (car body) (format "Generically created method `%s'." method)))
+     (or (documentation code)
+         (format "Generically created method `%s'." method)))
     ;; create symbol for property to bind to.  If the first arg is of
     ;; the form (varname vartype) and `vartype' is a class, then
     ;; that class will be the type symbol.  If not, then it will fall
     ;; under the type `primary' which is a non-specific calling of the
     ;; function.
-    (setq firstarg (car args))
-    (if (listp firstarg)
-	(progn
-	  (setq argclass  (nth 1 firstarg))
+    (if argclass
 	  (if (not (class-p argclass))
 	      (error "Unknown class type %s in method parameters"
-		     (nth 1 firstarg))))
+                   argclass))
       (if (= key -1)
 	  (signal 'wrong-type-argument (list :static 'non-class-arg)))
       ;; generics are higher
@@ -1884,11 +1848,11 @@ OBJECT can be an instance or a class."
   ;; Skip typechecking while retrieving this value.
   (let ((eieio-skip-typecheck t))
     ;; Return nil if the magic symbol is in there.
-    (if (eieio-object-p object)
-	(if (eq (eieio-oref object slot) eieio-unbound) nil t)
-      (if (class-p object)
-	  (if (eq (eieio-oref-default object slot) eieio-unbound) nil t)
-	(signal 'wrong-type-argument (list 'eieio-object-p object))))))
+    (not (eq (cond
+	      ((eieio-object-p object) (eieio-oref object slot))
+	      ((class-p object)        (eieio-oref-default object slot))
+	      (t (signal 'wrong-type-argument (list 'eieio-object-p object))))
+	     eieio-unbound))))
 
 (defun slot-makeunbound (object slot)
   "In OBJECT, make SLOT unbound."
diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
index 1fb8ac0c2b6..7f3657bbbe6 100644
--- a/lisp/emacs-lisp/warnings.el
+++ b/lisp/emacs-lisp/warnings.el
@@ -64,8 +64,8 @@ Level :debug is ignored by default (see `warning-minimum-level').")
     (critical . :emergency)
     (alarm . :emergency))
   "Alist of aliases for severity levels for `display-warning'.
-Each element looks like (ALIAS . LEVEL) and defines
-ALIAS as equivalent to LEVEL.  LEVEL must be defined in `warning-levels';
+Each element looks like (ALIAS . LEVEL) and defines ALIAS as
+equivalent to LEVEL.  LEVEL must be defined in `warning-levels';
 it may not itself be an alias.")
 
 (defcustom warning-minimum-level :warning
@@ -141,7 +141,7 @@ the beginning of the warning.")
 A marker indicates a position in the warnings buffer
 which is the start of the current series; it means that
 additional warnings in the same buffer should not move point.
-t means the next warning begins a series (and stores a marker here).
+If t, the next warning begins a series (and stores a marker here).
 A symbol with a function definition is like t, except
 also call that function before the next warning.")
 (put 'warning-series 'risky-local-variable t)
@@ -235,7 +235,7 @@ See also `warning-series', `warning-prefix-function' and
       (warning-suppress-p type warning-suppress-log-types)
       (let* ((typename (if (consp type) (car type) type))
              (old (get-buffer buffer-name))
-	     (buffer (get-buffer-create buffer-name))
+	     (buffer (or old (get-buffer-create buffer-name)))
 	     (level-info (assq level warning-levels))
 	     start end)
 	(with-current-buffer buffer
@@ -251,60 +251,60 @@ See also `warning-series', `warning-prefix-function' and
 		    (unless (eq warning-series t)
 		      (funcall warning-series)))))
           (let ((inhibit-read-only t))
-	  (unless (bolp)
-	    (newline))
-	  (setq start (point))
-	  (if warning-prefix-function
-	      (setq level-info (funcall warning-prefix-function
-					level level-info)))
-	  (insert (format (nth 1 level-info)
-                          (format warning-type-format typename))
-		  message)
-	  (newline)
-	  (when (and warning-fill-prefix (not (string-match "\n" message)))
-	    (let ((fill-prefix warning-fill-prefix)
-		  (fill-column 78))
-	      (fill-region start (point))))
-            (setq end (point)))
+	    (unless (bolp)
+	      (newline))
+	    (setq start (point))
+	    (if warning-prefix-function
+		(setq level-info (funcall warning-prefix-function
+					  level level-info)))
+	    (insert (format (nth 1 level-info)
+			    (format warning-type-format typename))
+		    message)
+	    (newline)
+	    (when (and warning-fill-prefix (not (string-match "\n" message)))
+	      (let ((fill-prefix warning-fill-prefix)
+		    (fill-column 78))
+		(fill-region start (point))))
+	    (setq end (point)))
 	  (when (and (markerp warning-series)
 		     (eq (marker-buffer warning-series) buffer))
 	    (goto-char warning-series)))
 	(if (nth 2 level-info)
 	    (funcall (nth 2 level-info)))
-     (cond (noninteractive
-	    ;; Noninteractively, take the text we inserted
-	    ;; in the warnings buffer and print it.
-	    ;; Do this unconditionally, since there is no way
-	    ;; to view logged messages unless we output them.
-	    (with-current-buffer buffer
-	      (save-excursion
-		;; Don't include the final newline in the arg
-		;; to `message', because it adds a newline.
-		(goto-char end)
-		(if (bolp)
-		    (forward-char -1))
-		(message "%s" (buffer-substring start (point))))))
-	   ((and (daemonp) (null after-init-time))
-	    ;; Warnings assigned during daemon initialization go into
-	    ;; the messages buffer.
-	    (message "%s"
-		     (with-current-buffer buffer
-		       (save-excursion
-			 (goto-char end)
-			 (if (bolp)
-			     (forward-char -1))
-			 (buffer-substring start (point))))))
-	   (t
-	    ;; Interactively, decide whether the warning merits
-	    ;; immediate display.
-	    (or (< (warning-numeric-level level)
-		   (warning-numeric-level warning-minimum-level))
-		(warning-suppress-p type warning-suppress-types)
-		(let ((window (display-buffer buffer)))
-		  (when (and (markerp warning-series)
-			     (eq (marker-buffer warning-series) buffer))
-		    (set-window-start window warning-series))
-		  (sit-for 0))))))))
+	(cond (noninteractive
+	       ;; Noninteractively, take the text we inserted
+	       ;; in the warnings buffer and print it.
+	       ;; Do this unconditionally, since there is no way
+	       ;; to view logged messages unless we output them.
+	       (with-current-buffer buffer
+		 (save-excursion
+		   ;; Don't include the final newline in the arg
+		   ;; to `message', because it adds a newline.
+		   (goto-char end)
+		   (if (bolp)
+		       (forward-char -1))
+		   (message "%s" (buffer-substring start (point))))))
+	      ((and (daemonp) (null after-init-time))
+	       ;; Warnings assigned during daemon initialization go into
+	       ;; the messages buffer.
+	       (message "%s"
+			(with-current-buffer buffer
+			  (save-excursion
+			    (goto-char end)
+			    (if (bolp)
+				(forward-char -1))
+			    (buffer-substring start (point))))))
+	      (t
+	       ;; Interactively, decide whether the warning merits
+	       ;; immediate display.
+	       (or (< (warning-numeric-level level)
+		      (warning-numeric-level warning-minimum-level))
+		   (warning-suppress-p type warning-suppress-types)
+		   (let ((window (display-buffer buffer)))
+		     (when (and (markerp warning-series)
+				(eq (marker-buffer warning-series) buffer))
+		       (set-window-start window warning-series))
+		     (sit-for 0))))))))
 
 ;;;###autoload
 (defun lwarn (type level message &rest args)