426 lines
13 KiB
EmacsLisp
426 lines
13 KiB
EmacsLisp
;;; ledger.el --- Helper code for use with the "ledger" command-line tool
|
|
|
|
;; Copyright (C) 2004 John Wiegley (johnw AT gnu DOT org)
|
|
|
|
;; Emacs Lisp Archive Entry
|
|
;; Filename: ledger.el
|
|
;; Version: 1.2
|
|
;; Date: Thu 02-Apr-2004
|
|
;; Keywords: data
|
|
;; Author: John Wiegley (johnw AT gnu DOT org)
|
|
;; Maintainer: John Wiegley (johnw AT gnu DOT org)
|
|
;; Description: Helper code for using my "ledger" command-line tool
|
|
;; URL: http://www.newartisans.com/johnw/emacs.html
|
|
;; Compatibility: Emacs21
|
|
|
|
;; This file is not part of GNU Emacs.
|
|
|
|
;; This is free software; you can redistribute it and/or modify it under
|
|
;; the terms of the GNU General Public License as published by the Free
|
|
;; Software Foundation; either version 2, or (at your option) any later
|
|
;; version.
|
|
;;
|
|
;; This is distributed in the hope that it will be useful, but WITHOUT
|
|
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
|
;; for more details.
|
|
;;
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
|
|
;; MA 02111-1307, USA.
|
|
|
|
;;; Commentary:
|
|
|
|
;; To use this module: Load this file, open a ledger data file, and
|
|
;; 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-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
|
|
;;
|
|
;; 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.
|
|
|
|
(defvar ledger-version "1.2"
|
|
"The version of ledger.el currently loaded")
|
|
|
|
(defgroup ledger nil
|
|
"Interface to the Ledger command-line accounting program."
|
|
:group 'data)
|
|
|
|
(defcustom ledger-binary-path (executable-find "ledger")
|
|
"Path to the ledger executable."
|
|
:type 'file
|
|
:group 'ledger)
|
|
|
|
(defvar bold 'bold)
|
|
(defvar ledger-font-lock-keywords
|
|
'(("^[0-9./]+\\s-+\\(?:([^)]+)\\s-+\\)?\\([^*].+\\)" 1 bold)
|
|
("^\\s-+.+?\\( \\|\t\\|\\s-+$\\)" . font-lock-keyword-face))
|
|
"Default expressions to highlight in Ledger mode.")
|
|
|
|
(defsubst ledger-current-year ()
|
|
(format-time-string "%Y"))
|
|
(defsubst ledger-current-month ()
|
|
(format-time-string "%m"))
|
|
|
|
(defvar ledger-year (ledger-current-year)
|
|
"Start a ledger session with the current year, but make it
|
|
customizable to ease retro-entry.")
|
|
(defvar ledger-month (ledger-current-month)
|
|
"Start a ledger session with the current month, but make it
|
|
customizable to ease retro-entry.")
|
|
|
|
(defun ledger-iterate-entries (callback)
|
|
(goto-char (point-min))
|
|
(let* ((now (current-time))
|
|
(current-year (nth 5 (decode-time now))))
|
|
(while (not (eobp))
|
|
(when (looking-at
|
|
(concat "\\(Y\\s-+\\([0-9]+\\)\\|"
|
|
"\\([0-9]\\{4\\}+\\)?[./]?"
|
|
"\\([0-9]+\\)[./]\\([0-9]+\\)\\s-+"
|
|
"\\(\\*\\s-+\\)?\\(.+\\)\\)"))
|
|
(let ((found (match-string 2)))
|
|
(if found
|
|
(setq current-year (string-to-number found))
|
|
(let ((start (match-beginning 0))
|
|
(year (match-string 3))
|
|
(month (string-to-number (match-string 4)))
|
|
(day (string-to-number (match-string 5)))
|
|
(mark (match-string 6))
|
|
(desc (match-string 7)))
|
|
(if (and year (> (length year) 0))
|
|
(setq year (string-to-number year)))
|
|
(funcall callback start
|
|
(encode-time 0 0 0 day month
|
|
(or year current-year))
|
|
mark desc)))))
|
|
(forward-line))))
|
|
|
|
(defun ledger-time-less-p (t1 t2)
|
|
"Say whether time value T1 is less than time value T2."
|
|
(or (< (car t1) (car t2))
|
|
(and (= (car t1) (car t2))
|
|
(< (nth 1 t1) (nth 1 t2)))))
|
|
|
|
(defun ledger-time-subtract (t1 t2)
|
|
"Subtract two time values.
|
|
Return the difference in the format of a time value."
|
|
(let ((borrow (< (cadr t1) (cadr t2))))
|
|
(list (- (car t1) (car t2) (if borrow 1 0))
|
|
(- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
|
|
|
|
(defun ledger-find-slot (moment)
|
|
(catch 'found
|
|
(ledger-iterate-entries
|
|
(function
|
|
(lambda (start date mark desc)
|
|
(if (ledger-time-less-p moment date)
|
|
(throw 'found t)))))))
|
|
|
|
(defun ledger-add-entry (entry-text)
|
|
(interactive
|
|
(list
|
|
(read-string "Entry: " (concat ledger-year "/" ledger-month "/"))))
|
|
(let* ((date (car (split-string entry-text)))
|
|
(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-int (match-string 3 date))
|
|
(string-to-int (match-string 2 date))
|
|
(string-to-int (match-string 1 date)))))
|
|
(ledger-find-slot date)
|
|
(save-excursion
|
|
(if (re-search-backward "^Y " nil t)
|
|
(setq insert-year nil)))
|
|
(save-excursion
|
|
(insert
|
|
(with-temp-buffer
|
|
(setq exit-code
|
|
(apply #'ledger-run-ledger
|
|
ledger-buf "entry"
|
|
(split-string
|
|
(with-temp-buffer
|
|
(insert entry-text)
|
|
(goto-char (point-min))
|
|
(while (re-search-forward "\\([&$]\\)" nil t)
|
|
(replace-match "\\\\\\1"))
|
|
(buffer-string)))))
|
|
(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"))))
|
|
|
|
(defun ledger-delete-current-entry ()
|
|
(interactive)
|
|
(save-excursion
|
|
(when (or (looking-at "^[0-9]")
|
|
(re-search-backward "^[0-9]" nil t))
|
|
(let ((beg (point)))
|
|
(while (not (eolp))
|
|
(forward-line))
|
|
(delete-blank-lines)
|
|
(delete-region beg (point))))))
|
|
|
|
(defun ledger-toggle-current ()
|
|
(interactive)
|
|
(let (clear)
|
|
(save-excursion
|
|
(when (or (looking-at "^[0-9]")
|
|
(re-search-backward "^[0-9]" nil t))
|
|
(skip-chars-forward "0-9./")
|
|
(delete-horizontal-space)
|
|
(if (equal ?\* (char-after))
|
|
(delete-char 1)
|
|
(insert " * ")
|
|
(setq clear t))))
|
|
clear))
|
|
|
|
(defvar ledger-mode-abbrev-table)
|
|
|
|
(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-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)))
|
|
(let ((map (current-local-map)))
|
|
(define-key map [(control ?c) (control ?a)] 'ledger-add-entry)
|
|
(define-key map [(control ?c) (control ?d)] 'ledger-delete-current-entry)
|
|
(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 ?r)] 'ledger-reconcile)))
|
|
|
|
;; Reconcile mode
|
|
|
|
(defvar ledger-buf nil)
|
|
(defvar ledger-acct nil)
|
|
|
|
(defun ledger-display-balance ()
|
|
(let ((buffer ledger-buf)
|
|
(account ledger-acct))
|
|
(with-temp-buffer
|
|
(let ((exit-code (ledger-run-ledger buffer "-C" "balance" account)))
|
|
(if (/= 0 exit-code)
|
|
(message "Error determining cleared balance")
|
|
(goto-char (1- (point-max)))
|
|
(goto-char (line-beginning-position))
|
|
(delete-horizontal-space)
|
|
(message "Cleared balance = %s"
|
|
(buffer-substring-no-properties (point)
|
|
(line-end-position))))))))
|
|
|
|
(defun ledger-reconcile-toggle ()
|
|
(interactive)
|
|
(let ((where (get-text-property (point) 'where))
|
|
(account ledger-acct)
|
|
(inhibit-read-only t)
|
|
cleared)
|
|
(with-current-buffer ledger-buf
|
|
(goto-char where)
|
|
(setq cleared (ledger-toggle-current)))
|
|
(if cleared
|
|
(add-text-properties (line-beginning-position)
|
|
(line-end-position)
|
|
(list 'face 'bold))
|
|
(remove-text-properties (line-beginning-position)
|
|
(line-end-position)
|
|
(list 'face)))
|
|
(forward-line)))
|
|
|
|
(defun ledger-auto-reconcile (balance date)
|
|
(interactive "sReconcile to balance: \nsStatement date: ")
|
|
(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" "%B\\n" "--reconcile"
|
|
(with-temp-buffer
|
|
(insert balance)
|
|
(goto-char (point-min))
|
|
(while (re-search-forward "\\([&$]\\)" nil t)
|
|
(replace-match "\\\\\\1"))
|
|
(buffer-string))
|
|
"--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 (get-text-property (point) 'where)))
|
|
(forward-line))
|
|
(unless (eobp)
|
|
(ledger-reconcile-toggle))))
|
|
(goto-char (point-min))))
|
|
|
|
(defun ledger-reconcile-add ()
|
|
(interactive)
|
|
(with-current-buffer ledger-buf
|
|
(call-interactively #'ledger-add-entry))
|
|
(let ((inhibit-read-only t))
|
|
(erase-buffer)
|
|
(ledger-do-reconcile)
|
|
(set-buffer-modified-p t)))
|
|
|
|
(defun ledger-reconcile-delete ()
|
|
(interactive)
|
|
(let ((where (get-text-property (point) 'where)))
|
|
(with-current-buffer ledger-buf
|
|
(goto-char where)
|
|
(ledger-delete-current-entry))
|
|
(let ((inhibit-read-only t))
|
|
(goto-char (line-beginning-position))
|
|
(delete-region (point) (1+ (line-end-position)))
|
|
(set-buffer-modified-p t))))
|
|
|
|
(defun ledger-reconcile-save ()
|
|
(interactive)
|
|
(with-current-buffer ledger-buf
|
|
(save-buffer))
|
|
(set-buffer-modified-p nil)
|
|
(ledger-display-balance))
|
|
|
|
(defun ledger-do-reconcile ()
|
|
(let* ((buf ledger-buf)
|
|
(account ledger-acct)
|
|
(items
|
|
(with-temp-buffer
|
|
(let ((exit-code
|
|
(ledger-run-ledger buf "--reconcilable" "emacs" account)))
|
|
(when (= 0 exit-code)
|
|
(goto-char (point-min))
|
|
(unless (looking-at "(")
|
|
(error (buffer-string)))
|
|
(read (current-buffer)))))))
|
|
(dolist (item items)
|
|
(dolist (xact (nthcdr 5 item))
|
|
(let ((beg (point)))
|
|
(insert (format "%s %-30s %-25s %15s\n"
|
|
(format-time-string "%m/%d" (nth 2 item))
|
|
(nth 4 item) (nth 0 xact) (nth 1 xact)))
|
|
(if (nth 1 item)
|
|
(set-text-properties beg (1- (point))
|
|
(list 'face 'bold
|
|
'where
|
|
(with-current-buffer buf
|
|
(copy-marker (nth 0 item)))))
|
|
(set-text-properties beg (1- (point))
|
|
(list 'where
|
|
(with-current-buffer buf
|
|
(copy-marker (nth 0 item)))))))))
|
|
(goto-char (point-min))
|
|
(set-buffer-modified-p nil)
|
|
(toggle-read-only t)))
|
|
|
|
(defun ledger-reconcile (account &optional arg)
|
|
(interactive "sAccount to reconcile: \nP")
|
|
(let ((buf (current-buffer)))
|
|
(with-current-buffer
|
|
(pop-to-buffer (generate-new-buffer "*Reconcile*"))
|
|
(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)))))
|
|
|
|
(defvar ledger-reconcile-mode-abbrev-table)
|
|
|
|
(define-derived-mode ledger-reconcile-mode text-mode "Reconcile"
|
|
"A mode for reconciling ledger entries."
|
|
(let ((map (make-sparse-keymap)))
|
|
(define-key map [(control ?c) (control ?r)] 'ledger-auto-reconcile)
|
|
(define-key map [(control ?x) (control ?s)] 'ledger-reconcile-save)
|
|
(define-key map [? ] 'ledger-reconcile-toggle)
|
|
(define-key map [?a] 'ledger-reconcile-add)
|
|
(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]
|
|
(function
|
|
(lambda ()
|
|
(interactive)
|
|
(kill-buffer (current-buffer)))))
|
|
(use-local-map map)))
|
|
|
|
;; A sample function for $ users
|
|
|
|
(defun ledger-align-dollars (&optional column)
|
|
(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))))
|
|
|
|
;; General helper functions
|
|
|
|
(defun ledger-run-ledger (buffer &rest args)
|
|
"run ledger with supplied arguments"
|
|
(let ((buf (current-buffer)))
|
|
(with-current-buffer buffer
|
|
(apply #'call-process-region
|
|
(append (list (point-min) (point-max)
|
|
ledger-binary-path nil buf nil "-f" "-")
|
|
args)))))
|
|
|
|
(defun ledger-set-year (newyear)
|
|
"Set ledger's idea of the current year to the prefix argument."
|
|
(interactive "p")
|
|
(if (= newyear 1)
|
|
(setq ledger-year (read-string "Year: " (ledger-current-year)))
|
|
(setq ledger-year (number-to-string newyear))))
|
|
|
|
(defun ledger-set-month (newmonth)
|
|
"Set ledger's idea of the current month to the prefix argument."
|
|
(interactive "p")
|
|
(if (= newmonth 1)
|
|
(setq ledger-month (read-string "Month: " (ledger-current-month)))
|
|
(setq ledger-month (format "%02d" newmonth))))
|
|
|
|
(provide 'ledger)
|
|
|
|
;;; ledger.el ends here
|