diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ledger-fontify.el | 34 | ||||
| -rw-r--r-- | lisp/ledger-fonts.el | 10 | ||||
| -rw-r--r-- | lisp/ledger-mode.el | 4 | ||||
| -rw-r--r-- | lisp/ledger-post.el | 53 | ||||
| -rw-r--r-- | lisp/ledger-regex.el | 6 | ||||
| -rw-r--r-- | lisp/ledger-xact.el | 33 |
6 files changed, 58 insertions, 82 deletions
diff --git a/lisp/ledger-fontify.el b/lisp/ledger-fontify.el index 548881aa..00fe249a 100644 --- a/lisp/ledger-fontify.el +++ b/lisp/ledger-fontify.el @@ -35,39 +35,10 @@ :type 'boolean :group 'ledger-fontification) -;; (defun ledger-fontify-whole-buffer () -;; (interactive) -;; (save-excursion -;; (message "Ledger fontify whole buffer") -;; (goto-char (point-min)) - -;; (while (not (eobp)) -;; (cond ((looking-at ledger-xact-start-regex) -;; (ledger-fontify-xact-at (point))) -;; ((looking-at ledger-directive-start-regex) -;; (ledger-fontify-directive-at (point)))) -;; (ledger-xact-next-xact-or-directive) ;; gets to beginning of next xact -;; ))) - -;; (defun ledger-fontify-activate () -;; "add hook to fontify after buffer changes" -;; (interactive) -;; (if (string= (format-mode-line 'mode-name) "Ledger") -;; (progn -;; (ledger-fontify-whole-buffer) -;; (add-hook 'after-change-functions 'ledger-fontify-buffer-part) -;; (add-hook 'before-change-functions 'ledger-fontify-ensure-activation) -;; (message "ledger-fontify-activate called")))) - -;; (defun ledger-fontify-ensure-activation (beg end) -;; (if (string= (format-mode-line 'mode-name) "Ledger") -;; (add-hook 'after-change-functions 'ledger-fontify-buffer-part))) - (defun ledger-fontify-buffer-part (beg end len) (save-excursion (unless beg (setq beg (point-min))) (unless end (setq end (point-max))) - (unless len (setq len (- end beg))) (goto-char beg) (while (< (point) end) (cond ((or (looking-at ledger-xact-start-regex) @@ -118,6 +89,7 @@ (re-search-forward ledger-posting-regex) (if (match-string 1) (save-match-data (setq state (ledger-state-from-string (s-trim (match-string 1)))))) +;;; FIX THIS. Pull the COND to the outer level and put the fontify-set-face inside. It will be clearer (ledger-fontify-set-face (list (match-beginning 0) (match-end 2)) (cond ((eq state 'cleared) 'ledger-font-posting-account-cleared-face) @@ -127,9 +99,9 @@ 'ledger-font-posting-account-face))) (ledger-fontify-set-face (list (match-beginning 4) (match-end 4)) (cond ((eq state 'cleared) - 'ledger-font-posting-account-cleared-face) + 'ledger-font-posting-amount-cleared-face) ((eq state 'cleared) - 'ledger-font-posting-account-pending-face) + 'ledger-font-posting-amount-pending-face) (t 'ledger-font-posting-amount-face))) (ledger-fontify-set-face (list (match-beginning 5) (match-end 5)) diff --git a/lisp/ledger-fonts.el b/lisp/ledger-fonts.el index b5495460..31cba9bf 100644 --- a/lisp/ledger-fonts.el +++ b/lisp/ledger-fonts.el @@ -176,11 +176,21 @@ "Face for Ledger accounts" :group 'ledger-faces) +(defface ledger-font-posting-amount-cleared-face + `((t :inherit ledger-font-posting-account-cleared-face)) + "Face for Ledger accounts" + :group 'ledger-faces) + (defface ledger-font-posting-account-pending-face `((t :inherit ledger-font-pending-face)) "Face for Ledger accounts" :group 'ledger-faces) +(defface ledger-font-posting-amount-pending-face + `((t :inherit ledger-font-posting-account-pending-face)) + "Face for Ledger accounts" + :group 'ledger-faces) + (defface ledger-font-posting-amount-face `((t :foreground "#cb4b16" )) "Face for Ledger amounts" diff --git a/lisp/ledger-mode.el b/lisp/ledger-mode.el index 08cbb950..cd1a587c 100644 --- a/lisp/ledger-mode.el +++ b/lisp/ledger-mode.el @@ -261,8 +261,8 @@ With a prefix argument, remove the effective date. " (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-xact-prev-xact) + (define-key map [(meta ?n)] 'ledger-xact-next-xact-or-directive) map) "Keymap for `ledger-mode'.") diff --git a/lisp/ledger-post.el b/lisp/ledger-post.el index ac040bb2..87e998cf 100644 --- a/lisp/ledger-post.el +++ b/lisp/ledger-post.el @@ -82,7 +82,6 @@ point at beginning of the commodity." (- (or (match-end 4) (match-end 3)) (point))))) - (defun ledger-next-account (&optional end) "Move point to the beginning of the next account, or status marker (!*), as long as it is not past END. Return the column of the beginning of the account and leave point @@ -110,37 +109,35 @@ region align the posting on the current line." (not (use-region-p))) (set-mark (point))) - (let* ((inhibit-modification-hooks t) + (let ((inhibit-modification-hooks t) (mark-first (< (mark) (point))) - (begin-region (if beg - beg - (if mark-first (mark) (point)))) - (end-region (if end - end - (if mark-first (point) (mark)))) acct-start-column acct-end-column acct-adjust amt-width amt-adjust (lines-left 1)) + + (unless beg (setq beg (if mark-first (mark) (point)))) + (unless end (setq end (if mark-first (mark) (point)))) ;; Condition point and mark to the beginning and end of lines - (goto-char end-region) - (setq end-region (line-end-position)) - (goto-char begin-region) + (goto-char end) + (setq end (line-end-position)) + (goto-char beg) (goto-char - (setq begin-region + (setq beg (line-beginning-position))) - (untabify begin-region end-region) + (untabify beg end) - (goto-char end-region) - (setq end-region (line-end-position)) - (goto-char begin-region) + ;; if untabify actually changed anything, then our begin and end are not correct. + (goto-char end) + (setq end (line-end-position)) + (goto-char beg) (goto-char - (setq begin-region + (setq beg (line-beginning-position))) ;; This is the guts of the alignment loop (while (and (or (setq acct-start-column (ledger-next-account (line-end-position))) lines-left) - (< (point) end-region)) + (< (point) end)) (when acct-start-column (setq acct-end-column (save-excursion (goto-char (match-end 2)) @@ -164,8 +161,6 @@ region align the posting on the current line." (setq lines-left (not (eobp)))) (setq inhibit-modification-hooks nil)))) - - (defun ledger-post-edit-amount () "Call 'calc-mode' and push the amount in the posting to the top of stack." (interactive) @@ -186,24 +181,6 @@ region align the posting on the current line." (insert " ")) (calc)))))) -(defun ledger-post-prev-xact () - "Move point to the previous transaction." - (interactive) - (backward-paragraph) - (when (re-search-backward ledger-xact-line-regexp nil t) - (goto-char (match-beginning 0)) - (re-search-forward ledger-post-line-regexp) - (goto-char (match-end ledger-regex-post-line-group-account)))) - -(defun ledger-post-next-xact () - "Move point to the next transaction." - (interactive) - (when (re-search-forward ledger-xact-line-regexp nil t) - (goto-char (match-beginning 0)) - (re-search-forward ledger-post-line-regexp) - (goto-char (match-end ledger-regex-post-line-group-account)))) - - (provide 'ledger-post) diff --git a/lisp/ledger-regex.el b/lisp/ledger-regex.el index 460b50ce..e80289f0 100644 --- a/lisp/ledger-regex.el +++ b/lisp/ledger-regex.el @@ -26,9 +26,9 @@ (defconst ledger-amount-regex (concat "\\( \\|\t\\| \t\\)[ \t]*-?" - "\\([A-Z$€£_]+ *\\)?" + "\\([A-Z$€£_(]+ *\\)?" "\\(-?[0-9,\\.]+?\\)" - "\\(.[0-9]+\\)?" + "\\(.[0-9)]+\\)?" "\\( *[[:word:]€£_\"]+\\)?" "\\([ \t]*[@={]@?[^\n;]+?\\)?" "\\([ \t]+;.+?\\|[ \t]*\\)?$")) @@ -343,7 +343,7 @@ (defconst ledger-posting-regex (concat "^[ \t]+ ?" ;; initial white space "\\([*!]\\)? ?" ;; state, subexpr 1 - "\\([[:word:]: ]+\\(\n\\|[ \t][ \t]\\)\\)" ;; account, subexpr 2 + "\\([[:word:]: ]+?\\(\n\\|[ \t][ \t]\\)\\)" ;; account, subexpr 2 "\\([^;\n]*\\)" ;; amount, subexpr 4 "\\(.*\\)" ;; comment, subexpr 5 )) diff --git a/lisp/ledger-xact.el b/lisp/ledger-xact.el index b16e5d85..277788e6 100644 --- a/lisp/ledger-xact.el +++ b/lisp/ledger-xact.el @@ -212,7 +212,7 @@ beginning with whitespace" (not (looking-at "[ \t]\\|\\(^$\\)"))) (defun ledger-xact-next-xact-or-directive () - "move to the beginning of the next xact" + "move to the beginning of the next xact or directive" (interactive) (beginning-of-line) (if (ledger-xact-start-xact-or-directive-p) ; if we are the start of an xact, move forward to the next xact @@ -224,13 +224,30 @@ beginning with whitespace" (ledger-xact-start-xact-or-directive-p))) (forward-line)))) -(defun ledger-xact-next-xact () - (interactive) - (beginning-of-line) - (if (looking-at ledger-xact-start-regex) - (forward-line)) - (re-search-forward ledger-xact-start-regex) - (forward-line -1)) +(defun ledger-xact-prev-xact () + "Move point to the previous transaction." + (interactive) + (backward-paragraph) + (when (re-search-backward ledger-xact-line-regexp nil t) + (goto-char (match-beginning 0)) + (re-search-forward ledger-post-line-regexp) + (goto-char (match-end ledger-regex-post-line-group-account)))) + +;; (defun ledger-post-next-xact () +;; "Move point to the next transaction." +;; (interactive) +;; (when (re-search-forward ledger-xact-line-regexp nil t) +;; (goto-char (match-beginning 0)) +;; (re-search-forward ledger-post-line-regexp) +;; (goto-char (match-end ledger-regex-post-line-group-account)))) + +;; (defun ledger-xact-next-xact () +;; (interactive) +;; (beginning-of-line) +;; (if (looking-at ledger-xact-start-regex) +;; (forward-line)) +;; (re-search-forward ledger-xact-start-regex) +;; (forward-line -1)) (provide 'ledger-xact) |