changeset 109412:9557b86a556a

Merge from mainline.

--- a/lisp/ChangeLog	Thu Jun 17 22:50:31 2010 +0000
+++ b/lisp/ChangeLog	Sun Jun 20 22:46:22 2010 +0000
@@ -1,3 +1,36 @@
[phone]  Chong Yidong  <[e-mail]>
+
+	* emacs-lisp/package.el (package-print-package): Add link to
+	package description via describe-package.
+	(describe-package-1): List package requirements.  Add button to
+	perform installation.
+	(package-menu-describe-package): New command.
+
+	* help-mode.el (help-package): New button type.
+
[phone]  Chong Yidong  <[e-mail]>
+
+	* emacs-lisp/package.el: Move package-list-packages binding to
+	menu-bar.el.
+	(describe-package, describe-package-1, package--dir): New funs.
+	(package-activate-1): Use package--dir.
+
+	* emacs-lisp/package-x.el (gnus-article-buffer): Require package.
+
+	* help-mode.el (help-package-def): New button type.
+
+	* menu-bar.el: Move package-list-packages binding here from
+	package.el.
+
[phone]  Gustav Hållberg  <[e-mail]>  (tiny change)
+
+	* descr-text.el (describe-char): Avoid trailing whitespace.  (Bug#6423)
+
[phone]  Stefan Monnier  <[e-mail]>
+
+	* emacs-lisp/edebug.el (edebug-read-list):
+	Phase out old-style backquotes.
+
 2010-06-17  Juri Linkov  <[e-mail]>
 
 	* help-mode.el (help-mode): Set buffer-local variable

--- a/lisp/descr-text.el	Thu Jun 17 22:50:31 2010 +0000
+++ b/lisp/descr-text.el	Sun Jun 20 22:46:22 2010 +0000
@@ -618,7 +618,7 @@
               ,@(if (not eight-bit-p)
                     (let ((unicodedata (describe-char-unicode-data char)))
                       (if unicodedata
-                          (cons (list "Unicode data" " ") unicodedata))))))
+                          (cons (list "Unicode data" "") unicodedata))))))
       (setq max-width (apply 'max (mapcar (lambda (x)
                                             (if (cadr x) (length (car x)) 0))
                                           item-list)))
@@ -642,7 +642,8 @@
                               (window-width))
                       (insert "\n")
                       (indent-to (1+ max-width)))
-                    (insert " " clm)))
+                    (unless (zerop (length clm))
+                      (insert " " clm))))
                 (insert "\n"))))
 
           (when overlays

--- a/lisp/emacs-lisp/edebug.el	Thu Jun 17 22:50:31 2010 +0000
+++ b/lisp/emacs-lisp/edebug.el	Sun Jun 20 22:46:22 2010 +0000
@@ -885,17 +885,12 @@
    (edebug-storing-offsets (1- (point)) 'quote)
    (edebug-read-storing-offsets stream)))
 
-(defvar edebug-read-backquote-level 0
-  "If non-zero, we're in a new-style backquote.
-It should never be negative.  This controls how we read comma constructs.")
-
 (defun edebug-read-backquote (stream)
   ;; Turn `thing into (\` thing)
   (forward-char 1)
   (list
    (edebug-storing-offsets (1- (point)) '\`)
-   (let ((edebug-read-backquote-level (1+ edebug-read-backquote-level)))
-     (edebug-read-storing-offsets stream))))
+   (edebug-read-storing-offsets stream)))
 
 (defun edebug-read-comma (stream)
   ;; Turn ,thing into (\, thing).  Handle ,@ and ,. also.
@@ -910,12 +905,9 @@
 	     (forward-char 1)))
       ;; Generate the same structure of offsets we would have
       ;; if the resulting list appeared verbatim in the input text.
-      (if (zerop edebug-read-backquote-level)
-	  (edebug-storing-offsets opoint symbol)
-	(list
-	 (edebug-storing-offsets opoint symbol)
-	 (let ((edebug-read-backquote-level (1- edebug-read-backquote-level)))
-	   (edebug-read-storing-offsets stream)))))))
+      (list
+       (edebug-storing-offsets opoint symbol)
+       (edebug-read-storing-offsets stream)))))
 
 (defun edebug-read-function (stream)
   ;; Turn #'thing into (function thing)
@@ -937,17 +929,7 @@
   (prog1
       (let ((elements))
 	(while (not (memq (edebug-next-token-class) '(rparen dot)))
-	  (if (and (eq (edebug-next-token-class) 'backquote)
-		   (null elements)
-		   (zerop edebug-read-backquote-level))
-	      (progn
-		;; Old style backquote.
-		(forward-char 1)	; Skip backquote.
-		;; Call edebug-storing-offsets here so that we
-		;; produce the same offsets we would have had
-		;; if the backquote were an ordinary symbol.
-		(push (edebug-storing-offsets (1- (point)) '\`) elements))
-	    (push (edebug-read-storing-offsets stream) elements)))
+          (push (edebug-read-storing-offsets stream) elements))
 	(setq elements (nreverse elements))
 	(if (eq 'dot (edebug-next-token-class))
 	    (let (dotted-form)
@@ -4455,7 +4437,7 @@
   (add-hook 'cl-load-hook
 	    (function (lambda () (require 'cl-specs)))))
 
-;;; edebug-cl-read and cl-read are available from [e-mail]
+;; edebug-cl-read and cl-read are available from [e-mail]
 (if (featurep 'cl-read)
     (add-hook 'edebug-setup-hook
 	      (function (lambda () (require 'edebug-cl-read))))
@@ -4466,8 +4448,8 @@
 
 ;;; Finalize Loading
 
-;;; Finally, hook edebug into the rest of Emacs.
-;;; There are probably some other things that could go here.
+;; Finally, hook edebug into the rest of Emacs.
+;; There are probably some other things that could go here.
 
 ;; Install edebug read and eval functions.
 (edebug-install-read-eval-functions)

--- a/lisp/emacs-lisp/package-x.el	Thu Jun 17 22:50:31 2010 +0000
+++ b/lisp/emacs-lisp/package-x.el	Sun Jun 20 22:46:22 2010 +0000
@@ -31,6 +31,9 @@
 
 ;;; Code:
 
+(require 'package)
+(defvar gnus-article-buffer)
+
 ;; Note that this only works if you have the password, which you
 ;; probably don't :-).
 (defvar package-archive-upload-base nil

--- a/lisp/emacs-lisp/package.el	Thu Jun 17 22:50:31 2010 +0000
+++ b/lisp/emacs-lisp/package.el	Sun Jun 20 22:46:22 2010 +0000
@@ -211,7 +211,6 @@
   :version "24.1")
 
 (defvar Info-directory-list)
-(defvar gnus-article-buffer)
 (declare-function info-initialize "info" ())
 (declare-function url-http-parse-response "url-http" ())
 (declare-function lm-header "lisp-mnt" (header))
@@ -423,33 +422,35 @@
   "Extract the kind of download from an archive package description vector."
   (aref desc 3))
 
-(defun package-activate-1 (package pkg-vec)
-  (let* ((pkg-name (symbol-name package))
-	 (pkg-ver-str (package-version-join (package-desc-vers pkg-vec)))
+(defun package--dir (name version-string)
+  (let* ((subdir (concat name "-" version-string))
 	 (dir-list (cons package-user-dir package-directory-list))
-	 (pkg-dir))
+	 pkg-dir)
     (while dir-list
-      (let ((subdir (expand-file-name (concat pkg-name "-" pkg-ver-str)
-				      (car dir-list))))
-	(if (file-directory-p subdir)
-	    (progn
-	      (setq pkg-dir subdir)
-	      (setq dir-list nil))
+      (let ((subdir-full (expand-file-name subdir (car dir-list))))
+	(if (file-directory-p subdir-full)
+	    (setq pkg-dir  subdir-full
+		  dir-list nil)
 	  (setq dir-list (cdr dir-list)))))
+    pkg-dir))
+
+(defun package-activate-1 (package pkg-vec)
+  (let* ((name (symbol-name package))
+	 (version-str (package-version-join (package-desc-vers pkg-vec)))
+	 (pkg-dir (package--dir name version-str)))
     (unless pkg-dir
       (error "Internal error: could not find directory for %s-%s"
-	     pkg-name pkg-ver-str))
+	     name version-str))
+    ;; Add info node.
     (if (file-exists-p (expand-file-name "dir" pkg-dir))
 	(progn
 	  ;; FIXME: not the friendliest, but simple.
 	  (require 'info)
 	  (info-initialize)
 	  (setq Info-directory-list (cons pkg-dir Info-directory-list))))
+    ;; Add to load path, add autoloads, and activate the package.
     (setq load-path (cons pkg-dir load-path))
-    ;; Load the autoloads and activate the package.
-    (load (expand-file-name (concat (symbol-name package) "-autoloads")
-			    pkg-dir)
-	  nil t)
+    (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t)
     (setq package-activated-list (cons package package-activated-list))
     ;; Don't return nil.
     t))
@@ -474,8 +475,7 @@
     (let* ((pkg-desc (assq package package-alist))
 	   (this-version (package-desc-vers (cdr pkg-desc)))
 	   (req-list (package-desc-reqs (cdr pkg-desc)))
-	   ;; If the package was never activated, we want to do it
-	   ;; now.
+	   ;; If the package was never activated, do it now.
 	   (keep-going (or (not (memq package package-activated-list))
 			   (package-version-compare this-version version '>))))
       (while (and req-list keep-going)
@@ -1037,13 +1037,114 @@
 	package-alist))
 
 
+;;;; Package description buffer.
 
+;;;###autoload
+(defun describe-package (package)
+  "Display the full documentation of PACKAGE (a symbol)."
+  (interactive
+   (let* ((packages (append (mapcar 'car package-alist)
+			    (mapcar 'car package-archive-contents)))
+	  (guess (function-called-at-point))
+	  val)
+     (unless (memq guess packages)
+       (setq guess nil))
+     (setq packages (mapcar 'symbol-name packages))
+     (setq val
+	   (completing-read (if guess
+				(format "Describe package (default %s): "
+					guess)
+			      "Describe package: ")
+			    packages nil t nil nil guess))
+     (list (if (equal val "")
+	       guess
+	     (intern val)))))
+  (if (or (null package) (null (symbolp package)))
+      (message "You did not specify a package")
+    (help-setup-xref (list #'describe-package package)
+		     (called-interactively-p 'interactive))
+    (with-help-window (help-buffer)
+      (with-current-buffer standard-output
+	(describe-package-1 package)))))
+
+(defun describe-package-1 (package)
+  (let ((desc (cdr (assq package package-alist)))
+	reqs version installable)
+    (prin1 package)
+    (princ " is ")
+    (cond
+     (desc
+      ;; This package is loaded (i.e. in `package-alist').
+      (let (pkg-dir)
+	(setq version (package-version-join (package-desc-vers desc)))
+	(if (assq package package--builtins)
+	    (princ "a built-in package.\n\n")
+	  (setq pkg-dir (package--dir (symbol-name package) version))
+	  (if pkg-dir
+	      (progn
+		(insert "a package installed in `")
+		(help-insert-xref-button (file-name-as-directory pkg-dir)
+					 'help-package-def pkg-dir)
+		(insert "'.\n\n"))
+	    ;; This normally does not happen.
+	    (insert "a deleted package.\n\n")
+	    (setq version nil)))))
+     (t
+      ;; An uninstalled package.
+      (setq desc (cdr (assq package package-archive-contents))
+	    version (package-version-join (package-desc-vers desc))
+	    installable t)
+      (insert "an installable package.\n\n")))
+    (if version
+	(insert "      Version: " version "\n"))
+    (setq reqs (package-desc-reqs desc))
+    (when reqs
+      (insert "     Requires: ")
+      (let ((first t)
+	    name vers text)
+	(dolist (req reqs)
+	  (setq name (car req)
+		vers (cadr req)
+		text (format "%s-%s" (symbol-name name)
+			     (package-version-join vers)))
+	  (cond (first (setq first nil))
+		((>= (+ 2 (current-column) (length text))
+		     (window-width))
+		 (insert ",\n               "))
+		(t (insert ", ")))
+	  (help-insert-xref-button text 'help-package name))
+	(insert "\n")))
+    (insert "  Description: " (package-desc-doc desc) "\n")
+    ;; Todo: button for uninstalling a package.
+    (when installable
+      (let ((button-text (if (display-graphic-p)
+			     "Install"
+			   "[Install]"))
+	    (button-face (if (display-graphic-p)
+			     '(:box (:line-width 2 :color "dark grey")
+				    :background "light grey"
+				    :foreground "black")
+			   'link)))
+	(insert "\n")
+	(insert-text-button button-text
+			    'face button-face
+			    'follow-link t
+			    'package-symbol package
+			    'action (lambda (button)
+				      (package-install
+				       (button-get button 'package-symbol))
+				      (revert-buffer nil t)
+				      (goto-char (point-min))))
+	(insert "\n")))))
+
+
 ;;;; Package menu mode.
 
 (defvar package-menu-mode-map
   (let ((map (make-keymap))
 	(menu-map (make-sparse-keymap "Package")))
     (suppress-keymap map)
+    (define-key map "\C-m" 'package-menu-describe-package)
     (define-key map "q" 'quit-window)
     (define-key map "n" 'next-line)
     (define-key map "p" 'previous-line)
@@ -1145,6 +1246,14 @@
   (interactive)
   (package-list-packages-internal))
 
+(defun package-menu-describe-package ()
+  "Describe the package in the current line."
+  (interactive)
+  (let ((name (package-menu-get-package)))
+    (if name
+	(describe-package (intern name))
+      (message "No package on this line"))))
+
 (defun package-menu-mark-internal (what)
   (unless (eobp)
     (let ((buffer-read-only nil))
@@ -1223,7 +1332,7 @@
   (save-excursion
     (beginning-of-line)
     (if (looking-at ". \\([^ \t]*\\)")
-	(match-string 1))))
+	(match-string-no-properties 1))))
 
 ;; Return the version of the package on the current line.
 (defun package-menu-get-version ()
@@ -1279,14 +1388,20 @@
 	       (t ; obsolete, but also the default.
 		'font-lock-warning-face))))
     (insert (propertize "  " 'font-lock-face face))
-    (insert (propertize (symbol-name package) 'font-lock-face face))
+    (insert-text-button (symbol-name package)
+			'face 'link
+			'follow-link t
+			'package-symbol package
+			'action (lambda (button)
+				  (describe-package
+				   (button-get button 'package-symbol))))
     (indent-to 20 1)
     (insert (propertize (package-version-join version) 'font-lock-face face))
-    (indent-to 30 1)
+    (indent-to 32 1)
     (insert (propertize key 'font-lock-face face))
     ;; FIXME: this 'when' is bogus...
     (when desc
-      (indent-to 41 1)
+      (indent-to 43 1)
       (insert (propertize desc 'font-lock-face face)))
     (insert "\n")))
 
@@ -1443,11 +1558,6 @@
   (interactive)
   (package--list-packages))
 
-;; Make it appear on the menu.
-(define-key-after menu-bar-options-menu [package]
-  '(menu-item "Manage Packages" package-list-packages
-	      :help "Install or uninstall additional Emacs packages"))
-
 (provide 'package)
 
 ;;; package.el ends here

--- a/lisp/help-mode.el	Thu Jun 17 22:50:31 2010 +0000
+++ b/lisp/help-mode.el	Sun Jun 20 22:46:22 2010 +0000
@@ -244,6 +244,16 @@
 		       (message "Unable to find location in file"))))
   'help-echo (purecopy "mouse-2, RET: find face's definition"))
 
+(define-button-type 'help-package
+  :supertype 'help-xref
+  'help-function 'describe-package
+  'help-echo (purecopy "mouse-2, RET: Describe package"))
+
+(define-button-type 'help-package-def
+  :supertype 'help-xref
+  'help-function (lambda (file) (dired file))
+  'help-echo (purecopy "mouse-2, RET: visit package directory"))
+
 
 ;;;###autoload
 (defun help-mode ()

--- a/lisp/menu-bar.el	Thu Jun 17 22:50:31 2010 +0000
+++ b/lisp/menu-bar.el	Sun Jun 20 22:46:22 2010 +0000
@@ -703,6 +703,10 @@
     (when need-save
       (custom-save-all))))
 
+(define-key menu-bar-options-menu [package]
+  '(menu-item "Manage Emacs Packages" package-list-packages
+	      :help "Install or uninstall additional Emacs packages"))
+
 (define-key menu-bar-options-menu [save]
   `(menu-item ,(purecopy "Save Options") menu-bar-options-save
 	      :help ,(purecopy "Save options set from the menu above")))

--- a/src/ChangeLog	Thu Jun 17 22:50:31 2010 +0000
+++ b/src/ChangeLog	Sun Jun 20 22:46:22 2010 +0000
@@ -1,3 +1,19 @@
[phone]  Eli Zaretskii  <[e-mail]>
+
+	* xdisp.c (try_scrolling): When scroll-conservatively is set to
+	most-positive-fixnum, be extra accurate when scrolling window
+	start, to avoid missing the cursor line.
+
[phone]  Eli Zaretskii  <[e-mail]>
+
+	* xdisp.c (try_scrolling): Compute the limit for searching point
+	in forward scroll from scroll_max, instead of an arbitrary limit
+	of 10 screen lines.  See
+	http://lists.gnu.org/archive/html/emacs-devel/2010-06/msg00766.html
+	and
+	http://lists.gnu.org/archive/html/emacs-devel/2010-06/msg00773.html
+	for details.
+
 2010-06-16  Glenn Morris  <[e-mail]>
 
 	* editfns.c (Fbyte_to_string): Pacify compiler.

--- a/src/xdisp.c	Thu Jun 17 22:50:31 2010 +0000
+++ b/src/xdisp.c	Sun Jun 20 22:46:22 2010 +0000
@@ -13431,14 +13431,22 @@
       if (PT > CHARPOS (it.current.pos))
 	{
 	  int y0 = line_bottom_y (&it);
-
-	  /* Compute the distance from the scroll margin to PT
-	     (including the height of the cursor line).  Moving the
-	     iterator unconditionally to PT can be slow if PT is far
-	     away, so stop 10 lines past the window bottom (is there a
-	     way to do the right thing quickly?).  */
-	  move_it_to (&it, PT, -1,
-	  	      it.last_visible_y + 10 * FRAME_LINE_HEIGHT (f),
+	  /* Compute how many pixels below window bottom to stop searching
+	     for PT.  This avoids costly search for PT that is far away if
+	     the user limited scrolling by a small number of lines, but
+	     always finds PT if scroll_conservatively is set to a large
+	     number, such as most-positive-fixnum.  */
+	  int slack = max (scroll_max, 10 * FRAME_LINE_HEIGHT (f));
+	  int y_to_move =
+	    slack >= INT_MAX - it.last_visible_y
+	    ? INT_MAX
+	    : it.last_visible_y + slack;
+
+	  /* Compute the distance from the scroll margin to PT or to
+	     the scroll limit, whichever comes first.  This should
+	     include the height of the cursor line, to make that line
+	     fully visible.  */
+	  move_it_to (&it, PT, -1, y_to_move,
 	  	      -1, MOVE_TO_POS | MOVE_TO_Y);
 	  dy = line_bottom_y (&it) - y0;
 
@@ -13478,7 +13486,26 @@
 	return SCROLLING_FAILED;
 
       start_display (&it, w, startp);
-      move_it_vertically (&it, amount_to_scroll);
+      if (scroll_max < INT_MAX)
+	move_it_vertically (&it, amount_to_scroll);
+      else
+	{
+	  /* Extra precision for users who set scroll-conservatively
+	     to most-positive-fixnum: make sure the amount we scroll
+	     the window start is never less than amount_to_scroll,
+	     which was computed as distance from window bottom to
+	     point.  This matters when lines at window top and lines
+	     below window bottom have different height.  */
+	  struct it it1 = it;
+	  /* We use a temporary it1 because line_bottom_y can modify
+	     its argument, if it moves one line down; see there.  */
+	  int start_y = line_bottom_y (&it1);
+
+	  do {
+	    move_it_by_lines (&it, 1, 1);
+	    it1 = it;
+	  } while (line_bottom_y (&it1) - start_y < amount_to_scroll);
+	}
 
       /* If STARTP is unchanged, move it down another screen line.  */
       if (CHARPOS (it.current.pos) == CHARPOS (startp))