add migration panel to GUI package manager

Also add "gui-pkg-manager" packages, including a "Racket Package Manager"
GUI application (that needs a better icon).

The package that supplies "Racket Package Manager" is not in the main
distribution, since DrRacket already includes the GUI package manager.

pkgs/drracket-pkgs/drracket/info.rkt

@@ -34,7 +34,8 @@
 	       "net-lib"
                "srfi-lib"
                "srfi-doc"
-               "unstable"))
+               "unstable"
+               "gui-pkg-manager-lib"))
 (define build-deps '("compatibility-doc"
                      "draw-doc"
                      "errortrace-doc"

pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/info.rkt

@@ -0,0 +1,7 @@
+#lang info
+
+(define collection 'multi)
+
+(define deps '("base"
+               "gui-lib"
+               "string-constants-lib"))

pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/by-migrate.rkt

@@ -0,0 +1,90 @@
+#lang racket/base
+
+(require racket/gui/base 
+         racket/class
+         racket/format
+         racket/file
+         string-constants
+         setup/dirs
+         pkg
+         "common.rkt")
+
+(provide by-migrate-panel%)
+
+(define by-migrate-panel%
+  (class vertical-panel%
+    (init-field [in-terminal in-terminal])
+    (super-new)
+    
+    (inherit get-top-level-window)
+
+    (define choices-panel (new horizontal-panel% 
+                               [parent this] 
+                               [alignment '(center top)]))
+    
+    (define versions (new list-box% 
+                          [label (~a (string-constant install-pkg-migrate-available-installations)
+                                     ":")]
+                          [choices null]
+                          [parent choices-panel]
+                          [callback (λ (_1 _2) (adjust-all))]))
+
+    (define button-panel (new vertical-panel% 
+                              [parent choices-panel] 
+                              [stretchable-height #f]
+                              [stretchable-width #f]
+                              [alignment '(center center)]))
+
+    (define migrate-from-button (new button%
+                                     [parent button-panel]
+                                     [label (string-constant install-pkg-migrate-from)]
+                                     [callback (lambda (b e)
+                                                 (in-terminal
+                                                  (string-constant install-pkg-abort-migrate)
+                                                  (lambda ()
+                                                    (pkg-migrate-command
+                                                     (send versions get-string-selection)))))]
+                                     [style '(border)]))
+
+    (define remove-button (new button%
+                               [parent button-panel]
+                               [label (string-constant install-pkg-remove)]
+                               [callback (lambda (b e)
+                                           (remove-package-info
+                                            (send versions get-string-selection)))]))
+
+    (define (remove-package-info vers)
+      (when (= 1 (message-box/custom (format (string-constant install-pkg-packages-for) vers)
+                                     (format
+                                      (string-constant install-pkg-really-remove-installation)
+                                      vers)
+                                     (string-constant install-pkg-remove)
+                                     (string-constant install-pkg-do-not-remove)
+                                     #f
+                                     (get-top-level-window)
+                                     '(caution default=1)))
+        (delete-directory/files (build-path (find-system-path 'addon-dir) vers "pkgs"))
+        (update-list!)
+        (adjust-all)))
+
+    (define (update-list!)
+      (define d (find-system-path 'addon-dir))
+      (define dirs (for/list ([p (in-list (directory-list d))]
+                              #:when (let ([p (build-path d p "pkgs" "pkgs.rktd")])
+                                       (file-exists? p))
+                              #:unless (equal? (path-element->string p)
+                                               (get-installation-name)))
+                     (path-element->string p)))
+      (send versions set dirs))
+
+    (define (adjust-all)
+      (define s (send versions get-selection))
+      (send migrate-from-button enable s)
+      (send remove-button enable s))
+    
+    (define/override (on-superwindow-show on?)
+      (when on?
+        (update-list!)
+        (adjust-all)))
+    
+    (adjust-all)))

pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/main.rkt

@@ -6,6 +6,7 @@
          "by-source.rkt"
          "by-list.rkt"
          "by-installed.rkt"
+         "by-migrate.rkt"
          mrlib/terminal
          string-constants)
 
@@ -16,7 +17,7 @@
         (#:wrap-terminal-action 
          (-> (-> any) any) 
          #:initial-tab 
-         (or/c 'by-source 'from-list 'installed))
+         (or/c 'by-source 'from-list 'installed 'migrate))
         (is-a?/c top-level-window<%>))]
   [make-pkg-installer
    (->* ()
@@ -117,7 +118,8 @@
          [parent (send frame get-area-container)]
          [choices (list (string-constant install-pkg-install-by-source)
                         (string-constant install-pkg-install-from-list)
-                        (string-constant install-pkg-install-installed))]
+                        (string-constant install-pkg-install-installed)
+                        (string-constant install-pkg-migrate-from))]
          [callback (lambda (t e)
                      (update-sel-panel-active))]))
 
@@ -147,12 +149,16 @@
   (new by-installed-panel%
        [parent sel-panel]
        [in-terminal in-terminal-panel])
+  (new by-migrate-panel%
+       [parent sel-panel]
+       [in-terminal in-terminal-panel])
   
   (send sel-tab set-selection
         (case initial-tab
           [(by-source) 0]
           [(from-list) 1]
-          [(installed) 2]))
+          [(installed) 2]
+          [(migrate) 3]))
   (update-sel-panel-active)
   
   (send frame show #t)

pkgs/gui-pkg-manager-pkgs/gui-pkg-manager/info.rkt

@@ -0,0 +1,8 @@
+#lang info
+
+(define collection 'multi)
+
+(define deps '("gui-pkg-manager-lib"
+               "base"))
+
+(define implies '("gui-pkg-manager-lib"))

pkgs/gui-pkg-manager-pkgs/gui-pkg-manager/pkg/gui/info.rkt

@@ -0,0 +1,4 @@
+#lang info
+
+(define gracket-launcher-names '("Racket Package Manager"))
+(define gracket-launcher-libraries '("start.rkt"))

pkgs/gui-pkg-manager-pkgs/gui-pkg-manager/pkg/gui/start.rkt

@@ -0,0 +1,5 @@
+#lang racket/base
+
+(require pkg/gui/main)
+
+(void (make-pkg-gui))

pkgs/plt-services/info.rkt

@@ -11,6 +11,7 @@
                "main-distribution-test"
                "distro-build"
                "honu"
+               "gui-pkg-manager"
                
                ;; Actual dependencies:
                "eli-tester"

pkgs/string-constants-lib/string-constants/private/english-string-constants.rkt

@@ -1785,6 +1785,7 @@ please adhere to these guidelines:
   (install-pkg-install-by-source "Install by Source") ; tab label
   (install-pkg-install-from-list "Install from List") ; tab label
   (install-pkg-install-installed "Installed")         ; tab label
+  (install-pkg-migrate-from "Migrate From")           ; tab label
   (install-pkg-menu-item... "Install Package...")
   (install-pkg-dialog-title "Install Package")
   (install-pkg-source-label "Package Source")
@@ -1796,7 +1797,7 @@ please adhere to these guidelines:
   (install-pkg-file-url "URL File")
   (install-pkg-github "Github")
   (install-pkg-name "Name (consulting resolver)")
-  (install-pkg-inferred-as "Type inferred to be ~a")
+  (install-pkg-inferred-as "Type inferred to be ~a") ; ~a gets install-pkg-{file,dir,...}
   (install-pkg-force? "Overwrite Existing?")
   (install-pkg-command-line "Equivalent command line invocation:")
   (install-pkg-error-installing-title "Error Installing Package")
@@ -1804,6 +1805,7 @@ please adhere to these guidelines:
   (install-pkg-install "Install")
   (install-pkg-update "Update")
   (install-pkg-remove "Remove")
+  (install-pkg-do-not-remove "Don't Remove")
   (install-pkg-action-inferred-to-be-update "Action inferred to be Update")
   (install-pkg-action-inferred-to-be-install "Action inferred to be Install")
   (install-pkg-default "Default")
@@ -1827,8 +1829,14 @@ please adhere to these guidelines:
   (install-pkg-abort-install "Abort Install")
   (install-pkg-abort-update "Abort Update")
   (install-pkg-abort-remove "Abort Remove")
+  (install-pkg-abort-migrate "Abort Migrate")
   (install-pkg-abort-generic-action "Abort Action")
   (install-pkg-show-all-options "Show All Options")
-  (pkg-manager-menu-item "Package Manager...")
+  (install-pkg-migrate-available-installations "Available Installations")
+  (install-pkg-inferred-as "Type inferred to be ~a") ; ~a gets install-pkg-{file,dir,...}
+  (pkg-manager-menu-item "Package Manager...")  
+  ;; where ~a gets an installation name:
+  (install-pkg-packages-for "Packages for ~a")
+  (install-pkg-really-remove-installation "Are you sure you want to remove all installed packages and information for ~a?")
   
   )

racket/collects/pkg/lib.rkt

@@ -1656,13 +1656,16 @@
            (printf "  ~a from ~a\n" n (pkg-desc-source d))]))]))
   (if (null? to-install)
       'skip
-      (pkg-install to-install
-                   #:force? force?
-                   #:ignore-checksums? ignore-checksums?
-                   #:skip-installed? #t
-                   #:dep-behavior (or dep-behavior 'search-auto)
-                   #:quiet? quiet? 
-                   #:strip strip-mode)))
+      (begin0
+       (pkg-install to-install
+                    #:force? force?
+                    #:ignore-checksums? ignore-checksums?
+                    #:skip-installed? #t
+                    #:dep-behavior (or dep-behavior 'search-auto)
+                    #:quiet? quiet? 
+                    #:strip strip-mode)
+       (unless quiet?
+         (printf "Packages migrated\n")))))
 
 (define (pkg-config config:set key+vals)
   (cond