Mercurial > hg > xemacs-beta
diff lisp/package-ui.el @ 321:19dcec799385 r21-0-58
Import from CVS: tag r21-0-58
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:46:44 +0200 |
parents | 512e409c26a2 |
children | 03446687b7cc |
line wrap: on
line diff
--- a/lisp/package-ui.el Mon Aug 13 10:46:01 2007 +0200 +++ b/lisp/package-ui.el Mon Aug 13 10:46:44 2007 +0200 @@ -30,23 +30,52 @@ ;; User-changeable variables: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar pui-up-to-date-package-face nil - "The face to use for packages that are up-to-date.") +(defgroup pui nil + "Conventient interface to the package system." + :group 'package-tools + :tag "Package User interface" + :prefix "pui-") -(defvar pui-selected-package-face (get-face 'bold) - "The face to use for selected packages. -Set this to `nil' to use the `default' face.") +(defcustom pui-package-install-dest-dir nil + "*If non-nil (Automatic) path to package tree to install packages in. +Otherwise, use old path for installed packages and make a guess for +new ones." + :group 'pui + :tag "Install Location" + :type '(choice (const :tag "Automatic" nil) + (directory))) + +(defcustom pui-list-verbose t + "*If non-nil, display verbose info in the package list buffer." + :group 'pui + :tag "Verbose Listing" + :type 'boolean) -(defvar pui-outdated-package-face (get-face 'red) - "The face to use for outdated packages. -Set this to `nil' to use the `default' face.") +(defcustom pui-up-to-date-package-face nil + "*The face to use for packages that are up-to-date." + :group 'pui + :type 'face) + +(defcustom pui-selected-package-face 'bold + "*The face to use for selected packages. +Set this to `nil' to use the `default' face." + :group 'pui + :type 'face) -(defvar pui-uninstalled-package-face (get-face 'italic) - "The face to use for uninstalled packages. -Set this to `nil' to use the `default' face.") +(defcustom pui-outdated-package-face 'red + "*The face to use for outdated packages. +Set this to `nil' to use the `default' face." + :group 'pui + :type 'face) -(defvar pui-list-verbose t - "If non-nil, display verbose info in the package list buffer.") +(defcustom pui-uninstalled-package-face 'italic + "*The face to use for uninstalled packages. +Set this to `nil' to use the `default' face." + :group 'pui + :type 'face) + + + (defvar pui-info-buffer "*Packages*" "Buffer to use for displaying package information.") @@ -71,6 +100,7 @@ (define-key m [return] 'pui-toggle-package-key) (define-key m "x" 'pui-install-selected-packages) (define-key m "I" 'pui-install-selected-packages) + (define-key m "r" 'pui-add-required-packages) (define-key m "n" 'next-line) (define-key m "+" 'next-line) (define-key m "p" 'previous-line) @@ -82,7 +112,8 @@ (let ((m (make-sparse-keymap))) (set-keymap-name m 'pui-package-keymap) (define-key m 'button2 'pui-toggle-package-event) - (define-key m 'button3 'pui-toggle-package-event) +;; We use a popup menu +;; (define-key m 'button3 'pui-toggle-package-event) m) "Keymap to use over package names/descriptions.") @@ -182,9 +213,15 @@ (defun pui-package-symbol-char (pkg-sym version) (progn (if (package-get-info-find-package packages-package-list pkg-sym) - (if (package-get-installedp pkg-sym version) - (list " " pui-up-to-date-package-face) - (list "*" pui-outdated-package-face)) + (let ((installed (package-get-key pkg-sym :version))) + (if (>= (if (stringp installed) + (string-to-number installed) + installed) + (if (stringp version) + (string-to-number version) + version)) + (list " " pui-up-to-date-package-face) + (list "*" pui-outdated-package-face))) (list "-" pui-uninstalled-package-face)) )) @@ -209,8 +246,8 @@ (progn (setq disp (pui-package-symbol-char pkg-sym version)) (setq sym-char (car disp)) - (if (cdr disp) - (set-extent-face extent (car (cdr disp))) + (if (car (cdr disp)) + (set-extent-face extent (get-face (car (cdr disp)))) (set-extent-face extent (get-face 'default))) )) (save-excursion @@ -301,7 +338,8 @@ (message "Installing selected packages ...") (sit-for 0) (if (catch 'done (mapcar (lambda (pkg) - (if (not (package-get-all pkg nil)) + (if (not (package-get pkg nil nil + pui-package-install-dest-dir)) (throw 'done nil))) pui-selected-packages) t) @@ -316,6 +354,61 @@ (error "No packages have been selected!")) )) +(defun pui-add-required-packages () + "Select packages required by those already selected for installation." + (interactive) + (let ((tmpbuf "*Required-Packages*") do-select) + (if pui-selected-packages + (let ((dependencies + (delq nil (mapcar + (lambda (pkg) + (let ((installed + (package-get-key pkg :version)) + (current + (package-get-info-prop + (package-get-info-version + (package-get-info-find-package + package-get-base pkg) nil) + 'version))) + (if (< (if (stringp installed) + (string-to-number installed) + installed) + (if (stringp current) + (string-to-number current) + current)) + pkg + nil))) + (package-get-dependencies pui-selected-packages))))) + ;; Don't change window config when asking the user if he really + ;; wants to add the packages. We do this to avoid messing up + ;; the window configuration if errors occur (we don't want to + ;; display random buffers in addition to the error buffer, if + ;; errors occur, which would normally be caused by display-buffer). + (save-window-excursion + (with-output-to-temp-buffer tmpbuf + (display-completion-list (sort + (mapcar #'(lambda (pkg) + (symbol-name pkg)) + dependencies) + 'string<) + :activate-callback nil + :help-string "Required packages:\n" + :completion-string t)) + (setq tmpbuf (get-buffer-create tmpbuf)) + (display-buffer tmpbuf) + (setq do-select (y-or-n-p "Select these packages? ")) + (kill-buffer tmpbuf)) + (if do-select + (progn + (setq pui-selected-packages + (union pui-selected-packages dependencies)) + (map-extents #'(lambda (extent maparg) + (pui-update-package-display extent)) + nil nil nil nil nil 'pui) + (message "added dependencies")) + (clear-message))) + (error "No packages have been selected!")))) + (defun pui-help-echo (extent &optional force-update) "Display additional package info in the modeline. EXTENT determines the package to display (the package information is @@ -371,6 +464,7 @@ Useful keys: `\\[pui-toggle-package-key]' to select/unselect the current package for installation. + `\\[pui-add-required-packages]' to add any packages required by those selected. `\\[pui-install-selected-packages]' to install selected packages. `\\[pui-display-info]' to display additional information about the package in the modeline. `\\[pui-list-packages]' to refresh the package list. @@ -379,6 +473,21 @@ ") )) +(defvar pui-menu + '("Packages" + ["Select" pui-toggle-package-key t] + ["Info" pui-display-info t] + "---" + ["Add Required" pui-add-required-packages t] + ["Install Selected" pui-install-selected-packages t] + "---" + ["Verbose" pui-toggle-verbosity-redisplay + :active t :style toggle :selected pui-list-verbose] + ["Refresh" pui-list-packages t] + ["Help" pui-help t] + ["Quit" pui-quit t])) + + ;;;###autoload (defun pui-list-packages () "List all packages and package information. @@ -387,6 +496,7 @@ which are out-of-date (a newer version is available). The user can then select packages for installation via the keyboard or mouse." (interactive) + (package-get-require-base t) (let ( (outbuf (get-buffer-create pui-info-buffer)) (sep-string "===============================================================================\n") start ) @@ -452,8 +562,8 @@ (point))) ) (setq extent (make-extent b e)) - (if (cdr disp) - (set-extent-face extent (car (cdr disp))) + (if (car (cdr disp)) + (set-extent-face extent (get-face (car (cdr disp)))) (set-extent-face extent (get-face 'default))) (set-extent-property extent 'highlight t) (set-extent-property extent 'pui t) @@ -474,10 +584,15 @@ (delete-other-windows) (goto-char start) (setq pui-selected-packages nil) ; Reset list + (when (featurep 'menubar) + (set-buffer-menubar current-menubar) + (add-submenu '() pui-menu) + (setq mode-popup-menu pui-menu)) (clear-message) ; (message (substitute-command-keys "Press `\\[pui-help]' for help.")) )) + (provide 'package-ui) ;;; package-ui.el ends here