diff options
Diffstat (limited to 'lisp/ldg-complete.el')
| -rw-r--r-- | lisp/ldg-complete.el | 236 |
1 files changed, 153 insertions, 83 deletions
diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index 7b4b0471..bd907bc8 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -1,29 +1,41 @@ -;;(require 'esh-util) -;;(require 'esh-arg) +;;; ldg-complete.el --- Helper code for use with the "ledger" command-line tool + +;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org) + +;; 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., 59 Temple Place - Suite 330, Boston, +;; MA 02111-1307, USA. + +;;; Commentary: +;; Functions providing payee and account auto complete. + (require 'pcomplete) ;; In-place completion support -(defun ledger-thing-at-point () - (let ((here (point))) - (goto-char (line-beginning-position)) - (cond ((looking-at "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.+?)\\)?\\s-+") - (goto-char (match-end 0)) - 'entry) - ((looking-at "^\\s-+\\([*!]\\s-+\\)?[[(]?\\(.\\)") - (goto-char (match-beginning 2)) - 'transaction) - ((looking-at "^\\(sun\\|mon\\|tue\\|wed\\|thu\\|fri\\|sat\\)\\s-+") - (goto-char (match-end 0)) - 'entry) - (t - (ignore (goto-char here)))))) +;;; Code: (defun ledger-parse-arguments () "Parse whitespace separated arguments in the current region." - (let* ((info (save-excursion - (cons (ledger-thing-at-point) (point)))) - (begin (cdr info)) + ;; this is more complex than it appears to need, so that it can work + ;; with pcomplete. See pcomplete-parse-arguments-function for + ;; details + (let* ((begin (save-excursion + (ledger-thing-at-point) ;; leave point at beginning of thing under point + (point))) (end (point)) begins args) (save-excursion @@ -36,115 +48,126 @@ args))) (cons (reverse args) (reverse begins))))) -(defun ledger-entries () + +(defun ledger-payees-in-buffer () + "Scan buffer and return list of all payees." (let ((origin (point)) - entries-list) + payees-list) (save-excursion (goto-char (point-min)) (while (re-search-forward - (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" - "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t) + ledger-payee-any-status-regex nil t) ;; matches first line (unless (and (>= origin (match-beginning 0)) (< origin (match-end 0))) - (setq entries-list (cons (match-string-no-properties 3) - entries-list))))) - (pcomplete-uniqify-list (nreverse entries-list)))) + (setq payees-list (cons (match-string-no-properties 3) + payees-list))))) ;; add the payee + ;; to the list + (pcomplete-uniqify-list (nreverse payees-list)))) -(defvar ledger-account-tree nil) - -(defun ledger-find-accounts () - (let ((origin (point)) account-path elements) +(defun ledger-find-accounts-in-buffer () + "Search through buffer and build tree of accounts. +Return tree structure" + (let ((origin (point)) + (account-tree (list t)) + (account-elements nil)) (save-excursion - (setq ledger-account-tree (list t)) (goto-char (point-min)) (while (re-search-forward - "^[ \t]+\\([*!]\\s-+\\)?[[(]?\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)" nil t) + ledger-account-any-status-regex nil t) (unless (and (>= origin (match-beginning 0)) (< origin (match-end 0))) - (setq account-path (match-string-no-properties 2)) - (setq elements (split-string account-path ":")) - (let ((root ledger-account-tree)) - (while elements - (let ((entry (assoc (car elements) root))) - (if entry - (setq root (cdr entry)) - (setq entry (cons (car elements) (list t))) - (nconc root (list entry)) - (setq root (cdr entry)))) - (setq elements (cdr elements))))))))) + (setq account-elements + (split-string + (match-string-no-properties 2) ":")) + (let ((root account-tree)) + (while account-elements + (let ((xact (assoc (car account-elements) root))) + (if xact + (setq root (cdr xact)) + (setq xact (cons (car account-elements) (list t))) + (nconc root (list xact)) + (setq root (cdr xact)))) + (setq account-elements (cdr account-elements))))))) + account-tree)) (defun ledger-accounts () - (ledger-find-accounts) + "Return a tree of all accounts in the buffer." (let* ((current (caar (ledger-parse-arguments))) (elements (and current (split-string current ":"))) - (root ledger-account-tree) + (root (ledger-find-accounts-in-buffer)) (prefix nil)) (while (cdr elements) - (let ((entry (assoc (car elements) root))) - (if entry + (let ((xact (assoc (car elements) root))) + (if xact (setq prefix (concat prefix (and prefix ":") (car elements)) - root (cdr entry)) - (setq root nil elements nil))) + root (cdr xact)) + (setq root nil elements nil))) (setq elements (cdr elements))) (and root (sort (mapcar (function (lambda (x) - (let ((term (if prefix - (concat prefix ":" (car x)) - (car x)))) - (if (> (length (cdr x)) 1) - (concat term ":") - term)))) + (let ((term (if prefix + (concat prefix ":" (car x)) + (car x)))) + (if (> (length (cdr x)) 1) + (concat term ":") + term)))) (cdr root)) 'string-lessp)))) (defun ledger-complete-at-point () - "Do appropriate completion for the thing at point" + "Do appropriate completion for the thing at point." (interactive) (while (pcomplete-here (if (eq (save-excursion - (ledger-thing-at-point)) 'entry) + (ledger-thing-at-point)) 'transaction) (if (null current-prefix-arg) - (ledger-entries) ; this completes against entry names - (progn - (let ((text (buffer-substring (line-beginning-position) - (line-end-position)))) - (delete-region (line-beginning-position) - (line-end-position)) - (condition-case err - (ledger-add-entry text t) - ((error) - (insert text)))) - (forward-line) - (goto-char (line-end-position)) - (search-backward ";" (line-beginning-position) t) - (skip-chars-backward " \t0123456789.,") - (throw 'pcompleted t))) - (ledger-accounts))))) - -(defun ledger-fully-complete-entry () - "Do appropriate completion for the thing at point" + (ledger-payees-in-buffer) ;; this completes against payee names + (progn + (let ((text (buffer-substring-no-properties (line-beginning-position) + (line-end-position)))) + (delete-region (line-beginning-position) + (line-end-position)) + (condition-case nil + (ledger-add-transaction text t) + (error nil))) + (forward-line) + (goto-char (line-end-position)) + (search-backward ";" (line-beginning-position) t) + (skip-chars-backward " \t0123456789.,") + (throw 'pcompleted t))) + (ledger-accounts))))) + +(defun ledger-fully-complete-xact () + "Completes a transaction if there is another matching payee in the buffer. +Does not use ledger xact" (interactive) - (let ((name (caar (ledger-parse-arguments))) + (let* ((name (caar (ledger-parse-arguments))) + (rest-of-name name) xacts) (save-excursion - (when (eq 'entry (ledger-thing-at-point)) + (when (eq 'transaction (ledger-thing-at-point)) + (delete-region (point) (+ (length name) (point))) + ;; Search backward for a matching payee (when (re-search-backward - (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" - (regexp-quote name) "\\(\t\\|\n\\| [ \t]\\)") nil t) - (forward-line) - (while (looking-at "^\\s-+") + (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.*" + (regexp-quote name) ".*\\)" ) nil t) + (setq rest-of-name (match-string 3)) + ;; Start copying the postings + (forward-line) + (while (looking-at ledger-account-any-status-regex) (setq xacts (cons (buffer-substring-no-properties (line-beginning-position) (line-end-position)) xacts)) (forward-line)) (setq xacts (nreverse xacts))))) + ;; Insert rest-of-name and the postings (when xacts (save-excursion - (insert ?\n) + (insert rest-of-name ?\n) (while xacts (insert (car xacts) ?\n) (setq xacts (cdr xacts)))) @@ -153,4 +176,51 @@ (if (re-search-backward "\\(\t\\| [ \t]\\)" nil t) (goto-char (match-end 0)))))) + +(defun ledger-pcomplete (&optional interactively) + "Complete rip-off of pcomplete from pcomplete.el, only added +ledger-magic-tab in the previous commands list so that +ledger-magic-tab would cycle properly" + (interactive "p") + (if (and interactively + pcomplete-cycle-completions + pcomplete-current-completions + (memq last-command '(ledger-magic-tab + ledger-pcomplete + pcomplete-expand-and-complete + pcomplete-reverse))) + (progn + (delete-backward-char pcomplete-last-completion-length) + (if (eq this-command 'pcomplete-reverse) + (progn + (push (car (last pcomplete-current-completions)) + pcomplete-current-completions) + (setcdr (last pcomplete-current-completions 2) nil)) + (nconc pcomplete-current-completions + (list (car pcomplete-current-completions))) + (setq pcomplete-current-completions + (cdr pcomplete-current-completions))) + (pcomplete-insert-entry pcomplete-last-completion-stub + (car pcomplete-current-completions) + nil pcomplete-last-completion-raw)) + (setq pcomplete-current-completions nil + pcomplete-last-completion-raw nil) + (catch 'pcompleted + (let* ((pcomplete-stub) + pcomplete-seen pcomplete-norm-func + pcomplete-args pcomplete-last pcomplete-index + (pcomplete-autolist pcomplete-autolist) + (pcomplete-suffix-list pcomplete-suffix-list) + (completions (pcomplete-completions)) + (result (pcomplete-do-complete pcomplete-stub completions))) + (and result + (not (eq (car result) 'listed)) + (cdr result) + (pcomplete-insert-entry pcomplete-stub (cdr result) + (memq (car result) + '(sole shortest)) + pcomplete-last-completion-raw)))))) + (provide 'ldg-complete) + +;;; ldg-complete.el ends here |