From f1a137975058c10085af3d04cbc7172a1ddc362d Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Wed, 5 Dec 2001 22:14:12 +0000 Subject: [PATCH] * src/scm/bootstrap.scm.in: deleted (yesterday actually). git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@6259 57a11ea4-9604-0410-9ed3-97b8803252fd --- src/scm/bootstrap.scm.in | 250 --------------------------------------- 1 file changed, 250 deletions(-) delete mode 100644 src/scm/bootstrap.scm.in diff --git a/src/scm/bootstrap.scm.in b/src/scm/bootstrap.scm.in deleted file mode 100644 index b8723f7026..0000000000 --- a/src/scm/bootstrap.scm.in +++ /dev/null @@ -1,250 +0,0 @@ -;; 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 - -(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 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) - (export simple-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))) - -(load-from-path "main.scm")