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

Sort buffer now attempts to keep point at the same xact.

Browse source
This commit is contained in:
Craig Earls 2013-04-18 18:30:27 -07:00
parent 769a73c33b
commit 1761e6a447
1 changed files with 43 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

73
lisp/ldg-sort.el
View file

@ -49,7 +49,7 @@
(save-excursion
(goto-char (point-min))
(if (ledger-sort-find-start)
(delete-region (match-beginning 0) (match-end 0))))
(delete-region (match-beginning 0) (match-end 0))))
(beginning-of-line)
(insert "\n; Ledger-mode: Start sort\n\n"))
@ -58,7 +58,7 @@
(save-excursion
(goto-char (point-min))
(if (ledger-sort-find-end)
(delete-region (match-beginning 0) (match-end 0))))
(delete-region (match-beginning 0) (match-end 0))))
(beginning-of-line)
(insert "\n; Ledger-mode: End sort\n\n"))
@ -69,44 +69,57 @@
(defun ledger-sort-region (beg end)
"Sort the region from BEG to END in chronological order."
(interactive "r") ;; load beg and end from point and mark
;; automagically
;; automagically
(let ((new-beg beg)
(new-end end))
(setq inhibit-modification-hooks t)
(new-end end)
point-delta
(bounds (ledger-find-xact-extents (point)))
target-xact)
(setq point-delta (- (point) (car bounds)))
(setq target-xact (buffer-substring (car bounds) (cadr bounds)))
(setq inhibit-modification-hooks t)
(save-excursion
(save-restriction
(goto-char beg)
(ledger-next-record-function) ;; make sure point is at the
;; beginning of a xact
(setq new-beg (point))
(goto-char end)
(ledger-next-record-function) ;; make sure end of region is at
;; the beginning of next record
;; after the region
(setq new-end (point))
(narrow-to-region new-beg new-end)
(goto-char new-beg)
(goto-char beg)
(ledger-next-record-function) ;; make sure point is at the
;; beginning of a xact
(setq new-beg (point))
(goto-char end)
(ledger-next-record-function) ;; make sure end of region is at
;; the beginning of next record
;; after the region
(setq new-end (point))
(narrow-to-region new-beg new-end)
(goto-char new-beg)
(let ((inhibit-field-text-motion t))
(sort-subr
nil
'ledger-next-record-function
'ledger-end-record-function
'ledger-sort-startkey))))
(let ((inhibit-field-text-motion t))
(sort-subr
nil
'ledger-next-record-function
'ledger-end-record-function
'ledger-sort-startkey))))
(goto-char beg)
(re-search-forward (regexp-quote target-xact))
(goto-char (+ (match-beginning 0) point-delta))
(setq inhibit-modification-hooks nil)))
(defun ledger-sort-buffer ()
"Sort the entire buffer."
(interactive)
(goto-char (point-min))
(let ((sort-start (ledger-sort-find-start))
(sort-end (ledger-sort-find-end)))
(let (sort-start
sort-end)
(save-excursion
(goto-char (point-min))
(setq sort-start (ledger-sort-find-start)
sort-end (ledger-sort-find-end)))
(ledger-sort-region (if sort-start
sort-start
(point-min))
(if sort-end
sort-end
(point-max)))))
sort-start
(point-min))
(if sort-end
sort-end
(point-max)))))
(provide 'ldg-sort)