From 5c91124955b2c570b071dc81ac971f9c75b406cf Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 31 Jan 2013 15:13:00 -0700 Subject: WIP. ledger-sort-region still drops the first transaction in the region. --- lisp/ldg-mode.el | 4 ++-- lisp/ldg-xact.el | 35 +++++++++++++++++++++++------------ 2 files changed, 25 insertions(+), 14 deletions(-) diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 128dfeac..9efe7618 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -82,7 +82,7 @@ customizable to ease retro-entry.") (define-key map [(control ?c) (control ?c)] 'ledger-toggle-current) (define-key map [(control ?c) (control ?e)] 'ledger-toggle-current-entry) (define-key map [(control ?c) (control ?r)] 'ledger-reconcile) - (define-key map [(control ?c) (control ?s)] 'ledger-sort) + (define-key map [(control ?c) (control ?s)] 'ledger-sort-buffer) (define-key map [(control ?c) (control ?t)] 'ledger-test-run) (define-key map [tab] 'pcomplete) (define-key map [(control ?i)] 'pcomplete) @@ -109,7 +109,7 @@ customizable to ease retro-entry.") (define-key map [menu-bar ldg-menu sm] '("Set Month" . ledger-set-month)) (define-key map [menu-bar ldg-menu sy] '("Set Year" . ledger-set-year)) (define-key map [menu-bar ldg-menu s1] '("--")) - (define-key map [menu-bar ldg-menu so] '("Sort Buffer" . ledger-sort)) + (define-key map [menu-bar ldg-menu so] '("Sort Buffer or Region" . ledger-sort-buffer)) (define-key map [menu-bar ldg-menu s2] '("--")) (define-key map [menu-bar ldg-menu te] '("Toggle Current Posting" . ledger-toggle-current)) (define-key map [menu-bar ldg-menu tt] '("Toggle Current Transaction" . ledger-toggle-current-entry)) diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el index 11e6fbaf..8907f58e 100644 --- a/lisp/ldg-xact.el +++ b/lisp/ldg-xact.el @@ -22,21 +22,32 @@ ;; A sample entry sorting function, which works if entry dates are of ;; the form YYYY/mm/dd. -(defun ledger-sort () - (interactive) - (save-excursion - (goto-char (point-min)) - (sort-subr - nil - (function - (lambda () +(defun ledger-next-record-function () (if (re-search-forward (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t) (goto-char (match-beginning 0)) - (goto-char (point-max))))) - (function - (lambda () - (forward-paragraph)))))) + (goto-char (point-max)))) + +(defun ledger-end-record-function () + (forward-paragraph)) + +(defun ledger-sort-region (beg end) + (interactive "r") ;load beg and end from point and mark automagically + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (message "%s %s %s" beg end (point-min)) + (let ((inhibit-field-text-motion t)) + (sort-subr + nil + 'ledger-next-record-function + 'ledger-end-record-function))))) + +(defun ledger-sort-buffer () + (interactive) + (ledger-sort-region (point-min) (point-max))) + (provide 'ldg-xact) \ No newline at end of file -- cgit v1.2.3 From 0675208a63837b0ce6802b5124bb90514f07b5e0 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 1 Feb 2013 10:19:47 -0700 Subject: Add regional sort facility to ledger mode C-c C-s now bound to ledger-sort-region. ledger-sort-region is smart and find the beginning of the first xact within the region and the beginning of the first xact AFTER the region so that it can keep posing structure intact --- doc/ledger3.texi | 2 +- lisp/ldg-mode.el | 5 +++-- lisp/ldg-new.el | 1 + lisp/ldg-sort.el | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/ldg-xact.el | 26 ------------------------ 5 files changed, 67 insertions(+), 29 deletions(-) create mode 100644 lisp/ldg-sort.el diff --git a/doc/ledger3.texi b/doc/ledger3.texi index 79ce0b0d..ac0208bd 100644 --- a/doc/ledger3.texi +++ b/doc/ledger3.texi @@ -2376,7 +2376,7 @@ reconcile uncleared entries related to an account @item C-c C-d delete the current entry @item C-c C-s -sort all entries in the journal by date. Drop comments outside of entries +sort all entries in the region. @item C-c C-o C-r run a ledger report @item C-C C-o C-g diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 6179747d..001ec8eb 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -69,7 +69,7 @@ customizable to ease retro-entry.") (define-key map [(control ?c) (control ?c)] 'ledger-toggle-current) (define-key map [(control ?c) (control ?e)] 'ledger-toggle-current-entry) (define-key map [(control ?c) (control ?r)] 'ledger-reconcile) - (define-key map [(control ?c) (control ?s)] 'ledger-sort-buffer) + (define-key map [(control ?c) (control ?s)] 'ledger-sort-region) (define-key map [(control ?c) (control ?t)] 'ledger-test-run) (define-key map [tab] 'pcomplete) (define-key map [(control ?i)] 'pcomplete) @@ -96,7 +96,8 @@ customizable to ease retro-entry.") (define-key map [menu-bar ldg-menu sm] '("Set Month" . ledger-set-month)) (define-key map [menu-bar ldg-menu sy] '("Set Year" . ledger-set-year)) (define-key map [menu-bar ldg-menu s1] '("--")) - (define-key map [menu-bar ldg-menu so] '("Sort Buffer or Region" . ledger-sort-buffer)) + (define-key map [menu-bar ldg-menu so1] '("Sort Buffer" . ledger-sort-buffer)) + (define-key map [menu-bar ldg-menu so2] '("Sort Region" . ledger-sort-region)) (define-key map [menu-bar ldg-menu s2] '("--")) (define-key map [menu-bar ldg-menu te] '("Toggle Current Posting" . ledger-toggle-current)) (define-key map [menu-bar ldg-menu tt] '("Toggle Current Transaction" . ledger-toggle-current-entry)) diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el index 4793f662..c885cf21 100644 --- a/lisp/ldg-new.el +++ b/lisp/ldg-new.el @@ -43,6 +43,7 @@ (require 'ldg-test) (require 'ldg-texi) (require 'ldg-xact) +(require 'ldg-sort) (require 'ldg-fonts) ;(autoload #'ledger-mode "ldg-mode" nil t) ;(autoload #'ledger-fully-complete-entry "ldg-complete" nil t) diff --git a/lisp/ldg-sort.el b/lisp/ldg-sort.el new file mode 100644 index 00000000..e1988413 --- /dev/null +++ b/lisp/ldg-sort.el @@ -0,0 +1,62 @@ +;;; ldg-xact.el --- Helper code for use with the "ledger" command-line tool + +;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org) + +;; This file is not part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify it under +;; the terms of the GNU General Public License as published by the Free +;; Software Foundation; either version 2, or (at your option) any later +;; version. +;; +;; This is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, +;; MA 02111-1307, USA. + +;; A sample entry sorting function, which works if entry dates are of +;; the form YYYY/mm/dd. + +(defun ledger-next-record-function () + (if (re-search-forward + (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" + "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t) + (goto-char (match-beginning 0)) + (goto-char (point-max)))) + +(defun ledger-end-record-function () + (forward-paragraph)) + +(defun ledger-sort-region (beg end) + (interactive "r") ;load beg and end from point and mark automagically + (let ((new-beg beg) + (new-end end)) + (save-excursion + (save-restriction + (ledger-next-record-function) ;make sure point is at the beginning of a xact + (message "beg: %s end: %s" new-beg new-end) + (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 beg end) + (goto-char (point-min)) + + (let ((inhibit-field-text-motion t)) + (sort-subr + nil + 'ledger-next-record-function + 'ledger-end-record-function)))))) + +(defun ledger-sort-buffer () + (interactive) + (ledger-sort-region (point-min) (point-max))) + + +(provide 'ldg-sort) \ No newline at end of file diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el index 8907f58e..1df7d79a 100644 --- a/lisp/ldg-xact.el +++ b/lisp/ldg-xact.el @@ -22,32 +22,6 @@ ;; A sample entry sorting function, which works if entry dates are of ;; the form YYYY/mm/dd. -(defun ledger-next-record-function () - (if (re-search-forward - (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" - "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t) - (goto-char (match-beginning 0)) - (goto-char (point-max)))) - -(defun ledger-end-record-function () - (forward-paragraph)) - -(defun ledger-sort-region (beg end) - (interactive "r") ;load beg and end from point and mark automagically - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char (point-min)) - (message "%s %s %s" beg end (point-min)) - (let ((inhibit-field-text-motion t)) - (sort-subr - nil - 'ledger-next-record-function - 'ledger-end-record-function))))) - -(defun ledger-sort-buffer () - (interactive) - (ledger-sort-region (point-min) (point-max))) (provide 'ldg-xact) \ No newline at end of file -- cgit v1.2.3 From edd82b2639e8a4d1f865dfae898caf678a9e7cbd Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Fri, 1 Feb 2013 11:39:48 -0700 Subject: Add custom faces to the reconciler --- lisp/ldg-fonts.el | 15 +++++++++++++++ lisp/ldg-reconcile.el | 17 +++++++++++------ 2 files changed, 26 insertions(+), 6 deletions(-) diff --git a/lisp/ldg-fonts.el b/lisp/ldg-fonts.el index 9f98a9fd..2b7717c6 100644 --- a/lisp/ldg-fonts.el +++ b/lisp/ldg-fonts.el @@ -56,6 +56,21 @@ "Face for Ledger comments" :group 'ledger-faces) +(defface ledger-font-reconciler-uncleared-face + `((t :foreground "green" :weight normal )) + "Default face for uncleared transactions in the reconcile window" + :group 'ledger-faces) + +(defface ledger-font-reconciler-cleared-face + `((t :foreground "grey70" :weight normal )) + "Default face for cleared (*) transactions in the reconcile window" + :group 'ledger-faces) + +(defface ledger-font-reconciler-pending-face + `((t :foreground "yellow" :weight normal )) + "Default face for pending (!) transactions in the reconcile window" + :group 'ledger-faces) + (defvar ledger-font-lock-keywords '(("^[0-9]+[-/.=][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)" 2 'ledger-font-pending-face) diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index aaccfb07..02d0662a 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -55,13 +55,17 @@ (with-current-buffer ledger-buf (goto-char (cdr where)) (setq cleared (ledger-toggle-current-entry))) + ;remove the existing face and add the new face + (remove-text-properties (line-beginning-position) + (line-end-position) + (list 'face)) (if cleared (add-text-properties (line-beginning-position) (line-end-position) - (list 'face 'bold)) - (remove-text-properties (line-beginning-position) - (line-end-position) - (list 'face)))) + (list 'face 'ledger-font-reconciler-cleared-face )) + (add-text-properties (line-beginning-position) + (line-end-position) + (list 'face 'ledger-font-reconciler-uncleared-face )))) (forward-line) (ledger-display-balance))) @@ -172,10 +176,11 @@ (nth 4 item) (nth 1 xact) (nth 2 xact))) (if (nth 3 xact) (set-text-properties beg (1- (point)) - (list 'face 'bold + (list 'face 'ledger-font-reconciler-cleared-face 'where where)) (set-text-properties beg (1- (point)) - (list 'where where)))) + (list 'face 'ledger-font-reconciler-uncleared-face + 'where where)))) (setq index (1+ index))))) (goto-char (point-min)) (set-buffer-modified-p nil) -- cgit v1.2.3