diff options
Diffstat (limited to 'lisp/ledger-schedule.el')
| -rw-r--r-- | lisp/ledger-schedule.el | 60 |
1 files changed, 32 insertions, 28 deletions
diff --git a/lisp/ledger-schedule.el b/lisp/ledger-schedule.el index 1fbbcb59..ae08ad36 100644 --- a/lisp/ledger-schedule.el +++ b/lisp/ledger-schedule.el @@ -30,9 +30,11 @@ ;; function slot of the symbol VARNAME. Then use VARNAME as the ;; function without have to use funcall. + (require 'ledger-init) -(require 'cl) +(require 'cl-macs) +(declare-function ledger-mode "ledger-mode") ;;; Code: (defgroup ledger-schedule nil @@ -100,15 +102,15 @@ COUNT 0) means EVERY day-of-week (eg. every Saturday)" (cond ((zerop count) ;; Return true if day-of-week matches `(eq (nth 6 (decode-time date)) ,day-of-week)) ((> count 0) ;; Positive count - (let ((decoded (gensym))) + (let ((decoded (cl-gensym))) `(let ((,decoded (decode-time date))) (and (eq (nth 6 ,decoded) ,day-of-week) (between (nth 3 ,decoded) ,(* (1- count) 7) ,(* count 7)))))) ((< count 0) - (let ((days-in-month (gensym)) - (decoded (gensym))) + (let ((days-in-month (cl-gensym)) + (decoded (cl-gensym))) `(let* ((,decoded (decode-time date)) (,days-in-month (ledger-schedule-days-in-month (nth 4 ,decoded) @@ -133,9 +135,9 @@ For example every second Friday, regardless of month." (defun ledger-schedule-constrain-date-range (month1 day1 month2 day2) "Return a form of DATE that is true if DATE falls between MONTH1 DAY1 and MONTH2 DAY2." - (let ((decoded (gensym)) - (target-month (gensym)) - (target-day (gensym))) + (let ((decoded (cl-gensym)) + (target-month (cl-gensym)) + (target-day (cl-gensym))) `(let* ((,decoded (decode-time date)) (,target-month (nth 4 decoded)) (,target-day (nth 3 decoded))) @@ -202,39 +204,41 @@ the transaction should be logged for that day." (defun ledger-schedule-compile-constraints (descriptor-string) "Return a list with the year, month and day fields split." (let ((fields (split-string descriptor-string "[/\\-]" t))) - (if (string-match "[A-Za-z]" descriptor-string) - (ledger-schedule-constrain-day (nth 0 fields) (nth 1 fields) (nth 2 fields)) - (list 'and - (ledger-schedule-constrain-day (nth 0 fields) (nth 1 fields) (nth 2 fields)) - (ledger-schedule-constrain-year (nth 0 fields) (nth 1 fields) (nth 2 fields)) - (ledger-schedule-constrain-month (nth 0 fields) (nth 1 fields) (nth 2 fields)))))) + (list 'and + (ledger-schedule-constrain-day (nth 0 fields) (nth 1 fields) (nth 2 fields)) + (ledger-schedule-constrain-year (nth 0 fields) (nth 1 fields) (nth 2 fields)) + (ledger-schedule-constrain-month (nth 0 fields) (nth 1 fields) (nth 2 fields))))) (defun ledger-schedule-constrain-year (year-desc month-desc day-desc) "Return a form that constrains the year. YEAR-DESC, MONT-DESC, and DAY-DESC are the string portions of the date descriptor." - (cond ((string= year-desc "*") t) - ((/= 0 (string-to-number year-desc)) - `(memq (nth 5 (decode-time date)) ',(mapcar 'string-to-number (split-string year-desc ",")))) - (t - (error "Improperly specified year constraint: %s %s %s" year-desc month-desc day-desc)))) + (cond + ((string-match "[A-Za-z]" day-desc) t) ; there is an advanced day descriptor which overrides the year + ((string= year-desc "*") t) + ((/= 0 (string-to-number year-desc)) + `(memq (nth 5 (decode-time date)) ',(mapcar 'string-to-number (split-string year-desc ",")))) + (t + (error "Improperly specified year constraint: %s %s %s" year-desc month-desc day-desc)))) (defun ledger-schedule-constrain-month (year-desc month-desc day-desc) "Return a form that constrains the month. YEAR-DESC, MONT-DESC, and DAY-DESC are the string portions of the date descriptor." - (cond ((string= month-desc "*") - t) ;; always match - ((string= month-desc "E") ;; Even - `(evenp (nth 4 (decode-time date)))) - ((string= month-desc "O") ;; Odd - `(oddp (nth 4 (decode-time date)))) - ((/= 0 (string-to-number month-desc)) ;; Starts with number - `(memq (nth 4 (decode-time date)) ',(mapcar 'string-to-number (split-string month-desc ",")))) - (t - (error "Improperly specified month constraint: %s %s %s" year-desc month-desc day-desc)))) + (cond + ((string-match "[A-Za-z]" day-desc) t) ; there is an advanced day descriptor which overrides the month + ((string= month-desc "*") + t) ;; always match + ((string= month-desc "E") ;; Even + `(evenp (nth 4 (decode-time date)))) + ((string= month-desc "O") ;; Odd + `(oddp (nth 4 (decode-time date)))) + ((/= 0 (string-to-number month-desc)) ;; Starts with number + `(memq (nth 4 (decode-time date)) ',(mapcar 'string-to-number (split-string month-desc ",")))) + (t + (error "Improperly specified month constraint: %s %s %s" year-desc month-desc day-desc)))) (defun ledger-schedule-constrain-day (year-desc month-desc day-desc) "Return a form that constrains the day. |