"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "libgnucash/engine/business-core.scm" between
gnucash-3.6.tar.bz2 and gnucash-3.7.tar.bz2

About: GnuCash is personal and small-business financial-accounting software.

business-core.scm  (gnucash-3.6.tar.bz2):business-core.scm  (gnucash-3.7.tar.bz2)
skipping to change at line 22 skipping to change at line 22
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact: ;; along with this program; if not, contact:
;; ;;
;; Free Software Foundation Voice: +1-617-542-5942 ;; Free Software Foundation Voice: +1-617-542-5942
;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652 ;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
;; Boston, MA 02110-1301, USA gnu@gnu.org ;; Boston, MA 02110-1301, USA gnu@gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-module (gnucash business-core)) (define-module (gnucash business-core))
(use-modules (gnucash gnc-module)) (use-modules (gnucash gnc-module))
(use-modules (srfi srfi-1))
(gnc:module-load "gnucash/engine" 0) (gnc:module-load "gnucash/engine" 0)
(define (gnc:owner-get-address owner) (define (gnc:owner-get-address owner)
(let ((type (gncOwnerGetType owner))) (let ((type (gncOwnerGetType owner)))
(cond (cond
((eqv? type GNC-OWNER-CUSTOMER) ((eqv? type GNC-OWNER-CUSTOMER)
(let ((c (gncOwnerGetCustomer owner))) (let ((c (gncOwnerGetCustomer owner)))
(gncCustomerGetAddr c))) (gncCustomerGetAddr c)))
((eqv? type GNC-OWNER-VENDOR) ((eqv? type GNC-OWNER-VENDOR)
(let ((v (gncOwnerGetVendor owner))) (let ((v (gncOwnerGetVendor owner)))
skipping to change at line 53 skipping to change at line 54
; content. When multiple "lines" are included, separate them ; content. When multiple "lines" are included, separate them
; by newlines. ; by newlines.
; ;
; e.g.: return a string which is basically: ; e.g.: return a string which is basically:
; name \n Attn: contact \n addr1 \n addr2 \n addr3 \n addr4 ; name \n Attn: contact \n addr1 \n addr2 \n addr3 \n addr4
; ;
; But only include the strings that really exist. ; But only include the strings that really exist.
; ;
(define (gnc:owner-get-name-dep owner) (define (gnc:owner-get-name-dep owner)
(define (just-name name) (cond
(if name name "")) ((eqv? (gncOwnerGetType owner) GNC-OWNER-JOB)
(gnc:owner-get-name-dep (gncJobGetOwner (gncOwnerGetJob owner))))
(let ((type (gncOwnerGetType owner))) (else (or (gncOwnerGetName owner) ""))))
(cond
((eqv? type GNC-OWNER-JOB)
(gnc:owner-get-name-dep (gncJobGetOwner
(gncOwnerGetJob owner))))
(else (just-name (gncOwnerGetName owner))))))
(define (gnc:owner-get-address-dep owner) (define (gnc:owner-get-address-dep owner)
(define (add-if-exists lst new) (define (addif elt)
(if (and new (> (string-length new) 0)) (if (and elt (> (string-length elt) 0))
(cons new lst) (list elt)
lst)) '()))
(define (build-string lst) (let ((addr (gnc:owner-get-address owner)))
(cond (string-join
((null? lst) "") (append
((null? (cdr lst)) (car lst)) (addif (gncAddressGetName addr))
(else (string-append (build-string (cdr lst)) "\n" (car lst))))) (addif (gncAddressGetAddr1 addr))
(let ((lst '()) (addif (gncAddressGetAddr2 addr))
(addr (gnc:owner-get-address owner))) (addif (gncAddressGetAddr3 addr))
; Added gncAddressGetName <mikee@saxicola.co.uk> (addif (gncAddressGetAddr4 addr)))
(set! lst (add-if-exists lst (gncAddressGetName addr))) "\n")))
(set! lst (add-if-exists lst (gncAddressGetAddr1 addr)))
(set! lst (add-if-exists lst (gncAddressGetAddr2 addr)))
(set! lst (add-if-exists lst (gncAddressGetAddr3 addr)))
(set! lst (add-if-exists lst (gncAddressGetAddr4 addr)))
(build-string lst)))
(define (gnc:owner-get-name-and-address-dep owner) (define (gnc:owner-get-name-and-address-dep owner)
(let ((name (gnc:owner-get-name-dep owner)) (let ((name (gnc:owner-get-name-dep owner))
(addr (gnc:owner-get-address-dep owner))) (addr (gnc:owner-get-address-dep owner)))
(if (> (string-length name) 0) (if (> (string-length name) 0)
(string-append name "\n" addr) (string-append name "\n" addr)
addr))) addr)))
(define (gnc:owner-get-owner-id owner) (define (gnc:owner-get-owner-id owner)
(let ((type (gncOwnerGetType owner))) (let ((type (gncOwnerGetType owner)))
skipping to change at line 107 skipping to change at line 98
(let ((v (gncOwnerGetVendor owner))) (let ((v (gncOwnerGetVendor owner)))
(gncVendorGetID v))) (gncVendorGetID v)))
((eqv? type GNC-OWNER-EMPLOYEE) ((eqv? type GNC-OWNER-EMPLOYEE)
(let ((e (gncOwnerGetEmployee owner))) (let ((e (gncOwnerGetEmployee owner)))
(gncEmployeeGetID e))) (gncEmployeeGetID e)))
((eqv? type GNC-OWNER-JOB) ((eqv? type GNC-OWNER-JOB)
(gnc:owner-get-owner-id (gncJobGetOwner (gncOwnerGetJob owner)))) (gnc:owner-get-owner-id (gncJobGetOwner (gncOwnerGetJob owner))))
(else "")))) (else ""))))
(define (gnc:entry-type-percent-p type-val) (define (gnc:entry-type-percent-p type-val)
(issue-deprecation-warning
"gnc:entry-type-percent-p is deprecated.")
(let ((type type-val)) (let ((type type-val))
(equal? type GNC-AMT-TYPE-PERCENT))) (equal? type GNC-AMT-TYPE-PERCENT)))
;; this function aims to find a split's owner. various splits are
;; supported: (1) any splits in the invoice posted transaction, in
;; APAR or income/expense accounts (2) any splits from invoice's
;; payments, in APAR or asset/liability accounts. it returns either
;; the owner or '() if not found. in addition, if owner was found, the
;; result-owner argument is mutated to it.
(define (gnc:owner-from-split split result-owner) (define (gnc:owner-from-split split result-owner)
(define (notnull x) (and (not (null? x)) x))
(let* ((trans (xaccSplitGetParent split)) (let* ((trans (xaccSplitGetParent split))
(invoice (gncInvoiceGetInvoiceFromTxn trans)) (invoice (notnull (gncInvoiceGetInvoiceFromTxn trans)))
(temp-owner (gncOwnerNew)) (temp (gncOwnerNew))
(owner '())) (owner (or (and invoice (gncInvoiceGetOwner invoice))
(any
(if (not (null? invoice)) (lambda (split)
(set! owner (gncInvoiceGetOwner invoice)) (let* ((lot (xaccSplitGetLot split))
(let ((split-list (xaccTransGetSplitList trans))) (invoice (notnull (gncInvoiceGetInvoiceFromLot lot
(define (check-splits splits) ))))
(if (and splits (not (null? splits))) (or (and invoice (gncInvoiceGetOwner invoice))
(let* ((split (car splits)) (and (gncOwnerGetOwnerFromLot lot temp) temp))))
(lot (xaccSplitGetLot split))) (xaccTransGetSplitList trans)))))
(if (not (null? lot)) (gncOwnerFree temp)
(let* ((invoice (gncInvoiceGetInvoiceFromLot lot)) (cond (owner (gncOwnerCopy (gncOwnerGetEndOwner owner) result-owner)
(owner? (gncOwnerGetOwnerFromLot result-owner)
lot temp-owner))) (else '()))))
(if (not (null? invoice))
(set! owner (gncInvoiceGetOwner invoice))
(if owner?
(set! owner temp-owner)
(check-splits (cdr splits)))))
(check-splits (cdr splits))))))
(check-splits split-list)))
(if (not (null? owner))
(begin
(gncOwnerCopy (gncOwnerGetEndOwner owner) result-owner)
(gncOwnerFree temp-owner)
result-owner)
(begin
(gncOwnerFree temp-owner)
'()))))
(export gnc:owner-get-address) (export gnc:owner-get-address)
(export gnc:owner-get-name-dep) (export gnc:owner-get-name-dep)
(export gnc:owner-get-address-dep) (export gnc:owner-get-address-dep)
(export gnc:owner-get-name-and-address-dep) (export gnc:owner-get-name-and-address-dep)
(export gnc:owner-get-owner-id) (export gnc:owner-get-owner-id)
(export gnc:entry-type-percent-p) (export gnc:entry-type-percent-p)
(export gnc:owner-from-split) (export gnc:owner-from-split)
 End of changes. 7 change blocks. 
58 lines changed or deleted 42 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)