From 4450f4a0253e8c2d14b453ba173fb4c0f433fded Mon Sep 17 00:00:00 2001 From: Dave Peticolas Date: Tue, 11 Sep 2001 06:49:29 +0000 Subject: [PATCH] More module refactoring. git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@5360 57a11ea4-9604-0410-9ed3-97b8803252fd --- src/app-utils/Makefile.am | 9 +- src/app-utils/app-utils.scm | 8 + src/app-utils/gnc-helpers.c | 11 ++ src/app-utils/gnc-helpers.h | 9 +- src/app-utils/gw-app-utils-spec.scm | 11 +- src/{scm => app-utils}/utilities.scm | 16 ++ .../qif-import/gncmod-qif-import.c | 5 + src/import-export/qif-import/qif-import.scm | 1 + src/report/report-system/report-utilities.scm | 14 -- src/report/report-system/report.scm | 19 +-- src/scm/Makefile.am | 5 - src/scm/commodity-import.scm | 23 --- src/scm/design.txt | 150 ------------------ src/scm/extensions.scm | 50 ------ src/scm/main.scm | 3 +- src/scm/structure.scm | 87 ---------- src/scm/testbed.scm | 65 -------- 17 files changed, 67 insertions(+), 419 deletions(-) rename src/{scm => app-utils}/utilities.scm (88%) delete mode 100644 src/scm/commodity-import.scm delete mode 100644 src/scm/design.txt delete mode 100644 src/scm/structure.scm delete mode 100644 src/scm/testbed.scm diff --git a/src/app-utils/Makefile.am b/src/app-utils/Makefile.am index c6d35af571..71cc86dc7b 100644 --- a/src/app-utils/Makefile.am +++ b/src/app-utils/Makefile.am @@ -50,8 +50,13 @@ libgw_app_utils_la_LDFLAGS=-module gncmoddir=${GNC_SHAREDIR}/guile-modules/gnucash gncmod_DATA=app-utils.scm -gncscmdir=${GNC_SHAREDIR}/scm -gncscm_DATA=c-interface.scm options.scm hooks.scm date-utilities.scm +gncscmdir = ${GNC_SHAREDIR}/scm +gncscm_DATA = \ + c-interface.scm \ + date-utilities.scm \ + hooks.scm \ + options.scm \ + utilities.scm gwmoddir=${GNC_SHAREDIR}/guile-modules/g-wrapped gwmod_LTLIBRARIES=libgw-app-utils.la diff --git a/src/app-utils/app-utils.scm b/src/app-utils/app-utils.scm index f2baee9ee3..b8ea4ddc44 100644 --- a/src/app-utils/app-utils.scm +++ b/src/app-utils/app-utils.scm @@ -202,7 +202,15 @@ (export gnc:*book-opened-hook*) (export gnc:*book-closed-hook*) +;; utilities +(export hash-fold) +(export item-list->hash!) +(export string-split) +(export string-join) +(export gnc:backtrace-if-exception) + (load-from-path "c-interface.scm") (load-from-path "options.scm") (load-from-path "hooks.scm") (load-from-path "date-utilities.scm") +(load-from-path "utilities.scm") diff --git a/src/app-utils/gnc-helpers.c b/src/app-utils/gnc-helpers.c index 3a37e3e357..0fafd984b0 100644 --- a/src/app-utils/gnc-helpers.c +++ b/src/app-utils/gnc-helpers.c @@ -106,3 +106,14 @@ gnc_printinfo_p(SCM info_scm) return retval; } +const char * +gnc_get_account_separator_string (void) +{ + static char sep[2]; + + sep[0] = gnc_get_account_separator (); + sep[1] = '\0'; + + return sep; +} + diff --git a/src/app-utils/gnc-helpers.h b/src/app-utils/gnc-helpers.h index 3f48f09b9a..4dfee75088 100644 --- a/src/app-utils/gnc-helpers.h +++ b/src/app-utils/gnc-helpers.h @@ -21,14 +21,17 @@ * * \********************************************************************/ -#ifndef __GNC_HELPERS__ -#define __GNC_HELPERS__ +#ifndef GNC_HELPERS +#define GNC_HELPERS -#include "gnc-ui-util.h" #include +#include "gnc-ui-util.h" + SCM gnc_printinfo2scm(GNCPrintAmountInfo info); GNCPrintAmountInfo gnc_scm2printinfo(SCM info_scm); int gnc_printinfo_p(SCM info_scm); +const char * gnc_get_account_separator_string (void); + #endif diff --git a/src/app-utils/gw-app-utils-spec.scm b/src/app-utils/gw-app-utils-spec.scm index 1d7a2ccd39..9ae3686d59 100644 --- a/src/app-utils/gw-app-utils-spec.scm +++ b/src/app-utils/gw-app-utils-spec.scm @@ -305,4 +305,13 @@ determines formatting details.") ' "gnc_get_euro" '() - "Returns the commodity EURO")) + "Returns the commodity EURO") + + (gw:wrap-function + mod + 'gnc:account-separator-char + '( gw:const) + "gnc_get_account_separator_string" + '() + "Returns a string with the user-selected account separator") +) diff --git a/src/scm/utilities.scm b/src/app-utils/utilities.scm similarity index 88% rename from src/scm/utilities.scm rename to src/app-utils/utilities.scm index 41caadc46e..daa4b1e115 100644 --- a/src/scm/utilities.scm +++ b/src/app-utils/utilities.scm @@ -82,3 +82,19 @@ (loop first-char)) (set! parts (cons (substring str 0 last-char) parts)))) parts)) + +(define (gnc:backtrace-if-exception proc . args) + (define (dumper key . args) + (let ((stack (make-stack #t dumper))) + (display-backtrace stack (current-error-port)) + (apply display-error stack (current-error-port) args) + (throw 'ignore))) + + (catch + 'ignore + (lambda () + (lazy-catch #t + (lambda () (apply proc args)) + dumper)) + (lambda (key . args) + #f))) diff --git a/src/import-export/qif-import/gncmod-qif-import.c b/src/import-export/qif-import/gncmod-qif-import.c index 6071c4040e..5675eb0ee7 100644 --- a/src/import-export/qif-import/gncmod-qif-import.c +++ b/src/import-export/qif-import/gncmod-qif-import.c @@ -39,6 +39,11 @@ gnc_module_init(int refcount) return FALSE; } + if(!gnc_module_load("gnucash/app-utils", 0)) + { + return FALSE; + } + if(!gnc_module_load("gnucash/gnome-utils", 0)) { return FALSE; diff --git a/src/import-export/qif-import/qif-import.scm b/src/import-export/qif-import/qif-import.scm index 5333425700..95c48a17ee 100644 --- a/src/import-export/qif-import/qif-import.scm +++ b/src/import-export/qif-import/qif-import.scm @@ -17,6 +17,7 @@ (debug-enable 'backtrace) (gnc:module-load "gnucash/engine" 0) +(gnc:module-load "gnucash/app-utils" 0) (load-from-path "qif-import/simple-obj.scm") (load-from-path "qif-import/qif-objects.scm") ;; class definitions diff --git a/src/report/report-system/report-utilities.scm b/src/report/report-system/report-utilities.scm index 70f54d7ea1..7e4d8ac665 100644 --- a/src/report/report-system/report-utilities.scm +++ b/src/report/report-system/report-utilities.scm @@ -154,20 +154,6 @@ (accounts-get-children-depth (gnc:group-get-account-list (gnc:get-current-group)))) -;; -(define (gnc:account-separator-char) - (let ((option (gnc:lookup-option gnc:*options-entries* - "General" "Account Separator"))) - (if option - (case (gnc:option-value option) - ((colon) ":") - ((slash) "/") - ((backslash) "\\") - ((dash) "-") - ((period) ".") - (else ":")) - ":"))) - ;; get a full account name (define (gnc:account-get-full-name account) (let ((separator (gnc:account-separator-char))) diff --git a/src/report/report-system/report.scm b/src/report/report-system/report.scm index d43f753e65..92339db2fe 100644 --- a/src/report/report-system/report.scm +++ b/src/report/report-system/report.scm @@ -406,7 +406,7 @@ (N_ "Stylesheet")) (string->symbol (gnc:html-style-sheet-name stylesheet)))) - + (define (gnc:all-report-template-names) (sort (hash-fold @@ -448,23 +448,6 @@ #f " (gnc:restore-report ~S ~S options))\n" (gnc:report-id report) (gnc:report-type report)))) -(define (gnc:backtrace-if-exception proc . args) - (define (dumper key . args) - (let ((stack (make-stack #t dumper))) - (display-backtrace stack (current-error-port)) - (apply display-error stack (current-error-port) args) - (throw 'ignore))) - - (catch - 'ignore - (lambda () - (lazy-catch #t - (lambda () (apply proc args)) - dumper)) - (lambda (key . args) - #f))) - - (define (gnc:report-render-html report headers?) (if (and (not (gnc:report-dirty? report)) (gnc:report-ctext report)) diff --git a/src/scm/Makefile.am b/src/scm/Makefile.am index 2525ed92ba..5c67e76b60 100644 --- a/src/scm/Makefile.am +++ b/src/scm/Makefile.am @@ -11,7 +11,6 @@ gnc_autogen_scm_files = \ gnc_regular_scm_files = \ command-line.scm \ - commodity-import.scm \ config-var.scm \ depend.scm \ doc.scm \ @@ -24,12 +23,9 @@ gnc_regular_scm_files = \ price-quotes.scm \ slib-backup.scm \ startup.scm \ - structure.scm \ substring-search.scm \ - testbed.scm \ tip-list.scm \ tip-of-the-day.scm \ - utilities.scm \ xgettext.scm \ xml-generator.scm @@ -49,7 +45,6 @@ SCM_FILES = ${gncscm_DATA} ${gncscmmod_DATA} EXTRA_DIST = \ .cvsignore \ bootstrap.scm.in \ - design.txt \ startup-design.txt \ ${SCM_FILES} diff --git a/src/scm/commodity-import.scm b/src/scm/commodity-import.scm deleted file mode 100644 index 6b5dc324bf..0000000000 --- a/src/scm/commodity-import.scm +++ /dev/null @@ -1,23 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; commodity-import.scm -;;; file-io hooks to convert old-style currency strings to -;;; real gnucash commodities. -;;; -;;; Bill Gribble 11 Aug 2000 -;;; $Id$ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(gnc:support "commodity-import.scm") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; import-old-currencies -;; If there are old currencies in the account group, start the -;; import wizard. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(define (import-old-currencies from-filename) - (if (gnc:commodity-table-has-namespace (gnc:engine-commodities) - "GNC_LEGACY_CURRENCIES") - (gnc:import-legacy-commodities from-filename))) - -(gnc:hook-add-dangler gnc:*book-opened-hook* import-old-currencies) diff --git a/src/scm/design.txt b/src/scm/design.txt deleted file mode 100644 index 79b5e683ff..0000000000 --- a/src/scm/design.txt +++ /dev/null @@ -1,150 +0,0 @@ - -Option order is relevant... - -Startup looks like this: - - load *gnc:startup-file* - - may be overriden with --startup-file - - default is --share-dir /gnucash/scm/startup.scm - - sets up *gnc:load-path* (most other files respect this) - default is '("$HOME/.gnucash/scm" "$prefix/usr/share/gnucash/scm::") - and all the subdirectories of these directories. - - may be overridden by --load-path - the default path can be referenced as *gnc:load-path* - you can indicate that subdirs should be scanned with a trailing :: - i.e. --load-path '(append *gnc:load-path* (gnc:subdirs "/my/dir/"))' - - --load-path=<>:/usr/lib/foo:.: - - - load *gnc:config-dir* / config - *gnc:config-dir* may be overriden with --config-dir - - load $HOME/.gnucash/config.user or load $HOME/.gnucash/config.auto - - -This means that all code can be overriden by either --startup-file and ---load-path. - - -This file is out of date. Recent implementation has surpassed its -contents. It will be updated later... - - -This directory should hold the UI independent parts of the -configuration engine. In particular, this sub-system is concerned -with support for command line options, help strings for these options, -and general preferences. It is also concerned with integrating these -things with the startup config file. - -Current notes: - -1) One goal is to make it really easy to add preference options, and - to make sure that changes in one place propagate everywhere they're - relevant. You should be able to enter the option description in - one place, and then this information should be used to parse - command line options, automatically extend the options the config - file supports, generate the usage message, and annotate the config - file. - - I propose that each subdir in the gnucash tree be allowed to contain - an ./prefs.def.scm file which will look like this: - - (gnucash:describe-pref name value-name type description - default-value - arg-convert-func - arg-verify-func) - i.e. - - (gnucash:describe-pref - "ledger-height" "height" 'integer - "The default height of a newly opened ledger in number of lines." - 12 - gnucash:prefs-handle-integer-arg - #f) - - At the C level, all these objects will be returned as the guile - SCM type, but translating this to the relevant C type is - completely straightforward (guile has a set of functions for - this). In most cases, you'll know what the expected C type is, - and just use the relevant guile function to get it, but if not, - there are type query functions. There are also C level "foreach" - and list stepping functions to handle any lists. - - The option-definitions files will be used to determine the config - system's initial configuration behavior. - - -[ OUT OF DATE -- implementation in flux ] - - The following functions for interaction with the config system will - be available: - - guile-level: - (gnucash:preference-list) => list of prefs - (gnucash:preference-exists?) => list of prefs - (gnucash:preference-lookup-by-name name) => pref - (gnucash:preference-get-name pref) => name - (gnucash:preference-get-type pref) => type - (gnucash:preference-get-value pref) => value - (gnucash:preference-set-value! pref value) => - (gnucash:preference-get-documentation! pref) => documentation - - c-level: There will be an equivalent set of functions for querying - the state of the preference engine, and there will be some - helper functions to make interactions with the scheme level less - awkward. - - There will also be a callback mechanism whereby the C level can - register functions to be called whenever a given preference - changes. This will allow us to keep guileisms out of code that - we want to keep strictly C/C++ (this feature addresses one of - Linas' primary concerns). - - --name="value" on the command line will be handled identically to - (gnucash:preference-set-value! name value) in a config file, and will - - gnucash --help" will display a list of all options, their types, their - default values, and their documentation strings, all gathered from - the config files. - -2) The config file will just be guile code, and the startup procedure - should work as follows. (This approach needs to be substantially - more sophisticated later to handle UI selected options vs. user - config-file options more intelligently, but this will do for now.) - - By default, gnucash (or whatever we call it) writes all automatically - generated (by user interaction in the GUI or whatever) config info - to a file ~/.gnucash/config.auto in the form of guile code. Then at - startup, gnucash *first* tries to read ~/.gnucash/config.user. If it - can't, it falls back to ~/.gnucash/config.auto, but only if - ~/.gnucash/config.user doesn't exist. - - Normal users will only have a ~/.gnucash/config.auto file, and they'll - be happy. Users who want to tweak things manually will be able to - create an ~/.gnucash/config.user file and go nuts in there, loading - ~/.gnucash/config.auto whenever they feel like it (or not at all). - - Justification for guile code as the config file format rather than - something less complex: - - Want a to run a particular set of functions on startup? Put - - (gnc:load "config.auto") - - (my-first-function) - (my-second-function) - ... - - Also this makes hook functions possible (essentially callbacks on - certain events into user provided guile functions). - -Unknown: - -1) How does this scheme integrate with gtk's config rc file mechanism? - I know we'll pass argc, argv off to gtk_init, but do we need to - think about anything else? diff --git a/src/scm/extensions.scm b/src/scm/extensions.scm index f044d9d495..6fddbe4052 100644 --- a/src/scm/extensions.scm +++ b/src/scm/extensions.scm @@ -59,64 +59,14 @@ (define (gnc:extensions-menu-setup) (define menu (gnc:make-menu "Extensions" (list "_Settings"))) - - (define schedxact-editor-item - (gnc:make-menu-item (N_ "SchedXact: Editor") - (N_ "Editor of Scheduled Transactions") - (list "Extensions" "") - (lambda () (gnc:sx-editor))) - ) - (define schedxact-old-slr-item - (gnc:make-menu-item (N_ "SchedXact: [Old] Since Last Run") - (N_ "since last run dialog") - (list "Extensions" "") - (lambda () (gnc:sx-since-last-run))) - ) - (define schedxact-slr-item - (gnc:make-menu-item (N_ "SchedXact: [New] Since Last Run") - (N_ "since last run dialog") - (list "Extensions" "" ) - (lambda () (gnc:sx-sincelast-create )))) - (define progress-item - (gnc:make-menu-item (N_ "Test progress dialog") - (N_ "Test progress dialog") - (list "Extensions" "") - (lambda () - (let ((dialog (gnc:progress-dialog-new #f #f)) - (canceled #f)) - (gnc:progress-dialog-set-activity-mode dialog #t) - (gnc:progress-dialog-set-heading dialog #f) - (gnc:progress-dialog-set-cancel-scm-func - dialog - (lambda () - (display "User canceled.") (newline) - (set! canceled #t) - #t)) - (let loop ((value 0.0)) - (gnc:progress-dialog-set-value dialog value) - (sleep 1) - (if (and (not canceled) (< value 90.0)) - (loop (+ value 5.0)))) - (gnc:progress-dialog-finish dialog) - (gnc:progress-dialog-destroy dialog))))) (gnc:add-extension menu) -; (gnc:add-extension export-item) - -;; NOTE: this is the inverse order from how you may want them to -;; appear in the menu [prepending to some list]... - - (gnc:add-extension progress-item) - (gnc:add-extension schedxact-old-slr-item) - (gnc:add-extension schedxact-slr-item) - (gnc:add-extension schedxact-editor-item) ) (if (gnc:debugging?) (gnc:hook-add-dangler gnc:*ui-startup-hook* gnc:extensions-menu-setup)) - ;; Automatically pick accelerators for menu names (define (gnc:new-menu-namer) diff --git a/src/scm/main.scm b/src/scm/main.scm index a7ee14567d..cdf3f39940 100644 --- a/src/scm/main.scm +++ b/src/scm/main.scm @@ -71,11 +71,12 @@ (gnc:depend "doc.scm") (gnc:depend "extensions.scm") (gnc:depend "main-window.scm") - (gnc:depend "commodity-import.scm") (gnc:depend "printing/print-check.scm") (gnc:depend "price-quotes.scm") (gnc:depend "tip-of-the-day.scm") + (gnc:hook-add-dangler gnc:*book-opened-hook* gnc:import-legacy-commodities) + (if (not (gnc:handle-command-line-args)) (gnc:shutdown 1)) diff --git a/src/scm/structure.scm b/src/scm/structure.scm deleted file mode 100644 index e6cd951c5b..0000000000 --- a/src/scm/structure.scm +++ /dev/null @@ -1,87 +0,0 @@ -;; structure.scm -- Some functions to help build structures -;; -;; 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-mystruct is used to build an association list that defines -;;; the layout of a structure... -(define (define-mystruct lst) - (define alist '()) ;; Association list - (define count 0) ;; Number of entries - (define (add-item item) - (set! alist (cons (cons item count) alist)) - (set! count (+ 1 count))) - (add-item 'gensymid) - (for-each add-item lst) - alist) -;;; Use as follows: -;;; (define qif-split-structure (define-mystruct '(category memo -;;; amount percent))) -;;; - -(define (build-mystruct-instance structinfo) - ;;; struct-instance is the vector for the data... - (define struct-instance (make-vector (length structinfo) #f)) - (define (get-item field-id) ;;; Look up entry based on ID - (let ((assocv (assoc field-id structinfo))) - (if assocv - (vector-ref struct-instance (cdr assocv)) - (begin - (display (string-append "No such field as " - (symbol->string field-id) - " in ")) - (display structinfo) - (newline) - #f)))) - - - (define (set-item! field-id value) ;;; Plunk in new value - (let ((assocv (assoc field-id structinfo))) - (if assocv - (vector-set! struct-instance (cdr assocv) value) - #f))) - - (define (actions action field . value) ;;; now, methods to be applied - (cond - ((eq? action 'get) - (let ((item (get-item field))) - (if item - (car item) - #f))) - ((eq? action 'put) - (set-item! field value)) - (else - (list structinfo struct-instance)))) - (set-item! 'gensymid (list (gensym))) ;;; Attach a unique identifier - actions) - -;(if testing? -; (begin -; (display "Testing structur.scm - define-mystruct, build-mystruct-instance") -; (newline) -; (let* ((ms (define-mystruct '(f1 f2 f3))) -; (mi (build-mystruct-instance ms))) -; (mi 'put 'f1 122) -; (mi 'put 'f3 "hello") -; (display "Empty list entry:") (display (mi 'get 'f2)) (newline) -; (display "and two that aren't (f1 f3):") -; (display (list (mi 'get 'f1) (mi 'get 'f3))) (newline) -; (display "Whole thang:") -; (display (mi 'whole 'thang)) (newline) -; (display "Overlay 'f3 with 42, add to 'f1 value") -; (mi 'put 'f3 42) -; (display (number->string (+ (mi 'get 'f1) (mi 'get 'f3)))) (newline)))) diff --git a/src/scm/testbed.scm b/src/scm/testbed.scm deleted file mode 100644 index 86b0da4532..0000000000 --- a/src/scm/testbed.scm +++ /dev/null @@ -1,65 +0,0 @@ -;;; $Id$ -(define oklist #f) -(define errorlist #f) -(define errcount #f) - -(define (initialize-testing) - (set! oklist '()) - (set! errorlist '()) - (set! errcount 0)) - -(define (testing funname input expected actual) - (define (lookup-set! lookuptable key value) - (let - ((oldval (assoc key lookuptable))) - (if oldval - (set-cdr! oldval value) - (set! lookuptable (cons (cons key value) lookuptable)))) - lookuptable) - - (if testing? - (begin - (display (string-append "Test: (" funname " ")) - (display input) - (display ")") (newline) - (display "Expect: ") (display expected) (newline) - (display "Got: ") (display actual) (newline) - (let ((result (list funname input expected actual))) - (if (equal? expected actual) - (begin - (display "OK") - (set! oklist (lookup-set! oklist (list funname input) result))) - (begin - (display "ERROR!!!!!!!!!") - (set! errorlist (lookup-set! errorlist - (list funname input) - (list expected result)))))) - (newline)))) - -(define (reportonerrors) - (newline) - (display "Error Analysis:") (newline) - (display "---------------------------") (newline) - (display "Number Passed:") - (display (number->string (length (map car oklist)))) (newline) - (display "Number Failed:") - (display (number->string (length (map car errorlist)))) (newline) - - (map - (lambda (lst) - (display "Error:") (newline) - (let* ((key (car lst)) - (funname (car key)) - (input (cadr key)) - (value (cdr lst)) - (expected (car value)) - (actual (cadr value))) - (display "-------------------------------------------") (newline) - (display "Function:") (display funname) (newline) - (display "Input:") (display input) (newline) - (display "Expected result:") (display expected) (newline) - (display "Actual result:") (display actual) (newline) - (display "-------------------------------------------") (newline) - )) - errorlist) - (newline))