add compiler/exe-dylib-path

Provide a clean interface to a private library for updating
dynamic-library paths in Mac executables.

pkgs/racket-doc/scribblings/raco/exe-dylib-path.scrbl

@@ -0,0 +1,36 @@
+#lang scribble/manual
+@(require "common.rkt"
+          (for-label racket/base
+                     racket/contract
+                     compiler/exe-dylib-path))
+
+@title[#:tag "exe-dylib-path"]{Mac OS X Dynamic Library Paths}
+
+@defmodule[compiler/exe-dylib-path]{The
+@racketmodname[compiler/exe-dylib-path] library provides functions for
+reading and adjusting dynamic-library references in a Mac OS X
+executable.}
+
+@history[#:added "6.2.900.9"]
+
+@defproc[(find-matching-library-path [exe-path path-string?]
+                                     [library-str string?])
+         (or/c #f string?)]{
+
+Searches dynamic-linking information in @racket[exe-path] for a
+library reference whose name includes @racket[library-str] and returns
+the executable's path to the library for the first match. If no match is
+found, the result is @racket[#f].}
+
+@defproc[(update-matching-library-path [exe-path path-string?]
+                                       [library-str string?]
+                                       [library-path-str string?])
+         void?]{
+
+Searches dynamic-linking information in @racket[exe-path] for each
+library reference whose name includes @racket[library-str] and replaces
+the executable's path to that library with @racket[library-path-str].
+
+A single match is expected, and the update assumes enough space for
+the new path, perhaps because the executable is linked with
+@Flag{headerpad_max_install_names}.}

pkgs/racket-doc/scribblings/raco/exe.scrbl

@@ -176,3 +176,5 @@ The @exec{raco exe} command accepts the following command-line flags:
 
 @include-section["exe-api.scrbl"]
 @include-section["launcher.scrbl"]
+@include-section["exe-dylib-path.scrbl"]
+

racket/collects/compiler/exe-dylib-path.rkt

@@ -0,0 +1,17 @@
+#lang racket/base
+(require racket/contract/base
+         "private/macfw.rkt")
+
+(provide
+ (contract-out
+  [find-matching-library-path (path-string? string? . -> . (or/c #f string?))]
+  [update-matching-library-path (path-string? string? string? . -> . void?)]))
+
+(define (find-matching-library-path exe str)
+  (get-current-framework-path exe str))
+
+(define (update-matching-library-path exe str new-str)
+  (update-framework-path new-str #:as-given? #t
+                         exe
+                         #f
+                         #:matching (list str)))

racket/collects/compiler/private/macfw.rkt

@@ -14,7 +14,10 @@
 			     (vector-ref v 1)
 			     (equal? (vector-ref v 2) "mred"))))
 
-  (define (update-framework-path fw-path dest mred?)
+  (define (update-framework-path fw-path #:as-given? [as-given? #f]
+                                 dest
+                                 mred?
+                                 #:matching [matchings '("Racket")])
     (let ([dest (if (path? dest)
 		    (path->string dest)
 		    dest)])
@@ -25,9 +28,11 @@
 				 "")]
 			 [old-path (or orig
 				       (format "~a.framework/Versions/~a~a/~a" p (version) 3m p))]
-			 [new-path (format "~a~a.framework/Versions/~a~a/~a" 
-					   fw-path
-					   p (version) 3m p)])
+			 [new-path (if as-given?
+                                       (format "~a" fw-path)
+                                       (format "~a~a.framework/Versions/~a~a/~a" 
+                                               fw-path
+                                               p (version) 3m p))])
 		    (get/set-dylib-path dest
 					(byte-regexp
 					 (bytes-append
@@ -36,16 +41,11 @@
 					   (regexp-quote old-path))
 					  #"$"))
 					(string->bytes/utf-8 new-path))))
-                '("Racket"))))
+                matchings)))
 
   (define (get-current-framework-path dest p)
     (let ([v (get/set-dylib-path dest
 				 (byte-regexp (string->bytes/utf-8 p))
 				 #f)])
-      (if (pair? v)
-	  (bytes->string/utf-8 (car v))
-	  (begin
-            (eprintf "warning: cannot find existing link for ~a in ~a\n"
-                     p dest)
-            #f)))))
-
+      (and (pair? v)
+           (bytes->string/utf-8 (car v))))))