planner-ledger.el

   1 ;;; planner-ledger.el --- ledger support for planner
   2
   3 ;; Copyright (C) 2004, 2008 Will Glozer (will AT glozer DOT net)
   4 ;; Parts copyright (C) 2004, 2005, 2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Author: Will Glozer (will AT glozer DOT net)
   7
   8 ;; This file is part of Planner.  It is not part of GNU Emacs.
   9
  10 ;; Planner is free software; you can redistribute it and/or modify it
  11 ;; under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 3, or (at your option)
  13 ;; any later version.
  14
  15 ;; Planner is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with Planner; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; This planner module provides integration between planner and
  28 ;; John Wiegley's ledger accounting program available at:
  29 ;;
  30 ;;    http://newartisans.com/johnw/ledger.tar.gz
  31 ;;
  32 ;; planner-ledger can insert a ledger balance overview and a list of pending
  33 ;; transactions into a planner day page.  To do so, simply add a hook:
  34 ;;
  35 ;;   (add-hook 'planner-goto-hook 'planner-ledger-insert-maybe)
  36 ;;
  37 ;; and make sure `planner-day-page-template' includes sections that match
  38 ;; `planner-ledger-balance-regexp' and `planner-ledger-pending-regexp'.
  39 ;;
  40 ;; planner-ledger can also create a new ledger entry based on a planner
  41 ;; task that matches `planner-ledger-payment-task-regexp', which by default
  42 ;; matches entries like:
  43 ;;
  44 ;;   #B0  _ payment due: Payee, $100.00 from 2004.07.01
  45 ;;
  46 ;; Bind `planner-ledger-add-entry-from-task' to a convenient key stroke and
  47 ;; execute it when in a payment task.
  48
  49 ;;; Contributors
  50
  51 ;; Travis B. Hartwell made this usable with new versions of ledger and
  52 ;; made it more flexible.
  53
  54 (require 'ledger)
  55 (require 'planner)
  56
  57 ;;; Code:
  58
  59 (defgroup planner-ledger nil
  60   "Planner-ledger provides integration between Planner and
  61 John Wiegley's ledger accounting program."
  62   :group 'planner)
  63
  64 (defcustom planner-ledger-data-file
  65   nil
  66   "Ledger file to use.  This is the full path to the data file."
  67   :type  '(file :must-match t)
  68   :group 'planner-ledger)
  69
  70 (defcustom planner-ledger-balance-regexp
  71   "^\* Ledger *$"
  72   "Section marker for insertion of ledger balance."
  73   :type 'regexp
  74   :group 'planner-ledger)
  75
  76 (defcustom planner-ledger-pending-regexp
  77   "^\*\* Pending Transactions *$"
  78   "Section marker for insertion of pending ledger transactions."
  79   :type 'regexp
  80   :group 'planner-ledger)
  81
  82 (defcustom planner-ledger-balance-accounts
  83   '("Assets" "Liabilities" "-Equity")
  84   "Accounts to include or exclude from ledger balance overview."
  85   :type '(repeat string)
  86   :group 'planner-ledger)
  87
  88 (defcustom planner-ledger-balance-args
  89   '("-s" "-e" "next month" "balance")
  90   "Command line arguments for ledger balance."
  91   :type '(repeat string)
  92   :group 'planner-ledger)
  93
  94 (defcustom planner-ledger-register-args
  95   '("-U" "register")
  96   "Command line arguments for ledger register."
  97    :type '(repeat string)
  98    :group 'planner-ledger)
  99
 100 (defcustom planner-ledger-payment-task-regexp
 101   (concat planner-task-regexp
 102           "payment\\s-+due:\\s-+\\([^,]+?\\),\\s-*\\([[:graph:]]+\\)")
 103   "Regular expression matching planner tasks for ledger payment.
 104 The first parenthesized group should match the payee. The second
 105 group should match the amount.
 106
 107 Example task:
 108 #A0 _ payment due: foobar, $1000.00 some comment here"
 109   :type 'regexp
 110   :group 'planner-ledger)
 111
 112 ;;;###autoload
 113 (defun planner-ledger-insert-maybe ()
 114   "Maybe insert ledger sections into a Planner page."
 115   (interactive)
 116   (planner-ledger-insert-balance-maybe)
 117   (planner-ledger-insert-pending-maybe))
 118
 119 (defun planner-ledger-insert-balance-maybe ()
 120   "Maybe insert ledger account balances a Planner page.
 121 The accounts are specified in planner-ledger-balance-accounts."
 122   (interactive)
 123   (planner-ledger-clear-section-balance)
 124   (apply 'planner-ledger-insert-section-maybe
 125          planner-ledger-balance-regexp
 126          (append planner-ledger-balance-args
 127                  planner-ledger-balance-accounts)))
 128
 129 (defun planner-ledger-insert-pending-maybe ()
 130   "Maybe insert ledger pending transaction into a Planner page."
 131   (interactive)
 132   (planner-ledger-clear-section-pending)
 133   (apply 'planner-ledger-insert-section-maybe
 134          planner-ledger-pending-regexp
 135          (append planner-ledger-register-args)))
 136
 137 (defun planner-ledger-insert-section-maybe (regexp &rest ledger-args)
 138   "Maybe insert a ledger section into a Planner page.
 139 Argument REGEXP is the section heading to find.  Optional argument
 140 LEDGER-ARGS contains the arguments to pass to
 141 `ledger-run-ledger'."
 142   (save-excursion
 143     (goto-char (point-min))
 144     (when (re-search-forward regexp nil t)
 145       (progn
 146         (newline 2)
 147         (apply 'planner-ledger-run-ledger ledger-args)))))
 148
 149 (defun planner-ledger-clear-section-balance ()
 150   "Clear the planner-ledger section for Ledger balance."
 151   (interactive)
 152   (save-excursion
 153     (planner-ledger-clear-section planner-ledger-balance-regexp "^\\*")))
 154
 155 (defun planner-ledger-clear-section-pending ()
 156   "Clear the planner-ledger section for pending transactions."
 157   (interactive)
 158   (save-excursion
 159     (planner-ledger-clear-section planner-ledger-pending-regexp "^\\*")))
 160
 161 (defun planner-ledger-clear-section (regexp-start regexp-end)
 162   "Clear a planner ledger section."
 163   (goto-char (point-min))
 164   (when (re-search-forward regexp-start nil t)
 165     (progn
 166       (forward-line)
 167       (delete-region (point) (if (re-search-forward regexp-end nil t)
 168                                  (line-beginning-position)
 169                                (point-max))))))
 170
 171 (defun planner-ledger-goto-section-end (regexp-start)
 172   "Goto the end of the current section or end of buffer.
 173 Assumes that sections are marked with an asterisk."
 174   (if (re-search-forward regexp-start nil t)
 175       (line-beginning-position)
 176     (point-max)))
 177
 178 (defun planner-ledger-add-entry-from-task ()
 179   "Add a new ledger entry from the task at point."
 180   (interactive)
 181   (save-excursion
 182     (beginning-of-line)
 183     (if (re-search-forward planner-ledger-payment-task-regexp
 184                            (planner-line-end-position)
 185                            t)
 186         (let* ((payee  (match-string 1))
 187                (amount (match-string 2))
 188                (date   (planner-filename-to-calendar-date (buffer-name)))
 189                (buffer (find-buffer-visiting planner-ledger-data-file)))
 190           (unless buffer (setq buffer (find-file planner-ledger-data-file)))
 191           (pop-to-buffer buffer)
 192           (ledger-add-entry (format "%d/%02d/%02d %s %s"
 193                                     (extract-calendar-year date)
 194                                     (extract-calendar-month date)
 195                                     (extract-calendar-day date)
 196                                     payee
 197                                     amount)))
 198       (message "Not in a ledger payment task"))))
 199
 200 (defun planner-ledger-run-ledger (&rest ledger-args)
 201   "Run ledger for planner-ledger.
 202
 203 Run the ledger binary with ledger-run-ledger using the value of
 204 `planner-ledger-data-file'.
 205
 206 If the file is open in a buffer, use the buffer. Otherwise
 207 specify the file as an option to the ledger binary command and
 208 avoid loading it in Emacs."
 209   (let ((buffer (get-file-buffer planner-ledger-data-file)))
 210     (if buffer
 211         (apply 'ledger-run-ledger buffer ledger-args)
 212       (apply #'call-process
 213              (append (list ledger-binary-path nil t nil
 214                            "-f" planner-ledger-data-file)
 215                      ledger-args)))))
 216
 217 (provide 'planner-ledger)
 218
 219 ;;; planner-ledger.el ends here