Dramatic improvements to account completion speeds.
This commit is contained in:
Craig Earls
parent
e0b02afd60
commit
7540647f01
4 changed files with 222 additions and 234 deletions
|
|
@ -34,8 +34,8 @@
|
|||
;; 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)))
|
||||
(ledger-thing-at-point) ;; leave point at beginning of thing under point
|
||||
(point)))
|
||||
(end (point))
|
||||
begins args)
|
||||
;; to support end of line metadata
|
||||
|
|
@ -65,8 +65,8 @@
|
|||
(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
|
||||
payees-list))))) ;; add the payee
|
||||
;; to the list
|
||||
(pcomplete-uniqify-list (nreverse payees-list))))
|
||||
|
||||
|
||||
|
|
@ -75,14 +75,16 @@
|
|||
(let ((origin (point))
|
||||
accounts
|
||||
(account-tree (list t))
|
||||
(account-elements nil))
|
||||
(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 ledger-account-any-status-regex nil t)
|
||||
(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)))
|
||||
|
|
@ -127,19 +129,19 @@ Return list."
|
|||
(setq prefix (concat prefix (and prefix ":")
|
||||
(car elements))
|
||||
root (cdr xact))
|
||||
(setq root nil elements nil)))
|
||||
(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))))
|
||||
(let ((term (if prefix
|
||||
(concat prefix ":" (car x))
|
||||
(car x))))
|
||||
(if (> (length (cdr x)) 1)
|
||||
(concat term ":")
|
||||
term))))
|
||||
(cdr root))
|
||||
'string-lessp))))
|
||||
|
||||
|
|
@ -153,21 +155,21 @@ Return list."
|
|||
(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)))))
|
||||
(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.
|
||||
|
|
@ -225,30 +227,30 @@ ledger-magic-tab would cycle properly"
|
|||
(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)))
|
||||
(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))))))
|
||||
(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)
|
||||
|
||||
|
|
|
|||
220
lisp/ldg-mode.el
220
lisp/ldg-mode.el
|
|
@ -41,31 +41,31 @@
|
|||
|
||||
(defun ledger-read-account-with-prompt (prompt)
|
||||
(let* ((context (ledger-context-at-point))
|
||||
(default (if (and (eq (ledger-context-line-type context) 'acct-transaction)
|
||||
(eq (ledger-context-current-field context) 'account))
|
||||
(regexp-quote (ledger-context-field-value context 'account))
|
||||
nil)))
|
||||
(default (if (and (eq (ledger-context-line-type context) 'acct-transaction)
|
||||
(eq (ledger-context-current-field context) 'account))
|
||||
(regexp-quote (ledger-context-field-value context 'account))
|
||||
nil)))
|
||||
(ledger-read-string-with-default prompt default)))
|
||||
|
||||
(defun ledger-read-string-with-default (prompt default)
|
||||
"Return user supplied string after PROMPT, or DEFAULT."
|
||||
(read-string (concat prompt
|
||||
(if default
|
||||
(concat " (" default "): ")
|
||||
": "))
|
||||
nil 'ledger-minibuffer-history default))
|
||||
(if default
|
||||
(concat " (" default "): ")
|
||||
": "))
|
||||
nil 'ledger-minibuffer-history default))
|
||||
|
||||
(defun ledger-display-balance-at-point ()
|
||||
"Display the cleared-or-pending balance.
|
||||
And calculate the target-delta of the account being reconciled."
|
||||
(interactive)
|
||||
(let* ((account (ledger-read-account-with-prompt "Account balance to show"))
|
||||
(buffer (current-buffer))
|
||||
(balance (with-temp-buffer
|
||||
(ledger-exec-ledger buffer (current-buffer) "cleared" account)
|
||||
(if (> (buffer-size) 0)
|
||||
(buffer-substring-no-properties (point-min) (1- (point-max)))
|
||||
(concat account " is empty.")))))
|
||||
(buffer (current-buffer))
|
||||
(balance (with-temp-buffer
|
||||
(ledger-exec-ledger buffer (current-buffer) "cleared" account)
|
||||
(if (> (buffer-size) 0)
|
||||
(buffer-substring-no-properties (point-min) (1- (point-max)))
|
||||
(concat account " is empty.")))))
|
||||
(when balance
|
||||
(message balance))))
|
||||
|
||||
|
|
@ -96,117 +96,117 @@ Can indent, complete or align depending on context."
|
|||
(defun ledger-insert-effective-date ()
|
||||
(interactive)
|
||||
(let ((context (car (ledger-context-at-point)))
|
||||
(date-string (format-time-string (cdr (assoc "date-format" ledger-environment-alist)))))
|
||||
(cond ((eq 'xact context)
|
||||
(beginning-of-line)
|
||||
(insert date-string "="))
|
||||
((eq 'acct-transaction context)
|
||||
(end-of-line)
|
||||
(insert " ; [=" date-string "]")))))
|
||||
(date-string (format-time-string (cdr (assoc "date-format" ledger-environment-alist)))))
|
||||
(cond ((eq 'xact context)
|
||||
(beginning-of-line)
|
||||
(insert date-string "="))
|
||||
((eq 'acct-transaction context)
|
||||
(end-of-line)
|
||||
(insert " ; [=" date-string "]")))))
|
||||
|
||||
;;;###autoload
|
||||
(define-derived-mode ledger-mode text-mode "Ledger"
|
||||
"A mode for editing ledger data files."
|
||||
(ledger-check-version)
|
||||
(ledger-post-setup)
|
||||
"A mode for editing ledger data files."
|
||||
(ledger-check-version)
|
||||
(ledger-post-setup)
|
||||
|
||||
(set (make-local-variable 'comment-start) " ; ")
|
||||
(set (make-local-variable 'comment-end) "")
|
||||
(set (make-local-variable 'indent-tabs-mode) nil)
|
||||
(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)))
|
||||
(setq font-lock-extend-region-functions
|
||||
(list #'font-lock-extend-region-wholelines))
|
||||
(setq font-lock-multiline nil)
|
||||
(if (boundp 'font-lock-defaults)
|
||||
(set (make-local-variable 'font-lock-defaults)
|
||||
'(ledger-font-lock-keywords nil t)))
|
||||
(setq font-lock-extend-region-functions
|
||||
(list #'font-lock-extend-region-wholelines))
|
||||
(setq font-lock-multiline nil)
|
||||
|
||||
(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) "")
|
||||
(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) "")
|
||||
|
||||
(add-hook 'post-command-hook 'ledger-highlight-xact-under-point nil t)
|
||||
(add-hook 'before-revert-hook 'ledger-occur-remove-all-overlays nil t)
|
||||
(make-variable-buffer-local 'highlight-overlay)
|
||||
(add-hook 'post-command-hook 'ledger-highlight-xact-under-point nil t)
|
||||
(add-hook 'before-revert-hook 'ledger-occur-remove-all-overlays nil t)
|
||||
(make-variable-buffer-local 'highlight-overlay)
|
||||
|
||||
(ledger-init-load-init-file)
|
||||
(ledger-init-load-init-file)
|
||||
|
||||
(set (make-local-variable 'indent-region-function) 'ledger-post-align-postings)
|
||||
(set (make-local-variable 'indent-region-function) 'ledger-post-align-postings)
|
||||
|
||||
(let ((map (current-local-map)))
|
||||
(define-key map [(control ?c) (control ?a)] 'ledger-add-transaction)
|
||||
(define-key map [(control ?c) (control ?b)] 'ledger-post-edit-amount)
|
||||
(define-key map [(control ?c) (control ?c)] 'ledger-toggle-current)
|
||||
(define-key map [(control ?c) (control ?d)] 'ledger-delete-current-transaction)
|
||||
(define-key map [(control ?c) (control ?e)] 'ledger-toggle-current-transaction)
|
||||
(define-key map [(control ?c) (control ?f)] 'ledger-occur)
|
||||
(define-key map [(control ?c) (control ?k)] 'ledger-copy-transaction-at-point)
|
||||
(define-key map [(control ?c) (control ?m)] 'ledger-set-month)
|
||||
(define-key map [(control ?c) (control ?r)] 'ledger-reconcile)
|
||||
(define-key map [(control ?c) (control ?s)] 'ledger-sort-region)
|
||||
(define-key map [(control ?c) (control ?t)] 'ledger-insert-effective-date)
|
||||
(define-key map [(control ?c) (control ?u)] 'ledger-schedule-upcoming)
|
||||
(define-key map [(control ?c) (control ?y)] 'ledger-set-year)
|
||||
(define-key map [(control ?c) (control ?p)] 'ledger-display-balance-at-point)
|
||||
(define-key map [(control ?c) (control ?l)] 'ledger-display-ledger-stats)
|
||||
(let ((map (current-local-map)))
|
||||
(define-key map [(control ?c) (control ?a)] 'ledger-add-transaction)
|
||||
(define-key map [(control ?c) (control ?b)] 'ledger-post-edit-amount)
|
||||
(define-key map [(control ?c) (control ?c)] 'ledger-toggle-current)
|
||||
(define-key map [(control ?c) (control ?d)] 'ledger-delete-current-transaction)
|
||||
(define-key map [(control ?c) (control ?e)] 'ledger-toggle-current-transaction)
|
||||
(define-key map [(control ?c) (control ?f)] 'ledger-occur)
|
||||
(define-key map [(control ?c) (control ?k)] 'ledger-copy-transaction-at-point)
|
||||
(define-key map [(control ?c) (control ?m)] 'ledger-set-month)
|
||||
(define-key map [(control ?c) (control ?r)] 'ledger-reconcile)
|
||||
(define-key map [(control ?c) (control ?s)] 'ledger-sort-region)
|
||||
(define-key map [(control ?c) (control ?t)] 'ledger-insert-effective-date)
|
||||
(define-key map [(control ?c) (control ?u)] 'ledger-schedule-upcoming)
|
||||
(define-key map [(control ?c) (control ?y)] 'ledger-set-year)
|
||||
(define-key map [(control ?c) (control ?p)] 'ledger-display-balance-at-point)
|
||||
(define-key map [(control ?c) (control ?l)] 'ledger-display-ledger-stats)
|
||||
|
||||
(define-key map [tab] 'ledger-magic-tab)
|
||||
(define-key map [(control tab)] 'ledger-post-align-xact)
|
||||
(define-key map [(control ?i)] 'ledger-magic-tab)
|
||||
(define-key map [(control ?c) tab] 'ledger-fully-complete-xact)
|
||||
(define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-xact)
|
||||
(define-key map [tab] 'ledger-magic-tab)
|
||||
(define-key map [(control tab)] 'ledger-post-align-xact)
|
||||
(define-key map [(control ?i)] 'ledger-magic-tab)
|
||||
(define-key map [(control ?c) tab] 'ledger-fully-complete-xact)
|
||||
(define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-xact)
|
||||
|
||||
(define-key map [(control ?c) (control ?o) (control ?a)] 'ledger-report-redo)
|
||||
(define-key map [(control ?c) (control ?o) (control ?e)] 'ledger-report-edit)
|
||||
(define-key map [(control ?c) (control ?o) (control ?g)] 'ledger-report-goto)
|
||||
(define-key map [(control ?c) (control ?o) (control ?k)] 'ledger-report-kill)
|
||||
(define-key map [(control ?c) (control ?o) (control ?r)] 'ledger-report)
|
||||
(define-key map [(control ?c) (control ?o) (control ?s)] 'ledger-report-save)
|
||||
(define-key map [(control ?c) (control ?o) (control ?a)] 'ledger-report-redo)
|
||||
(define-key map [(control ?c) (control ?o) (control ?e)] 'ledger-report-edit)
|
||||
(define-key map [(control ?c) (control ?o) (control ?g)] 'ledger-report-goto)
|
||||
(define-key map [(control ?c) (control ?o) (control ?k)] 'ledger-report-kill)
|
||||
(define-key map [(control ?c) (control ?o) (control ?r)] 'ledger-report)
|
||||
(define-key map [(control ?c) (control ?o) (control ?s)] 'ledger-report-save)
|
||||
|
||||
(define-key map [(meta ?p)] 'ledger-post-prev-xact)
|
||||
(define-key map [(meta ?n)] 'ledger-post-next-xact)
|
||||
(define-key map [(meta ?p)] 'ledger-post-prev-xact)
|
||||
(define-key map [(meta ?n)] 'ledger-post-next-xact)
|
||||
|
||||
(define-key map [menu-bar] (make-sparse-keymap "ldg-menu"))
|
||||
(define-key map [menu-bar ldg-menu] (cons "Ledger" map))
|
||||
(define-key map [menu-bar] (make-sparse-keymap "ldg-menu"))
|
||||
(define-key map [menu-bar ldg-menu] (cons "Ledger" map))
|
||||
|
||||
(define-key map [report-kill] '(menu-item "Kill Report" ledger-report-kill :enable ledger-works))
|
||||
(define-key map [report-edit] '(menu-item "Edit Report" ledger-report-edit :enable ledger-works))
|
||||
(define-key map [report-save] '(menu-item "Save Report" ledger-report-save :enable ledger-works))
|
||||
(define-key map [report-rrun] '(menu-item "Re-run Report" ledger-report-redo :enable ledger-works))
|
||||
(define-key map [report-goto] '(menu-item "Goto Report" ledger-report-goto :enable ledger-works))
|
||||
(define-key map [report-run] '(menu-item "Run Report" ledger-report :enable ledger-works))
|
||||
(define-key map [sep5] '(menu-item "--"))
|
||||
(define-key map [set-month] '(menu-item "Set Month" ledger-set-month :enable ledger-works))
|
||||
(define-key map [set-year] '(menu-item "Set Year" ledger-set-year :enable ledger-works))
|
||||
(define-key map [cust] '(menu-item "Customize Ledger Mode" (lambda ()
|
||||
(interactive)
|
||||
(customize-group 'ledger))))
|
||||
(define-key map [sep1] '("--"))
|
||||
(define-key map [effective-date] '(menu-item "Set effective date" ledger-insert-effective-date))
|
||||
(define-key map [sort-end] '(menu-item "Mark Sort End" ledger-sort-insert-end-mark))
|
||||
(define-key map [sort-start] '(menu-item "Mark Sort Beginning" ledger-sort-insert-start-mark))
|
||||
(define-key map [sort-buff] '(menu-item "Sort Buffer" ledger-sort-buffer))
|
||||
(define-key map [sort-reg] '(menu-item "Sort Region" ledger-sort-region :enable mark-active))
|
||||
(define-key map [align-xact] '(menu-item "Align Xact" ledger-post-align-xact))
|
||||
(define-key map [align-reg] '(menu-item "Align Region" ledger-post-align-postings :enable mark-active))
|
||||
(define-key map [sep2] '(menu-item "--"))
|
||||
(define-key map [copy-xact] '(menu-item "Copy Trans at Point" ledger-copy-transaction-at-point))
|
||||
(define-key map [toggle-post] '(menu-item "Toggle Current Posting" ledger-toggle-current))
|
||||
(define-key map [toggle-xact] '(menu-item "Toggle Current Transaction" ledger-toggle-current-transaction))
|
||||
(define-key map [sep4] '(menu-item "--"))
|
||||
(define-key map [recon-account] '(menu-item "Reconcile Account" ledger-reconcile :enable ledger-works))
|
||||
(define-key map [check-balance] '(menu-item "Check Balance" ledger-display-balance-at-point :enable ledger-works))
|
||||
(define-key map [sep6] '(menu-item "--"))
|
||||
(define-key map [edit-amount] '(menu-item "Calc on Amount" ledger-post-edit-amount))
|
||||
(define-key map [sep] '(menu-item "--"))
|
||||
(define-key map [delete-xact] '(menu-item "Delete Transaction" ledger-delete-current-transaction))
|
||||
(define-key map [cmp-xact] '(menu-item "Complete Transaction" ledger-fully-complete-xact))
|
||||
(define-key map [add-xact] '(menu-item "Add Transaction (ledger xact)" ledger-add-transaction :enable ledger-works))
|
||||
(define-key map [sep3] '(menu-item "--"))
|
||||
(define-key map [stats] '(menu-item "Ledger Statistics" ledger-display-ledger-stats :enable ledger-works))
|
||||
(define-key map [fold-buffer] '(menu-item "Narrow to REGEX" ledger-occur))))
|
||||
(define-key map [report-kill] '(menu-item "Kill Report" ledger-report-kill :enable ledger-works))
|
||||
(define-key map [report-edit] '(menu-item "Edit Report" ledger-report-edit :enable ledger-works))
|
||||
(define-key map [report-save] '(menu-item "Save Report" ledger-report-save :enable ledger-works))
|
||||
(define-key map [report-rrun] '(menu-item "Re-run Report" ledger-report-redo :enable ledger-works))
|
||||
(define-key map [report-goto] '(menu-item "Goto Report" ledger-report-goto :enable ledger-works))
|
||||
(define-key map [report-run] '(menu-item "Run Report" ledger-report :enable ledger-works))
|
||||
(define-key map [sep5] '(menu-item "--"))
|
||||
(define-key map [set-month] '(menu-item "Set Month" ledger-set-month :enable ledger-works))
|
||||
(define-key map [set-year] '(menu-item "Set Year" ledger-set-year :enable ledger-works))
|
||||
(define-key map [cust] '(menu-item "Customize Ledger Mode" (lambda ()
|
||||
(interactive)
|
||||
(customize-group 'ledger))))
|
||||
(define-key map [sep1] '("--"))
|
||||
(define-key map [effective-date] '(menu-item "Set effective date" ledger-insert-effective-date))
|
||||
(define-key map [sort-end] '(menu-item "Mark Sort End" ledger-sort-insert-end-mark))
|
||||
(define-key map [sort-start] '(menu-item "Mark Sort Beginning" ledger-sort-insert-start-mark))
|
||||
(define-key map [sort-buff] '(menu-item "Sort Buffer" ledger-sort-buffer))
|
||||
(define-key map [sort-reg] '(menu-item "Sort Region" ledger-sort-region :enable mark-active))
|
||||
(define-key map [align-xact] '(menu-item "Align Xact" ledger-post-align-xact))
|
||||
(define-key map [align-reg] '(menu-item "Align Region" ledger-post-align-postings :enable mark-active))
|
||||
(define-key map [sep2] '(menu-item "--"))
|
||||
(define-key map [copy-xact] '(menu-item "Copy Trans at Point" ledger-copy-transaction-at-point))
|
||||
(define-key map [toggle-post] '(menu-item "Toggle Current Posting" ledger-toggle-current))
|
||||
(define-key map [toggle-xact] '(menu-item "Toggle Current Transaction" ledger-toggle-current-transaction))
|
||||
(define-key map [sep4] '(menu-item "--"))
|
||||
(define-key map [recon-account] '(menu-item "Reconcile Account" ledger-reconcile :enable ledger-works))
|
||||
(define-key map [check-balance] '(menu-item "Check Balance" ledger-display-balance-at-point :enable ledger-works))
|
||||
(define-key map [sep6] '(menu-item "--"))
|
||||
(define-key map [edit-amount] '(menu-item "Calc on Amount" ledger-post-edit-amount))
|
||||
(define-key map [sep] '(menu-item "--"))
|
||||
(define-key map [delete-xact] '(menu-item "Delete Transaction" ledger-delete-current-transaction))
|
||||
(define-key map [cmp-xact] '(menu-item "Complete Transaction" ledger-fully-complete-xact))
|
||||
(define-key map [add-xact] '(menu-item "Add Transaction (ledger xact)" ledger-add-transaction :enable ledger-works))
|
||||
(define-key map [sep3] '(menu-item "--"))
|
||||
(define-key map [stats] '(menu-item "Ledger Statistics" ledger-display-ledger-stats :enable ledger-works))
|
||||
(define-key map [fold-buffer] '(menu-item "Narrow to REGEX" ledger-occur))))
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -38,8 +38,8 @@
|
|||
(make-variable-buffer-local 'ledger-occur-use-face-shown)
|
||||
|
||||
|
||||
(defvar ledger-occur-mode nil
|
||||
"name of the minor mode, shown in the mode-line")
|
||||
(defvar ledger-occur-mode nil
|
||||
"name of the minor mode, shown in the mode-line")
|
||||
|
||||
(make-variable-buffer-local 'ledger-occur-mode)
|
||||
|
||||
|
|
@ -49,16 +49,11 @@
|
|||
|
||||
(defvar ledger-occur-history nil
|
||||
"History of previously searched expressions for the prompt.")
|
||||
;;(make-variable-buffer-local 'ledger-occur-history)
|
||||
|
||||
(defvar ledger-occur-last-match nil
|
||||
"Last match found.")
|
||||
(make-variable-buffer-local 'ledger-occur-last-match)
|
||||
|
||||
(defvar ledger-occur-overlay-list nil
|
||||
"A list of currently active overlays to the ledger buffer.")
|
||||
(make-variable-buffer-local 'ledger-occur-overlay-list)
|
||||
|
||||
(defun ledger-occur-remove-all-overlays ()
|
||||
"Remove all overlays from the ledger buffer."
|
||||
(interactive)
|
||||
|
|
@ -70,21 +65,19 @@
|
|||
When REGEX is nil, unhide everything, and remove higlight"
|
||||
(set-buffer buffer)
|
||||
(setq ledger-occur-mode
|
||||
(if (or (null regex)
|
||||
(zerop (length regex)))
|
||||
nil
|
||||
(concat " Ledger-Narrowed: " regex)))
|
||||
(if (or (null regex)
|
||||
(zerop (length regex)))
|
||||
nil
|
||||
(concat " Ledger-Narrowed: " regex)))
|
||||
(force-mode-line-update)
|
||||
(ledger-occur-remove-overlays)
|
||||
(if ledger-occur-mode
|
||||
(let* ((buffer-matches (ledger-occur-find-matches regex))
|
||||
(ovl-bounds (ledger-occur-create-xact-overlay-bounds buffer-matches)))
|
||||
(setq ledger-occur-overlay-list
|
||||
(append (ledger-occur-create-xact-overlays ovl-bounds)
|
||||
(ledger-occur-create-narrowed-overlays buffer-matches)))
|
||||
(setq ledger-occur-last-match regex)
|
||||
(if (get-buffer-window buffer)
|
||||
(select-window (get-buffer-window buffer)))))
|
||||
(when ledger-occur-mode
|
||||
(ledger-occur-create-overlays
|
||||
(ledger-occur-compress-matches
|
||||
(ledger-occur-find-matches regex)))
|
||||
(setq ledger-occur-last-match regex)
|
||||
(if (get-buffer-window buffer)
|
||||
(select-window (get-buffer-window buffer))))
|
||||
(recenter))
|
||||
|
||||
(defun ledger-occur (regex)
|
||||
|
|
@ -96,8 +89,8 @@ When REGEX is nil, unhide everything, and remove higlight"
|
|||
(interactive
|
||||
(if ledger-occur-mode
|
||||
(list nil)
|
||||
(list (read-string (concat "Regexp<" (ledger-occur-prompt) ">: ")
|
||||
nil 'ledger-occur-history (ledger-occur-prompt)))))
|
||||
(list (read-string (concat "Regexp<" (ledger-occur-prompt) ">: ")
|
||||
nil 'ledger-occur-history (ledger-occur-prompt)))))
|
||||
(ledger-occur-mode regex (current-buffer)))
|
||||
|
||||
(defun ledger-occur-prompt ()
|
||||
|
|
@ -115,41 +108,32 @@ When REGEX is nil, unhide everything, and remove higlight"
|
|||
(if (= (line-number-at-pos pos1)
|
||||
(line-number-at-pos pos2))
|
||||
(buffer-substring-no-properties pos1 pos2)))
|
||||
(current-word))))
|
||||
(current-word))))
|
||||
prompt))
|
||||
|
||||
(defun ledger-occur-create-narrowed-overlays(buffer-matches)
|
||||
(if buffer-matches
|
||||
(let ((overlays
|
||||
(let ((prev-end (point-min)))
|
||||
(mapcar (lambda (match)
|
||||
(prog1
|
||||
(make-overlay prev-end (car match)
|
||||
(current-buffer) t nil)
|
||||
(setq prev-end (1+ (cadr match)))))
|
||||
buffer-matches))))
|
||||
(mapcar (lambda (ovl)
|
||||
(overlay-put ovl ledger-occur-overlay-property-name t)
|
||||
(overlay-put ovl 'invisible t))
|
||||
(push (make-overlay (cadr (car(last buffer-matches)))
|
||||
(point-max)
|
||||
(current-buffer) t nil) overlays)))))
|
||||
|
||||
(defun ledger-occur-make-visible-overlay (beg end)
|
||||
(let ((ovl (make-overlay beg end (current-buffer))))
|
||||
(overlay-put ovl ledger-occur-overlay-property-name t)
|
||||
(overlay-put ovl 'face 'ledger-occur-xact-face)))
|
||||
|
||||
(defun ledger-occur-create-xact-overlays (ovl-bounds)
|
||||
"Create the overlay for the visible transactions.
|
||||
(defun ledger-occur-make-invisible-overlay (beg end)
|
||||
(let ((ovl (make-overlay beg end (current-buffer))))
|
||||
(overlay-put ovl ledger-occur-overlay-property-name t)
|
||||
(overlay-put ovl 'invisible t)))
|
||||
|
||||
(defun ledger-occur-create-overlays (ovl-bounds)
|
||||
"Create the overlays for the visible transactions.
|
||||
Argument OVL-BOUNDS contains bounds for the transactions to be left visible."
|
||||
(let ((overlays
|
||||
(mapcar (lambda (bnd)
|
||||
(make-overlay (car bnd)
|
||||
(cadr bnd)
|
||||
(current-buffer) t nil))
|
||||
ovl-bounds)))
|
||||
(mapcar (lambda (ovl)
|
||||
(overlay-put ovl ledger-occur-overlay-property-name t)
|
||||
(if ledger-occur-use-face-shown
|
||||
(overlay-put ovl 'face 'ledger-occur-xact-face )))
|
||||
overlays)))
|
||||
(let* ((beg (caar ovl-bounds))
|
||||
(end (cadar ovl-bounds)))
|
||||
(ledger-occur-make-invisible-overlay (point-min) (1- beg))
|
||||
(dolist (visible (cdr ovl-bounds))
|
||||
(ledger-occur-make-visible-overlay beg end)
|
||||
(ledger-occur-make-invisible-overlay (1+ end) (1- (car visible)))
|
||||
(setq beg (car visible))
|
||||
(setq end (cadr visible)))
|
||||
(ledger-occur-make-invisible-overlay (1+ end) (point-max))))
|
||||
|
||||
(defun ledger-occur-quit-buffer (buffer)
|
||||
"Quits hidings transaction in the given BUFFER.
|
||||
|
|
@ -164,45 +148,44 @@ Used for coordinating `ledger-occur' with other buffers, like reconcile."
|
|||
"Remove the transaction hiding overlays."
|
||||
(interactive)
|
||||
(remove-overlays (point-min)
|
||||
(point-max) ledger-occur-overlay-property-name t)
|
||||
(point-max) ledger-occur-overlay-property-name t)
|
||||
(setq ledger-occur-overlay-list nil))
|
||||
|
||||
|
||||
(defun ledger-occur-create-xact-overlay-bounds (buffer-matches)
|
||||
"Use BUFFER-MATCHES to produce the overlay for the visible transactions."
|
||||
(let ((prev-end (point-min))
|
||||
(overlays (list)))
|
||||
(when buffer-matches
|
||||
(mapc (lambda (line)
|
||||
(push (list (car line) (cadr line)) overlays)
|
||||
(setq prev-end (cadr line)))
|
||||
buffer-matches)
|
||||
(setq overlays (nreverse overlays)))))
|
||||
|
||||
|
||||
(defun ledger-occur-find-matches (regex)
|
||||
"Return a list of 2-number tuples describing the beginning and start of transactions meeting REGEX."
|
||||
"Return a list of 2-number tuples describing the beginning and end of transactions meeting REGEX."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
;; Set initial values for variables
|
||||
(let (curpoint
|
||||
endpoint
|
||||
(lines (list)))
|
||||
(let (curpoint
|
||||
endpoint
|
||||
(lines (list)))
|
||||
;; Search loop
|
||||
(while (not (eobp))
|
||||
(setq curpoint (point))
|
||||
;; if something found
|
||||
(when (setq endpoint (re-search-forward regex nil 'end))
|
||||
(save-excursion
|
||||
(let ((bounds (ledger-find-xact-extents (match-beginning 0))))
|
||||
(push bounds lines)
|
||||
(setq curpoint (cadr bounds)))) ;; move to the end of
|
||||
;; the xact, no need to
|
||||
;; search inside it more
|
||||
(let ((bounds (ledger-find-xact-extents (match-beginning 0))))
|
||||
(push bounds lines)
|
||||
(setq curpoint (cadr bounds)))) ;; move to the end of
|
||||
;; the xact, no need to
|
||||
;; search inside it more
|
||||
(goto-char curpoint))
|
||||
(forward-line 1))
|
||||
(setq lines (nreverse lines)))))
|
||||
|
||||
(defun ledger-occur-compress-matches (buffer-matches)
|
||||
"identify sequential xacts to reduce number of overlays required"
|
||||
(let ((points (list))
|
||||
(current-beginning (caar buffer-matches))
|
||||
(current-end (cadar buffer-matches)))
|
||||
(dolist (match (cdr buffer-matches))
|
||||
(if (< (- (car match) current-end) 2)
|
||||
(setq current-end (cadr match))
|
||||
(push (list current-beginning current-end) points)
|
||||
(setq current-beginning (car match))
|
||||
(setq current-end (cadr match))))
|
||||
(nreverse (push (list current-beginning current-end) points))))
|
||||
|
||||
(provide 'ldg-occur)
|
||||
|
||||
|
|
|
|||
|
|
@ -70,6 +70,9 @@
|
|||
(defconst ledger-account-any-status-regex
|
||||
"^[ \t]+\\([*!]\\s-+\\)?\\([[(]?.+?\\)\\(\t\\|\n\\| [ \t]\\)")
|
||||
|
||||
(defun ledger-account-any-status-with-seed-regex (seed)
|
||||
(concat "^[ \t]+\\([*!]\\s-+\\)?\\([[(]?" seed ".+?\\)\\(\t\\|\n\\| [ \t]\\)"))
|
||||
|
||||
(defconst ledger-account-pending-regex
|
||||
"\\(^[ \t]+\\)\\(!\\s-*.*?\\)\\( \\|\t\\|$\\)")
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue