X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fpackage-ui.el;h=1c5bc1353a4dbf09914502c6241ab1a169ca6598;hb=438fba6c3b9dafe9728e1426cd109e3494b081ec;hp=4f948c7dc2ac67811264c7f2f6446a9bf6772518;hpb=d3dd71489ab2730d79536ebdc3c56cca82766e9d;p=chise%2Fxemacs-chise.git- diff --git a/lisp/package-ui.el b/lisp/package-ui.el index 4f948c7..1c5bc13 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 @@ -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? ")) @@ -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 () @@ -528,17 +523,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 agreee 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 +538,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 +612,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 +686,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