IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2024-12-01 21:19:16 -06:00
Code Issues Packages Projects Releases Wiki Activity

* src/app-utils/utilities.scm: code moved to main.scm -- needed

Browse Source 
eariler in boot process.


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@6199 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Rob Browning 2001-12-04 22:42:57 +00:00
parent 3d1624113f
commit aebfa482e8
1 changed files with 0 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

100
src/app-utils/utilities.scm
View File

@ -1,100 +0,0 @@
;; utilities.scm
;; These utilities are loaded straight off
;;
;; 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
(if (not (defined? 'hash-fold))
(define (hash-fold proc init table)
(for-each
(lambda (bin)
(for-each
(lambda (elt)
(set! init (proc (car elt) (cdr elt) init)))
bin))
(vector->list table))))
(define (item-list->hash! lst hash
getkey getval
hashref hashset
list-duplicates?)
;; Takes a list of the form (item item item item) and returns a hash
;; formed by traversing the list, and getting the key and val from
;; each item using the supplied get-key and get-val functions, and
;; building a hash table from the result using the given hashref and
;; hashset functions. list-duplicates? determines whether or not in
;; the resulting hash, the value for a given key is a list of all
;; the values associated with that key in the input or just the
;; first one encountered.
(define (handle-item item)
(let* ((key (getkey item))
(val (getval item))
(existing-val (hashref hash key)))
(if (not list-duplicates?)
;; ignore if not first value.
(if (not existing-val) (hashset hash key val))
;; else result is list.
(if existing-val
(hashset hash key (cons val existing-val))
(hashset hash key (list val))))))
(for-each handle-item lst)
hash)
(define (string-join lst joinstr)
;; This should avoid a bunch of unnecessary intermediate string-appends.
;; I'm presuming those are more expensive than cons...
(if (or (not (list? lst)) (null? lst))
""
(apply string-append
(car lst)
(let loop ((remaining-elements (cdr lst)))
(if (null? remaining-elements)
'()
(cons joinstr (cons (car remaining-elements)
(loop (cdr remaining-elements)))))))))
(define (string-split str char)
(let ((parts '())
(first-char #f))
(let loop ((last-char (string-length str)))
(set! first-char (string-rindex str char 0 last-char))
(if first-char
(begin
(set! parts (cons (substring str (+ 1 first-char) last-char)
parts))
(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)))