Use utf-8-mcs-er instead of utf-8-mcs.

[chise/xemacs-chise.git.1] / lisp / package-ui.el

diff --git a/lisp/package-ui.el b/lisp/package-ui.el
index 4f948c7..c0b93ad 100644 (file)
--- a/lisp/package-ui.el
+++ b/lisp/package-ui.el
@@ -31,7 +31,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defgroup pui nil
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defgroup pui nil

-  "Conventient interface to the package system."
+  "Convenient interface to the package system."

   :group 'package-tools
   :tag "Package User interface"
   :prefix "pui-")
   :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)
 (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
     ))
 
     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))
              (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)
     ))
            (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
       (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
                                   :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)))
        (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)
        (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
          ;; 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? "))
            (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)))
                                (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)
                      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!")))
       (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 ()
     ))
 
 (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)."
   "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))
            )
     (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)
                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)
          (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
          (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!")))
       )))
 
          (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) "..."))]
 (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]))
 
     ["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:
 
 (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))
 "))
     (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)
     (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)
       (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
     ))
 
 ;;;###autoload