Fix copy-at-point and more regex consolidation and cleanup
This commit is contained in:
Craig Earls
parent
519e57ca1f
commit
1a52899673
7 changed files with 103 additions and 109 deletions
|
|
@ -52,7 +52,7 @@
|
|||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(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))
|
||||
(< origin (match-end 0)))
|
||||
(setq payees-list (cons (match-string-no-properties 3)
|
||||
|
|
@ -69,7 +69,7 @@ Return tree structure"
|
|||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward
|
||||
ledger-complete-account-regex nil t)
|
||||
ledger-account-any-status-regex nil t)
|
||||
(unless (and (>= origin (match-beginning 0))
|
||||
(< origin (match-end 0)))
|
||||
(setq account-elements
|
||||
|
|
@ -153,7 +153,7 @@ Does not use ledger xact"
|
|||
(setq rest-of-name (match-string 3))
|
||||
;; Start copying the postings
|
||||
(forward-line)
|
||||
(while (looking-at ledger-post-account-regex)
|
||||
(while (looking-at ledger-complete-account-regex)
|
||||
(setq xacts (cons (buffer-substring-no-properties
|
||||
(line-beginning-position)
|
||||
(line-end-position))
|
||||
|
|
|
|||
|
|
@ -121,12 +121,12 @@
|
|||
'ledger-font-payee-cleared-face) ; Works
|
||||
(,ledger-payee-uncleared-regex 2
|
||||
'ledger-font-payee-uncleared-face) ; Works
|
||||
(,ledger-posting-account-cleared-regex 2
|
||||
'ledger-font-posting-account-cleared-face) ; Works
|
||||
(,ledger-posting-account-pending-regex 2
|
||||
'ledger-font-posting-account-pending-face) ; Works
|
||||
(,ledger-posting-account-all-regex 2
|
||||
'ledger-font-posting-account-face)) ; Works
|
||||
(,ledger-account-cleared-regex 2
|
||||
'ledger-font-posting-account-cleared-face) ; Works
|
||||
(,ledger-account-pending-regex 2
|
||||
'ledger-font-posting-account-pending-face) ; Works
|
||||
(,ledger-account-any-status-regex 2
|
||||
'ledger-font-posting-account-face)) ; Works
|
||||
"Expressions to highlight in Ledger mode.")
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ?e)] 'ledger-toggle-current-transaction)
|
||||
(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 ?r)] 'ledger-reconcile)
|
||||
(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 [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))
|
||||
(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 "--"))
|
||||
|
|
@ -172,43 +172,6 @@ Return the difference in the format of a time value."
|
|||
(list (- (car t1) (car t2) (if borrow 1 0))
|
||||
(- (+ (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)
|
||||
"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)
|
||||
"Use ledger xact TRANSACTION-TEXT to add a transaction to the buffer.
|
||||
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."
|
||||
(interactive (list
|
||||
(read-string "Transaction: " (concat ledger-year "/" ledger-month "/"))))
|
||||
|
|
@ -238,12 +201,12 @@ correct chronological place in the buffer."
|
|||
exit-code)
|
||||
(unless insert-at-point
|
||||
(let ((date (car args)))
|
||||
(if (string-match ledger-iso-date-regex date)
|
||||
(if (string-match ledger-iso-date-regexp date)
|
||||
(setq date
|
||||
(encode-time 0 0 0 (string-to-number (match-string 3 date))
|
||||
(string-to-number (match-string 2 date))
|
||||
(string-to-number (match-string 1 date)))))
|
||||
(ledger-find-slot date)))
|
||||
(encode-time 0 0 0 (string-to-number (match-string 4 date))
|
||||
(string-to-number (match-string 3 date))
|
||||
(string-to-number (match-string 2 date)))))
|
||||
(ledger-xact-find-slot date)))
|
||||
(if (> (length args) 1)
|
||||
(save-excursion
|
||||
(insert
|
||||
|
|
|
|||
|
|
@ -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
|
||||
point at beginning of the commodity."
|
||||
;;(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))
|
||||
(skip-syntax-forward " ")
|
||||
(- (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
|
||||
at beginning of account"
|
||||
(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
|
||||
(goto-char (match-beginning 2))
|
||||
(current-column))))
|
||||
|
|
|
|||
|
|
@ -24,58 +24,45 @@
|
|||
(eval-when-compile
|
||||
(require 'cl))
|
||||
|
||||
(defvar ledger-amount-decimal-comma-regex
|
||||
(defconst ledger-amount-decimal-comma-regex
|
||||
"-?[1-9][0-9.]*[,]?[0-9]*")
|
||||
|
||||
(defvar ledger-amount-decimal-period-regex
|
||||
(defconst ledger-amount-decimal-period-regex
|
||||
"-?[1-9][0-9.]*[.]?[0-9]*")
|
||||
|
||||
(defvar ledger-other-entries-regex
|
||||
(defconst ledger-other-entries-regex
|
||||
"\\(^[~=A-Za-z].+\\)+")
|
||||
|
||||
;\\|^\\([A-Za-z] .+\\)\\)
|
||||
|
||||
(defvar ledger-xact-payee-regex
|
||||
(concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+"
|
||||
"\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)"))
|
||||
(defvar ledger-comment-regex
|
||||
(defconst ledger-comment-regex
|
||||
"\\( \\| \\|^\\)\\(;.*\\)")
|
||||
|
||||
(defvar ledger-payee-pending-regex
|
||||
"^[0-9]+[-/.=][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)")
|
||||
(defconst ledger-payee-any-status-regex
|
||||
"^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)")
|
||||
|
||||
(defvar ledger-payee-cleared-regex
|
||||
"^[0-9]+[-/.=][-/.=0-9]+\\s-\\*\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)")
|
||||
(defconst ledger-payee-pending-regex
|
||||
"^[0-9]+[-/.=][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)")
|
||||
|
||||
(defvar ledger-payee-uncleared-regex
|
||||
"^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)")
|
||||
(defconst ledger-payee-cleared-regex
|
||||
"^[0-9]+[-/.=][-/.=0-9]+\\s-\\*\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)")
|
||||
|
||||
(defvar ledger-iso-date-regex
|
||||
"\\([12][0-9]\\{3\\}\\)[-/]\\([0-9]\\{2\\}\\)[-/]\\([0-9]\\{2\\}\\)")
|
||||
(defconst ledger-payee-uncleared-regex
|
||||
"^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)")
|
||||
|
||||
(defvar ledger-init-string-regex
|
||||
(defconst ledger-init-string-regex
|
||||
"^--.+?\\($\\|[ ]\\)")
|
||||
|
||||
(defvar ledger-posting-account-all-regex
|
||||
"\\(^[ \t]+\\)\\(.+?\\)\\( \\|$\\)")
|
||||
(defconst ledger-account-any-status-regex
|
||||
"^[ \t]+\\([*!]\\s-+\\)?[[(]?\\(.+?\\)\\(\t\\|\n\\| [ \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]\\)")
|
||||
|
||||
(defvar ledger-posting-account-pending-regex
|
||||
(defconst ledger-account-pending-regex
|
||||
"\\(^[ \t]+\\)\\(!.+?\\)\\( \\|$\\)")
|
||||
|
||||
(defvar ledger-date-regex
|
||||
"\\([0-9]+\\)[/-]\\([0-9]+\\)[/-]\\([0-9]+\\)")
|
||||
(defconst ledger-account-cleared-regex
|
||||
"\\(^[ \t]+\\)\\(\\*.+?\\)\\( \\|$\\)")
|
||||
|
||||
(defvar ledger-post-amount-regex
|
||||
(defconst ledger-amount-regex
|
||||
(concat "\\( \\|\t\\| \t\\)[ \t]*-?"
|
||||
"\\([A-Z$€£_]+ *\\)?"
|
||||
"\\(-?[0-9,]+?\\)"
|
||||
|
|
@ -84,6 +71,7 @@
|
|||
"\\([ \t]*[@={]@?[^\n;]+?\\)?"
|
||||
"\\([ \t]+;.+?\\|[ \t]*\\)?$"))
|
||||
|
||||
|
||||
(defmacro ledger-define-regexp (name regex docs &rest args)
|
||||
"Simplify the creation of a Ledger regex and helper functions."
|
||||
(let ((defs
|
||||
|
|
@ -179,23 +167,23 @@
|
|||
|
||||
(put 'ledger-define-regexp 'lisp-indent-function 1)
|
||||
|
||||
(ledger-define-regexp date
|
||||
(let ((sep '(or ?- (any ?. ?/)))) ; can't do (any ?- ?. ?/) due to bug
|
||||
(ledger-define-regexp iso-date
|
||||
( let ((sep '(or ?- ?/)))
|
||||
(rx (group
|
||||
(and (? (= 4 num)
|
||||
(eval sep))
|
||||
(and num (? num))
|
||||
(and (group (? (= 4 num)))
|
||||
(eval sep)
|
||||
(group (and num (? num)))
|
||||
(eval sep)
|
||||
(and num (? num))))))
|
||||
(group (and num (? num)))))))
|
||||
"Match a single date, in its 'written' form.")
|
||||
|
||||
(ledger-define-regexp full-date
|
||||
(macroexpand
|
||||
`(rx (and (regexp ,ledger-date-regexp)
|
||||
(? (and ?= (regexp ,ledger-date-regexp))))))
|
||||
`(rx (and (regexp ,ledger-iso-date-regexp)
|
||||
(? (and ?= (regexp ,ledger-iso-date-regexp))))))
|
||||
"Match a compound date, of the form ACTUAL=EFFECTIVE"
|
||||
(actual date)
|
||||
(effective date))
|
||||
(actual iso-date)
|
||||
(effective iso-date))
|
||||
|
||||
(ledger-define-regexp state
|
||||
(rx (group (any ?! ?*)))
|
||||
|
|
@ -292,7 +280,7 @@
|
|||
(macroexpand
|
||||
`(rx (* (+ blank)
|
||||
(or (and ?\{ (regexp ,ledger-commoditized-amount-regexp) ?\})
|
||||
(and ?\[ (regexp ,ledger-date-regexp) ?\])
|
||||
(and ?\[ (regexp ,ledger-iso-date-regexp) ?\])
|
||||
(and ?\( (not (any ?\))) ?\))))))
|
||||
"")
|
||||
|
||||
|
|
@ -328,4 +316,12 @@
|
|||
(amount full-amount)
|
||||
(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)
|
||||
|
|
|
|||
|
|
@ -28,8 +28,8 @@
|
|||
|
||||
(defun ledger-next-record-function ()
|
||||
"Move point to next transaction."
|
||||
(if (re-search-forward ledger-sort-next-record-regex
|
||||
nil t)
|
||||
(if (re-search-forward ledger-payee-any-status-regex
|
||||
nil t)
|
||||
(goto-char (match-beginning 0))
|
||||
(goto-char (point-max))))
|
||||
|
||||
|
|
|
|||
|
|
@ -76,6 +76,41 @@ within the transaction."
|
|||
(ledger-context-field-value context-info 'payee)
|
||||
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)
|
||||
"Rapidly move point to line LINE-NUMBER."
|
||||
(goto-char (point-min))
|
||||
|
|
@ -106,17 +141,17 @@ within the transaction."
|
|||
(extents (ledger-find-xact-extents (point)))
|
||||
(transaction (buffer-substring-no-properties (car extents) (cadr extents)))
|
||||
encoded-date)
|
||||
(if (string-match ledger-date-regex date)
|
||||
(if (string-match ledger-iso-date-regexp date)
|
||||
(setq encoded-date
|
||||
(encode-time 0 0 0 (string-to-number (match-string 3 date))
|
||||
(string-to-number (match-string 2 date))
|
||||
(string-to-number (match-string 1 date)))))
|
||||
(ledger-find-slot encoded-date)
|
||||
(encode-time 0 0 0 (string-to-number (match-string 4 date))
|
||||
(string-to-number (match-string 3 date))
|
||||
(string-to-number (match-string 2 date)))))
|
||||
(ledger-xact-find-slot encoded-date)
|
||||
(insert transaction "\n")
|
||||
(backward-paragraph)
|
||||
(re-search-forward ledger-date-regex)
|
||||
(backward-paragraph 2)
|
||||
(re-search-forward ledger-iso-date-regexp)
|
||||
(replace-match date)
|
||||
(re-search-forward "[1-9][0-9]+\.[0-9]+")))
|
||||
(ledger-next-amount)))
|
||||
|
||||
(provide 'ldg-xact)
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue