sfos/ledger
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix effective date command.

Browse source
This commit is contained in:
Craig Earls 2014-12-01 20:07:32 -07:00
parent 8f9c46d42b
commit 438aaf251c
1 changed files with 15 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
lisp/ledger-mode.el
View file

@ -61,11 +61,12 @@
(defconst ledger-mode-version "3.0.0") (defconst ledger-mode-version "3.0.0")
(defun ledger-mode-dump-variable (var) (defun ledger-mode-dump-variable (var)
"Format VAR for dump to buffer."
(if var (if var
(insert (format " %s: %S\n" (symbol-name var) (eval var))))) (insert (format " %s: %S\n" (symbol-name var) (eval var)))))
(defun ledger-mode-dump-group (group) (defun ledger-mode-dump-group (group)
"Dump GROUP customizations to current buffer" "Dump GROUP customizations to current buffer."
(let ((members (custom-group-members group nil))) (let ((members (custom-group-members group nil)))
(dolist (member members) (dolist (member members)
(cond ((eq (cadr member) 'custom-group) (cond ((eq (cadr member) 'custom-group)
@ -75,7 +76,7 @@
(ledger-mode-dump-variable (car member))))))) (ledger-mode-dump-variable (car member)))))))
(defun ledger-mode-dump-configuration () (defun ledger-mode-dump-configuration ()
"Dump all customizations" "Dump all customizations."
(interactive) (interactive)
(find-file "ledger-mode-dump") (find-file "ledger-mode-dump")
(ledger-mode-dump-group 'ledger)) (ledger-mode-dump-group 'ledger))
@ -96,6 +97,7 @@
"Start a ledger session with the current month, but make it customizable to ease retro-entry.") "Start a ledger session with the current month, but make it customizable to ease retro-entry.")
(defun ledger-read-account-with-prompt (prompt) (defun ledger-read-account-with-prompt (prompt)
"Read an account from the minibuffer with PROMPT."
(let ((context (ledger-context-at-point))) (let ((context (ledger-context-at-point)))
(ledger-read-string-with-default prompt (ledger-read-string-with-default prompt
(if (eq (ledger-context-line-type context) 'acct-transaction) (if (eq (ledger-context-line-type context) 'acct-transaction)
@ -103,7 +105,7 @@
nil)))) nil))))
(defun ledger-read-date (prompt) (defun ledger-read-date (prompt)
"Returns user-supplied date after `PROMPT', defaults to today." "Return user-supplied date after `PROMPT', defaults to today."
(let* ((default (ledger-year-and-month)) (let* ((default (ledger-year-and-month))
(date (read-string prompt default (date (read-string prompt default
'ledger-minibuffer-history))) 'ledger-minibuffer-history)))
@ -148,7 +150,7 @@ And calculate the target-delta of the account being reconciled."
(message balance)))) (message balance))))
(defun ledger-magic-tab (&optional interactively) (defun ledger-magic-tab (&optional interactively)
"Decide what to with with <TAB>. "Decide what to with with <TAB>, INTERACTIVELY.
Can indent, complete or align depending on context." Can indent, complete or align depending on context."
(interactive "p") (interactive "p")
(if (= (point) (line-beginning-position)) (if (= (point) (line-beginning-position))
@ -166,14 +168,14 @@ Can indent, complete or align depending on context."
ledger-default-date-format))) ledger-default-date-format)))
(defun ledger-remove-effective-date () (defun ledger-remove-effective-date ()
"Removes the effective date from a transaction or posting." "Remove the effective date from a transaction or posting."
(interactive) (interactive)
(let ((context (car (ledger-context-at-point)))) (let ((context (car (ledger-context-at-point))))
(save-excursion (save-excursion
(save-restriction (save-restriction
(narrow-to-region (point-at-bol) (point-at-eol)) (narrow-to-region (point-at-bol) (point-at-eol))
(beginning-of-line) (beginning-of-line)
(cond ((eq 'pmnt-transaction context) (cond ((eq 'xact context)
(re-search-forward ledger-iso-date-regexp) (re-search-forward ledger-iso-date-regexp)
(when (= (char-after) ?=) (when (= (char-after) ?=)
(let ((eq-pos (point))) (let ((eq-pos (point)))
@ -196,7 +198,7 @@ If `DATE' is nil, prompt the user a date.
Replace the current effective date if there's one in the same Replace the current effective date if there's one in the same
line. line.
With a prefix argument, remove the effective date. " With a prefix argument, remove the effective date."
(interactive) (interactive)
(if (and (listp current-prefix-arg) (if (and (listp current-prefix-arg)
(= 4 (prefix-numeric-value current-prefix-arg))) (= 4 (prefix-numeric-value current-prefix-arg)))
@ -206,7 +208,7 @@ With a prefix argument, remove the effective date. "
(save-restriction (save-restriction
(narrow-to-region (point-at-bol) (point-at-eol)) (narrow-to-region (point-at-bol) (point-at-eol))
(cond (cond
((eq 'pmnt-transaction context) ((eq 'xact context)
(beginning-of-line) (beginning-of-line)
(re-search-forward ledger-iso-date-regexp) (re-search-forward ledger-iso-date-regexp)
(when (= (char-after) ?=) (when (= (char-after) ?=)
@ -218,12 +220,13 @@ With a prefix argument, remove the effective date. "
(insert " ; [=" date-string "]"))))))) (insert " ; [=" date-string "]")))))))
(defun ledger-mode-remove-extra-lines () (defun ledger-mode-remove-extra-lines ()
"Get rid of multiple empty lines."
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "\n\n\\(\n\\)+" nil t) (while (re-search-forward "\n\n\\(\n\\)+" nil t)
(replace-match "\n\n"))) (replace-match "\n\n")))
(defun ledger-mode-clean-buffer () (defun ledger-mode-clean-buffer ()
"indent, remove multiple linfe feeds and sort the buffer" "Indent, remove multiple linfe feeds and sort the buffer."
(interactive) (interactive)
(untabify (point-min) (point-max)) (untabify (point-min) (point-max))
(ledger-sort-buffer) (ledger-sort-buffer)