diff options
| -rw-r--r-- | lisp/ledger-context.el | 61 | ||||
| -rw-r--r-- | lisp/ledger-init.el | 2 | ||||
| -rw-r--r-- | lisp/ledger-mode.el | 60 | ||||
| -rw-r--r-- | lisp/ledger-reconcile.el | 14 | ||||
| -rw-r--r-- | lisp/ledger-schedule.el | 5 |
5 files changed, 95 insertions, 47 deletions
diff --git a/lisp/ledger-context.el b/lisp/ledger-context.el index eb3d4353..44ad3a30 100644 --- a/lisp/ledger-context.el +++ b/lisp/ledger-context.el @@ -28,29 +28,30 @@ (eval-when-compile (require 'cl)) -;; *-string constants are assembled in the single-line-config macro to -;; form the regex and list of elements -(defconst indent-string "\\(^[ \t]+\\)") -(defconst status-string "\\([*! ]?\\)") -(defconst account-string "[\\[(]?\\(.*?\\)[])]?") -(defconst amount-string "[ \t]?\\(-?[0-9]+\\.[0-9]*\\)") -(defconst comment-string "[ \t]*;[ \t]*\\(.*?\\)") -(defconst nil-string "\\([ \t]+\\)") -(defconst commodity-string "\\(.+?\\)") -(defconst date-string "^\\([0-9]\\{4\\}[/-][01]?[0-9][/-][0123]?[0-9]\\)") -(defconst code-string "\\((.*)\\)?") -(defconst payee-string "\\(.*\\)") - -(defmacro line-regex (&rest elements) +;; ledger-*-string constants are assembled in the +;; `ledger-single-line-config' macro to form the regex and list of +;; elements +(defconst ledger-indent-string "\\(^[ \t]+\\)") +(defconst ledger-status-string "\\([*! ]?\\)") +(defconst ledger-account-string "[\\[(]?\\(.*?\\)[])]?") +(defconst ledger-amount-string "[ \t]?\\(-?[0-9]+\\.[0-9]*\\)") +(defconst ledger-comment-string "[ \t]*;[ \t]*\\(.*?\\)") +(defconst ledger-nil-string "\\([ \t]+\\)") +(defconst ledger-commodity-string "\\(.+?\\)") +(defconst ledger-date-string "^\\([0-9]\\{4\\}[/-][01]?[0-9][/-][0123]?[0-9]\\)") +(defconst ledger-code-string "\\((.*)\\)?") +(defconst ledger-payee-string "\\(.*\\)") + +(defmacro ledger-line-regex (&rest elements) (let (regex-string) (concat (dolist (e elements regex-string) (setq regex-string (concat regex-string (eval (intern - (concat (symbol-name e) "-string")))))) "[ \t]*$"))) + (concat "ledger-" (symbol-name e) "-string")))))) "[ \t]*$"))) -(defmacro single-line-config2 (&rest elements) +(defmacro ledger-single-line-config2 (&rest elements) "Take list of ELEMENTS and return regex and element list for use in context-at-point" (let (regex-string) `'(,(concat (dolist (e elements regex-string) @@ -58,26 +59,26 @@ (concat regex-string (eval (intern - (concat (symbol-name e) "-string")))))) "[ \t]*$") + (concat "ledger-" (symbol-name e) "-string")))))) "[ \t]*$") ,elements))) -(defmacro single-line-config (&rest elements) +(defmacro ledger-single-line-config (&rest elements) "Take list of ELEMENTS and return regex and element list for use in context-at-point" - `'(,(eval `(line-regex ,@elements)) + `'(,(eval `(ledger-line-regex ,@elements)) ,elements)) (defconst ledger-line-config - (list (list 'xact (list (single-line-config date nil status nil code nil payee nil comment) - (single-line-config date nil status nil code nil payee) - (single-line-config date nil status nil payee))) - (list 'acct-transaction (list (single-line-config indent comment) - (single-line-config2 indent status account nil commodity amount nil comment) - (single-line-config2 indent status account nil commodity amount) - (single-line-config2 indent status account nil amount nil commodity comment) - (single-line-config2 indent status account nil amount nil commodity) - (single-line-config2 indent status account nil amount) - (single-line-config2 indent status account nil comment) - (single-line-config2 indent status account))))) + (list (list 'xact (list (ledger-single-line-config date nil status nil code nil payee nil comment) + (ledger-single-line-config date nil status nil code nil payee) + (ledger-single-line-config date nil status nil payee))) + (list 'acct-transaction (list (ledger-single-line-config indent comment) + (ledger-single-line-config2 indent status account nil commodity amount nil comment) + (ledger-single-line-config2 indent status account nil commodity amount) + (ledger-single-line-config2 indent status account nil amount nil commodity comment) + (ledger-single-line-config2 indent status account nil amount nil commodity) + (ledger-single-line-config2 indent status account nil amount) + (ledger-single-line-config2 indent status account nil comment) + (ledger-single-line-config2 indent status account))))) (defun ledger-extract-context-info (line-type pos) "Get context info for current line with LINE-TYPE. diff --git a/lisp/ledger-init.el b/lisp/ledger-init.el index d7eeb3f6..f7b65e96 100644 --- a/lisp/ledger-init.el +++ b/lisp/ledger-init.el @@ -30,6 +30,8 @@ (defvar ledger-environment-alist nil) +(defvar ledger-default-date-format "%Y/%m/%d") + (defun ledger-init-parse-initialization (buffer) (with-current-buffer buffer (let (environment-alist) diff --git a/lisp/ledger-mode.el b/lisp/ledger-mode.el index 8ae04934..28856bd4 100644 --- a/lisp/ledger-mode.el +++ b/lisp/ledger-mode.el @@ -145,16 +145,58 @@ Can indent, complete or align depending on context." (defvar ledger-mode-abbrev-table) -(defun ledger-insert-effective-date () +(defun ledger-remove-effective-date () + "Removes the effective date from a transaction or posting." (interactive) - (let ((context (car (ledger-context-at-point))) - (date-string (format-time-string (cdr (assoc "date-format" ledger-environment-alist))))) - (cond ((eq 'xact context) - (beginning-of-line) - (insert date-string "=")) - ((eq 'acct-transaction context) - (end-of-line) - (insert " ; [=" date-string "]"))))) + (let ((context (car (ledger-context-at-point)))) + (save-excursion + (save-restriction + (narrow-to-region (point-at-bol) (point-at-eol)) + (beginning-of-line) + (cond ((eq 'xact context) + (re-search-forward ledger-iso-date-regexp) + (when (= (char-after) ?=) + (let ((eq-pos (point))) + (delete-region + eq-pos + (re-search-forward ledger-iso-date-regexp))))) + ((eq 'acct-transaction context) + ;; Match "; [=date]" & delete string + (when (re-search-forward + (concat ledger-comment-regex + "\\[=" ledger-iso-date-regexp "\\]") + nil 'noerr) + (replace-match "")))))))) + +(defun ledger-insert-effective-date (&optional arg) + "Insert an effective date to the transaction or posting. + +Replace the current effective date if there's one in the same +line. + +With a prefix argument, remove the effective date. " + (interactive "P") + (if (and (listp arg) + (= 4 (prefix-numeric-value arg))) + (ledger-remove-effective-date) + (let* ((context (car (ledger-context-at-point))) + (date-format (or + (cdr (assoc "date-format" ledger-environment-alist)) + ledger-default-date-format)) + (date-string (format-time-string date-format))) + (save-restriction + (narrow-to-region (point-at-bol) (point-at-eol)) + (cond + ((eq 'xact context) + (beginning-of-line) + (re-search-forward ledger-iso-date-regexp) + (when (= (char-after) ?=) + (ledger-remove-effective-date)) + (insert "=" date-string)) + ((eq 'acct-transaction context) + (end-of-line) + (ledger-remove-effective-date) + (insert " ; [=" date-string "]"))))))) (defun ledger-mode-remove-extra-lines () (goto-char (point-min)) diff --git a/lisp/ledger-reconcile.el b/lisp/ledger-reconcile.el index 126b7083..44e60532 100644 --- a/lisp/ledger-reconcile.el +++ b/lisp/ledger-reconcile.el @@ -28,6 +28,7 @@ ;;; Code: (require 'easymenu) +(require 'ledger-init) (defvar ledger-buf nil) (defvar ledger-bufs nil) @@ -64,7 +65,7 @@ reconcile-finish will mark all pending posting cleared." :type 'boolean :group 'ledger-reconcile) -(defcustom ledger-reconcile-default-date-format "%Y/%m/%d" +(defcustom ledger-reconcile-default-date-format ledger-default-date-format "Default date format for the reconcile buffer" :type 'string :group 'ledger-reconcile) @@ -109,7 +110,7 @@ And calculate the target-delta of the account being reconciled." (message "Pending balance: %s" (ledger-commodity-to-string pending)))))) -(defun is-stdin (file) +(defun ledger-is-stdin (file) "True if ledger FILE is standard input." (or (equal file "") @@ -279,7 +280,7 @@ and exit reconcile mode" (defun ledger-marker-where-xact-is (emacs-xact posting) "Find the position of the EMACS-XACT in the `ledger-buf'. POSTING is used in `ledger-clear-whole-transactions' is nil." - (let ((buf (if (is-stdin (nth 0 emacs-xact)) + (let ((buf (if (ledger-is-stdin (nth 0 emacs-xact)) ledger-buf (find-file-noselect (nth 0 emacs-xact))))) (cons @@ -306,15 +307,14 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (if (looking-at "(") (read (current-buffer)))))))) ;current-buffer is the *temp* created above (if (and ledger-success (> (length xacts) 0)) - (let ((date-format (cdr (assoc "date-format" ledger-environment-alist)))) + (let ((date-format (or (cdr (assoc "date-format" ledger-environment-alist)) + ledger-default-date-format))) (dolist (xact xacts) (dolist (posting (nthcdr 5 xact)) (let ((beg (point)) (where (ledger-marker-where-xact-is xact posting))) (insert (format "%s %-4s %-30s %-30s %15s\n" - (format-time-string (if date-format - date-format - ledger-reconcile-default-date-format) (nth 2 xact)) + (format-time-string date-format (nth 2 xact)) (if (nth 3 xact) (nth 3 xact) "") diff --git a/lisp/ledger-schedule.el b/lisp/ledger-schedule.el index ce77f26b..c9ee4392 100644 --- a/lisp/ledger-schedule.el +++ b/lisp/ledger-schedule.el @@ -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) @@ -288,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) |