From 21c2b5812ca89bc780aab0cb0dff1b68bde27d6c Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 3 Jul 2013 20:10:49 -0600 Subject: [PATCH] add `site' makefile target Also, adjust stamp handling to ensure that it doesn't change during the build process. original commit: d2ddfc09bd1a68f27822a99aee99743e3204d6fa --- pkgs/distro-build/assemble-site.rkt | 7 ++- pkgs/distro-build/config.rkt | 13 +++++ pkgs/distro-build/download-page.rkt | 2 +- pkgs/distro-build/installer-dmg.rkt | 85 +++++++++++++++-------------- 4 files changed, 65 insertions(+), 42 deletions(-) diff --git a/pkgs/distro-build/assemble-site.rkt b/pkgs/distro-build/assemble-site.rkt index 9b31754..5273679 100644 --- a/pkgs/distro-build/assemble-site.rkt +++ b/pkgs/distro-build/assemble-site.rkt @@ -6,7 +6,6 @@ (only-in "config.rkt" extract-options)) (define build-dir (build-path "build")) -(define dest-dir (build-path build-dir "site")) (define built-dir (build-path build-dir "built")) (define native-dir (build-path build-dir "native")) @@ -23,6 +22,12 @@ (define config (extract-options config-file config-mode)) +(define dest-dir (hash-ref config + '#:site-dest + (build-path build-dir "site"))) + +(printf "Assembling site as ~a\n" dest-dir) + (define (copy dir [build-dir build-dir]) (make-directory* dest-dir) (printf "Copying ~a\n" (build-path build-dir dir)) diff --git a/pkgs/distro-build/config.rkt b/pkgs/distro-build/config.rkt index dee5b9a..d147186 100644 --- a/pkgs/distro-build/config.rkt +++ b/pkgs/distro-build/config.rkt @@ -164,6 +164,8 @@ ;; machine starts by a `git pull' in ; set ;; to #f, for example, for a repo checkout that is ;; shared with server; the default is #t +;; #:site-dest --- destination for completed build; the default +;; is "build/site" ;; ;; Machine-only keywords: ;; @@ -233,6 +235,7 @@ site-config-options site-config-content current-mode + current-stamp extract-options) (module reader syntax/module-reader @@ -353,6 +356,7 @@ [(#:repo) (string? val)] [(#:clean?) (boolean? val)] [(#:pull?) (boolean? val)] + [(#:site-dest) (path-string? val)] [else 'bad-keyword])) (define (check-machine-keyword kw val) @@ -368,6 +372,15 @@ (define current-mode (make-parameter "default")) +(define current-stamp + (let* ([f (build-path "build" "stamp.txt")] + [s (and (file-exists? f) + (call-with-input-file* f read-line))]) + (lambda () + (if (string? s) + s + "now")))) + (define (extract-options config-file config-mode) (or (and (file-exists? config-file) diff --git a/pkgs/distro-build/download-page.rkt b/pkgs/distro-build/download-page.rkt index 7078750..023f422 100644 --- a/pkgs/distro-build/download-page.rkt +++ b/pkgs/distro-build/download-page.rkt @@ -32,7 +32,7 @@ (keyword-apply make-download-page (map car args) (map cdr args) - table-file))) + (list table-file)))) (define (make-download-page table-file #:dest [dest "index.html"] diff --git a/pkgs/distro-build/installer-dmg.rkt b/pkgs/distro-build/installer-dmg.rkt index 5a656f8..4657b9d 100644 --- a/pkgs/distro-build/installer-dmg.rkt +++ b/pkgs/distro-build/installer-dmg.rkt @@ -55,48 +55,53 @@ "attach" "-readwrite" "-noverify" "-noautoopen" "-mountpoint" mnt dmg) (define mnt-name (let-values ([(base name dir?) (split-path mnt)]) (path->string name))) - ;; see also https://github.com/andreyvit/yoursway-create-dmg + ;; See also https://github.com/andreyvit/yoursway-create-dmg + ;; First, give Finder a chance to see the new disk: (define script @~a{ - tell application "Finder" - -- look for a single disk with the mount point as its name - -- (maybe this works only on newer osx versions?) - set myDisks to every disk - set theDMGDisk to "" - repeat with d in myDisks - if name of d = "@mnt-name" - if theDMGDisk = "" - set theDMGDisk to d - else - error "Too many attached DMGs found!" - end if - end if - end repeat - if theDMGDisk = "" then error "Attached DMG not found!" - -- found a single matching disk, continue - tell theDMGDisk - open - set current view of container window to icon view - set toolbar visible of container window to false - set statusbar visible of container window to false - set bounds of container window to {320, 160, 1000, 540} - set theViewOptions to the icon view options of container window - set arrangement of theViewOptions to not arranged - set icon size of theViewOptions to 128 - set text size of theViewOptions to 16 - set background picture of theViewOptions to file "@bg" - make new alias file at container window to POSIX file "/Applications" with properties {name:"Applications"} - set position of item "@volname" of container window to {170, 180} - set position of item "@bg" of container window to {900, 180} - set position of item "Applications" of container window to {500, 180} - set name of file "@bg" to ".@bg" - close - open - update without registering applications - delay 5 - close - end tell - end tell + tell application "Finder" + -- look for a single disk with the mount point as its name + -- (maybe this works only on newer osx versions?) + set theDMGDisk to "" + repeat while theDMGDisk = "" + set myDisks to every disk + repeat with d in myDisks + if name of d = "@mnt-name" + if theDMGDisk = "" + set theDMGDisk to d + else + error "Too many attached DMGs found!" + end if + end if + end repeat + -- not found? maybe Finder wasn't ready + if theDMGDisk = "" then delay 1 + end repeat + if theDMGDisk = "" then error "Attached DMG not found!" + -- found a single matching disk, continue + tell theDMGDisk + open + set current view of container window to icon view + set toolbar visible of container window to false + set statusbar visible of container window to false + set bounds of container window to {320, 160, 1000, 540} + set theViewOptions to the icon view options of container window + set arrangement of theViewOptions to not arranged + set icon size of theViewOptions to 128 + set text size of theViewOptions to 16 + set background picture of theViewOptions to file "@bg" + make new alias file at container window to POSIX file "/Applications" with properties {name:"Applications"} + set position of item "@volname" of container window to {170, 180} + set position of item "@bg" of container window to {900, 180} + set position of item "Applications" of container window to {500, 180} + set name of file "@bg" to ".@bg" + close + open + update without registering applications + delay 5 + close + end tell + end tell }) (printf "~a\n" script) (parameterize ([current-input-port (open-input-string script)])