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

setup/unixstyle-install: preserve all other config entries

Browse Source 
Preserve any configuration entry that is not explicitly set,
as opposed to keeping only entries that are known to the
script.
This commit is contained in:
Matthew Flatt 2014-05-04 08:35:06 -06:00
parent a8105dc0e3
commit 33ad485081
1 changed files with 20 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
racket/collects/setup/unixstyle-install.rkt
View File

@ -368,27 +368,29 @@
(define old (or (and (file-exists? src)
(call-with-input-file src read))
(hash)))
(define (preserve key)
(define val (hash-ref old key #f))
(when val
(printf " (~s . ~s)\n" key val)))
(with-output-to-file src #:exists 'truncate/replace
(lambda ()
(printf ";; automatically generated by unixstyle-install\n")
(printf "#hash(")
(printf "(doc-dir . ~s)\n" (dir: 'doc))
(preserve 'catalogs)
(preserve 'doc-search-url)
(preserve 'build-stamp)
(define handled (make-hash))
(define (out! key val)
(printf " (~a . ~s)\n" key val)
(hash-set! handled key #t))
(printf ";; generated by unixstyle-install\n")
(printf "#hash(\n")
(out! 'doc-dir (dir: 'doc))
(when (eq? 'shared (system-type 'link)) ; never true for now
(printf " (dll-dir . ~s)\n" (dir: 'lib)))
(printf " (lib-dir . ~s)\n" (dir: 'librkt))
(printf " (share-dir . ~s)\n" (dir: 'sharerkt))
(printf " (include-dir . ~s)\n" (dir: 'includerkt))
(printf " (bin-dir . ~s)\n" (dir: 'bin))
(printf " (apps-dir . ~s)\n" (dir: 'apps))
(printf " (man-dir . ~s)\n" (dir: 'man))
(printf " (absolute-installation? . #t))\n"))))]))
(out! 'dll-dir (dir: 'lib)))
(out! 'lib-dir (dir: 'librkt))
(out! 'share-dir (dir: 'sharerkt))
(out! 'include-dir (dir: 'includerkt))
(out! 'bin-dir (dir: 'bin))
(out! 'apps-dir (dir: 'apps))
(out! 'man-dir (dir: 'man))
(out! 'absolute-installation? #t)
;; Preserve all other keys:
(for ([(key val) (in-hash old)])
(unless (hash-ref handled key #f)
(out! key val)))
(printf ")\n"))))]))
;; creates a directory including its ancestors when needed
(define (make-dir* dir)