~rotty/guile-gnome/glib

« back to all changes in this revision

Viewing changes to gnome.scm.in

  • Committer: Andy Wingo
  • Date: 2005-01-10 04:51:01 UTC
  • mfrom: (27.1.32)
  • Revision ID: Arch-1:guile-gnome-devel@gnu.org--2005%glib--dev--0--patch-1
merge from wingo@pobox.com--2005-main
Patches applied:

 * wingo@pobox.com--2004-main/guile-gnome-glib--dev--0--patch-23
   (gnome-$version)

 * wingo@pobox.com--2004-main/guile-gnome-glib--dev--0--patch-24
   Fix it right this time

 * wingo@pobox.com--2004-main/guile-gnome-glib--dev--0--patch-25
   VERSION, record_check, no /usr/local hack

 * wingo@pobox.com--2004-main/guile-gnome-glib--dev--0--patch-26
   Merge from guile-gnome-devel@gnu.org--2004/glib--dev--0, janneke@gnu.org--2004-gnome/glib--dev--0, janneke@gnu.org--2004-lilypond/glib--janneke--0

 * wingo@pobox.com--2004-main/guile-gnome-glib--dev--0--patch-27
   iochannel fixes

 * wingo@pobox.com--2004-main/guile-gnome-glib--dev--0--patch-28
   Indentation, iochannel fixes; examples dist fix

 * wingo@pobox.com--2004-main/guile-gnome-glib--dev--0--patch-29
   wrap-custom-boxed!, gnome-0.scm fixes, custom gvalue wrappers

 * wingo@pobox.com--2004-main/guile-gnome-glib--dev--0--patch-30
   2.7.97, last-minute fixeroo

 * wingo@pobox.com--2005-main/guile-gnome-glib--dev--0--base-0
   tag of wingo@pobox.com--2004-main/guile-gnome-glib--dev--0--patch-30

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
;; guile-gnome        -*- scheme -*-
 
2
;; Copyright (C) 2003,2004 Andy Wingo <wingo at pobox dot com>
 
3
 
 
4
;; This program is free software; you can redistribute it and/or    
 
5
;; modify it under the terms of the GNU General Public License as   
 
6
;; published by the Free Software Foundation; either version 2 of   
 
7
;; the License, or (at your option) any later version.              
 
8
;;                                                                  
 
9
;; This program is distributed in the hope that it will be useful,  
 
10
;; but WITHOUT ANY WARRANTY; without even the implied warranty of   
 
11
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    
 
12
;; GNU General Public License for more details.                     
 
13
;;                                                                  
 
14
;; You should have received a copy of the GNU General Public License
 
15
;; along with this program; if not, contact:
 
16
;;
 
17
;; Free Software Foundation           Voice:  +1-617-542-5942
 
18
;; 59 Temple Place - Suite 330        Fax:    +1-617-542-2652
 
19
;; Boston, MA  02111-1307,  USA       gnu@gnu.org
 
20
 
 
21
;;; Commentary:
 
22
;;
 
23
;;API version @API_VERSION@ of guile-gnome. Use this module before using
 
24
;;any other guile-gnome modules.
 
25
;;
 
26
;;; Code:
 
27
 
 
28
;; Although resolve-module would create (gnome) if it's not found, guile
 
29
;; 1.6 will still search for a lib named libgnome.so before giving up.
 
30
;; Avoid this problem by making sure (gnome) is defined.
 
31
(define-module (gnome))
 
32
 
 
33
(define-module (gnome-@API_VERSION@))
 
34
 
 
35
(define (ld-library-path-prepend! path)
 
36
  (let ((ld-library-path (getenv "LD_LIBRARY_PATH")))
 
37
    (if ld-library-path
 
38
        (setenv "LD_LIBRARY_PATH" (format #f "~A:~A"
 
39
                                          path ld-library-path))
 
40
        (setenv "LD_LIBRARY_PATH" path))))
 
41
 
 
42
;; Add path to the load path, preserving any modification that the user
 
43
;; already made via environment variables. Necessary so that
 
44
;; GUILE_LOAD_PATH munging during build works even after (gnome-0)
 
45
;; munges the path itself.
 
46
(define (add-to-load-path! path)
 
47
  (let ((first-std-path (in-vicinity
 
48
                         (assq-ref %guile-build-info 'pkgdatadir)
 
49
                         "site")))
 
50
    (let lp ((tail %load-path) (head '()))
 
51
      (cond
 
52
       ((null? tail)
 
53
        (set! %load-path (cons path %load-path)))
 
54
       ((string=? (car tail) first-std-path)
 
55
        (set! %load-path (append (reverse head) (cons path tail))))
 
56
       (else
 
57
        (lp (cdr tail) (cons (car tail) head)))))))
 
58
                 
 
59
(define version "@API_VERSION@")
 
60
 
 
61
(cond
 
62
 ((module-variable (resolve-module '(gnome)) 'gnome-version)
 
63
  =>
 
64
  (lambda (v)
 
65
    (if (not (string=? (variable-ref v) version))
 
66
        (error "Loading guile-gnome version ~A, but ~A was already loaded"
 
67
               (variable-ref v) version))))
 
68
 
 
69
 (@running-uninstalled@ ;; #t if we are uninstalled
 
70
  (module-define! (resolve-module '(gnome)) 'gnome-version version)
 
71
  #t) ;; we're building guile-gnome, let the build scripts do their hacks
 
72
 
 
73
 (else
 
74
  (module-define! (resolve-module '(gnome)) 'gnome-version version)
 
75
 
 
76
  (let ((guile-gnome-dir "@guilegnomedir@")
 
77
        (guile-gnome-lib-dir "@guilegnomelibdir@")
 
78
        (libdir "@libdir@"))
 
79
 
 
80
    (add-to-load-path! guile-gnome-dir)
 
81
 
 
82
    ;; Resolve (gnome gw ...) wrapper links to libguile-gnome-gobject.
 
83
    (if (not (member libdir '("/usr/lib" "/usr/local/lib")))
 
84
        (ld-library-path-prepend! libdir))
 
85
  
 
86
    ;; Resolve (gnome gw ...) wrappers.
 
87
    (ld-library-path-prepend! guile-gnome-lib-dir))))