summaryrefslogtreecommitdiff
path: root/lisp/ledger.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/ledger.el')
-rw-r--r--lisp/ledger.el315
1 files changed, 186 insertions, 129 deletions
diff --git a/lisp/ledger.el b/lisp/ledger.el
index 0812f8f6..8e4de270 100644
--- a/lisp/ledger.el
+++ b/lisp/ledger.el
@@ -1,11 +1,11 @@
;;; ledger.el --- Helper code for use with the "ledger" command-line tool
-;; Copyright (C) 2007 John Wiegley (johnw AT gnu DOT org)
+;; Copyright (C) 2003-2009 John Wiegley (johnw AT gnu DOT org)
;; Emacs Lisp Archive Entry
;; Filename: ledger.el
;; Version: 3.0
-;; Date: Thu 16-Apr-2007
+;; Date: Fri 18-Jul-2008
;; Keywords: data
;; Author: John Wiegley (johnw AT gnu DOT org)
;; Maintainer: John Wiegley (johnw AT gnu DOT org)
@@ -36,6 +36,7 @@
;; type M-x ledger-mode. Once this is done, you can type:
;;
;; C-c C-a add a new entry, based on previous entries
+;; C-c C-e toggle cleared status of an entry
;; C-c C-y set default year for entry mode
;; C-c C-m set default month for entry mode
;; C-c C-r reconcile uncleared entries related to an account
@@ -48,8 +49,7 @@
;;
;; In the reconcile buffer, use SPACE to toggle the cleared status of
;; a transaction, C-x C-s to save changes (to the ledger file as
-;; well), or C-c C-r to attempt an auto-reconcilation based on the
-;; statement's ending date and balance.
+;; well).
;;
;; The ledger reports command asks the user to select a report to run
;; then creates a report buffer containing the results of running the
@@ -80,7 +80,7 @@
"Interface to the Ledger command-line accounting program."
:group 'data)
-(defcustom ledger-binary-path (executable-find "ledger")
+(defcustom ledger-binary-path "ledger"
"Path to the ledger executable."
:type 'file
:group 'ledger)
@@ -128,10 +128,17 @@ text that should replace the format specifier."
(defvar bold 'bold)
(defvar ledger-font-lock-keywords
- `((,(concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+"
- "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") 3 bold)
- ("^\\s-+.+?\\( \\|\t\\|\\s-+$\\)" . font-lock-keyword-face))
- "Default expressions to highlight in Ledger mode.")
+ '(("\\( \\| \\|^\\)\\(;.*\\)" 2 font-lock-comment-face)
+ ("^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)" 2 bold)
+ ;;("^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)"
+ ;; 2 font-lock-type-face)
+ ("^\\s-+\\([*]\\s-*\\)?\\(\\([[(]\\)?[^*:
+ ]+?:[^]);
+ ]+?\\([])]\\)?\\)\\( \\| \\|$\\)"
+ 2 font-lock-keyword-face)
+ ("^\\([~=].+\\)" 1 font-lock-function-name-face)
+ ("^\\([A-Za-z]+ .+\\)" 1 font-lock-function-name-face))
+ "Expressions to highlight in Ledger mode.")
(defsubst ledger-current-year ()
(format-time-string "%Y"))
@@ -193,38 +200,34 @@ Return the difference in the format of a time value."
(if (ledger-time-less-p moment date)
(throw 'found t)))))))
-(defun ledger-add-entry (entry-text)
+(defun ledger-add-entry (entry-text &optional insert-at-point)
(interactive
(list
(read-string "Entry: " (concat ledger-year "/" ledger-month "/"))))
(let* ((args (with-temp-buffer
(insert entry-text)
(eshell-parse-arguments (point-min) (point-max))))
- (date (car args))
- (insert-year t)
(ledger-buf (current-buffer))
exit-code)
- (if (string-match "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)" date)
- (setq date
- (encode-time 0 0 0 (string-to-number (match-string 3 date))
- (string-to-number (match-string 2 date))
- (string-to-number (match-string 1 date)))))
- (ledger-find-slot date)
- (save-excursion
- (if (re-search-backward "^Y " nil t)
- (setq insert-year nil)))
+ (unless insert-at-point
+ (let ((date (car args)))
+ (if (string-match "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)" date)
+ (setq date
+ (encode-time 0 0 0 (string-to-number (match-string 3 date))
+ (string-to-number (match-string 2 date))
+ (string-to-number (match-string 1 date)))))
+ (ledger-find-slot date)))
(save-excursion
(insert
(with-temp-buffer
(setq exit-code
(apply #'ledger-run-ledger ledger-buf "entry"
(mapcar 'eval args)))
- (if (= 0 exit-code)
- (if insert-year
- (buffer-substring 2 (point-max))
- (buffer-substring 7 (point-max)))
- (concat (if insert-year entry-text
- (substring entry-text 6)) "\n"))) "\n"))))
+ (goto-char (point-min))
+ (if (looking-at "Error: ")
+ (error (buffer-string))
+ (buffer-string)))
+ "\n"))))
(defun ledger-current-entry-bounds ()
(save-excursion
@@ -259,6 +262,35 @@ Return the difference in the format of a time value."
(setq clear t))))
clear))
+(defun ledger-move-to-next-field ()
+ (re-search-forward "\\( \\|\t\\)" (line-end-position) t))
+
+(defun ledger-toggle-state (state &optional style)
+ (if (not (null state))
+ (if (and style (eq style 'cleared))
+ 'cleared)
+ (if (and style (eq style 'pending))
+ 'pending
+ 'cleared)))
+
+(defun ledger-entry-state ()
+ (save-excursion
+ (when (or (looking-at "^[0-9]")
+ (re-search-backward "^[0-9]" nil t))
+ (skip-chars-forward "0-9./=")
+ (skip-syntax-forward " ")
+ (cond ((looking-at "!\\s-*") 'pending)
+ ((looking-at "\\*\\s-*") 'cleared)
+ (t nil)))))
+
+(defun ledger-transaction-state ()
+ (save-excursion
+ (goto-char (line-beginning-position))
+ (skip-syntax-forward " ")
+ (cond ((looking-at "!\\s-*") 'pending)
+ ((looking-at "\\*\\s-*") 'cleared)
+ (t (ledger-entry-state)))))
+
(defun ledger-toggle-current-transaction (&optional style)
"Toggle the cleared status of the transaction under point.
Optional argument STYLE may be `pending' or `cleared', depending
@@ -323,8 +355,15 @@ dropped."
(insert "* ")
(setq inserted t))))
(if (and inserted
- (search-forward " " (line-end-position) t))
- (delete-char 2))
+ (re-search-forward "\\(\t\\| [ \t]\\)"
+ (line-end-position) t))
+ (cond
+ ((looking-at "\t")
+ (delete-char 1))
+ ((looking-at " [ \t]")
+ (delete-char 2))
+ ((looking-at " ")
+ (delete-char 1))))
(setq clear inserted)))))
;; Clean up the entry so that it displays minimally
(save-excursion
@@ -354,20 +393,40 @@ dropped."
(let ((width (- (point) here)))
(when (> width 0)
(delete-region here (point))
- (if (search-forward " " (line-end-position) t)
+ (if (re-search-forward "\\(\t\\| [ \t]\\)"
+ (line-end-position) t)
(insert (make-string width ? ))))))
(forward-line))
(goto-char (car bounds))
(skip-chars-forward "0-9./= \t")
(insert state " ")
- (if (search-forward " " (line-end-position) t)
- (delete-char 2)))))
+ (if (re-search-forward "\\(\t\\| [ \t]\\)"
+ (line-end-position) t)
+ (cond
+ ((looking-at "\t")
+ (delete-char 1))
+ ((looking-at " [ \t]")
+ (delete-char 2))
+ ((looking-at " ")
+ (delete-char 1)))))))
clear))
(defun ledger-toggle-current (&optional style)
(interactive)
- (if ledger-clear-whole-entries
- (ledger-toggle-current-entry style)
+ (if (or ledger-clear-whole-entries
+ (eq 'entry (ledger-thing-at-point)))
+ (progn
+ (save-excursion
+ (forward-line)
+ (goto-char (line-beginning-position))
+ (while (and (not (eolp))
+ (save-excursion
+ (not (eq 'entry (ledger-thing-at-point)))))
+ (if (looking-at "\\s-+[*!]")
+ (ledger-toggle-current-transaction nil))
+ (forward-line)
+ (goto-char (line-beginning-position))))
+ (ledger-toggle-current-entry style))
(ledger-toggle-current-transaction style)))
(defvar ledger-mode-abbrev-table)
@@ -375,7 +434,7 @@ dropped."
;;;###autoload
(define-derived-mode ledger-mode text-mode "Ledger"
"A mode for editing ledger data files."
- (set (make-local-variable 'comment-start) ";")
+ (set (make-local-variable 'comment-start) " ; ")
(set (make-local-variable 'comment-end) "")
(set (make-local-variable 'indent-tabs-mode) nil)
@@ -395,6 +454,7 @@ dropped."
(define-key map [(control ?c) (control ?y)] 'ledger-set-year)
(define-key map [(control ?c) (control ?m)] 'ledger-set-month)
(define-key map [(control ?c) (control ?c)] 'ledger-toggle-current)
+ (define-key map [(control ?c) (control ?e)] 'ledger-toggle-current-entry)
(define-key map [(control ?c) (control ?r)] 'ledger-reconcile)
(define-key map [(control ?c) (control ?s)] 'ledger-sort)
(define-key map [tab] 'pcomplete)
@@ -402,16 +462,11 @@ dropped."
(define-key map [(control ?c) tab] 'ledger-fully-complete-entry)
(define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-entry)
(define-key map [(control ?c) (control ?o) (control ?r)] 'ledger-report)
- (define-key map [(control ?c) (control ?o) (control ?g)]
- 'ledger-report-goto)
- (define-key map [(control ?c) (control ?o) (control ?a)]
- 'ledger-report-redo)
- (define-key map [(control ?c) (control ?o) (control ?s)]
- 'ledger-report-save)
- (define-key map [(control ?c) (control ?o) (control ?e)]
- 'ledger-report-edit)
- (define-key map [(control ?c) (control ?o) (control ?k)]
- 'ledger-report-kill)))
+ (define-key map [(control ?c) (control ?o) (control ?g)] 'ledger-report-goto)
+ (define-key map [(control ?c) (control ?o) (control ?a)] 'ledger-report-redo)
+ (define-key map [(control ?c) (control ?o) (control ?s)] 'ledger-report-save)
+ (define-key map [(control ?c) (control ?o) (control ?e)] 'ledger-report-edit)
+ (define-key map [(control ?c) (control ?o) (control ?k)] 'ledger-report-kill)))
;; Reconcile mode
@@ -438,7 +493,7 @@ dropped."
(account ledger-acct)
(inhibit-read-only t)
cleared)
- (when (equal (car where) "<stdin>")
+ (when (or (equal (car where) "<stdin>") (equal (car where) "/dev/stdin"))
(with-current-buffer ledger-buf
(goto-char (cdr where))
(setq cleared (ledger-toggle-current 'pending)))
@@ -451,38 +506,6 @@ dropped."
(list 'face))))
(forward-line)))
-(defun ledger-auto-reconcile (balance date)
- (interactive "sReconcile to balance (negative for a liability): \nsStatement date (default: now): ")
- (let ((buffer ledger-buf)
- (account ledger-acct) cleared)
- ;; attempt to auto-reconcile in the background
- (with-temp-buffer
- (let ((exit-code
- (ledger-run-ledger buffer "--format" "%xB\\n"
- "--reconcile" balance "--reconcile-date" date
- "register" account)))
- (if (/= 0 exit-code)
- (error "Failed to reconcile account '%s' to balance '%s'"
- account balance)
- (goto-char (point-min))
- (unless (looking-at "[0-9]")
- (error (buffer-string)))
- (while (not (eobp))
- (setq cleared
- (cons (1+ (read (current-buffer))) cleared))
- (forward-line)))))
- (goto-char (point-min))
- (with-current-buffer ledger-buf
- (setq cleared (mapcar 'copy-marker (nreverse cleared))))
- (let ((inhibit-redisplay t))
- (dolist (pos cleared)
- (while (and (not (eobp))
- (/= pos (cdr (get-text-property (point) 'where))))
- (forward-line))
- (unless (eobp)
- (ledger-reconcile-toggle))))
- (goto-char (point-min))))
-
(defun ledger-reconcile-refresh ()
(interactive)
(let ((inhibit-read-only t)
@@ -509,7 +532,7 @@ dropped."
(defun ledger-reconcile-delete ()
(interactive)
(let ((where (get-text-property (point) 'where)))
- (when (equal (car where) "<stdin>")
+ (when (or (equal (car where) "<stdin>") (equal (car where) "/dev/stdin"))
(with-current-buffer ledger-buf
(goto-char (cdr where))
(ledger-delete-current-entry))
@@ -521,7 +544,7 @@ dropped."
(defun ledger-reconcile-visit ()
(interactive)
(let ((where (get-text-property (point) 'where)))
- (when (equal (car where) "<stdin>")
+ (when (or (equal (car where) "<stdin>") (equal (car where) "/dev/stdin"))
(switch-to-buffer-other-window ledger-buf)
(goto-char (cdr where)))))
@@ -544,7 +567,7 @@ dropped."
(let ((where (get-text-property (point) 'where))
(face (get-text-property (point) 'face)))
(if (and (eq face 'bold)
- (equal (car where) "<stdin>"))
+ (or (equal (car where) "<stdin>") (equal (car where) "/dev/stdin")))
(with-current-buffer ledger-buf
(goto-char (cdr where))
(ledger-toggle-current 'cleared))))
@@ -573,8 +596,12 @@ dropped."
(cons
(nth 0 item)
(if ledger-clear-whole-entries
- (copy-marker (nth 1 item))
- (copy-marker (nth 0 xact)))))))
+ (save-excursion
+ (goto-line (nth 1 item))
+ (point-marker))
+ (save-excursion
+ (goto-line (nth 0 xact))
+ (point-marker)))))))
(insert (format "%s %-30s %-25s %15s\n"
(format-time-string "%m/%d" (nth 2 item))
(nth 4 item) (nth 1 xact) (nth 2 xact)))
@@ -589,8 +616,8 @@ dropped."
(set-buffer-modified-p nil)
(toggle-read-only t)))
-(defun ledger-reconcile (account &optional arg)
- (interactive "sAccount to reconcile: \nP")
+(defun ledger-reconcile (account)
+ (interactive "sAccount to reconcile: ")
(let ((buf (current-buffer))
(rbuf (get-buffer "*Reconcile*")))
(if rbuf
@@ -601,10 +628,7 @@ dropped."
(ledger-reconcile-mode)
(set (make-local-variable 'ledger-buf) buf)
(set (make-local-variable 'ledger-acct) account)
- (ledger-do-reconcile)
- (when arg
- (sit-for 0 0)
- (call-interactively #'ledger-auto-reconcile)))))
+ (ledger-do-reconcile))))
(defvar ledger-reconcile-mode-abbrev-table)
@@ -614,7 +638,6 @@ dropped."
(define-key map [(control ?m)] 'ledger-reconcile-visit)
(define-key map [return] 'ledger-reconcile-visit)
(define-key map [(control ?c) (control ?c)] 'ledger-reconcile-finish)
- (define-key map [(control ?c) (control ?r)] 'ledger-auto-reconcile)
(define-key map [(control ?x) (control ?s)] 'ledger-reconcile-save)
(define-key map [(control ?l)] 'ledger-reconcile-refresh)
(define-key map [? ] 'ledger-reconcile-toggle)
@@ -622,7 +645,6 @@ dropped."
(define-key map [?d] 'ledger-reconcile-delete)
(define-key map [?n] 'next-line)
(define-key map [?p] 'previous-line)
- (define-key map [?r] 'ledger-auto-reconcile)
(define-key map [?s] 'ledger-reconcile-save)
(define-key map [?q] 'ledger-reconcile-quit)
(use-local-map map)))
@@ -789,6 +811,7 @@ specified line, returns nil."
"A mode for viewing ledger reports."
(let ((map (make-sparse-keymap)))
(define-key map [? ] 'scroll-up)
+ (define-key map [backspace] 'scroll-down)
(define-key map [?r] 'ledger-report-redo)
(define-key map [?s] 'ledger-report-save)
(define-key map [?k] 'ledger-report-kill)
@@ -846,7 +869,10 @@ used to generate the buffer, navigating the buffer, etc."
(set (make-local-variable 'ledger-report-name) report-name)
(set (make-local-variable 'ledger-original-window-cfg) wcfg)
(ledger-do-report (ledger-report-cmd report-name edit))
- (shrink-window-if-larger-than-buffer))))
+ (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)
"Check for the empty string."
@@ -948,7 +974,8 @@ the default."
(defun ledger-do-report (cmd)
"Run a report command line."
(goto-char (point-min))
- (insert (format "Report: %s\n" cmd)
+ (insert (format "Report: %s\n" ledger-report-name)
+ (format "Command: %s\n" cmd)
(make-string (- (window-width) 1) ?=)
"\n")
(shell-command cmd t nil))
@@ -966,14 +993,17 @@ the default."
"Redo the report in the current ledger report buffer."
(interactive)
(ledger-report-goto)
+ (setq buffer-read-only nil)
(erase-buffer)
- (ledger-do-report ledger-report-cmd))
+ (ledger-do-report ledger-report-cmd)
+ (setq buffer-read-only nil))
(defun ledger-report-quit ()
- "Quit the ledger report buffer."
+ "Quit the ledger report buffer by burying it."
(interactive)
(ledger-report-goto)
- (set-window-configuration ledger-original-window-cfg))
+ (set-window-configuration ledger-original-window-cfg)
+ (bury-buffer (get-buffer ledger-report-buffer-name)))
(defun ledger-report-kill ()
"Kill the ledger report buffer."
@@ -1028,6 +1058,9 @@ the default."
((looking-at "^\\s-+\\([*!]\\s-+\\)?[[(]?\\(.\\)")
(goto-char (match-beginning 2))
'transaction)
+ ((looking-at "^\\(sun\\|mon\\|tue\\|wed\\|thu\\|fri\\|sat\\)\\s-+")
+ (goto-char (match-end 0))
+ 'entry)
(t
(ignore (goto-char here))))))
@@ -1118,7 +1151,22 @@ the default."
(while (pcomplete-here
(if (eq (save-excursion
(ledger-thing-at-point)) 'entry)
- (ledger-entries)
+ (if (null current-prefix-arg)
+ (ledger-entries) ; this completes against entry names
+ (progn
+ (let ((text (buffer-substring (line-beginning-position)
+ (line-end-position))))
+ (delete-region (line-beginning-position)
+ (line-end-position))
+ (condition-case err
+ (ledger-add-entry text t)
+ ((error)
+ (insert text))))
+ (forward-line)
+ (goto-char (line-end-position))
+ (search-backward ";" (line-beginning-position) t)
+ (skip-chars-backward " \t0123456789.,")
+ (throw 'pcompleted t)))
(ledger-accounts)))))
(defun ledger-fully-complete-entry ()
@@ -1152,29 +1200,41 @@ the default."
;; A sample function for $ users
-(defun ledger-align-dollars (&optional column)
+(defun ledger-next-amount (&optional end)
+ (when (re-search-forward "\\( \\|\t\\| \t\\)[ \t]*-?\\([A-Z$]+ *\\)?\\(-?[0-9,]+?\\)\\(.[0-9]+\\)?\\( *[A-Z$]+\\)?\\([ \t]*@@?[^\n;]+?\\)?\\([ \t]+;.+?\\)?$" (marker-position end) t)
+ (goto-char (match-beginning 0))
+ (skip-syntax-forward " ")
+ (- (or (match-end 4)
+ (match-end 3)) (point))))
+
+(defun ledger-align-amounts (&optional column)
+ "Align amounts in the current region.
+This is done so that the last digit falls in COLUMN, which defaults to 52."
(interactive "p")
(if (= column 1)
- (setq column 48))
- (while (search-forward "$" nil t)
- (backward-char)
- (let ((col (current-column))
- (beg (point))
- target-col len)
- (skip-chars-forward "-$0-9,.")
- (setq len (- (point) beg))
- (setq target-col (- column len))
- (if (< col target-col)
- (progn
- (goto-char beg)
- (insert (make-string (- target-col col) ? )))
- (move-to-column target-col)
- (if (looking-back " ")
- (delete-char (- col target-col))
- (skip-chars-forward "^ \t")
- (delete-horizontal-space)
- (insert " ")))
- (forward-line))))
+ (setq column 52))
+ (save-excursion
+ (let* ((mark-first (< (mark) (point)))
+ (begin (if mark-first (mark) (point)))
+ (end (if mark-first (point-marker) (mark-marker)))
+ offset)
+ (goto-char begin)
+ (while (setq offset (ledger-next-amount end))
+ (let ((col (current-column))
+ (target-col (- column offset))
+ adjust)
+ (setq adjust (- target-col col))
+ (if (< col target-col)
+ (insert (make-string (- target-col col) ? ))
+ (move-to-column target-col)
+ (if (looking-back " ")
+ (delete-char (- col target-col))
+ (skip-chars-forward "^ \t")
+ (delete-horizontal-space)
+ (insert " ")))
+ (forward-line))))))
+
+(defalias 'ledger-align-dollars 'ledger-align-amounts)
;; A sample entry sorting function, which works if entry dates are of
;; the form YYYY/mm/dd.
@@ -1202,23 +1262,20 @@ the default."
(defun ledger-run-ledger (buffer &rest args)
"run ledger with supplied arguments"
+ ;; Let's try again, just in case they moved it while we were sleeping.
(cond
((null ledger-binary-path)
(error "The variable `ledger-binary-path' has not been set"))
- ((not (file-exists-p ledger-binary-path))
- (error "The file `ledger-binary-path' (\"%s\") does not exist"
- ledger-binary-path))
- ((not (file-executable-p ledger-binary-path))
- (error "The file `ledger-binary-path' (\"%s\") cannot be executed"
- ledger-binary-path))
(t
(let ((buf (current-buffer)))
(with-current-buffer buffer
- (apply #'call-process-region
- (append (list (point-min) (point-max)
- ledger-binary-path ledger-delete-after
- buf nil "-f" "-")
- args)))))))
+ (let ((coding-system-for-write 'utf-8)
+ (coding-system-for-read 'utf-8))
+ (apply #'call-process-region
+ (append (list (point-min) (point-max)
+ ledger-binary-path ledger-delete-after
+ buf nil "-f" "-")
+ args))))))))
(defun ledger-run-ledger-and-delete (buffer &rest args)
(let ((ledger-delete-after t))
generated by cgit v1.2.3 (git 2.39.1) at 2025-01-25 19:47:36 +0000