X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fpackage-ui.el;h=c0b93ad4ce43597ba6c8ac516b2ea5a9a7139554;hp=f471ae0db715dfbb3b1ebbfe6178d0c3e15c2764;hb=5378ab6d2bb24fd8d39025be1574d406cf91f141;hpb=716cfba952c1dc0d2cf5c968971f3780ba728a89 diff --git a/lisp/package-ui.el b/lisp/package-ui.el index f471ae0..c0b93ad 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-") @@ -140,12 +140,12 @@ Set this to `nil' to use the `default' face." (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) + (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 )) @@ -309,7 +309,7 @@ and whether or not it is up-to-date." (delete pkg-sym pui-deleted-packages)) (setq pui-deleted-packages (cons pkg-sym pui-deleted-packages)) - (setq pui-seleted-packages + (setq pui-selected-packages (delete pkg-sym pui-selected-packages))) (pui-update-package-display extent pkg-sym) )) @@ -358,11 +358,8 @@ and whether or not it is up-to-date." (save-window-excursion (with-output-to-temp-buffer tmpbuf (display-completion-list (sort - (mapcar '(lambda (pkg) - (symbol-name pkg) - ) - pui-deleted-packages) - 'string<) + (mapcar #'symbol-name pui-deleted-packages) + #'string<) :activate-callback nil :help-string "Packages selected for removal:\n" :completion-string t @@ -376,7 +373,7 @@ and whether or not it is up-to-date." (mapcar (lambda (pkg) (package-admin-delete-binary-package pkg (package-admin-get-install-dir pkg nil))) - pui-deleted-packages) + (nreverse pui-deleted-packages)) (message "Packages deleted")))) (let ( (tmpbuf "*Packages-To-Install*") do-install) @@ -389,16 +386,12 @@ 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? ")) @@ -418,7 +411,7 @@ and whether or not it is up-to-date." (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) @@ -431,6 +424,8 @@ and whether or not it is up-to-date." (if pui-deleted-packages (pui-list-packages) (error "No packages have been selected!"))) + ;; sync with windows type systems + (package-net-update-installed-db) )) (defun pui-add-required-packages () @@ -493,7 +488,7 @@ and whether or not it is up-to-date." "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 auth-ver date maintainer balloon req) (if (or force-update (not (current-message)) (string-match ".*: .*: " (current-message)) ) @@ -503,14 +498,29 @@ attached to the extent as properties)." inst-ver (package-get-key pkg-sym :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 "")) + (setq inst-ver 0)) + (if (featurep 'balloon-help) + (progn + (setq balloon (format " +Package Information: [For package: \"%s\"] +================ +Installed Version : %.2f +Author Version : %s +Maintainer: %s +Released: %s +Required Packages : %s\n\n" + pkg-sym inst-ver auth-ver maintainer + date req)) + (set-extent-property extent 'balloon-help balloon))) (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)) + (format + "Inst V: %.2f Auth V: %s Maint: %s" + inst-ver auth-ver maintainer) + (format "%.2f : %s : %s" + inst-ver auth-ver maintainer)) )) )) @@ -528,17 +538,6 @@ Designed to be called interactively (from a keypress)." (error "No package under cursor!"))) ))) -;;; "Why is there no standard function to do this?" -(defun pui-popup-context-sensitive (event) - (interactive "e") - (save-excursion - (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-menu-up-p) - (dispatch-event (next-event))))) - (defvar pui-menu '("Packages" ["Toggle install " pui-toggle-package-key :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))] @@ -554,6 +553,16 @@ Designed to be called interactively (from a keypress)." ["Help" pui-help t] ["Quit" pui-quit t])) +;;; "Why is there no standard function to do this?" +(defun pui-popup-context-sensitive (event) + (interactive "e") + (save-excursion + (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: @@ -618,67 +627,66 @@ Warning: No download sites specified. Package index may be out of date. ")) (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 %-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)))))) (insert sep-string) (insert (documentation 'list-packages-mode)) (set-buffer-modified-p nil) @@ -693,7 +701,7 @@ Warning: No download sites specified. Package index may be out of date. (add-submenu '() pui-menu) (setq mode-popup-menu pui-menu)) (clear-message) -; (message (substitute-command-keys "Press `\\[pui-help]' for help.")) + ;; (message (substitute-command-keys "Press `\\[pui-help]' for help.")) )) ;;;###autoload