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

Merge remote-tracking branch 'origin/next'

Browse source
This commit is contained in:
John Wiegley 2013-04-29 16:38:48 -05:00
commit c4853dcfd8
15 changed files with 4172 additions and 3384 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
README.md
View file

@ -101,7 +101,7 @@ following packages (current as of Ubuntu 12.04):
python-dev gettext libgmp3-dev libmpfr-dev libboost-dev python-dev gettext libgmp3-dev libmpfr-dev libboost-dev
libboost-regex-dev libboost-date-time-dev libboost-regex-dev libboost-date-time-dev
libboost-filesystem-dev libboost-python-dev texinfo lcov libboost-filesystem-dev libboost-python-dev texinfo lcov
sloccount sloccount libboost-iostreams-dev libboost-test-dev
Or, for Ubuntu Karmic: Or, for Ubuntu Karmic:

47
acprep
View file

@ -206,7 +206,7 @@ class CommandLineApp(object):
except KeyboardInterrupt: except KeyboardInterrupt:
exit_code = self.handleInterrupt() exit_code = self.handleInterrupt()
except SystemExit, msg: except SystemExit as msg:
exit_code = msg.args[0] exit_code = msg.args[0]
except Exception: except Exception:
@ -244,7 +244,7 @@ class PrepareBuild(CommandLineApp):
} }
for varname in self.envvars.keys(): for varname in self.envvars.keys():
if os.environ.has_key(varname): if varname in os.environ:
self.envvars[varname] = os.environ[varname] self.envvars[varname] = os.environ[varname]
if varname.endswith('FLAGS'): if varname.endswith('FLAGS'):
@ -327,7 +327,7 @@ class PrepareBuild(CommandLineApp):
if args: if args:
cmd = args[0] cmd = args[0]
if not PrepareBuild.__dict__.has_key('phase_' + cmd): if 'phase_' + cmd not in PrepareBuild.__dict__:
self.log.error("Unknown build phase: " + cmd + "\n") self.log.error("Unknown build phase: " + cmd + "\n")
sys.exit(1) sys.exit(1)
else: else:
@ -344,22 +344,22 @@ class PrepareBuild(CommandLineApp):
def execute(self, *args): def execute(self, *args):
try: try:
self.log.debug('Executing command: ' + string.join(args, ' ')) self.log.debug('Executing command: ' + ' '.join(args))
retcode = call(args, shell=False) retcode = call(args, shell=False)
if retcode < 0: if retcode < 0:
self.log.error("Child was terminated by signal", -retcode) self.log.error("Child was terminated by signal", -retcode)
sys.exit(1) sys.exit(1)
elif retcode != 0: elif retcode != 0:
self.log.error("Execution failed: " + string.join(args, ' ')) self.log.error("Execution failed: " + ' '.join(args))
sys.exit(1) sys.exit(1)
except OSError, e: except OSError as e:
self.log.error("Execution failed:", e) self.log.error("Execution failed: " + e)
sys.exit(1) sys.exit(1)
def get_stdout(self, *args): def get_stdout(self, *args):
try: try:
self.log.debug('Executing command: ' + string.join(args, ' ')) self.log.debug('Executing command: ' + ' '.join(args))
proc = Popen(args, shell=False, stdout=PIPE) proc = Popen(args, shell=False, stdout=PIPE)
stdout = proc.stdout.read() stdout = proc.stdout.read()
@ -369,11 +369,11 @@ class PrepareBuild(CommandLineApp):
-retcode) -retcode)
sys.exit(1) sys.exit(1)
elif retcode != 0: elif retcode != 0:
self.log.error("Execution failed: " + string.join(args, ' ')) self.log.error("Execution failed: " + ' '.join(args))
sys.exit(1) sys.exit(1)
return stdout[:-1] return stdout[:-1]
except OSError, e: except OSError as e:
self.log.error("Execution failed:", e) self.log.error("Execution failed:" + e)
sys.exit(1) sys.exit(1)
def isnewer(self, file1, file2): def isnewer(self, file1, file2):
@ -452,7 +452,7 @@ class PrepareBuild(CommandLineApp):
def phase_products(self, *args): def phase_products(self, *args):
self.log.info('Executing phase: products') self.log.info('Executing phase: products')
print self.products_directory() print(self.products_directory())
def phase_info(self, *args): def phase_info(self, *args):
self.log.info('Executing phase: info') self.log.info('Executing phase: info')
@ -527,7 +527,7 @@ class PrepareBuild(CommandLineApp):
'texlive-xetex', 'doxygen', 'graphviz', 'texinfo', 'texlive-xetex', 'doxygen', 'graphviz', 'texinfo',
'lcov', 'sloccount' 'lcov', 'sloccount'
] + BoostInfo.dependencies('darwin') ] + BoostInfo.dependencies('darwin')
self.log.info('Executing: ' + string.join(packages, ' ')) self.log.info('Executing: ' + ' '.join(packages))
self.execute(*packages) self.execute(*packages)
elif exists('/sw/bin/fink'): elif exists('/sw/bin/fink'):
self.log.info('Looks like you are using Fink on OS X') self.log.info('Looks like you are using Fink on OS X')
@ -616,7 +616,7 @@ class PrepareBuild(CommandLineApp):
self.log.info('I do not recognize your version of Ubuntu!') self.log.info('I do not recognize your version of Ubuntu!')
packages = None packages = None
if packages: if packages:
self.log.info('Executing: ' + string.join(packages, ' ')) self.log.info('Executing: ' + ' '.join(packages))
self.execute(*packages) self.execute(*packages)
if exists('/etc/redhat-release'): if exists('/etc/redhat-release'):
@ -646,7 +646,7 @@ class PrepareBuild(CommandLineApp):
#'lcov', #'lcov',
#'sloccount' #'sloccount'
] ]
self.log.info('Executing: ' + string.join(packages, ' ')) self.log.info('Executing: ' + ' '.join(packages))
self.execute(*packages) self.execute(*packages)
######################################################################### #########################################################################
@ -678,7 +678,7 @@ class PrepareBuild(CommandLineApp):
self.configure_args.append(self.source_dir) self.configure_args.append(self.source_dir)
def setup_for_system(self): def setup_for_system(self):
system = self.get_stdout('uname', '-s') system = str(self.get_stdout('uname', '-s'))
self.log.info('System type is => ' + system) self.log.info('System type is => ' + system)
if self.options.enable_doxygen: if self.options.enable_doxygen:
@ -695,8 +695,7 @@ class PrepareBuild(CommandLineApp):
def setup_flavor(self): def setup_flavor(self):
self.setup_for_system() self.setup_for_system()
if not PrepareBuild.__dict__.has_key('setup_flavor_' + if 'setup_flavor_' + self.current_flavor not in PrepareBuild.__dict__:
self.current_flavor):
self.log.error('Unknown build flavor "%s"' % self.current_flavor) self.log.error('Unknown build flavor "%s"' % self.current_flavor)
sys.exit(1) sys.exit(1)
@ -725,7 +724,7 @@ class PrepareBuild(CommandLineApp):
self.log.debug('Final value of %s: %s' % self.log.debug('Final value of %s: %s' %
(var, self.envvars[var])) (var, self.envvars[var]))
elif self.envvars.has_key(var): elif var in self.envvars:
del self.envvars[var] del self.envvars[var]
######################################################################### #########################################################################
@ -795,8 +794,8 @@ class PrepareBuild(CommandLineApp):
sys.exit(1) sys.exit(1)
for var in ('CXX', 'CXXFLAGS', 'LDFLAGS'): for var in ('CXX', 'CXXFLAGS', 'LDFLAGS'):
if self.envvars.has_key(var) and self.envvars[var] and \ if self.envvars.get(var) and (var.endswith('FLAGS')
(var.endswith('FLAGS') or exists(self.envvars[var])): or exists(self.envvars[var])):
if var == 'CXX': if var == 'CXX':
conf_args.append('-DCMAKE_CXX_COMPILER=%s' % conf_args.append('-DCMAKE_CXX_COMPILER=%s' %
self.envvars[var]) self.envvars[var])
@ -848,7 +847,7 @@ class PrepareBuild(CommandLineApp):
self.log.error("Child was terminated by signal", -retcode) self.log.error("Child was terminated by signal", -retcode)
sys.exit(1) sys.exit(1)
elif retcode != 0: elif retcode != 0:
self.log.error("Execution failed: " + string.join(conf_args, ' ')) self.log.error("Execution failed: " + ' '.join(conf_args))
sys.exit(1) sys.exit(1)
else: else:
self.log.debug('configure does not need to be run') self.log.debug('configure does not need to be run')
@ -1031,7 +1030,7 @@ class PrepareBuild(CommandLineApp):
def phase_help(self, *args): def phase_help(self, *args):
self.option_parser.print_help() self.option_parser.print_help()
print """ print("""
Of the optional ARGS, the first is an optional build FLAVOR, with the default Of the optional ARGS, the first is an optional build FLAVOR, with the default
being 'debug': being 'debug':
@ -1077,7 +1076,7 @@ Here are some real-world examples:
./acprep ./acprep
./acprep --python ./acprep --python
./acprep opt make ./acprep opt make
./acprep make doc -- -DBUILD_WEB_DOCS=1""" ./acprep make doc -- -DBUILD_WEB_DOCS=1""")
sys.exit(0) sys.exit(0)
PrepareBuild().run() PrepareBuild().run()

