planner-ledger.el

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