ledger-sort.el (3977B)
1 ;;; ledger-sort.el --- Helper code for use with the "ledger" command-line tool -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2003-2016 John Wiegley (johnw AT gnu DOT org) 4 5 ;; This file is not part of GNU Emacs. 6 7 ;; This is free software; you can redistribute it and/or modify it under 8 ;; the terms of the GNU General Public License as published by the Free 9 ;; Software Foundation; either version 2, or (at your option) any later 10 ;; version. 11 ;; 12 ;; This is distributed in the hope that it will be useful, but WITHOUT 13 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 14 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 15 ;; for more details. 16 ;; 17 ;; You should have received a copy of the GNU General Public License 18 ;; along with GNU Emacs; see the file COPYING. If not, write to the 19 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, 20 ;; MA 02110-1301 USA. 21 22 23 24 ;;; Commentary: 25 ;; 26 27 ;;; Code: 28 (require 'ledger-regex) 29 (require 'ledger-navigate) 30 (require 'ledger-xact) 31 32 (defun ledger-sort-find-start () 33 "Find the beginning of a sort region." 34 (when (re-search-forward ";.*Ledger-mode:.*Start sort" nil t) 35 (match-end 0))) 36 37 (defun ledger-sort-find-end () 38 "Find the end of a sort region." 39 (when (re-search-forward ";.*Ledger-mode:.*End sort" nil t) 40 (match-end 0))) 41 42 (defun ledger-sort-insert-start-mark () 43 "Insert a marker to start a sort region." 44 (interactive) 45 (save-excursion 46 (goto-char (point-min)) 47 (when (ledger-sort-find-start) 48 (delete-region (match-beginning 0) (match-end 0)))) 49 (beginning-of-line) 50 (insert "\n; Ledger-mode: Start sort\n\n")) 51 52 (defun ledger-sort-insert-end-mark () 53 "Insert a marker to end a sort region." 54 (interactive) 55 (save-excursion 56 (goto-char (point-min)) 57 (when (ledger-sort-find-end) 58 (delete-region (match-beginning 0) (match-end 0)))) 59 (beginning-of-line) 60 (insert "\n; Ledger-mode: End sort\n\n")) 61 62 (defun ledger-sort-startkey () 63 "Return a numeric sort key based on the date of the xact beginning at point." 64 ;; Can use `time-convert' to return an integer instead of a floating-point 65 ;; number, starting in Emacs 27. 66 (float-time 67 (ledger-parse-iso-date 68 (buffer-substring-no-properties (point) (+ 10 (point)))))) 69 70 (defun ledger-sort-region (beg end) 71 "Sort the region from BEG to END in chronological order." 72 (interactive "r") ;; load beg and end from point and mark 73 ;; automagically 74 (let* ((bounds (ledger-navigate-find-xact-extents (point))) 75 (point-delta (- (point) (car bounds))) 76 (target-xact (buffer-substring (car bounds) (cadr bounds))) 77 (inhibit-modification-hooks t)) 78 (save-excursion 79 (save-restriction 80 (goto-char beg) 81 ;; make sure beg of region is at the beginning of a line 82 (beginning-of-line) 83 ;; make sure point is at the beginning of a xact 84 (unless (looking-at ledger-payee-any-status-regex) 85 (ledger-navigate-next-xact)) 86 (setq beg (point)) 87 (goto-char end) 88 (ledger-navigate-next-xact) 89 ;; make sure end of region is at the beginning of next record 90 ;; after the region 91 (setq end (point)) 92 (narrow-to-region beg end) 93 (goto-char beg) 94 95 (let ((inhibit-field-text-motion t)) 96 (sort-subr 97 nil 98 #'ledger-navigate-next-xact 99 #'ledger-navigate-end-of-xact 100 #'ledger-sort-startkey)))) 101 102 (goto-char (point-min)) 103 (search-forward target-xact) 104 (goto-char (+ (match-beginning 0) point-delta)))) 105 106 (defun ledger-sort-buffer () 107 "Sort the entire buffer." 108 (interactive) 109 (let (sort-start sort-end) 110 (save-excursion 111 (goto-char (point-min)) 112 (setq sort-start (ledger-sort-find-start) 113 sort-end (ledger-sort-find-end))) 114 (ledger-sort-region (or sort-start (point-min)) 115 (or sort-end (point-max))))) 116 117 (provide 'ledger-sort) 118 119 ;;; ledger-sort.el ends here