diff --git a/pkgs/racket-doc/help/installer.rkt b/pkgs/racket-doc/help/installer.rkt index 1198ab9b88..d751eb0273 100644 --- a/pkgs/racket-doc/help/installer.rkt +++ b/pkgs/racket-doc/help/installer.rkt @@ -1,6 +1,9 @@ #lang scheme/base (require launcher - setup/dirs) + setup/dirs + setup/variant + racket/file + racket/path) ;; Builds different kinds of executables for different platforms. ;; The `plt-help' executable is for backward compatibility. @@ -10,27 +13,22 @@ (provide installer) (define (installer path coll user? no-main?) - (unless no-main? - (do-installer path coll user? #f) - (when (and (not user?) - (find-config-tethered-console-bin-dir)) - (do-installer path coll #f #t))) - (when (find-addon-tethered-console-bin-dir) - (do-installer path coll #t #t))) + (cond + [user? + (if (find-addon-tethered-console-bin-dir) + (do-installer path coll #t #t) + (do-installer path coll #t #f))] + [else + (unless no-main? + (if (find-config-tethered-console-bin-dir) + (do-installer path coll #f #t) + (do-installer path coll #f #f)))])) (define (do-installer path collection user? tethered?) (for ([mr? (case (system-type) [(macosx) '(#t #f)] [(windows) '(#t)] - [else '(#f)])] - #:when (or (not tethered?) - (if mr? - (if user? - (find-addon-tethered-gui-bin-dir) - (find-config-tethered-gui-bin-dir)) - (if user? - (find-addon-tethered-console-bin-dir) - (find-config-tethered-console-bin-dir))))) + [else '(#f)])]) (define-values (variants mk-launcher mk-path extras) (if mr? (values available-mred-variants @@ -42,14 +40,33 @@ make-mzscheme-launcher mzscheme-program-launcher-path '()))) - (for ([variant (remove* '(script-3m script-cgc) (variants))]) + (for ([variant (filter (lambda (x) (not (script-variant? x))) (variants))]) (parameterize ([current-launcher-variant variant]) - (mk-launcher #:tether-mode (and tethered? (if user? 'addon 'config)) - (append - '("-l-" "help/help")) - (mk-path (if mr? "Racket Documentation" "plt-help") #:user? user? #:tethered? tethered?) - `([exe-name . ,(if mr? "Racket Documentation" "plt-help")] - [relative? . ,(not user?)] - [install-mode . ,(if user? 'user 'main)] - [start-menu? . ,(not user?)] - ,@extras)))))) + (define exe-path + (mk-path (if mr? "Racket Documentation" "plt-help") #:user? user? #:tethered? tethered?)) + (unless (exists-in-another-layer? exe-path user? tethered? #:gui? mr?) + (mk-launcher #:tether-mode (and tethered? (if user? 'addon 'config)) + (append + '("-l-" "help/help")) + (prep-dir exe-path) + `([exe-name . ,(if mr? "Racket Documentation" "plt-help")] + [relative? . ,(not user?)] + [install-mode . ,(if user? 'user 'main)] + [start-menu? . ,(not user?)] + ,@extras))))))) + +(define (exists-in-another-layer? exe-name user? tethered? #:gui? gui?) + ;; for an untethered main installation, check whether the + ;; executable exists already in an earlier layer + (and (not user?) + (not tethered?) + (let-values ([(base name dir?) (split-path exe-name)]) + (for/or ([dir (in-list (if gui? + (get-gui-bin-extra-search-dirs) + (get-console-bin-extra-search-dirs)))]) + (file-or-directory-type (build-path dir name) #f))))) + +(define (prep-dir p) + (define dir (path-only p)) + (make-directory* dir) + p) diff --git a/pkgs/racket-doc/scribblings/raco/setup.scrbl b/pkgs/racket-doc/scribblings/raco/setup.scrbl index f19e04df4f..203df13a9d 100644 --- a/pkgs/racket-doc/scribblings/raco/setup.scrbl +++ b/pkgs/racket-doc/scribblings/raco/setup.scrbl @@ -2577,13 +2577,13 @@ layer: @item{An @defterm{installation} layer with tethering is like a one without tethering (see @secref["layered-install"]), but where the layer's @filepath{@nonterm{layer-dir}/etc/config.rktd} file - htat maps @racket['config-tethered-console-bin-dir] to + that maps @racket['config-tethered-console-bin-dir] to @nonterm{tethered-bin-dir} and @racket['config-tethered-gui-bin-dir] to - @nonterm{tethered-gui-bin-dir}. The @racket['bin-dir] - configuration can point to a directory that is ignored, since - the executables there will not be tethered. Initialize the - tethered layer with + @nonterm{tethered-gui-bin-dir}. The @racket['bin-dir] and + @racket['gui-bin-dir] configurations can point to the same + directories, but executables are not specifically created there by + @exec{raco setup}. Initialize the tethered layer with @commandline{racket -G @nonterm{layer-dir}/etc -l- raco setup}} diff --git a/racket/collects/setup/setup-core.rkt b/racket/collects/setup/setup-core.rkt index dc0fc391c8..a679702053 100755 --- a/racket/collects/setup/setup-core.rkt +++ b/racket/collects/setup/setup-core.rkt @@ -1554,31 +1554,33 @@ (define skip-non-addon? (and (cc-main? cc) (avoid-main-installation))) (define skip-untethered-main? (and (cc-main? cc) - ;; If the executable already exists in a search - ;; directory other than the one for `p`, no need - ;; to write `p` after all - (for/or ([dir (in-list (if (and (eq? kind 'gui) - (not (script-variant? - (current-launcher-variant)))) - (get-gui-bin-extra-search-dirs) - (get-console-bin-extra-search-dirs)))]) - (define-values (base name dir?) (split-path p)) - (define p2 (build-path dir name)) - (or (file-exists? p2) - (directory-exists? p2))))) + (or + ;; Don't create untethered if we're creating tethered + config-p + ;; If the executable already exists in a search + ;; directory other than the one for `p`, no need + ;; to write `p` after all + (for/or ([dir (in-list (if (and (eq? kind 'gui) + (not (script-variant? + (current-launcher-variant)))) + (get-gui-bin-extra-search-dirs) + (get-console-bin-extra-search-dirs)))]) + (define-values (base name dir?) (split-path p)) + (define p2 (build-path dir name)) + (or (file-exists? p2) + (directory-exists? p2)))))) (unless skip-non-addon? + (prep-dir receipt-path) (unless skip-untethered-main? - (prep-dir p) - (prep-dir receipt-path)) + (prep-dir p)) (when config-p (prep-dir config-p))) (when addon-p (prep-dir addon-p)) - (unless skip-untethered-main? - (hash-set! created-launchers - (record-launcher receipt-path mzln kind (current-launcher-variant) - (cc-collection cc) (cc-path cc)) - #t)) + (hash-set! created-launchers + (record-launcher receipt-path mzln kind (current-launcher-variant) + (cc-collection cc) (cc-path cc)) + #t) (define (create p user? tethered?) (define aux (append