sfos/ledger
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix copy-at-point and more regex consolidation and cleanup

Browse source
This commit is contained in:
Craig Earls 2013-04-03 16:30:36 -07:00
parent 519e57ca1f
commit 1a52899673
7 changed files with 103 additions and 109 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
lisp/ldg-complete.el
View file

@ -52,7 +52,7 @@
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward (while (re-search-forward
ledger-xact-payee-regex nil t) ;; matches first line ledger-payee-any-status-regex nil t) ;; matches first line
(unless (and (>= origin (match-beginning 0)) (unless (and (>= origin (match-beginning 0))
(< origin (match-end 0))) (< origin (match-end 0)))
(setq payees-list (cons (match-string-no-properties 3) (setq payees-list (cons (match-string-no-properties 3)
@ -69,7 +69,7 @@ Return tree structure"
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward (while (re-search-forward
ledger-complete-account-regex nil t) ledger-account-any-status-regex nil t)
(unless (and (>= origin (match-beginning 0)) (unless (and (>= origin (match-beginning 0))
(< origin (match-end 0))) (< origin (match-end 0)))
(setq account-elements (setq account-elements
@ -153,7 +153,7 @@ Does not use ledger xact"
(setq rest-of-name (match-string 3)) (setq rest-of-name (match-string 3))
;; Start copying the postings ;; Start copying the postings
(forward-line) (forward-line)
(while (looking-at ledger-post-account-regex) (while (looking-at ledger-complete-account-regex)
(setq xacts (cons (buffer-substring-no-properties (setq xacts (cons (buffer-substring-no-properties
(line-beginning-position) (line-beginning-position)
(line-end-position)) (line-end-position))

6
lisp/ldg-fonts.el
View file

@ -121,11 +121,11 @@
'ledger-font-payee-cleared-face) ; Works 'ledger-font-payee-cleared-face) ; Works
(,ledger-payee-uncleared-regex 2 (,ledger-payee-uncleared-regex 2
'ledger-font-payee-uncleared-face) ; Works 'ledger-font-payee-uncleared-face) ; Works
(,ledger-posting-account-cleared-regex 2 (,ledger-account-cleared-regex 2
'ledger-font-posting-account-cleared-face) ; Works 'ledger-font-posting-account-cleared-face) ; Works
(,ledger-posting-account-pending-regex 2 (,ledger-account-pending-regex 2
'ledger-font-posting-account-pending-face) ; Works 'ledger-font-posting-account-pending-face) ; Works
(,ledger-posting-account-all-regex 2 (,ledger-account-any-status-regex 2
'ledger-font-posting-account-face)) ; Works 'ledger-font-posting-account-face)) ; Works
"Expressions to highlight in Ledger mode.") "Expressions to highlight in Ledger mode.")

53
lisp/ldg-mode.el
View file

@ -101,7 +101,7 @@ Can be pcomplete, or align-posting"
(define-key map [(control ?c) (control ?d)] 'ledger-delete-current-transaction) (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 ?e)] 'ledger-toggle-current-transaction)
(define-key map [(control ?c) (control ?f)] 'ledger-occur) (define-key map [(control ?c) (control ?f)] 'ledger-occur)
(define-key map [(control ?c) (control ?k)] 'ledger-copy-transaction) (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 ?m)] 'ledger-set-month)
(define-key map [(control ?c) (control ?r)] 'ledger-reconcile) (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 ?s)] 'ledger-sort-region)
@ -144,7 +144,7 @@ Can be pcomplete, or align-posting"
(define-key map [sort-reg] '(menu-item "Sort Region" ledger-sort-region :enable mark-active)) (define-key map [sort-reg] '(menu-item "Sort Region" ledger-sort-region :enable mark-active))
(define-key map [align-reg] '(menu-item "Align Region" ledger-post-align-postings :enable mark-active)) (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 [sep2] '(menu-item "--"))
(define-key map [copy-xact] '(menu-item "Copy Trans at Point" ledger-copy-transaction)) (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-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 [toggle-xact] '(menu-item "Toggle Current Transaction" ledger-toggle-current-transaction))
(define-key map [sep4] '(menu-item "--")) (define-key map [sep4] '(menu-item "--"))
@ -172,43 +172,6 @@ Return the difference in the format of a time value."
(list (- (car t1) (car t2) (if borrow 1 0)) (list (- (car t1) (car t2) (if borrow 1 0))
(- (+ (if borrow 65536 0) (cadr t1)) (cadr t2))))) (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
(defun ledger-find-slot (moment)
"Find the right place in the buffer for a transaction at MOMENT.
MOMENT is an encoded date"
(catch 'found
(ledger-iterate-transactions
(function
(lambda (start date mark desc)
(if (ledger-time-less-p moment date)
(throw 'found t)))))))
(defun ledger-iterate-transactions (callback)
"Iterate through each transaction call CALLBACK for each."
(goto-char (point-min))
(let* ((now (current-time))
(current-year (nth 5 (decode-time now))))
(while (not (eobp))
(when (looking-at
(concat "\\(Y\\s-+\\([0-9]+\\)\\|"
"\\([0-9]\\{4\\}+\\)?[./-]?"
"\\([0-9]+\\)[./-]\\([0-9]+\\)\\s-+"
"\\(\\*\\s-+\\)?\\(.+\\)\\)"))
(let ((found (match-string 2)))
(if found
(setq current-year (string-to-number found))
(let ((start (match-beginning 0))
(year (match-string 3))
(month (string-to-number (match-string 4)))
(day (string-to-number (match-string 5)))
(mark (match-string 6))
(desc (match-string 7)))
(if (and year (> (length year) 0))
(setq year (string-to-number year)))
(funcall callback start
(encode-time 0 0 0 day month
(or year current-year))
mark desc)))))
(forward-line))))
(defun ledger-set-year (newyear) (defun ledger-set-year (newyear)
"Set ledger's idea of the current year to the prefix argument NEWYEAR." "Set ledger's idea of the current year to the prefix argument NEWYEAR."
@ -227,7 +190,7 @@ MOMENT is an encoded date"
(defun ledger-add-transaction (transaction-text &optional insert-at-point) (defun ledger-add-transaction (transaction-text &optional insert-at-point)
"Use ledger xact TRANSACTION-TEXT to add a transaction to the buffer. "Use ledger xact TRANSACTION-TEXT to add a transaction to the buffer.
If INSERT-AT-POINT is non-nil insert the transaction If INSERT-AT-POINT is non-nil insert the transaction
there, otherwise call `ledger-find-slot' to insert it at the there, otherwise call `ledger-xact-find-slot' to insert it at the
correct chronological place in the buffer." correct chronological place in the buffer."
(interactive (list (interactive (list
(read-string "Transaction: " (concat ledger-year "/" ledger-month "/")))) (read-string "Transaction: " (concat ledger-year "/" ledger-month "/"))))
@ -238,12 +201,12 @@ correct chronological place in the buffer."
exit-code) exit-code)
(unless insert-at-point (unless insert-at-point
(let ((date (car args))) (let ((date (car args)))
(if (string-match ledger-iso-date-regex date) (if (string-match ledger-iso-date-regexp date)
(setq date (setq date
(encode-time 0 0 0 (string-to-number (match-string 3 date)) (encode-time 0 0 0 (string-to-number (match-string 4 date))
(string-to-number (match-string 2 date)) (string-to-number (match-string 3 date))
(string-to-number (match-string 1 date))))) (string-to-number (match-string 2 date)))))
(ledger-find-slot date))) (ledger-xact-find-slot date)))
(if (> (length args) 1) (if (> (length args) 1)
(save-excursion (save-excursion
(insert (insert

4
lisp/ldg-post.el
View file

@ -122,7 +122,7 @@ PROMPT is a string to prompt with. CHOICES is a list of
Return the width of the amount field as an integer and leave Return the width of the amount field as an integer and leave
point at beginning of the commodity." point at beginning of the commodity."
;;(beginning-of-line) ;;(beginning-of-line)
(when (re-search-forward ledger-post-amount-regex end t) (when (re-search-forward ledger-amount-regex end t)
(goto-char (match-beginning 0)) (goto-char (match-beginning 0))
(skip-syntax-forward " ") (skip-syntax-forward " ")
(- (or (match-end 4) (- (or (match-end 4)
@ -134,7 +134,7 @@ point at beginning of the commodity."
Return the column of the beginning of the account and leave point Return the column of the beginning of the account and leave point
at beginning of account" at beginning of account"
(if (> end (point)) (if (> end (point))
(when (re-search-forward ledger-posting-account-all-regex (1+ end) t) (when (re-search-forward ledger-account-any-status-regex (1+ end) t)
;; the 1+ is to make sure we can catch the newline ;; the 1+ is to make sure we can catch the newline
(goto-char (match-beginning 2)) (goto-char (match-beginning 2))
(current-column)))) (current-column))))

80
lisp/ldg-regex.el
View file

@ -24,58 +24,45 @@
(eval-when-compile (eval-when-compile
(require 'cl)) (require 'cl))
(defvar ledger-amount-decimal-comma-regex (defconst ledger-amount-decimal-comma-regex
"-?[1-9][0-9.]*[,]?[0-9]*") "-?[1-9][0-9.]*[,]?[0-9]*")
(defvar ledger-amount-decimal-period-regex (defconst ledger-amount-decimal-period-regex
"-?[1-9][0-9.]*[.]?[0-9]*") "-?[1-9][0-9.]*[.]?[0-9]*")
(defvar ledger-other-entries-regex (defconst ledger-other-entries-regex
"\\(^[~=A-Za-z].+\\)+") "\\(^[~=A-Za-z].+\\)+")
;\\|^\\([A-Za-z] .+\\)\\) ;\\|^\\([A-Za-z] .+\\)\\)
(defvar ledger-xact-payee-regex (defconst ledger-comment-regex
(concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+"
"\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)"))
(defvar ledger-comment-regex
"\\( \\| \\|^\\)\\(;.*\\)") "\\( \\| \\|^\\)\\(;.*\\)")
(defvar ledger-payee-pending-regex (defconst ledger-payee-any-status-regex
"^[0-9]+[-/.=][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)") "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)")
(defvar ledger-payee-cleared-regex (defconst ledger-payee-pending-regex
"^[0-9]+[-/.=][-/.=0-9]+\\s-\\*\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)") "^[0-9]+[-/.=][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)")
(defvar ledger-payee-uncleared-regex (defconst ledger-payee-cleared-regex
"^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)") "^[0-9]+[-/.=][-/.=0-9]+\\s-\\*\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)")
(defvar ledger-iso-date-regex (defconst ledger-payee-uncleared-regex
"\\([12][0-9]\\{3\\}\\)[-/]\\([0-9]\\{2\\}\\)[-/]\\([0-9]\\{2\\}\\)") "^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)")
(defvar ledger-init-string-regex (defconst ledger-init-string-regex
"^--.+?\\($\\|[ ]\\)") "^--.+?\\($\\|[ ]\\)")
(defvar ledger-posting-account-all-regex (defconst ledger-account-any-status-regex
"\\(^[ \t]+\\)\\(.+?\\)\\( \\|$\\)")
(defvar ledger-sort-next-record-regex
(concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+"
"\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)"))
(defvar ledger-posting-account-cleared-regex
"\\(^[ \t]+\\)\\(\\*.+?\\)\\( \\|$\\)")
(defvar ledger-complete-account-regex
"^[ \t]+\\([*!]\\s-+\\)?[[(]?\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") "^[ \t]+\\([*!]\\s-+\\)?[[(]?\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)")
(defvar ledger-posting-account-pending-regex (defconst ledger-account-pending-regex
"\\(^[ \t]+\\)\\(!.+?\\)\\( \\|$\\)") "\\(^[ \t]+\\)\\(!.+?\\)\\( \\|$\\)")
(defvar ledger-date-regex (defconst ledger-account-cleared-regex
"\\([0-9]+\\)[/-]\\([0-9]+\\)[/-]\\([0-9]+\\)") "\\(^[ \t]+\\)\\(\\*.+?\\)\\( \\|$\\)")
(defvar ledger-post-amount-regex (defconst ledger-amount-regex
(concat "\\( \\|\t\\| \t\\)[ \t]*-?" (concat "\\( \\|\t\\| \t\\)[ \t]*-?"
"\\([A-Z$€£_]+ *\\)?" "\\([A-Z$€£_]+ *\\)?"
"\\(-?[0-9,]+?\\)" "\\(-?[0-9,]+?\\)"
@ -84,6 +71,7 @@
"\\([ \t]*[@={]@?[^\n;]+?\\)?" "\\([ \t]*[@={]@?[^\n;]+?\\)?"
"\\([ \t]+;.+?\\|[ \t]*\\)?$")) "\\([ \t]+;.+?\\|[ \t]*\\)?$"))
(defmacro ledger-define-regexp (name regex docs &rest args) (defmacro ledger-define-regexp (name regex docs &rest args)
"Simplify the creation of a Ledger regex and helper functions." "Simplify the creation of a Ledger regex and helper functions."
(let ((defs (let ((defs
@ -179,23 +167,23 @@
(put 'ledger-define-regexp 'lisp-indent-function 1) (put 'ledger-define-regexp 'lisp-indent-function 1)
(ledger-define-regexp date (ledger-define-regexp iso-date
(let ((sep '(or ?- (any ?. ?/)))) ; can't do (any ?- ?. ?/) due to bug ( let ((sep '(or ?- ?/)))
(rx (group (rx (group
(and (? (= 4 num) (and (group (? (= 4 num)))
(eval sep))
(and num (? num))
(eval sep) (eval sep)
(and num (? num)))))) (group (and num (? num)))
(eval sep)
(group (and num (? num)))))))
"Match a single date, in its 'written' form.") "Match a single date, in its 'written' form.")
(ledger-define-regexp full-date (ledger-define-regexp full-date
(macroexpand (macroexpand
`(rx (and (regexp ,ledger-date-regexp) `(rx (and (regexp ,ledger-iso-date-regexp)
(? (and ?= (regexp ,ledger-date-regexp)))))) (? (and ?= (regexp ,ledger-iso-date-regexp))))))
"Match a compound date, of the form ACTUAL=EFFECTIVE" "Match a compound date, of the form ACTUAL=EFFECTIVE"
(actual date) (actual iso-date)
(effective date)) (effective iso-date))
(ledger-define-regexp state (ledger-define-regexp state
(rx (group (any ?! ?*))) (rx (group (any ?! ?*)))
@ -292,7 +280,7 @@
(macroexpand (macroexpand
`(rx (* (+ blank) `(rx (* (+ blank)
(or (and ?\{ (regexp ,ledger-commoditized-amount-regexp) ?\}) (or (and ?\{ (regexp ,ledger-commoditized-amount-regexp) ?\})
(and ?\[ (regexp ,ledger-date-regexp) ?\]) (and ?\[ (regexp ,ledger-iso-date-regexp) ?\])
(and ?\( (not (any ?\))) ?\)))))) (and ?\( (not (any ?\))) ?\))))))
"") "")
@ -328,4 +316,12 @@
(amount full-amount) (amount full-amount)
(note end-note)) (note end-note))
(defconst ledger-iterate-regex
(concat "\\(Y\\s-+\\([0-9]+\\)\\|" ;; Catches a Y directive
ledger-iso-date-regexp
"\\([ *!]+\\)" ;; mark
"\\((.*)\\)" ;; code
"\\(.*\\)" ;; desc
"\\)"))
(provide 'ldg-regex) (provide 'ldg-regex)

2
lisp/ldg-sort.el
View file

@ -28,7 +28,7 @@
(defun ledger-next-record-function () (defun ledger-next-record-function ()
"Move point to next transaction." "Move point to next transaction."
(if (re-search-forward ledger-sort-next-record-regex (if (re-search-forward ledger-payee-any-status-regex
nil t) nil t)
(goto-char (match-beginning 0)) (goto-char (match-beginning 0))
(goto-char (point-max)))) (goto-char (point-max))))

51
lisp/ldg-xact.el
View file

@ -76,6 +76,41 @@ within the transaction."
(ledger-context-field-value context-info 'payee) (ledger-context-field-value context-info 'payee)
nil)))) nil))))
(defun ledger-xact-find-slot (moment)
"Find the right place in the buffer for a transaction at MOMENT.
MOMENT is an encoded date"
(catch 'found
(ledger-xact-iterate-transactions
(function
(lambda (start date mark desc)
(if (ledger-time-less-p moment date)
(throw 'found t)))))))
(defun ledger-xact-iterate-transactions (callback)
"Iterate through each transaction call CALLBACK for each."
(goto-char (point-min))
(let* ((now (current-time))
(current-year (nth 5 (decode-time now))))
(while (not (eobp))
(when (looking-at ledger-iterate-regex)
(let ((found-y-p (match-string 2)))
(if found-y-p
(setq current-year (string-to-number found-y-p)) ;; a Y directive was found
(let ((start (match-beginning 0))
(year (match-string 4))
(month (string-to-number (match-string 5)))
(day (string-to-number (match-string 6)))
(mark (match-string 7))
(code (match-string 8))
(desc (match-string 9)))
(if (and year (> (length year) 0))
(setq year (string-to-number year)))
(funcall callback start
(encode-time 0 0 0 day month
(or year current-year))
mark desc)))))
(forward-line))))
(defsubst ledger-goto-line (line-number) (defsubst ledger-goto-line (line-number)
"Rapidly move point to line LINE-NUMBER." "Rapidly move point to line LINE-NUMBER."
(goto-char (point-min)) (goto-char (point-min))
@ -106,17 +141,17 @@ within the transaction."
(extents (ledger-find-xact-extents (point))) (extents (ledger-find-xact-extents (point)))
(transaction (buffer-substring-no-properties (car extents) (cadr extents))) (transaction (buffer-substring-no-properties (car extents) (cadr extents)))
encoded-date) encoded-date)
(if (string-match ledger-date-regex date) (if (string-match ledger-iso-date-regexp date)
(setq encoded-date (setq encoded-date
(encode-time 0 0 0 (string-to-number (match-string 3 date)) (encode-time 0 0 0 (string-to-number (match-string 4 date))
(string-to-number (match-string 2 date)) (string-to-number (match-string 3 date))
(string-to-number (match-string 1 date))))) (string-to-number (match-string 2 date)))))
(ledger-find-slot encoded-date) (ledger-xact-find-slot encoded-date)
(insert transaction "\n") (insert transaction "\n")
(backward-paragraph) (backward-paragraph 2)
(re-search-forward ledger-date-regex) (re-search-forward ledger-iso-date-regexp)
(replace-match date) (replace-match date)
(re-search-forward "[1-9][0-9]+\.[0-9]+"))) (ledger-next-amount)))
(provide 'ldg-xact) (provide 'ldg-xact)