Merge from trunk.

9 files changed, 200 insertions, 50 deletions

diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el
index 270211f6a78..d6512306ad1 100644
--- a/lisp/emacs-lisp/cl-loaddefs.el
+++ b/lisp/emacs-lisp/cl-loaddefs.el
@@ -282,7 +282,7 @@ Not documented
 ;;;;;;  flet progv psetq do-all-symbols do-symbols dotimes dolist
 ;;;;;;  do* do loop return-from return block etypecase typecase ecase
 ;;;;;;  case load-time-value eval-when destructuring-bind function*
-;;;;;;  defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "9452c0e16fd960fce5c19e5c067a7160")
+;;;;;;  defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "cc8cbd8c86e2facbe61986e992e6c508")
 ;;; Generated autoloads from cl-macs.el
 
 (autoload 'gensym "cl-macs" "\
@@ -426,6 +426,7 @@ The Common Lisp `do*' loop.
 Loop over a list.
 Evaluate BODY with VAR bound to each `car' from LIST, in turn.
 Then evaluate RESULT to get return value, default nil.
+An implicit nil block is established around the loop.
 
 \(fn (VAR LIST [RESULT]) BODY...)" nil (quote macro))
 
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index d6b4643d6a4..d9531cc5261 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -238,6 +238,37 @@ It is a list of elements of the form either:
 
 (declare-function help-add-fundoc-usage "help-fns" (docstring arglist))
 
+(defun cl--make-usage-var (x)
+  "X can be a var or a (destructuring) lambda-list."
+  (cond
+   ((symbolp x) (make-symbol (upcase (symbol-name x))))
+   ((consp x) (cl--make-usage-args x))
+   (t x)))
+
+(defun cl--make-usage-args (arglist)
+  ;; `orig-args' can contain &cl-defs (an internal
+  ;; CL thingy I don't understand), so remove it.
+  (let ((x (memq '&cl-defs arglist)))
+    (when x (setq arglist (delq (car x) (remq (cadr x) arglist)))))
+  (let ((state nil))
+    (mapcar (lambda (x)
+              (cond
+               ((symbolp x)
+                (if (eq ?\& (aref (symbol-name x) 0))
+                    (setq state x)
+                  (make-symbol (upcase (symbol-name x)))))
+               ((not (consp x)) x)
+               ((memq state '(nil &rest)) (cl--make-usage-args x))
+               (t        ;(VAR INITFORM SVAR) or ((KEYWORD VAR) INITFORM SVAR).
+                (list*
+                 (if (and (consp (car x)) (eq state '&key))
+                     (list (caar x) (cl--make-usage-var (nth 1 (car x))))
+                   (cl--make-usage-var (car x)))
+                 (nth 1 x)                          ;INITFORM.
+                 (cl--make-usage-args (nthcdr 2 x)) ;SVAR.
+                 ))))
+            arglist)))
+
 (defun cl-transform-lambda (form bind-block)
   (let* ((args (car form)) (body (cdr form)) (orig-args args)
 	 (bind-defs nil) (bind-enquote nil)
@@ -282,11 +313,8 @@ It is a list of elements of the form either:
                         (require 'help-fns)
                         (cons (help-add-fundoc-usage
                                (if (stringp (car hdr)) (pop hdr))
-                               ;; orig-args can contain &cl-defs (an internal
-                               ;; CL thingy I don't understand), so remove it.
-                               (let ((x (memq '&cl-defs orig-args)))
-                                 (if (null x) orig-args
-                                   (delq (car x) (remq (cadr x) orig-args)))))
+                               (format "(fn %S)"
+                                       (cl--make-usage-args orig-args)))
                               hdr)))
 		    (list (nconc (list 'let* bind-lets)
 				 (nreverse bind-forms) body)))))))
@@ -1233,6 +1261,7 @@ Valid clauses are:
   "Loop over a list.
 Evaluate BODY with VAR bound to each `car' from LIST, in turn.
 Then evaluate RESULT to get return value, default nil.
+An implicit nil block is established around the loop.
 
 \(fn (VAR LIST [RESULT]) BODY...)"
   (let ((temp (make-symbol "--cl-dolist-temp--")))
@@ -2387,9 +2416,8 @@ value, that slot cannot be set via `setf'.
 			(append
 			 (and pred-check
 			      (list (list 'or pred-check
-					  (list 'error
-						(format "%s accessing a non-%s"
-							accessor name)))))
+					  `(error "%s accessing a non-%s"
+						  ',accessor ',name))))
 			 (list (if (eq type 'vector) (list 'aref 'cl-x pos)
 				 (if (= pos 0) '(car cl-x)
 				   (list 'nth pos 'cl-x)))))) forms)
@@ -2397,9 +2425,8 @@ value, that slot cannot be set via `setf'.
 	      (push (list 'define-setf-method accessor '(cl-x)
 			     (if (cadr (memq :read-only (cddr desc)))
                                  (list 'progn '(ignore cl-x)
-                                       (list 'error
-                                             (format "%s is a read-only slot"
-                                                     'accessor)))
+                                       `(error "%s is a read-only slot"
+					       ',accessor))
 			       ;; If cl is loaded only for compilation,
 			       ;; the call to cl-struct-setf-expander would
 			       ;; cause a warning because it may not be
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 157749500e7..8276030ccf8 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -778,6 +778,7 @@ Redefining FUNCTION also cancels it."
 			 (not (debugger-special-form-p symbol))))
 		t nil nil (symbol-name fn)))
      (list (if (equal val "") fn (intern val)))))
+  ;; FIXME: Use advice.el.
   (when (debugger-special-form-p function)
     (error "Function %s is a special form" function))
   (if (or (symbolp (symbol-function function))
@@ -835,24 +836,30 @@ To specify a nil argument interactively, exit with an empty minibuffer."
     (message "Cancelling debug-on-entry for all functions")
     (mapcar 'cancel-debug-on-entry debug-function-list)))
 
+(defun debug-arglist (definition)
+  ;; FIXME: copied from ad-arglist.
+  "Return the argument list of DEFINITION."
+  (require 'help-fns)
+  (help-function-arglist definition 'preserve-names))
+
 (defun debug-convert-byte-code (function)
   (let* ((defn (symbol-function function))
 	 (macro (eq (car-safe defn) 'macro)))
     (when macro (setq defn (cdr defn)))
-    (unless (consp defn)
-      ;; Assume a compiled code object.
-      (let* ((contents (append defn nil))
+    (when (byte-code-function-p defn)
+      (let* ((args (debug-arglist defn))
 	     (body
-	      (list (list 'byte-code (nth 1 contents)
-			  (nth 2 contents) (nth 3 contents)))))
-	(if (nthcdr 5 contents)
-	    (setq body (cons (list 'interactive (nth 5 contents)) body)))
-	(if (nth 4 contents)
+              `((,(if (memq '&rest args) #'apply #'funcall)
+                 ,defn
+                 ,@(remq '&rest (remq '&optional args))))))
+	(if (> (length defn) 5)
+	    (push `(interactive ,(aref defn 5)) body))
+	(if (aref defn 4)
 	    ;; Use `documentation' here, to get the actual string,
 	    ;; in case the compiled function has a reference
 	    ;; to the .elc file.
 	    (setq body (cons (documentation function) body)))
-	(setq defn (cons 'lambda (cons (car contents) body))))
+	(setq defn `(closure (t) ,args ,@body)))
       (when macro (setq defn (cons 'macro defn)))
       (fset function defn))))
 
@@ -861,11 +868,12 @@ To specify a nil argument interactively, exit with an empty minibuffer."
 	 (tail defn))
     (when (eq (car-safe tail) 'macro)
       (setq tail (cdr tail)))
-    (if (not (eq (car-safe tail) 'lambda))
+    (if (not (memq (car-safe tail) '(closure lambda)))
 	;; Only signal an error when we try to set debug-on-entry.
 	;; When we try to clear debug-on-entry, we are now done.
 	(when flag
 	  (error "%s is not a user-defined Lisp function" function))
+      (if (eq (car tail) 'closure) (setq tail (cdr tail)))
       (setq tail (cdr tail))
       ;; Skip the docstring.
       (when (and (stringp (cadr tail)) (cddr tail))
@@ -875,9 +883,9 @@ To specify a nil argument interactively, exit with an empty minibuffer."
 	(setq tail (cdr tail)))
       (unless (eq flag (equal (cadr tail) '(implement-debug-on-entry)))
 	;; Add/remove debug statement as needed.
-	(if flag
-	    (setcdr tail (cons '(implement-debug-on-entry) (cdr tail)))
-	  (setcdr tail (cddr tail)))))
+	(setcdr tail (if flag
+                         (cons '(implement-debug-on-entry) (cdr tail))
+                       (cddr tail)))))
     defn))
 
 (defun debugger-list-functions ()
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index 4fda2bf1d52..81932f9940a 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -133,10 +133,10 @@ BODY can start with a bunch of keyword arguments.  The following keyword
 	Declare the customization group that corresponds to this mode.
 	The command `customize-mode' uses this.
 :syntax-table TABLE
-	Use TABLE instead of the default.
+	Use TABLE instead of the default (CHILD-syntax-table).
 	A nil value means to simply use the same syntax-table as the parent.
 :abbrev-table TABLE
-	Use TABLE instead of the default.
+	Use TABLE instead of the default (CHILD-abbrev-table).
 	A nil value means to simply use the same abbrev-table as the parent.
 
 Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode:
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index f84de0308bf..57d25c9e169 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -3408,7 +3408,7 @@ go to the end of the last sexp, or if that is the same point, then step."
       (message "%s is already instrumented." func)
       func)
      (t
-      (let ((loc (find-function-noselect func)))
+      (let ((loc (find-function-noselect func t)))
 	(unless (cdr loc)
 	  (error "Could not find the definition in its file"))
 	(with-current-buffer (car loc)
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 83c09b6fe0f..f1fe9594fc0 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -1312,20 +1312,20 @@ Summary:
 (defun eieio--defmethod (method kind argclass code)
   "Work part of the `defmethod' macro defining METHOD with ARGS."
   (let ((key
-    ;; find optional keys
+         ;; find optional keys
          (cond ((or (eq ':BEFORE kind)
                     (eq ':before kind))
-		 method-before)
+                method-before)
                ((or (eq ':AFTER kind)
                     (eq ':after kind))
-		 method-after)
+                method-after)
                ((or (eq ':PRIMARY kind)
                     (eq ':primary kind))
-		 method-primary)
+                method-primary)
                ((or (eq ':STATIC kind)
                     (eq ':static kind))
-		 method-static)
-		;; Primary key
+                method-static)
+               ;; Primary key
                (t method-primary))))
     ;; Make sure there is a generic (when called from defclass).
     (eieio--defalias
@@ -1338,8 +1338,8 @@ Summary:
     ;; under the type `primary' which is a non-specific calling of the
     ;; function.
     (if argclass
-	  (if (not (class-p argclass))
-	      (error "Unknown class type %s in method parameters"
+        (if (not (class-p argclass))
+            (error "Unknown class type %s in method parameters"
                    argclass))
       (if (= key -1)
 	  (signal 'wrong-type-argument (list :static 'non-class-arg)))
@@ -2864,6 +2864,106 @@ of `eq'."
 )
 
 
+;;; Obsolete backward compatibility functions.
+;; Needed to run byte-code compiled with the EIEIO of Emacs-23.
+
+(defun eieio-defmethod (method args)
+  "Obsolete work part of an old version of the `defmethod' macro."
+  (let ((key nil) (body nil) (firstarg nil) (argfix nil) (argclass nil) loopa)
+    ;; find optional keys
+    (setq key
+	  (cond ((or (eq ':BEFORE (car args))
+		     (eq ':before (car args)))
+		 (setq args (cdr args))
+		 method-before)
+		((or (eq ':AFTER (car args))
+		     (eq ':after (car args)))
+		 (setq args (cdr args))
+		 method-after)
+		((or (eq ':PRIMARY (car args))
+		     (eq ':primary (car args)))
+		 (setq args (cdr args))
+		 method-primary)
+		((or (eq ':STATIC (car args))
+		     (eq ':static (car args)))
+		 (setq args (cdr args))
+		 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)))
+    ;; make sure there is a generic
+    (eieio-defgeneric
+     method
+     (if (stringp (car body))
+	 (car body) (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 (not (class-p argclass))
+	      (error "Unknown class type %s in method parameters"
+		     (nth 1 firstarg))))
+      (if (= key -1)
+	  (signal 'wrong-type-argument (list :static 'non-class-arg)))
+      ;; generics are higher
+      (setq key (eieio-specialized-key-to-generic-key key)))
+    ;; Put this lambda into the symbol so we can find it
+    (if (byte-code-function-p (car-safe body))
+	(eieiomt-add method (car-safe body) key argclass)
+      (eieiomt-add method (append (list 'lambda (reverse argfix)) body)
+		   key argclass))
+    )
+
+  (when eieio-optimize-primary-methods-flag
+    ;; Optimizing step:
+    ;;
+    ;; If this method, after this setup, only has primary methods, then
+    ;; we can setup the generic that way.
+    (if (generic-primary-only-p method)
+	;; If there is only one primary method, then we can go one more
+	;; optimization step.
+	(if (generic-primary-only-one-p method)
+	    (eieio-defgeneric-reset-generic-form-primary-only-one method)
+	  (eieio-defgeneric-reset-generic-form-primary-only method))
+      (eieio-defgeneric-reset-generic-form method)))
+
+  method)
+(make-obsolete 'eieio-defmethod 'eieio--defmethod "24.1")
+
+(defun eieio-defgeneric (method doc-string)
+  "Obsolete work part of an old version of the `defgeneric' macro."
+  (if (and (fboundp method) (not (generic-p method))
+	   (or (byte-code-function-p (symbol-function method))
+	       (not (eq 'autoload (car (symbol-function method)))))
+	   )
+      (error "You cannot create a generic/method over an existing symbol: %s"
+	     method))
+  ;; Don't do this over and over.
+  (unless (fboundp 'method)
+    ;; This defun tells emacs where the first definition of this
+    ;; method is defined.
+    `(defun ,method nil)
+    ;; Make sure the method tables are installed.
+    (eieiomt-install method)
+    ;; Apply the actual body of this function.
+    (fset method (eieio-defgeneric-form method doc-string))
+    ;; Return the method
+    'method))
+(make-obsolete 'eieio-defgeneric nil "24.1")
+
 ;;; Interfacing with edebug
 ;;
 (defun eieio-edebug-prin1-to-string (object &optional noescape)
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 0194af2e3a8..2c7208db8a3 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -312,7 +312,7 @@ The search is done in the source for library LIBRARY."
 	      (cons (current-buffer) nil))))))))
 
 ;;;###autoload
-(defun find-function-noselect (function)
+(defun find-function-noselect (function &optional lisp-only)
   "Return a pair (BUFFER . POINT) pointing to the definition of FUNCTION.
 
 Finds the source file containing the definition of FUNCTION
@@ -320,6 +320,10 @@ in a buffer and the point of the definition.  The buffer is
 not selected.  If the function definition can't be found in
 the buffer, returns (BUFFER).
 
+If FUNCTION is a built-in function, this function normally
+attempts to find it in the Emacs C sources; however, if LISP-ONLY
+is non-nil, signal an error instead.
+
 If the file where FUNCTION is defined is not known, then it is
 searched for in `find-function-source-path' if non-nil, otherwise
 in `load-path'."
@@ -345,6 +349,8 @@ in `load-path'."
 	   (cond ((eq (car-safe def) 'autoload)
 		  (nth 1 def))
 		 ((subrp def)
+		  (if lisp-only
+		      (error "%s is a built-in function" function))
 		  (help-C-file-name def 'subr))
 		 ((symbol-file function 'defun)))))
       (find-function-search-for-symbol function nil library))))
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index e42103a7a01..caf0ec2e8b8 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -570,11 +570,11 @@ EXTRA-PROPERTIES is currently unused."
   file)
 
 (defun package-generate-autoloads (name pkg-dir)
+  (require 'autoload)         ;Load before we let-bind generated-autoload-file!
   (let* ((auto-name (concat name "-autoloads.el"))
 	 (ignore-name (concat name "-pkg.el"))
 	 (generated-autoload-file (expand-file-name auto-name pkg-dir))
 	 (version-control 'never))
-    (require 'autoload)
     (unless (fboundp 'autoload-ensure-default-file)
       (package-autoload-ensure-default-file generated-autoload-file))
     (update-directory-autoloads pkg-dir)))
@@ -852,18 +852,26 @@ using `package-compute-transaction'."
        (t
 	(error "Unknown package kind: %s" (symbol-name kind)))))))
 
+(defvar package--initialized nil)
+
 ;;;###autoload
 (defun package-install (name)
   "Install the package named NAME.
-Interactively, prompt for the package name.
-The package is found on one of the archives in `package-archives'."
+NAME should be the name of one of the available packages in an
+archive in `package-archives'.  Interactively, prompt for NAME."
   (interactive
-   (list (intern (completing-read "Install package: "
-				  (mapcar (lambda (elt)
-					    (cons (symbol-name (car elt))
-						  nil))
-					  package-archive-contents)
-				  nil t))))
+   (progn
+     ;; Initialize the package system to get the list of package
+     ;; symbols for completion.
+     (unless package--initialized
+       (package-initialize t))
+     (list (intern (completing-read
+		    "Install package: "
+		    (mapcar (lambda (elt)
+			      (cons (symbol-name (car elt))
+				    nil))
+			    package-archive-contents)
+		    nil t)))))
   (let ((pkg-desc (assq name package-archive-contents)))
     (unless pkg-desc
       (error "Package `%s' is not available for installation"
@@ -1076,8 +1084,6 @@ makes them available for download."
 		      (car archive)))))
   (package-read-all-archive-contents))
 
-(defvar package--initialized nil)
-
 ;;;###autoload
 (defun package-initialize (&optional no-activate)
   "Load Emacs Lisp packages, and activate them.
@@ -1434,7 +1440,7 @@ If optional arg BUTTON is non-nil, describe its associated package."
 (defun package-menu-mark-delete (num)
   "Mark a package for deletion and move to the next line."
   (interactive "p")
-  (if (string-equal (package-menu-get-status) "installed")
+  (if (member (package-menu-get-status) '("installed" "obsolete"))
       (tabulated-list-put-tag "D" t)
     (forward-line)))
 
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index 2fdfa9525b1..75c9a01323d 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -258,7 +258,8 @@ to the entry with the same ID element as the current line."
     ;; If REMEMBER-POS was specified, move to the "old" location.
     (if saved-pt
 	(progn (goto-char saved-pt)
-	       (move-to-column saved-col))
+	       (move-to-column saved-col)
+	       (recenter))
       (goto-char (point-min)))))
 
 (defun tabulated-list-print-entry (id cols)
@@ -282,6 +283,7 @@ of column descriptors."
 	     (> (length label) width)
 	     (setq label (concat (substring label 0 (- width 3))
 				 "...")))
+	(setq label (bidi-string-mark-left-to-right label))
 	(if (stringp desc)
 	    (insert (propertize label 'help-echo help-echo))
 	  (apply 'insert-text-button label (cdr desc)))