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

Second rewrite of ledger-post-align-postings. Will probably perfect with the NEXT rewrite.

Browse source
This commit is contained in:
Craig Earls 2013-03-24 13:57:03 -04:00
parent 6ff330911d
commit 5797623fd7
1 changed files with 47 additions and 48 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

95
lisp/ldg-post.el
View file

@ -119,7 +119,7 @@ PROMPT is a string to prompt with. CHOICES is a list of
"Move point to the next amount, as long as it is not past END. "Move point to the next amount, as long as it is not past END.
Return the width of the amount field as an integer." Return the width of the amount field as an integer."
(beginning-of-line) (beginning-of-line)
(when (re-search-forward "\\( \\|\t\\| \t\\)[ \t]*-?\\([A-Z$€£]+ *\\)?\\(-?[0-9,]+?\\)\\(.[0-9]+\\)?\\( *[A-Z$€£]+\\)?\\([ \t]*@@?[^\n;]+?\\)?\\([ \t]+;.+?\\|[ \t]*\\)?$" (marker-position end) t) (when (re-search-forward "\\( \\|\t\\| \t\\)[ \t]*-?\\([A-Z$€£_]+ *\\)?\\(-?[0-9,]+?\\)\\(.[0-9]+\\)?\\( *[[:word:]€£_\"]+\\)?\\([ \t]*[@={]@?[^\n;]+?\\)?\\([ \t]+;.+?\\|[ \t]*\\)?$" (marker-position 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)
@ -130,60 +130,59 @@ Return the width of the amount field as an integer."
Return the column of the beginning of the account" Return the column of the beginning of the account"
(beginning-of-line) (beginning-of-line)
(if (> (marker-position end) (point)) (if (> (marker-position end) (point))
(when (re-search-forward "\\(^[ ]+\\)\\([*!;a-zA-Z0-9]+?\\)" (marker-position end) t) (when (re-search-forward "\\(^[ ]+\\)\\([\\[(*!;a-zA-Z0-9]+?\\)" (marker-position end) t)
(goto-char (match-beginning 2)) (goto-char (match-beginning 2))
(current-column)))) (current-column))))
(defun end-of-line-or-region (end-region)
"Return a number or marker to the END-REGION or end of line
position, whichever is closer."
(let ((end (if (< end-region (line-end-position))
end-region
(line-end-position))))
(if (markerp end-region)
(copy-marker end)
end)))
(defun ledger-post-adjust (adjust-by)
(if (> adjust-by 0)
(insert (make-string adjust-by ? ))
(if (looking-back " " (- (point) 3))
(delete-char adjust-by)
(skip-chars-forward "^ \t")
(delete-horizontal-space)
(insert " "))))
(defun ledger-post-align-postings () (defun ledger-post-align-postings ()
"Align all accounts and amounts within region, if there is no "Align all accounts and amounts within region, if there is no
region alight the posting on the current line." region alight the posting on the current line."
(interactive) (interactive)
(let ((region-boundaries-verified nil)) (save-excursion (save-excursion
;; If there is no region set (let* ((mark-first (< (mark) (point)))
(when (or (not (mark)) (begin-region (if mark-first (mark) (point)))
(= (point) (mark))) (end-region (if mark-first (point-marker) (mark-marker)))
(beginning-of-line) acc-col amt-offset acc-adjust)
(set-mark (point)) ;; Condition point and mark to the beginning and end of lines
(goto-char (line-end-position)) (goto-char end-region)
(setq region-boundaries-verified t)) (setq end-region (copy-marker (line-end-position)))
(goto-char begin-region)
(let* ((mark-first (< (mark) (point))) (setq begin-region (copy-marker (line-beginning-position)))
(begin (if mark-first (mark) (point))) (goto-char begin-region)
(end (if mark-first (point-marker) (mark-marker))) (while (or (setq acc-col (ledger-next-account (end-of-line-or-region end-region)))
acc-col amt-offset) (< (point) (marker-position end-region)))
(if (not region-boundaries-verified) (when acc-col
(progn (setq acc-adjust (- ledger-post-account-alignment-column acc-col))
(goto-char end) (if (/= acc-adjust 0)
(end-of-line) (ledger-post-adjust acc-adjust))
(setq end (point-marker))
(goto-char begin) (when (setq amt-offset (ledger-next-amount (end-of-line-or-region end-region)))
(beginning-of-line) (let* ((amt-adjust (- ledger-post-amount-alignment-column
(setq begin (point-marker))) amt-offset
(goto-char begin)) (current-column))))
(while (setq acc-col (ledger-next-account end)) (if (/= amt-adjust 0)
;; Adjust account position if necessary (ledger-post-adjust amt-adjust)))))
(let ((acc-adjust (- ledger-post-account-alignment-column acc-col))) (forward-line)))))
(if (/= acc-adjust 0)
(if (> acc-adjust 0)
(insert (make-string acc-adjust ? )) ;; Account too far left
(if (looking-back " " (- (point) 3))
(delete-char acc-adjust)
(skip-chars-forward "^ \t")
(delete-horizontal-space)
(insert " ")))))
(when (setq amt-offset (ledger-next-amount end))
(let* ((amt-adjust (- ledger-post-amount-alignment-column
amt-offset
(current-column))))
(if (/= amt-adjust 0)
(if (> amt-adjust 0)
(insert (make-string amt-adjust ? ))
(if (looking-back " ")
(delete-char amt-adjust)
(skip-chars-forward "^ \t")
(delete-horizontal-space)
(insert " "))))))
(forward-line))))))
(defun ledger-post-maybe-align (beg end len) (defun ledger-post-maybe-align (beg end len)
"Align amounts only if point is in a posting. "Align amounts only if point is in a posting.