!#
;;;; guile-config --- utility for linking programs with Guile
;;;; Jim Blandy <jim@red-bean.com> --- September 1997
+;;;;
+;;;; Copyright (C) 1998, 2001, 2004, 2005 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 2.1 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
;;; TODO:
;;; * Add some plausible structure for returning the right exit status,
;;; now, we're just going to reach into Guile's configuration info and
;;; hack it out.
(define (build-link args)
- (if (> (length args) 0)
- (error
- (string-append program-name
- " link: arguments to subcommand not yet implemented")))
;; If PATH has the form FOO/libBAR.a, return the substring
;; BAR, otherwise return #f.
(let* ((base (basename path))
(len (string-length base)))
(if (and (> len 5)
- (string=? (make-shared-substring base 0 3) "lib")
- (string=? (make-shared-substring base (- len 2)) ".a"))
- (make-shared-substring base 3 (- len 2))
+ (string=? (substring base 0 3) "lib")
+ (string=? (substring base (- len 2)) ".a"))
+ (substring base 3 (- len 2))
#f)))
- (let* ((flags
- (let loop ((libs
- ;; Get the string of linker flags we used to build
- ;; Guile, and break it up into a list.
- (separate-fields-discarding-char #\space
- (get-build-info 'LIBS)
- list)))
-
- (cond
- ((null? libs) '())
-
- ;; Turn any "FOO/libBAR.a" elements into "-lBAR".
- ((match-lib (car libs))
- => (lambda (bar)
- (cons (string-append "-l" bar)
- (loop (cdr libs)))))
-
- ;; Remove any empty strings that may have seeped in there.
- ((string=? (car libs) "") (loop (cdr libs)))
-
- (else (cons (car libs) (loop (cdr libs)))))))
-
- ;; Include libguile itself in the list, along with the
- ;; directory it was installed in.
- (flags (cons (string-append "-L" (get-build-info 'libdir))
- (cons (string-append "-R" (get-build-info 'libdir))
- (cons "-lguile" flags)))))
+ (if (> (length args) 0)
+ (error
+ (string-append program-name
+ " link: arguments to subcommand not yet implemented")))
+ (let ((libdir (get-build-info 'libdir))
+ (other-flags
+ (let loop ((libs
+ ;; Get the string of linker flags we used to build
+ ;; Guile, and break it up into a list.
+ (separate-fields-discarding-char #\space
+ (get-build-info 'LIBS)
+ list)))
+
+ (cond
+ ((null? libs) '())
+
+ ;; Turn any "FOO/libBAR.a" elements into "-lBAR".
+ ((match-lib (car libs))
+ => (lambda (bar)
+ (cons (string-append "-l" bar)
+ (loop (cdr libs)))))
+
+ ;; Remove any empty strings that may have seeped in there.
+ ((string=? (car libs) "") (loop (cdr libs)))
+
+ (else (cons (car libs) (loop (cdr libs))))))))
+
+ ;; Include libguile itself in the list, along with the directory
+ ;; it was installed in, but do *not* add /usr/lib since that may
+ ;; prevent other programs from specifying non-/usr/lib versions
+ ;; via their foo-config scripts. If *any* app puts -L/usr/lib in
+ ;; the output of its foo-config script then it may prevent the use
+ ;; a non-/usr/lib install of anything that also has a /usr/lib
+ ;; install. For now we hard-code /usr/lib, but later maybe we can
+ ;; do something more dynamic (i.e. what do we need.
+
;; Display the flags, separated by spaces.
- (display-separated flags)
+ (display (string-join
+ (list
+ (get-build-info 'CFLAGS)
+ "-lguile -lltdl"
+ (if (string=? libdir "/usr/lib/")
+ ""
+ (string-append "-L" (get-build-info 'libdir)))
+ (string-join other-flags)
+
+ )))
(newline)))
+
(define (help-link)
(let ((dle display-line-error))
(dle "Usage: " program-name " link")
(error
(string-append program-name
" compile: no arguments expected")))
- (display-line "-I" (get-build-info 'includedir)))
+
+ ;; See gcc manual wrt fixincludes. Search for "Use of
+ ;; `-I/usr/include' may cause trouble." For now we hard-code this.
+ ;; Later maybe we can do something more dynamic.
+ (display
+ (string-append
+ (if (not (string=? (get-build-info 'includedir) "/usr/include"))
+ (string-append "-I" (get-build-info 'includedir) " ")
+ " ")
+
+ (get-build-info 'CFLAGS)
+ "\n"
+ )))
(define (help-compile)
(let ((dle display-line-error))
(define (display-line-port port . args)
(for-each (lambda (arg) (display arg port))
args)
- (newline))
-
-(define (display-separated args)
- (let loop ((args args))
- (cond ((null? args))
- ((null? (cdr args)) (display (car args)))
- (else (display (car args))
- (display " ")
- (loop (cdr args))))))
+ (newline port))
\f
;;;; the command table
HCoop / bpt / guile.git / blobdiff