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

Correction to ldg-context xact regex.

Browse source
This commit is contained in:
Craig Earls 2013-05-21 23:42:19 -07:00
parent 67ce56e37c
commit d97048cf42
1 changed files with 22 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

43
lisp/ldg-context.el
View file

@ -37,46 +37,47 @@
(defconst comment-string "[ \t]*;[ \t]*\\(.*?\\)") (defconst comment-string "[ \t]*;[ \t]*\\(.*?\\)")
(defconst nil-string "\\([ \t]+\\)") (defconst nil-string "\\([ \t]+\\)")
(defconst commodity-string "\\(.+?\\)") (defconst commodity-string "\\(.+?\\)")
(defconst date-string "^\\(\\([0-9]\\{4\\}[/-]\\)?[01]?[0-9][/-][0123]?[0-9]\\)") (defconst date-string "^\\([0-9]\\{4\\}[/-][01]?[0-9][/-][0123]?[0-9]\\)")
(defconst code-string "\\((\\(.*\\))\\)?") (defconst code-string "\\((.*)\\)?")
(defconst payee-string "\\(.*\\)") (defconst payee-string "\\(.*\\)")
(defmacro line-regex (&rest elements) (defmacro line-regex (&rest elements)
(let (regex-string) (let (regex-string)
(concat (dolist (e elements regex-string) (concat (dolist (e elements regex-string)
(setq regex-string (setq regex-string
(concat regex-string (concat regex-string
(eval (eval
(intern (intern
(concat (symbol-name e) "-string")))))) "[ \t]*$"))) (concat (symbol-name e) "-string")))))) "[ \t]*$")))
(defmacro single-line-config2 (&rest elements) (defmacro single-line-config2 (&rest elements)
"Take list of ELEMENTS and return regex and element list for use in context-at-point" "Take list of ELEMENTS and return regex and element list for use in context-at-point"
(let (regex-string) (let (regex-string)
`'(,(concat (dolist (e elements regex-string) `'(,(concat (dolist (e elements regex-string)
(setq regex-string (setq regex-string
(concat regex-string (concat regex-string
(eval (eval
(intern (intern
(concat (symbol-name e) "-string")))))) "[ \t]*$") (concat (symbol-name e) "-string")))))) "[ \t]*$")
,elements))) ,elements)))
(defmacro single-line-config (&rest elements) (defmacro single-line-config (&rest elements)
"Take list of ELEMENTS and return regex and element list for use in context-at-point" "Take list of ELEMENTS and return regex and element list for use in context-at-point"
`'(,(eval `(line-regex ,@elements)) `'(,(eval `(line-regex ,@elements))
,elements)) ,elements))
(defconst ledger-line-config (defconst ledger-line-config
(list (list 'xact (list (single-line-config date nil status nil nil code payee comment) (list (list 'xact (list (single-line-config date nil status nil code nil payee nil comment)
(single-line-config date nil status nil nil code payee))) (single-line-config date nil status nil code nil payee)
(single-line-config date nil status nil payee)))
(list 'acct-transaction (list (single-line-config indent comment) (list 'acct-transaction (list (single-line-config indent comment)
(single-line-config indent status account nil commodity amount nil comment) (single-line-config2 indent status account nil commodity amount nil comment)
(single-line-config indent status account nil commodity amount) (single-line-config2 indent status account nil commodity amount)
(single-line-config indent status account nil amount nil commodity comment) (single-line-config2 indent status account nil amount nil commodity comment)
(single-line-config indent status account nil amount nil commodity) (single-line-config2 indent status account nil amount nil commodity)
(single-line-config indent status account nil amount) (single-line-config2 indent status account nil amount)
(single-line-config indent status account nil comment) (single-line-config2 indent status account nil comment)
(single-line-config indent status account))))) (single-line-config2 indent status account)))))
(defun ledger-extract-context-info (line-type pos) (defun ledger-extract-context-info (line-type pos)
"Get context info for current line with LINE-TYPE. "Get context info for current line with LINE-TYPE.
@ -109,7 +110,7 @@ where the \"users\" point was."
Leave point at the beginning of the thing under point" Leave point at the beginning of the thing under point"
(let ((here (point))) (let ((here (point)))
(goto-char (line-beginning-position)) (goto-char (line-beginning-position))
(cond ((looking-at "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.+?)\\)?\\s-+") (cond ((looking-at "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.+?)\\)?\\s-+")
(goto-char (match-end 0)) (goto-char (match-end 0))
'transaction) 'transaction)
((looking-at "^\\s-+\\([*!]\\s-+\\)?[[(]?\\(.\\)") ((looking-at "^\\s-+\\([*!]\\s-+\\)?[[(]?\\(.\\)")