X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fpackage-ui.el;h=f8ed19a36877a28e5e802b52f46a603f66231b1b;hb=59483252003895f7e52f747b322c84073c676922;hp=3e49ae31d64c5b3a5274333b496d060c7a8fa57b;hpb=fc475e6669a613cd6d98eb5511c749a23b63c7ac;p=chise%2Fxemacs-chise.git.1 diff --git a/lisp/package-ui.el b/lisp/package-ui.el index 3e49ae3..f8ed19a 100644 --- a/lisp/package-ui.el +++ b/lisp/package-ui.el @@ -31,7 +31,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defgroup pui nil - "Conventient interface to the package system." + "Convenient interface to the package system." :group 'package-tools :tag "Package User interface" :prefix "pui-") @@ -62,6 +62,12 @@ Set this to `nil' to use the `default' face." :group 'pui :type 'face) +(defcustom pui-deleted-package-face 'blue + "*The face to use for packages marked for removal. +Set this to `nil' to use the `default' face." + :group 'pui + :type 'face) + (defcustom pui-outdated-package-face 'red "*The face to use for outdated packages. Set this to `nil' to use the `default' face." @@ -74,11 +80,10 @@ 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.") +(defcustom pui-info-buffer "*Packages*" + "*Buffer to use for displaying package information." + :group 'pui + :type 'string) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; End of user-changeable variables. @@ -87,24 +92,32 @@ Set this to `nil' to use the `default' face." (defvar pui-selected-packages nil "The list of user-selected packages to install.") +(defvar pui-deleted-packages nil + "The list of user-selected packages to remove.") + +(defvar pui-actual-package "") + (defvar pui-display-keymap (let ((m (make-keymap))) (suppress-keymap m) (set-keymap-name m 'pui-display-keymap) (define-key m "q" 'pui-quit) (define-key m "g" 'pui-list-packages) - (define-key m " " 'pui-display-info) - (define-key m "?" 'pui-help) + (define-key m "i" 'pui-display-info) + (define-key m "m" 'pui-display-maintainer) + (define-key m "?" 'describe-mode) (define-key m "v" 'pui-toggle-verbosity-redisplay) - (define-key m "d" 'pui-toggle-verbosity-redisplay) + (define-key m "d" 'pui-toggle-package-delete-key) + (define-key m "D" 'pui-toggle-package-delete-key) (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 "+" 'pui-toggle-package-key) (define-key m "p" 'previous-line) - (define-key m "-" 'previous-line) + (define-key m " " 'scroll-up-command) + (define-key m [delete] 'scroll-down-command) m) "Keymap to use in the `pui-info-buffer' buffer") @@ -113,7 +126,7 @@ Set this to `nil' to use the `default' face." (set-keymap-name m 'pui-package-keymap) (define-key m 'button2 'pui-toggle-package-event) ;; We use a popup menu -;; (define-key m 'button3 'pui-toggle-package-event) + (define-key m 'button3 'pui-popup-context-sensitive) m) "Keymap to use over package names/descriptions.") @@ -124,72 +137,77 @@ Set this to `nil' to use the `default' face." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Configuration routines -(defun pui-directory-exists (dir) - "Check to see if DIR exists in `package-get-remote'." - (let (found) - (mapcar '(lambda (item) - (if (and (null (car item)) - (string-equal (file-name-as-directory (car (cdr item))) - (file-name-as-directory dir))) - (setq found t)) - ) package-get-remote) - found - )) - -(defun pui-package-dir-list (buffer) - "In BUFFER, format the list of package binary paths." - (let ( (count 1) paths sys dir) - (set-buffer buffer) - (buffer-disable-undo buffer) - (erase-buffer buffer) - (insert "Existing package binary paths:\n\n") - (setq paths package-get-remote) - (while paths - (setq sys (car (car paths)) - dir (car (cdr (car paths)))) - (insert (format "%2s. " count)) - (if (null sys) - (insert dir) - (insert sys ":" dir)) - (insert "\n") - (setq count (1+ count)) - (setq paths (cdr paths)) - ) - (insert "\nThese are the places that will be searched for package binaries.\n") - (goto-char (point-min)) - )) +;;;###autoload +(defun package-ui-add-site (site) + "Add site to package-get-remote and possibly offer to update package list." + (let ((had-none (null package-get-remote))) + (setq package-get-remote site) + (when (and had-none package-get-was-current + (y-or-n-p "Update Package list?")) + (setq package-get-was-current nil) + (package-get-require-base t) + (if (get-buffer pui-info-buffer) + (save-window-excursion + (pui-list-packages)))) + (set-menubar-dirty-flag))) ;;;###autoload -(defun pui-add-install-directory (dir) - "Add a new package binary directory to the head of `package-get-remote'. +(defun package-ui-download-menu () + "Build the `Add Download Site' menu." + (mapcar (lambda (site) + (vector (car site) + `(if (equal package-get-remote (quote ,(cdr site))) + (setq package-get-remote nil) + (package-ui-add-site (quote ,(cdr site)))) + ;; I've used radio buttons so that only a single + ;; site can be selected, but they are in fact + ;; toggles. SY. + :style 'radio + :selected `(equal package-get-remote (quote ,(cdr site))))) + package-get-download-sites)) + +;;;###autoload +(defun package-ui-pre-release-download-menu () + "Build the 'Pre-Release Download Sites' menu." + (mapcar (lambda (site) + (vector (car site) + `(if (equal package-get-remote (quote ,(cdr site))) + (setq package-get-remote nil) + (package-ui-add-site (quote ,(cdr site)))) + ;; I've used radio buttons so that only a single + ;; site can be selected, but they are in fact + ;; toggles. SY. + :style 'radio + :selected `(equal package-get-remote (quote ,(cdr site))))) + package-get-pre-release-download-sites)) + +;;;###autoload +(defun package-ui-site-release-download-menu () + "Build the 'Site Release Download Sites' menu." + (mapcar (lambda (site) + (vector (car site) + `(if (equal package-get-remote (quote ,(cdr site))) + (setq package-get-remote nil) + (package-ui-add-site (quote ,(cdr site)))) + ;; I've used radio buttons so that only a single + ;; site can be selected, but they are in fact + ;; toggles. SY. + :style 'radio + :selected `(equal package-get-remote (quote ,(cdr site))))) + package-get-site-release-download-sites)) + +;;;###autoload +(defun pui-set-local-package-get-directory () + "Set a new package binary directory in `package-get-remote'. Note that no provision is made for saving any changes made by this function. It exists mainly as a convenience for one-time package installations from disk." - (interactive (let ( (tmpbuf (get-buffer-create - "*Existing Package Binary Paths*")) - dir) - (save-window-excursion - (save-excursion - (unwind-protect - (progn - (pui-package-dir-list tmpbuf) - (display-buffer tmpbuf) - (setq dir (read-directory-name - "New package binary directory to add? " - nil nil t)) - ) - (kill-buffer tmpbuf) - ))) - (list dir) - )) - (progn - (if (not (pui-directory-exists dir)) - (progn - (setq package-get-remote (cons (list nil dir) package-get-remote)) - (message "Package directory \"%s\" added." dir) - ) - (message "Directory \"%s\" already exists in `package-get-remote'." dir)) - )) + (interactive) + (let ((dir (read-directory-name + "New package binary directory to add? " + nil nil t))) + (setq package-get-remote (list nil dir)) + (message "Package directory \"%s\" added." dir))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Package list/installer routines @@ -198,18 +216,6 @@ disk." (interactive) (kill-buffer nil)) -(defun pui-help () - (interactive) - (let ( (help-buffer (get-buffer-create "*Help*")) ) - (display-buffer help-buffer t) - (save-window-excursion - (set-buffer help-buffer) - (buffer-disable-undo help-buffer) - (erase-buffer help-buffer) - (insert (pui-help-string)) - ) - )) - (defun pui-package-symbol-char (pkg-sym version) (progn (if (package-get-info-find-package packages-package-list pkg-sym) @@ -222,8 +228,7 @@ disk." version)) (list " " pui-up-to-date-package-face) (list "*" pui-outdated-package-face))) - (list "-" pui-uninstalled-package-face)) - )) + (list "-" pui-uninstalled-package-face)))) (defun pui-update-package-display (extent &optional pkg-sym version) "Update the package status for EXTENT. @@ -236,27 +241,27 @@ and whether or not it is up-to-date." (if (not version) (setq version (package-get-info-prop (extent-property extent 'pui-info) 'version))) - (if (member pkg-sym pui-selected-packages) - (progn - (if pui-selected-package-face - (set-extent-face extent (get-face pui-selected-package-face)) - (set-extent-face extent (get-face 'default))) - (setq sym-char "+") - ) - (progn - (setq disp (pui-package-symbol-char pkg-sym version)) - (setq sym-char (car disp)) - (if (car (cdr disp)) - (set-extent-face extent (get-face (car (cdr disp)))) - (set-extent-face extent (get-face 'default))) - )) + (cond ((member pkg-sym pui-selected-packages) + (if pui-selected-package-face + (set-extent-face extent (get-face pui-selected-package-face)) + (set-extent-face extent (get-face 'default))) + (setq sym-char "+")) + ((member pkg-sym pui-deleted-packages) + (if pui-deleted-package-face + (set-extent-face extent (get-face pui-deleted-package-face)) + (set-extent-face extent (get-face 'default))) + (setq sym-char "D")) + (t + (setq disp (pui-package-symbol-char pkg-sym version)) + (setq sym-char (car disp)) + (if (car (cdr disp)) + (set-extent-face extent (get-face (car (cdr disp)))) + (set-extent-face extent (get-face 'default))))) (save-excursion (goto-char (extent-start-position extent)) (delete-char 1) (insert sym-char) - (set-buffer-modified-p nil) - ) - )) + (set-buffer-modified-p nil)))) (defun pui-toggle-package (extent) (let (pkg-sym) @@ -265,9 +270,10 @@ and whether or not it is up-to-date." (setq pui-selected-packages (delete pkg-sym pui-selected-packages)) (setq pui-selected-packages - (cons pkg-sym pui-selected-packages))) - (pui-update-package-display extent pkg-sym) - )) + (cons pkg-sym pui-selected-packages)) + (setq pui-deleted-packages + (delete pkg-sym pui-deleted-packages))) + (pui-update-package-display extent pkg-sym))) (defun pui-toggle-package-key () "Select/unselect package for installation, using the keyboard." @@ -276,33 +282,82 @@ and whether or not it is up-to-date." (if (setq extent (extent-at (point) (current-buffer) 'pui)) (progn (pui-toggle-package extent) - (forward-line 1) - ) - (error "No package under cursor!")) - )) + (forward-line 1)) + (error 'invalid-operation + "No package under cursor!")))) + +(defun pui-toggle-package-delete (extent) + (let (pkg-sym) + (setq pkg-sym (extent-property extent 'pui-package)) + (if (member pkg-sym pui-deleted-packages) + (setq pui-deleted-packages + (delete pkg-sym pui-deleted-packages)) + (setq pui-deleted-packages + (cons pkg-sym pui-deleted-packages)) + (setq pui-selected-packages + (delete pkg-sym pui-selected-packages))) + (pui-update-package-display extent pkg-sym))) + + +(defun pui-toggle-package-delete-key () + "Select/unselect package for removal, using the keyboard." + (interactive) + (let (extent) + (if (setq extent (extent-at (point) (current-buffer) 'pui)) + (progn + (pui-toggle-package-delete extent) + (forward-line 1)) + (error 'invalid-operation + "No package under cursor!")))) + +(defun pui-current-package () + (let ((extent (extent-at (point) (current-buffer) 'pui))) + (if extent + (extent-property extent 'pui-package)))) (defun pui-toggle-package-event (event) "Select/unselect package for installation, using the mouse." (interactive "e") - (let* ( (ep (event-point event)) - (buffer (window-buffer (event-window event))) - (extent (extent-at ep buffer 'pui-package)) - ) - (pui-toggle-package extent) - )) + (let* ((ep (event-point event)) + (buffer (window-buffer (event-window event))) + (extent (extent-at ep buffer 'pui-package))) + (pui-toggle-package extent))) (defun pui-toggle-verbosity-redisplay () "Toggle verbose package info." (interactive) (progn (setq pui-list-verbose (not pui-list-verbose)) - (pui-list-packages) - )) + (pui-list-packages))) (defun pui-install-selected-packages () "Install selected packages." (interactive) - (let ( (tmpbuf "*Packages-To-Install*") do-install) + (let ((tmpbuf "*Packages-To-Remove*") + do-delete) + (when pui-deleted-packages + (save-window-excursion + (with-output-to-temp-buffer tmpbuf + (display-completion-list (sort + (mapcar #'symbol-name pui-deleted-packages) + #'string<) + :activate-callback nil + :help-string "Packages selected for removal:\n" + :completion-string t)) + (setq tmpbuf (get-buffer-create tmpbuf)) + (display-buffer tmpbuf) + (setq do-delete (yes-or-no-p "Remove these packages? ")) + (kill-buffer tmpbuf)) + (when do-delete + (message "Deleting selected packages ...") (sit-for 0) + (mapcar (lambda (pkg) + (package-admin-delete-binary-package + pkg (package-admin-get-install-dir pkg))) + (nreverse pui-deleted-packages)) + (message "Packages deleted")))) + + (let ((tmpbuf "*Packages-To-Install*") + do-install) (if pui-selected-packages (progn ;; Don't change window config when asking the user if he really @@ -312,47 +367,40 @@ and whether or not it is up-to-date." ;; 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) - ) - pui-selected-packages) - 'string<) - :activate-callback nil - :help-string "Packages selected for installation:\n" - :completion-string t - )) + (display-completion-list + (sort (mapcar #'symbol-name pui-selected-packages) #'string<) + :activate-callback nil + :help-string "Packages selected for installation:\n" + :completion-string t)) (setq tmpbuf (get-buffer-create tmpbuf)) (display-buffer tmpbuf) (setq do-install (y-or-n-p "Install these packages? ")) - (kill-buffer tmpbuf) - ) + (kill-buffer tmpbuf)) (if do-install (progn (save-excursion ;; Clear old temp buffer history (set-buffer (get-buffer-create package-admin-temp-buffer)) (buffer-disable-undo package-admin-temp-buffer) - (erase-buffer package-admin-temp-buffer) - ) + (erase-buffer package-admin-temp-buffer)) (message "Installing selected packages ...") (sit-for 0) (if (catch 'done (mapcar (lambda (pkg) (if (not (package-get pkg nil nil pui-package-install-dest-dir)) (throw 'done nil))) - pui-selected-packages) + (nreverse pui-selected-packages)) t) (progn (pui-list-packages) - (message "Packages installed") - )) - ) - (clear-message) - ) - ) - (error "No packages have been selected!")) - )) + (message "Packages installed")))) + (clear-message))) + (if pui-deleted-packages + (pui-list-packages) + (error 'invalid-operation + "No packages have been selected!"))) + ;; sync with windows type systems + (package-net-update-installed-db))) (defun pui-add-required-packages () "Select packages required by those already selected for installation." @@ -370,12 +418,13 @@ and whether or not it is up-to-date." (package-get-info-find-package package-get-base pkg) nil) 'version))) - (if (< (if (stringp installed) + (if (or (null installed) + (< (if (stringp installed) (string-to-number installed) installed) (if (stringp current) (string-to-number current) - current)) + current))) pkg nil))) (package-get-dependencies pui-selected-packages))))) @@ -407,86 +456,125 @@ and whether or not it is up-to-date." nil nil nil nil nil 'pui) (message "added dependencies")) (clear-message))) - (error "No packages have been selected!")))) + (error 'invalid-operation + "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 attached to the extent as properties)." - (let (pkg-sym info inst-ver auth-ver date maintainer) + (let (pkg-sym info inst-ver inst-auth-ver auth-ver date maintainer balloon req) (if (or force-update (not (current-message)) - (string-match ".*: .*: " (current-message)) - ) + (string-match ".*: .*: " (current-message))) (progn (setq pkg-sym (extent-property extent 'pui-package) info (extent-property extent 'pui-info) inst-ver (package-get-key pkg-sym :version) + inst-auth-ver (package-get-key pkg-sym :author-version) auth-ver (package-get-info-prop info 'author-version) date (package-get-info-prop info 'date) - maintainer (package-get-info-prop info 'maintainer)) + maintainer (package-get-info-prop info 'maintainer) + req (package-get-info-prop info 'requires)) (if (not inst-ver) - (setq inst-ver "")) - (if pui-list-verbose - (format "Author version: %-8s %11s: %s" - auth-ver date maintainer) - (format "%-6s: %-8s %11s: %s" - inst-ver auth-ver date maintainer)) - )) - )) - -(defun pui-display-info (&optional no-error) + (setq inst-ver 0)) + (if (featurep 'balloon-help) + (progn + (setq balloon (format " +Package Information: [For package: \"%s\"]\n================ +Installed Upstream Ver: %s Available Upstream Ver: %s +Maintainer : %s +Released : %s +Required Packages : %s\n\n" + pkg-sym inst-auth-ver auth-ver maintainer + date req)) + (set-extent-property extent 'balloon-help balloon))) + (format + "Installed upstream ver: %s Available upstream ver: %s" + inst-auth-ver auth-ver))))) + +(defun pui-display-info (&optional no-error event) "Display additional package info in the modeline. Designed to be called interactively (from a keypress)." (interactive) (let (extent) (save-excursion (beginning-of-line) - (if (setq extent (extent-at (point) (current-buffer) 'pui)) + (if (setq extent (extent-at (point) (current-buffer) 'pui)) (message (pui-help-echo extent t)) (if no-error (clear-message nil) - (error "No package under cursor!"))) - ))) + (error 'invalid-operation + "No package under cursor!")))))) + +(defun pui-display-maintainer (&optional no-error event) + "Display a package's maintainer in the minibuffer." + (interactive) + (let (extent ;pkg-sym + info maintainer) + (save-excursion + (beginning-of-line) + (if (setq extent (extent-at (point) (current-buffer) 'pui)) + (progn + (setq ;pkg-sym (extent-property extent 'pui-package) + info (extent-property extent 'pui-info) + maintainer (package-get-info-prop info 'maintainer)) + (message (format "Maintainer: %s" maintainer))) + (if no-error + (clear-message nil) + (error 'invalid-operation + "No package under cursor!")))))) + +(defvar pui-menu + '("Packages" + ["Toggle install " pui-toggle-package-key :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))] + ["Toggle delete " pui-toggle-package-delete-key :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))] + ["Info on" pui-display-info :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))] + "---" + ["Add Required" pui-add-required-packages t] + ["Install/Remove 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])) -(defun pui-help-string () - "Return the help string for the package-info buffer. -This is not a defconst because of the call to substitute-command-keys." +;;; "Why is there no standard function to do this?" +(defun pui-popup-context-sensitive (event) + (interactive "e") (save-excursion - (set-buffer (get-buffer pui-info-buffer)) - (substitute-command-keys -"Symbols in the leftmost column: + (set-buffer (event-buffer event)) + (goto-char (event-point event)) + (popup-menu pui-menu event) + ;; I agree with dired.el - this is seriously bogus. + (while (popup-up-p) + (dispatch-event (next-event))))) + +(defun list-packages-mode () + "Symbols in the leftmost column: + The package is marked for installation. - The package has not been installed. + D The package has been marked for deletion. * The currently installed package is old, and a newer version is available. Useful keys: `\\[pui-toggle-package-key]' to select/unselect the current package for installation. + `\\[pui-toggle-package-delete-key]' to select/unselect the current package for removal. `\\[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-install-selected-packages]' to install/delete selected packages. + `\\[pui-display-info]' to display additional information about the package in the minibuffer. + `\\[pui-display-maintainer]' to display the package's maintainer in the minibuffer `\\[pui-list-packages]' to refresh the package list. `\\[pui-toggle-verbosity-redisplay]' to toggle between a verbose and non-verbose display. `\\[pui-quit]' to kill this buffer. -") - )) - -(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])) +" + (error 'invalid-operation + "You cannot enter this mode directly. Use `pui-list-packages'")) +(put 'list-packages-mode 'mode-class 'special) ;;;###autoload (defun pui-list-packages () @@ -497,101 +585,106 @@ 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 ) + (let ((outbuf (get-buffer-create pui-info-buffer)) + (sep-string "===============================================================================\n") + start) (message "Creating package list ...") (sit-for 0) (set-buffer outbuf) (setq buffer-read-only nil) (buffer-disable-undo outbuf) (erase-buffer outbuf) + (kill-all-local-variables) (use-local-map pui-display-keymap) + (setq major-mode 'list-packages-mode) + (setq mode-name "Packages") + (setq truncate-lines t) + + (unless package-get-remote + (insert " +Warning: No download sites specified. Package index may be out of date. + If you intend to install packages, specify download sites first. + +")) + (if pui-list-verbose - (insert " Latest Installed - Package name Vers. Vers. Description + (insert " Latest Installed + Package name Vers. Vers. Description ") - (insert " Latest - Package name Vers. Description + (insert " Latest + Package name Vers. Description ")) (insert sep-string) (setq start (point)) - (mapcar '(lambda (pkg) - (let (pkg-sym info version desc - b e extent current-vers disp) - (setq pkg-sym (car pkg) - info (package-get-info-version (cdr pkg) nil)) - (setq version (package-get-info-prop info 'version) - desc (package-get-info-prop info 'description)) - - (setq disp (pui-package-symbol-char pkg-sym - version)) - (setq b (point)) - (if pui-list-verbose - (progn - (setq current-vers (package-get-key pkg-sym :version)) - (cond - ( (not current-vers) - (setq current-vers "-----") ) - ( (stringp current-vers) - (setq current-vers - (format "%.2f" - (string-to-number current-vers))) ) - ( (numberp current-vers) - (setq current-vers (format "%.2f" current-vers)) ) - ) - (insert - (format "%s %-15s %-5.2f %-5s %s\n" - (car disp) pkg-sym - (if (stringp version) - (string-to-number version) - version) - current-vers desc)) -;; (insert -;; (format "\t\t %-12s %s\n" -;; (package-get-info-prop info 'author-version) -;; (package-get-info-prop info 'date) -;; )) - ) - (insert (format "%s %-15s %-5s %s\n" - (car disp) - pkg-sym version desc))) - (save-excursion - (setq e (progn - (forward-line -1) - (end-of-line) - (point))) - ) - (setq extent (make-extent b e)) - (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) - (set-extent-property extent 'pui-package pkg-sym) - (set-extent-property extent 'pui-info info) - (set-extent-property extent 'help-echo 'pui-help-echo) - (set-extent-property extent 'keymap pui-package-keymap) - )) (sort (copy-sequence package-get-base) - '(lambda (a b) - (string< (symbol-name (car a)) - (symbol-name (car b))) - ))) + (mapcar + #'(lambda (pkg) + (let (pkg-sym info version desc + b e extent current-vers disp) + (setq pkg-sym (car pkg) + info (package-get-info-version (cdr pkg) nil)) + (setq version (package-get-info-prop info 'version) + desc (package-get-info-prop info 'description)) + + (setq disp (pui-package-symbol-char pkg-sym + version)) + (setq b (point)) + (if pui-list-verbose + (progn + (setq current-vers (package-get-key pkg-sym :version)) + (cond + ((not current-vers) + (setq current-vers "-----")) + ((stringp current-vers) + (setq current-vers + (format "%.2f" + (string-to-number current-vers)))) + ((numberp current-vers) + (setq current-vers (format "%.2f" current-vers)))) + (insert + (format "%s %-20s %-5.2f %-5s %s\n" + (car disp) pkg-sym + (if (stringp version) + (string-to-number version) + version) + current-vers desc))) + (insert (format "%s %-20s %-5s %s\n" + (car disp) + pkg-sym version desc))) + (save-excursion + (setq e (progn + (forward-line -1) + (end-of-line) + (point)))) + (setq extent (make-extent b e)) + (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) + (set-extent-property extent 'pui-package pkg-sym) + (set-extent-property extent 'pui-info info) + (set-extent-property extent 'help-echo 'pui-help-echo) + (set-extent-property extent 'keymap pui-package-keymap))) + (sort (copy-sequence package-get-base) + #'(lambda (a b) + (string< (symbol-name (car a)) + (symbol-name (car b)))))) (insert sep-string) - (insert (pui-help-string)) + (insert (documentation 'list-packages-mode)) (set-buffer-modified-p nil) (setq buffer-read-only t) (pop-to-buffer outbuf) (delete-other-windows) (goto-char start) (setq pui-selected-packages nil) ; Reset list + (setq pui-deleted-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.")) - )) + (clear-message))) +;;;###autoload +(defalias 'list-packages 'pui-list-packages) (provide 'package-ui)