From bd8e6686f2a1d837b3c4427dfce218b6e720268e Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Mon, 12 Apr 2010 22:32:12 -0400 Subject: Broke up the old ledger.el into several submodules --- lisp/ldg-mode.el | 114 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 114 insertions(+) create mode 100644 lisp/ldg-mode.el (limited to 'lisp/ldg-mode.el') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el new file mode 100644 index 00000000..625d9f49 --- /dev/null +++ b/lisp/ldg-mode.el @@ -0,0 +1,114 @@ +(defcustom ledger-default-acct-transaction-indent " " + "Default indentation for account transactions in an entry." + :type 'string + :group 'ledger) + +(defvar bold 'bold) +(defvar ledger-font-lock-keywords + '(("\\( \\| \\|^\\)\\(;.*\\)" 2 font-lock-comment-face) + ("^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)" 2 bold) + ;;("^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)" + ;; 2 font-lock-type-face) + ("^\\s-+\\([*]\\s-*\\)?\\(\\([[(]\\)?[^*: + ]+?:[^]); + ]+?\\([])]\\)?\\)\\( \\| \\|$\\)" + 2 font-lock-keyword-face) + ("^\\([~=].+\\)" 1 font-lock-function-name-face) + ("^\\([A-Za-z]+ .+\\)" 1 font-lock-function-name-face)) + "Expressions to highlight in Ledger mode.") + +(defvar ledger-mode-abbrev-table) + +;;;###autoload +(define-derived-mode ledger-mode text-mode "Ledger" + "A mode for editing ledger data files." + (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))) + + (set (make-local-variable 'pcomplete-parse-arguments-function) + 'ledger-parse-arguments) + (set (make-local-variable 'pcomplete-command-completion-function) + 'ledger-complete-at-point) + (set (make-local-variable 'pcomplete-termination-string) "") + + (let ((map (current-local-map))) + (define-key map [(control ?c) (control ?a)] 'ledger-add-entry) + (define-key map [(control ?c) (control ?d)] 'ledger-delete-current-entry) + (define-key map [(control ?c) (control ?y)] 'ledger-set-year) + (define-key map [(control ?c) (control ?m)] 'ledger-set-month) + (define-key map [(control ?c) (control ?c)] 'ledger-toggle-current) + (define-key map [(control ?c) (control ?e)] 'ledger-toggle-current-entry) + (define-key map [(control ?c) (control ?r)] 'ledger-reconcile) + (define-key map [(control ?c) (control ?s)] 'ledger-sort) + (define-key map [tab] 'pcomplete) + (define-key map [(control ?i)] 'pcomplete) + (define-key map [(control ?c) tab] 'ledger-fully-complete-entry) + (define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-entry))) + +(defun ledger-time-less-p (t1 t2) + "Say whether time value T1 is less than time value T2." + (or (< (car t1) (car t2)) + (and (= (car t1) (car t2)) + (< (nth 1 t1) (nth 1 t2))))) + +(defun ledger-time-subtract (t1 t2) + "Subtract two time values. +Return the difference in the format of a time value." + (let ((borrow (< (cadr t1) (cadr t2)))) + (list (- (car t1) (car t2) (if borrow 1 0)) + (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2))))) + +(defun ledger-find-slot (moment) + (catch 'found + (ledger-iterate-entries + (function + (lambda (start date mark desc) + (if (ledger-time-less-p moment date) + (throw 'found t))))))) + +(defun ledger-add-entry (entry-text &optional insert-at-point) + (interactive "sEntry: ") + (let* ((args (with-temp-buffer + (insert entry-text) + (eshell-parse-arguments (point-min) (point-max)))) + (ledger-buf (current-buffer)) + exit-code) + (unless insert-at-point + (let ((date (car args))) + (if (string-match "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)" date) + (setq date + (encode-time 0 0 0 (string-to-number (match-string 3 date)) + (string-to-number (match-string 2 date)) + (string-to-number (match-string 1 date))))) + (ledger-find-slot date))) + (save-excursion + (insert + (with-temp-buffer + (setq exit-code + (apply #'ledger-run-ledger ledger-buf "entry" + (mapcar 'eval args))) + (goto-char (point-min)) + (if (looking-at "Error: ") + (error (buffer-string)) + (buffer-string))) + "\n")))) + +(defun ledger-current-entry-bounds () + (save-excursion + (when (or (looking-at "^[0-9]") + (re-search-backward "^[0-9]" nil t)) + (let ((beg (point))) + (while (not (eolp)) + (forward-line)) + (cons (copy-marker beg) (point-marker)))))) + +(defun ledger-delete-current-entry () + (interactive) + (let ((bounds (ledger-current-entry-bounds))) + (delete-region (car bounds) (cdr bounds)))) + -- cgit v1.2.3 From 7f5c1c81a1918dd3f7293a66b988599a0125b1f9 Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Sun, 2 May 2010 23:50:17 -0400 Subject: Added some missing autoloads for the new ledger-mode --- lisp/ldg-mode.el | 2 + lisp/ldg-new.el | 4 ++ lisp/ldg-post.el | 9 ++- lisp/ldg-regex.el | 152 +++++++++++++++++++++++++-------------------------- lisp/ldg-register.el | 3 +- 5 files changed, 90 insertions(+), 80 deletions(-) (limited to 'lisp/ldg-mode.el') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 625d9f49..c6f15eed 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -22,6 +22,8 @@ ;;;###autoload (define-derived-mode ledger-mode text-mode "Ledger" "A mode for editing ledger data files." + (ledger-post-setup) + (set (make-local-variable 'comment-start) " ; ") (set (make-local-variable 'comment-end) "") (set (make-local-variable 'indent-tabs-mode) nil) diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index fce25984..a515d94f 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -34,6 +34,10 @@ (require 'ldg-post) +(autoload #'ledger-mode "ldg-mode" nil t) + +(autoload #'ledger-fully-complete-entry "ldg-complete" nil t) + (autoload #'ledger-texi-update-test "ldg-texi" nil t) (autoload #'ledger-texi-update-examples "ldg-texi" nil t) diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 2d7a0e05..492f9467 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -83,6 +83,13 @@ to choose from." (delete-char 1))))))) (goto-char pos))) +(defun ledger-next-amount (&optional end) + (when (re-search-forward "\\( \\|\t\\| \t\\)[ \t]*-?\\([A-Z$]+ *\\)?\\(-?[0-9,]+?\\)\\(.[0-9]+\\)?\\( *[A-Z$]+\\)?\\([ \t]*@@?[^\n;]+?\\)?\\([ \t]+;.+?\\)?$" (marker-position end) t) + (goto-char (match-beginning 0)) + (skip-syntax-forward " ") + (- (or (match-end 4) + (match-end 3)) (point)))) + (defun ledger-align-amounts (&optional column) "Align amounts in the current region. This is done so that the last digit falls in COLUMN, which defaults to 52." @@ -164,6 +171,4 @@ This is done so that the last digit falls in COLUMN, which defaults to 52." (add-hook 'after-change-functions 'ledger-post-maybe-align t t)) (add-hook 'after-save-hook #'(lambda () (setq ledger-post-current-list nil)))) -(add-hook 'ledger-mode-hook 'ledger-post-setup) - (provide 'ldg-post) diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el index 15226ef1..93ef6b09 100644 --- a/lisp/ldg-regex.el +++ b/lisp/ldg-regex.el @@ -96,64 +96,64 @@ (cons 'progn defs))) -(put 'ledger-define-regexp 'lisp-indent-function 2) +(put 'ledger-define-regexp 'lisp-indent-function 1) (ledger-define-regexp date - (let ((sep '(or ?- (any ?. ?/)))) ; can't do (any ?- ?. ?/) due to bug - (rx (group - (and (? (= 4 num) - (eval sep)) - (and num (? num)) - (eval sep) - (and num (? num)))))) + (let ((sep '(or ?- (any ?. ?/)))) ; can't do (any ?- ?. ?/) due to bug + (rx (group + (and (? (= 4 num) + (eval sep)) + (and num (? num)) + (eval sep) + (and num (? num)))))) "Match a single date, in its 'written' form.") (ledger-define-regexp full-date - (macroexpand - `(rx (and (regexp ,ledger-date-regexp) - (? (and ?= (regexp ,ledger-date-regexp)))))) + (macroexpand + `(rx (and (regexp ,ledger-date-regexp) + (? (and ?= (regexp ,ledger-date-regexp)))))) "Match a compound date, of the form ACTUAL=EFFECTIVE" (actual date) (effective date)) (ledger-define-regexp state - (rx (group (any ?! ?*))) + (rx (group (any ?! ?*))) "Match a transaction or posting's \"state\" character.") (ledger-define-regexp code - (rx (and ?\( (group (+? (not (any ?\))))) ?\))) + (rx (and ?\( (group (+? (not (any ?\))))) ?\))) "Match the transaction code.") (ledger-define-regexp long-space - (rx (and (*? blank) - (or (and ? (or ? ?\t)) ?\t))) + (rx (and (*? blank) + (or (and ? (or ? ?\t)) ?\t))) "Match a \"long space\".") (ledger-define-regexp note - (rx (group (+ nonl))) + (rx (group (+ nonl))) "") (ledger-define-regexp end-note - (macroexpand - `(rx (and (regexp ,ledger-long-space-regexp) ?\; - (regexp ,ledger-note-regexp)))) + (macroexpand + `(rx (and (regexp ,ledger-long-space-regexp) ?\; + (regexp ,ledger-note-regexp)))) "") (ledger-define-regexp full-note - (macroexpand - `(rx (and line-start (+ blank) - ?\; (regexp ,ledger-note-regexp)))) + (macroexpand + `(rx (and line-start (+ blank) + ?\; (regexp ,ledger-note-regexp)))) "") (ledger-define-regexp xact-line - (macroexpand - `(rx (and line-start - (regexp ,ledger-full-date-regexp) - (? (and (+ blank) (regexp ,ledger-state-regexp))) - (? (and (+ blank) (regexp ,ledger-code-regexp))) - (+ blank) (+? nonl) - (? (regexp ,ledger-end-note-regexp)) - line-end))) + (macroexpand + `(rx (and line-start + (regexp ,ledger-full-date-regexp) + (? (and (+ blank) (regexp ,ledger-state-regexp))) + (? (and (+ blank) (regexp ,ledger-code-regexp))) + (+ blank) (+? nonl) + (? (regexp ,ledger-end-note-regexp)) + line-end))) "Match a transaction's first line (and optional notes)." (actual-date full-date actual) (effective-date full-date effective) @@ -162,84 +162,84 @@ (note end-note)) (ledger-define-regexp account - (rx (group (and (not (any blank ?\[ ?\( ?: ?\;)) (*? nonl)))) + (rx (group (and (not (any blank ?\[ ?\( ?: ?\;)) (*? nonl)))) "") (ledger-define-regexp account-kind - (rx (group (? (any ?\[ ?\()))) + (rx (group (? (any ?\[ ?\()))) "") (ledger-define-regexp full-account - (macroexpand - `(rx (and (regexp ,ledger-account-kind-regexp) - (regexp ,ledger-account-regexp) - (? (any ?\] ?\)))))) + (macroexpand + `(rx (and (regexp ,ledger-account-kind-regexp) + (regexp ,ledger-account-regexp) + (? (any ?\] ?\)))))) "" (kind account-kind) (name account)) (ledger-define-regexp commodity - (rx (group - (or (and ?\" (+ (not (any ?\"))) ?\") - (not (any blank ?\n - digit - ?- ?\[ ?\] - ?. ?, ?\; ?+ ?* ?/ ?^ ?? ?: ?& ?| ?! ?= - ?\< ?\> ?\{ ?\} ?\( ?\) ?@))))) + (rx (group + (or (and ?\" (+ (not (any ?\"))) ?\") + (not (any blank ?\n + digit + ?- ?\[ ?\] + ?. ?, ?\; ?+ ?* ?/ ?^ ?? ?: ?& ?| ?! ?= + ?\< ?\> ?\{ ?\} ?\( ?\) ?@))))) "") (ledger-define-regexp amount - (rx (group - (and (? ?-) - (and (+ digit) - (*? (and (any ?. ?,) (+ digit)))) - (? (and (any ?. ?,) (+ digit)))))) + (rx (group + (and (? ?-) + (and (+ digit) + (*? (and (any ?. ?,) (+ digit)))) + (? (and (any ?. ?,) (+ digit)))))) "") (ledger-define-regexp commoditized-amount - (macroexpand - `(rx (group - (or (and (regexp ,ledger-commodity-regexp) - (*? blank) - (regexp ,ledger-amount-regexp)) - (and (regexp ,ledger-amount-regexp) - (*? blank) - (regexp ,ledger-commodity-regexp)))))) + (macroexpand + `(rx (group + (or (and (regexp ,ledger-commodity-regexp) + (*? blank) + (regexp ,ledger-amount-regexp)) + (and (regexp ,ledger-amount-regexp) + (*? blank) + (regexp ,ledger-commodity-regexp)))))) "") (ledger-define-regexp commodity-annotations - (macroexpand - `(rx (* (+ blank) - (or (and ?\{ (regexp ,ledger-commoditized-amount-regexp) ?\}) - (and ?\[ (regexp ,ledger-date-regexp) ?\]) - (and ?\( (not (any ?\))) ?\)))))) + (macroexpand + `(rx (* (+ blank) + (or (and ?\{ (regexp ,ledger-commoditized-amount-regexp) ?\}) + (and ?\[ (regexp ,ledger-date-regexp) ?\]) + (and ?\( (not (any ?\))) ?\)))))) "") (ledger-define-regexp cost - (macroexpand - `(rx (and (or "@" "@@") (+ blank) - (regexp ,ledger-commoditized-amount-regexp)))) + (macroexpand + `(rx (and (or "@" "@@") (+ blank) + (regexp ,ledger-commoditized-amount-regexp)))) "") (ledger-define-regexp balance-assertion - (macroexpand - `(rx (and ?= (+ blank) - (regexp ,ledger-commoditized-amount-regexp)))) + (macroexpand + `(rx (and ?= (+ blank) + (regexp ,ledger-commoditized-amount-regexp)))) "") (ledger-define-regexp full-amount - (macroexpand `(rx (group (+? (not (any ?\;)))))) + (macroexpand `(rx (group (+? (not (any ?\;)))))) "") (ledger-define-regexp post-line - (macroexpand - `(rx (and line-start (+ blank) - (? (and (regexp ,ledger-state-regexp) (* blank))) - (regexp ,ledger-full-account-regexp) - (? (and (regexp ,ledger-long-space-regexp) - (regexp ,ledger-full-amount-regexp))) - (? (regexp ,ledger-end-note-regexp)) - line-end))) + (macroexpand + `(rx (and line-start (+ blank) + (? (and (regexp ,ledger-state-regexp) (* blank))) + (regexp ,ledger-full-account-regexp) + (? (and (regexp ,ledger-long-space-regexp) + (regexp ,ledger-full-amount-regexp))) + (? (regexp ,ledger-end-note-regexp)) + line-end))) "" state (account-kind full-account kind) diff --git a/lisp/ldg-register.el b/lisp/ldg-register.el index 93611345..02e50de9 100644 --- a/lisp/ldg-register.el +++ b/lisp/ldg-register.el @@ -57,8 +57,7 @@ (let ((pos (point)) (inhibit-read-only t)) (erase-buffer) - (ledger-register-render - buf (apply #'ledger-exec-read buf args)) + (ledger-register-render buf (apply #'ledger-exec-read buf args)) (goto-char pos)) (set-buffer-modified-p nil) (toggle-read-only t) -- cgit v1.2.3 From d728e1364a4499d9965c513c92468d2a89882433 Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Fri, 7 May 2010 22:57:05 -0400 Subject: Make sure ldg-new.el loads correctly --- lisp/ldg-complete.el | 1 + lisp/ldg-mode.el | 1 + lisp/ldg-new.el | 9 ++++++--- 3 files changed, 8 insertions(+), 3 deletions(-) (limited to 'lisp/ldg-mode.el') diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index cc2ac152..33a734b3 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -153,3 +153,4 @@ (if (re-search-backward "\\(\t\\| [ \t]\\)" nil t) (goto-char (match-end 0)))))) +(provide 'ldg-complete) diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index c6f15eed..973b891c 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -114,3 +114,4 @@ Return the difference in the format of a time value." (let ((bounds (ledger-current-entry-bounds))) (delete-region (car bounds) (cdr bounds)))) +(provide 'ldg-mode) diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index a515d94f..84863c95 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -33,10 +33,13 @@ ;;; Commentary: (require 'ldg-post) +(require 'ldg-mode) +(require 'ldg-complete) +(require 'ldg-state) -(autoload #'ledger-mode "ldg-mode" nil t) - -(autoload #'ledger-fully-complete-entry "ldg-complete" nil t) +;(autoload #'ledger-mode "ldg-mode" nil t) +;(autoload #'ledger-fully-complete-entry "ldg-complete" nil t) +;(autoload #'ledger-toggle-current "ldg-state" nil t) (autoload #'ledger-texi-update-test "ldg-texi" nil t) (autoload #'ledger-texi-update-examples "ldg-texi" nil t) -- cgit v1.2.3