summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ledger-check.el136
-rw-r--r--lisp/ledger-commodities.el4
-rw-r--r--lisp/ledger-complete.el4
-rw-r--r--lisp/ledger-exec.el2
-rw-r--r--lisp/ledger-mode.el2
-rw-r--r--lisp/ledger-occur.el4
-rw-r--r--lisp/ledger-post.el2
-rw-r--r--lisp/ledger-reconcile.el19
-rw-r--r--lisp/ledger-report.el15
-rw-r--r--lisp/ledger-schedule.el60
-rw-r--r--lisp/ledger-sort.el14
-rw-r--r--lisp/ledger-state.el4
-rw-r--r--lisp/ledger-texi.el2
-rw-r--r--lisp/ledger-xact.el9
14 files changed, 234 insertions, 43 deletions
diff --git a/lisp/ledger-check.el b/lisp/ledger-check.el
new file mode 100644
index 00000000..8eed34ed
--- /dev/null
+++ b/lisp/ledger-check.el
@@ -0,0 +1,136 @@
+;;; ledger-check.el --- Helper code for use with the "ledger" command-line tool
+
+;; Copyright (C) 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:
+;; Provide secial mode to correct errors in ledger when running with --strict and --explicit
+;;
+;; Adapted to ledger mode by Craig Earls <enderw88 at gmail dot com>
+
+;;; Code:
+
+(require 'easymenu)
+(eval-when-compile
+ (require 'cl))
+
+(defvar ledger-check-buffer-name "*Ledger Check*")
+
+
+
+
+(defvar ledger-check-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [return] 'ledger-report-visit-source)
+ (define-key map [?q] 'ledger-check-quit)
+ map)
+ "Keymap for `ledger-check-mode'.")
+
+(easy-menu-define ledger-check-mode-menu ledger-check-mode-map
+ "Ledger check menu"
+ '("Check"
+; ["Re-run Check" ledger-check-redo]
+ "---"
+ ["Visit Source" ledger-report-visit-source]
+ "---"
+ ["Quit" ledger-check-quit]
+ ))
+
+(define-derived-mode ledger-check-mode text-mode "Ledger-Check"
+ "A mode for viewing ledger errors and warnings.")
+
+
+(defun ledger-do-check ()
+ "Run a check command ."
+ (goto-char (point-min))
+ (let ((data-pos (point))
+ (have-warnings nil))
+ (shell-command
+ ;; ledger balance command will just return empty if you give it
+ ;; an account name that doesn't exist. I will assume that no
+ ;; one will ever have an account named "e342asd2131". If
+ ;; someones does, this will probably still work for them.
+ ;; I should only highlight error and warning lines.
+ "ledger bal e342asd2131 --strict --explicit "
+ t nil)
+ (goto-char data-pos)
+
+ ;; format check report to make it navigate the file
+
+ (while (re-search-forward "^.*: \"\\(.*\\)\", line \\([0-9]+\\)" nil t)
+ (let ((file (match-string 1))
+ (line (string-to-number (match-string 2))))
+ (when file
+ (set-text-properties (line-beginning-position) (line-end-position)
+ (list 'ledger-source (cons file (save-window-excursion
+ (save-excursion
+ (find-file file)
+ (widen)
+ (ledger-navigate-to-line line)
+ (point-marker))))))
+ (add-text-properties (line-beginning-position) (line-end-position)
+ (list 'face 'ledger-font-report-clickable-face))
+ (setq have-warnings 'true)
+ (end-of-line))))
+ (if (not have-warnings)
+ (insert "No errors or warnings reported."))))
+
+(defun ledger-check-goto ()
+ "Goto the ledger check buffer."
+ (interactive)
+ (let ((rbuf (get-buffer ledger-check-buffer-name)))
+ (if (not rbuf)
+ (error "There is no ledger check buffer"))
+ (pop-to-buffer rbuf)
+ (shrink-window-if-larger-than-buffer)))
+
+(defun ledger-check-quit ()
+ "Quit the ledger check buffer."
+ (interactive)
+ (ledger-check-goto)
+ (set-window-configuration ledger-original-window-cfg)
+ (kill-buffer (get-buffer ledger-check-buffer-name)))
+
+(defun ledger-check-buffer ()
+ "Run a ledge with --explicit and --strict report errors and assist with fixing them.
+
+The output buffer will be in `ledger-check-mode', which defines
+commands for navigating the buffer to the errors found, etc."
+ (interactive
+ (progn
+ (when (and (buffer-modified-p)
+ (y-or-n-p "Buffer modified, save it? "))
+ (save-buffer))))
+ (let ((buf (current-buffer))
+ (cbuf (get-buffer ledger-check-buffer-name))
+ (wcfg (current-window-configuration)))
+ (if cbuf
+ (kill-buffer cbuf))
+ (with-current-buffer
+ (pop-to-buffer (get-buffer-create ledger-check-buffer-name))
+ (ledger-check-mode)
+ (set (make-local-variable 'ledger-original-window-cfg) wcfg)
+ (ledger-do-check)
+ (shrink-window-if-larger-than-buffer)
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t)
+ (message "q to quit; r to redo; k to kill"))))
+
+
+(provide 'ledger-check)
diff --git a/lisp/ledger-commodities.el b/lisp/ledger-commodities.el
index b5244bdb..a6f2fdda 100644
--- a/lisp/ledger-commodities.el
+++ b/lisp/ledger-commodities.el
@@ -28,6 +28,10 @@
(require 'ledger-regex)
+;; These keep the byte-compiler from warning about them, but have no other
+;; effect:
+(defvar ledger-environment-alist)
+
(defcustom ledger-reconcile-default-commodity "$"
"The default commodity for use in target calculations in ledger reconcile."
:type 'string
diff --git a/lisp/ledger-complete.el b/lisp/ledger-complete.el
index 28b6b37a..5a4011b9 100644
--- a/lisp/ledger-complete.el
+++ b/lisp/ledger-complete.el
@@ -28,6 +28,10 @@
;;; Code:
+(declare-function ledger-thing-at-point "ledger-context" nil)
+(declare-function ledger-add-transaction "ledger-xact" (transaction-text &optional insert-at-point))
+(declare-function between "ledger-schedule" (val low high))
+
(defun ledger-parse-arguments ()
"Parse whitespace separated arguments in the current region."
;; this is more complex than it appears to need, so that it can work
diff --git a/lisp/ledger-exec.el b/lisp/ledger-exec.el
index 4ba9134d..5440e085 100644
--- a/lisp/ledger-exec.el
+++ b/lisp/ledger-exec.el
@@ -25,6 +25,8 @@
;;; Code:
+(defvar ledger-buf)
+
(defconst ledger-version-needed "3.0.0"
"The version of ledger executable needed for interactive features.")
diff --git a/lisp/ledger-mode.el b/lisp/ledger-mode.el
index 9eff6bc6..7e30c350 100644
--- a/lisp/ledger-mode.el
+++ b/lisp/ledger-mode.el
@@ -49,6 +49,7 @@
(require 'ledger-texi)
(require 'ledger-xact)
(require 'ledger-schedule)
+(require 'ledger-check)
;;; Code:
@@ -316,6 +317,7 @@ With a prefix argument, remove the effective date."
["Copy Trans at Point" ledger-copy-transaction-at-point]
"---"
["Clean-up Buffer" ledger-mode-clean-buffer]
+ ["Check Buffer" ledger-check-buffer ledger-works]
["Align Region" ledger-post-align-postings mark-active]
["Align Xact" ledger-post-align-xact]
["Sort Region" ledger-sort-region mark-active]
diff --git a/lisp/ledger-occur.el b/lisp/ledger-occur.el
index 810657a3..0df2f1a9 100644
--- a/lisp/ledger-occur.el
+++ b/lisp/ledger-occur.el
@@ -29,7 +29,9 @@
;;; Code:
-(require 'cl)
+;; TODO: replace this with (require 'cl-lib)
+(with-no-warnings
+ (require 'cl))
(require 'ledger-navigate)
(defconst ledger-occur-overlay-property-name 'ledger-occur-custom-buffer-grep)
diff --git a/lisp/ledger-post.el b/lisp/ledger-post.el
index ef0370b4..973f2260 100644
--- a/lisp/ledger-post.el
+++ b/lisp/ledger-post.el
@@ -27,6 +27,8 @@
;;; Code:
+(declare-function ledger-navigate-find-xact-extents "ledger-navigate" (pos))
+
(defgroup ledger-post nil
"Options for controlling how Ledger-mode deals with postings and completion"
:group 'ledger)
diff --git a/lisp/ledger-reconcile.el b/lisp/ledger-reconcile.el
index a6a7dd86..7ac8f2c4 100644
--- a/lisp/ledger-reconcile.el
+++ b/lisp/ledger-reconcile.el
@@ -34,7 +34,21 @@
(defvar ledger-bufs nil)
(defvar ledger-acct nil)
(defvar ledger-target nil)
-
+(defvar ledger-clear-whole-transactions)
+(declare-function ledger-exec-ledger "ledger-exec" (input-buffer &optional output-buffer &rest args))
+(declare-function ledger-split-commodity-string "ledger-commodities" (str))
+(declare-function ledger-commodity-to-string "ledger-commodities" (c1))
+(declare-function -commodity "ledger-commodities" (c1 c2))
+(declare-function ledger-navigate-to-line "ledger-navigate" (line-number))
+(declare-function ledger-toggle-current "ledger-state" (&optional style))
+(declare-function ledger-insert-effective-date "ledger-mode" (&optional date))
+(declare-function ledger-add-transaction "ledger-xact" (transaction-text &optional insert-at-point))
+(declare-function ledger-delete-current-transaction "ledger-xact" (pos))
+(declare-function ledger-highlight-xact-under-point "ledger-xact" nil)
+(declare-function ledger-occur-mode "ledger-occur")
+(declare-function ledger-read-account-with-prompt "ledger-mode" (prompt))
+(declare-function ledger-occur "ledger-occur" (regex))
+(declare-function ledger-read-commodity-string "ledger-commodities" (prompt))
(defgroup ledger-reconcile nil
"Options for Ledger-mode reconciliation"
:group 'ledger)
@@ -446,7 +460,8 @@ Return a count of the uncleared transactions."
(fmt (ledger-reconcile-compile-format-string ledger-reconcile-buffer-line-format)))
(if (and ledger-success (> (length xacts) 0))
(progn
- (insert (format ledger-reconcile-buffer-header account))
+ (if ledger-reconcile-buffer-header
+ (insert (format ledger-reconcile-buffer-header account)))
(dolist (xact xacts)
(ledger-reconcile-format-xact xact fmt))
(goto-char (point-max))
diff --git a/lisp/ledger-report.el b/lisp/ledger-report.el
index 8b6b1c9d..83c287eb 100644
--- a/lisp/ledger-report.el
+++ b/lisp/ledger-report.el
@@ -25,9 +25,14 @@
;;; Code:
+(declare-function ledger-read-string-with-default "ledger-mode" (prompt default))
+(declare-function ledger-xact-payee "ledger-xact" nil)
+(declare-function ledger-read-account-with-prompt "ledger-mode" (prompt))
+(declare-function ledger-navigate-to-line "ledger-navigate" (line-number))
+
(require 'easymenu)
-(eval-when-compile
- (require 'cl))
+
+(defvar ledger-buf)
(defgroup ledger-report nil
"Customization option for the Report buffer"
@@ -149,13 +154,13 @@ text that should replace the format specifier."
"A mode for viewing ledger reports.")
(defun ledger-report-tagname-format-specifier ()
- "Return a valid meta-data tag name"
+ "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 Name: " nil))
(defun ledger-report-tagvalue-format-specifier ()
- "Return a valid meta-data tag name"
+ "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))
@@ -418,8 +423,8 @@ Optional EDIT the command."
(customize-variable 'ledger-reports))
(defun ledger-report-edit-report ()
+ "Edit the current report command in the mini buffer and re-run the 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))
diff --git a/lisp/ledger-schedule.el b/lisp/ledger-schedule.el
index 1fbbcb59..ae08ad36 100644
--- a/lisp/ledger-schedule.el
+++ b/lisp/ledger-schedule.el
@@ -30,9 +30,11 @@
;; function slot of the symbol VARNAME. Then use VARNAME as the
;; function without have to use funcall.
+
(require 'ledger-init)
-(require 'cl)
+(require 'cl-macs)
+(declare-function ledger-mode "ledger-mode")
;;; Code:
(defgroup ledger-schedule nil
@@ -100,15 +102,15 @@ COUNT 0) means EVERY day-of-week (eg. every Saturday)"
(cond ((zerop count) ;; Return true if day-of-week matches
`(eq (nth 6 (decode-time date)) ,day-of-week))
((> count 0) ;; Positive count
- (let ((decoded (gensym)))
+ (let ((decoded (cl-gensym)))
`(let ((,decoded (decode-time date)))
(and (eq (nth 6 ,decoded) ,day-of-week)
(between (nth 3 ,decoded)
,(* (1- count) 7)
,(* count 7))))))
((< count 0)
- (let ((days-in-month (gensym))
- (decoded (gensym)))
+ (let ((days-in-month (cl-gensym))
+ (decoded (cl-gensym)))
`(let* ((,decoded (decode-time date))
(,days-in-month (ledger-schedule-days-in-month
(nth 4 ,decoded)
@@ -133,9 +135,9 @@ For example every second Friday, regardless of month."
(defun ledger-schedule-constrain-date-range (month1 day1 month2 day2)
"Return a form of DATE that is true if DATE falls between MONTH1 DAY1 and MONTH2 DAY2."
- (let ((decoded (gensym))
- (target-month (gensym))
- (target-day (gensym)))
+ (let ((decoded (cl-gensym))
+ (target-month (cl-gensym))
+ (target-day (cl-gensym)))
`(let* ((,decoded (decode-time date))
(,target-month (nth 4 decoded))
(,target-day (nth 3 decoded)))
@@ -202,39 +204,41 @@ the transaction should be logged for that day."
(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)))
- (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))))))
+ (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))))
+ (cond
+ ((string-match "[A-Za-z]" day-desc) t) ; there is an advanced day descriptor which overrides the year
+ ((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))))
+ (cond
+ ((string-match "[A-Za-z]" day-desc) t) ; there is an advanced day descriptor which overrides the month
+ ((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.
diff --git a/lisp/ledger-sort.el b/lisp/ledger-sort.el
index 4306a6ca..6ed82830 100644
--- a/lisp/ledger-sort.el
+++ b/lisp/ledger-sort.el
@@ -25,20 +25,22 @@
;;
;;; Code:
-
+(defvar ledger-payee-any-status-regex)
+(declare-function ledger-navigate-find-xact-extents "ledger-navigate" (pos))
+(declare-function ledger-navigate-next-xact "ledger-navigate" nil)
(defun ledger-sort-find-start ()
- "Find the beginning of a sort region"
+ "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"
+ "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"
+ "Insert a marker to start a sort region."
(interactive)
(save-excursion
(goto-char (point-min))
@@ -48,7 +50,7 @@
(insert "\n; Ledger-mode: Start sort\n\n"))
(defun ledger-sort-insert-end-mark ()
- "Insert a marker to end a sort region"
+ "Insert a marker to end a sort region."
(interactive)
(save-excursion
(goto-char (point-min))
@@ -58,7 +60,7 @@
(insert "\n; Ledger-mode: End sort\n\n"))
(defun ledger-sort-startkey ()
- "Return the actual date so the sort-subr doesn't sort onthe entire first line."
+ "Return the actual date so the sort subroutine doesn't sort on the entire first line."
(buffer-substring-no-properties (point) (+ 10 (point))))
(defun ledger-sort-region (beg end)
diff --git a/lisp/ledger-state.el b/lisp/ledger-state.el
index 61a9375e..561df095 100644
--- a/lisp/ledger-state.el
+++ b/lisp/ledger-state.el
@@ -24,6 +24,8 @@
;; Utilities for dealing with transaction and posting status.
;;; Code:
+(declare-function ledger-navigate-find-xact-extents "ledger-navigate" (pos))
+(declare-function ledger-thing-at-point "ledger-context" ())
(defcustom ledger-clear-whole-transactions nil
"If non-nil, clear whole transactions, not individual postings."
@@ -67,7 +69,7 @@
(defun ledger-state-from-string (state-string)
- "Get state from STATE-CHAR."
+ "Get state from STATE-STRING."
(when state-string
(cond
((string-match "\\!" state-string) 'pending)
diff --git a/lisp/ledger-texi.el b/lisp/ledger-texi.el
index 0ceef477..5bf8d9a2 100644
--- a/lisp/ledger-texi.el
+++ b/lisp/ledger-texi.el
@@ -18,6 +18,8 @@
;; 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.
+;;; Code:
+(defvar ledger-binary-path)
(defgroup ledger-texi nil
"Options for working on Ledger texi documentation"
diff --git a/lisp/ledger-xact.el b/lisp/ledger-xact.el
index 795df86a..f3721e9e 100644
--- a/lisp/ledger-xact.el
+++ b/lisp/ledger-xact.el
@@ -28,6 +28,14 @@
(require 'eshell)
(require 'ledger-regex)
(require 'ledger-navigate)
+
+(defvar ledger-year)
+(defvar ledger-month)
+(declare-function ledger-read-date "ledger-mode" (prompt))
+(declare-function ledger-next-amount "ledger-post" (&optional end))
+(declare-function ledger-exec-ledger "ledger-exec" (input-buffer &optional output-buffer &rest args))
+(declare-function ledger-post-align-postings "ledger-post" (&optional beg end))
+
;; TODO: This file depends on code in ledger-mode.el, which depends on this.
(defcustom ledger-highlight-xact-under-point t
@@ -123,6 +131,7 @@ MOMENT is an encoded date"
(forward-line))))
(defun ledger-year-and-month ()
+ "Return the current year and month, separated by / (or -, depending on LEDGER-USE-ISO-DATES)."
(let ((sep (if ledger-use-iso-dates
"-"
"/")))