Fixed reconciliation initialization. Now prompts with only account, not status and amount
Moved context function to leg-context, from leg-report. Cleaned up many regex in ldg-context.
This commit is contained in:
Craig Earls
parent
2f3053401a
commit
4df990014f
10 changed files with 237 additions and 206 deletions
|
|
@ -30,9 +30,12 @@
|
|||
|
||||
(defun ledger-parse-arguments ()
|
||||
"Parse whitespace separated arguments in the current region."
|
||||
(let* ((info (save-excursion
|
||||
(cons (ledger-thing-at-point) (point))))
|
||||
(begin (cdr info))
|
||||
;; 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-excursion
|
||||
(ledger-thing-at-point) ;; leave point at beginning of thing under point
|
||||
(point)))
|
||||
(end (point))
|
||||
begins args)
|
||||
(save-excursion
|
||||
|
|
@ -45,6 +48,7 @@
|
|||
args)))
|
||||
(cons (reverse args) (reverse begins)))))
|
||||
|
||||
|
||||
(defun ledger-payees-in-buffer ()
|
||||
"Scan buffer and return list of all payees."
|
||||
(let ((origin (point))
|
||||
|
|
@ -77,12 +81,12 @@ Return tree structure"
|
|||
(match-string-no-properties 2) ":"))
|
||||
(let ((root account-tree))
|
||||
(while account-elements
|
||||
(let ((entry (assoc (car account-elements) root)))
|
||||
(if entry
|
||||
(setq root (cdr entry))
|
||||
(setq entry (cons (car account-elements) (list t)))
|
||||
(nconc root (list entry))
|
||||
(setq root (cdr entry))))
|
||||
(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))
|
||||
|
||||
|
|
@ -93,11 +97,11 @@ Return tree structure"
|
|||
(root (ledger-find-accounts-in-buffer))
|
||||
(prefix nil))
|
||||
(while (cdr elements)
|
||||
(let ((entry (assoc (car elements) root)))
|
||||
(if entry
|
||||
(let ((xact (assoc (car elements) root)))
|
||||
(if xact
|
||||
(setq prefix (concat prefix (and prefix ":")
|
||||
(car elements))
|
||||
root (cdr entry))
|
||||
root (cdr xact))
|
||||
(setq root nil elements nil)))
|
||||
(setq elements (cdr elements)))
|
||||
(and root
|
||||
|
|
@ -136,7 +140,7 @@ Return tree structure"
|
|||
(throw 'pcompleted t)))
|
||||
(ledger-accounts)))))
|
||||
|
||||
(defun ledger-fully-complete-entry ()
|
||||
(defun ledger-fully-complete-xact ()
|
||||
"Completes a transaction if there is another matching payee in the buffer.
|
||||
Does not use ledger xact"
|
||||
(interactive)
|
||||
|
|
|
|||
183
lisp/ldg-context.el
Normal file
183
lisp/ldg-context.el
Normal file
|
|
@ -0,0 +1,183 @@
|
|||
;;; ldg-context.el --- Helper code for use with the "ledger" command-line tool
|
||||
|
||||
;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org)
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This is free software; you can redistribute it and/or modify it under
|
||||
;; the terms of the GNU General Public License as published by the Free
|
||||
;; Software Foundation; either version 2, or (at your option) any later
|
||||
;; version.
|
||||
;;
|
||||
;; This is distributed in the hope that it will be useful, but WITHOUT
|
||||
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
||||
;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
||||
;; for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
|
||||
;; MA 02111-1307, USA.
|
||||
|
||||
|
||||
;;; Commentary:
|
||||
;; Provide facilities for reflection in ledger buffers
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile
|
||||
(require 'cl))
|
||||
|
||||
|
||||
(defconst ledger-line-config
|
||||
'((xact
|
||||
(("^\\(\\([0-9][0-9][0-9][0-9]/\\)?[01]?[0-9]/[0123]?[0-9]\\)[ \t]+\\(\\([!*]\\)[ \t]\\)?[ \t]*\\((\\(.*\\))\\)?[ \t]*\\(.*?\\)[ \t]*;\\(.*\\)[ \t]*$"
|
||||
(date nil status nil nil code payee comment))
|
||||
("^\\(\\([0-9][0-9][0-9][0-9]/\\)?[01]?[0-9]/[0123]?[0-9]\\)[ \t]+\\(\\([!*]\\)[ \t]\\)?[ \t]*\\((\\(.*\\))\\)?[ \t]*\\(.*\\)[ \t]*$"
|
||||
(date nil status nil nil code payee))))
|
||||
(acct-transaction
|
||||
(("^\\([ \t]+;\\|;\\)\\s-?\\(.*\\)"
|
||||
(indent comment))
|
||||
("\\(^[ \t]+\\)\\([*! ]?\\)\\(.*?\\)\\s-\\s-[ \t]+\\([$€£]\\s-?\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)[ \t]*;[ \t]*\\(.*\\)[ \t]*$"
|
||||
(indent status account commodity amount nil comment)) ;checked 2013-04-06
|
||||
("\\(^[ \t]+\\)\\([*! ]?\\)\\(.*?\\)\\s-\\s-[ \t]+\\([$€£]\\s-?\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)$"
|
||||
(indent status account commodity amount)) ;checked 2013-04-06
|
||||
("\\(^[ \t]+\\)\\([*! ]?\\)\\(.*?\\)\\s-\\s-[ \t]+\\(-?[0-9]+\\.[0-9]*\\)[ \t]+\\(.*?\\)[ \t]*\\(;[ \t]*\\(.*?\\)[ \t]*$\\|@+\\)"
|
||||
(indent status account amount nil commodity comment)) ;checked 2013-04-06
|
||||
("\\(^[ \t]+\\)\\([*! ]?\\)\\(.*?\\)\\s-\\s-[ \t]+\\(-?[0-9]+\\.[0-9]*\\)[ \t]+\\(.*\\)"
|
||||
(indent status account amount nil commodity)) ;checked 2013-04-06
|
||||
("\\(^[ \t]+\\)\\([*! ]?\\)\\(.*?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$"
|
||||
(indent status account comment))
|
||||
("\\(^[ \t]+\\)\\([*! ]?\\)\\(.*?\\)[ \t]*$"
|
||||
(indent status account))))))
|
||||
|
||||
(defun ledger-extract-context-info (line-type pos)
|
||||
"Get context info for current line with LINE-TYPE.
|
||||
|
||||
Assumes point is at beginning of line, and the POS argument specifies
|
||||
where the \"users\" point was."
|
||||
(let ((linfo (assoc line-type ledger-line-config))
|
||||
found field fields)
|
||||
(dolist (re-info (nth 1 linfo))
|
||||
(let ((re (nth 0 re-info))
|
||||
(names (nth 1 re-info)))
|
||||
(unless found
|
||||
(when (looking-at re)
|
||||
(setq found t)
|
||||
(dotimes (i (length names))
|
||||
(when (nth i names)
|
||||
(setq fields (append fields
|
||||
(list
|
||||
(list (nth i names)
|
||||
(match-string-no-properties (1+ i))
|
||||
(match-beginning (1+ i))))))))
|
||||
(dolist (f fields)
|
||||
(and (nth 1 f)
|
||||
(>= pos (nth 2 f))
|
||||
(setq field (nth 0 f))))))))
|
||||
(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"
|
||||
(let ((here (point)))
|
||||
(goto-char (line-beginning-position))
|
||||
(cond ((looking-at "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.+?)\\)?\\s-+")
|
||||
(goto-char (match-end 0))
|
||||
'transaction)
|
||||
((looking-at "^\\s-+\\([*!]\\s-+\\)?[[(]?\\(.\\)")
|
||||
(goto-char (match-beginning 2))
|
||||
'posting)
|
||||
((looking-at "^\\(sun\\|mon\\|tue\\|wed\\|thu\\|fri\\|sat\\)\\s-+")
|
||||
(goto-char (match-end 0))
|
||||
'day)
|
||||
(t
|
||||
(ignore (goto-char here))))))
|
||||
|
||||
(defun ledger-context-at-point ()
|
||||
"Return a list describing the context around point.
|
||||
|
||||
The contents of the list are the line type, the name of the field
|
||||
containing point, and for selected line types, the content of
|
||||
the fields in the line in a association list."
|
||||
(let ((pos (point)))
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(let ((first-char (char-after)))
|
||||
(cond ((equal (point) (line-end-position))
|
||||
'(empty-line nil nil))
|
||||
((memq first-char '(?\ ?\t))
|
||||
(ledger-extract-context-info 'acct-transaction pos))
|
||||
((memq first-char '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
|
||||
(ledger-extract-context-info 'xact pos))
|
||||
((equal first-char ?\=)
|
||||
'(automated-xact nil nil))
|
||||
((equal first-char ?\~)
|
||||
'(period-xact nil nil))
|
||||
((equal first-char ?\!)
|
||||
'(command-directive))
|
||||
((equal first-char ?\;)
|
||||
'(comment nil nil))
|
||||
((equal first-char ?Y)
|
||||
'(default-year nil nil))
|
||||
((equal first-char ?P)
|
||||
'(commodity-price nil nil))
|
||||
((equal first-char ?N)
|
||||
'(price-ignored-commodity nil nil))
|
||||
((equal first-char ?D)
|
||||
'(default-commodity nil nil))
|
||||
((equal first-char ?C)
|
||||
'(commodity-conversion nil nil))
|
||||
((equal first-char ?i)
|
||||
'(timeclock-i nil nil))
|
||||
((equal first-char ?o)
|
||||
'(timeclock-o nil nil))
|
||||
((equal first-char ?b)
|
||||
'(timeclock-b nil nil))
|
||||
((equal first-char ?h)
|
||||
'(timeclock-h nil nil))
|
||||
(t
|
||||
'(unknown nil nil)))))))
|
||||
|
||||
(defun ledger-context-other-line (offset)
|
||||
"Return a list describing context of line OFFSET from existing position.
|
||||
|
||||
Offset can be positive or negative. If run out of buffer before reaching
|
||||
specified line, returns nil."
|
||||
(save-excursion
|
||||
(let ((left (forward-line offset)))
|
||||
(if (not (equal left 0))
|
||||
nil
|
||||
(ledger-context-at-point)))))
|
||||
|
||||
(defun ledger-context-line-type (context-info)
|
||||
(nth 0 context-info))
|
||||
|
||||
(defun ledger-context-current-field (context-info)
|
||||
(nth 1 context-info))
|
||||
|
||||
(defun ledger-context-field-info (context-info field-name)
|
||||
(assoc field-name (nth 2 context-info)))
|
||||
|
||||
(defun ledger-context-field-present-p (context-info field-name)
|
||||
(not (null (ledger-context-field-info context-info field-name))))
|
||||
|
||||
(defun ledger-context-field-value (context-info field-name)
|
||||
(nth 1 (ledger-context-field-info context-info field-name)))
|
||||
|
||||
(defun ledger-context-field-position (context-info field-name)
|
||||
(nth 2 (ledger-context-field-info context-info field-name)))
|
||||
|
||||
(defun ledger-context-field-end-position (context-info field-name)
|
||||
(+ (ledger-context-field-position context-info field-name)
|
||||
(length (ledger-context-field-value context-info field-name))))
|
||||
|
||||
(defun ledger-context-goto-field-start (context-info field-name)
|
||||
(goto-char (ledger-context-field-position context-info field-name)))
|
||||
|
||||
(defun ledger-context-goto-field-end (context-info field-name)
|
||||
(goto-char (ledger-context-field-end-position context-info field-name)))
|
||||
|
||||
(provide 'ldg-context)
|
||||
|
||||
;;; ldg-report.el ends here
|
||||
|
|
@ -39,10 +39,22 @@
|
|||
(defvar ledger-month (ledger-current-month)
|
||||
"Start a ledger session with the current month, but make it customizable to ease retro-entry.")
|
||||
|
||||
(defun ledger-remove-overlays ()
|
||||
"Remove all overlays from the ledger buffer."
|
||||
(interactive)
|
||||
(remove-overlays))
|
||||
(defun ledger-read-account-with-prompt (prompt)
|
||||
(let* ((context (ledger-context-at-point))
|
||||
(default
|
||||
(if (and (eq (ledger-context-line-type context) 'acct-transaction)
|
||||
(eq (ledger-context-current-field context) 'account))
|
||||
(regexp-quote (ledger-context-field-value context 'account))
|
||||
nil)))
|
||||
(ledger-read-string-with-default prompt default)))
|
||||
|
||||
(defun ledger-read-string-with-default (prompt default)
|
||||
"Return user supplied string after PROMPT, or DEFAULT."
|
||||
(let ((default-prompt (concat prompt
|
||||
(if default
|
||||
(concat " (" default "): ")
|
||||
": "))))
|
||||
(read-string default-prompt nil 'ledger-minibuffer-history default)))
|
||||
|
||||
(defun ledger-magic-tab (&optional interactively)
|
||||
"Decide what to with with <TAB> .
|
||||
|
|
@ -59,7 +71,7 @@ Can be pcomplete, or align-posting"
|
|||
(interactive)
|
||||
(let ((context (car (ledger-context-at-point)))
|
||||
(date-string (format-time-string (cdr (assoc "date-format" ledger-environment-alist)))))
|
||||
(cond ((eq 'entry context)
|
||||
(cond ((eq 'xact context)
|
||||
(beginning-of-line)
|
||||
(insert date-string "="))
|
||||
((eq 'acct-transaction context)
|
||||
|
|
@ -87,7 +99,7 @@ Can be pcomplete, or align-posting"
|
|||
(set (make-local-variable 'pcomplete-termination-string) "")
|
||||
|
||||
(add-hook 'post-command-hook 'ledger-highlight-xact-under-point nil t)
|
||||
(add-hook 'before-revert-hook 'ledger-remove-overlays nil t)
|
||||
(add-hook 'before-revert-hook 'ledger-occur-remove-all-overlays nil t)
|
||||
(make-variable-buffer-local 'highlight-overlay)
|
||||
|
||||
(ledger-init-load-init-file)
|
||||
|
|
@ -110,8 +122,8 @@ Can be pcomplete, or align-posting"
|
|||
(define-key map [(control ?c) (control ?y)] 'ledger-set-year)
|
||||
(define-key map [tab] 'ledger-magic-tab)
|
||||
(define-key map [(control ?i)] 'ledger-magic-tab)
|
||||
(define-key map [(control ?c) tab] 'ledger-fully-complete-entry)
|
||||
(define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-entry)
|
||||
(define-key map [(control ?c) tab] 'ledger-fully-complete-xact)
|
||||
(define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-xact)
|
||||
|
||||
(define-key map [(control ?c) (control ?o) (control ?a)] 'ledger-report-redo)
|
||||
(define-key map [(control ?c) (control ?o) (control ?e)] 'ledger-report-edit)
|
||||
|
|
@ -155,7 +167,7 @@ Can be pcomplete, or align-posting"
|
|||
(define-key map [edit-amount] '(menu-item "Calc on Amount" ledger-post-edit-amount))
|
||||
(define-key map [sep] '(menu-item "--"))
|
||||
(define-key map [delete-xact] '(menu-item "Delete Transaction" ledger-delete-current-transaction))
|
||||
(define-key map [cmp-xact] '(menu-item "Complete Transaction" ledger-fully-complete-entry))
|
||||
(define-key map [cmp-xact] '(menu-item "Complete Transaction" ledger-fully-complete-xact))
|
||||
(define-key map [add-xact] '(menu-item "Add Transaction (ledger xact)" ledger-add-transaction :enable ledger-works))
|
||||
(define-key map [sep3] '(menu-item "--"))
|
||||
(define-key map [reconcile] '(menu-item "Reconcile Account" ledger-reconcile :enable ledger-works))
|
||||
|
|
|
|||
|
|
@ -37,6 +37,7 @@
|
|||
(require 'esh-arg)
|
||||
(require 'ldg-commodities)
|
||||
(require 'ldg-complete)
|
||||
(require 'ldg-context)
|
||||
(require 'ldg-exec)
|
||||
(require 'ldg-fonts)
|
||||
(require 'ldg-init)
|
||||
|
|
|
|||
|
|
@ -59,6 +59,11 @@
|
|||
"A list of currently active overlays to the ledger buffer.")
|
||||
(make-variable-buffer-local 'ledger-occur-overlay-list)
|
||||
|
||||
(defun ledger-remove-all-overlays ()
|
||||
"Remove all overlays from the ledger buffer."
|
||||
(interactive)
|
||||
(remove-overlays))
|
||||
|
||||
(defun ledger-occur-mode (regex buffer)
|
||||
"Highlight transactions that match REGEX in BUFFER, hiding others.
|
||||
|
||||
|
|
|
|||
|
|
@ -251,15 +251,6 @@ BEG, END, and LEN control how far it can align."
|
|||
(add-hook 'after-save-hook #'(lambda () (setq ledger-post-current-list nil)) t t))
|
||||
|
||||
|
||||
(defun ledger-post-read-account-with-prompt (prompt)
|
||||
(let* ((context (ledger-context-at-point))
|
||||
(default
|
||||
(if (and (eq (ledger-context-line-type context) 'acct-transaction)
|
||||
(eq (ledger-context-current-field context) 'account))
|
||||
(regexp-quote (ledger-context-field-value context 'account))
|
||||
nil)))
|
||||
(ledger-read-string-with-default prompt default)))
|
||||
|
||||
|
||||
(provide 'ldg-post)
|
||||
|
||||
|
|
|
|||
|
|
@ -377,7 +377,7 @@ moved and recentered. If they aren't strange things happen."
|
|||
(defun ledger-reconcile ()
|
||||
"Start reconciling, prompt for account."
|
||||
(interactive)
|
||||
(let ((account (ledger-post-read-account-with-prompt "Account to reconcile"))
|
||||
(let ((account (ledger-read-account-with-prompt "Account to reconcile"))
|
||||
(buf (current-buffer))
|
||||
(rbuf (get-buffer ledger-recon-buffer-name)))
|
||||
;; this means only one *Reconcile* buffer, ever Set up the
|
||||
|
|
|
|||
|
|
@ -229,19 +229,11 @@ used to generate the buffer, navigating the buffer, etc."
|
|||
(expand-file-name ledger-master-file)
|
||||
(buffer-file-name)))
|
||||
|
||||
(defun ledger-read-string-with-default (prompt default)
|
||||
"Return user supplied string after PROMPT, or DEFAULT."
|
||||
(let ((default-prompt (concat prompt
|
||||
(if default
|
||||
(concat " (" default "): ")
|
||||
": "))))
|
||||
(read-string default-prompt nil 'ledger-minibuffer-history default)))
|
||||
|
||||
(defun ledger-report-payee-format-specifier ()
|
||||
"Substitute a payee name.
|
||||
|
||||
The user is prompted to enter a payee and that is substitued. If
|
||||
point is in an entry, the payee for that entry is used as the
|
||||
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
|
||||
|
|
@ -253,11 +245,11 @@ used to generate the buffer, navigating the buffer, etc."
|
|||
|
||||
The user is prompted to enter an account name, which can be any
|
||||
regular expression identifying an account. If point is on an account
|
||||
transaction line for an entry, the full account name on that line is
|
||||
posting line for an xact, the full account name on that line is
|
||||
the default."
|
||||
;; It is intended completion should be available on existing account
|
||||
;; names, but it remains to be implemented.
|
||||
(ledger-post-read-account-with-prompt "Account"))
|
||||
(ledger-read-account-with-prompt "Account"))
|
||||
|
||||
(defun ledger-report-expand-format-specifiers (report-cmd)
|
||||
"Expand %(account) and %(payee) appearing in REPORT-CMD with thing under point."
|
||||
|
|
@ -422,148 +414,6 @@ Optional EDIT the command."
|
|||
(ledger-reports-add ledger-report-name ledger-report-cmd)
|
||||
(ledger-reports-custom-save)))))))
|
||||
|
||||
(defconst ledger-line-config
|
||||
'((entry
|
||||
(("^\\(\\([0-9][0-9][0-9][0-9]/\\)?[01]?[0-9]/[0123]?[0-9]\\)[ \t]+\\(\\([!*]\\)[ \t]\\)?[ \t]*\\((\\(.*\\))\\)?[ \t]*\\(.*?\\)[ \t]*;\\(.*\\)[ \t]*$"
|
||||
(date nil status nil nil code payee comment))
|
||||
("^\\(\\([0-9][0-9][0-9][0-9]/\\)?[01]?[0-9]/[0123]?[0-9]\\)[ \t]+\\(\\([!*]\\)[ \t]\\)?[ \t]*\\((\\(.*\\))\\)?[ \t]*\\(.*\\)[ \t]*$"
|
||||
(date nil status nil nil code payee))))
|
||||
(acct-transaction
|
||||
(("^\\([ \t]+;\\|;\\)\\s-?\\(.*\\)"
|
||||
(indent comment))
|
||||
("\\(^[ \t]+\\)\\([:A-Za-z0-9]+?\\)\\s-\\s-+\\([$€£]\\s-?\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)$"
|
||||
(indent account commodity amount))
|
||||
("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\([$€£]\\s-?\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$"
|
||||
(indent account commodity amount nil comment))
|
||||
("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?[0-9]+\\(\\.[0-9]*\\)?\\)[ \t]+\\(.*?\\)[ \t]*\\(;[ \t]*\\(.*?\\)[ \t]*$\\|@+\\)"
|
||||
(indent account amount nil commodity comment))
|
||||
("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?[0-9]+\\(\\.[0-9]*\\)?\\)[ \t]+\\(.*?\\)[ \t]*$"
|
||||
(indent account amount nil commodity))
|
||||
("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?\\(\\.[0-9]*\\)\\)[ \t]+\\(.*?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$"
|
||||
(indent account amount nil commodity comment))
|
||||
("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?\\(\\.[0-9]*\\)\\)[ \t]+\\(.*?\\)[ \t]*$"
|
||||
(indent account amount nil commodity))
|
||||
("\\(^[ \t]+\\)\\(.*?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$"
|
||||
(indent account comment))
|
||||
("\\(^[ \t]+\\)\\(.*?\\)[ \t]*$"
|
||||
(indent account))
|
||||
|
||||
;; Bad regexes
|
||||
("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\([$€£]\\s-?\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)[ \t]*$"
|
||||
(indent account commodity amount nil))
|
||||
|
||||
))))
|
||||
|
||||
(defun ledger-extract-context-info (line-type pos)
|
||||
"Get context info for current line with LINE-TYPE.
|
||||
|
||||
Assumes point is at beginning of line, and the POS argument specifies
|
||||
where the \"users\" point was."
|
||||
(let ((linfo (assoc line-type ledger-line-config))
|
||||
found field fields)
|
||||
(dolist (re-info (nth 1 linfo))
|
||||
(let ((re (nth 0 re-info))
|
||||
(names (nth 1 re-info)))
|
||||
(unless found
|
||||
(when (looking-at re)
|
||||
(setq found t)
|
||||
(dotimes (i (length names))
|
||||
(when (nth i names)
|
||||
(setq fields (append fields
|
||||
(list
|
||||
(list (nth i names)
|
||||
(match-string-no-properties (1+ i))
|
||||
(match-beginning (1+ i))))))))
|
||||
(dolist (f fields)
|
||||
(and (nth 1 f)
|
||||
(>= pos (nth 2 f))
|
||||
(setq field (nth 0 f))))))))
|
||||
(list line-type field fields)))
|
||||
|
||||
(defun ledger-context-at-point ()
|
||||
"Return a list describing the context around point.
|
||||
|
||||
The contents of the list are the line type, the name of the field
|
||||
point containing point, and for selected line types, the content of
|
||||
the fields in the line in a association list."
|
||||
(let ((pos (point)))
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(let ((first-char (char-after)))
|
||||
(cond ((equal (point) (line-end-position))
|
||||
'(empty-line nil nil))
|
||||
((memq first-char '(?\ ?\t))
|
||||
(ledger-extract-context-info 'acct-transaction pos))
|
||||
((memq first-char '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
|
||||
(ledger-extract-context-info 'entry pos))
|
||||
((equal first-char ?\=)
|
||||
'(automated-entry nil nil))
|
||||
((equal first-char ?\~)
|
||||
'(period-entry nil nil))
|
||||
((equal first-char ?\!)
|
||||
'(command-directive))
|
||||
((equal first-char ?\;)
|
||||
'(comment nil nil))
|
||||
((equal first-char ?Y)
|
||||
'(default-year nil nil))
|
||||
((equal first-char ?P)
|
||||
'(commodity-price nil nil))
|
||||
((equal first-char ?N)
|
||||
'(price-ignored-commodity nil nil))
|
||||
((equal first-char ?D)
|
||||
'(default-commodity nil nil))
|
||||
((equal first-char ?C)
|
||||
'(commodity-conversion nil nil))
|
||||
((equal first-char ?i)
|
||||
'(timeclock-i nil nil))
|
||||
((equal first-char ?o)
|
||||
'(timeclock-o nil nil))
|
||||
((equal first-char ?b)
|
||||
'(timeclock-b nil nil))
|
||||
((equal first-char ?h)
|
||||
'(timeclock-h nil nil))
|
||||
(t
|
||||
'(unknown nil nil)))))))
|
||||
|
||||
(defun ledger-context-other-line (offset)
|
||||
"Return a list describing context of line OFFSET from existing position.
|
||||
|
||||
Offset can be positive or negative. If run out of buffer before reaching
|
||||
specified line, returns nil."
|
||||
(save-excursion
|
||||
(let ((left (forward-line offset)))
|
||||
(if (not (equal left 0))
|
||||
nil
|
||||
(ledger-context-at-point)))))
|
||||
|
||||
(defun ledger-context-line-type (context-info)
|
||||
(nth 0 context-info))
|
||||
|
||||
(defun ledger-context-current-field (context-info)
|
||||
(nth 1 context-info))
|
||||
|
||||
(defun ledger-context-field-info (context-info field-name)
|
||||
(assoc field-name (nth 2 context-info)))
|
||||
|
||||
(defun ledger-context-field-present-p (context-info field-name)
|
||||
(not (null (ledger-context-field-info context-info field-name))))
|
||||
|
||||
(defun ledger-context-field-value (context-info field-name)
|
||||
(nth 1 (ledger-context-field-info context-info field-name)))
|
||||
|
||||
(defun ledger-context-field-position (context-info field-name)
|
||||
(nth 2 (ledger-context-field-info context-info field-name)))
|
||||
|
||||
(defun ledger-context-field-end-position (context-info field-name)
|
||||
(+ (ledger-context-field-position context-info field-name)
|
||||
(length (ledger-context-field-value context-info field-name))))
|
||||
|
||||
(defun ledger-context-goto-field-start (context-info field-name)
|
||||
(goto-char (ledger-context-field-position context-info field-name)))
|
||||
|
||||
(defun ledger-context-goto-field-end (context-info field-name)
|
||||
(goto-char (ledger-context-field-end-position context-info field-name)))
|
||||
|
||||
(provide 'ldg-report)
|
||||
|
||||
;;; ldg-report.el ends here
|
||||
|
|
|
|||
|
|
@ -84,15 +84,15 @@ Optional argument STYLE may be `pending' or `cleared', depending
|
|||
on which type of status the caller wishes to indicate (default is
|
||||
`cleared'). Returns the new status as 'pending 'cleared or nil.
|
||||
This function is rather complicated because it must preserve both
|
||||
the overall formatting of the ledger entry, as well as ensuring
|
||||
the overall formatting of the ledger xact, as well as ensuring
|
||||
that the most minimal display format is used. This could be
|
||||
achieved more certainly by passing the entry to ledger for
|
||||
achieved more certainly by passing the xact to ledger for
|
||||
formatting, but doing so causes inline math expressions to be
|
||||
dropped."
|
||||
(interactive)
|
||||
(let ((bounds (ledger-current-transaction-bounds))
|
||||
new-status cur-status)
|
||||
;; Uncompact the entry, to make it easier to toggle the
|
||||
;; Uncompact the xact, to make it easier to toggle the
|
||||
;; transaction
|
||||
(save-excursion ;; this excursion checks state of entire
|
||||
;; transaction and unclears if marked
|
||||
|
|
@ -162,7 +162,7 @@ dropped."
|
|||
(setq new-status inserted))))
|
||||
(setq inhibit-modification-hooks nil))
|
||||
|
||||
;; This excursion cleans up the entry so that it displays
|
||||
;; This excursion cleans up the xact so that it displays
|
||||
;; minimally. This means that if all posts are cleared, remove
|
||||
;; the marks and clear the entire transaction.
|
||||
(save-excursion
|
||||
|
|
|
|||
|
|
@ -67,12 +67,12 @@ within the transaction."
|
|||
(overlay-put ovl 'priority 100))))
|
||||
|
||||
(defun ledger-xact-payee ()
|
||||
"Return the payee of the entry containing point or nil."
|
||||
"Return the payee 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) 'entry)
|
||||
(if (eq (ledger-context-line-type context-info) 'xact)
|
||||
(ledger-context-field-value context-info 'payee)
|
||||
nil))))
|
||||
|
||||
|
|
@ -116,21 +116,6 @@ MOMENT is an encoded date"
|
|||
(goto-char (point-min))
|
||||
(forward-line (1- line-number)))
|
||||
|
||||
(defun ledger-thing-at-point ()
|
||||
"Describe thing at points. Return 'transaction, 'posting, or nil."
|
||||
(let ((here (point)))
|
||||
(goto-char (line-beginning-position))
|
||||
(cond ((looking-at "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.+?)\\)?\\s-+")
|
||||
(goto-char (match-end 0))
|
||||
'transaction)
|
||||
((looking-at "^\\s-+\\([*!]\\s-+\\)?[[(]?\\(.\\)")
|
||||
(goto-char (match-beginning 2))
|
||||
'posting)
|
||||
((looking-at "^\\(sun\\|mon\\|tue\\|wed\\|thu\\|fri\\|sat\\)\\s-+")
|
||||
(goto-char (match-end 0))
|
||||
'entry)
|
||||
(t
|
||||
(ignore (goto-char here))))))
|
||||
|
||||
(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."
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue