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

Fixed reconciliation initialization. Now prompts with only account, not status and amount

Browse source 
Moved context function to leg-context, from leg-report. Cleaned up many regex in ldg-context.
This commit is contained in:
Craig Earls 2013-04-06 23:13:49 -07:00
parent 2f3053401a
commit 4df990014f
10 changed files with 237 additions and 206 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
lisp/ldg-complete.el
View file

@ -30,9 +30,12 @@
(defun ledger-parse-arguments () (defun ledger-parse-arguments ()
"Parse whitespace separated arguments in the current region." "Parse whitespace separated arguments in the current region."
(let* ((info (save-excursion ;; this is more complex than it appears to need, so that it can work
(cons (ledger-thing-at-point) (point)))) ;; with pcomplete. See pcomplete-parse-arguments-function for
(begin (cdr info)) ;; details
(let* ((begin (save-excursion
(ledger-thing-at-point) ;; leave point at beginning of thing under point
(point)))
(end (point)) (end (point))
begins args) begins args)
(save-excursion (save-excursion
@ -45,6 +48,7 @@
args))) args)))
(cons (reverse args) (reverse begins))))) (cons (reverse args) (reverse begins)))))
(defun ledger-payees-in-buffer () (defun ledger-payees-in-buffer ()
"Scan buffer and return list of all payees." "Scan buffer and return list of all payees."
(let ((origin (point)) (let ((origin (point))
@ -77,12 +81,12 @@ Return tree structure"
(match-string-no-properties 2) ":")) (match-string-no-properties 2) ":"))
(let ((root account-tree)) (let ((root account-tree))
(while account-elements (while account-elements
(let ((entry (assoc (car account-elements) root))) (let ((xact (assoc (car account-elements) root)))
(if entry (if xact
(setq root (cdr entry)) (setq root (cdr xact))
(setq entry (cons (car account-elements) (list t))) (setq xact (cons (car account-elements) (list t)))
(nconc root (list entry)) (nconc root (list xact))
(setq root (cdr entry)))) (setq root (cdr xact))))
(setq account-elements (cdr account-elements))))))) (setq account-elements (cdr account-elements)))))))
account-tree)) account-tree))
@ -93,11 +97,11 @@ Return tree structure"
(root (ledger-find-accounts-in-buffer)) (root (ledger-find-accounts-in-buffer))
(prefix nil)) (prefix nil))
(while (cdr elements) (while (cdr elements)
(let ((entry (assoc (car elements) root))) (let ((xact (assoc (car elements) root)))
(if entry (if xact
(setq prefix (concat prefix (and prefix ":") (setq prefix (concat prefix (and prefix ":")
(car elements)) (car elements))
root (cdr entry)) root (cdr xact))
(setq root nil elements nil))) (setq root nil elements nil)))
(setq elements (cdr elements))) (setq elements (cdr elements)))
(and root (and root
@ -136,7 +140,7 @@ Return tree structure"
(throw 'pcompleted t))) (throw 'pcompleted t)))
(ledger-accounts))))) (ledger-accounts)))))
(defun ledger-fully-complete-entry () (defun ledger-fully-complete-xact ()
"Completes a transaction if there is another matching payee in the buffer. "Completes a transaction if there is another matching payee in the buffer.
Does not use ledger xact" Does not use ledger xact"
(interactive) (interactive)

183
lisp/ldg-context.el Normal file
View 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

30
lisp/ldg-mode.el
View file

@ -39,10 +39,22 @@
(defvar ledger-month (ledger-current-month) (defvar ledger-month (ledger-current-month)
"Start a ledger session with the current month, but make it customizable to ease retro-entry.") "Start a ledger session with the current month, but make it customizable to ease retro-entry.")
(defun ledger-remove-overlays () (defun ledger-read-account-with-prompt (prompt)
"Remove all overlays from the ledger buffer." (let* ((context (ledger-context-at-point))
(interactive) (default
(remove-overlays)) (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) (defun ledger-magic-tab (&optional interactively)
"Decide what to with with <TAB> . "Decide what to with with <TAB> .
@ -59,7 +71,7 @@ Can be pcomplete, or align-posting"
(interactive) (interactive)
(let ((context (car (ledger-context-at-point))) (let ((context (car (ledger-context-at-point)))
(date-string (format-time-string (cdr (assoc "date-format" ledger-environment-alist))))) (date-string (format-time-string (cdr (assoc "date-format" ledger-environment-alist)))))
(cond ((eq 'entry context) (cond ((eq 'xact context)
(beginning-of-line) (beginning-of-line)
(insert date-string "=")) (insert date-string "="))
((eq 'acct-transaction context) ((eq 'acct-transaction context)
@ -87,7 +99,7 @@ Can be pcomplete, or align-posting"
(set (make-local-variable 'pcomplete-termination-string) "") (set (make-local-variable 'pcomplete-termination-string) "")
(add-hook 'post-command-hook 'ledger-highlight-xact-under-point nil t) (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) (make-variable-buffer-local 'highlight-overlay)
(ledger-init-load-init-file) (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 [(control ?c) (control ?y)] 'ledger-set-year)
(define-key map [tab] 'ledger-magic-tab) (define-key map [tab] 'ledger-magic-tab)
(define-key map [(control ?i)] '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) tab] 'ledger-fully-complete-xact)
(define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-entry) (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 ?a)] 'ledger-report-redo)
(define-key map [(control ?c) (control ?o) (control ?e)] 'ledger-report-edit) (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 [edit-amount] '(menu-item "Calc on Amount" ledger-post-edit-amount))
(define-key map [sep] '(menu-item "--")) (define-key map [sep] '(menu-item "--"))
(define-key map [delete-xact] '(menu-item "Delete Transaction" ledger-delete-current-transaction)) (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 [add-xact] '(menu-item "Add Transaction (ledger xact)" ledger-add-transaction :enable ledger-works))
(define-key map [sep3] '(menu-item "--")) (define-key map [sep3] '(menu-item "--"))
(define-key map [reconcile] '(menu-item "Reconcile Account" ledger-reconcile :enable ledger-works)) (define-key map [reconcile] '(menu-item "Reconcile Account" ledger-reconcile :enable ledger-works))

1
lisp/ldg-new.el
View file

@ -37,6 +37,7 @@
(require 'esh-arg) (require 'esh-arg)
(require 'ldg-commodities) (require 'ldg-commodities)
(require 'ldg-complete) (require 'ldg-complete)
(require 'ldg-context)
(require 'ldg-exec) (require 'ldg-exec)
(require 'ldg-fonts) (require 'ldg-fonts)
(require 'ldg-init) (require 'ldg-init)

5
lisp/ldg-occur.el
View file

@ -59,6 +59,11 @@
"A list of currently active overlays to the ledger buffer.") "A list of currently active overlays to the ledger buffer.")
(make-variable-buffer-local 'ledger-occur-overlay-list) (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) (defun ledger-occur-mode (regex buffer)
"Highlight transactions that match REGEX in BUFFER, hiding others. "Highlight transactions that match REGEX in BUFFER, hiding others.

9
lisp/ldg-post.el
View file

@ -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)) (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) (provide 'ldg-post)

2
lisp/ldg-reconcile.el
View file

@ -377,7 +377,7 @@ moved and recentered. If they aren't strange things happen."
(defun ledger-reconcile () (defun ledger-reconcile ()
"Start reconciling, prompt for account." "Start reconciling, prompt for account."
(interactive) (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)) (buf (current-buffer))
(rbuf (get-buffer ledger-recon-buffer-name))) (rbuf (get-buffer ledger-recon-buffer-name)))
;; this means only one *Reconcile* buffer, ever Set up the ;; this means only one *Reconcile* buffer, ever Set up the

156
lisp/ldg-report.el
View file

@ -229,19 +229,11 @@ used to generate the buffer, navigating the buffer, etc."
(expand-file-name ledger-master-file) (expand-file-name ledger-master-file)
(buffer-file-name))) (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 () (defun ledger-report-payee-format-specifier ()
"Substitute a payee name. "Substitute a payee name.
The user is prompted to enter a payee and that is substitued. If 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." default."
;; It is intended completion should be available on existing ;; It is intended completion should be available on existing
;; payees, but the list of possible completions needs to be ;; 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 The user is prompted to enter an account name, which can be any
regular expression identifying an account. If point is on an account 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." the default."
;; It is intended completion should be available on existing account ;; It is intended completion should be available on existing account
;; names, but it remains to be implemented. ;; 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) (defun ledger-report-expand-format-specifiers (report-cmd)
"Expand %(account) and %(payee) appearing in REPORT-CMD with thing under point." "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-add ledger-report-name ledger-report-cmd)
(ledger-reports-custom-save))))))) (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) (provide 'ldg-report)
;;; ldg-report.el ends here ;;; ldg-report.el ends here

8
lisp/ldg-state.el
View file

@ -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 on which type of status the caller wishes to indicate (default is
`cleared'). Returns the new status as 'pending 'cleared or nil. `cleared'). Returns the new status as 'pending 'cleared or nil.
This function is rather complicated because it must preserve both 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 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 formatting, but doing so causes inline math expressions to be
dropped." dropped."
(interactive) (interactive)
(let ((bounds (ledger-current-transaction-bounds)) (let ((bounds (ledger-current-transaction-bounds))
new-status cur-status) 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 ;; transaction
(save-excursion ;; this excursion checks state of entire (save-excursion ;; this excursion checks state of entire
;; transaction and unclears if marked ;; transaction and unclears if marked
@ -162,7 +162,7 @@ dropped."
(setq new-status inserted)))) (setq new-status inserted))))
(setq inhibit-modification-hooks nil)) (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 ;; minimally. This means that if all posts are cleared, remove
;; the marks and clear the entire transaction. ;; the marks and clear the entire transaction.
(save-excursion (save-excursion

19
lisp/ldg-xact.el
View file

@ -67,12 +67,12 @@ within the transaction."
(overlay-put ovl 'priority 100)))) (overlay-put ovl 'priority 100))))
(defun ledger-xact-payee () (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)) (let ((i 0))
(while (eq (ledger-context-line-type (ledger-context-other-line i)) 'acct-transaction) (while (eq (ledger-context-line-type (ledger-context-other-line i)) 'acct-transaction)
(setq i (- i 1))) (setq i (- i 1)))
(let ((context-info (ledger-context-other-line i))) (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) (ledger-context-field-value context-info 'payee)
nil)))) nil))))
@ -116,21 +116,6 @@ MOMENT is an encoded date"
(goto-char (point-min)) (goto-char (point-min))
(forward-line (1- line-number))) (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) (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." "Ask for a new DATE and copy the transaction under point to that date. Leave point on the first amount."