# HG changeset patch # User Katsumi Yamaoka # Date 1277073982 0 # Node ID 9557b86a556a17203ff7dc44aab898f54d9b65ef # Parent d654ebf81f14c1ad8c5b7ae76c0f68606cf84af4# Parent 9f55c53fc33a3e1d041ff19574d3742601a1a1ba Merge from mainline. diff -r d654ebf81f14 -r 9557b86a556a lisp/ChangeLog --- 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 @@ +2010-06-20 Chong Yidong + + * 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. + +2010-06-19 Chong Yidong + + * 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. + +2010-06-19 Gustav Hållberg (tiny change) + + * descr-text.el (describe-char): Avoid trailing whitespace. (Bug#6423) + +2010-06-18 Stefan Monnier + + * emacs-lisp/edebug.el (edebug-read-list): + Phase out old-style backquotes. + 2010-06-17 Juri Linkov * help-mode.el (help-mode): Set buffer-local variable diff -r d654ebf81f14 -r 9557b86a556a lisp/descr-text.el --- 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 diff -r d654ebf81f14 -r 9557b86a556a lisp/emacs-lisp/edebug.el --- 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 liberte@cs.uiuc.edu +;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu (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) diff -r d654ebf81f14 -r 9557b86a556a lisp/emacs-lisp/package-x.el --- 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 diff -r d654ebf81f14 -r 9557b86a556a lisp/emacs-lisp/package.el --- 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 diff -r d654ebf81f14 -r 9557b86a556a lisp/help-mode.el --- 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 () diff -r d654ebf81f14 -r 9557b86a556a lisp/menu-bar.el --- 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"))) diff -r d654ebf81f14 -r 9557b86a556a src/ChangeLog --- 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 @@ +2010-06-20 Eli Zaretskii + + * 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. + +2010-06-19 Eli Zaretskii + + * 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 * editfns.c (Fbyte_to_string): Pacify compiler. diff -r d654ebf81f14 -r 9557b86a556a src/xdisp.c --- 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))