Provide library lists out of "get-libs.rkt" and make it possible to require it
without doing anything, use this in the distribution specs to include them.
This commit is contained in:
parent
6a997be578
commit
d58395cd0b
|
@ -4,6 +4,7 @@
|
|||
#lang racket/base
|
||||
|
||||
(require racket/cmdline racket/runtime-path racket/match racket/promise
|
||||
racket/list ; for use in specs too
|
||||
racket/file (only-in racket/system system)
|
||||
(except-in racket/mpair mappend)
|
||||
meta/checker (prefix-in dist: meta/dist-specs) meta/specs)
|
||||
|
|
|
@ -313,6 +313,18 @@ package: :=
|
|||
(notes: ,p/) (man: ,p) (tests: ,p/)
|
||||
,@(if (getkey '#:src?) `((src: ,p/ ,(concat "worksp/" p/))) '()))))
|
||||
|
||||
;; Utility for pulling out the names of libraries
|
||||
get-libs: :=
|
||||
(lambda (p)
|
||||
(let* ([xs (parameterize ([current-command-line-arguments
|
||||
'#("--no-op" "" "" "")])
|
||||
(dynamic-require (build-path racket/ "src" "get-libs.rkt")
|
||||
'all-files+sizes))]
|
||||
[xs (or (assq p xs) (error 'get-libs "unknown package, ~s" p))]
|
||||
[xs (append-map cdr (cdr xs))]
|
||||
[xs (remove-duplicates (map car xs))])
|
||||
`(lib: ,@xs)))
|
||||
|
||||
;; ============================================================================
|
||||
;; Base distribution specs
|
||||
|
||||
|
@ -396,17 +408,16 @@ foreign-src := (src: "foreign/{Makefile.in|README}"
|
|||
;; queries have no point elsewhere.)
|
||||
|
||||
mz-bins := (lib: "buildinfo" "**/mzdyn{|w}{|3[mM]|cgc|CGC}.{o|obj|exp|def}")
|
||||
(get-libs: core)
|
||||
(cond mac => (lib: "Racket*/")
|
||||
win => (dll: "lib{mzgc|racket}" "UnicoWS" "iconv")
|
||||
win => (dll: "lib{mzgc|racket}")
|
||||
(lib: "gcc/{fixup|init}.o" "bcc/mzdynb.{obj|def}")
|
||||
unix => (lib: "starter"))
|
||||
extra-dynlibs
|
||||
|
||||
mr-bins := (cond mac => (lib: "GRacket*/")
|
||||
mr-bins := (get-libs: gui)
|
||||
(cond mac => (lib: "GRacket*/")
|
||||
win => (dll: "libgracket"))
|
||||
|
||||
extra-dynlibs := (cond win => (dll: "{ssl|lib}eay32"))
|
||||
|
||||
;; ============================================================================
|
||||
;; This filter is used on the full compiled trees to get the binary
|
||||
;; (platform-dependent) portion out.
|
||||
|
|
|
@ -12,6 +12,7 @@
|
|||
(define url-path "/libs/1/")
|
||||
(define url-base (string-append "http://" url-host url-path))
|
||||
|
||||
(provide all-files+sizes)
|
||||
(define all-files+sizes
|
||||
`(;; Core Libraries
|
||||
[core
|
||||
|
@ -95,7 +96,8 @@
|
|||
(command-line
|
||||
#:once-any
|
||||
[("--download") "download mode (the default)" (set! mode 'download)]
|
||||
[("--install") "install mode" (set! mode 'install)]
|
||||
[("--install") "install mode" (set! mode 'install)]
|
||||
[("--no-op") "do nothing (for internal use)" (set! mode #f)]
|
||||
#:once-each
|
||||
[("--touch") file "touch `<file>' on download success" (set! touch file)]
|
||||
#:args [package src-dir dest-dir]
|
||||
|
@ -107,7 +109,7 @@
|
|||
(string-append (unixize base) "/" (path->string name))
|
||||
(path->string name))))
|
||||
|
||||
(define needed-files+sizes
|
||||
(define (needed-files+sizes)
|
||||
(let* ([files+sizes
|
||||
(cdr (or (assq package all-files+sizes)
|
||||
(error 'get-libs "bad package: ~s, expecting one of ~s"
|
||||
|
@ -195,16 +197,17 @@
|
|||
(subprocess-wait p)))
|
||||
|
||||
(case mode
|
||||
[(#f) (void)]
|
||||
[(download)
|
||||
(unless (directory-exists? dest-dir) (make-directory dest-dir))
|
||||
(for ([file+size (in-list needed-files+sizes)])
|
||||
(for ([file+size (in-list (needed-files+sizes))])
|
||||
(download-if-needed dest-dir (car file+size) (cadr file+size)))
|
||||
(when touch
|
||||
(define ok (build-path dest-dir touch))
|
||||
(when (file-exists? ok) (delete-file ok))
|
||||
(unless (file-exists? ok) (with-output-to-file ok void)))]
|
||||
[(install)
|
||||
(for ([file+size (in-list needed-files+sizes)])
|
||||
(for ([file+size (in-list (needed-files+sizes))])
|
||||
(define file (car file+size))
|
||||
(install-file (build-path src-dir "libs" file)
|
||||
(build-path dest-dir file)))])
|
||||
|
|
Loading…
Reference in New Issue
Block a user