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:
parent
fec1c179e3
commit
f1882d0a56
2 changed files with 36 additions and 45 deletions
|
|
@ -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))
|
||||||
|
(when (re-search-forward ledger-post-account-regex end t)
|
||||||
(goto-char (match-beginning 2))
|
(goto-char (match-beginning 2))
|
||||||
(current-column))))
|
(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)))
|
||||||
|
(if (< end-region eol)
|
||||||
end-region
|
end-region
|
||||||
(line-end-position))))
|
eol)))
|
||||||
(if (markerp end-region)
|
|
||||||
(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.
|
||||||
|
|
|
||||||
|
|
@ -122,9 +122,7 @@ 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]")
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue