diff options
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/ledger-check.el | 136 | ||||
-rw-r--r-- | lisp/ledger-commodities.el | 4 | ||||
-rw-r--r-- | lisp/ledger-complete.el | 4 | ||||
-rw-r--r-- | lisp/ledger-exec.el | 2 | ||||
-rw-r--r-- | lisp/ledger-mode.el | 2 | ||||
-rw-r--r-- | lisp/ledger-occur.el | 4 | ||||
-rw-r--r-- | lisp/ledger-post.el | 2 | ||||
-rw-r--r-- | lisp/ledger-reconcile.el | 19 | ||||
-rw-r--r-- | lisp/ledger-report.el | 15 | ||||
-rw-r--r-- | lisp/ledger-schedule.el | 60 | ||||
-rw-r--r-- | lisp/ledger-sort.el | 14 | ||||
-rw-r--r-- | lisp/ledger-state.el | 4 | ||||
-rw-r--r-- | lisp/ledger-texi.el | 2 | ||||
-rw-r--r-- | lisp/ledger-xact.el | 9 |
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 "-" "/"))) |