;; bootstrap.scm -*-scheme-*-
;;
;; This program is free software; you can redistribute it and/or    
;; modify it under the terms of the GNU General Public License as   
;; published by the Free Software Foundation; either version 2 of   
;; the License, or (at your option) any later version.              
;;                                                                  
;; This program 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 General Public License for more details.                     
;;                                                                  
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
;; Free Software Foundation           Voice:  +1-617-542-5942
;; 59 Temple Place - Suite 330        Fax:    +1-617-542-2652
;; Boston, MA  02111-1307,  USA       gnu@gnu.org
;;
;; Minimal startup code. This file should just contain enough code to
;; get gnc:load defined, and the "default" environment setup.  After
;; that *everything* should be loaded via gnc:load, starting with
;; startup.scm

(define (display-slib-error)
        (display "Obtain slib at: http://swissnet.ai.mit.edu/~jaffer/SLIB.html\n")
        (newline)
        (display "If you have slib installed, you may need to create\n")
        (display "a symbolic link named 'slib' from the guile directory\n")
        (display "(usually /usr/share/guile) to the directory where slib\n")
        (display "is installed.\n\n")
        (display "You may also need to run the following command as root:")
        (newline)
        (newline)
        (display "  guile -c \"(use-modules (ice-9 slib)) (require 'new-catalog)\"")
        (newline)
        (newline))

