"Fossies" - the Fresh Open Source Software Archive

Member "gnucash-3.7/gnucash/report/standard-reports/daily-reports.scm" (7 Sep 2019, 14489 Bytes) of package /linux/misc/gnucash-3.7.tar.bz2:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Lisp source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "daily-reports.scm": 3.6_vs_3.7.

    1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    2 ;; daily-reports.scm: reports based on the day of the week
    3 ;;
    4 ;; Copyright (C) 2003, Andy Wingo <wingo at pobox dot com>
    5 ;;
    6 ;; based on account-piecharts.scm by Robert Merkel (rgmerk@mira.net)
    7 ;; and Christian Stimming <stimming@tu-harburg.de>
    8 ;;
    9 ;; This program is free software; you can redistribute it and/or    
   10 ;; modify it under the terms of the GNU General Public License as   
   11 ;; published by the Free Software Foundation; either version 2 of   
   12 ;; the License, or (at your option) any later version.              
   13 ;;                                                                  
   14 ;; This program is distributed in the hope that it will be useful,  
   15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of   
   16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    
   17 ;; GNU General Public License for more details.                     
   18 ;;                                                                  
   19 ;; You should have received a copy of the GNU General Public License
   20 ;; along with this program; if not, contact:
   21 ;;
   22 ;; Free Software Foundation           Voice:  +1-617-542-5942
   23 ;; 51 Franklin Street, Fifth Floor    Fax:    +1-617-542-2652
   24 ;; Boston, MA  02110-1301,  USA       gnu@gnu.org
   25 ;;
   26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   27 
   28 (define-module (gnucash report standard-reports daily-reports))
   29 
   30 (use-modules (gnucash utilities)) 
   31 (use-modules (srfi srfi-1))
   32 (use-modules (gnucash gnc-module))
   33 (use-modules (gnucash gettext))
   34 
   35 (gnc:module-load "gnucash/report/report-system" 0)
   36 
   37 (define menuname-income (N_ "Income vs. Day of Week"))
   38 (define menuname-expense (N_ "Expenses vs. Day of Week"))
   39 
   40 ;; The menu statusbar tips.
   41 (define menutip-income
   42   (N_ "Shows a piechart with the total income for each day of the week"))
   43 (define menutip-expense 
   44   (N_ "Shows a piechart with the total expenses for each day of the week"))
   45 
   46 ;; The names here are used 1. for internal identification, 2. as
   47 ;; tab labels, 3. as default for the 'Report name' option which
   48 ;; in turn is used for the printed report title.
   49 (define reportname-income (N_ "Income vs. Day of Week"))
   50 (define reportname-expense (N_ "Expenses vs. Day of Week"))
   51 
   52 (define optname-from-date (N_ "Start Date"))
   53 (define optname-to-date (N_ "End Date"))
   54 (define optname-report-currency (N_ "Report's currency"))
   55 (define optname-price-source (N_ "Price Source"))
   56 
   57 (define optname-accounts (N_ "Accounts"))
   58 (define optname-levels (N_ "Show Accounts until level"))
   59 (define optname-subacct (N_ "Include Sub-Accounts"))
   60 
   61 (define optname-fullname (N_ "Show long account names"))
   62 (define optname-show-total (N_ "Show Totals"))
   63 (define optname-slices (N_ "Maximum Slices"))
   64 (define optname-plot-width (N_ "Plot Width"))
   65 (define optname-plot-height (N_ "Plot Height"))
   66 (define optname-sort-method (N_ "Sort Method"))
   67 
   68 ;; The option-generator. The only dependance on the type of piechart
   69 ;; is the list of account types that the account selection option
   70 ;; accepts.
   71 (define (options-generator account-types)
   72   (let* ((options (gnc:new-options))
   73          (add-option 
   74           (lambda (new-option)
   75             (gnc:register-option options new-option))))
   76 
   77     (gnc:options-add-date-interval!
   78      options gnc:pagename-general
   79      optname-from-date optname-to-date "a")
   80 
   81     (gnc:options-add-currency! 
   82      options gnc:pagename-general optname-report-currency "b")
   83     
   84     (gnc:options-add-price-source! 
   85      options gnc:pagename-general
   86      optname-price-source "c" 'weighted-average)
   87 
   88     (add-option
   89      (gnc:make-simple-boolean-option
   90       gnc:pagename-accounts optname-subacct
   91       "a" (N_ "Include sub-accounts of all selected accounts.") #t))
   92 
   93     (add-option
   94      (gnc:make-account-list-option
   95       gnc:pagename-accounts optname-accounts
   96       "a"
   97       (N_ "Report on these accounts, if chosen account level allows.")
   98       (lambda ()
   99         (gnc:filter-accountlist-type 
  100          account-types
  101          (gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
  102       (lambda (accounts)
  103         (list #t
  104               (gnc:filter-accountlist-type
  105                account-types
  106                accounts)))
  107       #t))
  108 
  109     (gnc:options-add-account-levels! 
  110      options gnc:pagename-accounts optname-levels "b" 
  111      (N_ "Show accounts to this depth and not further.") 
  112      2)
  113 
  114     (add-option
  115      (gnc:make-simple-boolean-option
  116       gnc:pagename-display optname-show-total
  117       "b" (N_ "Show the total balance in legend?") #t))
  118 
  119     (gnc:options-add-plot-size! 
  120      options gnc:pagename-display 
  121      optname-plot-width optname-plot-height "d" (cons 'percent 100.0) (cons 'percent 100.0))
  122 
  123     (gnc:options-set-default-section options gnc:pagename-general)      
  124 
  125     options))
  126 
  127 
  128 ;; The rendering function. Since it works for a bunch of different
  129 ;; account settings, you have to give the reportname, the
  130 ;; account-types to work on and whether this report works on
  131 ;; intervals as arguments.
  132 (define (piechart-renderer report-obj reportname
  133                            account-types)
  134   
  135   ;; This is a helper function for looking up option values.
  136   (define (get-option section name)
  137     (gnc:option-value 
  138      (gnc:lookup-option 
  139       (gnc:report-options report-obj) section name)))
  140   
  141   (gnc:report-starting reportname)
  142 
  143   ;; Get all options
  144   (let* ((to-date (gnc:time64-end-day-time 
  145                      (gnc:date-option-absolute-time
  146                       (get-option gnc:pagename-general optname-to-date))))
  147          (from-date (gnc:time64-start-day-time 
  148                         (gnc:date-option-absolute-time 
  149                          (get-option gnc:pagename-general 
  150                                      optname-from-date))))
  151          (accounts (get-option gnc:pagename-accounts optname-accounts))
  152          (dosubs? (get-option gnc:pagename-accounts optname-subacct))
  153          (account-levels (get-option gnc:pagename-accounts optname-levels))
  154          (report-currency (get-option gnc:pagename-general
  155                                       optname-report-currency))
  156          (price-source (get-option gnc:pagename-general
  157                                    optname-price-source))
  158          (report-title (get-option gnc:pagename-general 
  159                                    gnc:optname-reportname))
  160          
  161          (show-total? (get-option gnc:pagename-display optname-show-total))
  162          (height (get-option gnc:pagename-display optname-plot-height))
  163          (width (get-option gnc:pagename-display optname-plot-width))
  164          
  165          (commodity-list #f)
  166          (exchange-fn #f)
  167          (print-info (gnc-commodity-print-info report-currency #t))
  168         
  169          (beforebegindate (gnc:time64-end-day-time 
  170                            (gnc:time64-previous-day from-date)))
  171          (document (gnc:make-html-document))
  172          (chart (gnc:make-html-piechart))
  173          (topl-accounts (gnc:filter-accountlist-type 
  174                          account-types
  175                          (gnc-account-get-children-sorted
  176                           (gnc-get-current-root-account)))))
  177     
  178     (define (monetary->double foreign-monetary date)
  179       (gnc-numeric-to-double
  180        (gnc:gnc-monetary-amount
  181         (exchange-fn foreign-monetary report-currency date))))
  182     
  183     (if (not (null? accounts))
  184         (let* ((query (qof-query-create-for-splits))
  185                (splits '())
  186                (daily-totals (list 0 0 0 0 0 0 0))
  187            ;; Note: the absolute-super-duper-i18n'ed solution
  188            ;; would be to use the locale-using functions
  189            ;; date->string of srfi-19, similar to get_wday_name()
  190            ;; in src/engine/FreqSpeq.c. For now, we simply use
  191            ;; the normal translations, which show up in the glade
  192            ;; file src/gnome-utils/gtkbuilder/gnc-frequency.glade anyway.
  193                (days-of-week (list (_"Sunday") (_"Monday") 
  194                    (_"Tuesday") (_"Wednesday") 
  195                    (_"Thursday") (_"Friday") (_"Saturday"))))
  196           
  197           (gnc:debug daily-totals)
  198           
  199           ;; The percentage done numbers here are a hack so that
  200           ;; something gets displayed. On my system the
  201           ;; gnc:case-exchange-time-fn takes about 20% of the time
  202           ;; building up a list of prices for later use. Either this
  203           ;; routine needs to send progress reports, or the price
  204           ;; lookup should be distributed and done when actually
  205           ;; needed so as to amortize the cpu time properly.
  206       (gnc:report-percent-done 1)
  207       (set! commodity-list (gnc:accounts-get-commodities
  208                                 (gnc:accounts-and-all-descendants accounts)
  209                                 report-currency))
  210       (gnc:report-percent-done 5)
  211       (set! exchange-fn (gnc:case-exchange-time-fn 
  212                              price-source report-currency 
  213                              commodity-list to-date
  214                  5 20))
  215       (gnc:report-percent-done 20)
  216           
  217           ;; initialize the query to find splits in the right 
  218           ;; date range and accounts
  219           (qof-query-set-book query (gnc-get-current-book))
  220           
  221       ;; for balance purposes, we don't need to do this, but it cleans up
  222       ;; the table display.
  223           (gnc:query-set-match-non-voids-only! query (gnc-get-current-book))
  224           ;; add accounts to the query (include subaccounts 
  225           ;; if requested)
  226       (gnc:report-percent-done 25)
  227           (if dosubs?
  228               (set! accounts
  229                 (gnc:accounts-and-all-descendants accounts)))
  230       (gnc:report-percent-done 30)
  231           
  232           (xaccQueryAddAccountMatch query accounts QOF-GUID-MATCH-ANY QOF-QUERY-AND)
  233           
  234           ;; match splits between start and end dates 
  235           (xaccQueryAddDateMatchTT
  236            query #t from-date #t to-date QOF-QUERY-AND)
  237           (qof-query-set-sort-order query
  238                     (list SPLIT-TRANS TRANS-DATE-POSTED)
  239                     (list QUERY-DEFAULT-SORT)
  240                     '())
  241           
  242           ;; get the query results 
  243           (set! splits (qof-query-run query))
  244           (qof-query-destroy query)
  245       (gnc:report-percent-done 40)
  246 
  247           ;; each split is analyzed... the amount is converted to
  248           ;; report-currency, and the date modulo 7 used to find
  249           ;; weekday, and the correct daily-totals is updated.
  250           (for-each
  251            (lambda (split)
  252              (let* ((date (xaccTransGetDate (xaccSplitGetParent split)))
  253                     (weekday (modulo (1- (gnc:time64-get-week-day date)) 7))
  254                     (exchanged (monetary->double
  255                                 (gnc:make-gnc-monetary
  256                                  (xaccAccountGetCommodity (xaccSplitGetAccount split))
  257                                  (xaccSplitGetAmount split))
  258                                 date))
  259                     (old-amount (list-ref daily-totals weekday)))
  260                (list-set! daily-totals weekday (+ old-amount exchanged))))
  261            splits)
  262 
  263           (gnc:report-percent-done 60)
  264 
  265           (let* ((zipped-list (filter (lambda (p) 
  266                                         (not (zero? (cadr p))))
  267                                       (zip days-of-week daily-totals)))
  268                  (labels (map (lambda (p)
  269                                 (if show-total?
  270                                     (string-append
  271                                      (car p)
  272                                      " - "
  273                                      (xaccPrintAmount
  274                                       (double-to-gnc-numeric
  275                                        (cadr p)
  276                                        (gnc-commodity-get-fraction report-currency)
  277                                        GNC-RND-ROUND)
  278                                       print-info))
  279                                     (car p)))
  280                               zipped-list)))
  281             
  282             (if (not (null? zipped-list))
  283                 (begin
  284                   (gnc:html-piechart-set-title! chart report-title)
  285                   (gnc:html-piechart-set-width! chart width)
  286                   (gnc:html-piechart-set-height! chart height)
  287                   
  288                   (gnc:html-piechart-set-subtitle!
  289                    chart (string-append
  290                           (format #f
  291                                    (_ "~a to ~a")
  292                                    (qof-print-date from-date)
  293                                    (qof-print-date to-date))
  294                           (if show-total?
  295                               (let ((total (apply + daily-totals)))
  296                                 (format
  297                                  #f ": ~a"
  298                                  (xaccPrintAmount
  299                                   (double-to-gnc-numeric
  300                                    total
  301                                    (gnc-commodity-get-fraction report-currency)
  302                                    GNC-RND-ROUND)
  303                                   print-info)))
  304                               "")))
  305                 
  306                   (gnc:html-piechart-set-data! chart (map cadr zipped-list))
  307                   (gnc:html-piechart-set-colors!
  308                    chart (gnc:assign-colors (length zipped-list)))
  309                   (gnc:html-piechart-set-labels! chart labels)
  310                 
  311                   (gnc:html-document-add-object! document chart))
  312                 (gnc:html-document-add-object!
  313                  document
  314                  (gnc:html-make-empty-data-warning
  315                   report-title (gnc:report-id report-obj))))))
  316         
  317         (gnc:html-document-add-object!
  318          document
  319          (gnc:html-make-empty-data-warning
  320           report-title (gnc:report-id report-obj))))
  321 
  322     (gnc:report-finished)
  323     document))
  324 
  325 (for-each 
  326  (lambda (l)
  327    (gnc:define-report
  328     'version 1
  329     'name (car l)
  330     'report-guid (car (reverse l))
  331     'menu-path (list gnc:menuname-income-expense)
  332     'menu-name (caddr l) 
  333     'menu-tip (car (cdddr l)) 
  334     'options-generator (lambda () (options-generator (cadr l)))
  335     'renderer (lambda (report-obj)
  336                 (piechart-renderer report-obj 
  337                                    (car l) 
  338                                    (cadr l)))))
  339 
  340  (list 
  341   ;; reportname, account-types, menu-reportname, menu-tip
  342   (list reportname-income (list ACCT-TYPE-INCOME) menuname-income menutip-income "5e2d129f28d14df881c3e47e3053f604")
  343   (list reportname-expense (list ACCT-TYPE-EXPENSE) menuname-expense menutip-expense "dde49fed4ca940959ae7d01b72742530")))