91
contrib/ledger-completion.bash Normal file
View file

@ -0,0 +1,91 @@
### Assumption
#
# bash-completion package is installed and enabled
#
### Just want to try it?
#
# $ source ledger-completion.bash
#
### How to install?
#
#### For local user
#
# $ cat <<EOF >>~/.bash_completion
# . ~/.bash_completion.d/ledger
# EOF
#
# $ cp ledger-completion.bash ~/.bash_completion.d/ledger
#
#### For all users
#
# $ sudo cp ledger-completion.bash /etc/bash_completion.d/ledger
#
_ledger()
{
local cur prev command options
COMPREPLY=()
cur="${COMP_WORDS[COMP_CWORD]}"
prev="${COMP_WORDS[COMP_CWORD-1]}"
# COMMANDS
#
# Commands are found in source code:
# report.cc::lookup "case symbol_t::COMMAND"
# report.cc::lookupcase "case symbol_t::PRECOMMAND" : these are debug commands and they have been filtered out here
#
commands="accounts balance budget cleared commodities convert csv draft echo emacs entry equity lisp org payees pricemap prices pricesdb print register reload select source stats tags xact xml"
# OPTIONS
#
# Options are found in source code:
# global.cc::lookup_option
# report.cc::lookup_option
# session.cc::lookup_option
#
options="--abbrev-len= --account-width= --account= --actual --actual-dates --add-budget --amount-data --amount-width= --amount= --anon --ansi --args-only --auto-match --aux-date --average --balance-format= --base --basis --begin= --bold-if= --budget --budget-format= --by-payee --cache= --change --check-payees --cleared --cleared-format= --collapse --collapse-if-zero --color --columns= --cost --count --csv-format= --current --daily --date-format= --date-width= --date= --datetime-format= --day-break --days-of-week --dc --debug= --decimal-comma --depth= --detail --deviation --display-amount= --display-total= --display= --dow --download --effective --empty --end= --equity --exact --exchange= --explicit --file= --first= --flat --force-color --force-pager --forecast-years= --forecast= --format= --full-help --gain --generated --group-by= --group-title-format= --head= --help --help-calc --help-comm --help-disp --historical --immediate --init-file= --inject= --input-date-format= --invert --last= --leeway= --limit= --lot-dates --lot-notes --lot-prices --lot-tags --lots --lots-actual --market --master-account= --meta-width= --meta= --monthly --no-color --no-rounding --no-titles --no-total --now= --only= --options --output= --pager= --payee-width= --payee= --pedantic --pending --percent --period-sort= --period= --permissive --pivot= --plot-amount-format= --plot-total-format= --prepend-format= --prepend-width= --price --price-db= --price-exp= --pricedb-format= --prices-format= --primary-date --quantity --quarterly --raw --real --register-format= --related --related-all --revalued --revalued-only --revalued-total= --rich-data --script= --seed= --sort-all= --sort-xacts= --sort= --start-of-week= --strict --subtotal --tail= --time-colon --time-report --total-data --total-width= --total= --trace= --truncate= --unbudgeted --uncleared --unrealized --unrealized-gains= --unrealized-losses= --unround --value --value-expr= --values --verbose --verify --verify-memory --version --weekly --wide --yearly"
# Bash FAQ E13 http://tiswww.case.edu/php/chet/bash/FAQ
#
COMP_WORDBREAKS=${COMP_WORDBREAKS//:}
# ACCOUNTS
#
# Accounts are generated with bash command:
# $ ledger accounts>/tmp/accounts; for i in {1..5}; do cut -d : -f $i- /tmp/accounts;cut -d : -f -$i /tmp/accounts; done|sort -u|xargs
#
# Warning: this is working badly if there are spaces in account names
#
accounts="Assets Liabilities Equity Revenue Expenses"
case $prev in
--@(cache|file|init-file|output|pager|price-db|script))
_filedir
return 0
;;
@(balance|equity|print|register))
COMPREPLY=( $(compgen -W "${accounts}" -- ${cur}) )
return 0
;;
esac
if [[ ${cur} == -* ]] ; then
COMPREPLY=( $(compgen -W "${options}" -- ${cur}) )
# elif [[ ${cur} == [A-Z]* ]] ; then
# COMPREPLY=( $(compgen -W "${accounts}" -- ${cur}) )
else
COMPREPLY=( $(compgen -W "${commands}" -- ${cur}) )
fi
return 0
}
complete -F _ledger ledger
# Local variables:
# mode: shell-script
# sh-basic-offset: 4
# sh-indent-comment: t
# indent-tabs-mode: nil
# End:
# ex: ts=4 sw=4 et filetype=sh

6
doc/ledger-mode.texi
View file

@ -233,7 +233,11 @@ automatically place any amounts such that their last digit is aligned to
the column specified by @code{ledger-post-amount-alignment-column}, the column specified by @code{ledger-post-amount-alignment-column},
which defaults to 52. @xref{Ledger Post Customization Group}. which defaults to 52. @xref{Ledger Post Customization Group}.
@node Quick Balance Display @menu
* Quick Balance Display::
@end menu
@node Quick Balance Display, , Adding Transactions, Adding Transactions
@subsection Quick Balance Display @subsection Quick Balance Display
You will often want to quickly check the balance of an account. The You will often want to quickly check the balance of an account. The
easiest way it to position point on the account you are interested in, easiest way it to position point on the account you are interested in,

6010
doc/ledger3.texi
View file

File diff suppressed because it is too large Load diff

130
lisp/ldg-commodities.el
View file

