Include contents of elpa/ sources + theme update.

1 files changed, 362 insertions, 0 deletions

diff --git a/elpa/ledger-mode-20200530.1710/ledger-complete.el b/elpa/ledger-mode-20200530.1710/ledger-complete.el
new file mode 100644
index 0000000..2bf2cec
--- /dev/null
+++ b/elpa/ledger-mode-20200530.1710/ledger-complete.el
@@ -0,0 +1,362 @@
+;;; ledger-complete.el --- Helper code for use with the "ledger" command-line tool  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2003-2016 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., 51 Franklin Street, Fifth Floor, Boston,
+;; MA 02110-1301 USA.
+
+;;; Commentary:
+;; Functions providing payee and account auto complete.
+
+(require 'cl-lib)
+(eval-when-compile
+  (require 'subr-x))
+
+;; In-place completion support
+
+;;; Code:
+(require 'ledger-context)
+(require 'ledger-xact)
+(require 'ledger-schedule)
+
+(defcustom ledger-accounts-file nil
+  "The path to an optional file in which all accounts are used or declared.
+This file will then be used as a source for account name completions."
+  :type 'file
+  :group 'ledger)
+
+(defcustom ledger-accounts-exclude-function nil
+  "Function to exclude accounts from completion.
+Should be a predicate function that accepts one argument, an
+element of `ledger-accounts-list-in-buffer'."
+  :type 'function
+  :group 'ledger
+  :package-version '(ledger-mode . "2019-08-14"))
+
+(defcustom ledger-complete-in-steps nil
+  "When non-nil, `ledger-complete-at-point' completes account names in steps.
+If nil, full account names are offered for completion."
+  :type 'boolean
+  :group 'ledger
+  :package-version '(ledger-mode . "4.0.0"))
+
+(defun ledger-parse-arguments ()
+  "Parse whitespace separated arguments in the current region."
+  ;; FIXME: We don't use pcomplete anymore.
+  ;; 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-match-data
+                  (if (looking-back (concat "^\\(" ledger-iso-date-regexp "=\\|\\)"
+                                            ledger-incomplete-date-regexp) nil)
+                      (match-end 1)
+                    (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
+    (sort (delete-dups payees-list) #'string-lessp)))
+
+(defun ledger-accounts-in-buffer ()
+  "Return an alist of accounts in the current buffer.
+The `car' of each element is the account name and the `cdr' is an
+alist where the key is a subdirective such as \"assert\" and the
+value (if any) is the associated data.  In other words, if you've
+declared an account like so:
+
+account Assets:Checking
+    assert commodity == \"$\"
+    default
+
+Then one of the elements this function returns will be
+\(\"Assets:Checking\"
+  (\"default\")
+  (\"assert\" . \"commodity == \"$\"\"))"
+  (save-excursion
+    (goto-char (point-min))
+    (let (account-list
+          (seen (make-hash-table :test #'equal :size 1)))
+      ;; First, consider accounts declared with "account" directives, which may or
+      ;; may not have associated data. The data is on the following lines up to a
+      ;; line not starting with whitespace.
+      (while (re-search-forward ledger-account-directive-regex nil t)
+        (let ((account (match-string-no-properties 1))
+              (lines (buffer-substring-no-properties
+                      (point)
+                      (progn (ledger-navigate-next-xact-or-directive)
+                             (point))))
+              data)
+          (dolist (d (split-string lines "\n"))
+            (setq d (string-trim d))
+            (unless (string= d "")
+              (if (string-match " " d)
+                  (push (cons (substring d 0 (match-beginning 0))
+                              (substring d (match-end 0) nil))
+                        data)
+                (push (cons d nil) data))))
+          (push (cons account data) account-list)
+          (puthash account t seen)))
+      ;; Next, gather all accounts declared in postings
+      (unless
+          ;; FIXME: People who have set `ledger-flymake-be-pedantic' to non-nil
+          ;; probably don't want accounts from postings, just those declared
+          ;; with directives.  But the name is a little misleading.  Should we
+          ;; make a ledger-mode-be-pedantic and use that instead?
+          (bound-and-true-p ledger-flymake-be-pedantic)
+        (goto-char (point-min))
+        (while (re-search-forward ledger-account-name-or-directive-regex nil t)
+          (let ((account (match-string-no-properties 1)))
+            (unless (gethash account seen)
+              (puthash account t seen)
+              (push (cons account nil) account-list)))))
+      (sort account-list (lambda (a b) (string-lessp (car a) (car b)))))))
+
+(defun ledger-accounts-list-in-buffer ()
+  "Return a list of all known account names in the current buffer as strings.
+Considers both accounts listed in postings and those declared with \"account\" directives."
+  (let ((accounts (ledger-accounts-in-buffer)))
+    (when ledger-accounts-exclude-function
+      (setq accounts (cl-remove-if ledger-accounts-exclude-function accounts)))
+    (mapcar #'car accounts)))
+
+(defun ledger-accounts-list ()
+  "Return a list of all known account names as strings.
+Looks in `ledger-accounts-file' if set, otherwise the current buffer."
+  (if ledger-accounts-file
+      (let ((f ledger-accounts-file))
+        (with-temp-buffer
+          (insert-file-contents f)
+          (ledger-accounts-list-in-buffer)))
+    (ledger-accounts-list-in-buffer)))
+
+(defun ledger-find-accounts-in-buffer ()
+  (let ((account-tree (list t))
+        (account-elements nil)
+        (prefix ""))
+    (save-excursion
+      (goto-char (point-min))
+
+      (dolist (account
+               (cl-remove-if-not (lambda (c) (string-prefix-p prefix c))
+                                 (ledger-accounts-list)))
+        (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-accounts-tree ()
+  "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-date (month-string day-string)
+  "Complete a date."
+  (let*
+      ((now (current-time))
+       (decoded (decode-time now))
+       (this-month (nth 4 decoded))
+       (this-year (nth 5 decoded))
+       (last-month (if (> this-month 1) (1- this-month) 12))
+       (last-year (1- this-year))
+       (last-month-year (if (> this-month 1) this-year last-year))
+       (month (and month-string
+                   (string-to-number month-string)))
+       (day (string-to-number day-string))
+       (dates (list (encode-time 0 0 0 day (or month this-month) this-year)
+                    (if month
+                        (encode-time 0 0 0 day month last-year)
+                      (encode-time 0 0 0 day last-month last-month-year)))))
+    (lambda (_string _predicate _all)
+      (concat (ledger-format-date
+               (cl-find-if (lambda (date) (not (time-less-p now date))) dates))
+              (and (= (point) (line-end-position)) " ")))))
+
+(defun ledger-complete-effective-date
+    (tx-year-string tx-month-string tx-day-string
+                    month-string day-string)
+  "Complete an effective date."
+  (let*
+      ((tx-year (string-to-number tx-year-string))
+       (tx-month (string-to-number tx-month-string))
+       (tx-day (string-to-number tx-day-string))
+       (tx-date (encode-time 0 0 0 tx-day tx-month tx-year))
+       (next-month (if (< tx-month 12) (1+ tx-month) 1))
+       (next-year (1+ tx-year))
+       (next-month-year (if (< tx-month 12) tx-year next-year))
+       (month (and month-string
+                   (string-to-number month-string)))
+       (day (string-to-number day-string))
+       (dates (list (encode-time 0 0 0 day (or month tx-month) tx-year)
+                    (if month
+                        (encode-time 0 0 0 day month next-year)
+                      (encode-time 0 0 0 day next-month next-month-year)))))
+    (lambda (_string _predicate _all)
+      (concat (ledger-format-date
+               (cl-find-if (lambda (date) (not (time-less-p date tx-date))) dates))
+              (and (= (point) (line-end-position)) " ")))))
+
+(defun ledger-complete-at-point ()
+  "Do appropriate completion for the thing at point."
+  (let ((end (point))
+        start collection
+        realign-after
+        delete-suffix)
+    (cond (;; Date
+           (looking-back (concat "^" ledger-incomplete-date-regexp) (line-beginning-position))
+           (setq collection (ledger-complete-date (match-string 1) (match-string 2))
+                 start (match-beginning 0)
+                 delete-suffix (save-match-data
+                                 (when (looking-at (rx (one-or-more (or digit (any ?/ ?-)))))
+                                   (length (match-string 0))))))
+          (;; Effective dates
+           (looking-back (concat "^" ledger-iso-date-regexp "=" ledger-incomplete-date-regexp)
+                         (line-beginning-position))
+           (setq start (line-beginning-position))
+           (setq collection (ledger-complete-effective-date
+                             (match-string 2) (match-string 3) (match-string 4)
+                             (match-string 5) (match-string 6))))
+          (;; Payees
+           (eq (save-excursion (ledger-thing-at-point)) 'transaction)
+           (setq start (save-excursion (backward-word) (point)))
+           (setq collection #'ledger-payees-in-buffer))
+          (;; Accounts
+           (looking-back (rx-to-string `(seq bol (one-or-more space)
+                                             (optional (any ?\( ?\[ )) ;; for virtual accounts
+                                             (group (zero-or-more (not space)))))
+                         (line-beginning-position))
+           (setq start (match-beginning 1)
+                 delete-suffix (save-excursion
+                                 (when (search-forward-regexp (rx (or eol (repeat 2 space))) (line-end-position) t)
+                                   (- (match-beginning 0) end)))
+                 realign-after t
+                 collection (if ledger-complete-in-steps
+                                #'ledger-accounts-tree
+                              #'ledger-accounts-list))))
+    (when collection
+      (let ((prefix (buffer-substring-no-properties start end)))
+        (list start end
+              (if (functionp collection)
+                  (completion-table-with-cache
+                   (lambda (_)
+                     (cl-remove-if (apply-partially 'string= prefix) (funcall collection))))
+                collection)
+              :exit-function (lambda (&rest _)
+                               (when delete-suffix
+                                 (delete-char delete-suffix))
+                               (when (and realign-after ledger-post-auto-align)
+                                 (ledger-post-align-postings (line-beginning-position) (line-end-position))))
+              'ignore)))))
+
+(defun ledger-trim-trailing-whitespace (str)
+  (replace-regexp-in-string "[ \t]*$" "" str))
+
+(defun ledger-fully-complete-xact ()
+  "Completes a transaction if there is another matching payee in the buffer.
+
+Interactively, if point is after a payee, complete the
+transaction with the details from the last transaction to that
+payee."
+  (interactive)
+  (let* ((name (ledger-trim-trailing-whitespace (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)
+          (setq xacts (buffer-substring-no-properties (point) (ledger-navigate-end-of-xact))))))
+    ;; Insert rest-of-name and the postings
+    (save-excursion
+      (insert rest-of-name ?\n)
+      (insert xacts)
+      (unless (looking-at-p "\n\n")
+        (insert "\n")))
+    (forward-line)
+    (goto-char (line-end-position))
+    (when (re-search-backward "\\(\t\\| [ \t]\\)" nil t)
+      (goto-char (match-end 0)))))
+
+(provide 'ledger-complete)
+
+;;; ledger-complete.el ends here