;; 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-module (gnucash bootstrap))

(use-modules (ice-9 slib))
(use-modules (g-wrapped gw-gnc))
(use-modules (g-wrapped gw-runtime))

;; from bootstrap.scm
(export gnc:version)
(export gnc:debugging?)
(export gnc:warn)
(export gnc:error)
(export gnc:msg)
(export gnc:debug)
(export build-path)
(export gnc:load)
(export gnc:use-module-here!)

;; from main.scm
(export gnc:main)

;; from path.scm
(export gnc:make-home-dir)
(export gnc:current-config-auto)

;; from command-line.scm
(export gnc:*command-line-remaining*)
(export gnc:*config-dir*)
(export gnc:*share-dir*)

;; from doc.scm
(export gnc:find-doc-file)
(export gnc:load-help-topics)

;; from extensions.scm
(export gnc:extension-type)
(export gnc:extension-name)
(export gnc:extension-documentation)
(export gnc:extension-path)
(export gnc:extension-script)

;; from main-window.scm
(export gnc:find-acct-tree-window-options)
(export gnc:make-new-acct-tree-window)  
(export gnc:free-acct-tree-window)
(export gnc:main-window-save-state)

;; from printing/print-check.scm
(export make-print-check-format)
(export gnc:print-check)

;; from tip-of-the-day.scm
(export gnc:get-current-tip)
(export gnc:increment-tip-number)
(export gnc:decrement-tip-number)

(define gnc:use-guile-module-here!
  ;; FIXME: this should be a temporary fix.  We need to check to see
  ;; if there's a more approved way to do this.  As I recall, there's
  ;; not, but I belive a better way will be added to Guile soon.

  ;; module == '(ice-9 slib)
  (cond
   ((or (string=? "1.3" (version))
        (string=? "1.3.4" (version))
        (string=? "1.4" (version)))
    (lambda (module)
      (process-use-modules (list module))))
   (else
    (lambda (module)
      (process-use-modules (list (list module)))))))

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

;; 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:_lib-dir-default_ "@-GNC_LIB_INSTALLDIR-@")
(define gnc:_pkglib-dir-default_ "@-GNC_PKGLIB_INSTALLDIR-@")

(define gnc:version "@-VERSION-@")

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

;(simple-format #t "load-path == ~S\n" %load-path)

;; These will be converted to config vars later (see command-line.scm)
(define gnc:*load-path* #f)
(define gnc:*debugging?* (if (getenv "GNC_DEBUG") #t #f))
(define gnc:*develmode* (if (getenv "GNC_DEVEL_MODE") #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 (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))))

(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 (build-path (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*."
  
  (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
        (primitive-load file-name))))

(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)))

(gnc:load "main.scm")