meta/guile-config.in

   1 #!/bin/sh
   2 PKG_CONFIG_PATH="@pkgconfigdir@:$PKG_CONFIG_PATH"
   3 GUILE_AUTO_COMPILE=0
   4 export PKG_CONFIG_PATH GUILE_AUTO_COMPILE
   5
   6 exec "@installed_guile@" -e main -s $0 "$@"
   7 !#
   8 ;;;; guile-config --- utility for linking programs with Guile
   9 ;;;; Jim Blandy <jim@red-bean.com> --- September 1997
  10 ;;;;
  11 ;;;;    Copyright (C) 1998, 2001, 2004, 2005, 2006, 2008, 2009, 2011 Free Software Foundation, Inc.
  12 ;;;;
  13 ;;;; This library is free software; you can redistribute it and/or
  14 ;;;; modify it under the terms of the GNU Lesser General Public
  15 ;;;; License as published by the Free Software Foundation; either
  16 ;;;; version 3 of the License, or (at your option) any later version.
  17 ;;;;
  18 ;;;; This library is distributed in the hope that it will be useful,
  19 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 ;;;; Lesser General Public License for more details.
  22 ;;;;
  23 ;;;; You should have received a copy of the GNU Lesser General Public
  24 ;;;; License along with this library; if not, write to the Free
  25 ;;;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  26 ;;;; Boston, MA 02110-1301 USA
  27
  28 ;;; This script has been deprecated. Just use pkg-config.
  29
  30 (use-modules (ice-9 popen)
  31              (ice-9 rdelim))
  32
  33 \f
  34 (define %pkg-config-program "@PKG_CONFIG@")
  35
  36 ;;;; main function, command-line processing
  37
  38 ;;; The script's entry point.
  39 (define (main args)
  40   (set-program-name! (car args))
  41   (let ((args (cdr args)))
  42     (cond
  43      ((null? args) (show-help '())
  44                    (quit 1))
  45      ((assoc (car args) command-table)
  46       => (lambda (row)
  47            (set! subcommand-name (car args))
  48            ((cadr row) (cdr args))))
  49      (else (show-help '())
  50            (quit 1)))))
  51
  52 (define program-name #f)
  53 (define subcommand-name #f)
  54
  55 ;;; Given an executable path PATH, set program-name to something
  56 ;;; appropriate f or use in error messages (i.e., with leading
  57 ;;; directory names stripped).
  58 (define (set-program-name! path)
  59   (set! program-name (basename path)))
  60
  61 (define (show-help args)
  62   (cond
  63    ((null? args) (show-help-overview))
  64    ((assoc (car args) command-table)
  65     => (lambda (row) ((caddr row))))
  66    (else
  67     (show-help-overview))))
  68
  69 (define (show-help-overview)
  70   (display-line-error "Usage: ")
  71   (for-each (lambda (row) ((cadddr row)))
  72             command-table))
  73
  74 (define (usage-help)
  75   (let ((dle display-line-error)
  76         (p program-name))
  77     (dle "  " p " --help      - show usage info (this message)")
  78     (dle "  " p " --help SUBCOMMAND - show help for SUBCOMMAND")))
  79
  80 (define guile-module "guile-2.2")
  81
  82 (define (pkg-config . args)
  83   (let* ((real-args (cons %pkg-config-program args))
  84          (pipe (apply open-pipe* OPEN_READ real-args))
  85          (output (read-delimited "" pipe))
  86          (ret (close-pipe pipe)))
  87     (case (status:exit-val ret)
  88       ((0) (if (eof-object? output) "" output))
  89       (else (display-line-error
  90              (format #f "error: ~s exited with non-zero error code ~A"
  91                      (cons %pkg-config-program args) (status:exit-val ret)))
  92             ;; assume pkg-config sent diagnostics to stdout
  93             (exit (status:exit-val ret))))))
  94
  95 (define (show-version args)
  96   (format (current-error-port) "~A - Guile version ~A"
  97           program-name (pkg-config "--modversion" guile-module)))
  98
  99 (define (help-version)
 100   (let ((dle display-line-error))
 101     (dle "Usage: " program-name " --version")
 102     (dle "Show the version of this script.  This is also the version of")
 103     (dle "Guile this script was installed with.")))
 104
 105 (define (usage-version)
 106   (display-line-error
 107    "  " program-name " --version   - show installed script and Guile version"))
 108
 109 \f
 110 ;;;; the "link" subcommand
 111
 112 ;;; Write a set of linker flags to standard output to include the
 113 ;;; libraries that libguile needs to link against.
 114 ;;;
 115 ;;; In the long run, we want to derive these flags from Guile module
 116 ;;; declarations files that are installed along the load path.  For
 117 ;;; now, we're just going to reach into Guile's configuration info and
 118 ;;; hack it out.
 119 (define (build-link args)
 120   (display (apply pkg-config "--libs" guile-module args)))
 121
 122 (define (help-link)
 123   (let ((dle display-line-error))
 124     (dle "Usage: " program-name " link")
 125     (dle "Print linker flags for building the `guile' executable.")
 126     (dle "Print the linker command-line flags necessary to link against")
 127     (dle "the Guile library, and any other libraries it requires.")))
 128
 129 (define (usage-link)
 130   (display-line-error
 131    "  " program-name " link        - print libraries to link with"))
 132
 133
 134 \f
 135 ;;;; The "compile" subcommand
 136
 137 (define (build-compile args)
 138   (display (apply pkg-config "--cflags" guile-module args)))
 139
 140 (define (help-compile)
 141   (let ((dle display-line-error))
 142     (dle "Usage: " program-name " compile")
 143     (dle "Print C compiler flags for compiling code that uses Guile.")
 144     (dle "This includes any `-I' flags needed to find Guile's header files.")))
 145
 146 (define (usage-compile)
 147   (display-line-error
 148    "  " program-name " compile     - print C compiler flags to compile with"))
 149
 150 \f
 151 ;;;; The "info" subcommand
 152
 153 (define (build-info args)
 154   (cond
 155    ((null? args)
 156     (display-line-error "guile-config info with no args has been removed")
 157     (quit 2))
 158    ((null? (cdr args))
 159     (cond
 160      ((string=? (car args) "guileversion")
 161       (display (pkg-config "--modversion" guile-module)))
 162      (else
 163       (display (pkg-config (format #f "--variable=~A" (car args))
 164                            guile-module)))))
 165    (else (display-line-error "Usage: " program-name " info VAR")
 166          (quit 2))))
 167
 168 (define (help-info)
 169   (let ((d display-line-error))
 170     (d "Usage: " program-name " info VAR")
 171     (d "Display the value of the pkg-config variable VAR used when Guile")
 172     (d "was built.\n")
 173     (d "Use this command to find out where Guile was installed,")
 174     (d "where it will look for Scheme code at run-time, and so on.")))
 175
 176 (define (usage-info)
 177   (display-line-error
 178    "  " program-name " info VAR    - print Guile build directories"))
 179
 180 \f
 181 ;;;; trivial utilities
 182
 183 (define (display-line . args)
 184   (apply display-line-port (current-output-port) args))
 185
 186 (define (display-line-error . args)
 187   (apply display-line-port (current-error-port) args))
 188
 189 (define (display-line-port port . args)
 190   (for-each (lambda (arg) (display arg port))
 191             args)
 192   (newline port))
 193
 194 \f
 195 ;;;; the command table
 196
 197 ;;; We define this down here, so Guile builds the list after all the
 198 ;;; functions have been defined.
 199 (define command-table
 200   (list
 201    (list "--version" show-version help-version usage-version)
 202    (list "--help" show-help show-help-overview usage-help)
 203    (list "link" build-link help-link usage-link)
 204    (list "compile" build-compile help-compile usage-compile)
 205    (list "info" build-info help-info usage-info)))
 206
 207 \f
 208 ;;; Local Variables:
 209 ;;; mode: scheme
 210 ;;; End: