adjust the installation package GUI so it doesn't install during

and installation (ditto update)

closes PR 14263

this may be a release branch candidate. I'm not sure myself, but the PR
sounds worrying.

If it should be considered, then this is the relevant diff (since more than
half of the diff is whitespace changes) to the file pkg/gui/main:

@@ -57,6 +57,8 @@

   (define terminal #f)
   (define (in-terminal-panel abort-label thunk)
+    (cond
+      [(or (not terminal) (send terminal can-close?))
     (send dlg begin-container-sequence)
     (when terminal (send terminal close))
     (define t (in-terminal
@@ -71,7 +73,10 @@
     (disallow-close)
     (send dlg end-container-sequence)
     (yield (send t can-close-evt))
-    (allow-close))
+       (allow-close)]
+      [else
+       (message-box (string-constant install-pkg-dialog-title)
+                    (string-constant install-pkg-not-rentrant))]))
This commit is contained in:
Robby Findler 2013-12-28 20:48:52 -06:00
parent 92872addf2
commit 5059db47d3
2 changed files with 23 additions and 15 deletions

View File

@ -57,21 +57,26 @@
(define terminal #f)
(define (in-terminal-panel abort-label thunk)
(send dlg begin-container-sequence)
(when terminal (send terminal close))
(define t (in-terminal
#:abort-label abort-label
#:canvas-min-height 200
#:container dlg
#:close-button? #f
(λ (cust parent) (wrap-terminal-action thunk))))
(move-close-button (send t get-button-panel))
(send dlg reflow-container)
(set! terminal t)
(disallow-close)
(send dlg end-container-sequence)
(yield (send t can-close-evt))
(allow-close))
(cond
[(or (not terminal) (send terminal can-close?))
(send dlg begin-container-sequence)
(when terminal (send terminal close))
(define t (in-terminal
#:abort-label abort-label
#:canvas-min-height 200
#:container dlg
#:close-button? #f
(λ (cust parent) (wrap-terminal-action thunk))))
(move-close-button (send t get-button-panel))
(send dlg reflow-container)
(set! terminal t)
(disallow-close)
(send dlg end-container-sequence)
(yield (send t can-close-evt))
(allow-close)]
[else
(message-box (string-constant install-pkg-dialog-title)
(string-constant install-pkg-not-rentrant))]))
(define (disallow-close)
(set! allow-close? #f)

View File

@ -1889,6 +1889,9 @@ please adhere to these guidelines:
(install-pkg-package-catalogs "Package Catalogs") ; label for a list box
(install-pkg-add-package-catalog "Add Package Catalog")
(install-pkg-not-rentrant "Installation and updating cannot happen simultaneously;"
" either abort the current one or wait for it to finish.")
;; open a file via a collection path (new "Open" menu item in DrRacket)
(open-collection-path "Open Collection Path...")
(enter-subcollection "Enter subcollection") ; button in new dialog