summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/CMakeLists.txt3
-rw-r--r--lisp/ledger-commodities.el25
-rw-r--r--lisp/ledger-complete.el6
-rw-r--r--lisp/ledger-context.el6
-rw-r--r--lisp/ledger-exec.el5
-rw-r--r--lisp/ledger-fontify.el199
-rw-r--r--lisp/ledger-fonts.el188
-rw-r--r--lisp/ledger-init.el8
-rw-r--r--lisp/ledger-mode.el105
-rw-r--r--lisp/ledger-navigate.el168
-rw-r--r--lisp/ledger-occur.el157
-rw-r--r--lisp/ledger-post.el130
-rw-r--r--lisp/ledger-reconcile.el162
-rw-r--r--lisp/ledger-regex.el36
-rw-r--r--lisp/ledger-report.el76
-rw-r--r--lisp/ledger-schedule.el260
-rw-r--r--lisp/ledger-sort.el33
-rw-r--r--lisp/ledger-state.el14
-rw-r--r--lisp/ledger-test.el14
-rw-r--r--lisp/ledger-texi.el2
-rw-r--r--lisp/ledger-xact.el43
21 files changed, 1075 insertions, 565 deletions
diff --git a/lisp/CMakeLists.txt b/lisp/CMakeLists.txt
index 76f221b4..9dee2abb 100644
--- a/lisp/CMakeLists.txt
+++ b/lisp/CMakeLists.txt
@@ -2,9 +2,12 @@ set(EMACS_LISP_SOURCES
ledger-commodities.el
ledger-complete.el
ledger-exec.el
+ ledger-fontify.el
ledger-fonts.el
+ ledger-fontify.el
ledger-init.el
ledger-mode.el
+ ledger-navigate.el
ledger-occur.el
ledger-post.el
ledger-reconcile.el
diff --git a/lisp/ledger-commodities.el b/lisp/ledger-commodities.el
index e6f5417d..5ffebf3b 100644
--- a/lisp/ledger-commodities.el
+++ b/lisp/ledger-commodities.el
@@ -1,6 +1,6 @@
;;; ledger-commodities.el --- Helper code for use with the "ledger" command-line tool
-;; Copyright (C) 2003-2014 John Wiegley (johnw AT gnu DOT org)
+;; Copyright (C) 2003-2015 John Wiegley (johnw AT gnu DOT org)
;; This file is not part of GNU Emacs.
@@ -33,11 +33,6 @@
:type 'string
:group 'ledger-reconcile)
-(defcustom ledger-scale 10000
- "The 10 ^ maximum number of digits you would expect to appear in your reports.
-This is a cheap way of getting around floating point silliness in subtraction"
- :group 'ledger)
-
(defun ledger-split-commodity-string (str)
"Split a commoditized string, STR, into two parts.
Returns a list with (value commodity)."
@@ -86,11 +81,7 @@ Returns a list with (value commodity)."
(defun -commodity (c1 c2)
"Subtract C2 from C1, ensuring their commodities match."
(if (string= (cadr c1) (cadr c2))
- ; the scaling below is to get around inexact
- ; subtraction results where, for example 1.23
- ; - 4.56 = -3.3299999999999996 instead of
- ; -3.33
- (list (/ (- (* ledger-scale (car c1)) (* ledger-scale (car c2))) ledger-scale) (cadr c1))
+ (list (-(car c1) (car c2)) (cadr c1))
(error "Can't subtract different commodities %S from %S" c2 c1)))
(defun +commodity (c1 c2)
@@ -100,22 +91,21 @@ Returns a list with (value commodity)."
(error "Can't add different commodities, %S to %S" c1 c2)))
(defun ledger-strip (str char)
- (let (new-str)
- (concat (dolist (ch (append str nil) new-str)
- (unless (= ch char)
- (setq new-str (append new-str (list ch))))))))
+ "Return STR with CHAR removed."
+ (replace-regexp-in-string char "" str))
(defun ledger-string-to-number (str &optional decimal-comma)
"improve builtin string-to-number by handling internationalization, and return nil if number can't be parsed"
(let ((nstr (if (or decimal-comma
(assoc "decimal-comma" ledger-environment-alist))
- (ledger-strip str ?.)
- (ledger-strip str ?,))))
+ (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)
+ "number-to-string that handles comma as decimal."
(let ((str (number-to-string n)))
(when (or decimal-comma
(assoc "decimal-comma" ledger-environment-alist))
@@ -134,6 +124,7 @@ longer ones are after the value."
(concat commodity " " str))))
(defun ledger-read-commodity-string (prompt)
+ "Read an amount from mini-buffer using PROMPT."
(let ((str (read-from-minibuffer
(concat prompt " (" ledger-reconcile-default-commodity "): ")))
comm)
diff --git a/lisp/ledger-complete.el b/lisp/ledger-complete.el
index bc4b1854..2fae9911 100644
--- a/lisp/ledger-complete.el
+++ b/lisp/ledger-complete.el
@@ -1,6 +1,6 @@
;;; ledger-complete.el --- Helper code for use with the "ledger" command-line tool
-;; Copyright (C) 2003-2014 John Wiegley (johnw AT gnu DOT org)
+;; Copyright (C) 2003-2015 John Wiegley (johnw AT gnu DOT org)
;; This file is not part of GNU Emacs.
@@ -157,9 +157,7 @@
(ledger-accounts)))))
(defun ledger-trim-trailing-whitespace (str)
- (let ((s str))
- (when (string-match "[ \t]*$" s)
- (replace-match "" nil nil s))))
+ (replace-regexp-in-string "[ \t]*$" "" str))
(defun ledger-fully-complete-xact ()
"Completes a transaction if there is another matching payee in the buffer.
diff --git a/lisp/ledger-context.el b/lisp/ledger-context.el
index 7b10c552..0dfa4645 100644
--- a/lisp/ledger-context.el
+++ b/lisp/ledger-context.el
@@ -1,6 +1,6 @@
;;; ledger-context.el --- Helper code for use with the "ledger" command-line tool
-;; Copyright (C) 2003-2014 John Wiegley (johnw AT gnu DOT org)
+;; Copyright (C) 2003-2015 John Wiegley (johnw AT gnu DOT org)
;; This file is not part of GNU Emacs.
@@ -44,9 +44,11 @@
(defconst ledger-payee-string "\\(.*\\)")
(defun ledger-get-regex-str (name)
+ "Get the ledger regex of type NAME."
(symbol-value (intern (concat "ledger-" (symbol-name name) "-string"))))
(defun ledger-line-regex (elements)
+ "Get a regex to match ELEMENTS on a single line."
(concat (apply 'concat (mapcar 'ledger-get-regex-str elements)) "[ \t]*$"))
(defmacro ledger-single-line-config (&rest elements)
@@ -195,4 +197,4 @@ specified line, returns nil."
(provide 'ledger-context)
-;;; ledger-report.el ends here
+;;; ledger-context.el ends here
diff --git a/lisp/ledger-exec.el b/lisp/ledger-exec.el
index cd5c11a0..8902d839 100644
--- a/lisp/ledger-exec.el
+++ b/lisp/ledger-exec.el
@@ -1,6 +1,6 @@
;;; ledger-exec.el --- Helper code for use with the "ledger" command-line tool
-;; Copyright (C) 2003-2014 John Wiegley (johnw AT gnu DOT org)
+;; Copyright (C) 2003-2015 John Wiegley (johnw AT gnu DOT org)
;; This file is not part of GNU Emacs.
@@ -36,7 +36,7 @@
:group 'ledger)
(defcustom ledger-mode-should-check-version t
- "Should Ledger-mode verify that the executable is working"
+ "Should Ledger-mode verify that the executable is working?"
:type 'boolean
:group 'ledger-exec)
@@ -53,6 +53,7 @@
(setq buffer-read-only t)))
(defun ledger-exec-success-p (ledger-output-buffer)
+ "Return t if the ledger output in LEDGER-OUTPUT-BUFFER is successful."
(with-current-buffer ledger-output-buffer
(goto-char (point-min))
(if (and (> (buffer-size) 1) (looking-at (regexp-quote "While")))
diff --git a/lisp/ledger-fontify.el b/lisp/ledger-fontify.el
new file mode 100644
index 00000000..d307208f
--- /dev/null
+++ b/lisp/ledger-fontify.el
@@ -0,0 +1,199 @@
+;;; ledger-fontify.el --- Provide custom fontification for ledger-mode
+
+
+;; Copyright (C) 2014 Craig P. Earls (enderw88 at gmail dot com)
+
+;; 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., 51 Franklin Street, Fifth Floor, Boston,
+;; MA 02110-1301 USA.
+
+;;; Commentary:
+;; Font-lock-mode doesn't handle multiline syntax very well. This
+;; code provides font lock that is sensitive to overall transaction
+;; states
+
+
+;;; Code:
+
+(require 'ledger-navigate)
+(require 'ledger-regex)
+(require 'ledger-state)
+
+(defcustom ledger-fontify-xact-state-overrides nil
+ "If t the highlight entire xact with state."
+ :type 'boolean
+ :group 'ledger)
+
+(defun ledger-fontify-buffer-part (&optional beg end len)
+"Fontify buffer from BEG to END, length LEN."
+ (save-excursion
+ (unless beg (setq beg (point-min)))
+ (unless end (setq end (point-max)))
+ (beginning-of-line)
+ (while (< (point) end)
+ (cond ((or (looking-at ledger-xact-start-regex)
+ (looking-at ledger-posting-regex))
+ (ledger-fontify-xact-at (point)))
+ ((looking-at ledger-directive-start-regex)
+ (ledger-fontify-directive-at (point))))
+ (ledger-navigate-next-xact-or-directive))))
+
+(defun ledger-fontify-xact-at (position)
+ "Fontify the xact at POSITION."
+ (interactive "d")
+ (save-excursion
+ (goto-char position)
+ (let ((extents (ledger-navigate-find-element-extents position))
+ (state (ledger-transaction-state)))
+ (if (and ledger-fontify-xact-state-overrides state)
+ (cond ((eq state 'cleared)
+ (ledger-fontify-set-face extents 'ledger-font-xact-cleared-face))
+ ((eq state 'pending)
+ (ledger-fontify-set-face extents 'ledger-font-xact-pending-face)))
+ (ledger-fontify-xact-by-line extents)))))
+
+(defun ledger-fontify-xact-by-line (extents)
+ "Do line-by-line detailed fontification of xact in EXTENTS."
+ (save-excursion
+ (ledger-fontify-xact-start (car extents))
+ (while (< (point) (cadr extents))
+ (if (looking-at "[ \t]+;")
+ (ledger-fontify-set-face (list (point) (progn
+ (end-of-line)
+ (point))) 'ledger-font-comment-face)
+ (ledger-fontify-posting (point)))
+ (forward-line))))
+
+(defun ledger-fontify-xact-start (pos)
+ "POS should be at the beginning of a line starting an xact.
+Fontify the first line of an xact"
+ (goto-char pos)
+ (let ((line-start (line-beginning-position)))
+ (goto-char line-start)
+ (re-search-forward "[ \t]")
+ (ledger-fontify-set-face (list line-start (match-beginning 0)) 'ledger-font-posting-date-face)
+ (goto-char line-start)
+ (re-search-forward ledger-xact-after-date-regex)
+ (let ((state (save-match-data (ledger-state-from-string (match-string 1)))))
+ (ledger-fontify-set-face (list (match-beginning 3) (match-end 3))
+ (cond ((eq state 'pending)
+ 'ledger-font-payee-pending-face)
+ ((eq state 'cleared)
+ 'ledger-font-payee-cleared-face)
+ (t
+ 'ledger-font-payee-uncleared-face))))
+ (when (match-beginning 4)
+ (ledger-fontify-set-face (list (match-beginning 4)
+ (match-end 4)) 'ledger-font-comment-face))
+ (forward-line)))
+
+(defun ledger-fontify-posting (pos)
+ "Fontify the posting at POS."
+ (let* ((state nil)
+ (end-of-line-comment nil)
+ (end (progn (end-of-line)
+ (point)))
+ (start (progn (beginning-of-line)
+ (point))))
+
+ ;; Look for a posting status flag
+ (set-match-data nil 'reseat)
+ (re-search-forward " \\([*!]\\) " end t)
+ (if (match-string 1)
+ (setq state (ledger-state-from-string (match-string 1))))
+ (beginning-of-line)
+ (re-search-forward "[[:graph:]]\\([ \t][ \t]\\)" end 'end) ;; find the end of the account, or end of line
+
+ (when (<= (point) end) ;; we are still on the line
+ (ledger-fontify-set-face (list start (point))
+ (cond ((eq state 'cleared)
+ 'ledger-font-posting-account-cleared-face)
+ ((eq state 'pending)
+ 'ledger-font-posting-account-pending-face)
+ (t
+ 'ledger-font-posting-account-face)))
+
+
+ (when (< (point) end) ;; there is still more to fontify
+ (setq start (point)) ;; update start of next font region
+ (setq end-of-line-comment (re-search-forward ";" end 'end)) ;; find the end of the line, or start of a comment
+ (ledger-fontify-set-face (list start (point) )
+ (cond ((eq state 'cleared)
+ 'ledger-font-posting-amount-cleared-face)
+ ((eq state 'pending)
+ 'ledger-font-posting-amount-pending-face)
+ (t
+ 'ledger-font-posting-amount-face)))
+ (when end-of-line-comment
+ (setq start (point))
+ (end-of-line)
+ (ledger-fontify-set-face (list (- start 1) (point)) ;; subtract 1 from start because we passed the semi-colon
+ 'ledger-font-comment-face))))))
+
+(defun ledger-fontify-directive-at (pos)
+ "Fontify the directive at POS."
+ (let ((extents (ledger-navigate-find-element-extents pos))
+ (face 'ledger-font-default-face))
+ (cond ((looking-at "=")
+ (setq face 'ledger-font-auto-xact-face))
+ ((looking-at "~")
+ (setq face 'ledger-font-periodic-xact-face))
+ ((looking-at "[;#%|\\*]")
+ (setq face 'ledger-font-comment-face))
+ ((looking-at "\\(year\\)\\|Y")
+ (setq face 'ledger-font-year-directive-face))
+ ((looking-at "account")
+ (setq face 'ledger-font-account-directive-face))
+ ((looking-at "apply")
+ (setq face 'ledger-font-apply-directive-face))
+ ((looking-at "alias")
+ (setq face 'ledger-font-alias-directive-face))
+ ((looking-at "assert")
+ (setq face 'ledger-font-assert-directive-face))
+ ((looking-at "\\(bucket\\)\\|A")
+ (setq face 'ledger-font-bucket-directive-face))
+ ((looking-at "capture")
+ (setq face 'ledger-font-capture-directive-face))
+ ((looking-at "check")
+ (setq face 'ledger-font-check-directive-face))
+ ((looking-at "commodity")
+ (setq face 'ledger-font-commodity-directive-face))
+ ((looking-at "define")
+ (setq face 'ledger-font-define-directive-face))
+ ((looking-at "end")
+ (setq face 'ledger-font-end-directive-face))
+ ((looking-at "expr")
+ (setq face 'ledger-font-expr-directive-face))
+ ((looking-at "fixed")
+ (setq face 'ledger-font-fixed-directive-face))
+ ((looking-at "include")
+ (setq face 'ledger-font-include-directive-face))
+ ((looking-at "payee")
+ (setq face 'ledger-font-payee-directive-face))
+ ((looking-at "P")
+ (setq face 'ledger-font-price-directive-face))
+ ((looking-at "tag")
+ (setq face 'ledger-font-tag-directive-face)))
+ (ledger-fontify-set-face extents face)))
+
+(defun ledger-fontify-set-face (extents face)
+ "Set the text in EXTENTS to FACE."
+ (put-text-property (car extents) (cadr extents) 'face face))
+
+
+(provide 'ledger-fontify)
+
+;;; ledger-fontify.el ends here
diff --git a/lisp/ledger-fonts.el b/lisp/ledger-fonts.el
index f5ed6e94..8bdecdb3 100644
--- a/lisp/ledger-fonts.el
+++ b/lisp/ledger-fonts.el
@@ -1,6 +1,6 @@
;;; ledger-fonts.el --- Helper code for use with the "ledger" command-line tool
-;; Copyright (C) 2003-2014 John Wiegley (johnw AT gnu DOT org)
+;; Copyright (C) 2003-2015 John Wiegley (johnw AT gnu DOT org)
;; This file is not part of GNU Emacs.
@@ -29,6 +29,37 @@
(require 'ledger-regex)
(defgroup ledger-faces nil "Ledger mode highlighting" :group 'ledger)
+
+(defface ledger-font-default-face
+ `((t :inherit default))
+ "Default face"
+ :group 'ledger-faces)
+
+(defface ledger-font-auto-xact-face
+ `((t :foreground "orange" :weight normal))
+ "Default face for automatic transactions"
+ :group 'ledger-faces)
+
+(defface ledger-font-periodic-xact-face
+ `((t :foreground "green" :weight normal))
+ "Default face for automatic transactions"
+ :group 'ledger-faces)
+
+(defface ledger-font-xact-cleared-face
+ `((t :foreground "#AAAAAA" :weight normal))
+ "Default face for cleared transaction"
+ :group 'ledger-faces)
+
+(defface ledger-font-xact-pending-face
+ `((t :foreground "#444444" :weight normal))
+ "Default face for pending transaction"
+ :group 'ledger-faces)
+
+(defface ledger-font-xact-open-face
+ `((t :foreground "#000000" :weight normal))
+ "Default face for transaction under point"
+ :group 'ledger-faces)
+
(defface ledger-font-payee-uncleared-face
`((t :foreground "#dc322f" :weight bold ))
"Default face for Ledger"
@@ -36,7 +67,12 @@
(defface ledger-font-payee-cleared-face
`((t :inherit ledger-font-other-face))
- "Default face for cleared (*) transactions"
+ "Default face for cleared (*) payees"
+ :group 'ledger-faces)
+
+(defface ledger-font-payee-pending-face
+ `((t :foreground "#F24B61" :weight normal))
+ "Default face for pending (!) payees"
:group 'ledger-faces)
(defface ledger-font-xact-highlight-face
@@ -54,6 +90,96 @@
"Default face for other transactions"
:group 'ledger-faces)
+(defface ledger-font-directive-face
+ `((t :inherit font-lock-preprocessor-face))
+ "Default face for other transactions"
+ :group 'ledger-faces)
+
+(defface ledger-font-account-directive-face
+ `((t :inherit ledger-font-directive-face))
+ "Default face for other transactions"
+ :group 'ledger-faces)
+
+(defface ledger-font-price-directive-face
+ `((t :inherit ledger-font-directive-face))
+ "Default face for other transactions"
+ :group 'ledger-faces)
+
+(defface ledger-font-apply-directive-face
+ `((t :inherit ledger-font-directive-face))
+ "Default face for other transactions"
+ :group 'ledger-faces)
+
+(defface ledger-font-alias-directive-face
+ `((t :inherit ledger-font-directive-face))
+ "Default face for other transactions"
+ :group 'ledger-faces)
+
+(defface ledger-font-assert-directive-face
+ `((t :inherit ledger-font-directive-face))
+ "Default face for other transactions"
+ :group 'ledger-faces)
+
+(defface ledger-font-bucket-directive-face
+ `((t :inherit ledger-font-directive-face))
+ "Default face for other transactions"
+ :group 'ledger-faces)
+
+(defface ledger-font-capture-directive-face
+ `((t :inherit ledger-font-directive-face))
+ "Default face for other transactions"
+ :group 'ledger-faces)
+
+(defface ledger-font-check-directive-face
+ `((t :inherit ledger-font-directive-face))
+ "Default face for other transactions"
+ :group 'ledger-faces)
+
+(defface ledger-font-commodity-directive-face
+ `((t :inherit ledger-font-directive-face))
+ "Default face for other transactions"
+ :group 'ledger-faces)
+
+(defface ledger-font-define-directive-face
+ `((t :inherit ledger-font-directive-face))
+ "Default face for other transactions"
+ :group 'ledger-faces)
+
+(defface ledger-font-end-directive-face
+ `((t :inherit ledger-font-directive-face))
+ "Default face for other transactions"
+ :group 'ledger-faces)
+
+(defface ledger-font-expr-directive-face
+ `((t :inherit ledger-font-directive-face))
+ "Default face for other transactions"
+ :group 'ledger-faces)
+
+(defface ledger-font-fixed-directive-face
+ `((t :inherit ledger-font-directive-face))
+ "Default face for other transactions"
+ :group 'ledger-faces)
+
+(defface ledger-font-include-directive-face
+ `((t :inherit ledger-font-directive-face))
+ "Default face for other transactions"
+ :group 'ledger-faces)
+
+(defface ledger-font-payee-directive-face
+ `((t :inherit ledger-font-directive-face))
+ "Default face for other transactions"
+ :group 'ledger-faces)
+
+(defface ledger-font-tag-directive-face
+ `((t :inherit ledger-font-directive-face))
+ "Default face for other transactions"
+ :group 'ledger-faces)
+
+(defface ledger-font-year-directive-face
+ `((t :inherit ledger-font-directive-face))
+ "Default face for other transactions"
+ :group 'ledger-faces)
+
(defface ledger-font-posting-account-face
`((t :foreground "#268bd2" ))
"Face for Ledger accounts"
@@ -64,11 +190,21 @@
"Face for Ledger accounts"
:group 'ledger-faces)
+(defface ledger-font-posting-amount-cleared-face
+ `((t :inherit ledger-font-posting-account-cleared-face))
+ "Face for Ledger accounts"
+ :group 'ledger-faces)
+
(defface ledger-font-posting-account-pending-face
`((t :inherit ledger-font-pending-face))
"Face for Ledger accounts"
:group 'ledger-faces)
+(defface ledger-font-posting-amount-pending-face
+ `((t :inherit ledger-font-posting-account-pending-face))
+ "Face for Ledger accounts"
+ :group 'ledger-faces)
+
(defface ledger-font-posting-amount-face
`((t :foreground "#cb4b16" ))
"Face for Ledger amounts"
@@ -80,18 +216,17 @@
:group 'ledger-faces)
(defface ledger-occur-narrowed-face
- `((t :foreground "grey70" :invisible t ))
+ `((t :inherit font-lock-comment-face :invisible t))
"Default face for Ledger occur mode hidden transactions"
:group 'ledger-faces)
(defface ledger-occur-xact-face
- `((((background dark)) :background "#1a1a1a" )
- (t :background "#eee8d5" ))
+ `((t :inherit highlight))
"Default face for Ledger occur mode shown transactions"
:group 'ledger-faces)
(defface ledger-font-comment-face
- `((t :foreground "#93a1a1" :slant italic))
+ `((t :inherit font-lock-comment-face))
"Face for Ledger comments"
:group 'ledger-faces)
@@ -115,30 +250,25 @@
"Default face for pending (!) transactions in the reconcile window"
:group 'ledger-faces)
+ (defvar ledger-font-lock-keywords
+ `(("account" . ledger-font-account-directive-face)
+ ("apply" . ledger-font-apply-directive-face)
+ ("alias" . ledger-font-alias-directive-face)
+ ("assert" . ledger-font-assert-directive-face)
+ ("bucket" . ledger-font-bucket-directive-face)
+ ("capture" . ledger-font-capture-directive-face)
+ ("check" . ledger-font-check-directive-face)
+ ("commodity" . ledger-font-commodity-directive-face)
+ ("define" . ledger-font-define-directive-face)
+ ("end" . ledger-font-end-directive-face)
+ ("expr" . ledger-font-expr-directive-face)
+ ("fixed" . ledger-font-fixed-directive-face)
+ ("include" . ledger-font-include-directive-face)
+ ("payee" . ledger-font-payee-directive-face)
+ ("tag" . ledger-font-tag-directive-face)
+ ("year" . ledger-font-year-directive-face))
+ "Expressions to highlight in Ledger mode.")
-(defvar ledger-font-lock-keywords
- `( ;; (,ledger-other-entries-regex 1
- ;; ledger-font-other-face)
- (,ledger-comment-regex 0
- 'ledger-font-comment-face)
- (,ledger-amount-regex 0
- 'ledger-font-posting-amount-face)
- (,ledger-multiline-comment-regex 0 'ledger-font-comment-face)
- (,ledger-payee-pending-regex 2
- 'ledger-font-payee-pending-face) ; Works
- (,ledger-payee-cleared-regex 2
- 'ledger-font-payee-cleared-face) ; Works
- (,ledger-payee-uncleared-regex 2
- 'ledger-font-payee-uncleared-face) ; Works
- (,ledger-account-cleared-regex 2
- 'ledger-font-posting-account-cleared-face) ; Works
- (,ledger-account-pending-regex 2
- 'ledger-font-posting-account-pending-face) ; Works
- (,ledger-account-any-status-regex 2
- 'ledger-font-posting-account-face) ; Works
- (,ledger-other-entries-regex 1
- 'ledger-font-other-face))
- "Expressions to highlight in Ledger mode.")
(provide 'ledger-fonts)
diff --git a/lisp/ledger-init.el b/lisp/ledger-init.el
index 491f20cf..49d74098 100644
--- a/lisp/ledger-init.el
+++ b/lisp/ledger-init.el
@@ -1,6 +1,6 @@
;;; ledger-init.el --- Helper code for use with the "ledger" command-line tool
-;; Copyright (C) 2003-2014 John Wiegley (johnw AT gnu DOT org)
+;; Copyright (C) 2003-2015 John Wiegley (johnw AT gnu DOT org)
;; This file is not part of GNU Emacs.
@@ -24,8 +24,10 @@
(require 'ledger-regex)
+;;; Code:
+
(defcustom ledger-init-file-name "~/.ledgerrc"
- "Location of the ledger initialization file. nil if you don't have one"
+ "Location of the ledger initialization file. nil if you don't have one."
:group 'ledger-exec)
(defvar ledger-environment-alist nil)
@@ -33,6 +35,7 @@
(defvar ledger-default-date-format "%Y/%m/%d")
(defun ledger-init-parse-initialization (buffer)
+ "Parse the .ledgerrc file in BUFFER."
(with-current-buffer buffer
(let (environment-alist)
(goto-char (point-min))
@@ -53,6 +56,7 @@
environment-alist)))
(defun ledger-init-load-init-file ()
+ "Load and parse the .ledgerrc file."
(interactive)
(let ((init-base-name (file-name-nondirectory ledger-init-file-name)))
(if (get-buffer init-base-name) ;; init file already loaded, parse it and leave it
diff --git a/lisp/ledger-mode.el b/lisp/ledger-mode.el
index 458c24b1..4e2beff6 100644
--- a/lisp/ledger-mode.el
+++ b/lisp/ledger-mode.el
@@ -1,6 +1,6 @@
;;; ledger-mode.el --- Helper code for use with the "ledger" command-line tool
-;; Copyright (C) 2003-2014 John Wiegley (johnw AT gnu DOT org)
+;; Copyright (C) 2003-2015 John Wiegley (johnw AT gnu DOT org)
;; This file is not part of GNU Emacs.
@@ -27,6 +27,7 @@
;;; Code:
(require 'ledger-regex)
+(require 'cus-edit)
(require 'esh-util)
(require 'esh-arg)
(require 'easymenu)
@@ -35,7 +36,9 @@
(require 'ledger-context)
(require 'ledger-exec)
(require 'ledger-fonts)
+(require 'ledger-fontify)
(require 'ledger-init)
+(require 'ledger-navigate)
(require 'ledger-occur)
(require 'ledger-post)
(require 'ledger-reconcile)
@@ -59,11 +62,12 @@
(defconst ledger-mode-version "3.0.0")
(defun ledger-mode-dump-variable (var)
- (if var
+ "Format VAR for dump to buffer."
+ (if var
(insert (format " %s: %S\n" (symbol-name var) (eval var)))))
(defun ledger-mode-dump-group (group)
- "Dump GROUP customizations to current buffer"
+ "Dump GROUP customizations to current buffer."
(let ((members (custom-group-members group nil)))
(dolist (member members)
(cond ((eq (cadr member) 'custom-group)
@@ -73,7 +77,7 @@
(ledger-mode-dump-variable (car member)))))))
(defun ledger-mode-dump-configuration ()
- "Dump all customizations"
+ "Dump all customizations."
(interactive)
(find-file "ledger-mode-dump")
(ledger-mode-dump-group 'ledger))
@@ -94,14 +98,15 @@
"Start a ledger session with the current month, but make it customizable to ease retro-entry.")
(defun ledger-read-account-with-prompt (prompt)
- (let* ((context (ledger-context-at-point))
- (default (if (eq (ledger-context-line-type context) 'acct-transaction)
- (regexp-quote (ledger-context-field-value context 'account))
- nil)))
- (ledger-read-string-with-default prompt default)))
+ "Read an account from the minibuffer with PROMPT."
+ (let ((context (ledger-context-at-point)))
+ (ledger-read-string-with-default prompt
+ (if (eq (ledger-context-current-field context) 'account)
+ (regexp-quote (ledger-context-field-value context 'account))
+ nil))))
(defun ledger-read-date (prompt)
- "Returns user-supplied date after `PROMPT', defaults to today."
+ "Return user-supplied date after `PROMPT', defaults to today."
(let* ((default (ledger-year-and-month))
(date (read-string prompt default
'ledger-minibuffer-history)))
@@ -146,7 +151,7 @@ And calculate the target-delta of the account being reconciled."
(message balance))))
(defun ledger-magic-tab (&optional interactively)
- "Decide what to with with <TAB>.
+ "Decide what to with with <TAB>, INTERACTIVELY.
Can indent, complete or align depending on context."
(interactive "p")
(if (= (point) (line-beginning-position))
@@ -164,14 +169,14 @@ Can indent, complete or align depending on context."
ledger-default-date-format)))
(defun ledger-remove-effective-date ()
- "Removes the effective date from a transaction or posting."
+ "Remove the effective date from a transaction or posting."
(interactive)
(let ((context (car (ledger-context-at-point))))
(save-excursion
(save-restriction
(narrow-to-region (point-at-bol) (point-at-eol))
(beginning-of-line)
- (cond ((eq 'pmnt-transaction context)
+ (cond ((eq 'xact context)
(re-search-forward ledger-iso-date-regexp)
(when (= (char-after) ?=)
(let ((eq-pos (point)))
@@ -194,7 +199,7 @@ If `DATE' is nil, prompt the user a date.
Replace the current effective date if there's one in the same
line.
-With a prefix argument, remove the effective date. "
+With a prefix argument, remove the effective date."
(interactive)
(if (and (listp current-prefix-arg)
(= 4 (prefix-numeric-value current-prefix-arg)))
@@ -204,7 +209,7 @@ With a prefix argument, remove the effective date. "
(save-restriction
(narrow-to-region (point-at-bol) (point-at-eol))
(cond
- ((eq 'pmnt-transaction context)
+ ((eq 'xact context)
(beginning-of-line)
(re-search-forward ledger-iso-date-regexp)
(when (= (char-after) ?=)
@@ -216,26 +221,35 @@ With a prefix argument, remove the effective date. "
(insert " ; [=" date-string "]")))))))
(defun ledger-mode-remove-extra-lines ()
- (goto-char (point-min))
+ "Get rid of multiple empty lines."
+ (goto-char (point-min))
(while (re-search-forward "\n\n\\(\n\\)+" nil t)
(replace-match "\n\n")))
(defun ledger-mode-clean-buffer ()
- "indent, remove multiple linfe feeds and sort the buffer"
+ "Indent, remove multiple line feeds and sort the buffer."
(interactive)
- (untabify (point-min) (point-max))
- (ledger-sort-buffer)
- (ledger-post-align-postings (point-min) (point-max))
- (ledger-mode-remove-extra-lines))
-
+ (let ((start (point-min-marker))
+ (end (point-max-marker)))
+ (goto-char start)
+ (ledger-navigate-beginning-of-xact)
+ (beginning-of-line)
+ (let ((target (buffer-substring (point) (progn
+ (end-of-line)
+ (point)))))
+ (untabify start end)
+ (ledger-sort-buffer)
+ (ledger-post-align-postings start end)
+ (ledger-mode-remove-extra-lines)
+ (goto-char start)
+ (search-forward target))))
(defvar ledger-mode-syntax-table
- (let ((table (make-syntax-table)))
- ;; Support comments via the syntax table
- (modify-syntax-entry ?\; "< b" table)
- (modify-syntax-entry ?\n "> b" table)
+ (let ((table (make-syntax-table text-mode-syntax-table)))
+ (modify-syntax-entry ?\; "<" table)
+ (modify-syntax-entry ?\n ">" table)
table)
- "Syntax table for `ledger-mode' buffers.")
+ "Syntax table in use in `ledger-mode' buffers.")
(defvar ledger-mode-map
(let ((map (make-sparse-keymap)))
@@ -269,8 +283,8 @@ With a prefix argument, remove the effective date. "
(define-key map [(control ?c) (control ?o) (control ?r)] 'ledger-report)
(define-key map [(control ?c) (control ?o) (control ?s)] 'ledger-report-save)
- (define-key map [(meta ?p)] 'ledger-post-prev-xact)
- (define-key map [(meta ?n)] 'ledger-post-next-xact)
+ (define-key map [(meta ?p)] 'ledger-navigate-prev-xact-or-directive)
+ (define-key map [(meta ?n)] 'ledger-navigate-next-xact-or-directive)
map)
"Keymap for `ledger-mode'.")
@@ -278,9 +292,10 @@ With a prefix argument, remove the effective date. "
"Ledger menu"
'("Ledger"
["Narrow to REGEX" ledger-occur]
+ ["Show all transactions" ledger-occur-mode ledger-occur-mode]
["Ledger Statistics" ledger-display-ledger-stats ledger-works]
"---"
- ["Show upcoming transactions" ledger-schedule-upcoming ledger-schedule-available]
+ ["Show upcoming transactions" ledger-schedule-upcoming]
["Add Transaction (ledger xact)" ledger-add-transaction ledger-works]
["Complete Transaction" ledger-fully-complete-xact]
["Delete Transaction" ledger-delete-current-transaction]
@@ -318,37 +333,25 @@ With a prefix argument, remove the effective date. "
(define-derived-mode ledger-mode text-mode "Ledger"
"A mode for editing ledger data files."
(ledger-check-version)
- (ledger-schedule-check-available)
- ;;(ledger-post-setup)
-
- (set-syntax-table ledger-mode-syntax-table)
- (set (make-local-variable 'comment-start) "; ")
- (set (make-local-variable 'comment-end) "")
- (set (make-local-variable 'indent-tabs-mode) nil)
-
- (if (boundp 'font-lock-defaults)
- (set (make-local-variable 'font-lock-defaults)
- '(ledger-font-lock-keywords nil t)))
- (setq font-lock-extend-region-functions
- (list #'font-lock-extend-region-wholelines))
- (setq font-lock-multiline nil)
-
- (set (make-local-variable 'pcomplete-parse-arguments-function)
- 'ledger-parse-arguments)
- (set (make-local-variable 'pcomplete-command-completion-function)
- 'ledger-complete-at-point)
+ (when (boundp 'font-lock-defaults)
+ (setq font-lock-defaults
+ '(ledger-font-lock-keywords t t nil nil
+ (font-lock-fontify-region-function . ledger-fontify-buffer-part))))
+
+ (set (make-local-variable 'pcomplete-parse-arguments-function) 'ledger-parse-arguments)
+ (set (make-local-variable 'pcomplete-command-completion-function) 'ledger-complete-at-point)
(add-hook 'completion-at-point-functions 'pcomplete-completions-at-point nil t)
(add-hook 'after-save-hook 'ledger-report-redo)
- ;(add-hook 'after-save-hook)
(add-hook 'post-command-hook 'ledger-highlight-xact-under-point nil t)
- (add-hook 'before-revert-hook 'ledger-occur-remove-all-overlays nil t)
(ledger-init-load-init-file)
+ (setq comment-start ";")
(set (make-local-variable 'indent-region-function) 'ledger-post-align-postings))
+
(defun ledger-set-year (newyear)
"Set ledger's idea of the current year to the prefix argument NEWYEAR."
(interactive "p")
diff --git a/lisp/ledger-navigate.el b/lisp/ledger-navigate.el
new file mode 100644
index 00000000..904faf8c
--- /dev/null
+++ b/lisp/ledger-navigate.el
@@ -0,0 +1,168 @@
+;;; ledger-navigate.el --- Provide navigation services through the ledger buffer.
+
+;; Copyright (C) 2014-2015 Craig Earls (enderw88 AT gmail DOT com)
+
+;; 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., 51 Franklin Street, Fifth Floor, Boston,
+;; MA 02110-1301 USA.
+
+
+;;; Commentary:
+;;
+
+;;; Code:
+
+(require 'ledger-regex)
+(require 'ledger-context)
+
+(defun ledger-navigate-next-xact ()
+ "Move point to beginning of next xact."
+ ;; make sure we actually move to the next xact, even if we are the
+ ;; beginning of one now.
+ (if (looking-at ledger-payee-any-status-regex)
+ (forward-line))
+ (if (re-search-forward ledger-payee-any-status-regex nil t)
+ (goto-char (match-beginning 0))
+ (goto-char (point-max))))
+
+(defun ledger-navigate-start-xact-or-directive-p ()
+ "Return t if at the beginning of an empty or all-whitespace line."
+ (not (looking-at "[ \t]\\|\\(^$\\)")))
+
+(defun ledger-navigate-next-xact-or-directive ()
+ "Move to the beginning of the next xact or directive."
+ (interactive)
+ (beginning-of-line)
+ (if (ledger-navigate-start-xact-or-directive-p) ; if we are the start of an xact, move forward to the next xact
+ (progn
+ (forward-line)
+ (if (not (ledger-navigate-start-xact-or-directive-p)) ; we have moved forward and are not at another xact, recurse forward
+ (ledger-navigate-next-xact-or-directive)))
+ (while (not (or (eobp) ; we didn't start off at the beginning of an xact
+ (ledger-navigate-start-xact-or-directive-p)))
+ (forward-line))))
+
+(defun ledger-navigate-prev-xact-or-directive ()
+ "Move point to beginning of previous xact."
+ (interactive)
+ (let ((context (car (ledger-context-at-point))))
+ (when (equal context 'acct-transaction)
+ (ledger-navigate-beginning-of-xact))
+ (beginning-of-line)
+ (re-search-backward "^[[:graph:]]" nil t)))
+
+(defun ledger-navigate-beginning-of-xact ()
+ "Move point to the beginning of the current xact."
+ (interactive)
+ ;; need to start at the beginning of a line incase we are in the first line of an xact already.
+ (beginning-of-line)
+ (let ((sreg (concat "^\\(=\\|~\\|" ledger-iso-date-regexp "\\)")))
+ (unless (looking-at sreg)
+ (re-search-backward sreg nil t)
+ (beginning-of-line)))
+ (point))
+
+(defun ledger-navigate-end-of-xact ()
+ "Move point to end of xact."
+ (interactive)
+ (ledger-navigate-next-xact-or-directive)
+ (re-search-backward ".$")
+ (end-of-line)
+ (point))
+
+(defun ledger-navigate-to-line (line-number)
+ "Rapidly move point to line LINE-NUMBER."
+ (goto-char (point-min))
+ (forward-line (1- line-number)))
+
+(defun ledger-navigate-find-xact-extents (pos)
+ "Return list containing point for beginning and end of xact containing POS.
+Requires empty line separating xacts."
+ (interactive "d")
+ (save-excursion
+ (goto-char pos)
+ (list (ledger-navigate-beginning-of-xact)
+ (ledger-navigate-end-of-xact))))
+
+(defun ledger-navigate-find-directive-extents (pos)
+ "Return the extents of the directive at POS."
+ (goto-char pos)
+ (let ((begin (progn (beginning-of-line)
+ (point)))
+ (end (progn (end-of-line)
+ (+ 1 (point)))))
+ ;; handle block comments here
+ (beginning-of-line)
+ (if (looking-at " *;")
+ (progn
+ (while (and (looking-at " *;")
+ (> (point) (point-min)))
+ (forward-line -1))
+ ;; We are either at the beginning of the buffer, or we found
+ ;; a line outside the comment. If we are not at the
+ ;; beginning of the buffer then we need to move forward a
+ ;; line.
+ (if (> (point) (point-min))
+ (progn (forward-line 1)
+ (beginning-of-line)))
+ (setq begin (point))
+ (goto-char pos)
+ (beginning-of-line)
+ (while (and (looking-at " *;")
+ (< (point) (point-max)))
+ (forward-line 1))
+ (setq end (point))))
+ (list begin end)))
+
+(defun ledger-navigate-block-comment (pos)
+ "Move past the block comment at POS, and return its extents."
+ (interactive "d")
+ (goto-char pos)
+ (let ((begin (progn (beginning-of-line)
+ (point)))
+ (end (progn (end-of-line)
+ (point))))
+ ;; handle block comments here
+ (beginning-of-line)
+ (if (looking-at " *;")
+ (progn
+ (while (and (looking-at " *;")
+ (> (point) (point-min)))
+ (forward-line -1))
+ (setq begin (point))
+ (goto-char pos)
+ (beginning-of-line)
+ (while (and (looking-at " *;")
+ (< (point) (point-max)))
+ (forward-line 1))
+ (setq end (point))))
+ (list begin end)))
+
+
+(defun ledger-navigate-find-element-extents (pos)
+ "Return list containing beginning and end of the entity surrounding POS."
+ (interactive "d")
+ (save-excursion
+ (goto-char pos)
+ (beginning-of-line)
+ (if (looking-at "[ =~0-9]")
+ (ledger-navigate-find-xact-extents pos)
+ (ledger-navigate-find-directive-extents pos))))
+
+
+(provide 'ledger-navigate)
+
+;;; ledger-navigate.el ends here
diff --git a/lisp/ledger-occur.el b/lisp/ledger-occur.el
index 9287ed13..a4fde2e1 100644
--- a/lisp/ledger-occur.el
+++ b/lisp/ledger-occur.el
@@ -1,6 +1,6 @@
-;;; ledger-mode.el --- Helper code for use with the "ledger" command-line tool
+;;; ledger-occur.el --- Helper code for use with the "ledger" command-line tool
-;; Copyright (C) 2003-2014 John Wiegley (johnw AT gnu DOT org)
+;; Copyright (C) 2003-2015 John Wiegley (johnw AT gnu DOT org)
;; This file is not part of GNU Emacs.
@@ -29,6 +29,9 @@
;;; Code:
+(require 'cl)
+(require 'ledger-navigate)
+
(defconst ledger-occur-overlay-property-name 'ledger-occur-custom-buffer-grep)
(defcustom ledger-occur-use-face-shown t
@@ -38,78 +41,66 @@
(make-variable-buffer-local 'ledger-occur-use-face-shown)
-(defvar ledger-occur-mode nil
- "name of the minor mode, shown in the mode-line")
+(defvar ledger-occur-history nil
+ "History of previously searched expressions for the prompt.")
-(make-variable-buffer-local 'ledger-occur-mode)
+(defvar ledger-occur-current-regex nil
+ "Pattern currently applied to narrow the buffer.")
+(make-variable-buffer-local 'ledger-occur-current-regex)
-(or (assq 'ledger-occur-mode minor-mode-alist)
- (nconc minor-mode-alist
- (list '(ledger-occur-mode ledger-occur-mode))))
+(defvar ledger-occur-mode-map (make-sparse-keymap))
-(defvar ledger-occur-history nil
- "History of previously searched expressions for the prompt.")
+(define-minor-mode ledger-occur-mode
+ "A minor mode which display only transactions matching `ledger-occur-current-regex'."
+ nil
+ (:eval (format " Ledger-Narrow(%s)" ledger-occur-current-regex))
+ ledger-occur-mode-map
+ (if (and ledger-occur-current-regex ledger-occur-mode)
+ (ledger-occur-refresh)
+ (ledger-occur-remove-overlays)
+ (message "Showing all transactions")))
-(defvar ledger-occur-last-match nil
- "Last match found.")
-(make-variable-buffer-local 'ledger-occur-last-match)
+(define-key ledger-occur-mode-map (kbd "C-c C-g") 'ledger-occur-refresh)
+(define-key ledger-occur-mode-map (kbd "C-c C-f") 'ledger-occur-mode)
-(defun ledger-occur-remove-all-overlays ()
- "Remove all overlays from the ledger buffer."
+(defun ledger-occur-refresh ()
+ "Re-apply the current narrowing expression."
(interactive)
- (remove-overlays))
-
-(defun ledger-occur-mode (regex buffer)
- "Highlight transactions that match REGEX in BUFFER, hiding others.
-
-When REGEX is nil, unhide everything, and remove higlight"
- (set-buffer buffer)
- (setq ledger-occur-mode
- (if (or (null regex)
- (zerop (length regex)))
- nil
- (concat " Ledger-Narrowed: " regex)))
- (force-mode-line-update)
- (ledger-occur-remove-overlays)
- (when ledger-occur-mode
- (ledger-occur-create-overlays
- (ledger-occur-compress-matches
- (ledger-occur-find-matches regex)))
- (setq ledger-occur-last-match regex)
- (if (get-buffer-window buffer)
- (select-window (get-buffer-window buffer))))
- (recenter))
+ (let ((matches (ledger-occur-compress-matches
+ (ledger-occur-find-matches ledger-occur-current-regex))))
+ (if matches
+ (ledger-occur-create-overlays matches)
+ (message "No matches found for '%s'" ledger-occur-current-regex)
+ (ledger-occur-mode -1))))
(defun ledger-occur (regex)
- "Perform a simple grep in current buffer for the regular expression REGEX.
+ "Show only transactions in the current buffer which match 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"
+This command hides all xact in the current buffer except those
+matching REGEX. If REGEX is nil or empty, turn off any narrowing
+currently active."
(interactive
- (if ledger-occur-mode
- (list nil)
- (list (read-string (concat "Regexp<" (ledger-occur-prompt) ">: ")
- nil 'ledger-occur-history (ledger-occur-prompt)))))
- (ledger-occur-mode regex (current-buffer)))
+ (list (read-regexp "Regexp" (ledger-occur-prompt) 'ledger-occur-history)))
+ (if (or (null regex)
+ (zerop (length regex))) ; empty regex, or already have narrowed, clear narrowing
+ (ledger-occur-mode -1)
+ (setq ledger-occur-current-regex regex)
+ (ledger-occur-mode 1)))
(defun ledger-occur-prompt ()
"Return the default value of the prompt.
Default value for prompt is a current word or active
region(selection), if its size is 1 line"
- (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))
+ (if (use-region-p)
+ (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)))
(defun ledger-occur-make-visible-overlay (beg end)
@@ -127,6 +118,7 @@ When REGEX is nil, unhide everything, and remove higlight"
Argument OVL-BOUNDS contains bounds for the transactions to be left visible."
(let* ((beg (caar ovl-bounds))
(end (cadar ovl-bounds)))
+ (ledger-occur-remove-overlays)
(ledger-occur-make-invisible-overlay (point-min) (1- beg))
(dolist (visible (cdr ovl-bounds))
(ledger-occur-make-visible-overlay beg end)
@@ -135,15 +127,6 @@ Argument OVL-BOUNDS contains bounds for the transactions to be left visible."
(setq end (cadr visible)))
(ledger-occur-make-invisible-overlay (1+ end) (point-max))))
-(defun ledger-occur-quit-buffer (buffer)
- "Quits hidings transaction in the given BUFFER.
-Used for coordinating `ledger-occur' with other buffers, like reconcile."
- (set-buffer buffer)
- (setq ledger-occur-mode nil)
- (force-mode-line-update)
- (ledger-occur-remove-overlays)
- (recenter))
-
(defun ledger-occur-remove-overlays ()
"Remove the transaction hiding overlays."
(interactive)
@@ -155,36 +138,30 @@ Used for coordinating `ledger-occur' with other buffers, like reconcile."
(save-excursion
(goto-char (point-min))
;; Set initial values for variables
- (let (curpoint
- endpoint
- (lines (list)))
+ (let (endpoint lines bounds)
;; 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-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)))))
+ (setq bounds (ledger-navigate-find-element-extents endpoint))
+ (push bounds lines)
+ ;; move to the end of the xact, no need to search inside it more
+ (goto-char (cadr bounds))))
+ (nreverse lines))))
(defun ledger-occur-compress-matches (buffer-matches)
"identify sequential xacts to reduce number of overlays required"
- (let ((points (list))
- (current-beginning (caar buffer-matches))
- (current-end (cadar buffer-matches)))
- (dolist (match (cdr buffer-matches))
- (if (< (- (car match) current-end) 2)
- (setq current-end (cadr match))
- (push (list current-beginning current-end) points)
- (setq current-beginning (car match))
- (setq current-end (cadr match))))
- (nreverse (push (list current-beginning current-end) points))))
+ (if buffer-matches
+ (let ((points (list))
+ (current-beginning (caar buffer-matches))
+ (current-end (cadar buffer-matches)))
+ (dolist (match (cdr buffer-matches))
+ (if (< (- (car match) current-end) 2)
+ (setq current-end (cadr match))
+ (push (list current-beginning current-end) points)
+ (setq current-beginning (car match))
+ (setq current-end (cadr match))))
+ (nreverse (push (list current-beginning current-end) points)))))
(provide 'ledger-occur)
diff --git a/lisp/ledger-post.el b/lisp/ledger-post.el
index ac040bb2..e0c7aaee 100644
--- a/lisp/ledger-post.el
+++ b/lisp/ledger-post.el
@@ -1,6 +1,6 @@
;;; ledger-post.el --- Helper code for use with the "ledger" command-line tool
-;; Copyright (C) 2003-2014 John Wiegley (johnw AT gnu DOT org)
+;; Copyright (C) 2003-2015 John Wiegley (johnw AT gnu DOT org)
;; This file is not part of GNU Emacs.
@@ -42,7 +42,7 @@
:group 'ledger-post)
(defcustom ledger-post-use-completion-engine :built-in
- "Which completion engine to use, :iswitchb or :ido chose those engines,
+ "Which completion engine to use, :iswitchb or :ido chose those engines.
:built-in uses built-in Ledger-mode completion"
:type '(radio (const :tag "built in completion" :built-in)
(const :tag "ido completion" :ido)
@@ -82,9 +82,8 @@ point at beginning of the commodity."
(- (or (match-end 4)
(match-end 3)) (point)))))
-
(defun ledger-next-account (&optional end)
- "Move point to the beginning of the next account, or status marker (!*), as long as it is not past END.
+ "Move to the beginning of the posting, or status marker, limit to END.
Return the column of the beginning of the account and leave point
at beginning of account"
(if (> end (point))
@@ -96,13 +95,13 @@ at beginning of account"
(current-column))))
(defun ledger-post-align-xact (pos)
- (interactive "d")
- (let ((bounds (ledger-find-xact-extents pos)))
+ "Align all the posting in the xact at POS."
+ (interactive "d")
+ (let ((bounds (ledger-navigate-find-xact-extents pos)))
(ledger-post-align-postings (car bounds) (cadr bounds))))
(defun ledger-post-align-postings (&optional beg end)
- "Align all accounts and amounts within region, if there is no
-region align the posting on the current line."
+ "Align all accounts and amounts between BEG and END, or the current line."
(interactive)
(save-excursion
@@ -110,62 +109,51 @@ region align the posting on the current line."
(not (use-region-p)))
(set-mark (point)))
- (let* ((inhibit-modification-hooks t)
- (mark-first (< (mark) (point)))
- (begin-region (if beg
- beg
- (if mark-first (mark) (point))))
- (end-region (if end
- end
- (if mark-first (point) (mark))))
- acct-start-column acct-end-column acct-adjust amt-width amt-adjust
- (lines-left 1))
- ;; Condition point and mark to the beginning and end of lines
- (goto-char end-region)
- (setq end-region (line-end-position))
- (goto-char begin-region)
- (goto-char
- (setq begin-region
- (line-beginning-position)))
-
- (untabify begin-region end-region)
-
- (goto-char end-region)
- (setq end-region (line-end-position))
- (goto-char begin-region)
- (goto-char
- (setq begin-region
- (line-beginning-position)))
-
- ;; This is the guts of the alignment loop
- (while (and (or (setq acct-start-column (ledger-next-account (line-end-position)))
- lines-left)
- (< (point) end-region))
- (when acct-start-column
- (setq acct-end-column (save-excursion
- (goto-char (match-end 2))
- (current-column)))
- (when (/= (setq acct-adjust (- ledger-post-account-alignment-column acct-start-column)) 0)
- (setq acct-end-column (+ acct-end-column acct-adjust)) ;;adjust the account ending column
- (if (> acct-adjust 0)
- (insert (make-string acct-adjust ? ))
- (delete-char acct-adjust)))
- (when (setq amt-width (ledger-next-amount (line-end-position)))
- (if (/= 0 (setq amt-adjust (- (if (> (- ledger-post-amount-alignment-column amt-width)
- (+ 2 acct-end-column))
- ledger-post-amount-alignment-column ;;we have room
- (+ acct-end-column 2 amt-width))
- amt-width
- (current-column))))
- (if (> amt-adjust 0)
- (insert (make-string amt-adjust ? ))
- (delete-char amt-adjust)))))
- (forward-line)
- (setq lines-left (not (eobp))))
+ (let ((inhibit-modification-hooks t)
+ (mark-first (< (mark) (point)))
+ acct-start-column acct-end-column acct-adjust amt-width amt-adjust
+ (lines-left 1))
+
+ (unless beg (setq beg (if mark-first (mark) (point))))
+ (unless end (setq end (if mark-first (mark) (point))))
+
+ ;; Extend region to whole lines
+ (let ((start-marker (set-marker (make-marker) (save-excursion
+ (goto-char beg)
+ (line-beginning-position))))
+ (end-marker (set-marker (make-marker) (save-excursion
+ (goto-char end)
+ (line-end-position)))))
+ (untabify start-marker end-marker)
+ (goto-char start-marker)
+
+ ;; This is the guts of the alignment loop
+ (while (and (or (setq acct-start-column (ledger-next-account (line-end-position)))
+ lines-left)
+ (< (point) end-marker))
+ (when acct-start-column
+ (setq acct-end-column (save-excursion
+ (goto-char (match-end 2))
+ (current-column)))
+ (when (/= (setq acct-adjust (- ledger-post-account-alignment-column acct-start-column)) 0)
+ (setq acct-end-column (+ acct-end-column acct-adjust)) ;;adjust the account ending column
+ (if (> acct-adjust 0)
+ (insert (make-string acct-adjust ? ))
+ (delete-char acct-adjust)))
+ (when (setq amt-width (ledger-next-amount (line-end-position)))
+ (if (/= 0 (setq amt-adjust (- (if (> (- ledger-post-amount-alignment-column amt-width)
+ (+ 2 acct-end-column))
+ ledger-post-amount-alignment-column ;;we have room
+ (+ acct-end-column 2 amt-width))
+ amt-width
+ (current-column))))
+ (if (> amt-adjust 0)
+ (insert (make-string amt-adjust ? ))
+ (delete-char amt-adjust)))))
+ (forward-line)
+ (setq lines-left (not (eobp)))))
(setq inhibit-modification-hooks nil))))
-
-
(defun ledger-post-edit-amount ()
"Call 'calc-mode' and push the amount in the posting to the top of stack."
(interactive)
@@ -186,24 +174,6 @@ region align the posting on the current line."
(insert " "))
(calc))))))
-(defun ledger-post-prev-xact ()
- "Move point to the previous transaction."
- (interactive)
- (backward-paragraph)
- (when (re-search-backward ledger-xact-line-regexp nil t)
- (goto-char (match-beginning 0))
- (re-search-forward ledger-post-line-regexp)
- (goto-char (match-end ledger-regex-post-line-group-account))))
-
-(defun ledger-post-next-xact ()
- "Move point to the next transaction."
- (interactive)
- (when (re-search-forward ledger-xact-line-regexp nil t)
- (goto-char (match-beginning 0))
- (re-search-forward ledger-post-line-regexp)
- (goto-char (match-end ledger-regex-post-line-group-account))))
-
-
(provide 'ledger-post)
diff --git a/lisp/ledger-reconcile.el b/lisp/ledger-reconcile.el
index 48d54eb0..80e27ae3 100644
--- a/lisp/ledger-reconcile.el
+++ b/lisp/ledger-reconcile.el
@@ -1,6 +1,6 @@
;;; ledger-reconcile.el --- Helper code for use with the "ledger" command-line tool
-;; Copyright (C) 2003-2014 John Wiegley (johnw AT gnu DOT org)
+;; Copyright (C) 2003-2015 John Wiegley (johnw AT gnu DOT org)
;; This file is not part of GNU Emacs.
@@ -44,8 +44,7 @@
:group 'ledger-reconcile)
(defcustom ledger-narrow-on-reconcile t
- "If t, limit transactions shown in main buffer to those
-matching the reconcile regex."
+ "If t, limit transactions shown in main buffer to those matching the reconcile regex."
:type 'boolean
:group 'ledger-reconcile)
@@ -56,8 +55,7 @@ Then that transaction will be shown in its source buffer."
:group 'ledger-reconcile)
(defcustom ledger-reconcile-force-window-bottom nil
- "If t make the reconcile window appear along the bottom of the
-register window and resize."
+ "If t make the reconcile window appear along the bottom of the register window and resize."
:type 'boolean
:group 'ledger-reconcile)
@@ -68,25 +66,26 @@ reconcile-finish will mark all pending posting cleared."
:group 'ledger-reconcile)
(defcustom ledger-reconcile-default-date-format ledger-default-date-format
- "Default date format for the reconcile buffer"
+ "Default date format for the reconcile buffer."
:type 'string
:group 'ledger-reconcile)
(defcustom ledger-reconcile-target-prompt-string "Target amount for reconciliation "
- "Default prompt for recon target prompt"
+ "Default prompt for recon target prompt."
:type 'string
:group 'ledger-reconcile)
(defcustom ledger-reconcile-buffer-header "Reconciling account %s\n\n"
- "Default header string for the reconcile buffer. If non-nil,
- the name of the account being reconciled will be substituted
+ "Default header string for the reconcile buffer.
+
+If non-nil, the name of the account being reconciled will be substituted
into the '%s'. If nil, no header willbe displayed."
:type 'string
:group 'ledger-reconcile)
(defcustom ledger-reconcile-buffer-line-format "%(date)s %-4(code)s %-50(payee)s %-30(account)s %15(amount)s\n"
- "Format string for the ledger reconcile posting
-format. Available fields are date, status, code, payee, account,
+ "Format string for the ledger reconcile posting format.
+Available fields are date, status, code, payee, account,
amount. The format for each field is %WIDTH(FIELD), WIDTH can be
preced by a minus sign which mean to left justify and pad the
field."
@@ -94,8 +93,9 @@ field."
:group 'ledger-reconcile)
(defcustom ledger-reconcile-sort-key "(0)"
- "Default key for sorting reconcile buffer. Possible values are
-'(date)', '(amount)', '(payee)'. For no sorting, i.e. using
+ "Default key for sorting reconcile buffer.
+
+Possible values are '(date)', '(amount)', '(payee)'. For no sorting, i.e. using
ledger file order, use '(0)'."
:type 'string
:group 'ledger-reconcile)
@@ -106,7 +106,7 @@ ledger file order, use '(0)'."
:group 'ledger-reconcile)
(defun ledger-reconcile-get-cleared-or-pending-balance (buffer account)
- "Calculate the cleared or pending balance of the account."
+ "Use BUFFER to Calculate the cleared or pending balance of the ACCOUNT."
;; these vars are buffer local, need to hold them for use in the
;; temp buffer below
@@ -118,7 +118,7 @@ ledger file order, use '(0)'."
;; specify the individual fields in the command line.
(if (ledger-exec-ledger buffer (current-buffer)
"balance" "--limit" "cleared or pending" "--empty" "--collapse"
- "--format" "%(display_total)" account)
+ "--format" "%(scrub(display_total))" account)
(ledger-split-commodity-string
(buffer-substring-no-properties (point-min) (point-max))))))
@@ -157,7 +157,7 @@ And calculate the target-delta of the account being reconciled."
status)
(when (ledger-reconcile-get-buffer where)
(with-current-buffer (ledger-reconcile-get-buffer where)
- (ledger-goto-line (cdr where))
+ (ledger-navigate-to-line (cdr where))
(forward-char)
(setq status (ledger-toggle-current (if ledger-reconcile-toggle-to-pending
'pending
@@ -197,15 +197,16 @@ Return the number of uncleared xacts found."
(defun ledger-reconcile-refresh-after-save ()
"Refresh the recon-window after the ledger buffer is saved."
- (let ((curbuf (current-buffer))
+ (let ((curbufwin (get-buffer-window (current-buffer)))
(curpoint (point))
(recon-buf (get-buffer ledger-recon-buffer-name)))
(when (buffer-live-p recon-buf)
(with-current-buffer recon-buf
(ledger-reconcile-refresh)
(set-buffer-modified-p nil))
- (select-window (get-buffer-window curbuf))
- (goto-char curpoint))))
+ (when curbufwin
+ (select-window curbufwin)
+ (goto-char curpoint)))))
(defun ledger-reconcile-add ()
"Use ledger xact to add a new transaction."
@@ -220,7 +221,7 @@ Return the number of uncleared xacts found."
(let ((where (get-text-property (point) 'where)))
(when (ledger-reconcile-get-buffer where)
(with-current-buffer (ledger-reconcile-get-buffer where)
- (ledger-goto-line (cdr where))
+ (ledger-navigate-to-line (cdr where))
(ledger-delete-current-transaction (point)))
(let ((inhibit-read-only t))
(goto-char (line-beginning-position))
@@ -231,22 +232,22 @@ Return the number of uncleared xacts found."
(defun ledger-reconcile-visit (&optional come-back)
"Recenter ledger buffer on transaction and COME-BACK if non-nil."
(interactive)
- (progn
- (beginning-of-line)
- (let* ((where (get-text-property (1+ (point)) 'where))
- (target-buffer (if where
- (ledger-reconcile-get-buffer where)
- nil))
- (cur-win (get-buffer-window (get-buffer ledger-recon-buffer-name))))
- (when target-buffer
- (switch-to-buffer-other-window target-buffer)
- (ledger-goto-line (cdr where))
- (forward-char)
- (recenter)
- (ledger-highlight-xact-under-point)
- (forward-char -1)
- (if (and come-back cur-win)
- (select-window cur-win))))))
+ (beginning-of-line)
+ (let* ((where (get-text-property (1+ (point)) 'where))
+ (target-buffer (if where
+ (ledger-reconcile-get-buffer where)
+ nil))
+ (cur-win (get-buffer-window (get-buffer ledger-recon-buffer-name))))
+ (when target-buffer
+ (switch-to-buffer-other-window target-buffer)
+ (ledger-navigate-to-line (cdr where))
+ (forward-char)
+ (recenter)
+ (ledger-highlight-xact-under-point)
+ (forward-char -1)
+ (when (and come-back cur-win)
+ (select-window cur-win)
+ (get-buffer ledger-recon-buffer-name)))))
(defun ledger-reconcile-save ()
@@ -273,7 +274,7 @@ and exit reconcile mode"
(face (get-text-property (point) 'face)))
(if (eq face 'ledger-font-reconciler-pending-face)
(with-current-buffer (ledger-reconcile-get-buffer where)
- (ledger-goto-line (cdr where))
+ (ledger-navigate-to-line (cdr where))
(ledger-toggle-current 'cleared))))
(forward-line 1)))
(ledger-reconcile-save)
@@ -303,7 +304,7 @@ and exit reconcile mode"
(with-current-buffer buf
(remove-hook 'after-save-hook 'ledger-reconcile-refresh-after-save t)
(when ledger-narrow-on-reconcile
- (ledger-occur-quit-buffer buf)
+ (ledger-occur-mode -1)
(ledger-highlight-xact-under-point))))))
(defun ledger-marker-where-xact-is (emacs-xact posting)
@@ -319,7 +320,7 @@ POSTING is used in `ledger-clear-whole-transactions' is nil."
(nth 0 posting))))) ;; return line-no of posting
(defun ledger-reconcile-compile-format-string (fstr)
- "return a function that implements the format string in fstr"
+ "Return a function that implements the format string in FSTR."
(let (fields
(start 0))
(while (string-match "(\\(.*?\\))" fstr start)
@@ -332,6 +333,7 @@ POSTING is used in `ledger-clear-whole-transactions' is nil."
(defun ledger-reconcile-format-posting (beg where fmt date code status payee account amount)
+ "Format posting for the reconcile buffer."
(insert (funcall fmt date code status payee account amount))
; Set face depending on cleared status
@@ -348,6 +350,7 @@ POSTING is used in `ledger-clear-whole-transactions' is nil."
'where where))))
(defun ledger-reconcile-format-xact (xact fmt)
+ "Format XACT using FMT."
(let ((date-format (or (cdr (assoc "date-format" ledger-environment-alist))
ledger-default-date-format)))
(dolist (posting (nthcdr 5 xact))
@@ -364,7 +367,8 @@ POSTING is used in `ledger-clear-whole-transactions' is nil."
(nth 2 posting)))))) ; amount
(defun ledger-do-reconcile (&optional sort)
- "Return the number of uncleared transactions in the account and display them in the *Reconcile* buffer."
+ "SORT the uncleared transactions in the account and display them in the *Reconcile* buffer.
+Return a count of the uncleared transactions."
(let* ((buf ledger-buf)
(account ledger-acct)
(ledger-success nil)
@@ -399,9 +403,8 @@ POSTING is used in `ledger-clear-whole-transactions' is nil."
(length xacts)))
(defun ledger-reconcile-ensure-xacts-visible ()
- "Ensures that the last of the visible transactions in the
-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
+ "Ensure the last of the visible transactions in the 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
moved and recentered. If they aren't strange things happen."
(let ((recon-window (get-buffer-window (get-buffer ledger-recon-buffer-name))))
@@ -436,6 +439,13 @@ moved and recentered. If they aren't strange things happen."
(set-window-buffer (split-window (get-buffer-window buf) nil nil) rbuf)
(pop-to-buffer rbuf)))
+(defun ledger-reconcile-check-valid-account (account)
+ "Check to see if ACCOUNT exists in the ledger file"
+ (if (> (length account) 0)
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward account nil t))))
+
(defun ledger-reconcile ()
"Start reconciling, prompt for account."
(interactive)
@@ -443,37 +453,38 @@ moved and recentered. If they aren't strange things happen."
(buf (current-buffer))
(rbuf (get-buffer ledger-recon-buffer-name)))
- (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t)
-
- (if rbuf ;; *Reconcile* already exists
- (with-current-buffer rbuf
- (set 'ledger-acct account) ;; already buffer local
- (when (not (eq buf rbuf))
- ;; called from some other ledger-mode buffer
- (ledger-reconcile-quit-cleanup)
- (setq ledger-buf buf)) ;; should already be buffer-local
-
- (unless (get-buffer-window rbuf)
- (ledger-reconcile-open-windows buf rbuf)))
-
- ;; no recon-buffer, starting from scratch.
-
- (with-current-buffer (setq rbuf
- (get-buffer-create ledger-recon-buffer-name))
- (ledger-reconcile-open-windows buf rbuf)
- (ledger-reconcile-mode)
- (make-local-variable 'ledger-target)
- (set (make-local-variable 'ledger-buf) buf)
- (set (make-local-variable 'ledger-acct) account)))
-
- ;; Narrow the ledger buffer
- (with-current-buffer rbuf
- (save-excursion
- (if ledger-narrow-on-reconcile
- (ledger-occur-mode account ledger-buf)))
- (if (> (ledger-reconcile-refresh) 0)
- (ledger-reconcile-change-target))
- (ledger-display-balance))))
+ (when (ledger-reconcile-check-valid-account account)
+ (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t)
+
+ (if rbuf ;; *Reconcile* already exists
+ (with-current-buffer rbuf
+ (set 'ledger-acct account) ;; already buffer local
+ (when (not (eq buf rbuf))
+ ;; called from some other ledger-mode buffer
+ (ledger-reconcile-quit-cleanup)
+ (setq ledger-buf buf)) ;; should already be buffer-local
+
+ (unless (get-buffer-window rbuf)
+ (ledger-reconcile-open-windows buf rbuf)))
+
+ ;; no recon-buffer, starting from scratch.
+
+ (with-current-buffer (setq rbuf
+ (get-buffer-create ledger-recon-buffer-name))
+ (ledger-reconcile-open-windows buf rbuf)
+ (ledger-reconcile-mode)
+ (make-local-variable 'ledger-target)
+ (set (make-local-variable 'ledger-buf) buf)
+ (set (make-local-variable 'ledger-acct) account)))
+
+ ;; Narrow the ledger buffer
+ (with-current-buffer rbuf
+ (save-excursion
+ (if ledger-narrow-on-reconcile
+ (ledger-occur account)))
+ (if (> (ledger-reconcile-refresh) 0)
+ (ledger-reconcile-change-target))
+ (ledger-display-balance)))))
(defvar ledger-reconcile-mode-abbrev-table)
@@ -483,7 +494,8 @@ moved and recentered. If they aren't strange things happen."
(setq ledger-target (ledger-read-commodity-string ledger-reconcile-target-prompt-string)))
(defmacro ledger-reconcile-change-sort-key-and-refresh (sort-by)
- `(lambda ()
+ "Set the sort-key to SORT-BY."
+ `(lambda ()
(interactive)
(setq ledger-reconcile-sort-key ,sort-by)
diff --git a/lisp/ledger-regex.el b/lisp/ledger-regex.el
index bb080b94..41231845 100644
--- a/lisp/ledger-regex.el
+++ b/lisp/ledger-regex.el
@@ -1,6 +1,6 @@
;;; ledger-regex.el --- Helper code for use with the "ledger" command-line tool
-;; Copyright (C) 2003-2014 John Wiegley (johnw AT gnu DOT org)
+;; Copyright (C) 2003-2015 John Wiegley (johnw AT gnu DOT org)
;; This file is not part of GNU Emacs.
@@ -26,10 +26,10 @@
(defconst ledger-amount-regex
(concat "\\( \\|\t\\| \t\\)[ \t]*-?"
- "\\([A-Z$€£_]+ *\\)?"
+ "\\([A-Z$€£₹_(]+ *\\)?"
"\\(-?[0-9,\\.]+?\\)"
- "\\(.[0-9]+\\)?"
- "\\( *[[:word:]€£_\"]+\\)?"
+ "\\(.[0-9)]+\\)?"
+ "\\( *[[:word:]€£₹_\"]+\\)?"
"\\([ \t]*[@={]@?[^\n;]+?\\)?"
"\\([ \t]+;.+?\\|[ \t]*\\)?$"))
@@ -329,7 +329,33 @@
ledger-iso-date-regexp
"\\([ *!]+\\)" ;; mark
"\\((.*)\\)?" ;; code
- "\\(.*\\)" ;; desc
+ "\\([[:word:] ]+\\)" ;; desc
"\\)"))
+(defconst ledger-xact-start-regex
+ (concat "^" ledger-iso-date-regexp ;; subexp 1
+ "\\(=" ledger-iso-date-regexp "\\)?"
+ ))
+
+(defconst ledger-xact-after-date-regex
+ (concat "\\([ \t]+[*!]\\)?" ;; mark, subexp 1
+ "\\([ \t]+(.*?)\\)?" ;; code, subexp 2
+ "\\([ \t]+[^;\n]+\\)" ;; desc, subexp 3
+ "\\(;[^\n]*\\)?" ;; comment, subexp 4
+ ))
+
+(defconst ledger-posting-regex
+ (concat "^[ \t]+ ?" ;; initial white space
+ "\\([*!]\\)? ?" ;; state, subexpr 1
+ "\\([[:print:]]+\\([ \t][ \t]\\)\\)" ;; account, subexpr 2
+ "\\([^;\n]*\\)" ;; amount, subexpr 4
+ "\\(.*\\)" ;; comment, subexpr 5
+ ))
+
+
+
+(defconst ledger-directive-start-regex
+ "[=~;#%|\\*[A-Za-z]")
+
+
(provide 'ledger-regex)
diff --git a/lisp/ledger-report.el b/lisp/ledger-report.el
index 85f75212..c477707f 100644
--- a/lisp/ledger-report.el
+++ b/lisp/ledger-report.el
@@ -1,6 +1,6 @@
;;; ledger-report.el --- Helper code for use with the "ledger" command-line tool
-;; Copyright (C) 2003-2014 John Wiegley (johnw AT gnu DOT org)
+;; Copyright (C) 2003-2015 John Wiegley (johnw AT gnu DOT org)
;; This file is not part of GNU Emacs.
@@ -57,7 +57,8 @@ specifier."
'(("ledger-file" . ledger-report-ledger-file-format-specifier)
("payee" . ledger-report-payee-format-specifier)
("account" . ledger-report-account-format-specifier)
- ("value" . ledger-report-value-format-specifier))
+ ("tagname" . ledger-report-tagname-format-specifier)
+ ("tagvalue" . ledger-report-tagvalue-format-specifier))
"An alist mapping ledger report format specifiers to implementing functions.
The function is called with no parameters and expected to return the
@@ -70,6 +71,11 @@ text that should replace the format specifier."
:type 'boolean
:group 'ledger-report)
+(defcustom ledger-report-auto-refresh-sticky-cursor nil
+ "If t then try to place cursor at same relative position as it was before auto-refresh."
+ :type 'boolean
+ :group 'ledger-report)
+
(defvar ledger-report-buffer-name "*Ledger Report*")
(defvar ledger-report-name nil)
@@ -81,8 +87,16 @@ text that should replace the format specifier."
(defvar ledger-minibuffer-history nil)
(defvar ledger-report-mode-abbrev-table)
+(defvar ledger-report-is-reversed nil)
+(defvar ledger-report-cursor-line-number nil)
+
+(defun ledger-report-reverse-report ()
+ "Reverse the order of the report."
+ (interactive)
+ (ledger-report-reverse-lines)
+ (setq ledger-report-is-reversed (not ledger-report-is-reversed)))
+
(defun ledger-report-reverse-lines ()
- (interactive)
(goto-char (point-min))
(forward-paragraph)
(forward-line)
@@ -95,10 +109,11 @@ text that should replace the format specifier."
(define-key map [? ] 'scroll-up)
(define-key map [backspace] 'scroll-down)
(define-key map [?r] 'ledger-report-redo)
- (define-key map [(shift ?r)] 'ledger-report-reverse-lines)
+ (define-key map [(shift ?r)] 'ledger-report-reverse-report)
(define-key map [?s] 'ledger-report-save)
(define-key map [?k] 'ledger-report-kill)
- (define-key map [?e] 'ledger-report-edit)
+ (define-key map [?e] 'ledger-report-edit-report)
+ (define-key map [( shift ?e)] 'ledger-report-edit-reports)
(define-key map [?q] 'ledger-report-quit)
(define-key map [?g] 'ledger-report-redo)
(define-key map [(control ?c) (control ?l) (control ?r)]
@@ -117,11 +132,11 @@ text that should replace the format specifier."
"Ledger report menu"
'("Reports"
["Save Report" ledger-report-save]
- ["Edit Report" ledger-report-edit]
+ ["Edit Current Report" ledger-report-edit-report]
+ ["Edit All Reports" ledger-report-edit-reports]
["Re-run Report" ledger-report-redo]
- ["Kill Report" ledger-report-kill]
"---"
- ["Reverse report order" ledger-report-reverse-lines]
+ ["Reverse report order" ledger-report-reverse-report]
"---"
["Scroll Up" scroll-up]
["Visit Source" ledger-report-visit-source]
@@ -133,11 +148,17 @@ text that should replace the format specifier."
(define-derived-mode ledger-report-mode text-mode "Ledger-Report"
"A mode for viewing ledger reports.")
-(defun ledger-report-value-format-specifier ()
+(defun ledger-report-tagname-format-specifier ()
"Return a valid meta-data tag name"
;; It is intended completion should be available on existing account
;; names, but it remains to be implemented.
- (ledger-read-string-with-default "Value: " nil))
+ (ledger-read-string-with-default "Tag Name: " nil))
+
+(defun ledger-report-tagvalue-format-specifier ()
+ "Return a valid meta-data tag name"
+ ;; It is intended completion should be available on existing account
+ ;; names, but it remains to be implemented.
+ (ledger-read-string-with-default "Tag Value: " nil))
(defun ledger-report-read-name ()
"Read the name of a ledger report to use, with completion.
@@ -182,13 +203,14 @@ used to generate the buffer, navigating the buffer, etc."
(set (make-local-variable 'ledger-buf) buf)
(set (make-local-variable 'ledger-report-name) report-name)
(set (make-local-variable 'ledger-original-window-cfg) wcfg)
+ (set (make-local-variable 'ledger-report-is-reversed) nil)
(ledger-do-report (ledger-report-cmd report-name edit))
(shrink-window-if-larger-than-buffer)
(set-buffer-modified-p nil)
(setq buffer-read-only t)
(message "q to quit; r to redo; e to edit; k to kill; s to save; SPC and DEL to scroll"))))
-(defun string-empty-p (s)
+(defun ledger-report-string-empty-p (s)
"Check S for the empty string."
(string-equal "" s))
@@ -197,7 +219,7 @@ used to generate the buffer, navigating the buffer, etc."
If name exists, returns the object naming the report,
otherwise returns nil."
- (unless (string-empty-p name)
+ (unless (ledger-report-string-empty-p name)
(car (assoc name ledger-reports))))
(defun ledger-reports-add (name cmd)
@@ -288,7 +310,7 @@ Optional EDIT the command."
(setq ledger-report-saved nil)) ;; this is a new report, or edited report
(setq report-cmd (ledger-report-expand-format-specifiers report-cmd))
(set (make-local-variable 'ledger-report-cmd) report-cmd)
- (or (string-empty-p report-name)
+ (or (ledger-report-string-empty-p report-name)
(ledger-report-name-exists report-name)
(progn
(ledger-reports-add report-name report-cmd)
@@ -325,7 +347,7 @@ Optional EDIT the command."
(save-excursion
(find-file file)
(widen)
- (ledger-goto-line line)
+ (ledger-navigate-to-line line)
(point-marker))))))
(add-text-properties (line-beginning-position) (line-end-position)
(list 'face 'ledger-font-report-clickable-face))
@@ -367,16 +389,20 @@ Optional EDIT the command."
(interactive)
(let ((cur-buf (current-buffer)))
(if (and ledger-report-auto-refresh
- (string= (format-mode-line 'mode-name) "Ledger")
- (get-buffer ledger-report-buffer-name))
+ (or (string= (format-mode-line 'mode-name) "Ledger")
+ (string= (format-mode-line 'mode-name) "Ledger-Report"))
+ (get-buffer ledger-report-buffer-name))
(progn
(pop-to-buffer (get-buffer ledger-report-buffer-name))
(shrink-window-if-larger-than-buffer)
(setq buffer-read-only nil)
+ (setq ledger-report-cursor-line-number (line-number-at-pos))
(erase-buffer)
(ledger-do-report ledger-report-cmd)
(setq buffer-read-only nil)
+ (if ledger-report-is-reversed (ledger-report-reverse-lines))
+ (if ledger-report-auto-refresh-sticky-cursor (forward-line (- ledger-report-cursor-line-number 5)))
(pop-to-buffer cur-buf)))))
(defun ledger-report-quit ()
@@ -386,21 +412,21 @@ Optional EDIT the command."
(set-window-configuration ledger-original-window-cfg)
(kill-buffer (get-buffer ledger-report-buffer-name)))
-(defun ledger-report-kill ()
- "Kill the ledger report buffer."
- (interactive)
- (ledger-report-quit)
- (kill-buffer (get-buffer ledger-report-buffer-name)))
-
-(defun ledger-report-edit ()
+(defun ledger-report-edit-reports ()
"Edit the defined ledger reports."
(interactive)
(customize-variable 'ledger-reports))
+(defun ledger-report-edit-report ()
+ (interactive)
+ "Edit the current report command in the mini buffer and re-run the report"
+ (setq ledger-report-cmd (ledger-report-read-command ledger-report-cmd))
+ (ledger-report-redo))
+
(defun ledger-report-read-new-name ()
"Read the name for a new report from the minibuffer."
(let ((name ""))
- (while (string-empty-p name)
+ (while (ledger-report-string-empty-p name)
(setq name (read-from-minibuffer "Report name: " nil nil nil
'ledger-report-name-prompt-history)))
name))
@@ -410,7 +436,7 @@ Optional EDIT the command."
(interactive)
(ledger-report-goto)
(let (existing-name)
- (when (string-empty-p ledger-report-name)
+ (when (ledger-report-string-empty-p ledger-report-name)
(setq ledger-report-name (ledger-report-read-new-name)))
(if (setq existing-name (ledger-report-name-exists ledger-report-name))
diff --git a/lisp/ledger-schedule.el b/lisp/ledger-schedule.el
index 8e2ab1f6..d66fdbab 100644
--- a/lisp/ledger-schedule.el
+++ b/lisp/ledger-schedule.el
@@ -22,7 +22,7 @@
;;; Commentary:
;;
;; This module provides for automatically adding transactions to a
-;; ledger buffer on a periodic basis. Recurrence expressions are
+;; ledger buffer on a periodic basis. Recurrence expressions are
;; inspired by Martin Fowler's "Recurring Events for Calendars",
;; martinfowler.com/apsupp/recurring.pdf
@@ -31,13 +31,16 @@
;; function without have to use funcall.
(require 'ledger-init)
+(require 'cl)
+
+;;; Code:
(defgroup ledger-schedule nil
"Support for automatically recommendation transactions."
:group 'ledger)
(defcustom ledger-schedule-buffer-name "*Ledger Schedule*"
- "Name for the schedule buffer"
+ "Name for the schedule buffer."
:type 'string
:group 'ledger-schedule)
@@ -47,7 +50,7 @@
:group 'ledger-schedule)
(defcustom ledger-schedule-look-forward 14
- "Number of days auto look forward to recommend transactions"
+ "Number of days auto look forward to recommend transactions."
:type 'integer
:group 'ledger-schedule)
@@ -56,28 +59,40 @@
:type 'file
:group 'ledger-schedule)
-(defvar ledger-schedule-available nil)
+(defcustom ledger-schedule-week-days '(("Mo" 1)
+ ("Tu" 2)
+ ("We" 3)
+ ("Th" 4)
+ ("Fr" 5)
+ ("Sa" 6)
+ ("Su" 7))
+ "List of weekday abbreviations. There must be exactly seven
+entries each with a two character abbreviation for a day and the
+number of that day in the week. "
+ :type '(alist :value-type (group integer))
+ :group 'ledger-schedule)
(defsubst between (val low high)
- (and (>= val low) (<= val high)))
-
-(defun ledger-schedule-check-available ()
- (setq ledger-schedule-available (and ledger-schedule-file
- (file-exists-p ledger-schedule-file))))
+ "Return TRUE if VAL > LOW and < HIGH."
+ (and (>= val low) (<= val high)))
(defun ledger-schedule-days-in-month (month year)
"Return number of days in the MONTH, MONTH is from 1 to 12.
-If year is nil, assume it is not a leap year"
+If YEAR is nil, assume it is not a leap year"
(if (between month 1 12)
(if (and year (date-leap-year-p year) (= 2 month))
29
(nth (1- month) '(31 28 31 30 31 30 31 31 30 31 30 31)))
(error "Month out of range, MONTH=%S" month)))
+(defun ledger-schedule-encode-day-of-week (day-string)
+ "Return the numerical day of week corresponding to DAY-STRING."
+ (cadr (assoc day-string ledger-schedule-week-days)))
+
;; Macros to handle date expressions
(defun ledger-schedule-constrain-day-in-month (count day-of-week)
- "Return a form that evaluates DATE that returns true for the COUNT DAY-OF-WEEK.
+ "Return a form that returns TRUE for the the COUNT DAY-OF-WEEK.
For example, return true if date is the 3rd Thursday of the
month. Negative COUNT starts from the end of the month. (EQ
COUNT 0) means EVERY day-of-week (eg. every Saturday)"
@@ -109,11 +124,11 @@ COUNT 0) means EVERY day-of-week (eg. every Saturday)"
day-of-week)))
(defun ledger-schedule-constrain-every-count-day (day-of-week skip start-date)
- "Return a form that is true for every DAY skipping SKIP, starting on START.
+ "Return a form that is true for every DAY-OF-WEEK skipping SKIP, starting on START-DATE.
For example every second Friday, regardless of month."
- (let ((start-day (nth 6 (decode-time (eval start-date)))))
+ (let ((start-day (nth 6 (decode-time start-date))))
(if (eq start-day day-of-week) ;; good, can proceed
- `(zerop (mod (- (time-to-days date) ,(time-to-days (eval start-date))) ,(* skip 7)))
+ `(zerop (mod (- (time-to-days date) ,(time-to-days start-date)) ,(* skip 7)))
(error "START-DATE day of week doesn't match DAY-OF-WEEK"))))
(defun ledger-schedule-constrain-date-range (month1 day1 month2 day2)
@@ -130,12 +145,10 @@ For example every second Friday, regardless of month."
(< ,target-day ,day2))))))
-(defun ledger-schedule-is-holiday (date)
- "Return true if DATE is a holiday.")
(defun ledger-schedule-scan-transactions (schedule-file)
- "Scans AUTO_FILE and returns a list of transactions with date predicates.
-The car of each item is a fuction of date that returns true if
+ "Scan SCHEDULE-FILE and return a list of transactions with date predicates.
+The car of each item is a function of date that returns true if
the transaction should be logged for that day."
(interactive "fFile name: ")
(let ((xact-list (list)))
@@ -146,67 +159,27 @@ the transaction should be logged for that day."
(let ((date-descriptor "")
(transaction nil)
(xact-start (match-end 0)))
- (setq date-descriptors
+ (setq date-descriptor
(ledger-schedule-read-descriptor-tree
(buffer-substring-no-properties
(match-beginning 0)
(match-end 0))))
(forward-paragraph)
- (setq transaction (list date-descriptors
+ (setq transaction (list date-descriptor
(buffer-substring-no-properties
xact-start
(point))))
(setq xact-list (cons transaction xact-list))))
xact-list)))
-(defun ledger-schedule-replace-brackets ()
- "Replace all brackets with parens"
- (goto-char (point-min))
- (while (search-forward "]" nil t)
- (replace-match ")" nil t))
- (goto-char (point-min))
- (while (search-forward "[" nil t)
- (replace-match "(" nil t)))
-
-(defvar ledger-schedule-descriptor-regex
- (concat "\\(20[0-9][0-9]\\|[\*]\\)[/\\-]" ;; Year slot
- "\\([\*EO]\\|[01][0-9]\\)[/\\-]" ;; Month slot
- "\\([\*]\\|\\([0-3][0-9]\\)\\|"
- "\\([0-5]"
- "\\(\\(Su\\)\\|"
- "\\(Mo\\)\\|"
- "\\(Tu\\)\\|"
- "\\(We\\)\\|"
- "\\(Th\\)\\|"
- "\\(Fr\\)\\|"
- "\\(Sa\\)\\)\\)\\)"))
-
(defun ledger-schedule-read-descriptor-tree (descriptor-string)
- "Take a date DESCRIPTOR-STRING and return a function of date that
-returns true if the date meets the requirements"
- (with-temp-buffer
- ;; copy the descriptor string into a temp buffer for manipulation
- (let (pos)
- ;; Replace brackets with parens
- (insert descriptor-string)
- (ledger-schedule-replace-brackets)
-
- (goto-char (point-max))
- ;; double quote all the descriptors for string processing later
- (while (re-search-backward ledger-schedule-descriptor-regex nil t) ;; Day slot
- (goto-char
- (match-end 0))
- (insert ?\")
- (goto-char (match-beginning 0))
- (insert "\"" )))
-
- ;; read the descriptor string into a lisp object the transform the
- ;; string descriptor into useable things
- (ledger-schedule-transform-auto-tree
- (read (buffer-substring-no-properties (point-min) (point-max))))))
+ "Read DESCRIPTOR-STRING and return a form that evaluates dates."
+ (ledger-schedule-transform-auto-tree
+ (split-string
+ (substring descriptor-string 1 (string-match "]" descriptor-string)) " ")))
(defun ledger-schedule-transform-auto-tree (descriptor-string-list)
- "Takes a lisp list of date descriptor strings, TREE, and returns a string with a lambda function of date."
+ "Take DESCRIPTOR-STRING-LIST, and return a string with a lambda function of date."
;; use funcall to use the lambda function spit out here
(if (consp descriptor-string-list)
(let (result)
@@ -221,70 +194,92 @@ returns true if the date meets the requirements"
(push (ledger-schedule-compile-constraints newcar) result)) )
(setq descriptor-string-list (cdr descriptor-string-list)))
- ;; tie up all the clauses in a big or and lambda, and return
+ ;; tie up all the clauses in a big or lambda, and return
;; the lambda function as list to be executed by funcall
`(lambda (date)
,(nconc (list 'or) (nreverse result) descriptor-string-list)))))
(defun ledger-schedule-compile-constraints (descriptor-string)
- "Return a list with the year, month and day fields split"
- (let ((fields (split-string descriptor-string "[/\\-]" t))
- constrain-year constrain-month constrain-day)
- (setq constrain-year (ledger-schedule-constrain-year (nth 0 fields)))
- (setq constrain-month (ledger-schedule-constrain-month (nth 1 fields)))
- (setq constrain-day (ledger-schedule-constrain-day (nth 2 fields)))
-
- (list 'and constrain-year constrain-month constrain-day)))
-
-(defun ledger-schedule-constrain-year (str)
- (let ((year-match t))
- (cond ((string= str "*")
- year-match)
- ((/= 0 (setq year-match (string-to-number str)))
- `(eq (nth 5 (decode-time date)) ,year-match))
- (t
- (error "Improperly specified year constraint: %s" str)))))
-
-(defun ledger-schedule-constrain-month (str)
-
- (let ((month-match t))
- (cond ((string= str "*")
- month-match) ;; always match
- ((/= 0 (setq month-match (string-to-number str)))
- (if (between month-match 1 12) ;; no month specified, assume 31 days.
- `(eq (nth 4 (decode-time date)) ,month-match)
- (error "ledger-schedule-constrain-numerical-month: month out of range %S" month-match)))
- (t
- (error "Improperly specified month constraint: %s" str)))))
-
-(defun ledger-schedule-constrain-day (str)
- (let ((day-match t))
- (cond ((string= str "*")
- t)
- ((/= 0 (setq day-match (string-to-number str)))
- `(eq (nth 3 (decode-time date)) ,day-match))
- (t
- (error "Improperly specified day constraint: %s" str)))))
-
-(defun ledger-schedule-parse-date-descriptor (descriptor)
- "Parse the date descriptor, return the evaluator"
- (ledger-schedule-compile-constraints descriptor))
+ "Return a list with the year, month and day fields split."
+ (let ((fields (split-string descriptor-string "[/\\-]" t)))
+ (if (string-match "[A-Za-z]" descriptor-string)
+ (ledger-schedule-constrain-day (nth 0 fields) (nth 1 fields) (nth 2 fields))
+ (list 'and
+ (ledger-schedule-constrain-day (nth 0 fields) (nth 1 fields) (nth 2 fields))
+ (ledger-schedule-constrain-year (nth 0 fields) (nth 1 fields) (nth 2 fields))
+ (ledger-schedule-constrain-month (nth 0 fields) (nth 1 fields) (nth 2 fields))))))
+
+(defun ledger-schedule-constrain-year (year-desc month-desc day-desc)
+ "Return a form that constrains the year.
+
+YEAR-DESC, MONT-DESC, and DAY-DESC are the string portions of the
+date descriptor."
+ (cond ((string= year-desc "*") t)
+ ((/= 0 (string-to-number year-desc))
+ `(memq (nth 5 (decode-time date)) ',(mapcar 'string-to-number (split-string year-desc ","))))
+ (t
+ (error "Improperly specified year constraint: %s %s %s" year-desc month-desc day-desc))))
+
+(defun ledger-schedule-constrain-month (year-desc month-desc day-desc)
+ "Return a form that constrains the month.
+
+YEAR-DESC, MONT-DESC, and DAY-DESC are the string portions of the
+date descriptor."
+ (cond ((string= month-desc "*")
+ t) ;; always match
+ ((string= month-desc "E") ;; Even
+ `(evenp (nth 4 (decode-time date))))
+ ((string= month-desc "O") ;; Odd
+ `(oddp (nth 4 (decode-time date))))
+ ((/= 0 (string-to-number month-desc)) ;; Starts with number
+ `(memq (nth 4 (decode-time date)) ',(mapcar 'string-to-number (split-string month-desc ","))))
+ (t
+ (error "Improperly specified month constraint: %s %s %s" year-desc month-desc day-desc))))
+
+(defun ledger-schedule-constrain-day (year-desc month-desc day-desc)
+ "Return a form that constrains the day.
+
+YEAR-DESC, MONT-DESC, and DAY-DESC are the string portions of the
+date descriptor."
+ (cond ((string= day-desc "*")
+ t)
+ ((string-match "[A-Za-z]" day-desc) ;; There is something other than digits and commas
+ (ledger-schedule-parse-complex-date year-desc month-desc day-desc))
+ ((/= 0 (string-to-number day-desc))
+ `(memq (nth 3 (decode-time date)) ',(mapcar 'string-to-number (split-string day-desc ","))))
+ (t
+ (error "Improperly specified day constraint: %s %s %s" year-desc month-desc day-desc))))
+
+
+
+(defun ledger-schedule-parse-complex-date (year-desc month-desc day-desc)
+ "Parse day descriptors that have repeats."
+ (let ((years (mapcar 'string-to-number (split-string year-desc ",")))
+ (months (mapcar 'string-to-number (split-string month-desc ",")))
+ (day-parts (split-string day-desc "+"))
+ (every-nth (string-match "+" day-desc)))
+ (if every-nth
+ (let ((base-day (string-to-number (car day-parts)))
+ (increment (string-to-number (substring (cadr day-parts) 0
+ (string-match "[A-Za-z]" (cadr day-parts)))))
+ (day-of-week (ledger-schedule-encode-day-of-week
+ (substring (cadr day-parts) (string-match "[A-Za-z]" (cadr day-parts))))))
+ (ledger-schedule-constrain-every-count-day day-of-week increment (encode-time 0 0 0 base-day (car months) (car years))))
+ (let ((count (string-to-number (substring (car day-parts) 0 1)))
+ (day-of-week (ledger-schedule-encode-day-of-week
+ (substring (car day-parts) (string-match "[A-Za-z]" (car day-parts))))))
+ (ledger-schedule-constrain-day-in-month count day-of-week)))))
(defun ledger-schedule-list-upcoming-xacts (candidate-items early horizon)
- "Search CANDIDATE-ITEMS for xacts that occur within the period today - EARLY to today + HORIZON"
- (let ((start-date (time-subtract (current-time) (days-to-time early)))
- test-date items)
- (loop for day from 0 to (+ early horizon) by 1 do
- (setq test-date (time-add start-date (days-to-time day)))
- (dolist (candidate candidate-items items)
- (if (funcall (car candidate) test-date)
- (setq items (append items (list (list test-date (cadr candidate))))))))
- items))
-
-(defun ledger-schedule-already-entered (candidate buffer)
- (let ((target-date (format-time-string date-format (car candidate)))
- (target-payee (cadr candidate)))
- nil))
+ "Search CANDIDATE-ITEMS for xacts that occur within the period today - EARLY to today + HORIZON."
+ (let ((start-date (time-subtract (current-time) (days-to-time early)))
+ test-date items)
+ (loop for day from 0 to (+ early horizon) by 1 do
+ (setq test-date (time-add start-date (days-to-time day)))
+ (dolist (candidate candidate-items items)
+ (if (funcall (car candidate) test-date)
+ (setq items (append items (list (list test-date (cadr candidate))))))))
+ items))
(defun ledger-schedule-create-auto-buffer (candidate-items early horizon ledger-buf)
"Format CANDIDATE-ITEMS for display."
@@ -295,13 +290,12 @@ returns true if the date meets the requirements"
(with-current-buffer schedule-buf
(erase-buffer)
(dolist (candidate candidates)
- (if (not (ledger-schedule-already-entered candidate ledger-buf))
- (insert (format-time-string date-format (car candidate) ) " " (cadr candidate) "\n")))
+ (insert (format-time-string date-format (car candidate) ) " " (cadr candidate) "\n"))
(ledger-mode))
(length candidates)))
(defun ledger-schedule-upcoming (file look-backward look-forward)
- "Generate upcoming transaction
+ "Generate upcoming transactions.
FILE is the file containing the scheduled transaction,
default to `ledger-schedule-file'.
@@ -316,12 +310,16 @@ Use a prefix arg to change the default value"
(read-number "Look backward: " ledger-schedule-look-backward)
(read-number "Look forward: " ledger-schedule-look-forward))
(list ledger-schedule-file ledger-schedule-look-backward ledger-schedule-look-forward)))
- (ledger-schedule-create-auto-buffer
- (ledger-schedule-scan-transactions file)
- look-backward
- look-forward
- (current-buffer))
- (pop-to-buffer ledger-schedule-buffer-name))
+ (if (and file
+ (file-exists-p file))
+ (progn
+ (ledger-schedule-create-auto-buffer
+ (ledger-schedule-scan-transactions file)
+ look-backward
+ look-forward
+ (current-buffer))
+ (pop-to-buffer ledger-schedule-buffer-name))
+ (error "Could not find ledger schedule file at %s" file)))
(provide 'ledger-schedule)
diff --git a/lisp/ledger-sort.el b/lisp/ledger-sort.el
index 80472a35..870e298c 100644
--- a/lisp/ledger-sort.el
+++ b/lisp/ledger-sort.el
@@ -1,6 +1,6 @@
;;; ledger-xact.el --- Helper code for use with the "ledger" command-line tool
-;; Copyright (C) 2003-2014 John Wiegley (johnw AT gnu DOT org)
+;; Copyright (C) 2003-2015 John Wiegley (johnw AT gnu DOT org)
;; This file is not part of GNU Emacs.
@@ -26,25 +26,19 @@
;;; Code:
-(defun ledger-next-record-function ()
- "Move point to next transaction."
- (if (re-search-forward ledger-payee-any-status-regex nil t)
- (goto-char (match-beginning 0))
- (goto-char (point-max))))
-
-(defun ledger-end-record-function ()
- "Move point to end of transaction."
- (forward-paragraph))
(defun ledger-sort-find-start ()
+ "Find the beginning of a sort region"
(if (re-search-forward ";.*Ledger-mode:.*Start sort" nil t)
(match-end 0)))
(defun ledger-sort-find-end ()
+ "Find the end of a sort region"
(if (re-search-forward ";.*Ledger-mode:.*End sort" nil t)
(match-end 0)))
(defun ledger-sort-insert-start-mark ()
+ "Insert a marker to start a sort region"
(interactive)
(save-excursion
(goto-char (point-min))
@@ -54,6 +48,7 @@
(insert "\n; Ledger-mode: Start sort\n\n"))
(defun ledger-sort-insert-end-mark ()
+ "Insert a marker to end a sort region"
(interactive)
(save-excursion
(goto-char (point-min))
@@ -69,11 +64,11 @@
(defun ledger-sort-region (beg end)
"Sort the region from BEG to END in chronological order."
(interactive "r") ;; load beg and end from point and mark
- ;; automagically
+ ;; automagically
(let ((new-beg beg)
(new-end end)
point-delta
- (bounds (ledger-find-xact-extents (point)))
+ (bounds (ledger-navigate-find-xact-extents (point)))
target-xact)
(setq point-delta (- (point) (car bounds)))
@@ -82,12 +77,14 @@
(save-excursion
(save-restriction
(goto-char beg)
- (ledger-next-record-function) ;; make sure point is at the
- ;; beginning of a xact
+ ;; make sure point is at the beginning of a xact
+ (ledger-navigate-next-xact)
+ (unless (looking-at ledger-payee-any-status-regex)
+ (ledger-navigate-next-xact))
(setq new-beg (point))
(goto-char end)
- (ledger-next-record-function) ;; make sure end of region is at
- ;; the beginning of next record
+ (ledger-navigate-next-xact)
+ ;; make sure end of region is at the beginning of next record
;; after the region
(setq new-end (point))
(narrow-to-region new-beg new-end)
@@ -96,8 +93,8 @@
(let ((inhibit-field-text-motion t))
(sort-subr
nil
- 'ledger-next-record-function
- 'ledger-end-record-function
+ 'ledger-navigate-next-xact
+ 'ledger-navigate-end-of-xact
'ledger-sort-startkey))))
(goto-char (point-min))
diff --git a/lisp/ledger-state.el b/lisp/ledger-state.el
index 989e6d33..47805f15 100644
--- a/lisp/ledger-state.el
+++ b/lisp/ledger-state.el
@@ -1,6 +1,6 @@
;;; ledger-state.el --- Helper code for use with the "ledger" command-line tool
-;; Copyright (C) 2003-2014 John Wiegley (johnw AT gnu DOT org)
+;; Copyright (C) 2003-2015 John Wiegley (johnw AT gnu DOT org)
;; This file is not part of GNU Emacs.
@@ -65,6 +65,16 @@
((eql state-char ?\;) 'comment)
(t nil)))
+
+(defun ledger-state-from-string (state-string)
+ "Get state from STATE-CHAR."
+ (when state-string
+ (cond
+ ((string-match "\\!" state-string) 'pending)
+ ((string-match "\\*" state-string) 'cleared)
+ ((string-match ";" state-string) 'comment)
+ (t nil))))
+
(defun ledger-toggle-current-posting (&optional style)
"Toggle the cleared status of the transaction under point.
Optional argument STYLE may be `pending' or `cleared', depending
@@ -77,7 +87,7 @@ achieved more certainly by passing the xact to ledger for
formatting, but doing so causes inline math expressions to be
dropped."
(interactive)
- (let ((bounds (ledger-find-xact-extents (point)))
+ (let ((bounds (ledger-navigate-find-xact-extents (point)))
new-status cur-status)
;; Uncompact the xact, to make it easier to toggle the
;; transaction
diff --git a/lisp/ledger-test.el b/lisp/ledger-test.el
index 5f9f02fa..da120f63 100644
--- a/lisp/ledger-test.el
+++ b/lisp/ledger-test.el
@@ -1,6 +1,6 @@
;;; ledger-test.el --- Helper code for use with the "ledger" command-line tool
-;; Copyright (C) 2003-2014 John Wiegley (johnw AT gnu DOT org)
+;; Copyright (C) 2003-2015 John Wiegley (johnw AT gnu DOT org)
;; This file is not part of GNU Emacs.
@@ -19,6 +19,16 @@
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
;; MA 02110-1301 USA.
+;;; Commentary:
+
+;;; Code:
+
+(declare-function ledger-mode "ledger-mode") ; TODO: fix this cyclic dependency
+(declare-function org-narrow-to-subtree "org")
+(declare-function org-entry-get "org")
+(declare-function outline-back-to-heading "outline")
+(declare-function outline-next-heading "outline")
+
(defgroup ledger-test nil
"Definitions for the Ledger testing framework"
:group 'ledger)
@@ -125,3 +135,5 @@
(cd prev-directory)))))))
(provide 'ledger-test)
+
+;;; ledger-test.el ends here
diff --git a/lisp/ledger-texi.el b/lisp/ledger-texi.el
index 746051bf..afaf0df7 100644
--- a/lisp/ledger-texi.el
+++ b/lisp/ledger-texi.el
@@ -1,6 +1,6 @@
;;; ledger-texi.el --- Helper code for use with the "ledger" command-line tool
-;; Copyright (C) 2003-2014 John Wiegley (johnw AT gnu DOT org)
+;; Copyright (C) 2003-2015 John Wiegley (johnw AT gnu DOT org)
;; This file is not part of GNU Emacs.
diff --git a/lisp/ledger-xact.el b/lisp/ledger-xact.el
index e747b6b2..0eb9386a 100644
--- a/lisp/ledger-xact.el
+++ b/lisp/ledger-xact.el
@@ -1,6 +1,6 @@
;;; ledger-xact.el --- Helper code for use with the "ledger" command-line tool
-;; Copyright (C) 2003-2014 John Wiegley (johnw AT gnu DOT org)
+;; Copyright (C) 2003-2015 John Wiegley (johnw AT gnu DOT org)
;; This file is not part of GNU Emacs.
@@ -25,6 +25,11 @@
;;; Code:
+(require 'eshell)
+(require 'ledger-regex)
+(require 'ledger-navigate)
+;; TODO: This file depends on code in ledger-mode.el, which depends on this.
+
(defcustom ledger-highlight-xact-under-point t
"If t highlight xact under point."
:type 'boolean
@@ -39,26 +44,10 @@
(defvar ledger-xact-highlight-overlay (list))
(make-variable-buffer-local 'ledger-xact-highlight-overlay)
-(defun ledger-find-xact-extents (pos)
- "Return point for beginning of xact and and of xact containing position.
-Requires empty line separating xacts. Argument POS is a location
-within the transaction."
- (interactive "d")
- (save-excursion
- (goto-char pos)
- (list (progn
- (backward-paragraph)
- (if (/= (point) (point-min))
- (forward-line))
- (line-beginning-position))
- (progn
- (forward-paragraph)
- (line-beginning-position)))))
-
(defun ledger-highlight-xact-under-point ()
"Move the highlight overlay to the current transaction."
(if ledger-highlight-xact-under-point
- (let ((exts (ledger-find-xact-extents (point)))
+ (let ((exts (ledger-navigate-find-element-extents (point)))
(ovl ledger-xact-highlight-overlay))
(if (not ledger-xact-highlight-overlay)
(setq ovl
@@ -68,7 +57,7 @@ within the transaction."
(current-buffer) t nil)))
(move-overlay ovl (car exts) (cadr exts)))
(overlay-put ovl 'face 'ledger-font-xact-highlight-face)
- (overlay-put ovl 'priority 100))))
+ (overlay-put ovl 'priority '(nil . 99)))))
(defun ledger-xact-payee ()
"Return the payee of the transaction containing point or nil."
@@ -98,7 +87,7 @@ MOMENT is an encoded date"
(if (ledger-time-less-p moment date)
(throw 'found t))))))
(when (and (eobp) last-xact-start)
- (let ((end (cadr (ledger-find-xact-extents last-xact-start))))
+ (let ((end (cadr (ledger-navigate-find-xact-extents last-xact-start))))
(goto-char end)
(if (eobp)
(insert "\n")
@@ -129,11 +118,6 @@ MOMENT is an encoded date"
mark desc)))))
(forward-line))))
-(defun ledger-goto-line (line-number)
- "Rapidly move point to line LINE-NUMBER."
- (goto-char (point-min))
- (forward-line (1- line-number)))
-
(defun ledger-year-and-month ()
(let ((sep (if ledger-use-iso-dates
"-"
@@ -145,7 +129,7 @@ MOMENT is an encoded date"
(interactive (list
(ledger-read-date "Copy to date: ")))
(let* ((here (point))
- (extents (ledger-find-xact-extents (point)))
+ (extents (ledger-navigate-find-xact-extents (point)))
(transaction (buffer-substring-no-properties (car extents) (cadr extents)))
encoded-date)
(if (string-match ledger-iso-date-regexp date)
@@ -155,7 +139,7 @@ MOMENT is an encoded date"
(string-to-number (match-string 2 date)))))
(ledger-xact-find-slot encoded-date)
(insert transaction "\n")
- (backward-paragraph 2)
+ (ledger-navigate-beginning-of-xact)
(re-search-forward ledger-iso-date-regexp)
(replace-match date)
(ledger-next-amount)
@@ -163,9 +147,9 @@ MOMENT is an encoded date"
(goto-char (match-beginning 0)))))
(defun ledger-delete-current-transaction (pos)
- "Delete the transaction surrounging point."
+ "Delete the transaction surrounging POS."
(interactive "d")
- (let ((bounds (ledger-find-xact-extents pos)))
+ (let ((bounds (ledger-navigate-find-xact-extents pos)))
(delete-region (car bounds) (cadr bounds))))
(defun ledger-add-transaction (transaction-text &optional insert-at-point)
@@ -207,7 +191,6 @@ correct chronological place in the buffer."
(insert (car args) " \n\n")
(end-of-line -1)))))
-
(provide 'ledger-xact)
;;; ledger-xact.el ends here
generated by cgit v1.2.3 (git 2.39.1) at 2025-08-08 00:41:44 +0000