diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ldg-post.el | 122 | ||||
| -rw-r--r-- | lisp/ldg-regex.el | 167 | ||||
| -rw-r--r-- | lisp/ldg-texi.el | 121 | ||||
| -rw-r--r-- | lisp/ledger.el | 4 |
4 files changed, 412 insertions, 2 deletions
diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el new file mode 100644 index 00000000..30edd035 --- /dev/null +++ b/lisp/ldg-post.el @@ -0,0 +1,122 @@ +(require 'ldg-regex) + +(defgroup ledger-post nil + "" + :group 'ledger) + +(defcustom ledger-post-auto-adjust-amounts t + "If non-nil, ." + :type 'boolean + :group 'ledger-post) + +(declare-function iswitchb-read-buffer "iswitchb" + (prompt &optional default require-match start matches-set)) +(defvar iswitchb-temp-buflist) + +(defvar ledger-post-current-list nil) + +(defun ledger-post-find-all () + (let ((origin (point)) + (ledger-post-list nil) + account-path elements) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward + "^[ \t]+\\([*!]\\s-+\\)?[[(]?\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)" nil t) + (unless (and (>= origin (match-beginning 0)) + (< origin (match-end 0))) + (setq account-path (match-string-no-properties 2)) + (unless (string-match "\\`\\s-*;" account-path) + (add-to-list 'ledger-post-list account-path)))) + (setq ledger-post-current-list + (nreverse ledger-post-list))))) + +(defun ledger-post-completing-read (prompt choices) + "Use iswitchb as a completing-read replacement to choose from choices. +PROMPT is a string to prompt with. CHOICES is a list of strings +to choose from." + (let* ((iswitchb-use-virtual-buffers nil) + (iswitchb-make-buflist-hook + (lambda () + (setq iswitchb-temp-buflist choices)))) + (iswitchb-read-buffer prompt))) + +(defun ledger-post-pick-account () + (interactive) + (let* ((account + (ledger-post-completing-read "Account: " + (or ledger-post-current-list + (ledger-post-find-all)))) + (account-len (length account)) + (pos (point))) + (goto-char (line-beginning-position)) + (when (re-search-forward ledger-regex-post-line (line-end-position) t) + (let ((existing-len (length (match-string 3)))) + (goto-char (match-beginning 3)) + (delete-region (match-beginning 3) (match-end 3)) + (insert account) + (cond + ((> existing-len account-len) + (insert (make-string (- existing-len account-len) ? ))) + ((< existing-len account-len) + (dotimes (n (- account-len existing-len)) + (if (looking-at "[ \t]\\( [ \t]\\|\t\\)") + (delete-char 1))))))) + (goto-char pos))) + +(defun ledger-post-align-amount () + (interactive) + (save-excursion + (set-mark (line-beginning-position)) + (goto-char (1+ (line-end-position))) + (ledger-align-amounts))) + +(defun ledger-post-maybe-align (beg end len) + (save-excursion + (goto-char beg) + (when (< end (line-end-position)) + (goto-char (line-beginning-position)) + (if (looking-at ledger-regex-post-line) + (ledger-post-align-amount))))) + +(defun ledger-post-edit-amount () + (interactive) + (goto-char (line-beginning-position)) + (when (re-search-forward ledger-regex-post-line (line-end-position) t) + (goto-char (match-end 3)) + (when (re-search-forward "[-.,0-9]+" (line-end-position) t) + (let ((val (match-string 0))) + (goto-char (match-beginning 0)) + (delete-region (match-beginning 0) (match-end 0)) + (calc) + (while (string-match "," val) + (setq val (replace-match "" nil nil val))) + (calc-eval val 'push))))) + +(defun ledger-post-prev-xact () + (interactive) + (backward-paragraph) + (when (re-search-backward ledger-regex-xact-line nil t) + (goto-char (match-beginning 0)) + (re-search-forward ledger-regex-post-line) + (goto-char (match-end 3)))) + +(defun ledger-post-next-xact () + (interactive) + (when (re-search-forward ledger-regex-xact-line nil t) + (goto-char (match-beginning 0)) + (re-search-forward ledger-regex-post-line) + (goto-char (match-end 3)))) + +(defun ledger-post-setup () + (let ((map (current-local-map))) + (define-key map [(meta ?p)] 'ledger-post-prev-xact) + (define-key map [(meta ?n)] 'ledger-post-next-xact) + (define-key map [(control ?c) (control ?c)] 'ledger-post-pick-account) + (define-key map [(control ?c) (control ?e)] 'ledger-post-edit-amount)) + (if ledger-post-auto-adjust-amounts + (add-hook 'after-change-functions 'ledger-post-maybe-align t t))) + +(add-hook 'ledger-mode-hook 'ledger-post-setup) + +(provide 'ldg-post) diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el new file mode 100644 index 00000000..14c41f63 --- /dev/null +++ b/lisp/ldg-regex.el @@ -0,0 +1,167 @@ +(require 'rx) + +(defconst ledger-regex-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)))))) + "Match a single date, in its 'written' form.") + +(defconst ledger-regex-date-group 1) +(defconst ledger-regex-date-group--count 1) + +(defconst ledger-regex-full-date + (macroexpand + `(rx (and (regexp ,ledger-regex-date) + (? (and ?= (regexp ,ledger-regex-date)))))) + "Match a compound date, of the form ACTUAL=EFFECTIVE") + +(defconst ledger-regex-full-date-group-actual + ledger-regex-date-group) +(defconst ledger-regex-full-date-group-effective + (+ ledger-regex-date-group--count + ledger-regex-date-group)) +(defconst ledger-regex-full-date-group--count + (* 2 ledger-regex-date-group--count)) + +(defconst ledger-regex-state + (rx (group (any ?! ?*)))) + +(defconst ledger-regex-state-group 1) +(defconst ledger-regex-state-group--count 1) + +(defconst ledger-regex-code + (rx (and ?\( (group (+? (not (any ?\))))) ?\)))) + +(defconst ledger-regex-code-group 1) +(defconst ledger-regex-code-group--count 1) + +(defconst ledger-regex-long-space + (rx (and (*? space) + (or (and ? (or ? ?\t)) ?\t)))) + +(defconst ledger-regex-note + (rx (group (+ nonl)))) + +(defconst ledger-regex-note-group 1) +(defconst ledger-regex-note-group--count 1) + +(defconst ledger-regex-end-note + (macroexpand `(rx (and (regexp ,ledger-regex-long-space) ?\; + (regexp ,ledger-regex-note))))) + +(defconst ledger-regex-end-note-group + ledger-regex-note-group) +(defconst ledger-regex-end-note-group--count + ledger-regex-note-group--count) + +(defconst ledger-regex-full-note + (macroexpand `(rx (and line-start (+ space) + ?\; (regexp ,ledger-regex-note))))) + +(defconst ledger-regex-full-note-group + ledger-regex-note-group) +(defconst ledger-regex-full-note-group--count + ledger-regex-note-group--count) + +(defconst ledger-regex-xact-line + (macroexpand + `(rx (and line-start + (regexp ,ledger-regex-full-date) + (? (and (+ space) (regexp ,ledger-regex-state))) + (? (and (+ space) (regexp ,ledger-regex-code))) + (+ space) (+? nonl) + (? (regexp ,ledger-regex-end-note)) + line-end)))) + +(defconst ledger-regex-xact-line-group-actual-date + ledger-regex-full-date-group-actual) +(defconst ledger-regex-xact-line-group-effective-date + ledger-regex-full-date-group-effective) +(defconst ledger-regex-xact-line-group-state + (+ ledger-regex-full-date-group--count + ledger-regex-state-group)) +(defconst ledger-regex-xact-line-group-code + (+ ledger-regex-full-date-group--count + ledger-regex-state-group--count + ledger-regex-code-group)) +(defconst ledger-regex-xact-line-group-note + (+ ledger-regex-full-date-group--count + ledger-regex-state-group--count + ledger-regex-code-group--count + ledger-regex-note-group)) +(defconst ledger-regex-full-note-group--count + (+ ledger-regex-full-date-group--count + ledger-regex-state-group--count + ledger-regex-code-group--count + ledger-regex-note-group--count)) + +(defun ledger-regex-xact-line-actual-date + (&optional string) + (match-string ledger-regex-xact-line-group-actual-date string)) + +(defconst ledger-regex-account + (rx (group (and (not (any ?:)) (*? nonl))))) + +(defconst ledger-regex-full-account + (macroexpand + `(rx (and (group (? (any ?\[ ?\)))) + (regexp ,ledger-regex-account) + (? (any ?\] ?\))))))) + +(defconst ledger-regex-commodity + (rx (or (and ?\" (+ (not (any ?\"))) ?\") + (not (any space ?\n + digit + ?- ?\[ ?\] + ?. ?, ?\; ?+ ?* ?/ ?^ ?? ?: ?& ?| ?! ?= + ?\< ?\> ?\{ ?\} ?\( ?\) ?@))))) + +(defconst ledger-regex-amount + (rx (and (? ?-) + (and (+ digit) + (*? (and (any ?. ?,) (+ digit)))) + (? (and (any ?. ?,) (+ digit)))))) + +(defconst ledger-regex-commoditized-amount + (macroexpand + `(rx (or (and (regexp ,ledger-regex-commodity) + (*? space) + (regexp ,ledger-regex-amount)) + (and (regexp ,ledger-regex-amount) + (*? space) + (regexp ,ledger-regex-commodity)))))) + +(defconst ledger-regex-commodity-annotations + (macroexpand + `(rx (* (+ space) + (or (and ?\{ (regexp ,ledger-regex-commoditized-amount) ?\}) + (and ?\[ (regexp ,ledger-regex-date) ?\]) + (and ?\( (not (any ?\))) ?\))))))) + +(defconst ledger-regex-cost + (macroexpand + `(rx (and (or "@" "@@") (+ space) + (regexp ,ledger-regex-commoditized-amount))))) + +(defconst ledger-regex-balance-assertion + (macroexpand + `(rx (and ?= (+ space) + (regexp ,ledger-regex-commoditized-amount))))) + +(defconst ledger-regex-full-amount + (macroexpand `(rx (group (+? (not (any ?\;))))))) + +(defconst ledger-regex-post-line + (macroexpand + `(rx (and line-start + (? (and (+ space) (regexp ,ledger-regex-state))) + (+ space) (regexp ,ledger-regex-full-account) + (+ space) (regexp ,ledger-regex-full-amount) + (? (regexp ,ledger-regex-end-note)) + line-end)))) + +(provide 'ldg-regex) diff --git a/lisp/ldg-texi.el b/lisp/ldg-texi.el new file mode 100644 index 00000000..982ea0ed --- /dev/null +++ b/lisp/ldg-texi.el @@ -0,0 +1,121 @@ +(defvar ledger-path "/Users/johnw/bin/ledger") +(defvar ledger-sample-doc-path "/Users/johnw/src/ledger/doc/sample.dat") +(defvar ledger-normalization-args "--args-only --columns 80") + +(defun ledger-texi-write-test (name command input output &optional category) + (let ((buf (current-buffer))) + (with-current-buffer (find-file-noselect + (expand-file-name (concat name ".test") category)) + (erase-buffer) + (let ((case-fold-search nil)) + (if (string-match "\\$LEDGER\\s-+" command) + (setq command (replace-match "" t t command))) + (if (string-match " -f \\$\\([-a-z]+\\)" command) + (setq command (replace-match "" t t command)))) + (insert command ?\n) + (insert "<<<" ?\n) + (insert input) + (insert ">>>1" ?\n) + (insert output) + (insert ">>>2" ?\n) + (insert "=== 0" ?\n) + (save-buffer) + (unless (eq buf (current-buffer)) + (kill-buffer (current-buffer)))))) + +(defun ledger-texi-update-test () + (interactive) + (let ((details (ledger-texi-test-details)) + (name (file-name-sans-extension + (file-name-nondirectory (buffer-file-name))))) + (ledger-texi-write-test + name (nth 0 details) + (nth 1 details) + (ledger-texi-invoke-command + (ledger-texi-expand-command + (nth 0 details) + (ledger-texi-write-test-data name (nth 1 details))))))) + +(defun ledger-texi-test-details () + (goto-char (point-min)) + (let ((command (buffer-substring (point) (line-end-position))) + input output) + (re-search-forward "^<<<") + (let ((input-beg (1+ (match-end 0)))) + (re-search-forward "^>>>1") + (let ((output-beg (1+ (match-end 0)))) + (setq input (buffer-substring input-beg (match-beginning 0))) + (re-search-forward "^>>>2") + (setq output (buffer-substring output-beg (match-beginning 0))) + (list command input output))))) + +(defun ledger-texi-expand-command (command data-file) + (if (string-match "\\$LEDGER" command) + (replace-match (format "%s -f \"%s\" %s" ledger-path + data-file ledger-normalization-args) t t command) + (concat (format "%s -f \"%s\" %s " ledger-path + data-file ledger-normalization-args) command))) + +(defun ledger-texi-invoke-command (command) + (with-temp-buffer (shell-command command t (current-buffer)) + (if (= (point-min) (point-max)) + (progn + (push-mark nil t) + (message "Command '%s' yielded no result at %d" command (point)) + (ding)) + (buffer-string)))) + +(defun ledger-texi-write-test-data (name input) + (let ((path (expand-file-name name temporary-file-directory))) + (with-current-buffer (find-file-noselect path) + (erase-buffer) + (insert input) + (save-buffer)) + path)) + +(defun ledger-texi-update-examples () + (interactive) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^@c \\(\\(?:sm\\)?ex\\) \\(\\S-+\\): \\(.*\\)" nil t) + (let ((section (match-string 1)) + (example-name (match-string 2)) + (command (match-string 3)) expanded-command + (data-file ledger-sample-doc-path) + input output) + (goto-char (match-end 0)) + (forward-line) + (when (looking-at "@\\(\\(?:small\\)?example\\)") + (let ((beg (point))) + (re-search-forward "^@end \\(\\(?:small\\)?example\\)") + (delete-region beg (1+ (point))))) + + (when (let ((case-fold-search nil)) + (string-match " -f \\$\\([-a-z]+\\)" command)) + (let ((label (match-string 1 command))) + (setq command (replace-match "" t t command)) + (save-excursion + (goto-char (point-min)) + (search-forward (format "@c data: %s" label)) + (re-search-forward "@\\(\\(?:small\\)?example\\)") + (forward-line) + (let ((beg (point))) + (re-search-forward "@end \\(\\(?:small\\)?example\\)") + (setq data-file (ledger-texi-write-test-data + (format "%s.dat" label) + (buffer-substring-no-properties + beg (match-beginning 0)))))))) + + (let ((section-name (if (string= section "smex") + "smallexample" + "example")) + (output (ledger-texi-invoke-command + (ledger-texi-expand-command command data-file)))) + (insert "@" section-name ?\n output + "@end " section-name ?\n)) + + ;; Update the regression test associated with this example + (ledger-texi-write-test example-name command input output + "../test/manual"))))) + +(provide 'ldg-texi) diff --git a/lisp/ledger.el b/lisp/ledger.el index c2407261..9fa28781 100644 --- a/lisp/ledger.el +++ b/lisp/ledger.el @@ -73,7 +73,7 @@ (require 'esh-arg) (require 'pcomplete) -(defvar ledger-version "1.2" +(defvar ledger-version "1.3" "The version of ledger.el currently loaded") (defgroup ledger nil @@ -1226,7 +1226,7 @@ the default." "Align amounts in the current region. This is done so that the last digit falls in COLUMN, which defaults to 52." (interactive "p") - (if (= column 1) + (if (or (null column) (= column 1)) (setq column 52)) (save-excursion (let* ((mark-first (< (mark) (point))) |