Enh 246 add code folding to ledger mode
Based on loccur. Hides everything but the xacts that match a regex. Linked to reconcile mode so that when you reconcile an account on xacts with that account are shown. Documentation updated
This commit is contained in:
parent
c7bf701cb3
commit
71de1e6cdc
5 changed files with 392 additions and 79 deletions
|
|
@ -2367,6 +2367,8 @@ add a new entry, based on previous entries
|
||||||
toggle cleared status of an entire entry
|
toggle cleared status of an entire entry
|
||||||
@item C-c C-c
|
@item C-c C-c
|
||||||
toggle cleared status of an individual posting
|
toggle cleared status of an individual posting
|
||||||
|
@item C-c C-f
|
||||||
|
toggle folding mode. When on shows only transactions that meet a given REGEX
|
||||||
@item C-c C-y
|
@item C-c C-y
|
||||||
set default year for entry mode
|
set default year for entry mode
|
||||||
@item C-c C-m
|
@item C-c C-m
|
||||||
|
|
@ -2401,12 +2403,13 @@ kill the ledger report buffer
|
||||||
@subsection Working with entries
|
@subsection Working with entries
|
||||||
@menu
|
@menu
|
||||||
* Manual Entry Support::
|
* Manual Entry Support::
|
||||||
|
* Hiding Transactions::
|
||||||
* Automagically Adding new entries::
|
* Automagically Adding new entries::
|
||||||
* Clearing Transactions::
|
* Clearing Transactions::
|
||||||
* Calculating Values with EMACS Calc::
|
* Calculating Values with EMACS Calc::
|
||||||
@end menu
|
@end menu
|
||||||
|
|
||||||
@node Manual Entry Support, Automagically Adding new entries, Working with entries, Working with entries
|
@node Manual Entry Support, Hiding Transactions, Working with entries, Working with entries
|
||||||
@subsubsection Manual Entry Support
|
@subsubsection Manual Entry Support
|
||||||
|
|
||||||
@cindex <TAB> completion
|
@cindex <TAB> completion
|
||||||
|
|
@ -2427,8 +2430,38 @@ habit to get in to prevent misspellings of accounts. Remember Ledger
|
||||||
does not validate the names of payees or account so a misspelled account
|
does not validate the names of payees or account so a misspelled account
|
||||||
will be interpreted as a new account by ledger.
|
will be interpreted as a new account by ledger.
|
||||||
|
|
||||||
|
@node Hiding Transactions, Automagically Adding new entries, Manual Entry Support, Working with entries
|
||||||
|
@subsubsection Hiding Transactions
|
||||||
|
|
||||||
@node Automagically Adding new entries, Clearing Transactions, Manual Entry Support, Working with entries
|
There are several ways to organize Ledger data files. You can use a
|
||||||
|
master file and @code{include} one file for each real bank or brokerage
|
||||||
|
account, separate files for major expense categories, a mix of those
|
||||||
|
ideas, or throw every transaction in to one giant file. The biggest
|
||||||
|
drawback to uing one file is that it can get confusing finding specific
|
||||||
|
transactions in the file.
|
||||||
|
|
||||||
|
Ledger mode has a special transaction hiding mode that you can use to
|
||||||
|
hide all transactions except those that meet a regular expression you
|
||||||
|
provide. By default this command is bound to @code{C-c C-f}. EMACS
|
||||||
|
will ask for a regular expression, which at its simplest is just text
|
||||||
|
you want to match. For example, lets say you want to review the
|
||||||
|
transactions in your checking account named @code{"Assets:Checking"}.
|
||||||
|
Type @code{C-c C-f}, then type @code{Checking} in the minibuffer. EMACS
|
||||||
|
will hide all other transactions and highlight the remaining
|
||||||
|
transactions. You can edit them without fear that your other
|
||||||
|
transaction have had anything done, they are only hidden from view.
|
||||||
|
|
||||||
|
The color used to highlight the xaction can be customized in the EMACS
|
||||||
|
customization menu. It is called @code{ledger-occur-xact-face}, and can
|
||||||
|
be changed to alter any charactistic of a font that you want. If you
|
||||||
|
don't want any highlighting, simply set
|
||||||
|
@code{ledger-occur-use-face-unfolded} to @code{nil} in the customization
|
||||||
|
menu.
|
||||||
|
|
||||||
|
To clear the highlighting and show all transactions, type @code{C-c C-f}
|
||||||
|
again.
|
||||||
|
|
||||||
|
@node Automagically Adding new entries, Clearing Transactions, Hiding Transactions, Working with entries
|
||||||
@subsubsection Automagically Adding new entries
|
@subsubsection Automagically Adding new entries
|
||||||
@cindex new transactions in EMACS
|
@cindex new transactions in EMACS
|
||||||
@cindex EMACS, adding new transactions
|
@cindex EMACS, adding new transactions
|
||||||
|
|
@ -2463,7 +2496,7 @@ ordered by date, not at the bottom of the file. If you need to include
|
||||||
spaces in the payee name, then surrond the name of the payee with double
|
spaces in the payee name, then surrond the name of the payee with double
|
||||||
quotes, otherwise ledger will interpret the second part of the name as
|
quotes, otherwise ledger will interpret the second part of the name as
|
||||||
an account.
|
an account.
|
||||||
@node Clearing Transactions, , Automagically Adding new entries, Working with entries
|
@node Clearing Transactions, Calculating Values with EMACS Calc, Automagically Adding new entries, Working with entries
|
||||||
@subsubsection Clearing Transactions and Postings
|
@subsubsection Clearing Transactions and Postings
|
||||||
@cindex clearing transactions in EMACS
|
@cindex clearing transactions in EMACS
|
||||||
@cindex EMACS, clear transaction
|
@cindex EMACS, clear transaction
|
||||||
|
|
@ -2491,7 +2524,7 @@ toggled.
|
||||||
@node Calculating Values with EMACS Calc, , Clearing Transactions, Working with entries
|
@node Calculating Values with EMACS Calc, , Clearing Transactions, Working with entries
|
||||||
@subsubsection Calculating Values with EMACS Calc
|
@subsubsection Calculating Values with EMACS Calc
|
||||||
|
|
||||||
EMACS come with a very power calculator built in. You can use it to
|
EMACS come with a very powerful calculator built in. You can use it to
|
||||||
easily insert calculated amounts directly into your ledger buffer. From
|
easily insert calculated amounts directly into your ledger buffer. From
|
||||||
the menu, select @code{Calc on Amount}. Calc will pull the current
|
the menu, select @code{Calc on Amount}. Calc will pull the current
|
||||||
amount to the top of the calc stack. Calulate the value as you normally
|
amount to the top of the calc stack. Calulate the value as you normally
|
||||||
|
|
@ -2529,6 +2562,14 @@ all of the uncleared transactions. The reconcile buffer has several functions:
|
||||||
@item C-l
|
@item C-l
|
||||||
refresh display
|
refresh display
|
||||||
@end table
|
@end table
|
||||||
|
|
||||||
|
By default the reconcile mode uses transaction hiding to show only
|
||||||
|
transaction eligible for your reconcile. Th reconcile widow itself will
|
||||||
|
only show a summary of uncleared transaction while the main buffer will
|
||||||
|
show all transaction meeting the regex, cleared or not. This behavior
|
||||||
|
can be disabled by setting @code{ledger-fold-on-reconcile} to nil in the
|
||||||
|
emacs customization menus.
|
||||||
|
|
||||||
@node Generating Reports, , Reconciling accounts, Using EMACS
|
@node Generating Reports, , Reconciling accounts, Using EMACS
|
||||||
@subsection Generating Reports
|
@subsection Generating Reports
|
||||||
|
|
||||||
|
|
@ -2539,7 +2580,7 @@ retyping the command line, or writing shell scripts for simple one line
|
||||||
commands.
|
commands.
|
||||||
|
|
||||||
To generate a report, select the @code{Run Reports} menu, or type
|
To generate a report, select the @code{Run Reports} menu, or type
|
||||||
@code{C-c C-o C-r}. Emacs will prompt for a report name. If it
|
@code{C-c C-o C-r}. EMACS will prompt for a report name. If it
|
||||||
recognizes the name it will run the report again. If it is a new name,
|
recognizes the name it will run the report again. If it is a new name,
|
||||||
or blank it will respond by giving you an example command line to edit.
|
or blank it will respond by giving you an example command line to edit.
|
||||||
Hitting return willrun the report and present it in a new buffer.
|
Hitting return willrun the report and present it in a new buffer.
|
||||||
|
|
|
||||||
|
|
@ -72,6 +72,7 @@ customizable to ease retro-entry.")
|
||||||
(define-key map [(control ?c) (control ?s)] 'ledger-sort-region)
|
(define-key map [(control ?c) (control ?s)] 'ledger-sort-region)
|
||||||
(define-key map [(control ?c) (control ?t)] 'ledger-test-run)
|
(define-key map [(control ?c) (control ?t)] 'ledger-test-run)
|
||||||
(define-key map [(control ?c) (control ?v)] 'ledger-post-edit-amount)
|
(define-key map [(control ?c) (control ?v)] 'ledger-post-edit-amount)
|
||||||
|
(define-key map [(control ?c) (control ?f)] 'ledger-occur)
|
||||||
(define-key map [tab] 'pcomplete)
|
(define-key map [tab] 'pcomplete)
|
||||||
(define-key map [(control ?i)] 'pcomplete)
|
(define-key map [(control ?i)] 'pcomplete)
|
||||||
(define-key map [(control ?c) tab] 'ledger-fully-complete-entry)
|
(define-key map [(control ?c) tab] 'ledger-fully-complete-entry)
|
||||||
|
|
@ -110,7 +111,9 @@ customizable to ease retro-entry.")
|
||||||
(define-key map [delete-xact] '(menu-item "Delete Entry" ledger-delete-current-entry))
|
(define-key map [delete-xact] '(menu-item "Delete Entry" ledger-delete-current-entry))
|
||||||
(define-key map [add-xact] '(menu-item "Add Entry" ledger-add-entry :enable ledger-works))
|
(define-key map [add-xact] '(menu-item "Add Entry" ledger-add-entry :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))
|
||||||
|
(define-key map [reconcile] '(menu-item "Hide Xacts" ledger-occur))
|
||||||
|
))
|
||||||
|
|
||||||
(defun ledger-time-less-p (t1 t2)
|
(defun ledger-time-less-p (t1 t2)
|
||||||
"Say whether time value T1 is less than time value T2."
|
"Say whether time value T1 is less than time value T2."
|
||||||
|
|
|
||||||
|
|
@ -45,6 +45,8 @@
|
||||||
(require 'ldg-xact)
|
(require 'ldg-xact)
|
||||||
(require 'ldg-sort)
|
(require 'ldg-sort)
|
||||||
(require 'ldg-fonts)
|
(require 'ldg-fonts)
|
||||||
|
(require 'ldg-occur)
|
||||||
|
|
||||||
;(autoload #'ledger-mode "ldg-mode" nil t)
|
;(autoload #'ledger-mode "ldg-mode" nil t)
|
||||||
;(autoload #'ledger-fully-complete-entry "ldg-complete" nil t)
|
;(autoload #'ledger-fully-complete-entry "ldg-complete" nil t)
|
||||||
;(autoload #'ledger-toggle-current "ldg-state" nil t)
|
;(autoload #'ledger-toggle-current "ldg-state" nil t)
|
||||||
|
|
|
||||||
252
lisp/ldg-occur.el
Normal file
252
lisp/ldg-occur.el
Normal file
|
|
@ -0,0 +1,252 @@
|
||||||
|
;;; ldg-mode.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 code folding to ledger mode. Adapted from original loccur
|
||||||
|
;; mode by Alexey Veretennikov <alexey dot veretennikov at gmail dot
|
||||||
|
;; com>
|
||||||
|
;;
|
||||||
|
;; Adapted to ledger mode by Craig Earls <enderww at gmail dot
|
||||||
|
;; com>
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(defface ledger-occur-folded-face
|
||||||
|
`((t :foreground "grey70" :invisible t ))
|
||||||
|
"Default face for Ledger occur mode hidden transactions"
|
||||||
|
:group 'ledger-faces)
|
||||||
|
|
||||||
|
(defface ledger-occur-xact-face
|
||||||
|
`((t :background "blue" :weight normal ))
|
||||||
|
"Default face for Ledger occur mode shown transactions"
|
||||||
|
:group 'ledger-faces)
|
||||||
|
|
||||||
|
(defconst ledger-occur-overlay-property-name 'ledger-occur-custom-buffer-grep)
|
||||||
|
|
||||||
|
(defcustom ledger-occur-use-face-unfolded t
|
||||||
|
"if non-nil use a custom face for xacts shown in ledger-occur mode"
|
||||||
|
:group 'ledger)
|
||||||
|
(make-variable-buffer-local 'ledger-occur-use-face-unfolded)
|
||||||
|
|
||||||
|
|
||||||
|
(defvar ledger-occur-mode nil) ;; name of the minor mode, shown in the mode-line
|
||||||
|
(make-variable-buffer-local 'ledger-occur-mode)
|
||||||
|
|
||||||
|
(or (assq 'ledger-occur-mode minor-mode-alist)
|
||||||
|
(nconc minor-mode-alist
|
||||||
|
(list '(ledger-occur-mode ledger-occur-mode))))
|
||||||
|
|
||||||
|
(defvar ledger-occur-history nil
|
||||||
|
"History of previously searched expressions for the prompt")
|
||||||
|
(make-variable-buffer-local 'ledger-occur-history)
|
||||||
|
|
||||||
|
(defvar ledger-occur-last-match nil
|
||||||
|
"Last match found")
|
||||||
|
(make-variable-buffer-local 'ledger-occur-last-match)
|
||||||
|
|
||||||
|
(defvar ledger-occur-overlay-list nil
|
||||||
|
"A list of currently active overlays to the ledger buffer.")
|
||||||
|
(make-variable-buffer-local 'ledger-occur-overlay-list)
|
||||||
|
|
||||||
|
|
||||||
|
(defun ledger-occur-mode (regex buffer)
|
||||||
|
(save-excursion
|
||||||
|
(set-buffer buffer)
|
||||||
|
(setq ledger-occur-mode
|
||||||
|
(if (or ledger-occur-mode
|
||||||
|
(null regex)
|
||||||
|
(zerop (length regex)))
|
||||||
|
nil
|
||||||
|
(concat " Ledger-Folded: " regex)))
|
||||||
|
(force-mode-line-update)
|
||||||
|
(ledger-occur-remove-overlays)
|
||||||
|
(if ledger-occur-mode
|
||||||
|
(let* ((buffer-matches (ledger-occur-find-matches regex))
|
||||||
|
(ovl-bounds (ledger-occur-create-xact-overlay-bounds buffer-matches)))
|
||||||
|
(setq ledger-occur-overlay-list
|
||||||
|
(ledger-occur-create-xact-overlays ovl-bounds))
|
||||||
|
(setq ledger-occur-overlay-list
|
||||||
|
(append ledger-occur-overlay-list
|
||||||
|
(ledger-occur-create-folded-overlays buffer-matches)))
|
||||||
|
(setq ledger-occur-last-match regex))
|
||||||
|
(recenter))))
|
||||||
|
|
||||||
|
(defun ledger-occur (regex)
|
||||||
|
"Perform a simple grep in current buffer for the regular
|
||||||
|
expression REGEX
|
||||||
|
|
||||||
|
This command hides all xact from the current buffer except
|
||||||
|
those containing the regular expression REGEX. A second call
|
||||||
|
of the function unhides lines again"
|
||||||
|
(interactive
|
||||||
|
(if ledger-occur-mode
|
||||||
|
(list nil)
|
||||||
|
(list (read-string (concat "Regexp<" (ledger-occur-prompt)
|
||||||
|
">: ") "" 'ledger-occur-history ))))
|
||||||
|
(if (string-equal "" regex) (setq regex (ledger-occur-prompt)))
|
||||||
|
(ledger-occur-mode regex (current-buffer)))
|
||||||
|
|
||||||
|
(defun ledger-occur-prompt ()
|
||||||
|
"Returns the default value of the prompt.
|
||||||
|
|
||||||
|
Default value for prompt is a current word or active
|
||||||
|
region(selection), if its size is 1 line"
|
||||||
|
(let ((prompt
|
||||||
|
(if (and transient-mark-mode
|
||||||
|
mark-active)
|
||||||
|
(let ((pos1 (region-beginning))
|
||||||
|
(pos2 (region-end)))
|
||||||
|
;; Check if the start and the of an active region is on
|
||||||
|
;; the same line
|
||||||
|
(if (= (line-number-at-pos pos1)
|
||||||
|
(line-number-at-pos pos2))
|
||||||
|
(buffer-substring-no-properties pos1 pos2)))
|
||||||
|
(current-word))))
|
||||||
|
prompt))
|
||||||
|
|
||||||
|
(defun ledger-occur-create-folded-overlays(buffer-matches)
|
||||||
|
(let ((overlays
|
||||||
|
(let ((prev-end (point-min))
|
||||||
|
(temp (point-max)))
|
||||||
|
(mapcar (lambda (match)
|
||||||
|
(progn
|
||||||
|
(setq temp prev-end) ;need a swap so that the
|
||||||
|
;last form in the lambda
|
||||||
|
;is the (make-overlay)
|
||||||
|
(setq prev-end (1+ (cadr match))) ;add 1 so
|
||||||
|
;that we skip
|
||||||
|
;the empty
|
||||||
|
;line after
|
||||||
|
;the xact
|
||||||
|
(make-overlay
|
||||||
|
temp
|
||||||
|
(car match)
|
||||||
|
(current-buffer) t nil)))
|
||||||
|
buffer-matches))))
|
||||||
|
(mapcar (lambda (ovl)
|
||||||
|
(overlay-put ovl ledger-occur-overlay-property-name t)
|
||||||
|
(overlay-put ovl 'invisible t)
|
||||||
|
(overlay-put ovl 'intangible t))
|
||||||
|
(push (make-overlay (cadr (car(last buffer-matches)))
|
||||||
|
(point-max)
|
||||||
|
(current-buffer) t nil) overlays))))
|
||||||
|
|
||||||
|
|
||||||
|
(defun ledger-occur-create-xact-overlays (ovl-bounds)
|
||||||
|
(let ((overlays
|
||||||
|
(mapcar (lambda (bnd)
|
||||||
|
(make-overlay
|
||||||
|
(car bnd)
|
||||||
|
(cadr bnd)
|
||||||
|
(current-buffer) t nil))
|
||||||
|
ovl-bounds)))
|
||||||
|
(mapcar (lambda (ovl)
|
||||||
|
(overlay-put ovl ledger-occur-overlay-property-name t)
|
||||||
|
(if ledger-occur-use-face-unfolded
|
||||||
|
(overlay-put ovl 'face 'ledger-occur-xact-face )))
|
||||||
|
overlays)))
|
||||||
|
|
||||||
|
(defun ledger-occur-change-regex (regex buffer)
|
||||||
|
"use this function to programatically change the overlays,
|
||||||
|
rather than quitting out and restarting"
|
||||||
|
(progn
|
||||||
|
(set-buffer buffer)
|
||||||
|
(setq ledger-occur-mode nil)
|
||||||
|
(force-mode-line-update)
|
||||||
|
(ledger-occur-mode regex buffer)
|
||||||
|
(recenter)))
|
||||||
|
|
||||||
|
(defun ledger-occur-quit-buffer (buffer)
|
||||||
|
"quits hidings transaction in the given buffer. Used for
|
||||||
|
coordinating ledger-occur with other buffers, like reconcile"
|
||||||
|
(progn
|
||||||
|
(set-buffer buffer)
|
||||||
|
(setq ledger-occur-mode nil)
|
||||||
|
(force-mode-line-update)
|
||||||
|
(ledger-occur-remove-overlays)
|
||||||
|
(recenter)))
|
||||||
|
|
||||||
|
(defun ledger-occur-remove-overlays ()
|
||||||
|
(interactive)
|
||||||
|
(remove-overlays (point-min)
|
||||||
|
(point-max) ledger-occur-overlay-property-name t)
|
||||||
|
(setq ledger-occur-overlay-list nil))
|
||||||
|
|
||||||
|
|
||||||
|
(defun ledger-occur-create-xact-overlay-bounds (buffer-matches)
|
||||||
|
(let ((prev-end (point-min))
|
||||||
|
(overlays (list)))
|
||||||
|
(when buffer-matches
|
||||||
|
(mapcar (lambda (line)
|
||||||
|
(push (list (car line) (cadr line)) overlays)
|
||||||
|
(setq prev-end (cadr line)))
|
||||||
|
buffer-matches)
|
||||||
|
(setq overlays (nreverse overlays)))))
|
||||||
|
|
||||||
|
(defun ledger-occur-find-xact-extents (pos)
|
||||||
|
"return point for beginning of xact and and of xact containing
|
||||||
|
position. Requires empty line separating xacts"
|
||||||
|
(interactive "d")
|
||||||
|
(save-excursion
|
||||||
|
(goto-char pos)
|
||||||
|
(let ((end-pos pos)
|
||||||
|
(beg-pos pos))
|
||||||
|
(backward-paragraph)
|
||||||
|
(next-line)
|
||||||
|
(beginning-of-line)
|
||||||
|
(setq beg-pos (point))
|
||||||
|
(forward-paragraph)
|
||||||
|
(previous-line)
|
||||||
|
(end-of-line)
|
||||||
|
(setq end-pos (1+ (point)))
|
||||||
|
(list beg-pos end-pos))))
|
||||||
|
|
||||||
|
(defun ledger-occur-find-matches (regex)
|
||||||
|
"Returns a list of 2-number tuples, specifying begnning of the
|
||||||
|
line and end of a line containing matching xact"
|
||||||
|
(save-excursion
|
||||||
|
(goto-char (point-min))
|
||||||
|
;; Set initial values for variables
|
||||||
|
(let ((curpoint nil)
|
||||||
|
(endpoint nil)
|
||||||
|
(lines (list)))
|
||||||
|
;; Search loop
|
||||||
|
(while (not (eobp))
|
||||||
|
(setq curpoint (point))
|
||||||
|
;; if something found
|
||||||
|
(when (setq endpoint (re-search-forward regex nil 'end))
|
||||||
|
(save-excursion
|
||||||
|
(let ((bounds (ledger-occur-find-xact-extents (match-beginning 0))))
|
||||||
|
(push bounds lines)
|
||||||
|
(setq curpoint (cadr bounds)))) ;move to the end of the
|
||||||
|
;xact, no need to search
|
||||||
|
;inside it more
|
||||||
|
(goto-char curpoint))
|
||||||
|
(forward-line 1))
|
||||||
|
(setq lines (nreverse lines)))))
|
||||||
|
|
||||||
|
|
||||||
|
(provide 'ldg-occur)
|
||||||
|
|
||||||
|
;;; ldg-occur.el ends here
|
||||||
|
|
@ -24,6 +24,12 @@
|
||||||
(defvar ledger-buf nil)
|
(defvar ledger-buf nil)
|
||||||
(defvar ledger-acct nil)
|
(defvar ledger-acct nil)
|
||||||
|
|
||||||
|
(defcustom ledger-fold-on-reconcile t
|
||||||
|
"if t, limit transactions shown in main buffer to those
|
||||||
|
matching the reconcile regex"
|
||||||
|
:group 'ledger)
|
||||||
|
(make-variable-buffer-local 'ledger-fold-on-reconcilex)
|
||||||
|
|
||||||
(defun ledger-display-balance ()
|
(defun ledger-display-balance ()
|
||||||
"Calculate the cleared balance of the account being reconciled"
|
"Calculate the cleared balance of the account being reconciled"
|
||||||
(interactive)
|
(interactive)
|
||||||
|
|
@ -55,10 +61,10 @@
|
||||||
(with-current-buffer ledger-buf
|
(with-current-buffer ledger-buf
|
||||||
(goto-char (cdr where))
|
(goto-char (cdr where))
|
||||||
(setq cleared (ledger-toggle-current-entry)))
|
(setq cleared (ledger-toggle-current-entry)))
|
||||||
;remove the existing face and add the new face
|
;remove the existing face and add the new face
|
||||||
(remove-text-properties (line-beginning-position)
|
(remove-text-properties (line-beginning-position)
|
||||||
(line-end-position)
|
(line-end-position)
|
||||||
(list 'face))
|
(list 'face))
|
||||||
(if cleared
|
(if cleared
|
||||||
(add-text-properties (line-beginning-position)
|
(add-text-properties (line-beginning-position)
|
||||||
(line-end-position)
|
(line-end-position)
|
||||||
|
|
@ -72,7 +78,11 @@
|
||||||
(defun ledger-reconcile-new-account (account)
|
(defun ledger-reconcile-new-account (account)
|
||||||
(interactive "sAccount to reconcile: ")
|
(interactive "sAccount to reconcile: ")
|
||||||
(set (make-local-variable 'ledger-acct) account)
|
(set (make-local-variable 'ledger-acct) account)
|
||||||
(ledger-reconcile-refresh))
|
(let ((buf (current-buffer)))
|
||||||
|
(if ledger-fold-on-reconcile
|
||||||
|
(ledger-occur-change-regex account ledger-buf))
|
||||||
|
(set-buffer buf)
|
||||||
|
(ledger-reconcile-refresh)))
|
||||||
|
|
||||||
(defun ledger-reconcile-refresh ()
|
(defun ledger-reconcile-refresh ()
|
||||||
(interactive)
|
(interactive)
|
||||||
|
|
@ -125,7 +135,10 @@
|
||||||
|
|
||||||
(defun ledger-reconcile-quit ()
|
(defun ledger-reconcile-quit ()
|
||||||
(interactive)
|
(interactive)
|
||||||
(kill-buffer (current-buffer)))
|
(let ((buf ledger-buf))
|
||||||
|
(kill-buffer (current-buffer))
|
||||||
|
(if ledger-fold-on-reconcile
|
||||||
|
(ledger-occur-quit-buffer buf))))
|
||||||
|
|
||||||
(defun ledger-reconcile-finish ()
|
(defun ledger-reconcile-finish ()
|
||||||
(interactive)
|
(interactive)
|
||||||
|
|
@ -144,49 +157,49 @@
|
||||||
|
|
||||||
(defun ledger-do-reconcile ()
|
(defun ledger-do-reconcile ()
|
||||||
"get the uncleared transactions in the account and display them in the *Reconcile* buffer"
|
"get the uncleared transactions in the account and display them in the *Reconcile* buffer"
|
||||||
(let* ((buf ledger-buf)
|
(let* ((buf ledger-buf)
|
||||||
(account ledger-acct)
|
(account ledger-acct)
|
||||||
(items
|
(items
|
||||||
(with-temp-buffer
|
(with-temp-buffer
|
||||||
(ledger-exec-ledger buf (current-buffer) "--uncleared" "--real"
|
(ledger-exec-ledger buf (current-buffer) "--uncleared" "--real"
|
||||||
"emacs" account)
|
"emacs" account)
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(unless (eobp)
|
(unless (eobp)
|
||||||
(unless (looking-at "(")
|
(unless (looking-at "(")
|
||||||
(error (buffer-string)))
|
(error (buffer-string)))
|
||||||
(read (current-buffer))))))
|
(read (current-buffer))))))
|
||||||
(dolist (item items)
|
(dolist (item items)
|
||||||
(let ((index 1))
|
(let ((index 1))
|
||||||
(dolist (xact (nthcdr 5 item))
|
(dolist (xact (nthcdr 5 item))
|
||||||
(let ((beg (point))
|
(let ((beg (point))
|
||||||
(where
|
(where
|
||||||
(with-current-buffer buf
|
(with-current-buffer buf
|
||||||
(cons
|
(cons
|
||||||
(nth 0 item)
|
(nth 0 item)
|
||||||
(if ledger-clear-whole-entries
|
(if ledger-clear-whole-entries
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(goto-line (nth 1 item))
|
(goto-line (nth 1 item))
|
||||||
(point-marker))
|
(point-marker))
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(goto-line (nth 0 xact))
|
(goto-line (nth 0 xact))
|
||||||
(point-marker)))))))
|
(point-marker)))))))
|
||||||
(insert (format "%s %-4s %-30s %-30s %15s\n"
|
(insert (format "%s %-4s %-30s %-30s %15s\n"
|
||||||
(format-time-string "%Y/%m/%d" (nth 2 item))
|
(format-time-string "%Y/%m/%d" (nth 2 item))
|
||||||
(if (nth 3 item)
|
(if (nth 3 item)
|
||||||
(nth 3 item)
|
(nth 3 item)
|
||||||
"")
|
"")
|
||||||
(nth 4 item) (nth 1 xact) (nth 2 xact)))
|
(nth 4 item) (nth 1 xact) (nth 2 xact)))
|
||||||
(if (nth 3 xact)
|
(if (nth 3 xact)
|
||||||
(set-text-properties beg (1- (point))
|
(set-text-properties beg (1- (point))
|
||||||
(list 'face 'ledger-font-reconciler-cleared-face
|
(list 'face 'ledger-font-reconciler-cleared-face
|
||||||
'where where))
|
'where where))
|
||||||
(set-text-properties beg (1- (point))
|
(set-text-properties beg (1- (point))
|
||||||
(list 'face 'ledger-font-reconciler-uncleared-face
|
(list 'face 'ledger-font-reconciler-uncleared-face
|
||||||
'where where))))
|
'where where))))
|
||||||
(setq index (1+ index)))))
|
(setq index (1+ index)))))
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(set-buffer-modified-p nil)
|
(set-buffer-modified-p nil)
|
||||||
(toggle-read-only t)))
|
(toggle-read-only t)))
|
||||||
|
|
||||||
|
|
||||||
(defun ledger-reconcile (account)
|
(defun ledger-reconcile (account)
|
||||||
|
|
@ -196,6 +209,8 @@
|
||||||
(if rbuf
|
(if rbuf
|
||||||
(kill-buffer rbuf))
|
(kill-buffer rbuf))
|
||||||
(add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save)
|
(add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save)
|
||||||
|
(if ledger-fold-on-reconcile
|
||||||
|
(ledger-occur-mode account buf))
|
||||||
(with-current-buffer
|
(with-current-buffer
|
||||||
(pop-to-buffer (get-buffer-create "*Reconcile*"))
|
(pop-to-buffer (get-buffer-create "*Reconcile*"))
|
||||||
(ledger-reconcile-mode)
|
(ledger-reconcile-mode)
|
||||||
|
|
@ -206,41 +221,41 @@
|
||||||
(defvar ledger-reconcile-mode-abbrev-table)
|
(defvar ledger-reconcile-mode-abbrev-table)
|
||||||
|
|
||||||
(define-derived-mode ledger-reconcile-mode text-mode "Reconcile"
|
(define-derived-mode ledger-reconcile-mode text-mode "Reconcile"
|
||||||
"A mode for reconciling ledger entries."
|
"A mode for reconciling ledger entries."
|
||||||
(let ((map (make-sparse-keymap)))
|
(let ((map (make-sparse-keymap)))
|
||||||
(define-key map [(control ?m)] 'ledger-reconcile-visit)
|
(define-key map [(control ?m)] 'ledger-reconcile-visit)
|
||||||
(define-key map [return] 'ledger-reconcile-visit)
|
(define-key map [return] 'ledger-reconcile-visit)
|
||||||
(define-key map [(control ?c) (control ?c)] 'ledger-reconcile-finish)
|
(define-key map [(control ?c) (control ?c)] 'ledger-reconcile-finish)
|
||||||
(define-key map [(control ?x) (control ?s)] 'ledger-reconcile-save)
|
(define-key map [(control ?x) (control ?s)] 'ledger-reconcile-save)
|
||||||
(define-key map [(control ?l)] 'ledger-reconcile-refresh)
|
(define-key map [(control ?l)] 'ledger-reconcile-refresh)
|
||||||
(define-key map [? ] 'ledger-reconcile-toggle)
|
(define-key map [? ] 'ledger-reconcile-toggle)
|
||||||
(define-key map [?a] 'ledger-reconcile-add)
|
(define-key map [?a] 'ledger-reconcile-add)
|
||||||
(define-key map [?d] 'ledger-reconcile-delete)
|
(define-key map [?d] 'ledger-reconcile-delete)
|
||||||
(define-key map [?g] 'ledger-reconcile-new-account)
|
(define-key map [?g] 'ledger-reconcile-new-account)
|
||||||
(define-key map [?n] 'next-line)
|
(define-key map [?n] 'next-line)
|
||||||
(define-key map [?p] 'previous-line)
|
(define-key map [?p] 'previous-line)
|
||||||
(define-key map [?s] 'ledger-reconcile-save)
|
(define-key map [?s] 'ledger-reconcile-save)
|
||||||
(define-key map [?q] 'ledger-reconcile-quit)
|
(define-key map [?q] 'ledger-reconcile-quit)
|
||||||
(define-key map [?b] 'ledger-display-balance)
|
(define-key map [?b] 'ledger-display-balance)
|
||||||
|
|
||||||
(define-key map [menu-bar] (make-sparse-keymap "ldg-recon-menu"))
|
(define-key map [menu-bar] (make-sparse-keymap "ldg-recon-menu"))
|
||||||
(define-key map [menu-bar ldg-recon-menu] (cons "Reconcile" map))
|
(define-key map [menu-bar ldg-recon-menu] (cons "Reconcile" map))
|
||||||
(define-key map [menu-bar ldg-recon-menu qui] '("Quit" . ledger-reconcile-quit))
|
(define-key map [menu-bar ldg-recon-menu qui] '("Quit" . ledger-reconcile-quit))
|
||||||
(define-key map [menu-bar ldg-recon-menu sep1] '("--"))
|
(define-key map [menu-bar ldg-recon-menu sep1] '("--"))
|
||||||
(define-key map [menu-bar ldg-recon-menu pre] '("Previous Entry" . previous-line))
|
(define-key map [menu-bar ldg-recon-menu pre] '("Previous Entry" . previous-line))
|
||||||
(define-key map [menu-bar ldg-recon-menu vis] '("Visit Entry" . ledger-reconcile-visit))
|
(define-key map [menu-bar ldg-recon-menu vis] '("Visit Entry" . ledger-reconcile-visit))
|
||||||
(define-key map [menu-bar ldg-recon-menu nex] '("Next Entry" . next-line))
|
(define-key map [menu-bar ldg-recon-menu nex] '("Next Entry" . next-line))
|
||||||
(define-key map [menu-bar ldg-recon-menu sep2] '("--"))
|
(define-key map [menu-bar ldg-recon-menu sep2] '("--"))
|
||||||
(define-key map [menu-bar ldg-recon-menu del] '("Delete Entry" . ledger-reconcile-delete))
|
(define-key map [menu-bar ldg-recon-menu del] '("Delete Entry" . ledger-reconcile-delete))
|
||||||
(define-key map [menu-bar ldg-recon-menu add] '("Add Entry" . ledger-reconcile-add))
|
(define-key map [menu-bar ldg-recon-menu add] '("Add Entry" . ledger-reconcile-add))
|
||||||
(define-key map [menu-bar ldg-recon-menu tog] '("Toggle Entry" . ledger-reconcile-toggle))
|
(define-key map [menu-bar ldg-recon-menu tog] '("Toggle Entry" . ledger-reconcile-toggle))
|
||||||
(define-key map [menu-bar ldg-recon-menu sep3] '("--"))
|
(define-key map [menu-bar ldg-recon-menu sep3] '("--"))
|
||||||
(define-key map [menu-bar ldg-recon-menu bal] '("Show Cleared Balance" . ledger-display-balance))
|
(define-key map [menu-bar ldg-recon-menu bal] '("Show Cleared Balance" . ledger-display-balance))
|
||||||
(define-key map [menu-bar ldg-recon-menu sep4] '("--"))
|
(define-key map [menu-bar ldg-recon-menu sep4] '("--"))
|
||||||
(define-key map [menu-bar ldg-recon-menu rna] '("Reconcile New Account" . ledger-reconcile-new-account))
|
(define-key map [menu-bar ldg-recon-menu rna] '("Reconcile New Account" . ledger-reconcile-new-account))
|
||||||
(define-key map [menu-bar ldg-recon-menu ref] '("Refresh" . ledger-reconcile-refresh))
|
(define-key map [menu-bar ldg-recon-menu ref] '("Refresh" . ledger-reconcile-refresh))
|
||||||
(define-key map [menu-bar ldg-recon-menu sav] '("Save" . ledger-reconcile-save))
|
(define-key map [menu-bar ldg-recon-menu sav] '("Save" . ledger-reconcile-save))
|
||||||
|
|
||||||
(use-local-map map)))
|
(use-local-map map)))
|
||||||
|
|
||||||
(provide 'ldg-reconcile)
|
(provide 'ldg-reconcile)
|
||||||
Loading…
Add table
Reference in a new issue