daniel/emacs-conf
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

update packages

Browse Source
This commit is contained in:
Daniel Weschke
2025-02-26 20:16:44 +01:00
parent 59db017445
commit 45d49daef0
291 changed files with 16240 additions and 522600 deletions
Download Patch File Download Diff File Expand all files Collapse all files

29
lisp/ledger-mode/ledger-check.el
View File

@@ -32,20 +32,20 @@
(defvar ledger-check-buffer-name "*Ledger Check*")
(defvar ledger-original-window-cfg nil)
(defvar-local ledger-check--original-window-configuration nil)
(defvar ledger-check-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [return] 'ledger-report-visit-source)
(define-key map [?q] 'ledger-check-quit)
(define-key map (kbd "RET") #'ledger-report-visit-source)
(define-key map (kbd "q") #'ledger-check-quit)
map)
"Keymap for `ledger-check-mode'.")
(easy-menu-define ledger-check-mode-menu ledger-check-mode-map
"Ledger check menu"
"Ledger check menu."
'("Check"
;; ["Re-run Check" ledger-check-redo]
"---"
@@ -106,22 +106,25 @@
"Quit the ledger check buffer."
(interactive)
(ledger-check-goto)
(set-window-configuration ledger-original-window-cfg)
(set-window-configuration ledger-check--original-window-configuration)
(kill-buffer (get-buffer ledger-check-buffer-name)))
(defun ledger-check-buffer ()
(defun ledger-check-buffer (&optional interactive)
"Check the current buffer for errors.
Runs ledger with --explicit and --strict report errors and assist
with fixing them.
The output buffer will be in `ledger-check-mode', which defines
commands for navigating the buffer to the errors found, etc."
(interactive
(progn
(when (and (buffer-modified-p)
(y-or-n-p "Buffer modified, save it? "))
(save-buffer))))
commands for navigating the buffer to the errors found, etc.
When INTERACTIVE is non-nil (i.e., when called interactively),
prompt to save if the current buffer is modified."
(interactive "p")
(when (and interactive
(buffer-modified-p)
(y-or-n-p "Buffer modified, save it? "))
(save-buffer))
(let ((_buf (find-file-noselect (ledger-master-file)))
(cbuf (get-buffer ledger-check-buffer-name))
(wcfg (current-window-configuration)))
@@ -130,7 +133,7 @@ commands for navigating the buffer to the errors found, etc."
(with-current-buffer
(pop-to-buffer (get-buffer-create ledger-check-buffer-name))
(ledger-check-mode)
(set (make-local-variable 'ledger-original-window-cfg) wcfg)
(setq ledger-check--original-window-configuration wcfg)
(ledger-do-check)
(shrink-window-if-larger-than-buffer)
(set-buffer-modified-p nil)

41
lisp/ledger-mode/ledger-commodities.el
View File

@@ -94,16 +94,30 @@ Returns a list with (value commodity)."
(split-string str "[\n\r]")))
(defun ledger-subtract-commodity (c1 c2)
"Subtract C2 from C1, ensuring their commodities match."
(if (string= (cadr c1) (cadr c2))
(list (-(car c1) (car c2)) (cadr c1))
(error "Can't subtract different commodities %S from %S" c2 c1)))
"Subtract C2 from C1, ensuring their commodities match.
As an exception, if the quantity of C2 is zero, C1 is returned
directly."
(cond
((zerop (car c2)) c1)
((string= (cadr c1) (cadr c2))
(list (- (car c1) (car c2)) (cadr c1)))
(t (error "Can't subtract different commodities: %S - %S" c1 c2))))
(defun ledger-add-commodity (c1 c2)
"Add C1 and C2, ensuring their commodities match."
(if (string= (cadr c1) (cadr c2))
(list (+ (car c1) (car c2)) (cadr c1))
(error "Can't add different commodities, %S to %S" c1 c2)))
"Add C1 and C2, ensuring their commodities match.
As an exception, if the quantity of C2 is zero, C1 is returned
directly."
(cond
((zerop (car c2)) c1)
((string= (cadr c1) (cadr c2))
(list (+ (car c1) (car c2)) (cadr c1)))
(t (error "Can't add different commodities: %S + %S" c1 c2))))
(defun ledger-negate-commodity (c)
"Return the negative of the commoditized amount C."
(list (- (car c)) (cadr c)))
(defun ledger-strip (str char)
"Return STR with CHAR removed."
@@ -148,13 +162,12 @@ longer ones are after the value."
(let ((str (read-from-minibuffer
(concat prompt " (" ledger-reconcile-default-commodity "): ")))
comm)
(if (and (> (length str) 0)
(when (and (> (length str) 0)
(ledger-split-commodity-string str))
(progn
(setq comm (ledger-split-commodity-string str))
(if (cadr comm)
comm
(list (car comm) ledger-reconcile-default-commodity))))))
(setq comm (ledger-split-commodity-string str))
(if (cadr comm)
comm
(list (car comm) ledger-reconcile-default-commodity)))))
(provide 'ledger-commodities)

314
lisp/ledger-mode/ledger-complete.el
View File

@@ -35,15 +35,30 @@
(defcustom ledger-accounts-file nil
"The path to an optional file in which all accounts are used or declared.
This file will then be used as a source for account name completions."
:type 'file
:group 'ledger)
This file will then be used as a source for account name
completions instead of the current file.
See ledger's \"account\" directive."
:type '(choice (const :tag "Use current buffer for completion" nil)
file)
:group 'ledger
:safe #'string-or-null-p)
(defcustom ledger-payees-file nil
"The path to an optional file in which all payees are used or declared.
This file will then be used as a source for payee name
completions instead of the current file.
See ledger's \"payee\" directive."
:type '(choice (const :tag "Use current buffer for completion" nil)
file)
:group 'ledger
:safe #'string-or-null-p)
(defcustom ledger-accounts-exclude-function nil
"Function to exclude accounts from completion.
Should be a predicate function that accepts one argument, an
element of `ledger-accounts-list-in-buffer'."
:type 'function
:type '(choice (const :tag "Do not exclude any accounts from completion" nil)
function)
:group 'ledger
:package-version '(ledger-mode . "2019-08-14"))
@@ -54,52 +69,30 @@ If nil, full account names are offered for completion."
:group 'ledger
:package-version '(ledger-mode . "4.0.0"))
(defun ledger-parse-arguments ()
"Parse whitespace separated arguments in the current region."
;; FIXME: We don't use pcomplete anymore.
;; This is more complex than it appears
;; to need, so that it can work with pcomplete. See
;; pcomplete-parse-arguments-function for details
(let* ((begin (save-match-data
(if (looking-back (concat "^\\(" ledger-iso-date-regexp "=\\|\\)"
ledger-incomplete-date-regexp) nil)
(match-end 1)
(save-excursion
(ledger-thing-at-point) ;; leave point at beginning of thing under point
(point)))))
(end (point))
begins args)
;; to support end of line metadata
(save-excursion
(when (search-backward ";"
(line-beginning-position) t)
(setq begin (match-beginning 0))))
(save-excursion
(goto-char begin)
(when (< (point) end)
(skip-chars-forward " \t\n")
(setq begins (cons (point) begins))
(setq args (cons (buffer-substring-no-properties
(car begins) end)
args)))
(cons (reverse args) (reverse begins)))))
(defun ledger-payees-in-buffer ()
"Scan buffer and return list of all payees."
(let ((origin (point))
payees-list)
(save-excursion
(goto-char (point-min))
(while (re-search-forward
ledger-payee-any-status-regex nil t) ;; matches first line
(while (re-search-forward ledger-payee-name-or-directive-regex nil t)
(unless (and (>= origin (match-beginning 0))
(< origin (match-end 0)))
(setq payees-list (cons (match-string-no-properties 3)
payees-list))))) ;; add the payee
(push (or (match-string-no-properties 1) (match-string-no-properties 2))
payees-list))))
;; to the list
(sort (delete-dups payees-list) #'string-lessp)))
(defun ledger-payees-list ()
"Return a list of all known account names as strings.
Looks in `ledger-payees-file' if set, otherwise the current buffer."
(if ledger-payees-file
(let ((f ledger-payees-file))
(with-temp-buffer
(insert-file-contents f)
(ledger-payees-in-buffer)))
(ledger-payees-in-buffer)))
(defun ledger-accounts-in-buffer ()
"Return an alist of accounts in the current buffer.
The `car' of each element is the account name and the `cdr' is an
@@ -146,12 +139,14 @@ Then one of the elements this function returns will be
;; with directives. But the name is a little misleading. Should we
;; make a ledger-mode-be-pedantic and use that instead?
(bound-and-true-p ledger-flymake-be-pedantic)
(goto-char (point-min))
(while (re-search-forward ledger-account-name-or-directive-regex nil t)
(let ((account (match-string-no-properties 1)))
(unless (gethash account seen)
(puthash account t seen)
(push (cons account nil) account-list)))))
(ledger-xact-iterate-transactions
(lambda (_pos _date _state _payee)
(let ((end (save-excursion (ledger-navigate-end-of-xact))))
(while (re-search-forward ledger-account-any-status-regex end t)
(let ((account (match-string-no-properties 1)))
(unless (gethash account seen)
(puthash account t seen)
(push (cons account nil) account-list))))))))
(sort account-list (lambda (a b) (string-lessp (car a) (car b)))))))
(defun ledger-accounts-list-in-buffer ()
@@ -173,35 +168,35 @@ Looks in `ledger-accounts-file' if set, otherwise the current buffer."
(ledger-accounts-list-in-buffer)))
(ledger-accounts-list-in-buffer)))
(defun ledger-find-accounts-in-buffer ()
(let ((account-tree (list t))
(account-elements nil)
(prefix ""))
(save-excursion
(goto-char (point-min))
(dolist (account
(cl-remove-if-not (lambda (c) (string-prefix-p prefix c))
(ledger-accounts-list)))
(let ((root account-tree))
(setq account-elements
(split-string
account ":"))
(while account-elements
(let ((xact (assoc (car account-elements) root)))
(if xact
(setq root (cdr xact))
(setq xact (cons (car account-elements) (list t)))
(nconc root (list xact))
(setq root (cdr xact))))
(setq account-elements (cdr account-elements))))))
account-tree))
(defun ledger-accounts-tree ()
"Return a tree of all accounts in the buffer."
(let* ((current (caar (ledger-parse-arguments)))
"Return a tree of all accounts in the buffer.
Each node in the tree is a list (t . CHILDREN), where CHILDREN is
an alist (ACCOUNT-ELEMENT . NODE)."
(let ((account-tree (list t)))
(dolist (account (ledger-accounts-list) account-tree)
(let ((root account-tree)
(account-elements (split-string account ":")))
(dolist (element account-elements)
(let ((node (assoc element root)))
(unless node
(setq node (cons element (list t)))
(nconc root (list node)))
(setq root (cdr node))))))))
(defun ledger-complete-account-next-steps ()
"Return a list of next steps for the account prefix at point."
;; FIXME: This function is called from `ledger-complete-at-point' which
;; already knows the bounds of the account name to complete. Computing it
;; again here is wasteful.
(let* ((current (buffer-substring
(save-excursion
(unless (eq 'posting (ledger-thing-at-point))
(error "Not on a posting line"))
(point))
(point)))
(elements (and current (split-string current ":")))
(root (ledger-find-accounts-in-buffer))
(root (ledger-accounts-tree))
(prefix nil))
(while (cdr elements)
(let ((xact (assoc (car elements) root)))
@@ -225,51 +220,61 @@ Looks in `ledger-accounts-file' if set, otherwise the current buffer."
(cdr root))
'string-lessp))))
(defun ledger-complete-date (month-string day-string)
(defvar ledger-complete--current-time-for-testing nil
"Internal, used for testing only.")
(defun ledger-complete-date (month-string day-string date-at-eol-p)
"Complete a date."
(let*
((now (current-time))
(decoded (decode-time now))
(this-month (nth 4 decoded))
(this-year (nth 5 decoded))
(last-month (if (> this-month 1) (1- this-month) 12))
(last-year (1- this-year))
(last-month-year (if (> this-month 1) this-year last-year))
(month (and month-string
(string-to-number month-string)))
(day (string-to-number day-string))
(dates (list (encode-time 0 0 0 day (or month this-month) this-year)
(if month
(encode-time 0 0 0 day month last-year)
(encode-time 0 0 0 day last-month last-month-year)))))
(lambda (_string _predicate _all)
(concat (ledger-format-date
(cl-find-if (lambda (date) (not (time-less-p now date))) dates))
(and (= (point) (line-end-position)) " ")))))
(let* ((now (or ledger-complete--current-time-for-testing (current-time)))
(decoded (decode-time now))
(this-month (nth 4 decoded))
(this-year (nth 5 decoded))
(last-month (if (> this-month 1) (1- this-month) 12))
(last-year (1- this-year))
(last-month-year (if (> this-month 1) this-year last-year))
(month (and month-string
(string-to-number month-string)))
(day (string-to-number day-string))
(dates (list (encode-time 0 0 0 day (or month this-month) this-year)
(if month
(encode-time 0 0 0 day month last-year)
(encode-time 0 0 0 day last-month last-month-year)))))
(let ((collection
(list (concat (ledger-format-date
(cl-find-if (lambda (date) (not (time-less-p now date))) dates))
(when date-at-eol-p " ")))))
(lambda (string predicate action)
(if (eq action 'metadata)
'(metadata (category . ledger-date))
(complete-with-action action collection string predicate))))))
(defun ledger-complete-effective-date
(tx-year-string tx-month-string tx-day-string
month-string day-string)
month-string day-string
date-at-eol-p)
"Complete an effective date."
(let*
((tx-year (string-to-number tx-year-string))
(tx-month (string-to-number tx-month-string))
(tx-day (string-to-number tx-day-string))
(tx-date (encode-time 0 0 0 tx-day tx-month tx-year))
(next-month (if (< tx-month 12) (1+ tx-month) 1))
(next-year (1+ tx-year))
(next-month-year (if (< tx-month 12) tx-year next-year))
(month (and month-string
(string-to-number month-string)))
(day (string-to-number day-string))
(dates (list (encode-time 0 0 0 day (or month tx-month) tx-year)
(if month
(encode-time 0 0 0 day month next-year)
(encode-time 0 0 0 day next-month next-month-year)))))
(lambda (_string _predicate _all)
(concat (ledger-format-date
(cl-find-if (lambda (date) (not (time-less-p date tx-date))) dates))
(and (= (point) (line-end-position)) " ")))))
(let* ((tx-year (string-to-number tx-year-string))
(tx-month (string-to-number tx-month-string))
(tx-day (string-to-number tx-day-string))
(tx-date (encode-time 0 0 0 tx-day tx-month tx-year))
(next-month (if (< tx-month 12) (1+ tx-month) 1))
(next-year (1+ tx-year))
(next-month-year (if (< tx-month 12) tx-year next-year))
(month (and month-string
(string-to-number month-string)))
(day (string-to-number day-string))
(dates (list (encode-time 0 0 0 day (or month tx-month) tx-year)
(if month
(encode-time 0 0 0 day month next-year)
(encode-time 0 0 0 day next-month next-month-year)))))
(let ((collection
(list (concat (ledger-format-date
(cl-find-if (lambda (date) (not (time-less-p date tx-date))) dates))
(when date-at-eol-p " ")))))
(lambda (string predicate action)
(if (eq action 'metadata)
'(metadata (category . ledger-date))
(complete-with-action action collection string predicate))))))
(defun ledger-complete-at-point ()
"Do appropriate completion for the thing at point."
@@ -278,49 +283,78 @@ Looks in `ledger-accounts-file' if set, otherwise the current buffer."
realign-after
delete-suffix)
(cond (;; Date
(looking-back (concat "^" ledger-incomplete-date-regexp) (line-beginning-position))
(setq collection (ledger-complete-date (match-string 1) (match-string 2))
(save-excursion
(skip-chars-forward "0-9/-")
(looking-back (concat "^" ledger-incomplete-date-regexp) (line-beginning-position)))
(setq collection (ledger-complete-date (match-string 1)
(match-string 2)
(= (line-end-position) (match-end 0)))
start (match-beginning 0)
;; FIXME: This delete-suffix-post-completion behavior is weird
;; and doesn't integrate well with different completion styles.
;; For example, it breaks partial-completion's behavior when in
;; the middle of the identifier.
;;
;; Instead, it should be implemented as an alternative
;; completion style which is like emacs22 but discards the
;; suffix. Or perhaps ledger-mode might rebind TAB to some key
;; that deletes the account at point and then calls completion.
delete-suffix (save-match-data
(when (looking-at (rx (one-or-more (or digit (any ?/ ?-)))))
(length (match-string 0))))))
(;; Effective dates
(looking-back (concat "^" ledger-iso-date-regexp "=" ledger-incomplete-date-regexp)
(line-beginning-position))
(save-excursion
(skip-chars-forward "0-9/-")
(looking-back (concat "^" ledger-iso-date-regexp "=" ledger-incomplete-date-regexp)
(line-beginning-position)))
(setq start (line-beginning-position))
(setq collection (ledger-complete-effective-date
(match-string 2) (match-string 3) (match-string 4)
(match-string 5) (match-string 6))))
(match-string 5) (match-string 6)
(= (line-end-position) (match-end 0)))))
(;; Payees
(eq (save-excursion (ledger-thing-at-point)) 'transaction)
(setq start (save-excursion (backward-word) (point)))
(setq collection #'ledger-payees-in-buffer))
(eq 'transaction
(save-excursion
(prog1 (ledger-thing-at-point)
(setq start (point)))))
(setq collection (cons 'nullary #'ledger-payees-list)))
(;; Accounts
(save-excursion
(back-to-indentation)
(skip-chars-forward "([") ;; for virtual accounts
(setq start (point)))
(setq delete-suffix (save-excursion
(when (search-forward-regexp (rx (or eol (or ?\t (repeat 2 space)))) (line-end-position) t)
(when (search-forward-regexp
(rx (or eol (any "\t])") (repeat 2 space)))
(line-end-position) t)
(- (match-beginning 0) end)))
realign-after t
collection (if ledger-complete-in-steps
#'ledger-accounts-tree
#'ledger-accounts-list))))
collection (cons 'nullary
(if ledger-complete-in-steps
#'ledger-complete-account-next-steps
#'ledger-accounts-list)))))
(when collection
(let ((prefix (buffer-substring-no-properties start end)))
(list start end
(if (functionp collection)
(completion-table-with-cache
(lambda (_)
(cl-remove-if (apply-partially 'string= prefix) (funcall collection))))
collection)
(pcase collection
;; `func-arity' isn't available until Emacs 26, so we have to
;; manually track the arity of the functions.
(`(nullary . ,f)
;; a nullary function that returns a completion collection
(completion-table-with-cache
(lambda (_)
(cl-remove-if (apply-partially 'string= prefix) (funcall f)))))
((pred functionp)
;; a completion table
collection)
(_
;; a static completion collection
collection))
:exit-function (lambda (&rest _)
(when delete-suffix
(delete-char delete-suffix))
(when (and realign-after ledger-post-auto-align)
(ledger-post-align-postings (line-beginning-position) (line-end-position))))
'ignore)))))
(ledger-post-align-postings (line-beginning-position) (line-end-position)))))))))
(defun ledger-trim-trailing-whitespace (str)
(replace-regexp-in-string "[ \t]*$" "" str))
@@ -332,7 +366,13 @@ Interactively, if point is after a payee, complete the
transaction with the details from the last transaction to that
payee."
(interactive)
(let* ((name (ledger-trim-trailing-whitespace (caar (ledger-parse-arguments))))
(let* ((name (ledger-trim-trailing-whitespace
(buffer-substring
(save-excursion
(unless (eq (ledger-thing-at-point) 'transaction)
(user-error "Cannot fully complete xact here"))
(point))
(point))))
(rest-of-name name)
xacts)
(save-excursion
@@ -341,7 +381,8 @@ payee."
;; Search backward for a matching payee
(when (re-search-backward
(concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.*"
(regexp-quote name) ".*\\)" ) nil t)
(regexp-quote name) ".*\\)")
nil t)
(setq rest-of-name (match-string 3))
;; Start copying the postings
(forward-line)
@@ -353,10 +394,13 @@ payee."
(unless (looking-at-p "\n\n")
(insert "\n")))
(forward-line)
(goto-char (line-end-position))
(when (re-search-backward "\\(\t\\| [ \t]\\)" nil t)
(end-of-line)
;; Move to amount on first posting line
(when (re-search-backward "\t\\| [ \t]" nil t)
(goto-char (match-end 0)))))
(add-to-list 'completion-category-defaults '(ledger-date (styles . (substring))))
(provide 'ledger-complete)
;;; ledger-complete.el ends here

5
lisp/ledger-mode/ledger-context.el
View File

@@ -109,8 +109,9 @@ where the \"users\" point was."
(list line-type field fields)))
(defun ledger-thing-at-point ()
"Describe thing at points. Return \='transaction, \='posting, or nil.
Leave point at the beginning of the thing under point"
"Describe thing at point. Return \\='transaction, \\='posting, \\='day, or nil.
Leave point at the beginning of the thing at point, otherwise do not move point."
(let ((here (point)))
(goto-char (line-beginning-position))
(cond ((looking-at "^\\(?:[~=][ \t]\\|[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.+?)\\)?\\s-+\\)")

2
lisp/ledger-mode/ledger-exec.el
View File

@@ -25,6 +25,8 @@
;;; Code:
(require 'ledger-init) ;for `ledger-default-date-format'
(declare-function ledger-master-file "ledger-report" ())
(defconst ledger-version-needed "3.0.0"

5
lisp/ledger-mode/ledger-flymake.el
View File

@@ -22,7 +22,10 @@
;;; Commentary:
;; Flymake is the built-in Emacs package to support on-the-fly syntax checking.
;; This file adds support for flymake to `ledger-mode'. Enable it by calling
;; `flymake-mode' from a file-visiting ledger buffer.
;; `ledger-flymake-enable' from a file-visiting ledger buffer. To enable it
;; automatically, put this in your .emacs:
;;
;; (add-hook 'ledger-mode-hook #'ledger-flymake-enable)
;;; Code:
(require 'cl-lib)

5
lisp/ledger-mode/ledger-fonts.el
View File

@@ -394,11 +394,6 @@
"Face for Ledger dates"
:group 'ledger-faces)
(defface ledger-occur-narrowed-face
`((t :inherit font-lock-comment-face :invisible t))
"Default face for Ledger occur mode hidden transactions"
:group 'ledger-faces)
(defface ledger-occur-xact-face
`((t :inherit highlight))
"Default face for Ledger occur mode shown transactions"

62
lisp/ledger-mode/ledger-init.el
View File

@@ -28,14 +28,19 @@
(defcustom ledger-init-file-name "~/.ledgerrc"
"Location of the ledger initialization file. nil if you don't have one."
:type 'file
:type '(choice (const :tag "Do not read ledger initialization file" nil)
file)
:group 'ledger-exec)
(defvar ledger-environment-alist nil
"Variable to hold details about ledger-mode's environment.
Adding the dotted pair (\"decimal-comma\" . t) will tell ledger
to treat commas as decimal separator.")
to treat commas as decimal separator.
This variable is automatically populated by
`ledger-init-load-init-file', which is called in the body of
`ledger-mode'.")
(defconst ledger-iso-date-format "%Y-%m-%d"
"The format for ISO 8601 dates.")
@@ -48,11 +53,16 @@ ISO 8601 dates."
:package-version '(ledger-mode . "4.0.0")
:group 'ledger)
(defun ledger-format-date (&optional date)
(defun ledger-format-date (&optional date format)
"Format DATE according to the current preferred date format.
Returns the current date if DATE is nil or not supplied."
Returns the current date if DATE is nil or not supplied.
If FORMAT is provided, use that as the date format. Otherwise,
use the --input-date-format specified in `ledger-init-file-name',
or if none, use `ledger-default-date-format'."
(format-time-string
(or (cdr (assoc "input-date-format" ledger-environment-alist))
(or format
(cdr (assoc "input-date-format" ledger-environment-alist))
ledger-default-date-format)
date))
@@ -62,36 +72,30 @@ Returns the current date if DATE is nil or not supplied."
(with-current-buffer buffer
(let (environment-alist)
(goto-char (point-min))
(while (re-search-forward ledger-init-string-regex nil t )
(while (re-search-forward ledger-init-string-regex nil t)
(let ((matchb (match-beginning 0)) ;; save the match data, string-match stamp on it
(matche (match-end 0)))
(end-of-line)
(setq environment-alist
(append environment-alist
(list (cons (let ((flag (buffer-substring-no-properties (+ 2 matchb) matche)))
(if (string-match "[ \t\n\r]+\\'" flag)
(replace-match "" t t flag)
flag))
(let ((value (buffer-substring-no-properties matche (point) )))
(if (> (length value) 0)
value
t))))))))
environment-alist)))
(push (cons (let ((flag (buffer-substring-no-properties (+ 2 matchb) matche)))
(if (string-match "[ \t\n\r]+\\'" flag)
(replace-match "" t t flag)
flag))
(let ((value (buffer-substring-no-properties matche (point))))
(if (> (length value) 0)
value
t)))
environment-alist)))
(nreverse environment-alist))))
(defun ledger-init-load-init-file ()
"Load and parse the .ledgerrc file."
"Load and parse the .ledgerrc file into `ledger-environment-alist'."
(interactive)
(when ledger-init-file-name
(let ((init-base-name (file-name-nondirectory ledger-init-file-name)))
(if (get-buffer init-base-name) ;; init file already loaded, parse it and leave it
(setq ledger-environment-alist
(ledger-init-parse-initialization init-base-name))
(when (and (file-exists-p ledger-init-file-name)
(file-readable-p ledger-init-file-name))
(let ((init-buffer (find-file-noselect ledger-init-file-name)))
(setq ledger-environment-alist
(ledger-init-parse-initialization init-buffer))
(kill-buffer init-buffer)))))))
(when (and ledger-init-file-name
(file-readable-p ledger-init-file-name))
(with-temp-buffer
(insert-file-contents ledger-init-file-name)
(setq ledger-environment-alist
(ledger-init-parse-initialization (current-buffer))))))
(provide 'ledger-init)

4
lisp/ledger-mode/ledger-mode-pkg.el
View File

@@ -1,6 +1,6 @@
(define-package "ledger-mode" "20230925.1013" "Helper code for use with the \"ledger\" command-line tool"
(define-package "ledger-mode" "20241114.1751" "Helper code for use with the \"ledger\" command-line tool"
'((emacs "25.1"))
:commit "105d67626e91acb4550ab860e0dc4247c8a4c79e")
:commit "15b7d29f2539f9e9671ab3c062bd5165e5b80ae8")
;; Local Variables:
;; no-byte-compile: t
;; End:

149
lisp/ledger-mode/ledger-mode.el
View File

@@ -96,6 +96,13 @@
(regexp-quote account))
(ledger-accounts-list))))
(defun ledger-read-payee-with-prompt (prompt)
"Read a payee from the minibuffer with PROMPT."
(ledger-completing-read-with-default prompt
(when-let ((payee (ledger-xact-payee)))
(regexp-quote payee))
(ledger-payees-list)))
(defun ledger-read-date (prompt)
"Return user-supplied date after `PROMPT', defaults to today.
This uses `org-read-date', which see."
@@ -137,11 +144,10 @@ the balance into that."
(buffer-substring-no-properties (point-min) (1- (point-max)))
(concat account " is empty.")))))
(when balance
(message balance))))
(display-message-or-buffer balance))))
(defun ledger-display-ledger-stats ()
"Display the cleared-or-pending balance.
And calculate the target-delta of the account being reconciled."
"Display some summary statistics about the current ledger file."
(interactive)
(let* ((buffer (find-file-noselect (ledger-master-file)))
(balance (with-temp-buffer
@@ -154,6 +160,10 @@ And calculate the target-delta of the account being reconciled."
(defvar ledger-date-string-today (ledger-format-date))
;;; Editing commands
(defun ledger-remove-effective-date ()
"Remove the effective date from a transaction or posting."
(interactive)
@@ -216,19 +226,133 @@ With a prefix argument, remove the effective date."
"Indent, remove multiple line feeds and sort the buffer."
(interactive)
(let ((start (point-min-marker))
(end (point-max-marker)))
(ledger-navigate-beginning-of-xact)
(beginning-of-line)
(let ((target (buffer-substring (point) (progn
(end-of-line)
(point)))))
(end (point-max-marker))
(distance-in-xact (- (point) (ledger-navigate-beginning-of-xact))))
(let ((target (buffer-substring (line-beginning-position) (line-end-position))))
(goto-char start)
(untabify start end)
(ledger-sort-buffer)
(ledger-post-align-postings start end)
(ledger-mode-remove-extra-lines)
(goto-char start)
(search-forward target))))
(search-forward target)
(beginning-of-line)
(forward-char distance-in-xact))))
(defun ledger-rename-account (old new &optional toplevel-only)
"Rename account with name OLD to name NEW.
Affects account names mentioned in postings as well as declared
with the \"account\" directive.
By default, child accounts of OLD are also renamed to
corresponding child accounts of NEW. With \\[universal-argument]
prefix, child accounts are not renamed. When called from Lisp,
TOPLEVEL-ONLY has the same meaning."
(interactive
(let* ((old-name
(ledger-read-account-with-prompt "Old name: "))
(new-name
(ledger-read-string-with-default "New name: " old-name)))
(list old-name new-name current-prefix-arg)))
(save-excursion
(goto-char (point-min))
(while (re-search-forward ledger-account-name-or-directive-regex nil t)
(let ((account (match-string 1)))
(cond
((string-equal account old)
(replace-match new 'fixedcase 'literal nil 1))
((and (not toplevel-only)
(string-prefix-p (concat old ":") account))
(replace-match
(concat new (substring account (length old)))
'fixedcase 'literal nil 1))))))
(when ledger-post-auto-align
(ledger-post-align-postings (point-min) (point-max))))
;;; Commands for changing dates
;; These functions are adapted from the implementation of `org-timestamp-change'.
(defun ledger--in-regexp (regexp)
"Return (BEG . END) if point is inside a match of REGEXP, or nil.
Only check the current line for occurrences of REGEXP."
(catch :exit
(let ((pos (point))
(eol (line-end-position)))
(save-excursion
(beginning-of-line)
(while (and (re-search-forward regexp eol t)
(<= (match-beginning 0) pos))
(let ((end (match-end 0)))
(when (>= end pos)
(throw :exit (cons (match-beginning 0) (match-end 0))))))))))
(defsubst ledger--pos-in-match-range (pos n)
"Return non-nil if POS is inside the range of group N in the match data."
(and (match-beginning n)
(<= (match-beginning n) pos)
(>= (match-end n) pos)))
(defun ledger--at-date-p ()
"Return non-nil if point is inside a date.
Specifically, return `year', `month', or `day', depending on
which part of the date string point is in."
(let ((pos (point))
(boundaries (ledger--in-regexp ledger-iso-date-regexp)))
(cond ((null boundaries) nil)
((ledger--pos-in-match-range pos 2) 'year)
((ledger--pos-in-match-range pos 3) 'month)
((ledger--pos-in-match-range pos 4) 'day))))
(defun ledger--date-change (n)
"Change the date field at point by N (can be negative)."
(let ((date-cat (ledger--at-date-p))
(origin-pos (point))
date-separator
date-str time-old time-new)
(unless date-cat (user-error "Not at a date"))
(setq date-str (match-string 0))
(setq date-separator
(string (aref date-str 4)))
(save-match-data
(setq time-old (decode-time (ledger-parse-iso-date date-str)))
(setq time-new
;; Do not pass DST or ZONE arguments here; it should be
;; automatically inferred from the other arguments, since the
;; appropriate DST value may differ from `time-old'.
(encode-time
0 ; second
0 ; minute
0 ; hour
(+ (if (eq date-cat 'day) n 0) (nth 3 time-old))
(+ (if (eq date-cat 'month) n 0) (nth 4 time-old))
(+ (if (eq date-cat 'year) n 0) (nth 5 time-old)))))
(replace-match (format-time-string (concat "%Y" date-separator "%m" date-separator "%d")
time-new)
'fixedcase
'literal)
(goto-char origin-pos)))
(defun ledger-date-up (&optional arg)
"Increment the date field at point by 1.
With prefix ARG, increment by that many instead."
(interactive "p")
(ledger--date-change arg))
(defun ledger-date-down (&optional arg)
"Decrement the date field at point by 1.
With prefix ARG, decrement by that many instead."
(interactive "p")
(ledger--date-change (- arg)))
;;; Major mode definition
(defvar ledger-mode-syntax-table
(let ((table (make-syntax-table text-mode-syntax-table)))
@@ -269,6 +393,9 @@ With a prefix argument, remove the effective date."
(define-key map (kbd "M-n") #'ledger-navigate-next-xact-or-directive)
(define-key map (kbd "M-q") #'ledger-post-align-dwim)
(define-key map (kbd "S-<up>") #'ledger-date-up)
(define-key map (kbd "S-<down>") #'ledger-date-down)
;; Reset the `text-mode' override of this standard binding
(define-key map (kbd "C-M-i") 'completion-at-point)
map)
@@ -325,6 +452,8 @@ With a prefix argument, remove the effective date."
(add-hook 'after-save-hook 'ledger-report-redo nil t)
(add-hook 'post-command-hook 'ledger-highlight-xact-under-point nil t)
(add-hook 'before-revert-hook 'ledger-highlight--before-revert nil t)
(add-hook 'after-revert-hook 'ledger-highlight-xact-under-point nil t)
(ledger-init-load-init-file)
(setq-local comment-start ";")

106
lisp/ledger-mode/ledger-mode.info
View File

@@ -246,8 +246,8 @@ In addition to the usual Emacs navigation commands, ledger-mode offers
several additional commands to ease navigation. ‘M-n’ and ‘M-p’
navigate between next and previous xacts or directives.
Additionally, M-x ledger-navigate-previous-uncleared and M-x
ledger-navigate-next-uncleared navigate to the next and previous
Additionally, ‘M-x ledger-navigate-next-uncleared’ and ‘M-x
ledger-navigate-previous-uncleared’ navigate to the next and previous
uncleared transactions.

@@ -954,7 +954,7 @@ File: ledger-mode.info, Node: Ledger Reconcile Customization Group, Next: Ledg
6.2.2 Ledger Reconcile Customization Group
------------------------------------------
‘ledger-recon-buffer-name’
‘ledger-reconcile-buffer-name’
Name to use for reconciliation buffer. Defaults to ‘*Reconcile*’.
‘ledger-narrow-on-reconcile’
@@ -979,7 +979,7 @@ File: ledger-mode.info, Node: Ledger Reconcile Customization Group, Next: Ledg
‘ledger-default-date-format’.
‘ledger-reconcile-target-prompt-string’
Prompt for recon target. Defaults to "Target amount for
Prompt for reconcile target. Defaults to "Target amount for
reconciliation ".
‘ledger-reconcile-buffer-header’
@@ -1362,14 +1362,14 @@ Command & Variable Index
(line 18)
* ledger-post-auto-align: Ledger Post Customization Group.
(line 21)
* ledger-recon-buffer-name: Ledger Reconcile Customization Group.
(line 6)
* ledger-reconcile-buffer-account-max-chars: Ledger Reconcile Customization Group.
(line 54)
* ledger-reconcile-buffer-header: Ledger Reconcile Customization Group.
(line 34)
* ledger-reconcile-buffer-line-format: Ledger Reconcile Customization Group.
(line 40)
* ledger-reconcile-buffer-name: Ledger Reconcile Customization Group.
(line 6)
* ledger-reconcile-buffer-payee-max-chars: Ledger Reconcile Customization Group.
(line 50)
* ledger-reconcile-default-commodity: Starting a Reconciliation.
@@ -1498,53 +1498,53 @@ Node: Reports7243
Node: Narrowing8273
Node: The Ledger Buffer8857
Node: Navigating Transactions9263
Node: Adding Transactions9811
Node: Setting a Transactions Effective Date11310
Node: Quick Balance Display12210
Node: Copying Transactions12742
Node: Editing Amounts13344
Node: Marking Transactions14415
Node: Formatting Transactions16110
Node: Deleting Transactions16708
Node: Sorting Transactions17148
Node: Narrowing Transactions18700
Node: The Reconcile Buffer20550
Node: Basics of Reconciliation21015
Node: Starting a Reconciliation21964
Node: Mark Transactions Pending23813
Node: Edit Transactions During Reconciliation24482
Node: Finalize Reconciliation25125
Node: Adding and Deleting Transactions during Reconciliation25782
Node: Changing Reconciliation Account26366
Node: Changing Reconciliation Target26916
Node: The Report Buffer27234
Node: Running Basic Reports27492
Node: Adding and Editing Reports28925
Node: Expansion Formats30312
Node: Make Report Transactions Active31953
Node: Reversing Report Order32660
Node: Scheduling Transactions33353
Node: Specifying Upcoming Transactions34209
Node: Transactions that occur on specific dates34783
Node: Transactions that occur on specific days35824
Node: Customizing Ledger-mode36953
Node: Ledger-mode Customization37217
Node: Customization Variables37902
Node: Ledger Customization Group38382
Node: Ledger Reconcile Customization Group39022
Node: Ledger Report Customization Group41965
Node: Ledger Faces Customization Group42684
Node: Ledger Post Customization Group44431
Node: Ledger Exec Customization Group45258
Node: Ledger Test Customization Group45757
Node: Ledger Texi Customization Group46159
Node: Generating Ledger Regression Tests46651
Node: Embedding Example results in Ledger Documentation46914
Node: Hacking Ledger-mode47203
Node: Use org-like outlines47428
Node: Concept Index48093
Node: Command & Variable Index53609
Node: Keystroke Index61719
Node: Adding Transactions9823
Node: Setting a Transactions Effective Date11322
Node: Quick Balance Display12222
Node: Copying Transactions12754
Node: Editing Amounts13356
Node: Marking Transactions14427
Node: Formatting Transactions16122
Node: Deleting Transactions16720
Node: Sorting Transactions17160
Node: Narrowing Transactions18712
Node: The Reconcile Buffer20562
Node: Basics of Reconciliation21027
Node: Starting a Reconciliation21976
Node: Mark Transactions Pending23825
Node: Edit Transactions During Reconciliation24494
Node: Finalize Reconciliation25137
Node: Adding and Deleting Transactions during Reconciliation25794
Node: Changing Reconciliation Account26378
Node: Changing Reconciliation Target26928
Node: The Report Buffer27246
Node: Running Basic Reports27504
Node: Adding and Editing Reports28937
Node: Expansion Formats30324
Node: Make Report Transactions Active31965
Node: Reversing Report Order32672
Node: Scheduling Transactions33365
Node: Specifying Upcoming Transactions34221
Node: Transactions that occur on specific dates34795
Node: Transactions that occur on specific days35836
Node: Customizing Ledger-mode36965
Node: Ledger-mode Customization37229
Node: Customization Variables37914
Node: Ledger Customization Group38394
Node: Ledger Reconcile Customization Group39034
Node: Ledger Report Customization Group41985
Node: Ledger Faces Customization Group42704
Node: Ledger Post Customization Group44451
Node: Ledger Exec Customization Group45278
Node: Ledger Test Customization Group45777
Node: Ledger Texi Customization Group46179
Node: Generating Ledger Regression Tests46671
Node: Embedding Example results in Ledger Documentation46934
Node: Hacking Ledger-mode47223
Node: Use org-like outlines47448
Node: Concept Index48113
Node: Command & Variable Index53629
Node: Keystroke Index61739

End Tag Table

46
lisp/ledger-mode/ledger-navigate.el
View File

@@ -39,7 +39,9 @@
(goto-char (point-max))))
(defun ledger-navigate-start-xact-or-directive-p ()
"Return t if at the beginning of an empty or all-whitespace line."
"Return t if at the beginning line of an xact or directive.
Assumes point is at the beginning of a line."
(not (looking-at "[ \t]\\|\\(^$\\)")))
(defun ledger-navigate-next-xact-or-directive ()
@@ -49,8 +51,8 @@
(if (ledger-navigate-start-xact-or-directive-p) ; if we are the start of an xact, move forward to the next xact
(progn
(forward-line)
(if (not (ledger-navigate-start-xact-or-directive-p)) ; we have moved forward and are not at another xact, recurse forward
(ledger-navigate-next-xact-or-directive)))
(unless (ledger-navigate-start-xact-or-directive-p) ; we have moved forward and are not at another xact, recurse forward
(ledger-navigate-next-xact-or-directive)))
(while (not (or (eobp) ; we didn't start off at the beginning of an xact
(ledger-navigate-start-xact-or-directive-p)))
(forward-line))))
@@ -122,18 +124,17 @@ Requires empty line separating xacts."
(goto-char begin)
(cond
((looking-at comment-re)
(progn
(ledger-navigate-skip-lines-backwards comment-re)
;; We are either at the beginning of the buffer, or we found
;; a line outside the comment, or both. If we are outside
;; the comment then we need to move forward a line.
(unless (looking-at comment-re)
(forward-line 1)
(beginning-of-line))
(setq begin (point))
(goto-char pos)
(ledger-navigate-skip-lines-forwards comment-re)
(setq end (point))))
(ledger-navigate-skip-lines-backwards comment-re)
;; We are either at the beginning of the buffer, or we found
;; a line outside the comment, or both. If we are outside
;; the comment then we need to move forward a line.
(unless (looking-at comment-re)
(forward-line 1)
(beginning-of-line))
(setq begin (point))
(goto-char pos)
(ledger-navigate-skip-lines-forwards comment-re)
(setq end (point)))
((looking-at "\\(?:comment\\|test\\)\\>")
(setq end (or (save-match-data
(re-search-forward "^end[[:blank:]]+\\(?:comment\\|test\\)\\_>"))
@@ -151,14 +152,13 @@ Requires empty line separating xacts."
(comment-re " *;"))
;; handle block comments here
(beginning-of-line)
(if (looking-at comment-re)
(progn
(ledger-navigate-skip-lines-backwards comment-re)
(setq begin (point))
(goto-char pos)
(beginning-of-line)
(ledger-navigate-skip-lines-forwards comment-re)
(setq end (point))))
(when (looking-at comment-re)
(ledger-navigate-skip-lines-backwards comment-re)
(setq begin (point))
(goto-char pos)
(beginning-of-line)
(ledger-navigate-skip-lines-forwards comment-re)
(setq end (point)))
(list begin end)))

55
lisp/ledger-mode/ledger-occur.el
View File

@@ -45,11 +45,15 @@ This uses `ledger-occur-xact-face'."
(defvar ledger-occur-history nil
"History of previously searched expressions for the prompt.")
(defvar ledger-occur-current-regex nil
(defvar-local ledger-occur-current-regex nil
"Pattern currently applied to narrow the buffer.")
(make-variable-buffer-local 'ledger-occur-current-regex)
(defvar ledger-occur-mode-map (make-sparse-keymap))
(defvar ledger-occur-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-g") #'ledger-occur-refresh)
(define-key map (kbd "C-c C-f") #'ledger-occur-mode)
map)
"Keymap used by `ledger-occur-mode'.")
(define-minor-mode ledger-occur-mode
"A minor mode which display only transactions matching a pattern.
@@ -58,13 +62,12 @@ The pattern is given by `ledger-occur-current-regex'."
:lighter (:eval (format " Ledger-Narrow(%s)" ledger-occur-current-regex))
:keymap ledger-occur-mode-map
(if (and ledger-occur-current-regex ledger-occur-mode)
(ledger-occur-refresh)
(progn (ledger-occur-refresh)
;; Clear overlays after revert-buffer and similar commands.
(add-hook 'change-major-mode-hook #'ledger-occur-remove-overlays nil t))
(ledger-occur-remove-overlays)
(message "Showing all transactions")))
(define-key ledger-occur-mode-map (kbd "C-c C-g") #'ledger-occur-refresh)
(define-key ledger-occur-mode-map (kbd "C-c C-f") #'ledger-occur-mode)
(defun ledger-occur-refresh ()
"Re-apply the current narrowing expression."
(interactive)
@@ -92,8 +95,8 @@ currently active."
(defun ledger-occur-prompt ()
"Return the default value of the prompt.
Default value for prompt is a current word or active
region(selection), if its size is 1 line"
Default value for prompt is the active region, if it is one line
long, otherwise it is the word at point."
(if (use-region-p)
(let ((pos1 (region-beginning))
(pos2 (region-end)))
@@ -106,29 +109,31 @@ currently active."
(defun ledger-occur-make-visible-overlay (beg end)
(let ((ovl (make-overlay beg end (current-buffer))))
"Make an overlay for a visible portion of the buffer, from BEG to END."
(let ((ovl (make-overlay beg end)))
(overlay-put ovl ledger-occur-overlay-property-name t)
(when ledger-occur-use-face-shown
(overlay-put ovl 'font-lock-face 'ledger-occur-xact-face))))
(defun ledger-occur-make-invisible-overlay (beg end)
(let ((ovl (make-overlay beg end (current-buffer))))
"Make an overlay for an invisible portion of the buffer, from BEG to END."
(let ((ovl (make-overlay beg end)))
(overlay-put ovl ledger-occur-overlay-property-name t)
(overlay-put ovl 'invisible t)))
(defun ledger-occur-create-overlays (ovl-bounds)
"Create the overlays for the visible transactions.
Argument OVL-BOUNDS contains bounds for the transactions to be left visible."
(let* ((beg (caar ovl-bounds))
(end (cl-cadar ovl-bounds)))
(ledger-occur-remove-overlays)
(ledger-occur-make-invisible-overlay (point-min) (1- beg))
(dolist (visible (cdr ovl-bounds))
(ledger-occur-remove-overlays)
(let ((end-of-last-visible (point-min)))
(pcase-dolist (`(,beg ,end) ovl-bounds)
;; keep newline before xact visible, but do not highlight it with
;; `ledger-occur-xact-face'
(ledger-occur-make-invisible-overlay end-of-last-visible (1- beg))
(ledger-occur-make-visible-overlay beg end)
(ledger-occur-make-invisible-overlay (1+ end) (1- (car visible)))
(setq beg (car visible))
(setq end (cadr visible)))
(ledger-occur-make-invisible-overlay (1+ end) (point-max))))
;; keep newline after xact visible
(setq end-of-last-visible (1+ end)))
(ledger-occur-make-invisible-overlay end-of-last-visible (point-max))))
(defun ledger-occur-remove-overlays ()
"Remove the transaction hiding overlays."
@@ -141,19 +146,21 @@ Argument OVL-BOUNDS contains bounds for the transactions to be left visible."
(save-excursion
(goto-char (point-min))
;; Set initial values for variables
(let (endpoint lines bounds)
(let (lines)
;; Search loop
(while (not (eobp))
;; if something found
(when (setq endpoint (re-search-forward regex nil 'end))
(setq bounds (ledger-navigate-find-element-extents endpoint))
(when-let ((endpoint (re-search-forward regex nil 'end))
(bounds (ledger-navigate-find-element-extents endpoint)))
(push bounds lines)
;; move to the end of the xact, no need to search inside it more
(goto-char (cadr bounds))))
(nreverse lines))))
(defun ledger-occur-compress-matches (buffer-matches)
"identify sequential xacts to reduce number of overlays required"
"Identify sequential xacts to reduce number of overlays required.
BUFFER-MATCHES should be a list of (BEG END) lists."
(if buffer-matches
(let ((points (list))
(current-beginning (caar buffer-matches))

98
lisp/ledger-mode/ledger-post.el
View File

@@ -26,6 +26,11 @@
(require 'ledger-regex)
(require 'ledger-navigate)
(declare-function calc-renumber-stack "calc" ())
(declare-function ledger-add-commodity "ledger-commodities" (c1 c2))
(declare-function ledger-commodity-to-string "ledger-commodities" (c1))
(declare-function ledger-negate-commodity "ledger-commodities" (c))
(declare-function ledger-split-commodity-string "ledger-commodities" (str))
(declare-function ledger-string-to-number "ledger-commodities" (str &optional decimal-comma))
;;; Code:
@@ -161,28 +166,81 @@ regular text."
(t (call-interactively 'ledger-post-align-xact))))
(defun ledger-post-edit-amount ()
"Call `calc-mode' and push the amount in the posting to the top of stack."
"Call `calc' and push the amount in the posting to the top of stack, if any.
In the calc buffer, press y to use the top value in the stack as
the amount and return to ledger."
(interactive)
(goto-char (line-beginning-position))
(beginning-of-line)
(when (re-search-forward ledger-post-line-regexp (line-end-position) t)
(goto-char (match-end ledger-regex-post-line-group-account)) ;; go to the and of the account
(let ((end-of-amount (re-search-forward "[-.,0-9]+" (line-end-position) t)))
;; determine if there is an amount to edit
(if end-of-amount
(let ((val-string (match-string 0)))
(goto-char (match-beginning 0))
(delete-region (match-beginning 0) (match-end 0))
(push-mark)
(calc)
;; edit the amount, first removing thousands separators and
;; converting decimal commas to calc's input format
(calc-eval (number-to-string (ledger-string-to-number val-string)) 'push))
(progn ;;make sure there are two spaces after the account name and go to calc
(if (search-backward " " (- (point) 3) t)
(goto-char (line-end-position))
(insert " "))
(push-mark)
(calc))))))
(goto-char (match-end ledger-regex-post-line-group-account)) ;; go to the end of the account
;; determine if there is an amount to edit
(if (re-search-forward ledger-amount-regexp (line-end-position) t)
(let ((val-string (match-string 0)))
(goto-char (match-beginning 0))
(delete-region (match-beginning 0) (match-end 0))
(push-mark (point) 'nomsg)
(calc)
;; edit the amount, first removing thousands separators and converting
;; decimal commas to calc's input format
(calc-eval (number-to-string (ledger-string-to-number val-string)) 'push)
(calc-renumber-stack))
;; make sure there are two spaces after the account name and go to calc
(if (search-backward " " (- (point) 3) t)
(end-of-line)
(insert " "))
(push-mark (point) 'nomsg)
(calc))))
(defun ledger-post-xact-total ()
"Return (TOTAL . MISSING-POSITIONS) for the transaction at point.
TOTAL is a commoditized amount representing the total amount of
the postings in the transaction.
MISSING-POSITIONS is a list of positions in the buffer where the
transaction do not have an amount specified (such postings do not
contribute to TOTAL). Specifically, the positions are at the end
of the account name on such posting lines.
Error if the commodities do not match."
(save-excursion
(pcase-let ((`(,begin ,end) (ledger-navigate-find-xact-extents (point))))
(goto-char begin)
(cl-loop
while (re-search-forward ledger-post-line-regexp end t)
for account-end = (match-end ledger-regex-post-line-group-account)
for amount-string = (when-let ((amount-string (match-string ledger-regex-post-line-group-amount)))
(unless (string-empty-p (string-trim amount-string))
amount-string))
if (not amount-string)
collect account-end into missing-positions
else
collect (ledger-split-commodity-string amount-string) into amounts
finally return (cons (if amounts
(cl-reduce #'ledger-add-commodity amounts)
'(0 nil))
missing-positions)))))
(defun ledger-post-fill ()
"Find a posting with no amount and insert it.
Even if ledger allows for one missing amount per transaction, you
might want to insert it anyway."
(interactive)
(pcase-let* ((`(,total . ,missing-positions) (ledger-post-xact-total))
(missing-amount (ledger-negate-commodity total))
(amounts-balance (< (abs (car missing-amount)) 0.0001)))
(pcase missing-positions
('() (unless amounts-balance
(user-error "Postings do not balance, but no posting to fill")))
(`(,missing-pos)
(if amounts-balance
(user-error "Missing amount but amounts balance already")
(goto-char missing-pos)
(insert " " (ledger-commodity-to-string missing-amount))
(ledger-post-align-xact (point))))
(_ (user-error "More than one posting with missing amount")))))
(provide 'ledger-post)

243
lisp/ledger-mode/ledger-reconcile.el
View File

@@ -40,16 +40,25 @@
(declare-function ledger-read-account-with-prompt "ledger-mode" (prompt))
(declare-function ledger-read-date "ledger-mode" (prompt))
(defvar ledger-buf nil)
(defvar ledger-bufs nil)
(defvar ledger-acct nil)
(defvar ledger-target nil)
(defvar-local ledger-reconcile-ledger-buf nil
"Buffer from which the current reconcile buffer was created.")
(defvar-local ledger-reconcile-account nil
"Account being reconciled in the current buffer.")
(defvar-local ledger-reconcile-target nil
"Target amount for this reconciliation process.")
(defgroup ledger-reconcile nil
"Options for Ledger-mode reconciliation"
:group 'ledger)
(defcustom ledger-recon-buffer-name "*Reconcile*"
(define-obsolete-variable-alias
'ledger-recon-buffer-name
'ledger-reconcile-buffer-name
"2023-12-15")
(defcustom ledger-reconcile-buffer-name "*Reconcile*"
"Name to use for reconciliation buffer."
:type 'string
:group 'ledger-reconcile)
@@ -84,7 +93,7 @@ Default is `ledger-default-date-format'."
:group 'ledger-reconcile)
(defcustom ledger-reconcile-target-prompt-string "Target amount for reconciliation "
"Prompt for recon target."
"Prompt for reconcile target."
:type 'string
:group 'ledger-reconcile)
@@ -122,8 +131,15 @@ if string is longer, it is not truncated unless
"Key for sorting reconcile buffer.
Possible values are \"(date)\", \"(amount)\", \"(payee)\" or \"(0)\" for
no sorting, i.e. using ledger file order."
:type 'string
no sorting, i.e. using ledger file order.
It can also be any value accepted by ledger's --sort option."
:type '(choice
(const :tag "Date" "(date)")
(const :tag "Amount" "(amount)")
(const :tag "Payee" "(payee)")
(const :tag "No sorting (Ledger file order)" "(0)")
(string :tag "Custom --sort expression"))
:group 'ledger-reconcile)
(defcustom ledger-reconcile-insert-effective-date nil
@@ -140,6 +156,14 @@ described above."
:type 'boolean
:group 'ledger-reconcile)
(defvar-local ledger-reconcile-last-balance-message nil)
(defvar-local ledger-reconcile-last-balance-equals-target nil)
(defface ledger-reconcile-last-balance-equals-target-face
'((t :inherit header-line :foreground "green3"))
"Face used for header line when cleared-or-pending balance equals the target."
:group 'ledger-reconcile)
;; s-functions below are copied from Magnars' s.el
;; prefix ledger-reconcile- is added to not conflict with s.el
(defun ledger-reconcile-s-pad-left (len padding s)
@@ -197,14 +221,18 @@ described above."
"Display the cleared-or-pending balance.
And calculate the target-delta of the account being reconciled."
(interactive)
(let* ((pending (ledger-reconcile-get-cleared-or-pending-balance ledger-buf ledger-acct)))
(when pending
(if ledger-target
(message "Cleared and Pending balance: %s, Difference from target: %s"
(ledger-commodity-to-string pending)
(ledger-commodity-to-string (ledger-subtract-commodity ledger-target pending)))
(message "Pending balance: %s"
(ledger-commodity-to-string pending))))))
(when-let (pending (ledger-reconcile-get-cleared-or-pending-balance ledger-reconcile-ledger-buf ledger-reconcile-account))
(let ((message
(if-let (diff (and ledger-reconcile-target (ledger-subtract-commodity ledger-reconcile-target pending)))
(progn
(setq ledger-reconcile-last-balance-equals-target (zerop (car diff)))
(format-message "Cleared and Pending balance: %s, Difference from target: %s"
(ledger-commodity-to-string pending)
(ledger-commodity-to-string diff)))
(format-message "Pending balance: %s"
(ledger-commodity-to-string pending)))))
(setq ledger-reconcile-last-balance-message message)
(message "%s" message))))
(defun ledger-is-stdin (file)
"True if ledger FILE is standard input."
@@ -233,7 +261,7 @@ do the same if its value is non-nil."
(ledger-insert-effective-date)))
(defun ledger-reconcile-toggle ()
"Toggle the current transaction, and mark the recon window."
"Toggle the current transaction, and mark the reconcile window."
(interactive)
(beginning-of-line)
(let ((where (get-text-property (point) 'where))
@@ -279,35 +307,38 @@ Return the number of uncleared xacts found."
(ledger-do-reconcile ledger-reconcile-sort-key)
(set-buffer-modified-p t)
(ledger-reconcile-ensure-xacts-visible)
(ledger-display-balance)
(goto-char (point-min))
(forward-line line))))
(defun ledger-reconcile-refresh-after-save ()
"Refresh the recon-window after the ledger buffer is saved."
"Refresh the reconcile window after the ledger buffer is saved."
(let ((curbufwin (get-buffer-window (current-buffer)))
(curpoint (point))
(recon-buf (get-buffer ledger-recon-buffer-name)))
(when (buffer-live-p recon-buf)
(with-current-buffer recon-buf
(reconcile-buf (get-buffer ledger-reconcile-buffer-name)))
(when (buffer-live-p reconcile-buf)
(with-current-buffer reconcile-buf
(ledger-reconcile-refresh)
(set-buffer-modified-p nil))
(when curbufwin
(select-window curbufwin)
(select-window curbufwin)
(goto-char curpoint)
(recenter)
(ledger-highlight-xact-under-point)))))
(defun ledger-reconcile-add ()
"Use ledger xact to add a new transaction."
(interactive)
(with-current-buffer ledger-buf
(let ((date (ledger-read-date "Date: "))
(text (read-string "Transaction: ")))
(ledger-add-transaction (concat date " " text))))
(defun ledger-reconcile-add (date xact)
"Use ledger xact to add a new transaction.
When called interactively, prompt for DATE, then XACT."
(interactive
(list (ledger-read-date "Date: ")
(read-string "Transaction: " nil 'ledger-minibuffer-history)))
(with-current-buffer ledger-reconcile-ledger-buf
(ledger-add-transaction (concat date " " xact)))
(ledger-reconcile-refresh))
(defun ledger-reconcile-delete ()
"Delete the transactions pointed to in the recon window."
"Delete the transactions pointed to in the reconcile window."
(interactive)
(let ((where (get-text-property (point) 'where)))
(when (ledger-reconcile-get-buffer where)
@@ -329,7 +360,7 @@ Return the number of uncleared xacts found."
(target-buffer (if where
(ledger-reconcile-get-buffer where)
nil))
(cur-win (get-buffer-window (get-buffer ledger-recon-buffer-name))))
(cur-win (get-buffer-window (get-buffer ledger-reconcile-buffer-name))))
(when target-buffer
(switch-to-buffer-other-window target-buffer)
(ledger-navigate-to-line (cdr where))
@@ -339,16 +370,15 @@ Return the number of uncleared xacts found."
(forward-char -1)
(when (and come-back cur-win)
(select-window cur-win)
(get-buffer ledger-recon-buffer-name)))))
(get-buffer ledger-reconcile-buffer-name)))))
(defun ledger-reconcile-save ()
"Save the ledger buffer."
(interactive)
(with-selected-window (selected-window) ; restoring window is needed because after-save-hook will modify window and buffers
(dolist (buf (cons ledger-buf ledger-bufs))
(with-current-buffer buf
(basic-save-buffer)))))
(with-current-buffer ledger-reconcile-ledger-buf
(basic-save-buffer))))
(defun ledger-reconcile-finish ()
@@ -374,22 +404,22 @@ exit reconcile mode if `ledger-reconcile-finish-force-quit'"
(defun ledger-reconcile-quit ()
"Quit the reconcile window without saving ledger buffer."
(interactive)
(let ((recon-buf (get-buffer ledger-recon-buffer-name))
(let ((reconcile-buf (get-buffer ledger-reconcile-buffer-name))
buf)
(if recon-buf
(with-current-buffer recon-buf
(if reconcile-buf
(with-current-buffer reconcile-buf
(ledger-reconcile-quit-cleanup)
(setq buf ledger-buf)
(setq buf ledger-reconcile-ledger-buf)
;; Make sure you delete the window before you delete the buffer,
;; otherwise, madness ensues
(delete-window (get-buffer-window recon-buf))
(kill-buffer recon-buf)
(delete-window (get-buffer-window reconcile-buf))
(kill-buffer reconcile-buf)
(set-window-buffer (selected-window) buf)))))
(defun ledger-reconcile-quit-cleanup ()
"Cleanup all hooks established by reconcile mode."
(interactive)
(let ((buf ledger-buf))
(let ((buf ledger-reconcile-ledger-buf))
(if (buffer-live-p buf)
(with-current-buffer buf
(remove-hook 'after-save-hook 'ledger-reconcile-refresh-after-save t)
@@ -398,10 +428,10 @@ exit reconcile mode if `ledger-reconcile-finish-force-quit'"
(ledger-highlight-xact-under-point))))))
(defun ledger-marker-where-xact-is (emacs-xact posting)
"Find the position of the EMACS-XACT in the `ledger-buf'.
"Find the position of the EMACS-XACT in the `ledger-reconcile-ledger-buf'.
POSTING is used in `ledger-clear-whole-transactions' is nil."
(let ((buf (if (ledger-is-stdin (nth 0 emacs-xact))
ledger-buf
ledger-reconcile-ledger-buf
(find-file-noselect (nth 0 emacs-xact)))))
(cons
buf
@@ -452,8 +482,10 @@ POSTING is used in `ledger-clear-whole-transactions' is nil."
(ledger-reconcile-format-posting beg
where
fmt
(ledger-format-date (nth 2 xact)) ; date
(if (nth 3 xact) (nth 3 xact) "") ; code
(ledger-format-date
(nth 2 xact)
ledger-reconcile-default-date-format) ; date
(if (nth 3 xact) (nth 3 xact) "") ; code
(nth 3 posting) ; status
(ledger-reconcile-truncate-right
(nth 4 xact) ; payee
@@ -467,8 +499,8 @@ POSTING is used in `ledger-clear-whole-transactions' is nil."
"SORT the uncleared transactions in the account.
The sorted results are displayed in in the *Reconcile* buffer.
Return a count of the uncleared transactions."
(let* ((buf ledger-buf)
(account ledger-acct)
(let* ((buf ledger-reconcile-ledger-buf)
(account ledger-reconcile-account)
(sort-by (if sort
sort
"(date)"))
@@ -477,19 +509,17 @@ Return a count of the uncleared transactions."
(ledger-exec-ledger buf (current-buffer)
"--uncleared" "--real" "emacs" "--sort" sort-by account)
(goto-char (point-min))
(unless (eobp)
(if (looking-at "(")
(read (current-buffer))))))
(when (and (not (eobp)) (looking-at "("))
(read (current-buffer)))))
(fmt (ledger-reconcile-compile-format-string ledger-reconcile-buffer-line-format)))
(if (> (length xacts) 0)
(progn
(if ledger-reconcile-buffer-header
(insert (format ledger-reconcile-buffer-header account)))
(dolist (xact xacts)
(ledger-reconcile-format-xact xact fmt))
(goto-char (point-max))
(delete-char -1)) ;gets rid of the extra line feed at the bottom of the list
(insert (concat "There are no uncleared entries for " account)))
(if (null xacts)
(insert (concat "There are no uncleared entries for " account))
(if ledger-reconcile-buffer-header
(insert (format ledger-reconcile-buffer-header account)))
(dolist (xact xacts)
(ledger-reconcile-format-xact xact fmt))
(goto-char (point-max))
(delete-char -1)) ;gets rid of the extra line feed at the bottom of the list
(goto-char (point-min))
(set-buffer-modified-p nil)
(setq buffer-read-only t)
@@ -501,17 +531,19 @@ Return a count of the uncleared transactions."
This is achieved by placing that transaction at the bottom of the main window.
The key to this is to ensure the window is selected when the buffer point is
moved and recentered. If they aren't strange things happen."
(let ((recon-window (get-buffer-window (get-buffer ledger-recon-buffer-name))))
(when recon-window
(fit-window-to-buffer recon-window)
(with-current-buffer ledger-buf
(let ((reconcile-window (get-buffer-window (get-buffer ledger-reconcile-buffer-name))))
(when reconcile-window
(fit-window-to-buffer reconcile-window)
(with-current-buffer ledger-reconcile-ledger-buf
(add-hook 'kill-buffer-hook 'ledger-reconcile-quit nil t)
(if (get-buffer-window ledger-buf)
(select-window (get-buffer-window ledger-buf)))
(if (get-buffer-window ledger-reconcile-ledger-buf)
(select-window (get-buffer-window ledger-reconcile-ledger-buf)))
(recenter))
(select-window recon-window)
(select-window reconcile-window)
(ledger-reconcile-visit t))
(with-current-buffer ledger-reconcile-ledger-buf
(when ledger-occur-mode
(ledger-occur-refresh)))
(add-hook 'post-command-hook 'ledger-reconcile-track-xact nil t)))
(defun ledger-reconcile-track-xact ()
@@ -541,33 +573,35 @@ moved and recentered. If they aren't strange things happen."
(search-forward account nil t))))
(defun ledger-reconcile (&optional account target)
"Start reconciling, prompt for ACCOUNT."
"Start reconciling, prompt for ACCOUNT.
If TARGET is non-nil, it is used as the initial target for
reconciliation, otherwise prompt for TARGET."
(interactive)
(let ((account (or account (ledger-read-account-with-prompt "Account to reconcile")))
(buf (current-buffer))
(rbuf (get-buffer ledger-recon-buffer-name)))
(rbuf (get-buffer ledger-reconcile-buffer-name)))
(when (ledger-reconcile-check-valid-account account)
(if rbuf ;; *Reconcile* already exists
(with-current-buffer rbuf
(set 'ledger-acct account) ;; already buffer local
(setq ledger-reconcile-account account)
(when (not (eq buf rbuf))
;; called from some other ledger-mode buffer
(ledger-reconcile-quit-cleanup)
(setq ledger-buf buf)) ;; should already be buffer-local
(setq ledger-reconcile-ledger-buf buf))
(unless (get-buffer-window rbuf)
(ledger-reconcile-open-windows buf rbuf)))
;; no recon-buffer, starting from scratch.
;; no reconcile-buffer, starting from scratch.
(with-current-buffer (setq rbuf
(get-buffer-create ledger-recon-buffer-name))
(get-buffer-create ledger-reconcile-buffer-name))
(ledger-reconcile-open-windows buf rbuf)
(ledger-reconcile-mode)
(make-local-variable 'ledger-target)
(set (make-local-variable 'ledger-buf) buf)
(set (make-local-variable 'ledger-acct) account)))
(setq ledger-reconcile-ledger-buf buf)
(setq ledger-reconcile-account account)))
(add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t)
@@ -575,6 +609,9 @@ moved and recentered. If they aren't strange things happen."
(if ledger-narrow-on-reconcile
(ledger-occur (regexp-quote account)))
(setq ledger-reconcile-last-balance-message nil)
(setq ledger-reconcile-last-balance-equals-target nil)
(with-current-buffer rbuf
(if (> (ledger-reconcile-refresh) 0)
(ledger-reconcile-change-target target)
@@ -585,7 +622,7 @@ moved and recentered. If they aren't strange things happen."
(defun ledger-reconcile-change-target (&optional target)
"Change the TARGET amount for the reconciliation process."
(interactive)
(setq ledger-target (or target (ledger-read-commodity-string ledger-reconcile-target-prompt-string)))
(setq ledger-reconcile-target (or target (ledger-read-commodity-string ledger-reconcile-target-prompt-string)))
(ledger-display-balance))
(defmacro ledger-reconcile-change-sort-key-and-refresh (sort-by)
@@ -598,29 +635,30 @@ moved and recentered. If they aren't strange things happen."
(defvar ledger-reconcile-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [(control ?m)] #'ledger-reconcile-visit)
(define-key map [return] #'ledger-reconcile-visit)
(define-key map [(control ?x) (control ?s)] #'ledger-reconcile-save)
(define-key map [(control ?l)] #'ledger-reconcile-refresh)
(define-key map [(control ?c) (control ?c)] #'ledger-reconcile-finish)
(define-key map [? ] #'ledger-reconcile-toggle)
(define-key map [?a] #'ledger-reconcile-add)
(define-key map [?d] #'ledger-reconcile-delete)
(define-key map [?g] #'ledger-reconcile);
(define-key map [?n] #'next-line)
(define-key map [?p] #'previous-line)
(define-key map [?t] #'ledger-reconcile-change-target)
(define-key map [?s] #'ledger-reconcile-save)
(define-key map [?q] #'ledger-reconcile-quit)
(define-key map [?b] #'ledger-display-balance)
(define-key map (kbd "C-m") #'ledger-reconcile-visit)
(define-key map (kbd "<return>") #'ledger-reconcile-visit)
(define-key map (kbd "C-x C-s") #'ledger-reconcile-save)
(define-key map (kbd "C-l") #'ledger-reconcile-refresh)
(define-key map (kbd "C-c C-c") #'ledger-reconcile-finish)
(define-key map (kbd "SPC") #'ledger-reconcile-toggle)
(define-key map (kbd "a") #'ledger-reconcile-add)
(define-key map (kbd "d") #'ledger-reconcile-delete)
(define-key map (kbd "g") #'ledger-reconcile);
(define-key map (kbd "n") #'next-line)
(define-key map (kbd "p") #'previous-line)
(define-key map (kbd "t") #'ledger-reconcile-change-target)
(define-key map (kbd "s") #'ledger-reconcile-save)
(define-key map (kbd "q") #'ledger-reconcile-quit)
(define-key map (kbd "b") #'ledger-display-balance)
(define-key map (kbd "B") #'ledger-reconcile-display-balance-in-header-mode)
(define-key map [(control ?c) (control ?o)] (ledger-reconcile-change-sort-key-and-refresh "(0)"))
(define-key map (kbd "C-c C-o") (ledger-reconcile-change-sort-key-and-refresh "(0)"))
(define-key map [(control ?c) (control ?a)] (ledger-reconcile-change-sort-key-and-refresh "(amount)"))
(define-key map (kbd "C-c C-a") (ledger-reconcile-change-sort-key-and-refresh "(amount)"))
(define-key map [(control ?c) (control ?d)] (ledger-reconcile-change-sort-key-and-refresh "(date)"))
(define-key map (kbd "C-c C-d") (ledger-reconcile-change-sort-key-and-refresh "(date)"))
(define-key map [(control ?c) (control ?p)] (ledger-reconcile-change-sort-key-and-refresh "(payee)"))
(define-key map (kbd "C-c C-p") (ledger-reconcile-change-sort-key-and-refresh "(payee)"))
map)
"Keymap for `ledger-reconcile-mode'.")
@@ -655,6 +693,17 @@ moved and recentered. If they aren't strange things happen."
(define-derived-mode ledger-reconcile-mode text-mode "Reconcile"
"A mode for reconciling ledger entries.")
(define-minor-mode ledger-reconcile-display-balance-in-header-mode
"When enabled, display the cleared-or-pending balance in the header."
:group 'ledger-reconcile
(if ledger-reconcile-display-balance-in-header-mode
(setq header-line-format '(ledger-reconcile-last-balance-equals-target
(:propertize
ledger-reconcile-last-balance-message
face ledger-reconcile-last-balance-equals-target-face)
ledger-reconcile-last-balance-message))
(setq header-line-format nil)))
(provide 'ledger-reconcile)
;;; ledger-reconcile.el ends here

10
lisp/ledger-mode/ledger-regex.el
View File

@@ -50,7 +50,7 @@
"^!comment\n\\(.*\n\\)*?!end_comment$")
(defconst ledger-payee-any-status-regex
"^[0-9]+[-/][-/.=0-9]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.+?\\)\\s-*\\(;\\|$\\)")
"^[0-9]+[-/][-/.=0-9]+\\(?:\\s-+\\*\\)?\\(?:\\s-+(.*?)\\)?\\s-+\\(.+?\\)\\s-*\\(?:;\\|$\\)")
(defconst ledger-payee-pending-regex
"^[0-9]+[-/][-/.=0-9]+\\s-!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\s-*\\(;\\|$\\)")
@@ -61,6 +61,12 @@
(defconst ledger-payee-uncleared-regex
"^[0-9]+[-/][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\s-*\\(;\\|$\\)")
(defconst ledger-payee-directive-regex
(concat "^payee[ \t]+\\(.*?\\)[ \t]*$"))
(defconst ledger-payee-name-or-directive-regex
(format "\\(?:%s\\|%s\\)" ledger-payee-any-status-regex ledger-payee-directive-regex))
(defconst ledger-init-string-regex
"^--.+?\\($\\|[ ]\\)")
@@ -282,7 +288,7 @@
(ledger-define-regexp amount-no-group
(rx (and (? ?-)
(+ digit)
(*? (and (any ?. ?,) (+ digit)))))
(* (and (any ?. ?,) (+ digit)))))
"")
(ledger-define-regexp amount

231
lisp/ledger-mode/ledger-report.el
View File

@@ -28,8 +28,10 @@
(require 'ledger-xact)
(require 'ledger-navigate)
(require 'ledger-commodities)
(require 'ledger-complete)
(declare-function ledger-read-string-with-default "ledger-mode" (prompt default))
(declare-function ledger-read-account-with-prompt "ledger-mode" (prompt))
(declare-function ledger-read-payee-with-prompt "ledger-mode" (prompt))
(require 'easymenu)
(require 'ansi-color)
@@ -38,10 +40,8 @@
(require 'rx)
(require 'subr-x))
(defvar ledger-buf)
(defgroup ledger-report nil
"Customization option for the Report buffer"
"Customization option for the Report buffer."
:group 'ledger)
(defcustom ledger-reports
@@ -78,7 +78,8 @@ The function is called with no parameters and expected to return
a string, or a list of strings, that should replace the format specifier.
Single strings are quoted with `shell-quote-argument'; lists of strings are
simply concatenated (no quoting)."
:type 'alist
:type '(alist :key-type string
:value-type function)
:group 'ledger-report)
(defcustom ledger-report-auto-refresh t
@@ -96,6 +97,13 @@ simply concatenated (no quoting)."
:type 'boolean
:group 'ledger-report)
(defcustom ledger-report-links-beginning-of-xact t
"If nil, links in \"register\" reports visit the posting they correspond to.
If non-nil, visit the beginning of the transaction instead."
:type 'boolean
:group 'ledger-report)
(defcustom ledger-report-use-native-highlighting t
"When non-nil, use ledger's native highlighting in reports."
:type 'boolean
@@ -153,21 +161,22 @@ Calls `shrink-window-if-larger-than-buffer'."
(defvar ledger-report-buffer-name "*Ledger Report*")
(defvar ledger-report-name nil)
(defvar ledger-report-cmd nil)
(defvar ledger-report-name-prompt-history nil)
(defvar ledger-report-cmd-prompt-history nil)
(defvar ledger-report-saved nil)
(defvar ledger-minibuffer-history nil)
(defvar ledger-report-mode-abbrev-table)
(defvar ledger-report-current-month nil)
(defvar ledger-report-is-reversed nil)
(defvar ledger-report-cursor-line-number nil)
(defvar-local ledger-report-name nil)
(defvar-local ledger-report-cmd nil)
(defvar-local ledger-report-saved nil)
(defvar-local ledger-report-current-month nil)
(defvar-local ledger-report-is-reversed nil)
(defvar-local ledger-report-cursor-line-number nil)
(defvar-local ledger-report-ledger-buf nil)
(defvar-local ledger-master-file nil
"The master file for the current buffer.
See documentation for the function `ledger-master-file'")
(defvar ledger-report-name-prompt-history nil)
(defvar ledger-report-cmd-prompt-history nil)
(defvar ledger-minibuffer-history nil)
(defvar ledger-report-mode-abbrev-table)
(defun ledger-report-reverse-report ()
"Reverse the order of the report."
(interactive)
@@ -191,20 +200,17 @@ See documentation for the function `ledger-master-file'")
(defvar ledger-report-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [?r] #'ledger-report-redo)
(define-key map [(shift ?r)] #'ledger-report-reverse-report)
(define-key map [?s] #'ledger-report-save)
(define-key map [(shift ?s)] #'ledger-report)
(define-key map [?e] #'ledger-report-edit-report)
(define-key map [( shift ?e)] #'ledger-report-edit-reports)
(define-key map [?q] #'ledger-report-quit)
(define-key map [(control ?c) (control ?l) (control ?r)]
#'ledger-report-redo)
(define-key map [(control ?c) (control ?l) (control ?S)]
#'ledger-report-save)
(define-key map [(control ?c) (control ?l) (control ?e)]
#'ledger-report-edit-report)
(define-key map [(control ?c) (control ?o) (control ?r)] #'ledger-report)
(define-key map (kbd "r") #'ledger-report-redo)
(define-key map (kbd "R") #'ledger-report-reverse-report)
(define-key map (kbd "s") #'ledger-report-save)
(define-key map (kbd "S") #'ledger-report)
(define-key map (kbd "e") #'ledger-report-edit-report)
(define-key map (kbd "E") #'ledger-report-edit-reports)
(define-key map (kbd "q") #'ledger-report-quit)
(define-key map (kbd "C-c C-l C-r") #'ledger-report-redo)
(define-key map (kbd "C-c C-l C-S-s") #'ledger-report-save)
(define-key map (kbd "C-c C-l C-e") #'ledger-report-edit-report)
(define-key map (kbd "C-c C-o C-r") #'ledger-report)
(define-key map (kbd "M-p") #'ledger-report-previous-month)
(define-key map (kbd "M-n") #'ledger-report-next-month)
(define-key map (kbd "$") #'ledger-report-toggle-default-commodity)
@@ -212,7 +218,7 @@ See documentation for the function `ledger-master-file'")
"Keymap for `ledger-report-mode'.")
(easy-menu-define ledger-report-mode-menu ledger-report-mode-map
"Ledger report menu"
"Ledger report menu."
'("Reports"
["Select Report" ledger-report]
["Save Report" ledger-report-save]
@@ -245,13 +251,13 @@ See documentation for the function `ledger-master-file'")
"Return a valid meta-data tag name."
;; It is intended completion should be available on existing tag
;; names, but it remains to be implemented.
(ledger-read-string-with-default "Tag Name: " nil))
(ledger-read-string-with-default "Tag Name" nil))
(defun ledger-report-tagvalue-format-specifier ()
"Return a valid meta-data tag name."
;; It is intended completion should be available on existing tag
;; values, but it remains to be implemented.
(ledger-read-string-with-default "Tag Value: " nil))
(ledger-read-string-with-default "Tag Value" nil))
(defun ledger-report-read-name ()
"Read the name of a ledger report to use, with completion.
@@ -288,16 +294,17 @@ used to generate the buffer, navigating the buffer, etc."
(buf (find-file-noselect file)))
(with-current-buffer
(pop-to-buffer (get-buffer-create ledger-report-buffer-name))
(ledger-report-mode)
(setq ledger-report-saved nil)
(setq ledger-report-ledger-buf buf)
(setq ledger-report-name report-name)
(setq ledger-report-is-reversed nil)
(setq ledger-report-current-month nil)
(setq ledger-master-file file)
(ledger-report-cmd report-name edit)
(with-silent-modifications
(erase-buffer)
(ledger-report-mode)
(set (make-local-variable 'ledger-report-saved) nil)
(set (make-local-variable 'ledger-buf) buf)
(set (make-local-variable 'ledger-report-name) report-name)
(set (make-local-variable 'ledger-report-is-reversed) nil)
(set (make-local-variable 'ledger-report-current-month) nil)
(set 'ledger-master-file file)
(ledger-do-report (ledger-report-cmd report-name edit)))
(ledger-do-report ledger-report-cmd))
(ledger-report-maybe-shrink-window)
(run-hooks 'ledger-report-after-report-hook)
(message (substitute-command-keys (concat "\\[ledger-report-quit] to quit; "
@@ -310,19 +317,15 @@ used to generate the buffer, navigating the buffer, etc."
"Compute the string to be used as the header in the `ledger-report' buffer."
(format "Ledger Report: %s -- Buffer: %s -- Command: %s"
(propertize ledger-report-name 'face 'font-lock-constant-face)
(propertize (buffer-name ledger-buf) 'face 'font-lock-string-face)
(propertize (buffer-name ledger-report-ledger-buf) 'face 'font-lock-string-face)
(propertize ledger-report-cmd 'face 'font-lock-comment-face)))
(defun ledger-report-string-empty-p (s)
"Check S for the empty string."
(string-equal "" s))
(defun ledger-report-name-exists (name)
"Check to see if the given report NAME exists.
If name exists, returns the object naming the report,
otherwise returns nil."
(unless (ledger-report-string-empty-p name)
If exists, returns the object naming the report, otherwise
returns nil."
(unless (string-empty-p name)
(car (assoc name ledger-reports))))
(defun ledger-reports-add (name cmd)
@@ -342,10 +345,10 @@ used to generate the buffer, navigating the buffer, etc."
(defun ledger-report-ledger-file-format-specifier ()
"Substitute the full path to master or current ledger file.
The master file name is determined by the variable `ledger-master-file'
buffer-local variable which can be set using file variables.
If it is set, it is used, otherwise the current buffer file is
used."
The master file name is determined by the function
`ledger-master-file', which depends on the variable of the same
name. If it is non-nil, it is used, otherwise the current
buffer's file is used."
(ledger-master-file))
;; General helper functions
@@ -353,10 +356,11 @@ used to generate the buffer, navigating the buffer, etc."
(defun ledger-master-file ()
"Return the master file for a ledger file.
The master file is either the file for the current ledger buffer or the
file specified by the buffer-local variable `ledger-master-file'. Typically
this variable would be set in a file local variable comment block at the
end of a ledger file which is included in some other file."
The master file is either the file for the current ledger buffer
or the file specified by the buffer-local variable
`ledger-master-file'. Typically this variable would be set in a
file local variable comment block at the end of a ledger file
which is included in some other file."
(if ledger-master-file
(expand-file-name ledger-master-file)
(buffer-file-name)))
@@ -364,23 +368,18 @@ used to generate the buffer, navigating the buffer, etc."
(defun ledger-report-payee-format-specifier ()
"Substitute a payee name.
The user is prompted to enter a payee and that is substituted. If
point is in an xact, the payee for that xact is used as the
default."
;; It is intended completion should be available on existing
;; payees, but the list of possible completions needs to be
;; developed to allow this.
(if-let ((payee (ledger-xact-payee)))
(ledger-read-string-with-default "Payee" (regexp-quote payee))
(ledger-read-string-with-default "Payee" nil)))
The user is prompted to enter a payee and that is substituted.
If point is in an xact, the payee for that xact is used as the
default."
(ledger-read-payee-with-prompt "Payee"))
(defun ledger-report-account-format-specifier ()
"Substitute an account name.
The user is prompted to enter an account name, which can be any
regular expression identifying an account. If point is on an account
posting line for an xact, the full account name on that line is
the default."
The user is prompted to enter an account name, which can be any
regular expression identifying an account. If point is on an
account posting line for an xact, the full account name on that
line is the default."
(ledger-read-account-with-prompt "Account"))
(defun ledger-report--current-month ()
@@ -424,25 +423,26 @@ MONTH is of the form (YEAR . INDEX) where INDEX ranges from
(format "%s-%s" year month-index))))
(defun ledger-report-expand-format-specifiers (report-cmd)
"Expand format specifiers in REPORT-CMD with thing under point."
(save-match-data
(let ((expanded-cmd report-cmd))
(set-match-data (list 0 0))
(while (string-match "%(\\([^)]*\\))" expanded-cmd
(if (> (length expanded-cmd) (match-end 0))
(match-end 0)
(1- (length expanded-cmd))))
(let* ((specifier (match-string 1 expanded-cmd))
(f (cdr (assoc specifier ledger-report-format-specifiers))))
(if f
(let* ((arg (save-match-data
(with-current-buffer ledger-buf
(funcall f))))
(quoted (if (listp arg)
(mapconcat #'identity arg " ")
(shell-quote-argument arg))))
(setq expanded-cmd (replace-match quoted t t expanded-cmd))))))
expanded-cmd)))
"Expand format specifiers in REPORT-CMD.
Format specifiers are defined in the
`ledger-report-format-specifiers' alist. The functions are
called in the ledger buffer for which the report is being run."
(let ((ledger-buf ledger-report-ledger-buf))
(with-temp-buffer
(save-excursion (insert report-cmd))
(while (re-search-forward "%(\\([^)]*\\))" nil t)
(when-let ((specifier (match-string 1))
(f (cdr (assoc specifier ledger-report-format-specifiers))))
(let* ((arg (save-match-data
(with-current-buffer ledger-buf
(funcall f))))
(quoted (save-match-data
(if (listp arg)
(string-join arg " ")
(shell-quote-argument arg)))))
(replace-match quoted 'fixedcase 'literal))))
(buffer-string))))
(defun ledger-report--cmd-needs-links-p (cmd)
"Check links should be added to the report produced by CMD."
@@ -457,7 +457,7 @@ MONTH is of the form (YEAR . INDEX) where INDEX ranges from
`(,@(when (ledger-report--cmd-needs-links-p report-cmd)
'("--prepend-format=%(filename):%(beg_line):"))
,@(when ledger-report-auto-width
`("--columns" ,(format "%d" (- (window-width) 1))))
`("--columns" ,(format "%d" (window-max-chars-per-line))))
,@(when ledger-report-use-native-highlighting
ledger-report-native-highlighting-arguments)
,@(when ledger-report-use-strict
@@ -472,8 +472,8 @@ Optionally EDIT the command."
(setq report-cmd (ledger-report-read-command report-cmd))
(setq ledger-report-saved nil)) ;; this is a new report, or edited report
(setq report-cmd (ledger-report-expand-format-specifiers report-cmd))
(set (make-local-variable 'ledger-report-cmd) report-cmd)
(or (ledger-report-string-empty-p report-name)
(setq ledger-report-cmd report-cmd)
(or (string-empty-p report-name)
(ledger-report-name-exists report-name)
(progn
(ledger-reports-add report-name report-cmd)
@@ -489,7 +489,7 @@ Optionally EDIT the command."
"Rebuild report with transactions from current month + SHIFT."
(let* ((current-month (or ledger-report-current-month (ledger-report--current-month)))
(previous-month (ledger-report--shift-month current-month shift)))
(set (make-local-variable 'ledger-report-current-month) previous-month)
(setq ledger-report-current-month previous-month)
(ledger-report-cmd ledger-report-name nil)
(ledger-report-redo)))
@@ -546,7 +546,10 @@ arguments returned by `ledger-report--compute-extra-args'."
(ledger-report--add-links))))))
(defun ledger-report-visit-source ()
"Visit the transaction under point in the report window."
"Visit the transaction under point in the report window.
If `ledger-report-links-beginning-of-xact' is nil, visit the
specific posting at point instead."
(interactive)
(let* ((prop (get-text-property (point) 'ledger-source))
(file (car prop))
@@ -556,7 +559,8 @@ arguments returned by `ledger-report--compute-extra-args'."
(widen)
(goto-char (point-min))
(forward-line (1- line))
(ledger-navigate-beginning-of-xact))))
(when ledger-report-links-beginning-of-xact
(ledger-navigate-beginning-of-xact)))))
(defun ledger-report-goto ()
"Goto the ledger report buffer."
@@ -616,7 +620,7 @@ IGNORE-AUTO and NOCONFIRM are for compatibility with
(defun ledger-report-read-new-name ()
"Read the name for a new report from the minibuffer."
(let ((name ""))
(while (ledger-report-string-empty-p name)
(while (string-empty-p name)
(setq name (read-from-minibuffer "Report name: " nil nil nil
'ledger-report-name-prompt-history)))
name))
@@ -625,27 +629,24 @@ IGNORE-AUTO and NOCONFIRM are for compatibility with
"Save the current report command line as a named report."
(interactive)
(ledger-report-goto)
(let (existing-name)
(when (ledger-report-string-empty-p ledger-report-name)
(setq ledger-report-name (ledger-report-read-new-name)))
(when (string-empty-p ledger-report-name)
(setq ledger-report-name (ledger-report-read-new-name)))
(if (setq existing-name (ledger-report-name-exists ledger-report-name))
(cond ((y-or-n-p (format "Overwrite existing report named '%s'? "
ledger-report-name))
(if (string-equal
ledger-report-cmd
(car (cdr (assq existing-name ledger-reports))))
(message "Nothing to save. Current command is identical to existing saved one")
(progn
(setq ledger-reports
(assq-delete-all existing-name ledger-reports))
(ledger-reports-add ledger-report-name ledger-report-cmd)
(ledger-reports-custom-save))))
(t
(progn
(setq ledger-report-name (ledger-report-read-new-name))
(ledger-reports-add ledger-report-name ledger-report-cmd)
(ledger-reports-custom-save)))))))
(when-let ((existing-name (ledger-report-name-exists ledger-report-name)))
(cond ((y-or-n-p (format "Overwrite existing report named '%s'? "
ledger-report-name))
(if (string-equal
ledger-report-cmd
(car (cdr (assq existing-name ledger-reports))))
(message "Nothing to save. Current command is identical to existing saved one")
(setq ledger-reports
(assq-delete-all existing-name ledger-reports))
(ledger-reports-add ledger-report-name ledger-report-cmd)
(ledger-reports-custom-save)))
(t
(setq ledger-report-name (ledger-report-read-new-name))
(ledger-reports-add ledger-report-name ledger-report-cmd)
(ledger-reports-custom-save)))))
(defun ledger-report-previous-month ()
"Rebuild report with transactions from the previous month."

18
lisp/ledger-mode/ledger-schedule.el
View File

@@ -71,7 +71,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))
:type '(alist :key-type string :value-type (group integer))
:group 'ledger-schedule)
(defsubst ledger-between (val low high)
@@ -318,15 +318,13 @@ 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)))
(if (and file
(file-exists-p file))
(progn
(ledger-schedule-create-auto-buffer
(ledger-schedule-scan-transactions file)
look-backward
look-forward)
(pop-to-buffer ledger-schedule-buffer-name))
(error "Could not find ledger schedule file at %s" file)))
(unless (and file (file-exists-p file))
(error "Could not find ledger schedule file at %s" file))
(ledger-schedule-create-auto-buffer
(ledger-schedule-scan-transactions file)
look-backward
look-forward)
(pop-to-buffer ledger-schedule-buffer-name))
(provide 'ledger-schedule)

32
lisp/ledger-mode/ledger-sort.el
View File

@@ -27,6 +27,7 @@
;;; Code:
(require 'ledger-regex)
(require 'ledger-navigate)
(require 'ledger-xact)
(defun ledger-sort-find-start ()
"Find the beginning of a sort region."
@@ -59,16 +60,18 @@
(insert "\n; Ledger-mode: End sort\n\n"))
(defun ledger-sort-startkey ()
"Return the date portion of the current line, for use in sorting."
(buffer-substring-no-properties (point) (+ 10 (point))))
"Return a numeric sort key based on the date of the xact beginning at point."
;; Can use `time-convert' to return an integer instead of a floating-point
;; number, starting in Emacs 27.
(float-time
(ledger-parse-iso-date
(buffer-substring-no-properties (point) (+ 10 (point))))))
(defun ledger-sort-region (beg end)
"Sort the region from BEG to END in chronological order."
(interactive "r") ;; load beg and end from point and mark
;; automagically
(let* ((new-beg beg)
(new-end end)
(bounds (ledger-navigate-find-xact-extents (point)))
(let* ((bounds (ledger-navigate-find-xact-extents (point)))
(point-delta (- (point) (car bounds)))
(target-xact (buffer-substring (car bounds) (cadr bounds)))
(inhibit-modification-hooks t))
@@ -80,31 +83,30 @@
;; make sure point is at the beginning of a xact
(unless (looking-at ledger-payee-any-status-regex)
(ledger-navigate-next-xact))
(setq new-beg (point))
(setq beg (point))
(goto-char end)
(ledger-navigate-next-xact)
;; make sure end of region is at the beginning of next record
;; after the region
(setq new-end (point))
(narrow-to-region new-beg new-end)
(goto-char new-beg)
(setq end (point))
(narrow-to-region beg end)
(goto-char beg)
(let ((inhibit-field-text-motion t))
(sort-subr
nil
'ledger-navigate-next-xact
'ledger-navigate-end-of-xact
'ledger-sort-startkey))))
#'ledger-navigate-next-xact
#'ledger-navigate-end-of-xact
#'ledger-sort-startkey))))
(goto-char (point-min))
(re-search-forward (regexp-quote target-xact))
(search-forward target-xact)
(goto-char (+ (match-beginning 0) point-delta))))
(defun ledger-sort-buffer ()
"Sort the entire buffer."
(interactive)
(let (sort-start
sort-end)
(let (sort-start sort-end)
(save-excursion
(goto-char (point-min))
(setq sort-start (ledger-sort-find-start)

28
lisp/ledger-mode/ledger-state.el
View File

@@ -215,21 +215,21 @@ dropped."
(defun ledger-toggle-current (&optional style)
"Toggle the current thing at point with optional STYLE."
(interactive)
(if (or ledger-clear-whole-transactions
(eq 'transaction (ledger-thing-at-point)))
(progn
(save-excursion
(forward-line)
(goto-char (line-beginning-position))
(while (and (not (eolp))
(save-excursion
(not (eq 'transaction (ledger-thing-at-point)))))
(if (looking-at "\\s-+[*!]")
(ledger-toggle-current-posting style))
(let ((thing (ledger-thing-at-point)))
(if (or (and ledger-clear-whole-transactions (eq 'posting thing))
(eq 'transaction thing))
(let ((end (save-excursion (ledger-navigate-end-of-xact) (point-marker))))
;; clear state markings on postings
(save-excursion
(forward-line)
(goto-char (line-beginning-position))))
(ledger-toggle-current-transaction style))
(ledger-toggle-current-posting style)))
(beginning-of-line)
(while (< (point) end)
(when (looking-at "\\s-+[*!]")
(ledger-toggle-current-posting style))
(forward-line)))
(set-marker end nil)
(ledger-toggle-current-transaction style))
(ledger-toggle-current-posting style))))
(defun ledger-toggle-current-transaction (&optional style)
"Toggle the transaction at point using optional STYLE."

2
lisp/ledger-mode/ledger-test.el
View File

@@ -1,4 +1,4 @@
;;; ledger-test.el --- Helper code for use with the "ledger" command-line tool
;;; ledger-test.el --- Helper code for use with the "ledger" command-line tool -*- lexical-binding: t -*-
;; Copyright (C) 2003-2016 John Wiegley (johnw AT gnu DOT org)

102
lisp/ledger-mode/ledger-xact.el
View File

@@ -31,7 +31,6 @@
(require 'ledger-exec)
(require 'ledger-post)
(declare-function ledger-read-date "ledger-mode" (prompt))
(declare-function ledger-format-date "ledger-init" (&optional date))
;; TODO: This file depends on code in ledger-mode.el, which depends on this.
@@ -70,36 +69,29 @@ When nil, `ledger-add-transaction' will not prompt twice."
(move-overlay ledger-xact-highlight-overlay b (+ 1 e))
(move-overlay ledger-xact-highlight-overlay 1 1))))))
(defun ledger-highlight--before-revert ()
"Clean up highlighting overlay before reverting buffer."
(when ledger-xact-highlight-overlay
(delete-overlay ledger-xact-highlight-overlay)))
(defun ledger-xact-context ()
"Return the context of the transaction containing point or nil."
(let ((i 0))
(while (eq (ledger-context-line-type (ledger-context-other-line i)) 'acct-transaction)
(setq i (- i 1)))
(let ((context-info (ledger-context-other-line i)))
(if (eq (ledger-context-line-type context-info) 'xact)
context-info
nil))))
(when (eq (ledger-context-line-type context-info) 'xact)
context-info))))
(defun ledger-xact-payee ()
"Return the payee of the transaction containing point or nil."
(let ((xact-context (ledger-xact-context)))
(if xact-context
(ledger-context-field-value xact-context 'payee)
nil)))
(when-let ((xact-context (ledger-xact-context)))
(ledger-context-field-value xact-context 'payee)))
(defun ledger-xact-date ()
"Return the date of the transaction containing point or nil."
(let ((xact-context (ledger-xact-context)))
(if xact-context
(ledger-context-field-value xact-context 'date)
nil)))
(defun ledger-time-less-p (t1 t2)
"Say whether time value T1 is less than time value T2."
;; TODO: assert listp, or support when both are strings
(or (< (car t1) (car t2))
(and (= (car t1) (car t2))
(< (nth 1 t1) (nth 1 t2)))))
(when-let ((xact-context (ledger-xact-context)))
(ledger-context-field-value xact-context 'date)))
(defun ledger-xact-find-slot (moment)
"Find the right place in the buffer for a transaction at MOMENT.
@@ -107,11 +99,11 @@ MOMENT is an encoded date"
(let (last-xact-start)
(catch 'found
(ledger-xact-iterate-transactions
(function
(lambda (start date _mark _desc)
(setq last-xact-start start)
(if (ledger-time-less-p moment date)
(throw 'found t))))))
(lambda (start date _mark _desc)
(setq last-xact-start start)
(when (time-less-p moment date)
(throw 'found t)))))
;; If we are inserting at the end of the buffer, insert an extra newline
(when (and (eobp) last-xact-start)
(let ((end (cadr (ledger-navigate-find-xact-extents last-xact-start))))
(goto-char end)
@@ -125,21 +117,20 @@ MOMENT is an encoded date"
(current-year (nth 5 (decode-time now))))
(while (not (eobp))
(when (looking-at ledger-iterate-regexp)
(let ((found-y-p (match-string 1)))
(if found-y-p
(setq current-year (string-to-number found-y-p)) ;; a Y directive was found
(let ((start (match-beginning 0))
(year (match-string (+ ledger-regex-iterate-group-actual-date 1)))
(month (string-to-number (match-string (+ ledger-regex-iterate-group-actual-date 2))))
(day (string-to-number (match-string (+ ledger-regex-iterate-group-actual-date 3))))
(state (match-string ledger-regex-iterate-group-state))
(payee (match-string ledger-regex-iterate-group-payee)))
(if (and year (> (length year) 0))
(setq year (string-to-number year)))
(funcall callback start
(encode-time 0 0 0 day month
(or year current-year))
state payee)))))
(if-let ((year (match-string 1)))
(setq current-year (string-to-number year)) ;a Y directive was found
(let ((start (match-beginning 0))
(year (match-string (+ ledger-regex-iterate-group-actual-date 1)))
(month (string-to-number (match-string (+ ledger-regex-iterate-group-actual-date 2))))
(day (string-to-number (match-string (+ ledger-regex-iterate-group-actual-date 3))))
(state (match-string ledger-regex-iterate-group-state))
(payee (match-string ledger-regex-iterate-group-payee)))
(if (and year (> (length year) 0))
(setq year (string-to-number year)))
(funcall callback start
(encode-time 0 0 0 day month
(or year current-year))
state payee))))
(forward-line))))
(defcustom ledger-copy-transaction-insert-blank-line-after nil
@@ -149,9 +140,8 @@ MOMENT is an encoded date"
(defun ledger-copy-transaction-at-point (date)
"Ask for a new DATE and copy the transaction under point to that date.
Leave point on the first amount."
(interactive (list
(ledger-read-date "Copy to date: ")))
Leave point on the first amount, if any, otherwise the first account."
(interactive (list (ledger-read-date "Copy to date: ")))
(let* ((extents (ledger-navigate-find-xact-extents (point)))
(transaction (buffer-substring-no-properties (car extents) (cadr extents)))
(encoded-date (ledger-parse-iso-date date)))
@@ -163,11 +153,14 @@ Leave point on the first amount."
"\n"))
(beginning-of-line -1)
(ledger-navigate-beginning-of-xact)
(re-search-forward ledger-iso-date-regexp)
(replace-match date)
(ledger-next-amount)
(if (re-search-forward "[-0-9]")
(goto-char (match-beginning 0)))))
(let ((end (save-excursion (ledger-navigate-end-of-xact) (point))))
(re-search-forward ledger-iso-date-regexp)
(replace-match date)
(if (ledger-next-amount end)
(progn
(re-search-forward "[-0-9]")
(goto-char (match-beginning 0)))
(ledger-next-account end)))))
(defun ledger-delete-current-transaction (pos)
"Delete the transaction surrounding POS."
@@ -198,9 +191,11 @@ Leave point on the first amount."
"Use ledger xact TRANSACTION-TEXT to add a transaction to the buffer.
If INSERT-AT-POINT is non-nil insert the transaction there,
otherwise call `ledger-xact-find-slot' to insert it at the
correct chronological place in the buffer. Interactively, the
date is requested via `ledger-read-date'."
(interactive (list (ledger-read-transaction)))
correct chronological place in the buffer.
Interactively, the date is requested via `ledger-read-date' and
the \\[universal-argument] enables INSERT-AT-POINT."
(interactive (list (ledger-read-transaction) current-prefix-arg))
(let* ((args (with-temp-buffer
(insert transaction-text)
(eshell-parse-arguments (point-min) (point-max))))
@@ -215,7 +210,7 @@ date is requested via `ledger-read-date'."
(ledger-xact-find-slot (or parsed-date date))
(when (looking-at "\n*\\'")
(setq separator ""))))
(if (> (length args) 1)
(if (cdr args)
(save-excursion
(insert
(with-temp-buffer
@@ -225,9 +220,8 @@ date is requested via `ledger-read-date'."
(ledger-post-align-postings (point-min) (point-max))
(buffer-string))
separator))
(progn
(insert (car args) " ")
(save-excursion (insert "\n" separator))))))
(insert (car args) " ")
(save-excursion (insert "\n" separator)))))
(provide 'ledger-xact)