r19639 - gnucash/trunk/src/app-utils - Bug #631058: Add future date period choices to be available in the date options
Christian Stimming
cstim at code.gnucash.org
Tue Oct 5 14:19:57 EDT 2010
Author: cstim
Date: 2010-10-05 14:19:57 -0400 (Tue, 05 Oct 2010)
New Revision: 19639
Trac: http://svn.gnucash.org/trac/changeset/19639
Modified:
gnucash/trunk/src/app-utils/app-utils.scm
gnucash/trunk/src/app-utils/date-utilities.scm
Log:
Bug #631058: Add future date period choices to be available in the date options
Patch by Chris Leach:
This patch provides date utilities to calculate future dates. This
allows easy selection of common future periods.
cstim adds: This patch adds new strings, but they are not used anywhere so
far, i.e. they will not be user-visible. Hence, I agree those scheme functions
may be useful for external report writers and for this reason they are
already added.
Note: The original submission would have added those options to the standard
relative-date chooser report option, but I (cstim) do not support adding those
extra option for all reports as standard setting. Hence, the usage of this
additional choices has to be added by the report writer explicitly.
Modified: gnucash/trunk/src/app-utils/app-utils.scm
===================================================================
--- gnucash/trunk/src/app-utils/app-utils.scm 2010-10-05 18:07:38 UTC (rev 19638)
+++ gnucash/trunk/src/app-utils/app-utils.scm 2010-10-05 18:19:57 UTC (rev 19639)
@@ -243,6 +243,16 @@
(export gnc:get-six-months-ago)
(export gnc:get-one-year-ago)
(export gnc:reldate-initialize)
+(export gnc:get-end-next-month)
+(export gnc:get-end-next-quarter)
+(export gnc:get-end-next-year)
+(export gnc:get-one-month-ahead)
+(export gnc:get-one-year-ahead)
+(export gnc:get-six-months-ahead)
+(export gnc:get-start-next-month)
+(export gnc:get-start-next-quarter)
+(export gnc:get-start-next-year)
+(export gnc:get-three-months-ahead)
;; hooks
(export gnc:hook-run-danglers) ;; from hooks.scm
Modified: gnucash/trunk/src/app-utils/date-utilities.scm
===================================================================
--- gnucash/trunk/src/app-utils/date-utilities.scm 2010-10-05 18:07:38 UTC (rev 19638)
+++ gnucash/trunk/src/app-utils/date-utilities.scm 2010-10-05 18:19:57 UTC (rev 19639)
@@ -494,6 +494,28 @@
(set-tm:isdst now -1)
(gnc:date->timepair now)))
+(define (gnc:get-start-next-year)
+ (let ((now (localtime (current-time))))
+ (set-tm:sec now 0)
+ (set-tm:min now 0)
+ (set-tm:hour now 0)
+ (set-tm:mday now 1)
+ (set-tm:mon now 0)
+ (set-tm:year now (+ (tm:year now) 1))
+ (set-tm:isdst now -1)
+ (gnc:date->timepair now)))
+
+(define (gnc:get-end-next-year)
+ (let ((now (localtime (current-time))))
+ (set-tm:sec now 59)
+ (set-tm:min now 59)
+ (set-tm:hour now 23)
+ (set-tm:mday now 31)
+ (set-tm:mon now 11)
+ (set-tm:year now (+ (tm:year now) 1))
+ (set-tm:isdst now -1)
+ (gnc:date->timepair now)))
+
(define (gnc:get-start-accounting-period)
(gnc:secs->timepair (gnc-accounting-period-fiscal-start)))
@@ -548,6 +570,35 @@
(set-tm:isdst now -1)
(gnc:date->timepair now)))
+(define (gnc:get-start-next-month)
+ (let ((now (localtime (current-time))))
+ (set-tm:sec now 0)
+ (set-tm:min now 0)
+ (set-tm:hour now 0)
+ (set-tm:mday now 1)
+ (if (= (tm:mon now) 11)
+ (begin
+ (set-tm:mon now 0)
+ (set-tm:year now (+ (tm:year now) 1)))
+ (set-tm:mon now (+ (tm:mon now) 1)))
+ (set-tm:isdst now -1)
+ (gnc:date->timepair now)))
+
+(define (gnc:get-end-next-month)
+ (let ((now (localtime (current-time))))
+ (set-tm:sec now 59)
+ (set-tm:min now 59)
+ (set-tm:hour now 23)
+ (if (= (tm:mon now) 11)
+ (begin
+ (set-tm:mon now 0)
+ (set-tm:year now (+ (tm:year now) 1)))
+ (set-tm:mon now (+ (tm:mon now) 1)))
+ (set-tm:mday now (gnc:days-in-month (+ (tm:mon now) 1)
+ (+ (tm:year now) 1900)))
+ (set-tm:isdst now -1)
+ (gnc:date->timepair now)))
+
(define (gnc:get-start-current-quarter)
(let ((now (localtime (current-time))))
(set-tm:sec now 0)
@@ -601,6 +652,36 @@
(set-tm:isdst now -1)
(gnc:date->timepair now)))
+(define (gnc:get-start-next-quarter)
+ (let ((now (localtime (current-time))))
+ (set-tm:sec now 0)
+ (set-tm:min now 0)
+ (set-tm:hour now 0)
+ (set-tm:mday now 1)
+ (if (> (tm:mon now) 8)
+ (begin
+ (set-tm:mon now 0)
+ (set-tm:year now (+ (tm:year now) 1)))
+ (set-tm:mon now (+ (tm:mon now) (- 3 (modulo (tm:mon now) 3)))))
+ (set-tm:isdst now -1)
+ (gnc:date->timepair now)))
+
+(define (gnc:get-end-next-quarter)
+ (let ((now (localtime (current-time))))
+ (set-tm:sec now 59)
+ (set-tm:min now 59)
+ (set-tm:hour now 23)
+ (if (> (tm:mon now) 8)
+ (begin
+ (set-tm:mon now 2)
+ (set-tm:year now (+ (tm:year now) 1)))
+ (set-tm:mon now (+ (tm:mon now)
+ (+ 1 (modulo (tm:mon now) 3)))))
+ (set-tm:mday now (gnc:days-in-month (+ (tm:mon now) 1)
+ (+ (tm:year now) 1900)))
+ (set-tm:isdst now -1)
+ (gnc:date->timepair now)))
+
(define (gnc:get-today)
(cons (current-time) 0))
@@ -656,6 +737,58 @@
(set-tm:isdst now -1)
(gnc:date->timepair now))))
+(define (gnc:get-one-month-ahead)
+ (let ((now (localtime (current-time))))
+ (if (= (tm:mon now) 11)
+ (begin
+ (set-tm:mon now 0)
+ (set-tm:year now (+ (tm:year now) 1)))
+ (set-tm:mon now (+ (tm:mon now) 1)))
+ (let ((month-length (gnc:days-in-month (+ (tm:mon now) 1)
+ (+ (tm:year now) 1900))))
+ (if (> month-length (tm:mday now))
+ (set-tm:mday now month-length))
+ (set-tm:isdst now -1)
+ (gnc:date->timepair now))))
+
+(define (gnc:get-three-months-ahead)
+ (let ((now (localtime (current-time))))
+ (if (> (tm:mon now) 8)
+ (begin
+ (set:tm-mon now (- (tm:mon now) 9))
+ (set:tm-year now (+ (tm:year now) 1))
+ (set:tm-mon now (+ (tm:mon now) 3))))
+ (let ((month-days (gnc:days-in-month (+ (tm:mon now) 1)
+ (+ (tm:year now) 1900))))
+ (if (> month-days (tm:mday now))
+ (set-tm:mday now month-days))
+ (set-tm:isdst now -1)
+ (gnc:date->timepair now))))
+
+(define (gnc:get-six-months-ahead)
+ (let ((now (localtime (current-time))))
+ (if (> (tm:mon now) 5)
+ (begin
+ (set:tm-mon now (- (tm:mon now) 6))
+ (set:tm-year now (+ (tm:year now) 1))
+ (set:tm-mon now (+ (tm:mon now) 6))))
+ (let ((month-days (gnc:days-in-month (+ (tm:mon now) 1)
+ (+ (tm:year now) 1900))))
+ (if (> month-days (tm:mday now))
+ (set-tm:mday now month-days))
+ (set-tm:isdst now -1)
+ (gnc:date->timepair now))))
+
+(define (gnc:get-one-year-ahead)
+ (let ((now (localtime (current-time))))
+ (set:tm-year now (+ (tm:year now) 1))
+ (let ((month-days (gnc:days-in-month (+ (tm:mon now) 1)
+ (+ (tm:year now) 1900))))
+ (if (> month-days (tm:mday now))
+ (set-tm:mday now month-days))
+ (set-tm:isdst now -1)
+ (gnc:date->timepair now))))
+
;; There is no GNC:RELATIVE-DATES list like the one mentioned in
;; gnucash-design.info, is there? Here are the currently defined
;; items, loosely grouped.
@@ -697,6 +830,20 @@
(N_ "Last day of the previous calendar year"))
(gnc:reldate-string-db
+ 'store 'start-next-year-string
+ (N_ "Start of next year"))
+ (gnc:reldate-string-db
+ 'store 'start-next-year-desc
+ (N_ "First day of the next calendar year"))
+
+ (gnc:reldate-string-db
+ 'store 'end-next-year-string
+ (N_ "End of next year"))
+ (gnc:reldate-string-db
+ 'store 'end-next-year-desc
+ (N_ "Last day of the next calendar year"))
+
+ (gnc:reldate-string-db
'store 'start-accounting-period-string
(N_ "Start of accounting period"))
(gnc:reldate-string-db
@@ -739,6 +886,20 @@
(N_ "Last day of previous month"))
(gnc:reldate-string-db
+ 'store 'start-next-month-string
+ (N_ "Start of next month"))
+ (gnc:reldate-string-db
+ 'store 'start-next-month-desc
+ (N_ "First day of the next month"))
+
+ (gnc:reldate-string-db
+ 'store 'end-next-month-string
+ (N_ "End of next month"))
+ (gnc:reldate-string-db
+ 'store 'end-next-month-desc
+ (N_ "Last day of next month"))
+
+ (gnc:reldate-string-db
'store 'start-current-quarter-string
(N_ "Start of current quarter"))
(gnc:reldate-string-db
@@ -767,6 +928,20 @@
(N_ "Last day of previous quarterly accounting period"))
(gnc:reldate-string-db
+ 'store 'start-next-quarter-string
+ (N_ "Start of next quarter"))
+ (gnc:reldate-string-db
+ 'store 'start-next-quarter-desc
+ (N_ "First day of the next quarterly accounting period"))
+
+ (gnc:reldate-string-db
+ 'store 'end-next-quarter-string
+ (N_ "End of next quarter"))
+ (gnc:reldate-string-db
+ 'store 'end-next-quarter-desc
+ (N_ "Last day of next quarterly accounting period"))
+
+ (gnc:reldate-string-db
'store 'today-string
(N_ "Today"))
(gnc:reldate-string-db
@@ -801,6 +976,35 @@
(gnc:reldate-string-db
'store 'one-year-ago-desc (N_ "One Year Ago"))
+ (gnc:reldate-string-db
+ 'store 'one-month-ahead-string
+ (N_ "One Month Ahead"))
+ (gnc:reldate-string-db
+ 'store 'one-month-ahead-desc (N_ "One Month Ahead"))
+
+ (gnc:reldate-string-db
+ 'store 'one-week-ahead-string
+ (N_ "One Week Ahead"))
+ (gnc:reldate-string-db
+ 'store 'one-week-ahead-desc (N_ "One Week Ahead"))
+
+ (gnc:reldate-string-db
+ 'store 'three-months-ahead-string
+ (N_ "Three Months Ahead"))
+ (gnc:reldate-string-db
+ 'store 'three-months-ahead-desc (N_ "Three Months Ahead"))
+
+ (gnc:reldate-string-db
+ 'store 'six-months-ahead-string
+ (N_ "Six Months Ahead"))
+ (gnc:reldate-string-db
+ 'store 'six-months-ahead-desc (N_ "Six Months Ahead"))
+
+ (gnc:reldate-string-db
+ 'store 'one-year-ahead-string (N_ "One Year Ahead"))
+ (gnc:reldate-string-db
+ 'store 'one-year-ahead-desc (N_ "One Year Ahead"))
+
(set! gnc:relative-date-values
(list
(vector 'start-cal-year
@@ -815,10 +1019,18 @@
(gnc:reldate-string-db 'lookup 'start-prev-year-string)
(gnc:reldate-string-db 'lookup 'start-prev-year-desc)
gnc:get-start-prev-year)
+ (vector 'start-next-year
+ (gnc:reldate-string-db 'lookup 'start-next-year-string)
+ (gnc:reldate-string-db 'lookup 'start-next-year-desc)
+ gnc:get-start-next-year)
(vector 'end-prev-year
(gnc:reldate-string-db 'lookup 'end-prev-year-string)
(gnc:reldate-string-db 'lookup 'end-prev-year-desc)
gnc:get-end-prev-year)
+ (vector 'end-next-year
+ (gnc:reldate-string-db 'lookup 'end-next-year-string)
+ (gnc:reldate-string-db 'lookup 'end-next-year-desc)
+ gnc:get-end-next-year)
(vector 'start-accounting-period
(gnc:reldate-string-db 'lookup 'start-accounting-period-string)
(gnc:reldate-string-db 'lookup 'start-accounting-period-desc)
@@ -843,6 +1055,14 @@
(gnc:reldate-string-db 'lookup 'end-prev-month-string)
(gnc:reldate-string-db 'lookup 'end-prev-month-desc)
gnc:get-end-prev-month)
+ (vector 'start-next-month
+ (gnc:reldate-string-db 'lookup 'start-next-month-string)
+ (gnc:reldate-string-db 'lookup 'start-next-month-desc)
+ gnc:get-start-next-month)
+ (vector 'end-next-month
+ (gnc:reldate-string-db 'lookup 'end-next-month-string)
+ (gnc:reldate-string-db 'lookup 'end-next-month-desc)
+ gnc:get-end-next-month)
(vector 'start-current-quarter
(gnc:reldate-string-db 'lookup 'start-current-quarter-string)
(gnc:reldate-string-db 'lookup 'start-current-quarter-desc)
@@ -859,6 +1079,14 @@
(gnc:reldate-string-db 'lookup 'end-prev-quarter-string)
(gnc:reldate-string-db 'lookup 'end-prev-quarter-desc)
gnc:get-end-prev-quarter)
+ (vector 'start-next-quarter
+ (gnc:reldate-string-db 'lookup 'start-next-quarter-string)
+ (gnc:reldate-string-db 'lookup 'start-next-quarter-desc)
+ gnc:get-start-next-quarter)
+ (vector 'end-next-quarter
+ (gnc:reldate-string-db 'lookup 'end-next-quarter-string)
+ (gnc:reldate-string-db 'lookup 'end-next-quarter-desc)
+ gnc:get-end-next-quarter)
(vector 'today
(gnc:reldate-string-db 'lookup 'today-string)
(gnc:reldate-string-db 'lookup 'today-desc)
@@ -878,7 +1106,23 @@
(vector 'one-year-ago
(gnc:reldate-string-db 'lookup 'one-year-ago-string)
(gnc:reldate-string-db 'lookup 'one-year-ago-desc)
- gnc:get-one-year-ago)))
+ gnc:get-one-year-ago)
+ (vector 'one-month-ahead
+ (gnc:reldate-string-db 'lookup 'one-month-ahead-string)
+ (gnc:reldate-string-db 'lookup 'one-month-ahead-desc)
+ gnc:get-one-month-ahead)
+ (vector 'three-months-ahead
+ (gnc:reldate-string-db 'lookup 'three-months-ahead-string)
+ (gnc:reldate-string-db 'lookup 'three-months-ahead-desc)
+ gnc:get-three-months-ahead)
+ (vector 'six-months-ahead
+ (gnc:reldate-string-db 'lookup 'six-months-ahead-string)
+ (gnc:reldate-string-db 'lookup 'six-months-ahead-desc)
+ gnc:get-three-months-ahead)
+ (vector 'one-year-ahead
+ (gnc:reldate-string-db 'lookup 'one-year-ahead-string)
+ (gnc:reldate-string-db 'lookup 'one-year-ahead-desc)
+ gnc:get-one-year-ahead)))
(gnc:make-reldate-hash gnc:relative-date-hash gnc:relative-date-values)
More information about the gnucash-changes
mailing list