Major speed improvements to ledger-post-align-postings

Got rid of markers.  Use inhibit-modification-hook to suppress any other buffer stuff happening.

Got giant-buffer down to around 3.5 seconds with full modifications.
This commit is contained in:
Craig Earls 2013-03-26 02:33:05 -04:00
parent fec1c179e3
commit f1882d0a56
2 changed files with 36 additions and 45 deletions

View file

@ -124,11 +124,12 @@ PROMPT is a string to prompt with. CHOICES is a list of
"\\([ \t]*[@={]@?[^\n;]+?\\)?" "\\([ \t]*[@={]@?[^\n;]+?\\)?"
"\\([ \t]+;.+?\\|[ \t]*\\)?$")) "\\([ \t]+;.+?\\|[ \t]*\\)?$"))
(defun ledger-next-amount (&optional end) (defsubst ledger-next-amount (&optional end)
"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 and leave
(beginning-of-line) point at beginning of the commodity."
(when (re-search-forward ledger-post-amount-regex (marker-position end) t) ;;(beginning-of-line)
(when (re-search-forward ledger-post-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)
@ -138,34 +139,29 @@ Return the width of the amount field as an integer."
(concat "\\(^[ \t]+\\)" (concat "\\(^[ \t]+\\)"
"\\([\\[(*!;a-zA-Z0-9]+?\\)")) "\\([\\[(*!;a-zA-Z0-9]+?\\)"))
(defun ledger-next-account (&optional end) (defsubst 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. "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" Return the column of the beginning of the account and leave point
(beginning-of-line) at beginning of account"
(if (> (marker-position end) (point)) ;; (beginning-of-line)
(when (re-search-forward ledger-post-account-regex (marker-position end) t) (if (> end (point))
(goto-char (match-beginning 2)) (when (re-search-forward ledger-post-account-regex end t)
(current-column)))) (goto-char (match-beginning 2))
(current-column))))
(defun end-of-line-or-region (end-region) (defsubst ledger-post-end-of-line-or-region (end-region)
"Return a number or marker to the END-REGION or end of line "Return a number the END-REGION or end of line
position, whichever is closer." position, whichever is closer."
(let ((end (if (< end-region (line-end-position)) (let ((eol (line-end-position)))
end-region (if (< end-region eol)
(line-end-position)))) end-region
(if (markerp end-region) eol)))
(copy-marker end)
end)))
(defsubst ledger-post-adjust (adjust-by) (defsubst ledger-post-adjust (adjust-by)
(if (> adjust-by 0) (if (> adjust-by 0)
(insert (make-string adjust-by ? )) (insert (make-string adjust-by ? ))
(if (looking-back " " (- (point) 1)) (delete-char adjust-by)))
(delete-char adjust-by)
(skip-chars-forward "^ \t")
(delete-horizontal-space)
(insert " "))))
(defun ledger-post-align-postings (&optional beg end) (defun ledger-post-align-postings (&optional beg end)
"Align all accounts and amounts within region, if there is no "Align all accounts and amounts within region, if there is no
@ -176,42 +172,40 @@ region align the posting on the current line."
(not (use-region-p))) (not (use-region-p)))
(set-mark (point))) (set-mark (point)))
(let* ((has-align-hook (remove-hook (let* ((inhibit-modification-hooks t)
'after-change-functions
'ledger-post-maybe-align t))
(mark-first (< (mark) (point))) (mark-first (< (mark) (point)))
(begin-region (if beg (begin-region (if beg
beg beg
(if mark-first (mark) (point)))) (if mark-first (mark) (point))))
(end-region (if end (end-region (if end
end end
(if mark-first (point-marker) (mark-marker)))) (if mark-first (point) (mark))))
acc-col amt-offset acc-adjust acc-col amt-offset acc-adjust
(lines-left 1)) (lines-left 1))
;; Condition point and mark to the beginning and end of lines ;; Condition point and mark to the beginning and end of lines
(goto-char end-region) (goto-char end-region)
(setq end-region (copy-marker (line-end-position))) (setq end-region (line-end-position))
(goto-char begin-region) (goto-char begin-region)
(goto-char (goto-char
(setq begin-region (setq begin-region
(copy-marker (line-beginning-position)))) (line-beginning-position)))
(while (or (setq acc-col (ledger-next-account (end-of-line-or-region end-region))) (while (or (setq acc-col (ledger-next-account (ledger-post-end-of-line-or-region end-region)))
(and (< (point) (marker-position end-region)) (and (< (point) end-region)
(> lines-left 0))) lines-left))
(when acc-col (when acc-col
(setq acc-adjust (- ledger-post-account-alignment-column acc-col)) (setq acc-adjust (- ledger-post-account-alignment-column acc-col))
(if (/= acc-adjust 0) (if (/= acc-adjust 0)
(ledger-post-adjust acc-adjust)) (ledger-post-adjust acc-adjust))
(when (setq amt-offset (ledger-next-amount (end-of-line-or-region end-region))) (when (setq amt-offset (ledger-next-amount (ledger-post-end-of-line-or-region end-region)))
(let* ((amt-adjust (- ledger-post-amount-alignment-column (let* ((amt-adjust (- ledger-post-amount-alignment-column
amt-offset amt-offset
(current-column)))) (current-column))))
(if (/= amt-adjust 0) (if (/= amt-adjust 0)
(ledger-post-adjust amt-adjust))))) (ledger-post-adjust amt-adjust)))))
(setq lines-left (forward-line))) (forward-line)
(if has-align-hook (setq lines-left (not (eobp))))
(add-hook 'after-change-functions 'ledger-post-maybe-align t t))))) (setq inhibit-modification-hooks nil))))
(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.

View file

@ -122,12 +122,10 @@ dropped."
;;this excursion toggles the posting status ;;this excursion toggles the posting status
(save-excursion (save-excursion
(let ((has-align-hook (remove-hook (setq inhibit-modification-hooks t)
'after-change-functions
'ledger-post-maybe-align t)))
(goto-char (line-beginning-position)) (goto-char (line-beginning-position))
(when (looking-at "[ \t]") (when (looking-at "[ \t]")
(skip-chars-forward " \t") (skip-chars-forward " \t")
(let ((here (point)) (let ((here (point))
(cur-status (ledger-state-from-char (char-after)))) (cur-status (ledger-state-from-char (char-after))))
@ -162,8 +160,7 @@ dropped."
((looking-at " ") ((looking-at " ")
(delete-char 1)))) (delete-char 1))))
(setq new-status inserted)))) (setq new-status inserted))))
(if has-align-hook (setq inhibit-modification-hooks nil))
(add-hook 'after-change-functions 'ledger-post-maybe-align t t))))
;; This excursion cleans up the entry so that it displays ;; This excursion cleans up the entry so that it displays
;; minimally. This means that if all posts are cleared, remove ;; minimally. This means that if all posts are cleared, remove