diff options
Diffstat (limited to 'lisp/ledger-mode.el')
| -rw-r--r-- | lisp/ledger-mode.el | 105 |
1 files changed, 54 insertions, 51 deletions
diff --git a/lisp/ledger-mode.el b/lisp/ledger-mode.el index 458c24b1..4e2beff6 100644 --- a/lisp/ledger-mode.el +++ b/lisp/ledger-mode.el @@ -1,6 +1,6 @@ ;;; ledger-mode.el --- Helper code for use with the "ledger" command-line tool -;; Copyright (C) 2003-2014 John Wiegley (johnw AT gnu DOT org) +;; Copyright (C) 2003-2015 John Wiegley (johnw AT gnu DOT org) ;; This file is not part of GNU Emacs. @@ -27,6 +27,7 @@ ;;; Code: (require 'ledger-regex) +(require 'cus-edit) (require 'esh-util) (require 'esh-arg) (require 'easymenu) @@ -35,7 +36,9 @@ (require 'ledger-context) (require 'ledger-exec) (require 'ledger-fonts) +(require 'ledger-fontify) (require 'ledger-init) +(require 'ledger-navigate) (require 'ledger-occur) (require 'ledger-post) (require 'ledger-reconcile) @@ -59,11 +62,12 @@ (defconst ledger-mode-version "3.0.0") (defun ledger-mode-dump-variable (var) - (if var + "Format VAR for dump to buffer." + (if var (insert (format " %s: %S\n" (symbol-name var) (eval var))))) (defun ledger-mode-dump-group (group) - "Dump GROUP customizations to current buffer" + "Dump GROUP customizations to current buffer." (let ((members (custom-group-members group nil))) (dolist (member members) (cond ((eq (cadr member) 'custom-group) @@ -73,7 +77,7 @@ (ledger-mode-dump-variable (car member))))))) (defun ledger-mode-dump-configuration () - "Dump all customizations" + "Dump all customizations." (interactive) (find-file "ledger-mode-dump") (ledger-mode-dump-group 'ledger)) @@ -94,14 +98,15 @@ "Start a ledger session with the current month, but make it customizable to ease retro-entry.") (defun ledger-read-account-with-prompt (prompt) - (let* ((context (ledger-context-at-point)) - (default (if (eq (ledger-context-line-type context) 'acct-transaction) - (regexp-quote (ledger-context-field-value context 'account)) - nil))) - (ledger-read-string-with-default prompt default))) + "Read an account from the minibuffer with PROMPT." + (let ((context (ledger-context-at-point))) + (ledger-read-string-with-default prompt + (if (eq (ledger-context-current-field context) 'account) + (regexp-quote (ledger-context-field-value context 'account)) + nil)))) (defun ledger-read-date (prompt) - "Returns user-supplied date after `PROMPT', defaults to today." + "Return user-supplied date after `PROMPT', defaults to today." (let* ((default (ledger-year-and-month)) (date (read-string prompt default 'ledger-minibuffer-history))) @@ -146,7 +151,7 @@ And calculate the target-delta of the account being reconciled." (message balance)))) (defun ledger-magic-tab (&optional interactively) - "Decide what to with with <TAB>. + "Decide what to with with <TAB>, INTERACTIVELY. Can indent, complete or align depending on context." (interactive "p") (if (= (point) (line-beginning-position)) @@ -164,14 +169,14 @@ Can indent, complete or align depending on context." ledger-default-date-format))) (defun ledger-remove-effective-date () - "Removes the effective date from a transaction or posting." + "Remove the effective date from a transaction or posting." (interactive) (let ((context (car (ledger-context-at-point)))) (save-excursion (save-restriction (narrow-to-region (point-at-bol) (point-at-eol)) (beginning-of-line) - (cond ((eq 'pmnt-transaction context) + (cond ((eq 'xact context) (re-search-forward ledger-iso-date-regexp) (when (= (char-after) ?=) (let ((eq-pos (point))) @@ -194,7 +199,7 @@ If `DATE' is nil, prompt the user a date. Replace the current effective date if there's one in the same line. -With a prefix argument, remove the effective date. " +With a prefix argument, remove the effective date." (interactive) (if (and (listp current-prefix-arg) (= 4 (prefix-numeric-value current-prefix-arg))) @@ -204,7 +209,7 @@ With a prefix argument, remove the effective date. " (save-restriction (narrow-to-region (point-at-bol) (point-at-eol)) (cond - ((eq 'pmnt-transaction context) + ((eq 'xact context) (beginning-of-line) (re-search-forward ledger-iso-date-regexp) (when (= (char-after) ?=) @@ -216,26 +221,35 @@ With a prefix argument, remove the effective date. " (insert " ; [=" date-string "]"))))))) (defun ledger-mode-remove-extra-lines () - (goto-char (point-min)) + "Get rid of multiple empty lines." + (goto-char (point-min)) (while (re-search-forward "\n\n\\(\n\\)+" nil t) (replace-match "\n\n"))) (defun ledger-mode-clean-buffer () - "indent, remove multiple linfe feeds and sort the buffer" + "Indent, remove multiple line feeds and sort the buffer." (interactive) - (untabify (point-min) (point-max)) - (ledger-sort-buffer) - (ledger-post-align-postings (point-min) (point-max)) - (ledger-mode-remove-extra-lines)) - + (let ((start (point-min-marker)) + (end (point-max-marker))) + (goto-char start) + (ledger-navigate-beginning-of-xact) + (beginning-of-line) + (let ((target (buffer-substring (point) (progn + (end-of-line) + (point))))) + (untabify start end) + (ledger-sort-buffer) + (ledger-post-align-postings start end) + (ledger-mode-remove-extra-lines) + (goto-char start) + (search-forward target)))) (defvar ledger-mode-syntax-table - (let ((table (make-syntax-table))) - ;; Support comments via the syntax table - (modify-syntax-entry ?\; "< b" table) - (modify-syntax-entry ?\n "> b" table) + (let ((table (make-syntax-table text-mode-syntax-table))) + (modify-syntax-entry ?\; "<" table) + (modify-syntax-entry ?\n ">" table) table) - "Syntax table for `ledger-mode' buffers.") + "Syntax table in use in `ledger-mode' buffers.") (defvar ledger-mode-map (let ((map (make-sparse-keymap))) @@ -269,8 +283,8 @@ With a prefix argument, remove the effective date. " (define-key map [(control ?c) (control ?o) (control ?r)] 'ledger-report) (define-key map [(control ?c) (control ?o) (control ?s)] 'ledger-report-save) - (define-key map [(meta ?p)] 'ledger-post-prev-xact) - (define-key map [(meta ?n)] 'ledger-post-next-xact) + (define-key map [(meta ?p)] 'ledger-navigate-prev-xact-or-directive) + (define-key map [(meta ?n)] 'ledger-navigate-next-xact-or-directive) map) "Keymap for `ledger-mode'.") @@ -278,9 +292,10 @@ With a prefix argument, remove the effective date. " "Ledger menu" '("Ledger" ["Narrow to REGEX" ledger-occur] + ["Show all transactions" ledger-occur-mode ledger-occur-mode] ["Ledger Statistics" ledger-display-ledger-stats ledger-works] "---" - ["Show upcoming transactions" ledger-schedule-upcoming ledger-schedule-available] + ["Show upcoming transactions" ledger-schedule-upcoming] ["Add Transaction (ledger xact)" ledger-add-transaction ledger-works] ["Complete Transaction" ledger-fully-complete-xact] ["Delete Transaction" ledger-delete-current-transaction] @@ -318,37 +333,25 @@ With a prefix argument, remove the effective date. " (define-derived-mode ledger-mode text-mode "Ledger" "A mode for editing ledger data files." (ledger-check-version) - (ledger-schedule-check-available) - ;;(ledger-post-setup) - - (set-syntax-table ledger-mode-syntax-table) - (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))) - (setq font-lock-extend-region-functions - (list #'font-lock-extend-region-wholelines)) - (setq font-lock-multiline nil) - - (set (make-local-variable 'pcomplete-parse-arguments-function) - 'ledger-parse-arguments) - (set (make-local-variable 'pcomplete-command-completion-function) - 'ledger-complete-at-point) + (when (boundp 'font-lock-defaults) + (setq font-lock-defaults + '(ledger-font-lock-keywords t t nil nil + (font-lock-fontify-region-function . ledger-fontify-buffer-part)))) + + (set (make-local-variable 'pcomplete-parse-arguments-function) 'ledger-parse-arguments) + (set (make-local-variable 'pcomplete-command-completion-function) 'ledger-complete-at-point) (add-hook 'completion-at-point-functions 'pcomplete-completions-at-point nil t) (add-hook 'after-save-hook 'ledger-report-redo) - ;(add-hook 'after-save-hook) (add-hook 'post-command-hook 'ledger-highlight-xact-under-point nil t) - (add-hook 'before-revert-hook 'ledger-occur-remove-all-overlays nil t) (ledger-init-load-init-file) + (setq comment-start ";") (set (make-local-variable 'indent-region-function) 'ledger-post-align-postings)) + (defun ledger-set-year (newyear) "Set ledger's idea of the current year to the prefix argument NEWYEAR." (interactive "p") |