summaryrefslogtreecommitdiff
path: root/lisp/ldg-complete.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/ldg-complete.el')
-rw-r--r--lisp/ldg-complete.el257
1 files changed, 0 insertions, 257 deletions
diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el
deleted file mode 100644
index 1bc7588c..00000000
--- a/lisp/ldg-complete.el
+++ /dev/null
@@ -1,257 +0,0 @@
-;;; 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
-
-;;; Code:
-
-(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
- ;; 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)
- ;; to support end of line metadata
- (save-excursion
- (when (search-backward ";"
- (line-beginning-position) t)
- (setq begin (match-beginning 0))))
- (save-excursion
- (goto-char begin)
- (when (< (point) end)
- (skip-chars-forward " \t\n")
- (setq begins (cons (point) begins))
- (setq args (cons (buffer-substring-no-properties
- (car begins) end)
- args)))
- (cons (reverse args) (reverse begins)))))
-
-
-(defun ledger-payees-in-buffer ()
- "Scan buffer and return list of all payees."
- (let ((origin (point))
- payees-list)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward
- ledger-payee-any-status-regex nil t) ;; matches first line
- (unless (and (>= origin (match-beginning 0))
- (< origin (match-end 0)))
- (setq payees-list (cons (match-string-no-properties 3)
- payees-list))))) ;; add the payee
- ;; to the list
- (pcomplete-uniqify-list (nreverse payees-list))))
-
-
-(defun ledger-find-accounts-in-buffer ()
- (interactive)
- (let ((origin (point))
- accounts
- (account-tree (list t))
- (account-elements nil)
- (seed-regex (ledger-account-any-status-with-seed-regex
- (regexp-quote (car pcomplete-args)))))
- (save-excursion
- (goto-char (point-min))
-
- (dolist (account
- (delete-dups
- (progn
- (while (re-search-forward seed-regex nil t)
- (unless (between origin (match-beginning 0) (match-end 0))
- (setq accounts (cons (match-string-no-properties 2) accounts))))
- accounts)))
- (let ((root account-tree))
- (setq account-elements
- (split-string
- account ":"))
- (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-find-metadata-in-buffer ()
- "Search through buffer and build list of metadata.
-Return list."
- (let ((origin (point)) accounts)
- (save-excursion
- (setq ledger-account-tree (list t))
- (goto-char (point-min))
- (while (re-search-forward
- ledger-metadata-regex
- nil t)
- (unless (and (>= origin (match-beginning 0))
- (< origin (match-end 0)))
- (setq accounts (cons (match-string-no-properties 2) accounts)))))
- accounts))
-
-(defun ledger-accounts ()
- "Return a tree of all accounts in the buffer."
- (let* ((current (caar (ledger-parse-arguments)))
- (elements (and current (split-string current ":")))
- (root (ledger-find-accounts-in-buffer))
- (prefix nil))
- (while (cdr elements)
- (let ((xact (assoc (car elements) root)))
- (if xact
- (setq prefix (concat prefix (and prefix ":")
- (car elements))
- root (cdr xact))
- (setq root nil elements nil)))
- (setq elements (cdr elements)))
- (setq root (delete (list (car elements) t) root))
- (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))))
- (cdr root))
- 'string-lessp))))
-
-(defun ledger-complete-at-point ()
- "Do appropriate completion for the thing at point."
- (interactive)
- (while (pcomplete-here
- (if (eq (save-excursion
- (ledger-thing-at-point)) 'transaction)
- (if (null current-prefix-arg)
- (delete
- (caar (ledger-parse-arguments))
- (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)))
- (rest-of-name name)
- xacts)
- (save-excursion
- (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) ".*\\)" ) 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 rest-of-name ?\n)
- (while xacts
- (insert (car xacts) ?\n)
- (setq xacts (cdr xacts))))
- (forward-line)
- (goto-char (line-end-position))
- (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
generated by cgit v1.2.3 (git 2.39.1) at 2025-01-08 21:06:00 +0000