From ec0053be7fda4057dab27cad31284ea3bcabd975 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sun, 4 May 2014 21:28:30 -0500 Subject: [PATCH] document gui-pkg-manager and add pkg-catalog-update-local/simple-status-dialog --- .../gui-pkg-manager-doc/info.rkt | 5 + .../pkg/gui/scribblings/gui-pkg-manager.scrbl | 46 ++++++++ .../gui-pkg-manager-doc/pkg/info.rkt | 4 + .../pkg/{gui/main.rkt => gui.rkt} | 15 ++- .../pkg/gui/{ => private}/by-installed.rkt | 0 .../pkg/gui/{ => private}/by-list.rkt | 0 .../pkg/gui/{ => private}/by-migrate.rkt | 0 .../pkg/gui/{ => private}/by-source.rkt | 0 .../pkg/gui/private/catalog-update.rkt | 103 ++++++++++++++++++ .../pkg/gui/{ => private}/common.rkt | 0 .../pkg/gui/{ => private}/filter-panel.rkt | 0 .../pkg/gui/{ => private}/settings.rkt | 0 .../gui-pkg-manager/info.rkt | 4 +- .../gui-pkg-manager/pkg/gui/start.rkt | 3 +- 14 files changed, 171 insertions(+), 9 deletions(-) create mode 100644 pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-doc/info.rkt create mode 100644 pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-doc/pkg/gui/scribblings/gui-pkg-manager.scrbl create mode 100644 pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-doc/pkg/info.rkt rename pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/{gui/main.rkt => gui.rkt} (93%) rename pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/{ => private}/by-installed.rkt (100%) rename pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/{ => private}/by-list.rkt (100%) rename pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/{ => private}/by-migrate.rkt (100%) rename pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/{ => private}/by-source.rkt (100%) create mode 100644 pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/catalog-update.rkt rename pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/{ => private}/common.rkt (100%) rename pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/{ => private}/filter-panel.rkt (100%) rename pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/{ => private}/settings.rkt (100%) diff --git a/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-doc/info.rkt b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-doc/info.rkt new file mode 100644 index 0000000000..b472b60b8c --- /dev/null +++ b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-doc/info.rkt @@ -0,0 +1,5 @@ +#lang info +(define collection 'multi) +(define deps '("base" "racket-doc" "scribble-lib")) +(define pkg-desc "documentation part of \"gui-pkg-manager\"") +(define pkg-authors '(mflatt robby)) diff --git a/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-doc/pkg/gui/scribblings/gui-pkg-manager.scrbl b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-doc/pkg/gui/scribblings/gui-pkg-manager.scrbl new file mode 100644 index 0000000000..8ca6e3e5d6 --- /dev/null +++ b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-doc/pkg/gui/scribblings/gui-pkg-manager.scrbl @@ -0,0 +1,46 @@ +#lang scribble/manual +@(require scribble/bnf + scribble/core + (for-label pkg racket/base)) + +@title{Package Management GUI Libraries} + +@author[@author+email["Matthew Flatt" "mflatt@racket-lang.org"] + @author+email["Jay McCarthy" "jay@racket-lang.org"] + @author+email["Robert Bruce Findler" "robby@racket-lang.org"]] + +@declare-exporting[pkg/gui] + +The @tt{gui-pkg-manager} provides GUI support for package management. + +@defproc[(make-pkg-gui + [#:wrap-terminal-action wrap-terminal-action (-> (-> any) any) (λ (t) (t))] + [#:initial-tab initial-tab (or/c 'by-source 'installed 'from-list 'migrate) 'by-source]) + (is-a?/c top-level-window<%>)]{ + Opens the package manager GUI starting with the @racket[initial-tab] selected. + + The @racket[wrap-terminal-action] function is passed a thunk that it is expected to + invoke, possibly after redirecting the @racket[current-output-port] and @racket[current-error-port] + to point to an existing GUI window. +} + +@defproc[(make-pkg-installer + [#:parent parent (or/c #f (is-a?/c top-level-window<%>)) #f] + [#:wrap-terminal-action wrap-terminal-action (-> (-> any) any) (λ (t) (t))] + [#:package-to-offer package-to-offer (or/c #f string?) #f]) + (is-a?/c top-level-window<%>)]{ + + Opens a specialized version of the @racket[make-pkg-gui] window that contains only the + @racket['by-source] panel. + + The @racket[wrap-terminal-action] function is passed a thunk that it is expected to + invoke, possibly after redirecting the @racket[current-output-port] and @racket[current-error-port] + to point to an existing GUI window. +} + +@defproc[(pkg-catalog-update-local/simple-status-dialog + [#:parent parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f) #f]) + void?]{ + Calls @racket[pkg-catalog-update-local] with a simple @racket[dialog%] + that shows which catalog servers are being consulted. +} diff --git a/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-doc/pkg/info.rkt b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-doc/pkg/info.rkt new file mode 100644 index 0000000000..8ebc6f413b --- /dev/null +++ b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-doc/pkg/info.rkt @@ -0,0 +1,4 @@ +#lang info + +(define scribblings + '(("gui/scribblings/gui-pkg-manager.scrbl"))) diff --git a/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/main.rkt b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui.rkt similarity index 93% rename from pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/main.rkt rename to pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui.rkt index b9240f260a..c5e861519c 100644 --- a/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/main.rkt +++ b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui.rkt @@ -3,11 +3,12 @@ racket/gui/base racket/contract/base framework - "by-source.rkt" - "by-list.rkt" - "by-installed.rkt" - "by-migrate.rkt" - "settings.rkt" + "gui/private/by-source.rkt" + "gui/private/by-list.rkt" + "gui/private/by-installed.rkt" + "gui/private/by-migrate.rkt" + "gui/private/settings.rkt" + "gui/private/catalog-update.rkt" mrlib/terminal string-constants) @@ -28,7 +29,9 @@ (-> (-> any) any) #:package-to-offer (or/c #f string?)) - (is-a?/c top-level-window<%>))])) + (is-a?/c top-level-window<%>))] + [pkg-catalog-update-local/simple-status-dialog + (->* () (#:parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f)) void?)])) (define pkg-gui-frame% (class (frame:standard-menus-mixin diff --git a/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/by-installed.rkt b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/by-installed.rkt similarity index 100% rename from pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/by-installed.rkt rename to pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/by-installed.rkt diff --git a/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/by-list.rkt b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/by-list.rkt similarity index 100% rename from pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/by-list.rkt rename to pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/by-list.rkt diff --git a/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/by-migrate.rkt b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/by-migrate.rkt similarity index 100% rename from pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/by-migrate.rkt rename to pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/by-migrate.rkt diff --git a/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/by-source.rkt b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/by-source.rkt similarity index 100% rename from pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/by-source.rkt rename to pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/by-source.rkt diff --git a/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/catalog-update.rkt b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/catalog-update.rkt new file mode 100644 index 0000000000..fbf6416c82 --- /dev/null +++ b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/catalog-update.rkt @@ -0,0 +1,103 @@ +#lang racket/base +(require racket/gui/base + racket/class + racket/contract + string-constants + pkg/lib + (prefix-in db: pkg/db)) +(provide + pkg-catalog-update-local/simple-status-dialog) + +(define (pkg-catalog-update-local/simple-status-dialog #:parent [parent #f]) + (define error-message-shown? #f) + (define d% + (class dialog% + (define/override (on-subwindow-event w e) + (if (and error-message-shown? (send e button-down?)) + (if (is-a? w button%) + #f + (if (or (is-a? w message%) + (and + (is-a? w editor-canvas%) + (let-values ([(w h) (send w get-client-size)]) + (< (send e get-x) w)))) + (begin + (send w popup-menu + (let ([m (make-object popup-menu%)]) + (make-object menu-item% + "Copy Message" + m + (lambda (i e) + (send the-clipboard + set-clipboard-string + (send err-msg-txt get-text 0 (send err-msg-txt last-position)) + (send e get-time-stamp)))) + m) + (send e get-x) + (send e get-y)) + #t) + #f)) + #f)) + (super-new))) + (define d (new d% + [width 600] + [parent parent] + [label (string-constant update-catalog)])) + (define m (new message% + [parent d] + [label ""] + [stretchable-width #t])) + + (define err-msg-txt (new text%)) + (define (show-exn exn) + (set! error-message-shown? #t) + (send d begin-container-sequence) + (parameterize ([current-output-port (open-output-text-editor err-msg-txt)]) + (display (exn-message exn)) + (define context (continuation-mark-set->context + (exn-continuation-marks exn))) + (unless (null? context) + (printf "\n") + (for ([x (in-list context)]) + (printf "\n ~s" x)))) + (define sd (make-object style-delta% 'change-family 'modern)) + (send sd set-delta-foreground "darkred") + (send err-msg-txt change-style sd 0 (send err-msg-txt last-position)) + (send err-msg-txt lock #t) + (send err-msg-txt hide-caret #t) + (define ec (new editor-canvas% + [parent d] + [min-height 400] + [editor err-msg-txt])) + (define bp (new horizontal-panel% + [parent d] + [stretchable-height #f] + [alignment '(right center)])) + (define b (new button% + [label (string-constant ok)] + [parent bp] + [callback + (λ (_1 _2) (send d show #f))])) + (send d end-container-sequence)) + + (thread + (λ () + (with-handlers ([exn:fail? + (λ (exn) + (queue-callback + (λ () + (show-exn exn))))]) + (for ([catalog (in-list (db:get-catalogs))]) + (define s (make-semaphore 0)) + (queue-callback + (λ () + (send m set-label (format (string-constant updating-catalog-from) catalog)) + (semaphore-post s))) + (semaphore-wait s) + (pkg-catalog-update-local #:catalogs (list catalog) + #:set-catalogs? #f + #:quiet? #t)) + (queue-callback + (λ () (send d show #f)))))) + + (send d show #t)) diff --git a/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/common.rkt b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/common.rkt similarity index 100% rename from pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/common.rkt rename to pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/common.rkt diff --git a/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/filter-panel.rkt b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/filter-panel.rkt similarity index 100% rename from pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/filter-panel.rkt rename to pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/filter-panel.rkt diff --git a/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/settings.rkt b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/settings.rkt similarity index 100% rename from pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/settings.rkt rename to pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/settings.rkt diff --git a/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager/info.rkt b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager/info.rkt index 7f71a423a9..18d3a60ffb 100644 --- a/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager/info.rkt +++ b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager/info.rkt @@ -3,10 +3,12 @@ (define collection 'multi) (define deps '("gui-pkg-manager-lib" + "gui-pkg-manager-doc" "gui-lib" "base")) -(define implies '("gui-pkg-manager-lib")) +(define implies '("gui-pkg-manager-lib" + "gui-pkg-manager-doc")) (define pkg-desc "Graphical tool for managing Racket package installations") diff --git a/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager/pkg/gui/start.rkt b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager/pkg/gui/start.rkt index 19511bd5b5..a4562cd760 100644 --- a/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager/pkg/gui/start.rkt +++ b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager/pkg/gui/start.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require pkg/gui/main) +(require pkg/gui) (void (make-pkg-gui)) @@ -9,4 +9,3 @@ (module+ test (require racket/gui/base) (queue-callback (lambda () (exit)) #f)) -