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

301.15: new install tree for Unix, moved docs, moved teachpacks, added config.ss

Browse Source 
svn: r2962
This commit is contained in:
Matthew Flatt 2006-05-18 15:03:05 +00:00
parent dde23c0890
commit c727afef04
106 changed files with 2485 additions and 1874 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
collects/compiler/start.ss
View File

@ -54,6 +54,7 @@
(define plt-files-replace (make-parameter #f))
(define plt-files-plt-relative? (make-parameter #f))
(define plt-files-plt-home-relative? (make-parameter #f))
(define plt-force-install-dir? (make-parameter #f))
(define plt-setup-collections (make-parameter null))
(define plt-include-compiled (make-parameter #f))
@ -311,10 +312,17 @@
("Files in archive replace existing files when unpacked")]
[("--at-plt")
,(lambda (f) (plt-files-plt-relative? #t))
("Files/dirs in archive are relative to PLT add-ons directory")]
("Files/dirs in archive are relative to user's add-ons directory")]]
[once-any
[("--all-users")
,(lambda (f) (plt-files-plt-home-relative? #t))
("Files/dirs in archive are relative to PLT installation directory")]
("Files/dirs in archive go to PLT installation if writable")]
[("--force-all-users")
,(lambda (f)
(plt-files-plt-home-relative? #t)
(plt-force-install-dir? #t))
("Files/dirs forced to PLT installation")]]
[once-each
[("--include-compiled")
,(lambda (f) (plt-include-compiled #t))
("Include \"compiled\" subdirectories in the archive")]]
@ -539,25 +547,27 @@
"file/directory is not relative to the current directory: \"~a\""
fd)))
source-files)
(pack (plt-output) (plt-name)
source-files
(map list (plt-setup-collections))
std-filter #t
(if (plt-files-replace)
'file-replace
'file)
#f
(or (plt-files-plt-relative?)
(plt-files-plt-home-relative?))
;; Get current version of mzscheme for require:
(let ([i (get-info '("mzscheme"))])
(let ([v (and i (i 'version (lambda () #f)))])
(list (list '("mzscheme") v))))
null
(plt-files-plt-home-relative?))
(pack-plt (plt-output) (plt-name)
source-files
#:collections (map list (plt-setup-collections))
#:file-mode (if (plt-files-replace)
'file-replace
'file)
#:plt-relative? (or (plt-files-plt-relative?)
(plt-files-plt-home-relative?))
#:at-plt-home? (plt-files-plt-home-relative?)
#:test-plt-dirs (if (or (plt-force-install-dir?)
(not (plt-files-plt-home-relative?)))
#f
(list "collects" "doc" "include" "lib"))
#:requires
;; Get current version of mzscheme for require:
(let ([i (get-info '("mzscheme"))])
(let ([v (and i (i 'version (lambda () #f)))])
(list (list '("mzscheme") v)))))
(printf " [output to \"~a\"]~n" (plt-output))]
[(plt-collect)
(pack-collections
(pack-collections-plt
(plt-output)
(if (eq? default-plt-name (plt-name))
#f
@ -569,13 +579,14 @@
(cons (cadr m) (loop (caddr m)))
(list sf)))))
source-files)
(plt-files-replace)
(map list (plt-setup-collections))
(if (plt-include-compiled)
(lambda (path)
(or (regexp-match #rx"compiled$" path)
(std-filter path)))
std-filter)
(plt-files-plt-home-relative?))
#:replace? (plt-files-replace)
#:extra-setup-collections (map list (plt-setup-collections))
#:filter (if (plt-include-compiled)
(lambda (path)
(or (regexp-match #rx"compiled$" path)
(std-filter path)))
std-filter)
#:at-plt-home? (plt-files-plt-home-relative?)
#:test-plt-collects? (not (plt-force-install-dir?)))
(printf " [output to \"~a\"]~n" (plt-output))]
[else (printf "bad mode: ~a~n" mode)]))

8
collects/config/config.ss Normal file
View File

@ -0,0 +1,8 @@
;; The config module doesn't have to use "configtab.ss";
;; it just has the have the right exports. But using
;; "configtab.ss" makes it easier to generate the
;; code at install time.
(module config (lib "configtab.ss" "setup")
;; An empty table means that all defaults apply
)

4
collects/drscheme/private/language-configuration.ss
View File

@ -1024,9 +1024,7 @@
(floor (inexact->exact (unbox y-box))))))
(define teachpack-directory
(let ([lib-dir (build-path
(collection-path "mzlib")
'up 'up "teachpack")])
(let ([lib-dir (collection-path "teachpack")])
(if (directory-exists? lib-dir)
lib-dir
#f)))

8
collects/help/installer.ss
View File

@ -3,7 +3,8 @@
(require (lib "match.ss")
(lib "file.ss")
(lib "list.ss"))
(lib "list.ss")
(lib "dirs.ss" "setup"))
(define installer
(lambda (path)
@ -28,9 +29,8 @@
(build-path (collection-path "help") "servlets")))
(define exploded-servlet-dir-len (length (explode-path servlet-dir)))
;; assume that there is only a single `help' collection and that the
;; original PLT tree help directory is a sibling of that.
(define dest-dir (build-path (collection-path "help") 'up "doc" "help"))
;; assume that "help" is in the main doc directory
(define dest-dir (build-path (find-doc-dir) "help"))
(unless (directory-exists? dest-dir)
(make-directory* dest-dir))

54
collects/help/private/colldocs.ss
View File

@ -27,56 +27,4 @@
docs)
(cons name names))
(loop (cdr dirs) docs names)))
(loop (cdr dirs) docs names)))])))
; Gets a list of collections that contain a doc.txt file
; returns two parallel lists.
; the first has the locations of the docs and the second is their names.
#;
(define (colldocs)
(let loop ([collection-paths (current-library-collection-paths)]
[docs null]
[names null])
(cond
[(null? collection-paths)
(let* ([collections-docs (map cons docs names)]
[l (sort collections-docs
(lambda (a b) (string<? (cdr a) (cdr b))))])
(values (map car l) (map cdr l)))]
[else (let ([path (car collection-paths)])
(let cloop ([l (with-handlers ([exn:fail:filesystem? (lambda (x) null)])
(directory-list path))]
[path path]
[collpath null]
[docs docs]
[names names])
(cond
[(null? l) (if (null? collpath)
(loop (cdr collection-paths) docs names)
(values docs names))]
[else
(let* ([coll (car l)]
[colldir (build-path path coll)])
(cond
[(and (directory-exists? colldir)
(not (member (path->string coll) names)))
(let* ([lcollpath (append collpath (list coll))]
[doc-txt-file (list colldir (string->path "doc.txt"))]
[this? (file-exists? (apply build-path doc-txt-file))])
(let-values ([(sub-docs sub-names)
(with-handlers ([exn:fail:filesystem?
(lambda (x) (values null null))])
(let ([info-proc/f (get-info lcollpath)])
(if info-proc/f
(let ([l (info-proc/f 'doc-sub-collections (lambda () null))])
(cloop (map string->path l) colldir lcollpath null null))
(values null null))))])
(let ([sub-names (map (lambda (s) (string-append (path->string coll) " " s)) sub-names)])
(let-values ([(ldocs lnames)
(if this?
(values (cons doc-txt-file sub-docs)
(cons (path->string coll) sub-names))
(values sub-docs sub-names))])
(cloop (cdr l) path collpath (append ldocs docs) (append lnames names))))))]
[else (cloop (cdr l) path collpath docs names)]))])))]))))
(loop (cdr dirs) docs names)))]))))

15
collects/help/private/config.ss
View File

@ -1,6 +1,7 @@
(module config mzscheme
(require (lib "file.ss")
(lib "configuration.ss" "web-server")
(lib "dirs.ss" "setup")
"internal-hp.ss")
(provide config)
@ -11,7 +12,6 @@
(normalize-path
(apply build-path args)))]
[help-path (build-normal-path (collection-path "help"))]
[doc-path (build-normal-path help-path 'up "doc")]
[host-root (build-normal-path help-path "web-root")]
[servlet-root help-path]
[make-host-config
@ -46,8 +46,11 @@
(max-waiting 40)
(initial-connection-timeout 30)
(default-host-table
,(make-host-config (build-normal-path doc-path 'up)))
(virtual-host-table
(,addon-host
,(make-host-config
(build-path (find-system-path 'addon-dir))))))))))
,(make-host-config (find-collects-dir)))
(virtual-host-table
,@(map
(lambda (virtual-host dir)
`(,virtual-host
,(make-host-config dir)))
(append doc-hosts collects-hosts)
(append doc-dirs collects-dirs))))))))

23
collects/help/private/finddoc.ss
View File

@ -1,10 +1,12 @@
(module finddoc mzscheme
(require "path.ss")
(require "path.ss"
(lib "dirs.ss" "setup"))
(provide finddoc
findreldoc
finddoc-page
finddoc-page-anchor)
finddoc-page-anchor
find-doc-directory)
;; Creates a "file:" link into the indicated manual.
;; The link doesn't go to a particular anchor,
@ -39,7 +41,7 @@
(let ([path (if anchor?
(string-append (caddr m) "#" (cadddr m))
(caddr m))])
(if (servlet-path? path)
(if (servlet-path? (string->path (caddr m)))
path
(format "/doc/~a/~a" manual path))))))
@ -63,7 +65,7 @@
;; (list docdir index-key filename anchor title)
(define (lookup manual index-key label)
(let ([key (string->symbol manual)]
[docdir (build-path (collection-path "doc") manual)])
[docdir (find-doc-directory manual)])
(let ([l (hash-table-get
ht
key
@ -77,6 +79,13 @@
(let ([m (assoc index-key l)])
(if m
(cons docdir m)
(error 'finddoc "index key ~s not found in manual ~s" index-key manual)))))))
(error 'finddoc "index key ~s not found in manual ~s" index-key manual))))))
;; finds the full path of the doc directory, if one exists
;; input is just the short name of the directory (as a path)
(define (find-doc-directory doc)
(ormap (lambda (d)
(let ([p (build-path d doc)])
(and (directory-exists? p)
p)))
(get-doc-search-dirs))))

55
collects/help/private/get-help-url.ss
View File

@ -4,7 +4,8 @@
(require (lib "file.ss")
"internal-hp.ss"
(lib "contract.ss")
(lib "etc.ss"))
(lib "etc.ss")
(lib "dirs.ss" "setup"))
(provide/contract (get-help-url
(((lambda (x)
@ -20,37 +21,39 @@
(let ([segments (explode-path (normalize-path manual-path))])
(let loop ([candidates manual-path-candidates])
(cond
;; shouldn't happen, unless documentation is found outside the user's addon dir
;; and also outside the PLT tree.
[(null? candidates) "/cannot-find-docs.html"]
[else
(let ([candidate (car candidates)])
(cond
[(subpath/tail (car candidate) segments)
=>
(λ (l-o-path)
((cadr candidate) l-o-path anchor))]
[else (loop (cdr candidates))]))])))))
;; shouldn't happen, unless documentation is outside
;; the set of doc dirs:
[(null? candidates) "/cannot-find-docs.html"]
[else
(let ([candidate (car candidates)])
(cond
[(subpath/tail (car candidate) segments)
=>
(λ (l-o-path)
((cadr candidate) l-o-path anchor))]
[else (loop (cdr candidates))]))])))))
(define manual-path-candidates '())
(define (maybe-add-candidate candidate host)
(with-handlers ([exn:fail? void])
(set! manual-path-candidates
(cons (list (explode-path (normalize-path candidate))
(λ (segments anchor)
(format "http://~a:~a~a~a"
host
internal-port
(apply string-append (map (λ (x) (format "/~a" (path->string x)))
segments))
(if anchor
(string-append "#" anchor)
""))))
manual-path-candidates))))
(define stupid-internal-define-syntax1
(maybe-add-candidate (build-path (collection-path "doc") 'up) internal-host))
(define stupid-internal-define-syntax2
(maybe-add-candidate (build-path (find-system-path 'addon-dir)) addon-host))
(format "http://~a:~a~a~a"
host
internal-port
(apply string-append (map (λ (x) (format "/~a" (path->string x)))
segments))
(if anchor
(string-append "#" anchor)
""))))
manual-path-candidates))))
;; Add doc dirs later, so that they take precedence:
(for-each (lambda (dir host)
(maybe-add-candidate dir host))
(append collects-dirs doc-dirs)
(append collects-hosts doc-hosts))
(define (subpath/tail short long)
(let loop ([short short]

86
collects/help/private/gui.ss
View File

@ -24,6 +24,7 @@
"standard-urls.ss"
"docpos.ss"
"manuals.ss"
"get-help-url.ss"
"internal-hp.ss")
@ -115,27 +116,58 @@
[(is-download.plt-scheme.org/doc-url? url)
url]
;; on the internal host
[(and (equal? internal-host (url-host url))
(equal? internal-port (url-port url)))
(let* ([path (url-path url)]
[coll (and (pair? path)
(pair? (cdr path))
(path/param-path (cadr path)))]
[coll-path (and coll (string->path coll))]
[doc-pr (and coll-path (assoc coll-path known-docs))])
;; check to see if the docs are installed
(if (and doc-pr
(not (has-index-installed? coll-path)))
(let ([url-str (url->string url)])
(string->url
(make-missing-manual-url coll (cdr doc-pr) url-str)))
url))]
[(and (equal? addon-host (url-host url))
(equal? internal-port (url-port url)))
url]
;; one of the "collects" hosts:
[(and (equal? internal-port (url-port url))
(or (equal? internal-host (url-host url))
(ormap (lambda (host)
(equal? host (url-host url)))
collects-hosts)))
url]
;; one of the "doc" hosts:
[(and (equal? internal-port (url-port url))
(ormap (lambda (host)
(equal? host (url-host url)))
doc-hosts))
;; Two things can go wrong with the URL:
;; 1. The corresponding doc might not be installed
;; 2. There's a relative reference from X to Y, and
;; X and Y are installed in different directories,
;; so the host is wrong for Y
;; Resolve 2, then check 1.
(let* ([path (url-path url)]
[manual (and (pair? path)
(path/param-path (car path)))])
(if manual
;; Find out where this manual is really located:
(let* ([path (find-doc-directory (string->path manual))]
[real-url (and path
(get-help-url path))]
[url (if real-url
;; Use the actual host:
(make-url (url-scheme url)
(url-user url)
(url-host (string->url real-url))
(url-port url)
(url-path-absolute? url)
(url-path url)
(url-query url)
(url-fragment url))
;; Can't do better than the original URL?
;; The manual is not installed.
url)])
(if (or (not path)
(not (has-index-installed? path)))
;; Manual not installed...
(let ([doc-pr (assoc (string->path manual) known-docs)])
(string->url
(make-missing-manual-url manual
(cdr doc-pr)
(url->string url))))
;; Manual here; use revised URL
url))
;; Not a manual? Shouldn't happen.
url))]
;; send the url off to another browser
[(or (and (string? (url-scheme url))
@ -151,16 +183,8 @@
(super-new)))
;; has-index-installed? : path -> boolean
(define (has-index-installed? doc-coll)
(let loop ([docs-dirs (find-doc-directories)])
(cond
[(null? docs-dirs) #f]
[else
(let ([doc-dir (car docs-dirs)])
(let-values ([(base name dir?) (split-path doc-dir)])
(or (and (equal? doc-coll name)
(get-index-file doc-dir))
(loop (cdr docs-dirs)))))])))
(define (has-index-installed? path)
(and (get-index-file path) #t))
(define sk-bitmap #f)

42
collects/help/private/internal-hp.ss
View File

@ -1,6 +1,38 @@
(module internal-hp mzscheme
(provide internal-host internal-port addon-host)
(define internal-host "helpdesk.plt-scheme.org") ;; should not exist.
(define addon-host "addon-helpdesk.plt-scheme.org") ;; ditto
(define internal-port 8000))
(require (lib "dirs.ss" "setup"))
(provide internal-port internal-host
collects-hosts collects-dirs
doc-hosts doc-dirs)
;; Hostnames defined here should not exist as real machines
;; The general idea is that there's one virtual host for
;; every filesystem tree that we need to access.
;; The "get-help-url.ss" library provides a function to
;; convert a path into a suitable URL (i.e., a URL using
;; the right virtual host).
;; The "gui.ss" library performs a bit of extra URL
;; processing at the last minute, sometimes switching
;; a URL for a manual to a different host. (That's needed
;; when cross-manual references are implemented as relative
;; URLs.)
(define internal-host "helpdesk.plt-scheme.org")
(define internal-port 8000)
(define (generate-hosts prefix dirs)
(let loop ([dirs dirs][n 0])
(if (null? dirs)
null
(cons (format "~a~a.helpdesk.plt-scheme.org" prefix n)
(loop (cdr dirs) (add1 n))))))
(define collects-dirs
(get-collects-search-dirs))
(define collects-hosts
(generate-hosts "collects" collects-dirs))
(define doc-dirs
(get-doc-search-dirs))
(define doc-hosts
(generate-hosts "doc" doc-dirs)))

124
collects/help/private/manuals.ss
View File

@ -7,6 +7,8 @@
(lib "contract.ss")
(lib "getinfo.ss" "setup")
(lib "uri-codec.ss" "net")
(lib "dirs.ss" "setup")
"finddoc.ss"
"colldocs.ss"
"docpos.ss"
"path.ss"
@ -50,87 +52,13 @@
(make-sec "Libraries" #rx"SRFI|MzLib|Framework|PLT Miscellaneous|Teachpack|Swindle" '())
(make-sec "Writing extensions" #rx"Tools|Inside|Foreign" '())
(make-sec "Other" #rx"" '())))
;; Creates a "file:" link into the indicated manual.
;; The link doesn't go to a particular anchor,
;; because "file:" does not support that.
(define (finddoc manual index-key label)
(let ([m (finddoc-lookup manual index-key label)])
(if (string? m)
m
(format "<A href=\"file:~a\">~a</A>"
(path->string (build-path (car m) (caddr m)))
label))))
;; Given a Unix-style relative path to reach the "doc"
;; collection, creates a link that can go to a
;; particular anchor.
(define (findreldoc todocs manual index-key label)
(let ([m (finddoc-lookup manual index-key label)])
(if (string? m)
m
(format "<A href=\"~a/~a/~a#~a\">~a</A>"
todocs
manual
(caddr m)
(cadddr m)
label))))
(define (finddoc-page-help manual index-key anchor?)
(let ([m (finddoc-lookup manual index-key "dummy")])
(if (string? m)
(error (format "Error finding index \"~a\" in manual \"~a\""
index-key manual))
(let ([path (if anchor?
(string-append (caddr m) "#" (cadddr m))
(caddr m))])
(if (servlet-path? (string->path (caddr m)))
path
(format "/doc/~a/~a" manual path))))))
; finddoc-page : string string -> string
; returns path for use by PLT Web server
; path is of form /doc/manual/page, or
; /servlet/<rest-of-path>
(define (finddoc-page manual index-key)
(finddoc-page-help manual index-key #f))
; finddoc-page-anchor : string string -> string
; returns path (with anchor) for use by PLT Web server
; path is of form /doc/manual/page#anchor, or
; /servlet/<rest-of-path>#anchor
(define (finddoc-page-anchor manual index-key)
(finddoc-page-help manual index-key #t))
;; returns either a string (failure) or
;; (list docdir index-key filename anchor title)
(define finddoc-ht (make-hash-table))
(define (finddoc-lookup manual index-key label)
(let ([key (string->symbol manual)]
[docdir (find-doc-directory (string->path manual))])
(unless docdir
(error 'finddoc-lookup "manual ~s not found" manual))
(let ([l (hash-table-get
finddoc-ht
key
(lambda ()
(let ([f (build-path docdir "hdindex")])
(if (file-exists? f)
(let ([l (with-input-from-file f read)])
(hash-table-put! finddoc-ht key l)
l)
(error 'finddoc "manual index ~s not installed" manual)))))])
(let ([m (assoc index-key l)])
(if m
(cons docdir m)
(error 'finddoc "index key ~s not found in manual ~s" index-key manual))))))
; manual is doc collection subdirectory, e.g. "mred"
(define (main-manual-page manual)
(let* ([entry (assoc (string->path manual) known-docs)]
[name (or (and entry (cdr entry))
manual)]
[href (string-append "/doc/" manual "/")])
[href (get-help-url (find-doc-directory manual))])
`(A ((HREF ,href)) ,name)))
; string string string -> xexpr
@ -197,36 +125,22 @@
[else (loop (cdr dirs))]))]))))
(define (find-doc-directories-in-doc-collection)
(let loop ([paths (current-library-collection-paths)]
[acc null])
(let loop ([dirs (get-doc-search-dirs)]
[acc null])
(cond
[(null? paths) acc]
[else (let* ([path (car paths)]
[doc-path (build-path path "doc")])
(if (directory-exists? doc-path)
(let dloop ([doc-contents (directory-list doc-path)]
[acc acc])
(cond
[(null? doc-contents) (loop (cdr paths) acc)]
[else
(let ([candidate (build-path doc-path (car doc-contents))])
(if (directory-exists? candidate)
(dloop (cdr doc-contents) (cons candidate acc))
(dloop (cdr doc-contents) acc)))]))
(loop (cdr paths) acc)))])))
;; finds the full path of the doc directory, if one exists
;; input is just the short name of the directory (as a path)
(define (find-doc-directory doc)
(let loop ([dirs (find-doc-directories-in-doc-collection)])
(cond
[(null? dirs) #f]
[else (let ([dir (car dirs)])
(let-values ([(base name dir?) (split-path dir)])
(if (equal? name doc)
dir
(loop (cdr dirs)))))])))
[(null? dirs) acc]
[else (let* ([doc-path (car dirs)])
(if (directory-exists? doc-path)
(let dloop ([doc-contents (directory-list doc-path)]
[acc acc])
(cond
[(null? doc-contents) (loop (cdr dirs) acc)]
[else
(let ([candidate (build-path doc-path (car doc-contents))])
(if (directory-exists? candidate)
(dloop (cdr doc-contents) (cons candidate acc))
(dloop (cdr doc-contents) acc)))]))
(loop (cdr dirs) acc)))])))
(define re:title (regexp "<[tT][iI][tT][lL][eE]>(.*)</[tT][iI][tT][lL][eE]>"))

34
collects/help/private/search.ss
View File

@ -5,7 +5,8 @@
"manuals.ss"
(lib "list.ss")
(lib "plt-match.ss")
(lib "contract.ss"))
(lib "contract.ss")
(lib "dirs.ss" "setup"))
(provide doc-collections-changed)
(provide/contract
@ -33,6 +34,7 @@
(non-regexp (string? . -> . string?)))
(define doc-dirs (get-doc-search-dirs))
; These are set by reset-doc-lists:
; docs, doc-names and doc-kinds are parallel lists. doc-kinds
@ -44,8 +46,12 @@
; doc-kinds : (list-of symbol)
(define doc-kinds null)
; doc-collection-date : (union #f number 'none)
(define doc-collection-date #f)
(define doc-collection-dates (map (lambda (x) #f) doc-dirs))
(define (dir-date/none dir)
(with-handlers ([exn:fail:filesystem? (lambda (x) 'none)])
(file-or-directory-modify-seconds dir)))
(define (reset-doc-lists)
; Locate standard HTML documentation
(define-values (std-docs std-doc-names)
@ -64,10 +70,7 @@
txt-doc-names)))
(set! doc-kinds (append (map (lambda (x) 'html) std-docs) (map (lambda (x) 'text) txt-docs)))
(with-handlers ([exn:fail:filesystem? (lambda (x) (set! doc-collection-date 'none))])
(set! doc-collection-date
(file-or-directory-modify-seconds
(collection-path "doc")))))
(set! doc-collection-dates (map dir-date/none doc-dirs)))
(define MAX-HIT-COUNT 300)
@ -284,7 +287,7 @@
(string->list s)))))
(define (doc-collections-changed)
(set! doc-collection-date #f)
(set! doc-collection-dates (map (lambda (x) #f) doc-dirs))
(set! html-keywords (make-hash-table 'equal))
(set! html-indices (make-hash-table 'equal))
(set! text-keywords (make-hash-table 'equal))
@ -325,11 +328,18 @@
add-doc-section add-kind-section add-choice)
; When new docs are installed, the directory's modification date changes:
(set! max-reached #f)
(unless (eq? doc-collection-date 'none)
(when (or (not doc-collection-date)
(> (file-or-directory-modify-seconds (collection-path "doc"))
doc-collection-date))
(reset-doc-lists)))
(when (ormap (lambda (date new-date)
(cond
[(not date) #t]
[(equal? date new-date) #f]
[(eq? date 'none) #t]
[(eq? new-date 'none) #t]
[else (new-date . > . date)]))
doc-collection-dates
(map dir-date/none doc-dirs))
(reset-doc-lists))
(let ([hit-count 0])
(let-values ([(string-finds finds) (build-string-finds/finds given-find regexp? exact?)]
[(filtered-docs filtered-doc-names filtered-doc-kinds)

3
collects/help/private/tcp-intercept.ss
View File

@ -108,7 +108,8 @@
(define (gen-tcp-connect raw)
(lambda (hostname-string port)
(if (and (or (string=? internal-host hostname-string)
(string=? addon-host hostname-string))
(ormap (lambda (host) string=? host hostname-string)
doc-hosts))
(equal? internal-port port))
(let-values ([(req-in req-out) (make-pipe)]
[(resp-in resp-out) (make-pipe)])

11
collects/help/refresh-manuals.ss
View File

@ -175,7 +175,12 @@
(when doc-dir
(display (format sc-refresh-deleting... full-name))
(newline)
(delete-directory/r doc-dir)))))
(with-handlers ([exn:fail:filesystem?
(lambda (exn)
(fprintf (current-error-port)
"Warning: delete failed: ~a\n"
(exn-message exn)))])
(delete-directory/r doc-dir))))))
(define delete-local-plt-files
(lambda (tmp-dir)
@ -216,5 +221,7 @@
(display (format sc-refresh-installing... (cdr pr)))
(newline)
(run-single-installer (make-local-doc-filename tmp-dir (car pr))
parent))
(lambda ()
(error 'install-docs
"expected PLT-relative archive"))))
docs-to-install))))

3
collects/help/servlets/release/notes.ss
View File

@ -2,6 +2,7 @@
(require (lib "servlet.ss" "web-server")
(lib "list.ss")
(lib "uri-codec.ss" "net")
(lib "dirs.ss" "setup")
"../private/util.ss"
"../private/headelts.ss")
@ -9,7 +10,7 @@
(let* ([label (car s)]
[dir (cadr s)]
[filename (caddr s)]
[file (build-path (collection-path "mzlib") 'up 'up "notes" dir filename)])
[file (build-path (find-doc-dir) "release-notes" dir filename)])
(if (file-exists? file)
`(LI (A ((HREF ,(format "/servlets/doc-anchor.ss?file=~a&name=~a&caption=~a"
(uri-encode (path->string file))

3
collects/help/servlets/results.ss
View File

@ -13,6 +13,7 @@ is stored in a module top-level and that's namespace-specific.
(lib "string.ss")
(lib "servlet.ss" "web-server")
(lib "uri-codec.ss" "net")
(lib "dirs.ss" "setup")
"../private/internal-hp.ss"
"../private/path.ss"
"../private/docpos.ss"
@ -81,7 +82,7 @@ is stored in a module top-level and that's namespace-specific.
(define exp-web-root
(explode-path
(normalize-path
(build-path (collection-path "mzlib") 'up))))
(find-collects-dir))))
(define web-root-len (length exp-web-root))
(define (keyword-string? ekey)

10
collects/mzlib/foreign.ss
View File

@ -2,7 +2,8 @@
(module foreign mzscheme
(require #%foreign)
(require #%foreign
(lib "dirs.ss" "setup"))
(require-for-syntax (lib "stx.ss" "syntax"))
;; This module is full of unsafe bindings that are not provided to requiring
@ -166,7 +167,12 @@
[name (if (regexp-match lib-suffix-re name0) ; name + suffix
(string-append name0 version)
(string-append name0 "." lib-suffix version))])
(or (ffi-lib name #t) ; try good name first
(or (ormap (lambda (dir)
(or (ffi-lib (build-path dir name) #t) ; try good name first
(ffi-lib (build-path dir name0) #t))) ; try original
(get-lib-search-dirs))
;; Try without DLL path:
(ffi-lib name #t) ; try good name first
(ffi-lib name0 #t) ; try original
(and (file-exists? name) ; try a relative path
(ffi-lib (fullpath name) #t))

20
collects/openssl/mzssl.ss
View File

@ -18,8 +18,7 @@
(lib "port.ss")
(lib "etc.ss")
(lib "kw.ss")
(lib "filename-version.ss" "dynext")
(lib "dirs.ss" "setup"))
(lib "filename-version.ss" "dynext"))
(provide ssl-available?
ssl-load-fail-reason
@ -53,20 +52,11 @@
(define ssl-load-fail-reason #f)
(define (ffi-lib-win name)
(let* ([d (find-dll-dir)]
[f (and d (build-path d (format "~a.dll" name)))])
;; Try PLT-specific lib:
(if (and f (file-exists? f))
(ffi-lib f)
;; Try system-wide:
(ffi-lib (format "~a.dll" name)))))
(define (ffi-lib-xxxxxxx name)
(let* ([f (format "~a~a" name filename-version-part)])
(or (with-handlers ([exn? (lambda (x) #f)])
(ffi-lib-win (format "~a~a" name filename-version-part)))
(ffi-lib-win (format "~axxxxxxx" name)))))
(ffi-lib (format "~a~a" name filename-version-part)))
(ffi-lib (format "~axxxxxxx" name)))))
(define 3m? (regexp-match #rx#"3m" (path->bytes (system-library-subpath))))
@ -76,7 +66,7 @@
#f)])
(case (system-type)
[(windows)
(ffi-lib-win "libeay32")]
(ffi-lib "libeay32")]
[else
(ffi-lib "libcrypto")])))
@ -87,7 +77,7 @@
#f)])
(case (system-type)
[(windows)
(ffi-lib-win "ssleay32")]
(ffi-lib "ssleay32")]
[else
(ffi-lib "libssl")]))))

92
collects/setup/configtab.ss Normal file
View File

@ -0,0 +1,92 @@
;; Defines a language to be used by the "config.ss" file
(module configtab mzscheme
;; These are the name that need to be provided
;; by the "config.ss" library:
(define-for-syntax exports
'(doc-dir
doc-search-dirs
lib-dir
lib-search-dirs
include-dir
include-search-dirs
bin-dir))
;; ----------------------------------------
;; For configure into into absolute paths
(define use-default (delay #f))
(define (to-path l)
(cond
[(string? l) (complete-path (string->path l))]
[(bytes? l) (complete-path (bytes->path l))]
[(list? l) (map to-path l)]
[else l]))
(define (complete-path p)
(cond
[(complete-path? p) p]
[(absolute-path? p) (exe-relative p)]
[else
(or (parameterize ([current-directory (find-system-path 'orig-dir)])
(find-executable-path (find-system-path 'exec-file) p))
(exe-relative p))]))
(define (exe-relative p)
(let ([exec (path->complete-path
(find-executable-path (find-system-path 'exec-file))
(find-system-path 'orig-dir))])
(let-values ([(base name dir?) (split-path exec)])
(path->complete-path p base))))
;; ----------------------------------------
;; module-begin
(define-syntax config-module-begin
(lambda (stx)
(syntax-case stx (define define-values)
[(_ (define-values (name) val))
;; This can happen because a lone definition is expanded
#'(config-module-begin (define name val))]
[(_ (define name val) ...)
(let ([names (syntax->list #'(name ...))])
(unless (andmap identifier? names)
(raise-syntax-error
#f
"bad syntax"
stx))
(for-each (lambda (name)
(unless (memq (syntax-e name) exports)
(raise-syntax-error
#f
"not a config name"
name)))
names)
(let ([syms (map syntax-e names)])
(let loop ([names names][syms syms])
(cond
[(null? names) 'done]
[(memq (car syms) (cdr syms))
(raise-syntax-error
#f
"duplicate definition"
(car names))]
[else
(loop (cdr names) (cdr syms))]))
#`(#%plain-module-begin
(provide #,@exports)
(define name (delay (to-path val))) ...
#,@(apply
append
(map (lambda (id)
(if (memq id syms)
()
(list #`(define #,id use-default))))
exports)))))])))
(provide (rename config-module-begin #%module-begin)
define
#%datum quote))

157
collects/setup/dirs.ss
View File

@ -1,7 +1,11 @@
(module dirs mzscheme
(require (lib "winutf16.ss" "compiler" "private")
(require (prefix config: (lib "config.ss" "config"))
(lib "winutf16.ss" "compiler" "private")
(lib "mach-o.ss" "compiler" "private"))
;; ----------------------------------------
;; "collects"
(define main-collects-dir
(delay
(let ([d (find-system-path 'collects-dir)])
@ -10,11 +14,11 @@
[(absolute-path? d)
;; This happens only under Windows; add a drive
;; specification to make the path complete
(let ([exec (find-system-path 'exec-file)])
(if (complete-path? exec)
(let-values ([(base name dir?) (split-path exec)])
(path->complete-path d base))
(path->complete-path d (find-system-path 'orig-dir))))]
(let ([exec (path->complete-path
(find-executable-path (find-system-path 'exec-file))
(find-system-path 'orig-dir))])
(let-values ([(base name dir?) (split-path exec)])
(path->complete-path d base)))]
[else
;; Relative to executable...
(parameterize ([current-directory (find-system-path 'orig-dir)])
@ -24,36 +28,137 @@
(and p
(simplify-path p))))]))))
(provide find-main-collects-dir)
(define (find-main-collects-dir)
(provide find-collects-dir
find-user-collects-dir
get-collects-search-dirs)
(define (find-collects-dir)
(force main-collects-dir))
(define user-collects-dir
(delay (build-path (find-system-path 'addon-dir) (version) "collects")))
(define (find-user-collects-dir)
(force user-collects-dir))
(define (get-collects-search-dirs)
(current-library-collection-paths))
;; ----------------------------------------
;; Helpers
(define (single p) (if p (list p) null))
(define (extra a l) (if (and a (not (member a l))) (cons a l) l))
(define (combine-search l default)
;; Replace #f in list with default path:
(if l
(let loop ([l l])
(cond
[(null? l) null]
[(not (car l)) (append default (loop (cdr l)))]
[else (cons (car l) (loop (cdr l)))]))
default))
(define-syntax define-finder
(syntax-rules ()
[(_ provide id default)
[(_ provide config:id id user-id config:search-id search-id default)
(begin
(provide id)
(define-finder provide config:id id user-id default)
(provide search-id)
(define (search-id)
(combine-search (force config:search-id)
(cons (user-id) (single (id))))))]
[(_ provide config:id id user-id config:search-id search-id extra-search-dir default)
(begin
(define-finder provide config:id id user-id default)
(provide search-id)
(define (search-id)
(combine-search (force config:search-id)
(extra (extra-search-dir)
(cons (user-id) (single (id)))))))]
[(_ provide config:id id user-id default)
(begin
(provide id user-id)
(define dir
(delay
(let ([p (find-main-collects-dir)])
(and p
(simplify-path (build-path p
'up
default))))))
(or (force config:id)
(let ([p (find-collects-dir)])
(and p
(simplify-path (build-path p
'up
default)))))))
(define (id)
(force dir)))]))
(force dir))
(define user-dir
(delay (build-path (find-system-path 'addon-dir) (version) default)))
(define (user-id)
(force user-dir)))]))
(define-finder provide find-include-dir "include")
(define-finder provide find-lib-dir "lib")
(define-syntax no-provide (syntax-rules () [(_ . rest) (begin)]))
(define-finder provide find-console-bin-dir (case (system-type)
[(windows) 'same]
[(macosx unix) "bin"]))
;; ----------------------------------------
;; "doc"
(define-finder provide find-gui-bin-dir (case (system-type)
[(windows macosx) 'same]
[(unix) "bin"]))
(define delayed-#f (delay #f))
(provide find-doc-dir
find-user-doc-dir
get-doc-search-dirs)
(define-finder no-provide
config:doc-dir
find-doc-dir
find-user-doc-dir
delayed-#f
get-new-doc-search-dirs
"doc")
;; For now, include "doc" pseudo-collections in search path:
(define (get-doc-search-dirs)
(combine-search (force config:doc-search-dirs)
(append (get-new-doc-search-dirs)
(map (lambda (p)
(build-path p "doc"))
(current-library-collection-paths)))))
;; ----------------------------------------
;; "include"
(define-finder provide
config:include-dir
find-include-dir
find-user-include-dir
config:include-search-dirs
get-include-search-dirs
"include")
;; ----------------------------------------
;; "lib"
(define-finder provide
config:lib-dir
find-lib-dir
find-user-lib-dir
config:lib-search-dirs
get-lib-search-dirs find-dll-dir
"lib")
;; ----------------------------------------
;; Executables
(define-finder provide
config:bin-dir
find-console-bin-dir
find-user-console-bin-dir
(case (system-type)
[(windows) 'same]
[(macosx unix) "bin"]))
(define-finder provide
config:bin-dir
find-gui-bin-dir
find-user-gui-bin-dir
(case (system-type)
[(windows macosx) 'same]
[(unix) "bin"]))
;; ----------------------------------------
;; DLLs
(provide find-dll-dir)
(define dll-dir
(delay (case (system-type)
@ -111,6 +216,4 @@
[else
(find-lib-dir)])))
(define (find-dll-dir)
(force dll-dir))
)
(force dll-dir)))

211
collects/setup/doc.txt
View File

@ -242,8 +242,10 @@ parameters that control the setup process:
"collects" directory, and a list of path choices; it
returns a path for a "plt-relative" install; when
unpacking an archive, either this or the procedure in
`current-target-directory-getter' will be called [default:
(lambda (preferred main-parent-dir choices) preferred)]
`current-target-directory-getter' will be called, and in
the former case, this procedure one may be called multiple
times [default: (lambda (preferred main-parent-dir choices)
preferred)]
Thus, to unpack a single .plt archive "x.plt", set the `archives'
parameter to (list "x.plt") and leave `specific-collections' as null.
@ -281,17 +283,33 @@ installation directories:
#f if none can be found. (A #f result is likely only in an
stand-alone executable that is distributed without libraries.)
> (find-console-bin-dir)
> (find-user-collects-dir)
Returns a path to the installation's executable directory, where the
stand-alone MzScheme executable resides. The result is #f if no such
directory is available.
Returns a path to the user-specific "collects" directory; the
directory indicated by the returned path may or may not exist.
> (find-include-dir)
> (get-collects-search-dir)
Returns the same result as `(current-library-collection-paths)'.
> (find-doc-dir)
Returns a path to the installation's "doc" directory. The result is
#f if no such directory is available.
> (find-user-doc-dir)
Returns a path to a user-specific "doc" directory; the directory
indicated by the returned path may or may not exist.
> (get-doc-search-dir)
Returns a list of paths to search for documentation, not including
documentation stored in individual collections. Unless it is
configured otherwise, the result includes any non-#f result of
`(find-doc-dir)' and `(find-user-doc-dir)'.
Returns a path to the installation's "include" directory, which
contains .h files for building MzScheme extensions and embedding
programs. The result is #f if no such directory is available.
> (find-lib-dir)
@ -306,6 +324,49 @@ installation directories:
is #f if no such directory is available, or if no specific directory
is available (i.e., other than the platform's normal search path).
> (find-user-lib-dir)
Returns a path to a user-specific "lib" directory; the directory
indicated by the returned path may or may not exist.
> (get-lib-search-dir)
Returns a list of paths to search for libraries. Unless it is
configured otherwise, the result includes any non-#f result of
`(find-lib-dir)', `(find-dll-dir)', and `(find-user-lib-dir)'.
> (find-include-dir)
Returns a path to the installation's "include" directory, which
contains .h files for building MzScheme extensions and embedding
programs. The result is #f if no such directory is available.
> (find-user-include-dir)
Returns a path to a user-specific "include" directory; the directory
indicated by the returned path may or may not exist.
> (get-include-search-dir)
Returns a list of paths to search for .h files. Unless it is
configured otherwise, the result includes any non-#f result of
`(find-include-dir)' and `(find-user-include-dir)'.
> (find-console-bin-dir)
Returns a path to the installation's executable directory, where the
stand-alone MzScheme executable resides. The result is #f if no such
directory is available.
> (find-gui-bin-dir)
Returns a path to the installation's executable directory, where the
stand-alone MrEd executable resides. The result is #f if no such
directory is available.
_Getting info.ss fields_
========================
@ -411,7 +472,12 @@ The raw format is
+ 'plt-home-relative? - a boolean; if true and if `plt-relative?'
is true, then the archive's content should be unpacked relative
to the plt installation directory.
to the PLT installation.
+ 'test-plt-dirs - #f or a list of path strings; in the latter
case, a true value of 'plt-home-relative? is cancelled if
any of the directories in the list (relative to the PLT
installation) is unwritable by the user.
The procedure is extracted from the archive using MzScheme's `read'
and `eval' procedures (in a fresh namespace).
@ -437,8 +503,9 @@ The raw format is
+ a relative path string - the pathname of the directory or file
to be unpacked, relative to the unpack directory; and
+ a path string for the unpack directory (which is often the
parent of the main "collects" directory).
+ a path string for the unpack directory (which can vary for a
PLT-relative install when elements of the archive start with
"collects", "lib", etc.).
If the filter procedure returns #f for a directory or file, the
directory or file is not unpacked. If the filter procedure returns
@ -492,7 +559,12 @@ mzc supports the creation of simple .plt files (see the mzc manual for
details) but the setup collection's _pack.ss_ library provides more
general functions to help make .plt archives:
> (pack-collections dest name collections replace? extra-setup-collections [filter] [at-plt-home?])
> (pack-collections-plt dest name collections
[#:replace? replace?]
[#:at-plt-home? at-home?]
[#:test-plt-collects? test?]
[#:extra-setup-collections collection-list]
[#:filter filter-proc])
Creates the .plt file specified by the pathname `dest', using the
string `name' as the name reported to Setup PLT as the archive's
@ -502,55 +574,96 @@ general functions to help make .plt archives:
should be a list of collection paths; each collection path is, in
turn, a list of relative-path strings.
If `replace?' is #f, then attempting to unpack the archive will
report an error when any of the collections exist already, otherwise
unpacking the archive will overwrite an existing collection.
If the #:replace? argument is #f, then attempting to unpack the
archive will report an error when any of the collections exist
already, otherwise unpacking the archive will overwrite an existing
collection.
The `extra-setup-collections' argument is a list of collection paths
that are not included in the archive, but are set-up when the
archive is unpacked.
If the #:at-plt-home? argument is true, then the archived
collections will be installed into the PLT installation directory
instead of the user's directory if the main "collects" directory is
writable by the user. If the #:test-plt-collects? argument is #f
(the default is #t) and the #:at-plt-home? argument is true, then
installation fails if the main "collects" directory is not writable.
The optional `filter' argument is the same as for `pack' (see
The optional #:extra-setup-collections argument is a list of
collection paths that are not included in the archive, but are
set-up when the archive is unpacked.
The optional #:filter argument is the same as for `pack-plt' (see
below).
The optional `at-plt-home?' argument is the same as for `pack'
where `plt-relative?' is true.
> (pack-collections dest name collections replace? extra-setup-collections [filter] [at-plt-home?])
> (pack dest name paths collections [filter encode? file-mode unpack-unit plt-relative? requires conflicts at-plt-home?])
Old, keywordless variant of `pack-collections-plt' for backward compatibility.
> (pack-plt dest name paths
[#:filter filter-proc]
[#:encode? encode?]
[#:file-mode file-mode-sym]
[#:unpack-unit unit-expr-or-#f]
[#:collections collection-list]
[#:plt-relative? plt-relative?]
[#:at-plt-home? at-plt-home?]
[#:test-plt-dirs dir-list-or-#f]
[#:requires mod-and-version-list]
[#:conflicts mod-list])
Creates the .plt file specified by the pathname `dest', using the
string `name' as the name reported to Setup PLT as the archive's
description, and `collections' as the list of collection paths (to
be compiled) returned by the unpacking unit. The `paths' argument
must be a list of relative paths for directories and files; the
contents of these files and directories will be packed into the
archive.
description. The `paths' argument must be a list of relative paths
for directories and files; the contents of these files and
directories will be packed into the archive.
The `filter' procedure is called with the relative path of each
The #:filter procedure is called with the relative path of each
candidate for packing. If it returns #f for some path, then that
file or directory is omitted from the archive. If it returns 'file
or 'file-replace for a file, the file is packed with that mode,
rather than the default mode. The default `filter' is `std-filter'
(defined below).
rather than the default mode. The default is `std-filter' (defined
below).
If `encode?' is #f, then the output archive is in raw form, and
still must be gzipped and mime-encoded (in that order). The default
value is #t.
If the #:encode? argument is #f, then the output archive is in raw
form, and still must be gzipped and mime-encoded (in that
order). The default value is #t.
The `file-mode' argument must be 'file or 'file-replace, indicating
the default mode for a file in the archive. The default value is
'file.
The #:file-mode argument must be 'file or 'file-replace,
indicating the default mode for a file in the archive. The default
is 'file.
The `unpack-unit' argument is usually #f. Otherwise, it must be an
unsigned unit that performs the work of unpacking; see the above
section on .plt internals for more information about the unit. If
`unpack-unit' is #f, an appropriate unpacking unit is generated.
S-expression for a unsigned unit that performs the work of
unpacking; see the above section on .plt internals for more
information about the unit. If `unpack-unit' is #f, an appropriate
unpacking unit is generated.
If `plt-relative?', the archive's files and directories are to be
unpacked relative to the plt add-ons directory (unless
`plt-at-home?' is #t; see below).
The #:collections argument is a list of collection paths to be
compiled after the archive is unpacked. The default is the empty
list.
The `requires' argument should have the shape
If the #:plt-relative? argument is true (the default is #f), the
archive's files and directories are to be unpacked relative to the
user's add-ons directory or the PLT installation directories,
depending on whether the #:at-plt-home? argument is true and whether
directories specified by #;test-plt-dirs are writable by the user.
If the #:at-plt-home? argument is true (the default is #f), then
#:plt-relative? must be true, and the archive is unpacked relative
to the PLT installation directory. In that case, a relative path
that starts with "collects" is mapped to the installation's main
"collects" directory, and so on, for the following the initial
directory names:
- "collects"
- "doc"
- "lib"
- "include"
If #:test-plt-dirs is a list, then #:at-plt-home? must be true. In
that case, when the archive is unpacked, if any of the relative
directories in the #;test-plt-dirs list is unwritable by the current
user, then the archive is unpacked in the user's add-ons directory
after all.
The #:requires argument should have the shape
(list (list <coll-path> <version>) ...)
where each <coll-path> is a non-empty list of relative-path strings,
and each <version> is a (possibly empty) list of exact integers. The
@ -559,15 +672,15 @@ general functions to help make .plt archives:
specified in the corresponding <version>. A collection's version is
indicated by the `version' field of it's info.ss file.
The `conflicts' argument should have the shape
The #:conflicts argument should have the shape
(list <coll-path> ...)
where each <coll-path> is a non-empty list of relative-path
strings. The indicated collections must *not* be installed at
unpacking time.
If `at-plt-home?' and `plt-relative?', the archive is to be unpacked
relative to the parent of the PLT Scheme installation's main
"collects" directory. The default is #f.
> (pack dest name paths collections [filter encode? file-mode unpack-unit plt-relative? requires conflicts at-plt-home?])
Old, keywordless variant of `pack-plt' for backward compatibility.
> (std-filter p) - returns #t unless `p', after stripping its
directory path and converting to a byte string, matches one of the

6
collects/setup/main-collects.ss
View File

@ -28,8 +28,8 @@
simplify-bytes-path))
(define main-collects-dir-bytes
(delay (and (find-main-collects-dir)
(path->bytes (find-main-collects-dir)))))
(delay (and (find-collects-dir)
(path->bytes (find-collects-dir)))))
(define main-collects-dir/
(delay (and (force main-collects-dir-bytes)
@ -68,7 +68,7 @@
(cond [(and (pair? path)
(eq? 'collects (car path))
(bytes? (cdr path)))
(let ([dir (or (find-main-collects-dir)
(let ([dir (or (find-collects-dir)
;; No main "collects"? Use original working directory:
(find-system-path 'orig-dir))])
(if (equal? (cdr path) #"")

137
collects/setup/pack.ss
View File

@ -7,9 +7,23 @@
(lib "etc.ss")
(lib "port.ss")
(lib "file.ss")
(lib "kw.ss")
(lib "getinfo.ss" "setup"))
(provide pack mztar std-filter pack-collections)
(provide pack
pack-plt
mztar
std-filter
pack-collections
pack-collections-plt)
(define (x-arg-needs-true-arg who arg1-name v arg2-name)
(error who
(string-append
"true value for `~a' argument: ~e "
"requires a true value for `~a' argument")
arg1-name v
arg2-name))
(define pack
(opt-lambda (dest name paths collections
@ -20,7 +34,37 @@
[plt-relative? #t]
[requires null]
[conflicts null]
[plt-home-relative? #f])
[at-plt-home? #f])
(pack-plt dest name paths
#:collections collections
#:filter filter
#:encode? encode?
#:file-mode file-mode
#:unpack-unit unpack-unit
#:plt-relative? plt-relative?
#:requires null
#:conflicts null
#:at-plt-home? at-plt-home?)))
(define pack-plt
(lambda/kw (dest name paths
#:key
[collections null]
[filter std-filter]
[encode? #t]
[file-mode 'file]
[unpack-unit #f]
[plt-relative? #t]
[requires null]
[conflicts null]
[at-plt-home? #f]
[test-plt-dirs #f])
(when at-plt-home?
(unless plt-relative?
(x-arg-needs-true-arg 'pack-plt 'at-plt-home? at-plt-home? 'plt-relative?)))
(when test-plt-dirs
(unless at-plt-home?
(x-arg-needs-true-arg 'pack-plt 'test-plt-dirs test-plt-dirs 'at-plt-home?)))
(let*-values ([(file) (open-output-file dest 'truncate/replace)]
[(fileout thd)
(if encode?
@ -83,7 +127,10 @@
[(conflicts) ',conflicts]
[(plt-relative?) ,plt-relative?]
[(plt-home-relative?) ,(and plt-relative?
plt-home-relative?)]
at-plt-home?)]
[(test-plt-dirs) ,(and plt-relative?
at-plt-home?
`',test-plt-dirs)]
[else (failure)]))
fileout)
(newline fileout)
@ -161,7 +208,21 @@
(regexp-match #rx#"^[.]#" name))))))
(define pack-collections
(opt-lambda (output name collections replace? extra-setup-collections [file-filter std-filter] [plt-home-relative? #f])
(opt-lambda (output name collections replace? extra-setup-collections [file-filter std-filter] [at-plt-home? #f])
(pack-collections-plt output name collections
#:replace? replace?
#:extra-setup-collections extra-setup-collections
#:filter file-filter
#:at-plt-home? at-plt-home?)))
(define pack-collections-plt
(lambda/kw (output name collections
#:key
[replace? #f]
[extra-setup-collections null]
[file-filter std-filter]
[at-plt-home? #f]
[test-plt-collects? #t])
(let-values ([(dir source-files requires conflicts name)
(let ([dirs (map (lambda (cp) (apply collection-path cp)) collections)])
;; Figure out the base path:
@ -224,35 +285,39 @@
(lambda () (caar collections)))))))])
(let ([output (path->complete-path output)])
(parameterize ([current-directory dir])
(pack output name
source-files
(append
extra-setup-collections
(filter get-info collections))
file-filter #t
(if replace?
'file-replace
'file)
#f
#t ; plt-relative
;; For each require, get current version
(map (lambda (r)
(let ([i (get-info r)])
(let ([v (and i (i 'version (lambda () #f)))])
(if v
(begin
(unless (and (list? v)
(andmap number? v)
(andmap exact? v)
(andmap integer? v))
(error
'mzc
"bad version specification in info.ss for collection ~s"
r))
(list r v))
(list r null)))))
(cons
'("mzscheme")
requires))
conflicts
plt-home-relative?)))))))
(pack-plt
output name
source-files
#:collections (append
extra-setup-collections
(filter get-info collections))
#:filter file-filter
#:file-mode (if replace?
'file-replace
'file)
#:plt-relative? #t
#:requires
;; For each require, get current version
(map (lambda (r)
(let ([i (get-info r)])
(let ([v (and i (i 'version (lambda () #f)))])
(if v
(begin
(unless (and (list? v)
(andmap number? v)
(andmap exact? v)
(andmap integer? v))
(error
'mzc
"bad version specification in info.ss for collection ~s"
r))
(list r v))
(list r null)))))
(cons
'("mzscheme")
requires))
#:conflicts conflicts
#:at-plt-home? at-plt-home?
#:test-plt-dirs (and at-plt-home?
test-plt-collects?
'("collects")))))))))

6
collects/setup/setup-unit.ss
View File

@ -39,7 +39,7 @@
(apply setup-fprintf (current-output-port) s args)))
(setup-printf "Setup version is ~a" (version))
(setup-printf "Main collection path is ~a" (find-main-collects-dir))
(setup-printf "Main collection path is ~a" (find-collects-dir))
(setup-printf "Collection search path is ~a" (if (null? (current-library-collection-paths))
"empty!"
""))
@ -75,7 +75,7 @@
(specific-collections)
(map (lambda (x) (unpack
x
(build-path (find-main-collects-dir) 'up)
(build-path (find-collects-dir) 'up)
(lambda (s) (setup-printf "~a" s))
(current-target-directory-getter)
(force-unpacks)
@ -536,7 +536,7 @@
(setup-printf "~aInstalling ~a"
(case part [(pre) "Pre-"] [(post) "Post-"] [else ""])
(cc-name cc))
(let ([dir (build-path (find-main-collects-dir) 'up)])
(let ([dir (build-path (find-collects-dir) 'up)])
(if (procedure-arity-includes? installer 2)
(installer dir (cc-path cc))
(installer dir)))))))))

113
collects/setup/unpack.ss
View File

@ -6,7 +6,8 @@
(lib "file.ss")
(lib "unit.ss")
(lib "base64.ss" "net")
(lib "getinfo.ss" "setup"))
(lib "getinfo.ss" "setup")
"dirs.ss")
;; Returns a port and a kill thunk
(define (port64gz->port p64gz)
@ -41,34 +42,58 @@
(path->string base)
base)))))
(define (unmztar p filter main-collects-parent-dir print-status)
(define (shuffle-path parent-dir get-dir shuffle? v)
(if shuffle?
;; Re-arrange for "collects', etc.
(cond
[(null? v) (values #f 'same)]
[else
(let ([dir
(cond
[(string=? (car v) "collects")
(get-dir find-collects-dir find-user-collects-dir)]
[(string=? (car v) "doc")
(get-dir find-doc-dir find-user-doc-dir)]
[(string=? (car v) "lib")
(get-dir find-lib-dir find-user-lib-dir)]
[(string=? (car v) "include")
(get-dir find-include-dir find-user-include-dir)]
[else #f])])
(if dir
(if (null? (cdr v))
(values dir 'same)
(values dir (apply build-path (cdr v))))
(values parent-dir (apply build-path v))))])
(values parent-dir
(if (null? v)
'same
(apply build-path v)))))
(define (unmztar p filter parent-dir get-dir shuffle? print-status)
(define bufsize 4096)
(define buffer (make-bytes bufsize))
(let loop ()
(let ([kind (read p)])
(unless (eof-object? kind)
(case kind
[(dir) (let ([s (let ([v (read p)])
(if (null? v)
'same
(apply build-path v)))])
[(dir) (let-values ([(target-dir s) (shuffle-path parent-dir get-dir shuffle? (read p))])
(unless (or (eq? s 'same) (relative-path? s))
(error "expected a directory name relative path string, got" s))
(when (or (eq? s 'same) (filter 'dir s main-collects-parent-dir))
(let ([d (build-path main-collects-parent-dir s)])
(when (or (eq? s 'same) (filter 'dir s target-dir))
(let ([d (build-path target-dir s)])
(unless (directory-exists? d)
(print-status
(format " making directory ~a" (pretty-name d)))
(make-directory* d)))))]
[(file file-replace)
(let ([s (apply build-path (read p))])
(let-values ([(target-dir s) (shuffle-path parent-dir get-dir shuffle? (read p))])
(unless (relative-path? s)
(error "expected a file name relative path string, got" s))
(let ([len (read p)])
(unless (and (number? len) (integer? len))
(error "expected a file name size, got" len))
(let* ([write? (filter kind s main-collects-parent-dir)]
[path (build-path main-collects-parent-dir s)])
(let* ([write? (filter kind s target-dir)]
[path (build-path target-dir s)])
(let ([out (and write?
(if (file-exists? path)
(if (eq? kind 'file)
@ -147,26 +172,51 @@
(lambda (n)
(unless (eq? n 'mzscheme)
(error "unpacker isn't mzscheme:" n))))]
[target-dir (let ([rel? (call-info info 'plt-relative? (lambda () #f) values)]
[not-user-rel? (call-info info 'plt-home-relative? (lambda () #f) values)])
(if rel?
(if (and not-user-rel?
;; Check for void because old unpacker didn't use
;; the failure thunk.
(not (void? not-user-rel?)))
(get-target-plt-directory main-collects-parent-dir
[target-dir-info
(let ([rel? (call-info info 'plt-relative? (lambda () #f) values)]
[not-user-rel? (call-info info 'plt-home-relative? (lambda () #f) values)]
[test-dirs (call-info info 'test-plt-dirs (lambda () #f) values)])
(if rel?
;; Shuffling...
(if (and not-user-rel?
;; Check for void because old unpacker didn't use
;; the failure thunk.
(not (void? not-user-rel?))
;; Non-user optional if test-dirs are writable
(or (not test-dirs)
(andmap (lambda (p)
(and (string? p)
(let ([dir (let-values ([(base dir)
(shuffle-path main-collects-parent-dir
(lambda (a b) (a))
#t (list p))])
(build-path base dir))])
(memq 'write
(with-handlers ([exn:fail:filesystem? (lambda (x) null)])
(file-or-directory-permissions dir))))))
test-dirs)))
;; Shuffle to main directory always:
(let ([dir (get-target-plt-directory main-collects-parent-dir
main-collects-parent-dir
(list main-collects-parent-dir))
(let ([addons (build-path (find-system-path 'addon-dir)
(version))])
(get-target-plt-directory
(list main-collects-parent-dir))])
(list dir (lambda (sys user)
(let ([a (sys)])
(get-target-plt-directory a a (list a))))))
;; Prefer to shuffle to user directory:
(let ([addons (find-user-collects-dir)])
(let ([dir (get-target-plt-directory
addons
main-collects-parent-dir
(list addons main-collects-parent-dir))))
(get-target-directory)))])
(list addons main-collects-parent-dir))])
(list dir (lambda (sys user)
(let ([a (sys)]
[b (user)])
(get-target-plt-directory b a (list b a))))))))
;; No shuffling --- install to target directory:
(list (get-target-directory))))])
;; Stop if no target directory:
(if target-dir
(if (car target-dir-info)
;; Check declared dependencies (none means v103)
(begin
@ -252,10 +302,15 @@
(let ([u (eval (read p) n)])
(unless (eval `(unit? ,u) n)
(error "expected a unit, got" u))
(make-directory* target-dir)
(make-directory* (car target-dir-info))
(let ([unmztar (lambda (filter)
(unmztar p filter target-dir print-status))])
(eval `(invoke-unit ,u ,target-dir ,unmztar) n))))
(unmztar p filter
(car target-dir-info)
(lambda (a b)
((cadr target-dir-info) a b))
((length target-dir-info) . > . 1)
print-status))])
(eval `(invoke-unit ,u ,(car target-dir-info) ,unmztar) n))))
;; Cancelled: no collections
null))))

2
collects/setup/winvers.ss
View File

@ -22,7 +22,7 @@
(dynamic-require `(lib "winvers-change.ss" "setup") #f)))
(define collects-dir
(path->string (find-main-collects-dir)))
(path->string (find-collects-dir)))
(let ([argv (current-command-line-arguments)])
(cond

7
collects/sgl/make-gl-info.ss
View File

@ -3,6 +3,7 @@
(all-except (lib "file.ss" "dynext") append-c-suffix)
(prefix dynext: (lib "link.ss" "dynext"))
(lib "file.ss")
(lib "dirs.ss" "setup")
(lib "string.ss" "srfi" "13"))
(provide make-gl-info)
@ -87,7 +88,7 @@ end-string
(string-tokenize s)))
(define (get-args which-arg home)
(let ((fp (build-path home "lib" "buildinfo")))
(let ((fp (build-path (find-lib-dir) "buildinfo")))
(cond
((file-exists? fp)
(call-with-input-file fp
@ -108,7 +109,7 @@ end-string
file.c
file.o
`(,@(parse-includes (get-args "X_CFLAGS" home))
,(build-path home "collects" "compiler")))
,(collection-path "compiler")))
(dynext:link-extension #f (list file.o) file.so)
(delete/continue file.o)))
@ -129,7 +130,7 @@ end-string
(let ([t (system-type)])
(if (eq? t 'unix)
;; Check "buildinfo" for USE_GL flag:
(let ([buildinfo (build-path home "lib" "buildinfo")])
(let ([buildinfo (build-path (find-lib-dir) "buildinfo")])
(if (file-exists? buildinfo)
(with-input-from-file buildinfo
(lambda ()

0
teachpack/htdc/Docs/draw.thtml → collects/teachpack/htdc/Docs/draw.thtml
View File

0
teachpack/htdc/Docs/foot.tinc → collects/teachpack/htdc/Docs/foot.tinc
View File

0
teachpack/htdc/Docs/head.tinc → collects/teachpack/htdc/Docs/head.tinc
View File

0
teachpack/htdc/Docs/idraw.thtml → collects/teachpack/htdc/Docs/idraw.thtml
View File

0
teachpack/htdc/Docs/index.thtml → collects/teachpack/htdc/Docs/index.thtml
View File

0
teachpack/htdc/Docs/mkdocs → collects/teachpack/htdc/Docs/mkdocs
View File

0
teachpack/htdc/draw.ss → collects/teachpack/htdc/draw.ss
View File

0
teachpack/htdc/idraw.ss → collects/teachpack/htdc/idraw.ss
View File

0
teachpack/htdp/Docs/arrow-gui.thtml → collects/teachpack/htdp/Docs/arrow-gui.thtml
View File

0
teachpack/htdp/Docs/arrow.thtml → collects/teachpack/htdp/Docs/arrow.thtml
View File

0
teachpack/htdp/Docs/convert.thtml → collects/teachpack/htdp/Docs/convert.thtml
View File

0
teachpack/htdp/Docs/dir.thtml → collects/teachpack/htdp/Docs/dir.thtml
View File

0
teachpack/htdp/Docs/docs.thtml → collects/teachpack/htdp/Docs/docs.thtml
View File

0
teachpack/htdp/Docs/draw.thtml → collects/teachpack/htdp/Docs/draw.thtml
View File

0
teachpack/htdp/Docs/elevator.thtml → collects/teachpack/htdp/Docs/elevator.thtml
View File

0
teachpack/htdp/Docs/foot.tinc → collects/teachpack/htdp/Docs/foot.tinc
View File

0
teachpack/htdp/Docs/graphing.thtml → collects/teachpack/htdp/Docs/graphing.thtml
View File

0
teachpack/htdp/Docs/guess-gui.thtml → collects/teachpack/htdp/Docs/guess-gui.thtml
View File

0
teachpack/htdp/Docs/guess.thtml → collects/teachpack/htdp/Docs/guess.thtml
View File

0
teachpack/htdp/Docs/gui.thtml → collects/teachpack/htdp/Docs/gui.thtml
View File

0
teachpack/htdp/Docs/hangman.thtml → collects/teachpack/htdp/Docs/hangman.thtml
View File

0
teachpack/htdp/Docs/head.tinc → collects/teachpack/htdp/Docs/head.tinc
View File

0
teachpack/htdp/Docs/image.thtml → collects/teachpack/htdp/Docs/image.thtml
View File

0
teachpack/htdp/Docs/index.thtml → collects/teachpack/htdp/Docs/index.thtml
View File

0
teachpack/htdp/Docs/lkup-gui.thtml → collects/teachpack/htdp/Docs/lkup-gui.thtml
View File

0
teachpack/htdp/Docs/master.thtml → collects/teachpack/htdp/Docs/master.thtml
View File

0
teachpack/htdp/Docs/mkdocs → collects/teachpack/htdp/Docs/mkdocs
View File

0
teachpack/htdp/Docs/servlet.thtml → collects/teachpack/htdp/Docs/servlet.thtml
View File

0
teachpack/htdp/Docs/servlet2.thtml → collects/teachpack/htdp/Docs/servlet2.thtml
View File

0
teachpack/htdp/Docs/show-queen.thtml → collects/teachpack/htdp/Docs/show-queen.thtml
View File

0
teachpack/htdp/Docs/world.thtml → collects/teachpack/htdp/Docs/world.thtml
View File

0
teachpack/htdp/arrow-gui.ss → collects/teachpack/htdp/arrow-gui.ss
View File

0
teachpack/htdp/arrow.ss → collects/teachpack/htdp/arrow.ss
View File

0
teachpack/htdp/convert.ss → collects/teachpack/htdp/convert.ss
View File

0
teachpack/htdp/dir.ss → collects/teachpack/htdp/dir.ss
View File

0
teachpack/htdp/docs.ss → collects/teachpack/htdp/docs.ss
View File

0
teachpack/htdp/draw.ss → collects/teachpack/htdp/draw.ss
View File

0
teachpack/htdp/elevator.ss → collects/teachpack/htdp/elevator.ss
View File

0
teachpack/htdp/graphing.ss → collects/teachpack/htdp/graphing.ss
View File

0
teachpack/htdp/guess-gui.ss → collects/teachpack/htdp/guess-gui.ss
View File

0
teachpack/htdp/guess.ss → collects/teachpack/htdp/guess.ss
View File

0
teachpack/htdp/gui.ss → collects/teachpack/htdp/gui.ss
View File

0
teachpack/htdp/hangman.ss → collects/teachpack/htdp/hangman.ss
View File

0
teachpack/htdp/image.ss → collects/teachpack/htdp/image.ss
View File

0
teachpack/htdp/lkup-gui.ss → collects/teachpack/htdp/lkup-gui.ss
View File

0
teachpack/htdp/master.ss → collects/teachpack/htdp/master.ss
View File

0
teachpack/htdp/servlet.ss → collects/teachpack/htdp/servlet.ss
View File

0
teachpack/htdp/servlet2.ss → collects/teachpack/htdp/servlet2.ss
View File

0
teachpack/htdp/show-queen.ss → collects/teachpack/htdp/show-queen.ss
View File

0
teachpack/htdp/world.ss → collects/teachpack/htdp/world.ss
View File

0
teachpack/turtles.ss → collects/teachpack/turtles.ss
View File

0
teachpack/value-turtles.ss → collects/teachpack/value-turtles.ss
View File

0
notes/COPYING-libscheme.txt → doc/release-notes/COPYING-libscheme.txt
View File

0
notes/COPYING.LIB → doc/release-notes/COPYING.LIB
View File

0
notes/drscheme/HISTORY → doc/release-notes/drscheme/HISTORY
View File

0
notes/mred/HISTORY → doc/release-notes/mred/HISTORY
View File

0
notes/mred/MrEd_100.txt → doc/release-notes/mred/MrEd_100.txt
View File

0
notes/mred/MrEd_100_Framework.txt → doc/release-notes/mred/MrEd_100_Framework.txt
View File

0
notes/mzscheme/HISTORY → doc/release-notes/mzscheme/HISTORY
View File

0
notes/mzscheme/MzScheme_200.txt → doc/release-notes/mzscheme/MzScheme_200.txt
View File

0
notes/mzscheme/MzScheme_300.txt → doc/release-notes/mzscheme/MzScheme_300.txt
View File

0
notes/mzscheme/rename-super-fixup.ss → doc/release-notes/mzscheme/rename-super-fixup.ss
View File

0
notes/stepper/DESIGN-NOTES → doc/release-notes/stepper/DESIGN-NOTES
View File

0
notes/stepper/HISTORY → doc/release-notes/stepper/HISTORY
View File

0
notes/teachpack/HISTORY → doc/release-notes/teachpack/HISTORY
View File

24
src/Makefile.in
View File

@ -1,6 +1,20 @@
# Builds MzScheme and MrEd
srcdir = @srcdir@
prefix = @prefix@
exec_prefix = @exec_prefix@
bindir = @bindir@
libdir = @libdir@
includepltdir = @includepltdir@
libpltdir = @libpltdir@
collectsdir = @collectsdir@
mandir = @mandir@
docdir = @docdir@
builddir = @builddir@
ALLDIRINFO = "$(bindir)" "$(collectsdir)" "$(docdir)" "$(libdir)" "$(includepltdir)" "$(libpltdir)" "$(mandir)"
all:
$(MAKE) mz
$(MAKE) mred-stub
@ -23,6 +37,7 @@ install:
$(MAKE) setup-plt
install-normal:
mzscheme/mzscheme -mvqu "$(srcdir)/mkdirs.ss" $(ALLDIRINFO)
if [ ! -d $(prefix) ] ; then mkdir $(prefix) ; fi
$(MAKE) mzinstall
$(MAKE) mredinstall-stub
@ -78,16 +93,11 @@ mrinstall:
mrinstall3m:
cd mred; $(MAKE) install-3m
lib-finish:
@LIBFINISH@ @prefix@/lib
@LIBFINISH@ "$(prefix)/lib"
srcdir = @srcdir@
prefix = @prefix@
copytree:
cp -p -r $(srcdir)/../collects $(prefix)/.
cp -p -r $(srcdir)/../include $(prefix)/.
cp -p -r $(srcdir)/../notes $(prefix)/.
cp -p -r $(srcdir)/../man $(prefix)/.
if [ -d $(srcdir)/../teachpack ] ; then cp -r $(srcdir)/../teachpack $(prefix)/teachpack ; fi
mzscheme/mzscheme -mvqu "$(srcdir)/copytree.ss" "$(srcdir)" $(ALLDIRINFO) @INSTALL_ORIG_TREE@

20
src/README
View File

@ -94,11 +94,12 @@ the Unix instructions below, but note the following:
your shell and PATH setting).
If the --prefix flag is omitted, the binaries are built for an
in-place installation (i.e., the plt directory containing this
README will be used directly). Unless --enable-shared is used, the
plt directory can be moved later; most system administrators
would recommend that you use --enable-shared, but the PLT Scheme
developers distribute binaries built without --enable-shared.
in-place installation (i.e., the parent of the directory
containing this README will be used directly). Unless
--enable-shared is used, the plt directory can be moved later;
most system administrators would recommend that you use
--enable-shared, but the PLT Scheme developers distribute binaries
built without --enable-shared.
The `configure' script generates the makefiles for building
MzScheme and/or MrEd. The current directory at the time
@ -164,6 +165,15 @@ the Unix instructions below, but note the following:
--enabled-shared, beware that you may accumlate many old, unused
versions of the dynamic libraries in plt/lib.
4. [Optional] Run `help-desk' to install missing documentation.
The source distribution (or Subversion-based source) includes only
the release notes, and not the rest of the core documentation.
Run the newly installed `help-desk' and follow the "Manuals" link
to install the rest of the documentation. For a Subversion-based
build, the "Manuals" page includes a link to update previously
installed documentation.
After an "in-place" install without Subversion, the plt/src directory
is no longer needed, and it can be safely deleted. Build information
is recorded in plt/lib/buildinfo.

168
src/configure vendored
View File

@ -314,7 +314,7 @@ ac_subdirs_all="$ac_subdirs_all foreign/gcc/libffi"
ac_subdirs_all="$ac_subdirs_all llvm/llvm"
ac_subdirs_all="$ac_subdirs_all wxcommon/jpeg"
ac_subdirs_all="$ac_subdirs_all wxxt/src/x/wbuild"
ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP CXX CXXFLAGS ac_ct_CXX CXXCPP RANLIB ac_ct_RANLIB PERL X_CFLAGS X_PRE_LIBS X_LIBS X_EXTRA_LIBS PREFLAGS COMPFLAGS PROFFLAGS SED AS AR STATIC_AR ARFLAGS WBUILD CC_FOR_BUILD REZ MZLINKER PLAIN_CC DYN_CFLAGS x_includes x_libraries OPTIONS MZOPTIONS CGCOPTIONS GC2OPTIONS MROPTIONS GCDIR MZBINTARGET MZINSTALLTARGET EXTRA_GMP_OBJ OSX NOT_OSX FRAMEWORK_INSTALL_DIR FRAMEWORK_REL_INSTALL MREDLINKER LIBSFX WXLIBS WXVARIANT ICP MRLIBINSTALL LIBFINISH MAKE_MRED MAKE_MRED3M MAKE_MREDINSTALL MAKE_MREDINSTALL3M MAKE_WBUILD MAKE_COPYTREE MAKE_FINISH WXPRECOMP USE_WXPRECOMP INCLUDEDEP WX_MMD_FLAG JPEG_A JPEG_INC ZLIB_A ZLIB_INC PNG_A OSKHOME EXTRA_OSK_LIBS FOREIGN_OBJSLIB_IF_USED FOREIGN_LIB_IF_USED FOREIGN_OBJSLIB FOREIGN_CONVENIENCE FOREIGNTARGET LIBMZSCHEME_DEP LIBMRED_DEP LLVMTARGET LTO LTA subdirs LIBOBJS LTLIBOBJS'
ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP CXX CXXFLAGS ac_ct_CXX CXXCPP RANLIB ac_ct_RANLIB PERL X_CFLAGS X_PRE_LIBS X_LIBS X_EXTRA_LIBS PREFLAGS COMPFLAGS PROFFLAGS SED AS AR STATIC_AR ARFLAGS WBUILD CC_FOR_BUILD REZ MZLINKER PLAIN_CC DYN_CFLAGS x_includes x_libraries OPTIONS MZOPTIONS CGCOPTIONS GC2OPTIONS MROPTIONS GCDIR MZBINTARGET MZINSTALLTARGET EXTRA_GMP_OBJ OSX NOT_OSX FRAMEWORK_INSTALL_DIR FRAMEWORK_REL_INSTALL INSTALL_ORIG_TREE MREDLINKER LIBSFX WXLIBS WXVARIANT ICP MRLIBINSTALL LIBFINISH MAKE_MRED MAKE_MRED3M MAKE_MREDINSTALL MAKE_MREDINSTALL3M MAKE_WBUILD MAKE_COPYTREE MAKE_FINISH WXPRECOMP USE_WXPRECOMP INCLUDEDEP WX_MMD_FLAG JPEG_A JPEG_INC ZLIB_A ZLIB_INC PNG_A OSKHOME EXTRA_OSK_LIBS FOREIGN_OBJSLIB_IF_USED FOREIGN_LIB_IF_USED FOREIGN_OBJSLIB FOREIGN_CONVENIENCE FOREIGNTARGET LIBMZSCHEME_DEP LIBMRED_DEP LLVMTARGET LTO LTA collectsdir libpltdir includepltdir docdir COLLECTS_PATH subdirs LIBOBJS LTLIBOBJS'
ac_subst_files=''
# Initialize some variables set by options.
@ -819,34 +819,26 @@ _ACEOF
cat <<_ACEOF
Installation directories:
--prefix=TARGETDIR install to TARGETDIR (usually ..../plt)
--prefix=PREFIX install architecture-independent files in PREFIX
[$ac_default_prefix]
--exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
[PREFIX]
By default, \`make install' will install all the files in
\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify
an installation prefix other than \`$ac_default_prefix' using \`--prefix',
for instance \`--prefix=\$HOME'.
For better control, use the options below.
Fine tuning of the installation directories:
--bindir=DIR user executables [EPREFIX/bin]
--datadir=DIR read-only architecture-independent data [PREFIX/share]
--libdir=DIR object code libraries [EPREFIX/lib]
--includedir=DIR C header files [PREFIX/include]
--mandir=DIR man documentation [PREFIX/man]
_ACEOF
cat <<\_ACEOF
X features:
@ -871,6 +863,7 @@ Optional Features:
--enable-libjpeg use libjpeg instead of building (enabled by default)
--enable-shared create shared libraries
--enable-dynlib same as --enable-shared
--enable-origtree install with original directory structure
--enable-foreign compile foreign support (enabled by default)
--enable-llvm compile llvm support (disabled by default)
--enable-sgc use Senora GC instead of the Boehm GC
@ -1399,6 +1392,11 @@ fi;
if test "${enable_dynlib+set}" = set; then
enableval="$enable_dynlib"
fi;
# Check whether --enable-shared or --disable-shared was given.
if test "${enable_shared+set}" = set; then
enableval="$enable_shared"
fi;
# Check whether --enable-foreign or --disable-foreign was given.
@ -5043,6 +5041,7 @@ if test "${enable_xonx}" = "yes" ; then
else
if test "$OS" = "Darwin" ; then
enable_quartz=yes
enable_origtree=yes
fi
fi
@ -5056,31 +5055,66 @@ if test "${enable_perl}" = "" ; then
fi
fi
if test "${prefix}" = "NONE" ; then
prefix=`cd "${srcdir}/.." && pwd`
else
# Check whether ${prefix} is redundant, because
# $prefix/src is $srcdir.
here_inode=`(ls -i -l -d ${srcdir}/. | cut -d d -f 1) 2> /dev/null`
there_inode=`(ls -i -l -d ${prefix}/src | cut -d d -f 1) 2> /dev/null`
if test "${here_inode}" = "${there_inode}" ; then
echo "in-place install, --prefix specification is redundant"
else
echo "----> Installation will go to ${prefix}:"
echo "----> ${prefix}/collects/..."
echo "----> ${prefix}/bin/..."
echo "----> ${prefix}/lib/..."
echo "----> ${prefix}/include/..."
echo "----> ${prefix}/man/..."
echo "----> ${prefix}/notes/..."
MAKE_COPYTREE=copytree
fi
fi
if test "${enable_iconv}" = "" ; then
enable_iconv=yes
fi
############## Install targets ################
unixstyle=no
if test "${prefix}" != "NONE" ; then
if test "${enable_origtree}" != "yes" ; then
unixstyle=yes
fi
fi
if test "${exec_prefix}" != "NONE" ; then
unixstyle=yes
fi
if test "${bindir}" != '${exec_prefix}/bin' ; then
unixstyle=yes
fi
if test "${datadir}" != '${prefix}/share' ; then
unixstyle=yes
fi
if test "${libdir}" != '${exec_prefix}/lib' ; then
unixstyle=yes
fi
if test "${includedir}" != '${prefix}/include' ; then
unixstyle=yes
fi
if test "${mandir}" != '${prefix}/man' ; then
unixstyle=yes
fi
if test "${unixstyle}" = "no" ; then
if test "${prefix}" = "NONE" ; then
inplacebuild=yes
prefix=`cd "${srcdir}/.." && pwd`
else
MAKE_COPYTREE=copytree
fi
bindir='${prefix}/bin'
libpltdir='${prefix}/lib'
collectsdir='${prefix}/collects'
includepltdir='${prefix}/include'
docdir='${prefix}/doc'
mandir='${prefix}/man'
COLLECTS_PATH="../collects"
INSTALL_ORIG_TREE=yes
else
if test "${prefix}" = "NONE" ; then
# Set prefix explicitly so we can use it during configure
prefix="${ac_default_prefix}"
fi
libpltdir="${libdir}/plt"
collectsdir="${libdir}/plt/collects"
includepltdir="${includedir}/plt"
docdir="${datadir}/plt/doc"
MAKE_COPYTREE=copytree
COLLECTS_PATH='${collectsdir}'
INSTALL_ORIG_TREE=no
fi
###### Make sure MrEd is really there ######
if test "${enable_mred}" = "yes" ; then
@ -8561,12 +8595,6 @@ case $OS in
X_LIBS="-L/usr/contrib/X11R6/lib/ $X_LIBS"
;;
CYGWIN*)
# Old cygwin approach, to make it Windows-like instead of Unix-like:
# MZBINTARGET=cygwin-bin
# MZINSTALLTARGET=cygwin-install
# EXTRALIBS="$LIBS gmzwin.exp"
# MZOPTIONS="$MZOPTIONS -DGC_DLL"
# CGCOPTIONS="$CGCOPTIONS -DGC_DLL -DGC_BUILD -DUSE_MSVC_MD_LIBRARY -DMD_LIB_MAIN"
MZINSTALLTARGET=unix-cygwin-install
if test "${enable_shared}" = "yes" ; then
ar_libtool_no_undefined=" -no-undefined"
@ -8634,7 +8662,7 @@ case $OS in
FRAMEWORK_INSTALL_DIR=~/Library/Frameworks
FRAMEWORK_REL_INSTALL=no
else
FRAMEWORK_INSTALL_DIR='${LIBIDIR}'
FRAMEWORK_INSTALL_DIR='${libdir}'
FRAMEWORK_REL_INSTALL=yes
fi
else
@ -11794,6 +11822,13 @@ LIBS="$LIBS $EXTRALIBS"
@ -12636,6 +12671,7 @@ s,@OSX@,$OSX,;t t
s,@NOT_OSX@,$NOT_OSX,;t t
s,@FRAMEWORK_INSTALL_DIR@,$FRAMEWORK_INSTALL_DIR,;t t
s,@FRAMEWORK_REL_INSTALL@,$FRAMEWORK_REL_INSTALL,;t t
s,@INSTALL_ORIG_TREE@,$INSTALL_ORIG_TREE,;t t
s,@MREDLINKER@,$MREDLINKER,;t t
s,@LIBSFX@,$LIBSFX,;t t
s,@WXLIBS@,$WXLIBS,;t t
@ -12671,6 +12707,11 @@ s,@LIBMRED_DEP@,$LIBMRED_DEP,;t t
s,@LLVMTARGET@,$LLVMTARGET,;t t
s,@LTO@,$LTO,;t t
s,@LTA@,$LTA,;t t
s,@collectsdir@,$collectsdir,;t t
s,@libpltdir@,$libpltdir,;t t
s,@includepltdir@,$includepltdir,;t t
s,@docdir@,$docdir,;t t
s,@COLLECTS_PATH@,$COLLECTS_PATH,;t t
s,@subdirs@,$subdirs,;t t
s,@LIBOBJS@,$LIBOBJS,;t t
s,@LTLIBOBJS@,$LTLIBOBJS,;t t
@ -13337,3 +13378,20 @@ echo "$as_me: error: $ac_sub_configure failed for $ac_dir" >&2;}
done
fi
if test "${inplacebuild}" = "yes" ; then
echo ">>> Installation is in-place"
else
echo ">>> Installation targets:"
echo " executables : ${bindir}/..."
echo " Scheme code : ${collectsdir}/..."
echo " core docs : ${docdir}/..."
echo " C libraries : ${libdir}/..."
echo " C headers : ${includepltdir}/..."
echo " extra C objs : ${libpltdir}/..."
echo " man pages : ${mandir}/..."
echo " where prefix = ${prefix}"
if test "${unixstyle}" = "yes" ; then
echo " and exec_prefix = ${exec_prefix}"
fi
fi

54
src/copytree.ss Normal file
View File

@ -0,0 +1,54 @@
(module copytree mzscheme
(define-values (srcdir bindir collectsdir docdir libdir includepltdir libpltdir mandir origtree)
(apply
values
(vector->list (current-command-line-arguments))))
(define pltdir (build-path srcdir 'up))
(define (skip-name? n)
(let ([s (path->bytes n)])
(or (regexp-match #rx#"^[.]svn$" s)
(regexp-match #rx#"^compiled$" s))))
(define (copytree src dest)
(for-each (lambda (n)
(unless (skip-name? n)
(let ([p (build-path src n)])
(cond
[(file-exists? p)
(let ([q (build-path dest n)])
(when (file-exists? q)
(delete-file q))
(copy-file p q)
(let ([t (file-or-directory-modify-seconds p)])
(file-or-directory-modify-seconds q t)))]
[(directory-exists? p)
(let ([q (build-path dest n)])
(unless (directory-exists? q)
(make-directory q))
(copytree p q))]))))
(directory-list src)))
(define (copytree* src dest)
(printf "Copying ~a\n to ~a\n" src dest)
(copytree src dest))
(copytree* (build-path pltdir "collects") collectsdir)
(copytree* (build-path pltdir "doc") docdir)
(copytree* (build-path pltdir "man") mandir)
(unless (equal? origtree "yes")
;; Replace "config.ss"
(with-output-to-file (build-path collectsdir "config" "config.ss")
(lambda ()
(printf "(module config (lib \"configtab.ss\" \"setup\")\n")
(printf " (define doc-dir ~s)\n" docdir)
(printf " (define lib-dir ~s)\n" libpltdir)
(printf " (define include-dir ~s)\n" includepltdir)
(printf " (define bin-dir ~s))\n" bindir))
'truncate/replace))
)

14
src/mkdirs.ss Normal file
View File

@ -0,0 +1,14 @@
(module mkdirs mzscheme
(define dirs (vector->list (current-command-line-arguments)))
(define (make-directory* dir)
(unless (directory-exists? dir)
(let-values ([(base name dir?) (split-path dir)])
(when (path? base)
(make-directory* base))
(printf "Making ~a\n" dir)
(make-directory dir))))
(for-each make-directory* dirs))

40
src/mred/Makefile.in
View File

@ -1,6 +1,11 @@
srcdir = @srcdir@
prefix = @prefix@
exec_prefix = @exec_prefix@
bindir = @bindir@
libdir = @libdir@
libpltdir = @libpltdir@
collectsdir = @collectsdir@
builddir = @builddir@
# for version.mak:
@ -231,17 +236,16 @@ install-no-lib:
echo "no dynamic libs"
install-lib:
cd ..; $(ICP) mred/libmred.@LIBSFX@ `(cd $(prefix); pwd)`/lib/
cd ..; $(ICP) mred/libmred.@LIBSFX@ "$(libdir)"
install_wx_xt:
cd ..; if [ ! -d $(prefix)/bin ] ; then mkdir $(prefix)/bin ; fi
cd ..; rm -f $(prefix)/bin/mred
cd ..; if [ ! -d "$(bindir)" ] ; then mkdir "$(bindir)" ; fi
cd ..; rm -f "$(bindir)/mred"
$(MAKE) @MRLIBINSTALL@
cd ..; $(ICP) mred/mred `(cd $(prefix); pwd)`/bin/
$(MZSCHEME) -mvqu "$(srcdir)/../mzscheme/collects-path.ss" "$(prefix)/bin/mred" ../collects
cd ..; $(ICP) mred/mred "$(bindir)"
$(MZSCHEME) -mvqu "$(srcdir)/../mzscheme/collects-path.ss" "$(prefix)/bin/mred" @COLLECTS_PATH@
LIBIDIR=$(prefix)/lib
BUILDINFO=$(LIBIDIR)/buildinfo
BUILDINFO=$(libpltdir)/buildinfo
MRFWDIR = @FRAMEWORK_INSTALL_DIR@/PLT_MrEd.framework
@ -255,16 +259,16 @@ install_wx_mac:
if [ ! -d $(MRFWDIR) ] ; then mkdir $(MRFWDIR) ; fi
if [ ! -d $(MRFWDIR)/Versions ] ; then mkdir $(MRFWDIR)/Versions ; fi
if [ ! -d $(MRFWDIR)/Versions/$(FWVERSION) ] ; then mkdir $(MRFWDIR)/Versions/$(FWVERSION) ; fi
cd ..; rm -rf $(prefix)/collects/launcher/Starter.app
cd ..; rm -rf $(collectsdir)/launcher/Starter.app
cd ..; rm -rf $(prefix)/MrEd.app
cd ..; $(ICP) -r mred/MrEd.app $(prefix)/.
$(ICP) PLT_MrEd.framework/Versions/$(FWVERSION)/PLT_MrEd $(MRFWDIR)/Versions/$(FWVERSION)/PLT_MrEd
$(ICP) -r PLT_MrEd.framework/Versions/$(FWVERSION)/Resources $(MRFWDIR)/Versions/$(FWVERSION)/Resources
ln -s Versions/$(FWVERSION)/PLT_MrEd $(MRFWDIR)/
ln -s Versions/$(FWVERSION)/Resources $(MRFWDIR)/
if [ ! -d $(prefix)/collects ] ; then mkdir $(prefix)/collects ; fi
if [ ! -d $(prefix)/collects/launcher ] ; then mkdir $(prefix)/collects/launcher ; fi
cd ..; $(ICP) -r mred/Starter.app $(prefix)/collects/launcher/.
if [ ! -d $(collectsdir) ] ; then mkdir $(collectsdir) ; fi
if [ ! -d $(collectsdir)/launcher ] ; then mkdir $(collectsdir)/launcher ; fi
cd ..; $(ICP) -r mred/Starter.app $(collectsdir)/launcher/.
if [ @FRAMEWORK_REL_INSTALL@ = yes ] ; then /usr/bin/install_name_tool -change "@executable_path/../../../PLT_MrEd.framework/Versions/$(FWVERSION)/PLT_MrEd" "@executable_path/../../../lib/PLT_MrEd.framework/Versions/$(FWVERSION)/PLT_MrEd" "$(prefix)/MrEd.app/Contents/MacOS/MrEd" ; fi
$(MZSCHEME) -mvqu "$(srcdir)/../mzscheme/collects-path.ss" "$(prefix)/MrEd.app/Contents/MacOS/MrEd" ../../../collects
@ -286,25 +290,25 @@ install-no-lib3m:
echo "no dynamic libs"
install-lib3m:
cd ..; $(ICP) mred/libmred3m.@LIBSFX@ `(cd $(prefix); pwd)`/lib/
cd ..; $(ICP) mred/libmred3m.@LIBSFX@ "$(libdir)"
install-3m_wx_xt:
cd ..; $(ICP) mred/mred3m $(prefix)/bin/
$(MZSCHEME) -mvqu "$(srcdir)/../mzscheme/collects-path.ss" "$(prefix)/bin/mred3m" ../collects
cd ..; $(ICP) mred/mred3m "$(bindir)"
$(MZSCHEME) -mvqu "$(srcdir)/../mzscheme/collects-path.ss" "$(bindir)/mred3m" @COLLECTS_PATH@
$(MAKE) @MRLIBINSTALL@3m
install-3m_wx_mac:
rm -f $(MRFWDIR)/Versions/$(FWVERSION)_3m/PLT_MrEd
rm -rf $(MRFWDIR)/Versions/$(FWVERSION)_3m/Resources
if [ ! -d $(MRFWDIR)/Versions/$(FWVERSION)_3m ] ; then mkdir $(MRFWDIR)/Versions/$(FWVERSION)_3m ; fi
cd ..; rm -rf $(prefix)/collects/launcher/Starter3m.app
cd ..; rm -rf $(collectsdir)/launcher/Starter3m.app
cd ..; rm -rf $(prefix)/MrEd3m.app
cd ..; $(ICP) -r mred/MrEd3m.app $(prefix)/.
$(ICP) PLT_MrEd.framework/Versions/$(FWVERSION)_3m/PLT_MrEd $(MRFWDIR)/Versions/$(FWVERSION)_3m/PLT_MrEd
$(ICP) -r PLT_MrEd.framework/Versions/$(FWVERSION)_3m/Resources $(MRFWDIR)/Versions/$(FWVERSION)_3m/Resources
if [ ! -d $(prefix)/collects ] ; then mkdir $(prefix)/collects ; fi
if [ ! -d $(prefix)/collects/launcher ] ; then mkdir $(prefix)/collects/launcher ; fi
cd ..; $(ICP) -r mred/Starter3m.app $(prefix)/collects/launcher/.
if [ ! -d $(collectsdir) ] ; then mkdir $(collectsdir) ; fi
if [ ! -d $(collectsdir)/launcher ] ; then mkdir $(collectsdir)/launcher ; fi
cd ..; $(ICP) -r mred/Starter3m.app $(collectsdir)/launcher/.
if [ @FRAMEWORK_REL_INSTALL@ = yes ] ; then /usr/bin/install_name_tool -change "@executable_path/../../../PLT_MrEd.framework/Versions/$(FWVERSION)_3m/PLT_MrEd" "@executable_path/../../../lib/PLT_MrEd.framework/Versions/$(FWVERSION)_3m/PLT_MrEd" "$(prefix)/MrEd3m.app/Contents/MacOS/MrEd3m" ; fi
$(MZSCHEME) -mvqu "$(srcdir)/../mzscheme/collects-path.ss" "$(prefix)/MrEd3m.app/Contents/MacOS/MrEd3m" ../../../collects

56
src/mzscheme/Makefile.in
View File

@ -4,6 +4,12 @@
srcdir = @srcdir@
prefix = @prefix@
exec_prefix = @exec_prefix@
bindir = @bindir@
libdir = @libdir@
includepltdir = @includepltdir@
libpltdir = @libpltdir@
collectsdir = @collectsdir@
builddir = @builddir@
# for version.mak:
@ -200,7 +206,7 @@ mark:
$(MAKE) $(srcdir)/src/mzmark.c
headers:
./mzscheme -qr $(srcdir)/mkincludes.ss $(srcdir)/../.. . $(srcdir)
./mzscheme -qr $(srcdir)/mkincludes.ss "$(includepltdir)" . "$(srcdir)"
$(MAKE) $(srcdir)/../../collects/mzscheme/lib/mzdyn.c
# mzdyn.c, used for MacOS "library"
@ -228,7 +234,7 @@ zo:
3m:
$(MAKE) bin
cd gc2; $(MAKE) all
cd dynsrc; $(MAKE) LIBDIR='$(LIBDIR)' dynlib3m
cd dynsrc; $(MAKE) dynlib3m
cd gc2; $(MAKE) ../mzscheme3m
palmos:
@ -254,9 +260,7 @@ clean@OSX@:
rm -rf PLT_MzScheme.framework
$(MAKE) clean@NOT_OSX@
LIBIDIR=`(cd $(prefix); pwd)`/lib
BINDIR=`(cd $(prefix); pwd)`/bin
BUILDINFO=$(LIBIDIR)/buildinfo
BUILDINFO="$(libpltdir)/buildinfo"
ICP=@ICP@
install:
@ -264,25 +268,23 @@ install:
$(MAKE) @MZINSTALLTARGET@
install-3m-basic:
cd ..; $(ICP) mzscheme/mzscheme3m $(prefix)/bin/mzscheme3m
cd ..; $(ICP) mzscheme/mzdyn3m.o $(prefix)/lib/mzdyn3m.o
./mzscheme -mvqu "$(srcdir)/collects-path.ss" "$(prefix)/bin/mzscheme3m" ../collects
cd ..; $(ICP) mzscheme/mzscheme3m $(bindir)/mzscheme3m
cd ..; $(ICP) mzscheme/mzdyn3m.o $(libpltdir)/mzdyn3m.o
./mzscheme -mvqu "$(srcdir)/collects-path.ss" "$(bindir)/mzscheme3m" @COLLECTS_PATH@
install-3m@NOT_OSX@:
$(MAKE) install-3m-basic
cd ..; $(ICP) mzscheme/libmzscheme3m.@LIBSFX@ $(LIBIDIR)/libmzscheme3m.@LIBSFX@
cd ..; $(ICP) mzscheme/libmzscheme3m.@LIBSFX@ "$(libdir)/libmzscheme3m.@LIBSFX@"
# Prefix might be relative to srcdir, or it might be absolute, so we
# have to go up and install things from there.
unix-install:
cd ..; if [ ! -d $(prefix)/bin ] ; then mkdir $(prefix)/bin ; fi
cd ..; rm -f $(prefix)/bin/mzscheme
cd ..; if [ ! -d $(LIBIDIR) ] ; then mkdir $(LIBIDIR) ; fi
cd ..; $(ICP) mzscheme/libmzgc.@LIBSFX@ $(LIBIDIR)/libmzgc.@LIBSFX@
cd ..; $(ICP) mzscheme/libmzscheme.@LIBSFX@ $(LIBIDIR)/libmzscheme.@LIBSFX@
cd ..; $(ICP) mzscheme/mzscheme "$(BINDIR)/mzscheme"
./mzscheme -mvqu "$(srcdir)/collects-path.ss" "$(BINDIR)/mzscheme" ../collects
cd ..; rm -f $(bindir)/mzscheme
cd ..; $(ICP) mzscheme/libmzgc.@LIBSFX@ "$(libdir)/libmzgc.@LIBSFX@"
cd ..; $(ICP) mzscheme/libmzscheme.@LIBSFX@ "$(libdir)/libmzscheme.@LIBSFX@"
cd ..; $(ICP) mzscheme/mzscheme "$(bindir)/mzscheme"
./mzscheme -mvqu "$(srcdir)/collects-path.ss" "$(bindir)/mzscheme" @COLLECTS_PATH@
cd ..; echo 'CC=@CC@' > $(BUILDINFO)
cd ..; echo 'CFLAGS=@CFLAGS@ @PREFLAGS@ @COMPFLAGS@' >> $(BUILDINFO)
cd ..; echo 'OPTIONS=@OPTIONS@' >> $(BUILDINFO)
@ -292,7 +294,7 @@ unix-install:
normal-install:
$(MAKE) unix-install
cd ..; cp mzscheme/mzdyn.o $(LIBIDIR)/mzdyn.o
cd ..; cp mzscheme/mzdyn.o $(libpltdir)/mzdyn.o
MZFWDIR = @FRAMEWORK_INSTALL_DIR@/PLT_MzScheme.framework
@ -307,7 +309,7 @@ osx-install:
if [ ! -d $(MZFWDIR)/Versions/$(FWVERSION) ] ; then mkdir $(MZFWDIR)/Versions/$(FWVERSION) ; fi
cp $(MZFW) $(MZFWDIR)/Versions/$(FWVERSION)/
ln -s Versions/$(FWVERSION)/PLT_MzScheme $(MZFWDIR)/
if [ @FRAMEWORK_REL_INSTALL@ = yes ] ; then /usr/bin/install_name_tool -change "@executable_path/PLT_MzScheme.framework/Versions/$(FWVERSION)/PLT_MzScheme" "@executable_path/../lib/PLT_MzScheme.framework/Versions/$(FWVERSION)/PLT_MzScheme" "$(BINDIR)/mzscheme" ; fi
if [ @FRAMEWORK_REL_INSTALL@ = yes ] ; then /usr/bin/install_name_tool -change "@executable_path/PLT_MzScheme.framework/Versions/$(FWVERSION)/PLT_MzScheme" "@executable_path/../lib/PLT_MzScheme.framework/Versions/$(FWVERSION)/PLT_MzScheme" "$(bindir)/mzscheme" ; fi
MZFWMMM = PLT_MzScheme.framework/Versions/$(FWVERSION)_3m/PLT_MzScheme
@ -316,23 +318,7 @@ install-3m@OSX@:
rm -f $(MZFWDIR)/Versions/$(FWVERSION)_3m/PLT_MzScheme
if [ ! -d $(MZFWDIR)/Versions/$(FWVERSION)_3m ] ; then mkdir $(MZFWDIR)/Versions/$(FWVERSION)_3m ; fi
cp $(MZFWMMM) $(MZFWDIR)/Versions/$(FWVERSION)_3m/
if [ @FRAMEWORK_REL_INSTALL@ = yes ] ; then /usr/bin/install_name_tool -change "@executable_path/PLT_MzScheme.framework/Versions/$(FWVERSION)_3m/PLT_MzScheme" "@executable_path/../lib/PLT_MzScheme.framework/Versions/$(FWVERSION)_3m/PLT_MzScheme" "$(BINDIR)/mzscheme3m" ; fi
WLIBIDIR=`(cd $(prefix); pwd)`/lib
WBUILDINFO=$(WLIBIDIR)/buildinfo
# OBSOLTE:
cygwin-install:
cd ..; rm -f $(prefix)/mzscheme.exe
cd ..; cp mzscheme/mzscheme.exe $(prefix)/mzscheme.exe
cd ..; cp mzscheme/libmzschxxxxxxx.dll $(prefix)/libmzschxxxxxxx.dll
cd ..; cp mzscheme/libmzgcxxxxxxx.dll $(prefix)/libmzgcxxxxxxx.dll
cd dynsrc; $(MAKE) cygwin-install
cd ..; $(ICP) mzscheme/mzstart.exe `(cd $(prefix); pwd)`/collects/launcher/mzstart.exe
cd ..; if [ ! -d $(WLIBIDIR) ] ; then mkdir $(WLIBIDIR) ; fi
cd ..; echo 'CC=gcc' > $(WBUILDINFO)
cd ..; echo 'CFLAGS=@CFLAGS@ @OPTIONS@' >> $(WBUILDINFO)
cd ..; echo 'LIBS=@LIBS@' >> $(WBUILDINFO)
if [ @FRAMEWORK_REL_INSTALL@ = yes ] ; then /usr/bin/install_name_tool -change "@executable_path/PLT_MzScheme.framework/Versions/$(FWVERSION)_3m/PLT_MzScheme" "@executable_path/../lib/PLT_MzScheme.framework/Versions/$(FWVERSION)_3m/PLT_MzScheme" "$(bindir)/mzscheme3m" ; fi
unix-cygwin-install:
$(MAKE) unix-install

111
src/mzscheme/configure.ac
View File

@ -35,6 +35,7 @@ AC_ARG_ENABLE(libjpeg, [ --enable-libjpeg use libjpeg instead of buildin
AC_ARG_ENABLE(shared, [ --enable-shared create shared libraries])
AC_ARG_ENABLE(dynlib, [ --enable-dynlib same as --enable-shared])
AC_ARG_ENABLE(shared, [ --enable-origtree install with original directory structure])
AC_ARG_ENABLE(foreign, [ --enable-foreign compile foreign support (enabled by default)], , enable_foreign=yes)
AC_ARG_ENABLE(llvm, [ --enable-llvm compile llvm support (disabled by default)], , enable_llvm=no)
@ -108,6 +109,7 @@ if test "${enable_xonx}" = "yes" ; then
else
if test "$OS" = "Darwin" ; then
enable_quartz=yes
enable_origtree=yes
fi
fi
@ -121,31 +123,66 @@ if test "${enable_perl}" = "" ; then
fi
fi
if test "${prefix}" = "NONE" ; then
prefix=`cd "${srcdir}/.." && pwd`
else
# Check whether ${prefix} is redundant, because
# $prefix/src is $srcdir.
here_inode=`(ls -i -l -d ${srcdir}/. | cut -d d -f 1) 2> /dev/null`
there_inode=`(ls -i -l -d ${prefix}/src | cut -d d -f 1) 2> /dev/null`
if test "${here_inode}" = "${there_inode}" ; then
echo "in-place install, --prefix specification is redundant"
else
echo "----> Installation will go to ${prefix}:"
echo "----> ${prefix}/collects/..."
echo "----> ${prefix}/bin/..."
echo "----> ${prefix}/lib/..."
echo "----> ${prefix}/include/..."
echo "----> ${prefix}/man/..."
echo "----> ${prefix}/notes/..."
MAKE_COPYTREE=copytree
fi
fi
if test "${enable_iconv}" = "" ; then
enable_iconv=yes
fi
############## Install targets ################
unixstyle=no
if test "${prefix}" != "NONE" ; then
if test "${enable_origtree}" != "yes" ; then
unixstyle=yes
fi
fi
if test "${exec_prefix}" != "NONE" ; then
unixstyle=yes
fi
if test "${bindir}" != '${exec_prefix}/bin' ; then
unixstyle=yes
fi
if test "${datadir}" != '${prefix}/share' ; then
unixstyle=yes
fi
if test "${libdir}" != '${exec_prefix}/lib' ; then
unixstyle=yes
fi
if test "${includedir}" != '${prefix}/include' ; then
unixstyle=yes
fi
if test "${mandir}" != '${prefix}/man' ; then
unixstyle=yes
fi
if test "${unixstyle}" = "no" ; then
if test "${prefix}" = "NONE" ; then
inplacebuild=yes
prefix=`cd "${srcdir}/.." && pwd`
else
MAKE_COPYTREE=copytree
fi
bindir='${prefix}/bin'
libpltdir='${prefix}/lib'
collectsdir='${prefix}/collects'
includepltdir='${prefix}/include'
docdir='${prefix}/doc'
mandir='${prefix}/man'
COLLECTS_PATH="../collects"
INSTALL_ORIG_TREE=yes
else
if test "${prefix}" = "NONE" ; then
# Set prefix explicitly so we can use it during configure
prefix="${ac_default_prefix}"
fi
libpltdir="${libdir}/plt"
collectsdir="${libdir}/plt/collects"
includepltdir="${includedir}/plt"
docdir="${datadir}/plt/doc"
MAKE_COPYTREE=copytree
COLLECTS_PATH='${collectsdir}'
INSTALL_ORIG_TREE=no
fi
###### Make sure MrEd is really there ######
if test "${enable_mred}" = "yes" ; then
@ -428,12 +465,6 @@ case $OS in
X_LIBS="-L/usr/contrib/X11R6/lib/ $X_LIBS"
;;
CYGWIN*)
# Old cygwin approach, to make it Windows-like instead of Unix-like:
# MZBINTARGET=cygwin-bin
# MZINSTALLTARGET=cygwin-install
# EXTRALIBS="$LIBS gmzwin.exp"
# MZOPTIONS="$MZOPTIONS -DGC_DLL"
# CGCOPTIONS="$CGCOPTIONS -DGC_DLL -DGC_BUILD -DUSE_MSVC_MD_LIBRARY -DMD_LIB_MAIN"
MZINSTALLTARGET=unix-cygwin-install
if test "${enable_shared}" = "yes" ; then
ar_libtool_no_undefined=" -no-undefined"
@ -501,7 +532,7 @@ case $OS in
FRAMEWORK_INSTALL_DIR=~/Library/Frameworks
FRAMEWORK_REL_INSTALL=no
else
FRAMEWORK_INSTALL_DIR='${LIBIDIR}'
FRAMEWORK_INSTALL_DIR='${libdir}'
FRAMEWORK_REL_INSTALL=yes
fi
else
@ -1092,6 +1123,7 @@ AC_SUBST(OSX)
AC_SUBST(NOT_OSX)
AC_SUBST(FRAMEWORK_INSTALL_DIR)
AC_SUBST(FRAMEWORK_REL_INSTALL)
AC_SUBST(INSTALL_ORIG_TREE)
AC_SUBST(MREDLINKER)
AC_SUBST(LIBSFX)
@ -1137,6 +1169,12 @@ AC_SUBST(LLVMTARGET)
AC_SUBST(LTO)
AC_SUBST(LTA)
AC_SUBST(collectsdir)
AC_SUBST(libpltdir)
AC_SUBST(includepltdir)
AC_SUBST(docdir)
AC_SUBST(COLLECTS_PATH)
mk_needed_dir()
{
if test ! -d "$1" ; then
@ -1228,3 +1266,20 @@ if test "${enable_wbuild}" = "yes" ; then
fi
AC_OUTPUT($makefiles)
if test "${inplacebuild}" = "yes" ; then
echo ">>> Installation is in-place"
else
echo ">>> Installation targets:"
echo " executables : ${bindir}/..."
echo " Scheme code : ${collectsdir}/..."
echo " core docs : ${docdir}/..."
echo " C libraries : ${libdir}/..."
echo " C headers : ${includepltdir}/..."
echo " extra C objs : ${libpltdir}/..."
echo " man pages : ${mandir}/..."
echo " where prefix = ${prefix}"
if test "${unixstyle}" = "yes" ; then
echo " and exec_prefix = ${exec_prefix}"
fi
fi

Some files were not shown because too many files have changed in this diff Show More