@ -36,50 +36,47 @@
(defun ledger-split-commodity-string (str) (defun ledger-split-commodity-string (str)
"Split a commoditized string, STR, into two parts. "Split a commoditized string, STR, into two parts.
Returns a list with (value commodity)." Returns a list with (value commodity)."
(if (> (length str) 0) (let ((number-regex (if (assoc "decimal-comma" ledger-environment-alist)
(let ((number-regex (if (assoc "decimal-comma" ledger-environment-alist) ledger-amount-decimal-comma-regex
ledger-amount-decimal-comma-regex ledger-amount-decimal-period-regex)))
ledger-amount-decimal-period-regex))) (if (> (length str) 0)
(with-temp-buffer (with-temp-buffer
(insert str) (insert str)
(goto-char (point-min)) (goto-char (point-min))
(cond (cond
((re-search-forward "\"\\(.*\\)\"" nil t) ; look for quoted commodities ((re-search-forward "\"\\(.*\\)\"" nil t) ; look for quoted commodities
(let ((com (delete-and-extract-region (let ((com (delete-and-extract-region
(match-beginning 1) (match-beginning 1)
(match-end 1)))) (match-end 1))))
(if (re-search-forward number-regex nil t) (if (re-search-forward
(list number-regex nil t)
(string-to-number (list
(ledger-commodity-string-number-decimalize (ledger-string-to-number
(delete-and-extract-region (match-beginning 0) (match-end 0)) :from-user)) (delete-and-extract-region (match-beginning 0) (match-end 0)))
com)))) com))))
((re-search-forward number-regex nil t) ((re-search-forward number-regex nil t)
;; found a number in the current locale, return it in ;; found a number in the current locale, return it in the
;; the car. Anything left over is annotation, ;; car. Anything left over is annotation, the first
;; the first thing should be the commodity, separated ;; thing should be the commodity, separated by
;; by whitespace, return it in the cdr. I can't think of any ;; whitespace, return it in the cdr. I can't think of
;; counterexamples ;; any counterexamples
(list (list
(string-to-number (ledger-string-to-number
(ledger-commodity-string-number-decimalize (delete-and-extract-region (match-beginning 0) (match-end 0)))
(delete-and-extract-region (match-beginning 0) (match-end 0)) :from-user)) (nth 0 (split-string (buffer-substring-no-properties (point-min) (point-max))))))
(nth 0 (split-string (buffer-substring-no-properties (point-min) (point-max)))))) ((re-search-forward "0" nil t)
((re-search-forward "0" nil t) ;; couldn't find a decimal number, look for a single 0,
;; couldn't find a decimal number, look for a single 0, ;; indicating account with zero balance
;; indicating account with zero balance (list 0 ledger-reconcile-default-commodity))))
(list 0 ledger-reconcile-default-commodity))))) ;; nothing found, return 0
;; nothing found, return 0 (list 0 ledger-reconcile-default-commodity))))
(list 0 ledger-reconcile-default-commodity)))
(defun ledger-string-balance-to-commoditized-amount (str) (defun ledger-string-balance-to-commoditized-amount (str)
"Return a commoditized amount (val, 'comm') from STR." "Return a commoditized amount (val, 'comm') from STR."
(let ((fields (split-string str "[\n\r]"))) ; break any balances ; break any balances with multi commodities into a list
; with multi commodities (mapcar #'(lambda (st)
; into a list (ledger-split-commodity-string st))
(mapcar #'(lambda (str) (split-string str "[\n\r]")))
(ledger-split-commodity-string str))
fields)))
(defun -commodity (c1 c2) (defun -commodity (c1 c2)
"Subtract C2 from C1, ensuring their commodities match." "Subtract C2 from C1, ensuring their commodities match."
@ -93,40 +90,39 @@ Returns a list with (value commodity)."
(list (+ (car c1) (car c2)) (cadr c1)) (list (+ (car c1) (car c2)) (cadr c1))
(error "Can't add different commodities, %S to %S" c1 c2))) (error "Can't add different commodities, %S to %S" c1 c2)))
(defun ledger-commodity-string-number-decimalize (number-string direction) (defun ledger-strip (str char)
"Take NUMBER-STRING and ensure proper decimalization for use by string-to-number and number-to-string. (let (new-str)
(concat (dolist (ch (append str nil) new-str)
DIRECTION can be :to-user or :from-user. All math calculations (unless (= ch char)
are done with decimal-period, some users may prefer decimal-comma (setq new-str (append new-str (list ch))))))))
which must be translated both directions."
(let ((val number-string))
(if (assoc "decimal-comma" ledger-environment-alist)
(cond ((eq direction :from-user)
;; change string to decimal-period
(while (string-match "," val)
(setq val (replace-match "." nil nil val)))) ;; switch to period separator
((eq direction :to-user)
;; change to decimal-comma
(while (string-match "\\." val)
(setq val (replace-match "," nil nil val)))) ;; gets rid of periods
(t
(error "ledger-commodity-string-number-decimalize: direction not properly specified %S" direction)))
(while (string-match "," val)
(setq val (replace-match "" nil nil val))))
val))
(defun ledger-string-to-number (str &optional decimal-comma)
"improve builtin string-to-number by handling internationalization, and return nil of number can't be parsed"
(let ((nstr (if (or decimal-comma
(assoc "decimal-comma" ledger-environment-alist))
(ledger-strip str ?.)
(ledger-strip str ?,))))
(while (string-match "," nstr) ;if there is a comma now, it is a thousands separator
(setq nstr (replace-match "." nil nil nstr)))
(string-to-number nstr)))
(defun ledger-number-to-string (n &optional decimal-comma)
(let ((str (number-to-string n)))
(if (or decimal-comma
(assoc "decimal-comma" ledger-environment-alist))
(while (string-match "\\." str)
(setq str (replace-match "," nil nil str)))
str)))
(defun ledger-commodity-to-string (c1) (defun ledger-commodity-to-string (c1)
"Return string representing C1. "Return string representing C1.
Single character commodities are placed ahead of the value, Single character commodities are placed ahead of the value,
longer ones are after the value." longer ones are after the value."
(let ((val (ledger-commodity-string-number-decimalize (let ((str (ledger-number-to-string (car c1)))
(number-to-string (car c1)) :to-user)) (commodity (cadr c1)))
(commodity (cadr c1)))
(if (> (length commodity) 1) (if (> (length commodity) 1)
(concat val " " commodity) (concat str " " commodity)
(concat commodity " " val)))) (concat commodity " " str))))
(defun ledger-read-commodity-string (prompt) (defun ledger-read-commodity-string (prompt)
(let ((str (read-from-minibuffer (let ((str (read-from-minibuffer

132
lisp/ldg-complete.el
View file

@ -38,6 +38,11 @@
(point))) (point)))
(end (point)) (end (point))
begins args) begins args)
;; to support end of line metadata
(save-excursion
(when (search-backward ";"
(line-beginning-position) t)
(setq begin (match-beginning 0))))
(save-excursion (save-excursion
(goto-char begin) (goto-char begin)
(when (< (point) end) (when (< (point) end)
@ -73,7 +78,7 @@ Return tree structure"
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward (while (re-search-forward
ledger-account-any-status-regex nil t) ledger-account-or-metadata-regex nil t)
(unless (and (>= origin (match-beginning 0)) (unless (and (>= origin (match-beginning 0))
(< origin (match-end 0))) (< origin (match-end 0)))
(setq account-elements (setq account-elements
@ -90,6 +95,21 @@ Return tree structure"
(setq account-elements (cdr account-elements))))))) (setq account-elements (cdr account-elements)))))))
account-tree)) account-tree))
(defun ledger-find-metadata-in-buffer ()
"Search through buffer and build list of metadata.
Return list."
(let ((origin (point)) accounts)
(save-excursion
(setq ledger-account-tree (list t))
(goto-char (point-min))
(while (re-search-forward
ledger-metadata-regex
nil t)
(unless (and (>= origin (match-beginning 0))
(< origin (match-end 0)))
(setq accounts (cons (match-string-no-properties 2) accounts)))))
accounts))
(defun ledger-accounts () (defun ledger-accounts ()
"Return a tree of all accounts in the buffer." "Return a tree of all accounts in the buffer."
(let* ((current (caar (ledger-parse-arguments))) (let* ((current (caar (ledger-parse-arguments)))
@ -102,18 +122,19 @@ Return tree structure"
(setq prefix (concat prefix (and prefix ":") (setq prefix (concat prefix (and prefix ":")
(car elements)) (car elements))
root (cdr xact)) root (cdr xact))
(setq root nil elements nil))) (setq root nil elements nil)))
(setq elements (cdr elements))) (setq elements (cdr elements)))
(setq root (delete (list (car elements) t) root))
(and root (and root
(sort (sort
(mapcar (function (mapcar (function
(lambda (x) (lambda (x)
(let ((term (if prefix (let ((term (if prefix
(concat prefix ":" (car x)) (concat prefix ":" (car x))
(car x)))) (car x))))
(if (> (length (cdr x)) 1) (if (> (length (cdr x)) 1)
(concat term ":") (concat term ":")
term)))) term))))
(cdr root)) (cdr root))
'string-lessp)))) 'string-lessp))))
@ -124,21 +145,24 @@ Return tree structure"
(if (eq (save-excursion (if (eq (save-excursion
(ledger-thing-at-point)) 'transaction) (ledger-thing-at-point)) 'transaction)
(if (null current-prefix-arg) (if (null current-prefix-arg)
(ledger-payees-in-buffer) ;; this completes against payee names (delete
(progn (caar (ledger-parse-arguments))
(let ((text (buffer-substring-no-properties (line-beginning-position) (ledger-payees-in-buffer)) ;; this completes against payee names
(line-end-position)))) (progn
(delete-region (line-beginning-position) (let ((text (buffer-substring-no-properties
(line-end-position)) (line-beginning-position)
(condition-case nil (line-end-position))))
(ledger-add-transaction text t) (delete-region (line-beginning-position)
(error nil))) (line-end-position))
(forward-line) (condition-case nil
(goto-char (line-end-position)) (ledger-add-transaction text t)
(search-backward ";" (line-beginning-position) t) (error nil)))
(skip-chars-backward " \t0123456789.,") (forward-line)
(throw 'pcompleted t))) (goto-char (line-end-position))
(ledger-accounts))))) (search-backward ";" (line-beginning-position) t)
(skip-chars-backward " \t0123456789.,")
(throw 'pcompleted t)))
(ledger-accounts)))))
(defun ledger-fully-complete-xact () (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.
@ -157,7 +181,7 @@ Does not use ledger xact"
(setq rest-of-name (match-string 3)) (setq rest-of-name (match-string 3))
;; Start copying the postings ;; Start copying the postings
(forward-line) (forward-line)
(while (looking-at ledger-account-any-status-regex) (while (looking-at ledger-account-or-metadata-regex)
(setq xacts (cons (buffer-substring-no-properties (setq xacts (cons (buffer-substring-no-properties
(line-beginning-position) (line-beginning-position)
(line-end-position)) (line-end-position))
@ -183,43 +207,43 @@ ledger-magic-tab in the previous commands list so that
ledger-magic-tab would cycle properly" ledger-magic-tab would cycle properly"
(interactive "p") (interactive "p")
(if (and interactively (if (and interactively
pcomplete-cycle-completions pcomplete-cycle-completions
pcomplete-current-completions pcomplete-current-completions
(memq last-command '(ledger-magic-tab (memq last-command '(ledger-magic-tab
ledger-pcomplete ledger-pcomplete
pcomplete-expand-and-complete pcomplete-expand-and-complete
pcomplete-reverse))) pcomplete-reverse)))
(progn (progn
(delete-backward-char pcomplete-last-completion-length) (delete-backward-char pcomplete-last-completion-length)
(if (eq this-command 'pcomplete-reverse) (if (eq this-command 'pcomplete-reverse)
(progn (progn
(push (car (last pcomplete-current-completions)) (push (car (last pcomplete-current-completions))
pcomplete-current-completions) pcomplete-current-completions)
(setcdr (last pcomplete-current-completions 2) nil)) (setcdr (last pcomplete-current-completions 2) nil))
(nconc pcomplete-current-completions (nconc pcomplete-current-completions
(list (car pcomplete-current-completions))) (list (car pcomplete-current-completions)))
(setq pcomplete-current-completions (setq pcomplete-current-completions
(cdr pcomplete-current-completions))) (cdr pcomplete-current-completions)))
(pcomplete-insert-entry pcomplete-last-completion-stub (pcomplete-insert-entry pcomplete-last-completion-stub
(car pcomplete-current-completions) (car pcomplete-current-completions)
nil pcomplete-last-completion-raw)) nil pcomplete-last-completion-raw))
(setq pcomplete-current-completions nil (setq pcomplete-current-completions nil
pcomplete-last-completion-raw nil) pcomplete-last-completion-raw nil)
(catch 'pcompleted (catch 'pcompleted
(let* ((pcomplete-stub) (let* ((pcomplete-stub)
pcomplete-seen pcomplete-norm-func pcomplete-seen pcomplete-norm-func
pcomplete-args pcomplete-last pcomplete-index pcomplete-args pcomplete-last pcomplete-index
(pcomplete-autolist pcomplete-autolist) (pcomplete-autolist pcomplete-autolist)
(pcomplete-suffix-list pcomplete-suffix-list) (pcomplete-suffix-list pcomplete-suffix-list)
(completions (pcomplete-completions)) (completions (pcomplete-completions))
(result (pcomplete-do-complete pcomplete-stub completions))) (result (pcomplete-do-complete pcomplete-stub completions)))
(and result (and result
(not (eq (car result) 'listed)) (not (eq (car result) 'listed))
(cdr result) (cdr result)
(pcomplete-insert-entry pcomplete-stub (cdr result) (pcomplete-insert-entry pcomplete-stub (cdr result)
(memq (car result) (memq (car result)
'(sole shortest)) '(sole shortest))
pcomplete-last-completion-raw)))))) pcomplete-last-completion-raw))))))
(provide 'ldg-complete) (provide 'ldg-complete)

30
lisp/ldg-fonts.el
View file

@ -113,8 +113,9 @@
(defvar ledger-font-lock-keywords (defvar ledger-font-lock-keywords
`( ;; (,ledger-other-entries-regex 1 `( ;; (,ledger-other-entries-regex 1
;; ledger-font-other-face) ;; ledger-font-other-face)
(,ledger-comment-regex 2 (,ledger-comment-regex 0
'ledger-font-comment-face) 'ledger-font-comment-face)
(,ledger-multiline-comment-regex 0 'ledger-font-comment-face)
(,ledger-payee-pending-regex 2 (,ledger-payee-pending-regex 2
'ledger-font-payee-pending-face) ; Works 'ledger-font-payee-pending-face) ; Works
(,ledger-payee-cleared-regex 2 (,ledger-payee-cleared-regex 2
@ -131,6 +132,33 @@
'ledger-font-other-face)) 'ledger-font-other-face))
"Expressions to highlight in Ledger mode.") "Expressions to highlight in Ledger mode.")
(defun ledger-extend-region-multiline-comment ()
"Adjusts the variables font-lock-beg and font-lock-end if they
fall within a multiline comment. Returns non-nil if an
adjustment is made."
(let (beg end)
;; fix beg
(save-excursion
(goto-char font-lock-beg)
(end-of-line)
(when (re-search-backward ledger-multiline-comment-start-regex nil t)
(setq beg (point))
(re-search-forward ledger-multiline-comment-regex nil t)
(if (and (>= (point) font-lock-beg)
(/= beg font-lock-beg))
(setq font-lock-beg beg)
(setq beg nil))))
;; fix end
(save-excursion
(goto-char font-lock-end)
(end-of-line)
(when (re-search-backward ledger-multiline-comment-start-regex nil t)
(re-search-forward ledger-multiline-comment-regex nil t)
(setq end (point))
(if (> end font-lock-end)
(setq font-lock-end end)
(setq end nil))))
(or beg end)))
(provide 'ldg-fonts) (provide 'ldg-fonts)

24
lisp/ldg-mode.el
View file

@ -68,13 +68,21 @@ And calculate the target-delta of the account being reconciled."
(message balance)))) (message balance))))
(defun ledger-magic-tab (&optional interactively) (defun ledger-magic-tab (&optional interactively)
"Decide what to with with <TAB> . "Decide what to with with <TAB>.
Can be pcomplete, or align-posting" Can indent, complete or align depending on context."
(interactive "p") (interactive "p")
(if (and (> (point) 1) (when (= (point) (line-end-position))
(looking-back "[:A-Za-z0-9]" 1)) (if (= (point) (line-beginning-position))
(ledger-pcomplete interactively) (indent-to ledger-post-account-alignment-column)
(ledger-post-align-postings))) (save-excursion
(re-search-backward
(rx-static-or ledger-account-any-status-regex
ledger-metadata-regex
ledger-payee-any-status-regex)
(line-beginning-position) t))
(when (= (point) (match-end 0))
(ledger-pcomplete interactively))))
(ledger-post-align-postings))
(defvar ledger-mode-abbrev-table) (defvar ledger-mode-abbrev-table)
@ -102,6 +110,10 @@ Can be pcomplete, or align-posting"
(if (boundp 'font-lock-defaults) (if (boundp 'font-lock-defaults)
(set (make-local-variable 'font-lock-defaults) (set (make-local-variable 'font-lock-defaults)
'(ledger-font-lock-keywords nil t))) '(ledger-font-lock-keywords nil t)))
(setq font-lock-extend-region-functions
(list #'font-lock-extend-region-wholelines
#'ledger-extend-region-multiline-comment))
(setq font-lock-multiline nil)
(set (make-local-variable 'pcomplete-parse-arguments-function) (set (make-local-variable 'pcomplete-parse-arguments-function)
'ledger-parse-arguments) 'ledger-parse-arguments)

5
lisp/ldg-occur.el
View file

@ -59,7 +59,7 @@
"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 () (defun ledger-occur-remove-all-overlays ()
"Remove all overlays from the ledger buffer." "Remove all overlays from the ledger buffer."
(interactive) (interactive)
(remove-overlays)) (remove-overlays))
@ -130,8 +130,7 @@ When REGEX is nil, unhide everything, and remove higlight"
buffer-matches)))) buffer-matches))))
(mapcar (lambda (ovl) (mapcar (lambda (ovl)
(overlay-put ovl ledger-occur-overlay-property-name t) (overlay-put ovl ledger-occur-overlay-property-name t)
(overlay-put ovl 'invisible t) (overlay-put ovl 'invisible t))
(overlay-put ovl 'intangible t))
(push (make-overlay (cadr (car(last buffer-matches))) (push (make-overlay (cadr (car(last buffer-matches)))
(point-max) (point-max)
(current-buffer) t nil) overlays))))) (current-buffer) t nil) overlays)))))

2
lisp/ldg-post.el
View file

@ -217,7 +217,7 @@ BEG, END, and LEN control how far it can align."
(let ((end-of-amount (re-search-forward "[-.,0-9]+" (line-end-position) t))) (let ((end-of-amount (re-search-forward "[-.,0-9]+" (line-end-position) t)))
;; determine if there is an amount to edit ;; determine if there is an amount to edit
(if end-of-amount (if end-of-amount
(let ((val (ledger-commodity-string-number-decimalize (match-string 0) :from-user))) (let ((val (ledger-string-to-number (match-string 0))))
(goto-char (match-beginning 0)) (goto-char (match-beginning 0))
(delete-region (match-beginning 0) (match-end 0)) (delete-region (match-beginning 0) (match-end 0))
(calc) (calc)

364
lisp/ldg-reconcile.el
View file

@ -33,7 +33,7 @@
(defvar ledger-target nil) (defvar ledger-target nil)
(defgroup ledger-reconcile nil (defgroup ledger-reconcile nil
"Options for Ledger-mode reconciliation" "Options for Ledger-mode reconciliation"
:group 'ledger) :group 'ledger)
(defcustom ledger-recon-buffer-name "*Reconcile*" (defcustom ledger-recon-buffer-name "*Reconcile*"
@ -59,8 +59,8 @@ Then that transaction will be shown in its source buffer."
(defcustom ledger-reconcile-toggle-to-pending t (defcustom ledger-reconcile-toggle-to-pending t
"If true then toggle between uncleared and pending. "If true then toggle between uncleared and pending.
reconcile-finish will mark all pending posting cleared." reconcile-finish will mark all pending posting cleared."
:type 'boolean :type 'boolean
:group 'ledger-reconcile) :group 'ledger-reconcile)
(defcustom ledger-reconcile-default-date-format "%Y/%m/%d" (defcustom ledger-reconcile-default-date-format "%Y/%m/%d"
"Default date format for the reconcile buffer" "Default date format for the reconcile buffer"
@ -85,10 +85,10 @@ reconcile-finish will mark all pending posting cleared."
;; split arguments like the shell does, so you need to ;; split arguments like the shell does, so you need to
;; specify the individual fields in the command line. ;; specify the individual fields in the command line.
(if (ledger-exec-ledger buffer (current-buffer) (if (ledger-exec-ledger buffer (current-buffer)
"balance" "--limit" "cleared or pending" "--empty" "--collapse" "balance" "--limit" "cleared or pending" "--empty" "--collapse"
"--format" "%(display_total)" account) "--format" "%(display_total)" account)
(ledger-split-commodity-string (ledger-split-commodity-string
(buffer-substring-no-properties (point-min) (point-max)))))) (buffer-substring-no-properties (point-min) (point-max))))))
(defun ledger-display-balance () (defun ledger-display-balance ()
"Display the cleared-or-pending balance. "Display the cleared-or-pending balance.
@ -96,12 +96,12 @@ And calculate the target-delta of the account being reconciled."
(interactive) (interactive)
(let* ((pending (ledger-reconcile-get-cleared-or-pending-balance ledger-buf ledger-acct))) (let* ((pending (ledger-reconcile-get-cleared-or-pending-balance ledger-buf ledger-acct)))
(when pending (when pending
(if ledger-target (if ledger-target
(message "Pending balance: %s, Difference from target: %s" (message "Pending balance: %s, Difference from target: %s"
(ledger-commodity-to-string pending) (ledger-commodity-to-string pending)
(ledger-commodity-to-string (-commodity ledger-target pending))) (ledger-commodity-to-string (-commodity ledger-target pending)))
(message "Pending balance: %s" (message "Pending balance: %s"
(ledger-commodity-to-string pending)))))) (ledger-commodity-to-string pending))))))
(defun is-stdin (file) (defun is-stdin (file)
"True if ledger FILE is standard input." "True if ledger FILE is standard input."
@ -125,27 +125,27 @@ And calculate the target-delta of the account being reconciled."
status) status)
(when (ledger-reconcile-get-buffer where) (when (ledger-reconcile-get-buffer where)
(with-current-buffer (ledger-reconcile-get-buffer where) (with-current-buffer (ledger-reconcile-get-buffer where)
(ledger-goto-line (cdr where)) (ledger-goto-line (cdr where))
(forward-char) (forward-char)
(setq status (ledger-toggle-current (if ledger-reconcile-toggle-to-pending (setq status (ledger-toggle-current (if ledger-reconcile-toggle-to-pending
'pending 'pending
'cleared)))) 'cleared))))
;; 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))
(cond ((eq status 'pending) (cond ((eq status 'pending)
(add-text-properties (line-beginning-position) (add-text-properties (line-beginning-position)
(line-end-position) (line-end-position)
(list 'face 'ledger-font-reconciler-pending-face ))) (list 'face 'ledger-font-reconciler-pending-face )))
((eq status 'cleared) ((eq status 'cleared)
(add-text-properties (line-beginning-position) (add-text-properties (line-beginning-position)
(line-end-position) (line-end-position)
(list 'face 'ledger-font-reconciler-cleared-face ))) (list 'face 'ledger-font-reconciler-cleared-face )))
(t (t
(add-text-properties (line-beginning-position) (add-text-properties (line-beginning-position)
(line-end-position) (line-end-position)
(list 'face 'ledger-font-reconciler-uncleared-face ))))) (list 'face 'ledger-font-reconciler-uncleared-face )))))
(forward-line) (forward-line)
(beginning-of-line) (beginning-of-line)
(ledger-display-balance))) (ledger-display-balance)))
@ -157,18 +157,18 @@ Return the number of uncleared xacts found."
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(erase-buffer) (erase-buffer)
(prog1 (prog1
(ledger-do-reconcile) (ledger-do-reconcile)
(set-buffer-modified-p t)))) (set-buffer-modified-p t))))
(defun ledger-reconcile-refresh-after-save () (defun ledger-reconcile-refresh-after-save ()
"Refresh the recon-window after the ledger buffer is saved." "Refresh the recon-window after the ledger buffer is saved."
(let ((curbuf (current-buffer)) (let ((curbuf (current-buffer))
(curpoint (point)) (curpoint (point))
(recon-buf (get-buffer ledger-recon-buffer-name))) (recon-buf (get-buffer ledger-recon-buffer-name)))
(when (buffer-live-p recon-buf) (when (buffer-live-p recon-buf)
(with-current-buffer recon-buf (with-current-buffer recon-buf
(ledger-reconcile-refresh) (ledger-reconcile-refresh)
(set-buffer-modified-p nil)) (set-buffer-modified-p nil))
(select-window (get-buffer-window curbuf)) (select-window (get-buffer-window curbuf))
(goto-char curpoint)))) (goto-char curpoint))))
@ -198,19 +198,19 @@ Return the number of uncleared xacts found."
(progn (progn
(beginning-of-line) (beginning-of-line)
(let* ((where (get-text-property (1+ (point)) 'where)) (let* ((where (get-text-property (1+ (point)) 'where))
(target-buffer (if where (target-buffer (if where
(ledger-reconcile-get-buffer where) (ledger-reconcile-get-buffer where)
nil)) nil))
(cur-buf (get-buffer ledger-recon-buffer-name))) (cur-buf (get-buffer ledger-recon-buffer-name)))
(when target-buffer (when target-buffer
(switch-to-buffer-other-window target-buffer) (switch-to-buffer-other-window target-buffer)
(ledger-goto-line (cdr where)) (ledger-goto-line (cdr where))
(forward-char) (forward-char)
(recenter) (recenter)
(ledger-highlight-xact-under-point) (ledger-highlight-xact-under-point)
(forward-char -1) (forward-char -1)
(if come-back (if come-back
(switch-to-buffer-other-window cur-buf)))))) (switch-to-buffer-other-window cur-buf))))))
(defun ledger-reconcile-save () (defun ledger-reconcile-save ()
"Save the ledger buffer." "Save the ledger buffer."
@ -218,7 +218,7 @@ Return the number of uncleared xacts found."
(let ((curpoint (point))) (let ((curpoint (point)))
(dolist (buf (cons ledger-buf ledger-bufs)) (dolist (buf (cons ledger-buf ledger-bufs))
(with-current-buffer buf (with-current-buffer buf
(save-buffer))) (save-buffer)))
(with-current-buffer (get-buffer ledger-recon-buffer-name) (with-current-buffer (get-buffer ledger-recon-buffer-name)
(set-buffer-modified-p nil) (set-buffer-modified-p nil)
(ledger-display-balance) (ledger-display-balance)
@ -247,84 +247,84 @@ and exit reconcile mode"
"Quit the reconcile window without saving ledger buffer." "Quit the reconcile window without saving ledger buffer."
(interactive) (interactive)
(let ((recon-buf (get-buffer ledger-recon-buffer-name)) (let ((recon-buf (get-buffer ledger-recon-buffer-name))
buf) buf)
(if recon-buf (if recon-buf
(with-current-buffer recon-buf (with-current-buffer recon-buf
(ledger-reconcile-quit-cleanup) (ledger-reconcile-quit-cleanup)
(setq buf ledger-buf) (setq buf ledger-buf)
;; Make sure you delete the window before you delete the buffer, ;; Make sure you delete the window before you delete the buffer,
;; otherwise, madness ensues ;; otherwise, madness ensues
(delete-window (get-buffer-window recon-buf)) (delete-window (get-buffer-window recon-buf))
(kill-buffer recon-buf) (kill-buffer recon-buf)
(set-window-buffer (selected-window) buf))))) (set-window-buffer (selected-window) buf)))))
(defun ledger-reconcile-quit-cleanup () (defun ledger-reconcile-quit-cleanup ()
"Cleanup all hooks established by reconcile mode." "Cleanup all hooks established by reconcile mode."
(interactive) (interactive)
(let ((buf ledger-buf)) (let ((buf ledger-buf))
(if (buffer-live-p buf) (if (buffer-live-p buf)
(with-current-buffer buf (with-current-buffer buf
(remove-hook 'after-save-hook 'ledger-reconcile-refresh-after-save t) (remove-hook 'after-save-hook 'ledger-reconcile-refresh-after-save t)
(when ledger-narrow-on-reconcile (when ledger-narrow-on-reconcile
(ledger-occur-quit-buffer buf) (ledger-occur-quit-buffer buf)
(ledger-highlight-xact-under-point)))))) (ledger-highlight-xact-under-point))))))
(defun ledger-marker-where-xact-is (emacs-xact posting) (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-buf'.
POSTING is used in `ledger-clear-whole-transactions' is nil." POSTING is used in `ledger-clear-whole-transactions' is nil."
(let ((buf (if (is-stdin (nth 0 emacs-xact)) (let ((buf (if (is-stdin (nth 0 emacs-xact))
ledger-buf ledger-buf
(find-file-noselect (nth 0 emacs-xact))))) (find-file-noselect (nth 0 emacs-xact)))))
(cons (cons
buf buf
(if ledger-clear-whole-transactions (if ledger-clear-whole-transactions
(nth 1 emacs-xact) ;; return line-no of xact (nth 1 emacs-xact) ;; return line-no of xact
(nth 0 posting))))) ;; return line-no of posting (nth 0 posting))))) ;; return line-no of posting
(defun ledger-do-reconcile () (defun ledger-do-reconcile ()
"Return the number of uncleared transactions in the account and display them in the *Reconcile* buffer." "Return the number of 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)
(ledger-success nil) (ledger-success nil)
(xacts (xacts
(with-temp-buffer (with-temp-buffer
(when (ledger-exec-ledger buf (current-buffer) (when (ledger-exec-ledger buf (current-buffer)
"--uncleared" "--real" "emacs" account) "--uncleared" "--real" "emacs" account)
(setq ledger-success t) (setq ledger-success t)
(goto-char (point-min)) (goto-char (point-min))
(unless (eobp) (unless (eobp)
(if (looking-at "(") (if (looking-at "(")
(read (current-buffer)))))))) ;current-buffer is the *temp* created above (read (current-buffer)))))))) ;current-buffer is the *temp* created above
(if (and ledger-success (> (length xacts) 0)) (if (and ledger-success (> (length xacts) 0))
(let ((date-format (cdr (assoc "date-format" ledger-environment-alist)))) (let ((date-format (cdr (assoc "date-format" ledger-environment-alist))))
(dolist (xact xacts) (dolist (xact xacts)
(dolist (posting (nthcdr 5 xact)) (dolist (posting (nthcdr 5 xact))
(let ((beg (point)) (let ((beg (point))
(where (ledger-marker-where-xact-is xact posting))) (where (ledger-marker-where-xact-is xact posting)))
(insert (format "%s %-4s %-30s %-30s %15s\n" (insert (format "%s %-4s %-30s %-30s %15s\n"
(format-time-string (if date-format (format-time-string (if date-format
date-format date-format
ledger-reconcile-default-date-format) (nth 2 xact)) ledger-reconcile-default-date-format) (nth 2 xact))
(if (nth 3 xact) (if (nth 3 xact)
(nth 3 xact) (nth 3 xact)
"") "")
(nth 4 xact) (nth 1 posting) (nth 2 posting))) (nth 4 xact) (nth 1 posting) (nth 2 posting)))
(if (nth 3 posting) (if (nth 3 posting)
(if (eq (nth 3 posting) 'pending) (if (eq (nth 3 posting) 'pending)
(set-text-properties beg (1- (point)) (set-text-properties beg (1- (point))
(list 'face 'ledger-font-reconciler-pending-face (list 'face 'ledger-font-reconciler-pending-face
'where where)) 'where where))
(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)))) ))
(goto-char (point-max)) (goto-char (point-max))
(delete-char -1)) ;gets rid of the extra line feed at the bottom of the list (delete-char -1)) ;gets rid of the extra line feed at the bottom of the list
(if ledger-success (if ledger-success
(insert (concat "There are no uncleared entries for " account)) (insert (concat "There are no uncleared entries for " account))
(insert "Ledger has reported a problem. Check *Ledger Error* buffer."))) (insert "Ledger has reported a problem. Check *Ledger Error* buffer.")))
(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)
@ -338,30 +338,30 @@ ledger buffer is at the bottom of the main window. The key to
this is to ensure the window is selected when the buffer point is this is to ensure the window is selected when the buffer point is
moved and recentered. If they aren't strange things happen." moved and recentered. If they aren't strange things happen."
(let ((recon-window (get-buffer-window (get-buffer ledger-recon-buffer-name)))) (let ((recon-window (get-buffer-window (get-buffer ledger-recon-buffer-name))))
(when recon-window (when recon-window
(fit-window-to-buffer recon-window) (fit-window-to-buffer recon-window)
(with-current-buffer buf (with-current-buffer buf
(add-hook 'kill-buffer-hook 'ledger-reconcile-quit nil t) (add-hook 'kill-buffer-hook 'ledger-reconcile-quit nil t)
(if (get-buffer-window buf) (if (get-buffer-window buf)
(select-window (get-buffer-window buf))) (select-window (get-buffer-window buf)))
(goto-char (point-max)) (goto-char (point-max))
(recenter -1)) (recenter -1))
(select-window recon-window) (select-window recon-window)
(ledger-reconcile-visit t)) (ledger-reconcile-visit t))
(add-hook 'post-command-hook 'ledger-reconcile-track-xact nil t))) (add-hook 'post-command-hook 'ledger-reconcile-track-xact nil t)))
(defun ledger-reconcile-track-xact () (defun ledger-reconcile-track-xact ()
"Force the ledger buffer to recenter on the transaction at point in the reconcile buffer." "Force the ledger buffer to recenter on the transaction at point in the reconcile buffer."
(if (and ledger-buffer-tracks-reconcile-buffer (if (and ledger-buffer-tracks-reconcile-buffer
(member this-command (list 'next-line (member this-command (list 'next-line
'previous-line 'previous-line
'mouse-set-point 'mouse-set-point
'ledger-reconcile-toggle 'ledger-reconcile-toggle
'end-of-buffer 'end-of-buffer
'beginning-of-buffer))) 'beginning-of-buffer)))
(save-excursion (save-excursion
(ledger-reconcile-visit t)))) (ledger-reconcile-visit t))))
(defun ledger-reconcile-open-windows (buf rbuf) (defun ledger-reconcile-open-windows (buf rbuf)
"Ensure that the ledger buffer BUF is split by RBUF." "Ensure that the ledger buffer BUF is split by RBUF."
@ -374,39 +374,39 @@ moved and recentered. If they aren't strange things happen."
"Start reconciling, prompt for account." "Start reconciling, prompt for account."
(interactive) (interactive)
(let ((account (ledger-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
;; reconcile buffer ;; reconcile buffer
(if rbuf ;; *Reconcile* already exists (if rbuf ;; *Reconcile* already exists
(with-current-buffer rbuf (with-current-buffer rbuf
(set 'ledger-acct account) ;; already buffer local (set 'ledger-acct account) ;; already buffer local
(when (not (eq buf rbuf)) (when (not (eq buf rbuf))
;; called from some other ledger-mode buffer ;; called from some other ledger-mode buffer
(ledger-reconcile-quit-cleanup) (ledger-reconcile-quit-cleanup)
(set 'ledger-buf buf)) ;; should already be buffer-local (set 'ledger-buf buf)) ;; should already be buffer-local
(unless (get-buffer-window rbuf) (unless (get-buffer-window rbuf)
(ledger-reconcile-open-windows buf rbuf))) (ledger-reconcile-open-windows buf rbuf)))
;; no recon-buffer, starting from scratch. ;; no recon-buffer, starting from scratch.
(add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t) (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t)
(with-current-buffer (setq rbuf (with-current-buffer (setq rbuf
(get-buffer-create ledger-recon-buffer-name)) (get-buffer-create ledger-recon-buffer-name))
(ledger-reconcile-open-windows buf rbuf) (ledger-reconcile-open-windows buf rbuf)
(ledger-reconcile-mode) (ledger-reconcile-mode)
(make-local-variable 'ledger-target) (make-local-variable 'ledger-target)
(set (make-local-variable 'ledger-buf) buf) (set (make-local-variable 'ledger-buf) buf)
(set (make-local-variable 'ledger-acct) account))) (set (make-local-variable 'ledger-acct) account)))
;; Narrow the ledger buffer ;; Narrow the ledger buffer
(with-current-buffer rbuf (with-current-buffer rbuf
(save-excursion (save-excursion
(if ledger-narrow-on-reconcile (if ledger-narrow-on-reconcile
(ledger-occur-mode account ledger-buf))) (ledger-occur-mode account ledger-buf)))
(if (> (ledger-reconcile-refresh) 0) (if (> (ledger-reconcile-refresh) 0)
(ledger-reconcile-change-target)) (ledger-reconcile-change-target))
(ledger-display-balance)))) (ledger-display-balance))))
(defvar ledger-reconcile-mode-abbrev-table) (defvar ledger-reconcile-mode-abbrev-table)
@ -417,45 +417,45 @@ moved and recentered. If they aren't strange things happen."
(setq ledger-target (ledger-read-commodity-string ledger-reconcile-target-prompt-string))) (setq ledger-target (ledger-read-commodity-string ledger-reconcile-target-prompt-string)))
(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 ?l)] 'ledger-reconcile-refresh) (define-key map [(control ?l)] 'ledger-reconcile-refresh)
(define-key map [(control ?c) (control ?c)] 'ledger-reconcile-finish) (define-key map [(control ?c) (control ?c)] 'ledger-reconcile-finish)
(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); (define-key map [?g] 'ledger-reconcile);
(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 [?t] 'ledger-reconcile-change-target) (define-key map [?t] 'ledger-reconcile-change-target)
(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 Source" . ledger-reconcile-visit)) (define-key map [menu-bar ldg-recon-menu vis] '("Visit Source" . 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 tgt] '("Change Target Balance" . ledger-reconcile-change-target)) (define-key map [menu-bar ldg-recon-menu tgt] '("Change Target Balance" . ledger-reconcile-change-target))
(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)) (define-key map [menu-bar ldg-recon-menu rna] '("Reconcile New Account" . ledger-reconcile))
(define-key map [menu-bar ldg-recon-menu sep5] '("--")) (define-key map [menu-bar ldg-recon-menu sep5] '("--"))
(define-key map [menu-bar ldg-recon-menu fin] '("Finish" . ledger-reconcile-finish)) (define-key map [menu-bar ldg-recon-menu fin] '("Finish" . ledger-reconcile-finish))
(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)

38
lisp/ldg-regex.el
View file

@ -37,39 +37,59 @@
"-?[1-9][0-9.]*[,]?[0-9]*") "-?[1-9][0-9.]*[,]?[0-9]*")
(defconst ledger-amount-decimal-period-regex (defconst ledger-amount-decimal-period-regex
"-?[1-9][0-9.]*[.]?[0-9]*") "-?[1-9][0-9,]*[.]?[0-9]*")
(defconst ledger-other-entries-regex (defconst ledger-other-entries-regex
"\\(^[~=A-Za-z].+\\)+") "\\(^[~=A-Za-z].+\\)+")
(defconst ledger-comment-regex (defconst ledger-comment-regex
"\\( \\| \\|^\\)\\(;.*\\)") "^[;#|\\*%].*\\|[ \t]+;.*")
(defconst ledger-multiline-comment-start-regex
"^!comment$")
(defconst ledger-multiline-comment-end-regex
"^!end_comment$")
(defconst ledger-multiline-comment-regex
"^!comment\n\\(.*\n\\)*?!end_comment$")
(defconst ledger-payee-any-status-regex (defconst ledger-payee-any-status-regex
"^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") "^[0-9]+[-/][-/.=0-9]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.+?\\)\\s-*\\(;\\|$\\)")
(defconst ledger-payee-pending-regex (defconst ledger-payee-pending-regex
"^[0-9]+[-/][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)") "^[0-9]+[-/][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\s-*\\(;\\|$\\)")
(defconst ledger-payee-cleared-regex (defconst ledger-payee-cleared-regex
"^[0-9]+[-/][-/.=0-9]+\\s-\\*\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)") "^[0-9]+[-/][-/.=0-9]+\\s-\\*\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\s-*\\(;\\|$\\)")
(defconst ledger-payee-uncleared-regex (defconst ledger-payee-uncleared-regex
"^[0-9]+[-/][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)") "^[0-9]+[-/][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\s-*\\(;\\|$\\)")
(defconst ledger-init-string-regex (defconst ledger-init-string-regex
"^--.+?\\($\\|[ ]\\)") "^--.+?\\($\\|[ ]\\)")
(defconst ledger-account-any-status-regex (defconst ledger-account-any-status-regex
"^[ \t]+\\([*!]\\s-+\\)?\\([[(]?.+?\\)\\(\t\\|\n\\| [ \t]\\)") "^[ \t]+\\(?1:[*!]\\s-*\\)?\\(?2:[^ ;].*?\\)\\( \\|\t\\|$\\)")
(defconst ledger-account-pending-regex (defconst ledger-account-pending-regex
"\\(^[ \t]+\\)\\(!.+?\\)\\( \\|$\\)") "\\(^[ \t]+\\)\\(!\\s-*.*?\\)\\( \\|\t\\|$\\)")
(defconst ledger-account-cleared-regex (defconst ledger-account-cleared-regex
"\\(^[ \t]+\\)\\(\\*.+?\\)\\( \\|$\\)") "\\(^[ \t]+\\)\\(*\\s-*.*?\\)\\( \\|\t\\|$\\)")
(defconst ledger-metadata-regex
"[ \t]+\\(?2:;[ \t]+.+\\)$")
(defconst ledger-account-or-metadata-regex
(concat
ledger-account-any-status-regex
"\\|"
ledger-metadata-regex))
(defmacro rx-static-or (&rest rx-strs)
"Returns rx union of regexps which can be symbols that eval to strings."
`(rx (or ,@(mapcar #'(lambda (rx-str)
`(regexp ,(eval rx-str)))
rx-strs))))
(defmacro ledger-define-regexp (name regex docs &rest args) (defmacro ledger-define-regexp (name regex docs &rest args)
"Simplify the creation of a Ledger regex and helper functions." "Simplify the creation of a Ledger regex and helper functions."

36
lisp/ldg-report.el
View file

@ -295,32 +295,32 @@ Optional EDIT the command."
"\n\n") "\n\n")
(let ((data-pos (point)) (let ((data-pos (point))
(register-report (string-match " reg\\(ister\\)? " cmd)) (register-report (string-match " reg\\(ister\\)? " cmd))
files-in-report) files-in-report)
(shell-command (shell-command
;; --subtotal does not produce identifiable transactions, so don't ;; --subtotal does not produce identifiable transactions, so don't
;; prepend location information for them ;; prepend location information for them
(if (and register-report (if (and register-report
(not (string-match "--subtotal" cmd))) (not (string-match "--subtotal" cmd)))
(concat cmd " --prepend-format='%(filename):%(beg_line):'") (concat cmd " --prepend-format='%(filename):%(beg_line):'")
cmd) cmd)
t nil) t nil)
(when register-report (when register-report
(goto-char data-pos) (goto-char data-pos)
(while (re-search-forward "^\\(/[^:]+\\)?:\\([0-9]+\\)?:" nil t) (while (re-search-forward "^\\(/[^:]+\\)?:\\([0-9]+\\)?:" nil t)
(let ((file (match-string 1)) (let ((file (match-string 1))
(line (string-to-number (match-string 2)))) (line (string-to-number (match-string 2))))
(delete-region (match-beginning 0) (match-end 0)) (delete-region (match-beginning 0) (match-end 0))
(when file (when file
(set-text-properties (line-beginning-position) (line-end-position) (set-text-properties (line-beginning-position) (line-end-position)
(list 'ledger-source (cons file (save-window-excursion (list 'ledger-source (cons file (save-window-excursion
(save-excursion (save-excursion
(find-file file) (find-file file)
(widen) (widen)
(ledger-goto-line line) (ledger-goto-line line)
(point-marker)))))) (point-marker))))))
(add-text-properties (line-beginning-position) (line-end-position) (add-text-properties (line-beginning-position) (line-end-position)
(list 'face 'ledger-font-report-clickable-face)) (list 'face 'ledger-font-report-clickable-face))
(end-of-line))))) (end-of-line)))))
(goto-char data-pos))) (goto-char data-pos)))

73
lisp/ldg-sort.el
View file

@ -49,7 +49,7 @@
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(if (ledger-sort-find-start) (if (ledger-sort-find-start)
(delete-region (match-beginning 0) (match-end 0)))) (delete-region (match-beginning 0) (match-end 0))))
(beginning-of-line) (beginning-of-line)
(insert "\n; Ledger-mode: Start sort\n\n")) (insert "\n; Ledger-mode: Start sort\n\n"))
@ -58,7 +58,7 @@
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(if (ledger-sort-find-end) (if (ledger-sort-find-end)
(delete-region (match-beginning 0) (match-end 0)))) (delete-region (match-beginning 0) (match-end 0))))
(beginning-of-line) (beginning-of-line)
(insert "\n; Ledger-mode: End sort\n\n")) (insert "\n; Ledger-mode: End sort\n\n"))
@ -69,44 +69,57 @@
(defun ledger-sort-region (beg end) (defun ledger-sort-region (beg end)
"Sort the region from BEG to END in chronological order." "Sort the region from BEG to END in chronological order."
(interactive "r") ;; load beg and end from point and mark (interactive "r") ;; load beg and end from point and mark
;; automagically ;; automagically
(let ((new-beg beg) (let ((new-beg beg)
(new-end end)) (new-end end)
(setq inhibit-modification-hooks t) point-delta
(bounds (ledger-find-xact-extents (point)))
target-xact)
(setq point-delta (- (point) (car bounds)))
(setq target-xact (buffer-substring (car bounds) (cadr bounds)))
(setq inhibit-modification-hooks t)
(save-excursion (save-excursion
(save-restriction (save-restriction
(goto-char beg) (goto-char beg)
(ledger-next-record-function) ;; make sure point is at the (ledger-next-record-function) ;; make sure point is at the
;; beginning of a xact ;; beginning of a xact
(setq new-beg (point)) (setq new-beg (point))
(goto-char end) (goto-char end)
(ledger-next-record-function) ;; make sure end of region is at (ledger-next-record-function) ;; make sure end of region is at
;; the beginning of next record ;; the beginning of next record
;; after the region ;; after the region
(setq new-end (point)) (setq new-end (point))
(narrow-to-region new-beg new-end) (narrow-to-region new-beg new-end)
(goto-char new-beg) (goto-char new-beg)
(let ((inhibit-field-text-motion t)) (let ((inhibit-field-text-motion t))
(sort-subr (sort-subr
nil nil
'ledger-next-record-function 'ledger-next-record-function
'ledger-end-record-function 'ledger-end-record-function
'ledger-sort-startkey)))) 'ledger-sort-startkey))))
(goto-char beg)
(re-search-forward (regexp-quote target-xact))
(goto-char (+ (match-beginning 0) point-delta))
(setq inhibit-modification-hooks nil))) (setq inhibit-modification-hooks nil)))
(defun ledger-sort-buffer () (defun ledger-sort-buffer ()
"Sort the entire buffer." "Sort the entire buffer."
(interactive) (interactive)
(goto-char (point-min)) (let (sort-start
(let ((sort-start (ledger-sort-find-start)) sort-end)
(sort-end (ledger-sort-find-end))) (save-excursion
(goto-char (point-min))
(setq sort-start (ledger-sort-find-start)
sort-end (ledger-sort-find-end)))
(ledger-sort-region (if sort-start (ledger-sort-region (if sort-start
sort-start sort-start
(point-min)) (point-min))
(if sort-end (if sort-end
sort-end sort-end
(point-max))))) (point-max)))))
(provide 'ldg-sort) (provide 'ldg-sort)