suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

raco setup: skip creation of redundant untethered executables

Browse Source 
When tethering is configured for an installation layer, skip creating
untethered executables.
This commit is contained in:
Matthew Flatt 2021-05-19 12:44:48 -06:00
parent 3f5db8270e
commit e586797164
3 changed files with 70 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

71
pkgs/racket-doc/help/installer.rkt
View File

@ -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)

10
pkgs/racket-doc/scribblings/raco/setup.scrbl
View File

@ -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}}

40
racket/collects/setup/setup-core.rkt
View File

@ -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