;; Test for slib.
(let* ((try-slib (lambda () (use-modules (ice-9 slib)) (require 'format)))
       (handler (lambda args #f))
       (result (catch #t try-slib handler)))
  (if (not result)
      (begin
        (newline)
        (display "It appears you do not have the 'slib' scheme ")
        (display "library installed.\nYou need slib2c4 or later ")
        (display "to run GnuCash.\n")
        (newline)
        (display-slib-error)
        (exit 1))))

;; This variable determines whether slib-backup.scm gets loaded.
(define gnc:*load-slib-backup* #f)

;; Test for slib >= 2c6.
(let* ((try-slib (lambda () (require 'printf) (sprintf #f "test")))
       (handler (lambda args #f))
       (result (catch #t try-slib handler)))
  (if (not result)
      (set! gnc:*load-slib-backup* #t)))

;; Test for simple-format
(if (not (defined? 'simple-format))
    (begin
      (require 'format)
      (define simple-format format)))

(define (build-path firstelement . restofpath)
  (define separator "/")
  (define (bp first rest)
    (if (null? rest)
	first
	(bp 	
	 (string-append first separator (car rest))
	 (cdr rest))))
  (if (null? restofpath)
      firstelement
      (bp 
       (string-append firstelement separator
		      (car restofpath))
       (cdr restofpath))))

;; In pre 1.3 guile's you have to do this manually, unless you call
;; scm_shell, which we can't.
(if (or (string=? (version) "1.2")
        (string=? (version) "1.3a"))
    (let ((boot-file (if (assoc 'prefix %guile-build-info)
                         (string-append (cdr (assoc 'prefix %guile-build-info))
                                        "/share/guile/"
                                        (version)
                                        "/ice-9/boot-9.scm")
                         "/usr/share/guile/1.3a/ice-9/boot-9.scm")))
      (primitive-load boot-file)))

;; Automatically generated defaults
(define gnc:_config-dir-default_ "@-GNC_CONFIGDIR-@")
(define gnc:_share-dir-default_ "@-GNC_SHAREDIR-@")
(define gnc:_help-dir-default_ "@-GNC_HELPDIR-@")
(define gnc:version "@-VERSION-@")

(set! %load-path
      (cons (string-append gnc:_share-dir-default_ "/guile-modules")
            %load-path))

;; These will be converted to config vars later (see prefs.scm)
(define gnc:*load-path* #f)
(define gnc:*debugging?* (if (getenv "GNC_DEBUG") #t #f))

;; Function to get debugging
(define (gnc:debugging?)
  (if (boolean? gnc:*debugging?*)
      gnc:*debugging?*
      (gnc:config-var-value-get gnc:*debugging?*)))

(define (gnc:setup-debugging)
  (if (gnc:debugging?)
      (debug-enable 'backtrace)))

;; These are needed for a guile 1.3.4 bug
(debug-enable 'debug)
(read-enable 'positions)

(debug-set! maxdepth 100000)
(debug-set! stack    2000000)

(gnc:setup-debugging)


;;;; Status output functions.

(define (gnc:warn . items)
  (display "gnucash: [W] ")
  (for-each (lambda (i) (write i)) items)
  (newline))

(define (gnc:error . items)
  (display "gnucash: [E] ")
  (for-each (lambda (i) (write i)) items)
  (newline))

(define (gnc:msg . items)
  (display "gnucash: [M] ")
  (for-each (lambda (i) (write i)) items)
  (newline))

(define (gnc:debug . items)
  (if (gnc:debugging?)
      (begin
        (display "gnucash: [D] ")
        (for-each (lambda (i) (write i)) items)
        (newline))))


;; Set up timing functions

(define gnc:*last-time* (gettimeofday))

(define (gnc:timestamp . stuff)
  (let* ((now (gettimeofday))
         (delta (+ (- (car now) (car gnc:*last-time*))
                   (/ (- (cdr now) (cdr gnc:*last-time*)) 1000000))))
    (gnc:msg stuff "-- Elapsed time: " delta "seconds.")
    (set! gnc:*last-time* now)))


;;; Set up gnc:load.

(define (gnc:find-in-directories file directories)
  "Find file named 'file' anywhere in 'directories'.  'file' must be a
string and 'directories' must be a list of strings."

  (gnc:debug "gnc:find-in-directories looking for " file " in " directories)

  (do ((rest directories (cdr rest))
       (finished? #f)
       (result #f))
      ((or (null? rest) finished?) result)

    (let ((file-name (string-append (car rest) "/" file)))
      (gnc:debug "  checking for " file-name)
      (if (access? file-name F_OK)
          (begin
            (gnc:debug "found file " file-name)
            (set! finished? #t)
            (set! result file-name))))))

(define (gnc:load name)
  "Name must be a string.  The system attempts to locate the file of
the given name and load it.  The system will attempt to locate the
file in all of the directories specified by gnc:*load-path*."

  (define (make-thunk file-name)
    (lambda () (primitive-load file-name) #t))

  (define (handler key . args)
    (apply display-error #f (current-error-port) args)
    #f)

  (let* ((path (if (list? gnc:*load-path*)
                   gnc:*load-path*
                   (gnc:config-var-value-get gnc:*load-path*)))
         (file-name (gnc:find-in-directories name path)))
    (if (not file-name)
        #f
        (if 
         (catch #t (make-thunk file-name) handler)
         (begin
           (gnc:debug "loaded file " file-name)
           #t)
         (begin
           (gnc:warn "failure loading " file-name)
           #f)))))

(define (gnc:_expand-load-path_ new-path)
  (let ((load-path-interpret
         (lambda (item)
           (cond ((string? item) (list item))
                 ((symbol? item)
                  (case item
                    ((default)
                     (list
                      (string-append (getenv "HOME") "/.gnucash")
                      (string-append (getenv "HOME") "/.gnucash/scm")
                      (string-append gnc:_share-dir-default_ "/scm")))
                    ((current)
                     (if (list? gnc:*load-path*)
                         gnc:*load-path*
                         (gnc:config-var-value-get gnc:*load-path*)))
                    (else
                     (gnc:warn "bad item " item " in load-path.  Ignoring.")
                     '())))
                 (else 
                  (gnc:warn "bad item " item " in load-path.  Ignoring.")
                  '())))))
    (apply append (map load-path-interpret new-path))))

(let* ((load-path-override (getenv "GNC_SCM_LOAD_PATH"))
       (new-path (if load-path-override
                     (call-with-input-string
                      load-path-override (lambda (p) (read p)))
                     '(default))))
  (set! gnc:*load-path* (gnc:_expand-load-path_ new-path)))
