diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ledger-commodities.el | 23 | ||||
| -rw-r--r-- | lisp/ledger-complete.el | 4 | ||||
| -rw-r--r-- | lisp/ledger-mode.el | 4 | ||||
| -rw-r--r-- | lisp/ledger-schedule.el | 104 |
4 files changed, 69 insertions, 66 deletions
diff --git a/lisp/ledger-commodities.el b/lisp/ledger-commodities.el index e6f5417d..c2d7639b 100644 --- a/lisp/ledger-commodities.el +++ b/lisp/ledger-commodities.el @@ -33,11 +33,6 @@ :type 'string :group 'ledger-reconcile) -(defcustom ledger-scale 10000 - "The 10 ^ maximum number of digits you would expect to appear in your reports. -This is a cheap way of getting around floating point silliness in subtraction" - :group 'ledger) - (defun ledger-split-commodity-string (str) "Split a commoditized string, STR, into two parts. Returns a list with (value commodity)." @@ -86,11 +81,7 @@ Returns a list with (value commodity)." (defun -commodity (c1 c2) "Subtract C2 from C1, ensuring their commodities match." (if (string= (cadr c1) (cadr c2)) - ; the scaling below is to get around inexact - ; subtraction results where, for example 1.23 - ; - 4.56 = -3.3299999999999996 instead of - ; -3.33 - (list (/ (- (* ledger-scale (car c1)) (* ledger-scale (car c2))) ledger-scale) (cadr c1)) + (list (-(car c1) (car c2)) (cadr c1)) (error "Can't subtract different commodities %S from %S" c2 c1))) (defun +commodity (c1 c2) @@ -100,22 +91,21 @@ Returns a list with (value commodity)." (error "Can't add different commodities, %S to %S" c1 c2))) (defun ledger-strip (str char) - (let (new-str) - (concat (dolist (ch (append str nil) new-str) - (unless (= ch char) - (setq new-str (append new-str (list ch)))))))) + "Return STR with CHAR removed." + (replace-regexp-in-string char "" str)) (defun ledger-string-to-number (str &optional decimal-comma) "improve builtin string-to-number by handling internationalization, and return nil if number can't be parsed" (let ((nstr (if (or decimal-comma (assoc "decimal-comma" ledger-environment-alist)) - (ledger-strip str ?.) - (ledger-strip str ?,)))) + (ledger-strip str ".") + (ledger-strip str ",")))) (while (string-match "," nstr) ;if there is a comma now, it is a thousands separator (setq nstr (replace-match "." nil nil nstr))) (string-to-number nstr))) (defun ledger-number-to-string (n &optional decimal-comma) + "number-to-string that handles comma as decimal." (let ((str (number-to-string n))) (when (or decimal-comma (assoc "decimal-comma" ledger-environment-alist)) @@ -134,6 +124,7 @@ longer ones are after the value." (concat commodity " " str)))) (defun ledger-read-commodity-string (prompt) + "Read an amount from mini-buffer using PROMPT." (let ((str (read-from-minibuffer (concat prompt " (" ledger-reconcile-default-commodity "): "))) comm) diff --git a/lisp/ledger-complete.el b/lisp/ledger-complete.el index bc4b1854..fd79656a 100644 --- a/lisp/ledger-complete.el +++ b/lisp/ledger-complete.el @@ -157,9 +157,7 @@ (ledger-accounts))))) (defun ledger-trim-trailing-whitespace (str) - (let ((s str)) - (when (string-match "[ \t]*$" s) - (replace-match "" nil nil s)))) + (replace-regexp-in-string "[ \t]*$" "" str)) (defun ledger-fully-complete-xact () "Completes a transaction if there is another matching payee in the buffer. diff --git a/lisp/ledger-mode.el b/lisp/ledger-mode.el index 1eab0f3b..92de4277 100644 --- a/lisp/ledger-mode.el +++ b/lisp/ledger-mode.el @@ -273,7 +273,7 @@ With a prefix argument, remove the effective date. " ["Narrow to REGEX" ledger-occur] ["Ledger Statistics" ledger-display-ledger-stats ledger-works] "---" - ["Show upcoming transactions" ledger-schedule-upcoming ledger-schedule-available] + ["Show upcoming transactions" ledger-schedule-upcoming] ["Add Transaction (ledger xact)" ledger-add-transaction ledger-works] ["Complete Transaction" ledger-fully-complete-xact] ["Delete Transaction" ledger-delete-current-transaction] @@ -312,8 +312,6 @@ With a prefix argument, remove the effective date. " (define-derived-mode ledger-mode text-mode "Ledger" "A mode for editing ledger data files." (ledger-check-version) - (ledger-schedule-check-available) - (if (boundp 'font-lock-defaults) (setq-local font-lock-defaults '(ledger-font-lock-keywords t t nil nil diff --git a/lisp/ledger-schedule.el b/lisp/ledger-schedule.el index a5e7decb..9411bd15 100644 --- a/lisp/ledger-schedule.el +++ b/lisp/ledger-schedule.el @@ -22,7 +22,7 @@ ;;; Commentary: ;; ;; This module provides for automatically adding transactions to a -;; ledger buffer on a periodic basis. Recurrence expressions are +;; ledger buffer on a periodic basis. Recurrence expressions are ;; inspired by Martin Fowler's "Recurring Events for Calendars", ;; martinfowler.com/apsupp/recurring.pdf @@ -32,12 +32,14 @@ (require 'ledger-init) +;;; Code: + (defgroup ledger-schedule nil "Support for automatically recommendation transactions." :group 'ledger) (defcustom ledger-schedule-buffer-name "*Ledger Schedule*" - "Name for the schedule buffer" + "Name for the schedule buffer." :type 'string :group 'ledger-schedule) @@ -47,7 +49,7 @@ :group 'ledger-schedule) (defcustom ledger-schedule-look-forward 14 - "Number of days auto look forward to recommend transactions" + "Number of days auto look forward to recommend transactions." :type 'integer :group 'ledger-schedule) @@ -56,37 +58,40 @@ :type 'file :group 'ledger-schedule) -(defvar ledger-schedule-available nil) +(defcustom ledger-schedule-week-days '(("Mo" 1) + ("Tu" 2) + ("We" 3) + ("Th" 4) + ("Fr" 5) + ("Sa" 6) + ("Su" 7)) + "List of weekday abbreviations. There must be exactly seven +entries each with a two character abbreviation for a day and the +number of that day in the week. " + :type '(alist :value-type (group integer)) + :group 'ledger-schedule) (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)))) + "Return TRUE if VAL > LOW and < HIGH." + (and (>= val low) (<= val high))) (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" +If YEAR is nil, assume it is not a leap year" (if (between month 1 12) (if (and year (date-leap-year-p year) (= 2 month)) 29 (nth (1- month) '(31 28 31 30 31 30 31 31 30 31 30 31))) (error "Month out of range, MONTH=%S" month))) -(defun ledger-schedule-encode-day-of-week ( day-string) - "return the numerical day of week corresponding to DAY-STRING" - (cond ((string= day-string "Su") 7) - ((string= day-string "Mo") 1) - ((string= day-string "Tu") 2) - ((string= day-string "We") 3) - ((string= day-string "Th") 4) - ((string= day-string "Fr") 5) - ((string= day-string "Sa") 6))) +(defun ledger-schedule-encode-day-of-week (day-string) + "Return the numerical day of week corresponding to DAY-STRING." + (cadr (assoc day-string ledger-schedule-week-days))) + ;; Macros to handle date expressions (defun ledger-schedule-constrain-day-in-month (count day-of-week) - "Return a form that evaluates DATE that returns true for the COUNT DAY-OF-WEEK. + "Return a form that returns TRUE for the the COUNT DAY-OF-WEEK. For example, return true if date is the 3rd Thursday of the month. Negative COUNT starts from the end of the month. (EQ COUNT 0) means EVERY day-of-week (eg. every Saturday)" @@ -118,7 +123,7 @@ COUNT 0) means EVERY day-of-week (eg. every Saturday)" day-of-week))) (defun ledger-schedule-constrain-every-count-day (day-of-week skip start-date) - "Return a form that is true for every DAY skipping SKIP, starting on START. + "Return a form that is true for every DAY-OF-WEEK skipping SKIP, starting on START-DATE. For example every second Friday, regardless of month." (let ((start-day (nth 6 (decode-time start-date)))) (if (eq start-day day-of-week) ;; good, can proceed @@ -139,12 +144,9 @@ For example every second Friday, regardless of month." (< ,target-day ,day2)))))) -(defun ledger-schedule-is-holiday (date) - "Return true if DATE is a holiday." - nil) (defun ledger-schedule-scan-transactions (schedule-file) - "Scans SCHEDULE-FILE and returns a list of transactions with date predicates. + "Scan SCHEDULE-FILE and return a list of transactions with date predicates. The car of each item is a function of date that returns true if the transaction should be logged for that day." (interactive "fFile name: ") @@ -156,13 +158,13 @@ the transaction should be logged for that day." (let ((date-descriptor "") (transaction nil) (xact-start (match-end 0))) - (setq date-descriptors + (setq date-descriptor (ledger-schedule-read-descriptor-tree (buffer-substring-no-properties (match-beginning 0) (match-end 0)))) (forward-paragraph) - (setq transaction (list date-descriptors + (setq transaction (list date-descriptor (buffer-substring-no-properties xact-start (point)))) @@ -170,10 +172,13 @@ the transaction should be logged for that day." xact-list))) (defun ledger-schedule-read-descriptor-tree (descriptor-string) - (ledger-schedule-transform-auto-tree (split-string (substring descriptor-string 1 (string-match "]" descriptor-string)) " "))) + "Read DESCRIPTOR-STRING and return a form that evaluates dates." + (ledger-schedule-transform-auto-tree + (split-string + (substring descriptor-string 1 (string-match "]" descriptor-string)) " "))) (defun ledger-schedule-transform-auto-tree (descriptor-string-list) - "Takes a lisp list of date descriptor strings, TREE, and returns a string with a lambda function of date." + "Take DESCRIPTOR-STRING-LIST, and return a string with a lambda function of date." ;; use funcall to use the lambda function spit out here (if (consp descriptor-string-list) (let (result) @@ -194,7 +199,7 @@ the transaction should be logged for that day." ,(nconc (list 'or) (nreverse result) descriptor-string-list))))) (defun ledger-schedule-compile-constraints (descriptor-string) - "Return a list with the year, month and day fields split" + "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)) @@ -204,6 +209,10 @@ the transaction should be logged for that day." (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 ",")))) @@ -211,6 +220,10 @@ the transaction should be logged for that day." (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 @@ -223,6 +236,10 @@ the transaction should be logged for that day." (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. + +YEAR-DESC, MONT-DESC, and DAY-DESC are the string portions of the +date descriptor." (cond ((string= day-desc "*") t) ((string-match "[A-Za-z]" day-desc) ;; There is something other than digits and commas @@ -235,6 +252,7 @@ the transaction should be logged for that day." (defun ledger-schedule-parse-complex-date (year-desc month-desc day-desc) + "Parse day descriptors that have repeats." (let ((years (mapcar 'string-to-number (split-string year-desc ","))) (months (mapcar 'string-to-number (split-string month-desc ","))) (day-parts (split-string day-desc "+")) @@ -252,7 +270,7 @@ the transaction should be logged for that day." (ledger-schedule-constrain-day-in-month count day-of-week))))) (defun ledger-schedule-list-upcoming-xacts (candidate-items early horizon) - "Search CANDIDATE-ITEMS for xacts that occur within the period today - EARLY to today + HORIZON" + "Search CANDIDATE-ITEMS for xacts that occur within the period today - EARLY to today + HORIZON." (let ((start-date (time-subtract (current-time) (days-to-time early))) test-date items) (loop for day from 0 to (+ early horizon) by 1 do @@ -262,12 +280,6 @@ the transaction should be logged for that day." (setq items (append items (list (list test-date (cadr candidate)))))))) items)) -(defun ledger-schedule-already-entered (candidate buffer) - "return TRUE if CANDIDATE is already in BUFFER" - (let ((target-date (format-time-string date-format (car candidate))) - (target-payee (cadr candidate))) - nil)) - (defun ledger-schedule-create-auto-buffer (candidate-items early horizon ledger-buf) "Format CANDIDATE-ITEMS for display." (let ((candidates (ledger-schedule-list-upcoming-xacts candidate-items early horizon)) @@ -283,7 +295,7 @@ the transaction should be logged for that day." (length candidates))) (defun ledger-schedule-upcoming (file look-backward look-forward) - "Generate upcoming transaction + "Generate upcoming transactions. FILE is the file containing the scheduled transaction, default to `ledger-schedule-file'. @@ -298,12 +310,16 @@ Use a prefix arg to change the default value" (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 file) - look-backward - look-forward - (current-buffer)) - (pop-to-buffer ledger-schedule-buffer-name)) + (if (and ledger-schedule-file + (file-exists-p ledger-schedule-file)) + (progn + (ledger-schedule-create-auto-buffer + (ledger-schedule-scan-transactions file) + look-backward + look-forward + (current-buffer)) + (pop-to-buffer ledger-schedule-buffer-name)) + (error "Could not find ledger schedule file at %s" ledger-schedule-file))) (provide 'ledger-schedule) |