summaryrefslogtreecommitdiff
path: root/lisp/ledger-schedule.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/ledger-schedule.el')
-rw-r--r--lisp/ledger-schedule.el75
1 files changed, 37 insertions, 38 deletions
diff --git a/lisp/ledger-schedule.el b/lisp/ledger-schedule.el
index 7497c7d0..e1e06d69 100644
--- a/lisp/ledger-schedule.el
+++ b/lisp/ledger-schedule.el
@@ -16,8 +16,8 @@
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+;; MA 02110-1301 USA.
;;; Commentary:
;;
@@ -30,6 +30,8 @@
;; function slot of the symbol VARNAME. Then use VARNAME as the
;; function without have to use funcall.
+(require 'ledger-init)
+
(defgroup ledger-schedule nil
"Support for automatically recommendation transactions."
:group 'ledger)
@@ -49,14 +51,20 @@
:type 'integer
:group 'ledger-schedule)
-(defcustom ledger-schedule-file "~/FinanceData/ledger-schedule.ledger"
+(defcustom ledger-schedule-file "~/ledger-schedule.ledger"
"File to find scheduled transactions."
:type 'file
:group 'ledger-schedule)
+(defvar ledger-schedule-available nil)
+
(defsubst between (val low high)
(and (>= val low) (<= val high)))
+(defun ledger-schedule-check-available ()
+ (setq ledger-schedule-available (and ledger-schedule-file
+ (file-exists-p ledger-schedule-file))))
+
(defun ledger-schedule-days-in-month (month year)
"Return number of days in the MONTH, MONTH is from 1 to 12.
If year is nil, assume it is not a leap year"
@@ -235,7 +243,7 @@ returns true if the date meets the requirements"
((/= 0 (setq year-match (string-to-number str)))
`(eq (nth 5 (decode-time date)) ,year-match))
(t
- (error "Improperly specified year constraint: " str)))))
+ (error "Improperly specified year constraint: %s" str)))))
(defun ledger-schedule-constrain-month (str)
@@ -247,7 +255,7 @@ returns true if the date meets the requirements"
`(eq (nth 4 (decode-time date)) ,month-match)
(error "ledger-schedule-constrain-numerical-month: month out of range %S" month-match)))
(t
- (error "Improperly specified month constraint: " str)))))
+ (error "Improperly specified month constraint: %s" str)))))
(defun ledger-schedule-constrain-day (str)
(let ((day-match t))
@@ -256,7 +264,7 @@ returns true if the date meets the requirements"
((/= 0 (setq day-match (string-to-number str)))
`(eq (nth 3 (decode-time date)) ,day-match))
(t
- (error "Improperly specified day constraint: " str)))))
+ (error "Improperly specified day constraint: %s" str)))))
(defun ledger-schedule-parse-date-descriptor (descriptor)
"Parse the date descriptor, return the evaluator"
@@ -282,7 +290,8 @@ returns true if the date meets the requirements"
"Format CANDIDATE-ITEMS for display."
(let ((candidates (ledger-schedule-list-upcoming-xacts candidate-items early horizon))
(schedule-buf (get-buffer-create ledger-schedule-buffer-name))
- (date-format (cdr (assoc "date-format" ledger-environment-alist))))
+ (date-format (or (cdr (assoc "date-format" ledger-environment-alist))
+ ledger-default-date-format)))
(with-current-buffer schedule-buf
(erase-buffer)
(dolist (candidate candidates)
@@ -291,38 +300,28 @@ returns true if the date meets the requirements"
(ledger-mode))
(length candidates)))
-
-;;
-;; Test harnesses for use in ielm
-;;
-(defvar auto-items)
-
-(defun ledger-schedule-test ( early horizon)
- (ledger-schedule-create-auto-buffer
- (ledger-schedule-scan-transactions ledger-schedule-file)
- early
- horizon
- (get-buffer "2013.ledger")))
-
-
-(defun ledger-schedule-test-predict ()
- (let ((today (current-time))
- test-date items)
-
- (loop for day from 0 to ledger-schedule-look-forward by 1 do
- (setq test-date (time-add today (days-to-time day)))
- (dolist (item auto-items items)
- (if (funcall (car item) test-date)
- (setq items (append items (list (decode-time test-date) (cdr item)))))))
- items))
-
-(defun ledger-schedule-upcoming ()
- (interactive)
+(defun ledger-schedule-upcoming (file look-backward look-forward)
+ "Generate upcoming transaction
+
+FILE is the file containing the scheduled transaction,
+default to `ledger-schedule-file'.
+LOOK-BACKWARD is the number of day in the past to look at
+default to `ledger-schedule-look-backward'
+LOOK-FORWARD is the number of day in the futur to look at
+default to `ledger-schedule-look-forward'
+
+Use a prefix arg to change the default value"
+ (interactive (if current-prefix-arg
+ (list (read-file-name "Schedule File: " () ledger-schedule-file t)
+ (read-number "Look backward: " ledger-schedule-look-backward)
+ (read-number "Look forward: " ledger-schedule-look-forward))
+ (list ledger-schedule-file ledger-schedule-look-backward ledger-schedule-look-forward)))
(ledger-schedule-create-auto-buffer
- (ledger-schedule-scan-transactions ledger-schedule-file)
- ledger-schedule-look-backward
- ledger-schedule-look-forward
- (current-buffer)))
+ (ledger-schedule-scan-transactions file)
+ look-backward
+ look-forward
+ (current-buffer))
+ (pop-to-buffer ledger-schedule-buffer-name))
(provide 'ledger-schedule)