From 90d275098899c30b14a812452bbf068cadd1d4ad Mon Sep 17 00:00:00 2001 From: George Kettleborough Date: Thu, 11 Apr 2013 10:50:18 +0100 Subject: Stop account regexes matching comments --- lisp/ldg-regex.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el index 226475df..c17582eb 100644 --- a/lisp/ldg-regex.el +++ b/lisp/ldg-regex.el @@ -61,13 +61,13 @@ "^--.+?\\($\\|[ ]\\)") (defconst ledger-account-any-status-regex - "^[ \t]+\\([*!]\\s-+\\)?\\([[(]?.+?\\)\\(\t\\|\n\\| [ \t]\\)") + "^[ \t]+\\([*!]\\s-*\\)?\\([^ ;].*?\\)\\( \\|$\\)") (defconst ledger-account-pending-regex - "\\(^[ \t]+\\)\\(!.+?\\)\\( \\|$\\)") + "\\(^[ \t]+\\)\\(!\\s-*.*?\\)\\( \\|$\\)") (defconst ledger-account-cleared-regex - "\\(^[ \t]+\\)\\(\\*.+?\\)\\( \\|$\\)") + "\\(^[ \t]+\\)\\(*\\s-*.*?\\)\\( \\|$\\)") -- cgit v1.2.3 From 6396fe2bd78d63cee3caaeb45fdd4daddb68d88f Mon Sep 17 00:00:00 2001 From: George Kettleborough Date: Thu, 11 Apr 2013 10:50:38 +0100 Subject: Fix comment regex to include all line comment types --- lisp/ldg-fonts.el | 2 +- lisp/ldg-regex.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-fonts.el b/lisp/ldg-fonts.el index cb7a81c0..8ba84c84 100644 --- a/lisp/ldg-fonts.el +++ b/lisp/ldg-fonts.el @@ -113,7 +113,7 @@ (defvar ledger-font-lock-keywords `( ;; (,ledger-other-entries-regex 1 ;; ledger-font-other-face) - (,ledger-comment-regex 2 + (,ledger-comment-regex 0 'ledger-font-comment-face) (,ledger-payee-pending-regex 2 'ledger-font-payee-pending-face) ; Works diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el index c17582eb..8e843ae5 100644 --- a/lisp/ldg-regex.el +++ b/lisp/ldg-regex.el @@ -43,7 +43,7 @@ "\\(^[~=A-Za-z].+\\)+") (defconst ledger-comment-regex - "\\( \\| \\|^\\)\\(;.*\\)") + "^[;#|\\*%].*\\|[ \t]+;.*") (defconst ledger-payee-any-status-regex "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") -- cgit v1.2.3 From 902d0f41ef610ab54786db7c859dbc86c4f6e1db Mon Sep 17 00:00:00 2001 From: George Kettleborough Date: Sat, 13 Apr 2013 21:56:17 +0100 Subject: Add regex for metadata --- lisp/ldg-regex.el | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el index 8e843ae5..83bc2197 100644 --- a/lisp/ldg-regex.el +++ b/lisp/ldg-regex.el @@ -61,13 +61,22 @@ "^--.+?\\($\\|[ ]\\)") (defconst ledger-account-any-status-regex - "^[ \t]+\\([*!]\\s-*\\)?\\([^ ;].*?\\)\\( \\|$\\)") + "^[ \t]+\\(?1:[*!]\\s-*\\)?\\(?2:[^ ;].*?\\)\\( \\|\t\\|$\\)") (defconst ledger-account-pending-regex - "\\(^[ \t]+\\)\\(!\\s-*.*?\\)\\( \\|$\\)") + "\\(^[ \t]+\\)\\(!\\s-*.*?\\)\\( \\|\t\\|$\\)") (defconst ledger-account-cleared-regex - "\\(^[ \t]+\\)\\(*\\s-*.*?\\)\\( \\|$\\)") + "\\(^[ \t]+\\)\\(*\\s-*.*?\\)\\( \\|\t\\|$\\)") + +(defconst ledger-metadata-regex + "[ \t]+\\(?2:;[ \t]+.+\\)$") + +(defconst ledger-account-or-metadata-regex + (concat + ledger-account-any-status-regex + "\\|" + ledger-metadata-regex)) -- cgit v1.2.3 From e604fe5cbb50a70d9c938c5076b2f971145328ec Mon Sep 17 00:00:00 2001 From: George Kettleborough Date: Sat, 13 Apr 2013 21:57:03 +0100 Subject: Allow completion on accounts and metadata --- lisp/ldg-complete.el | 24 ++++++++++++++++++++++-- lisp/ldg-mode.el | 17 +++++++++++------ 2 files changed, 33 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index bd907bc8..3ba35909 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -38,6 +38,11 @@ (point))) (end (point)) begins args) + ;; to support end of line metadata + (save-excursion + (when (search-backward ";" + (line-beginning-position) t) + (setq begin (match-beginning 0)))) (save-excursion (goto-char begin) (when (< (point) end) @@ -73,7 +78,7 @@ Return tree structure" (save-excursion (goto-char (point-min)) (while (re-search-forward - ledger-account-any-status-regex nil t) + ledger-account-or-metadata-regex nil t) (unless (and (>= origin (match-beginning 0)) (< origin (match-end 0))) (setq account-elements @@ -90,6 +95,21 @@ Return tree structure" (setq account-elements (cdr account-elements))))))) account-tree)) +(defun ledger-find-metadata-in-buffer () + "Search through buffer and build list of metadata. +Return list." + (let ((origin (point)) accounts) + (save-excursion + (setq ledger-account-tree (list t)) + (goto-char (point-min)) + (while (re-search-forward + ledger-metadata-regex + nil t) + (unless (and (>= origin (match-beginning 0)) + (< origin (match-end 0))) + (setq accounts (cons (match-string-no-properties 2) accounts))))) + accounts)) + (defun ledger-accounts () "Return a tree of all accounts in the buffer." (let* ((current (caar (ledger-parse-arguments))) @@ -157,7 +177,7 @@ Does not use ledger xact" (setq rest-of-name (match-string 3)) ;; Start copying the postings (forward-line) - (while (looking-at ledger-account-any-status-regex) + (while (looking-at ledger-account-or-metadata-regex) (setq xacts (cons (buffer-substring-no-properties (line-beginning-position) (line-end-position)) diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 4bc195ed..86889dda 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -68,13 +68,18 @@ And calculate the target-delta of the account being reconciled." (message balance)))) (defun ledger-magic-tab (&optional interactively) - "Decide what to with with . -Can be pcomplete, or align-posting" + "Decide what to with with . +Can indent, complete or align depending on context." (interactive "p") - (if (and (> (point) 1) - (looking-back "[:A-Za-z0-9]" 1)) - (ledger-pcomplete interactively) - (ledger-post-align-postings))) + (when (= (point) (line-end-position)) + (if (= (point) (line-beginning-position)) + (indent-to ledger-post-account-alignment-column) + (save-excursion + (re-search-backward ledger-account-or-metadata-regex + (line-beginning-position) t)) + (when (= (point) (match-end 0)) + (ledger-pcomplete interactively)))) + (ledger-post-align-postings)) (defvar ledger-mode-abbrev-table) -- cgit v1.2.3 From 971bcf22f4282ef9813a9fe9bb4966e03d50c48c Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sat, 13 Apr 2013 21:55:06 -0700 Subject: Bug 951, handle thousand separators. Rewrote handling for decimal comma to be much simpler. Why can't I see the simple way first? --- lisp/ldg-commodities.el | 156 +++++++++++--------- lisp/ldg-post.el | 2 +- lisp/ldg-reconcile.el | 374 ++++++++++++++++++++++++------------------------ lisp/ldg-regex.el | 2 +- lisp/ldg-report.el | 36 ++--- 5 files changed, 296 insertions(+), 274 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index 031bddeb..da551965 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -36,50 +36,47 @@ (defun ledger-split-commodity-string (str) "Split a commoditized string, STR, into two parts. Returns a list with (value commodity)." - (if (> (length str) 0) - (let ((number-regex (if (assoc "decimal-comma" ledger-environment-alist) - ledger-amount-decimal-comma-regex - ledger-amount-decimal-period-regex))) - (with-temp-buffer - (insert str) - (goto-char (point-min)) - (cond - ((re-search-forward "\"\\(.*\\)\"" nil t) ; look for quoted commodities - (let ((com (delete-and-extract-region - (match-beginning 1) - (match-end 1)))) - (if (re-search-forward number-regex nil t) - (list - (string-to-number - (ledger-commodity-string-number-decimalize - (delete-and-extract-region (match-beginning 0) (match-end 0)) :from-user)) - com)))) - ((re-search-forward number-regex nil t) - ;; found a number in the current locale, return it in - ;; the car. Anything left over is annotation, - ;; the first thing should be the commodity, separated - ;; by whitespace, return it in the cdr. I can't think of any - ;; counterexamples - (list - (string-to-number - (ledger-commodity-string-number-decimalize - (delete-and-extract-region (match-beginning 0) (match-end 0)) :from-user)) - (nth 0 (split-string (buffer-substring-no-properties (point-min) (point-max)))))) - ((re-search-forward "0" nil t) - ;; couldn't find a decimal number, look for a single 0, - ;; indicating account with zero balance - (list 0 ledger-reconcile-default-commodity))))) - ;; nothing found, return 0 - (list 0 ledger-reconcile-default-commodity))) + (let ((number-regex (if (assoc "decimal-comma" ledger-environment-alist) + ledger-amount-decimal-comma-regex + ledger-amount-decimal-period-regex))) + (if (> (length str) 0) + (with-temp-buffer + (insert str) + (goto-char (point-min)) + (cond + ((re-search-forward "\"\\(.*\\)\"" nil t) ; look for quoted commodities + (let ((com (delete-and-extract-region + (match-beginning 1) + (match-end 1)))) + (if (re-search-forward + number-regex nil t) + (list + (ledger-string-to-number + (delete-and-extract-region (match-beginning 0) (match-end 0))) + com)))) + ((re-search-forward number-regex nil t) + ;; found a number in the current locale, return it in the + ;; car. Anything left over is annotation, the first + ;; thing should be the commodity, separated by + ;; whitespace, return it in the cdr. I can't think of + ;; any counterexamples + (list + (ledger-string-to-number + (delete-and-extract-region (match-beginning 0) (match-end 0))) + (nth 0 (split-string (buffer-substring-no-properties (point-min) (point-max)))))) + ((re-search-forward "0" nil t) + ;; couldn't find a decimal number, look for a single 0, + ;; indicating account with zero balance + (list 0 ledger-reconcile-default-commodity)))) + ;; nothing found, return 0 + (list 0 ledger-reconcile-default-commodity)))) (defun ledger-string-balance-to-commoditized-amount (str) "Return a commoditized amount (val, 'comm') from STR." - (let ((fields (split-string str "[\n\r]"))) ; break any balances - ; with multi commodities - ; into a list - (mapcar #'(lambda (str) - (ledger-split-commodity-string str)) - fields))) + ; break any balances with multi commodities into a list + (mapcar #'(lambda (st) + (ledger-split-commodity-string st)) + (split-string str "[\n\r]"))) (defun -commodity (c1 c2) "Subtract C2 from C1, ensuring their commodities match." @@ -93,27 +90,53 @@ Returns a list with (value commodity)." (list (+ (car c1) (car c2)) (cadr c1)) (error "Can't add different commodities, %S to %S" c1 c2))) -(defun ledger-commodity-string-number-decimalize (number-string direction) - "Take NUMBER-STRING and ensure proper decimalization for use by string-to-number and number-to-string. - -DIRECTION can be :to-user or :from-user. All math calculations -are done with decimal-period, some users may prefer decimal-comma -which must be translated both directions." - (let ((val number-string)) - (if (assoc "decimal-comma" ledger-environment-alist) - (cond ((eq direction :from-user) - ;; change string to decimal-period - (while (string-match "," val) - (setq val (replace-match "." nil nil val)))) ;; switch to period separator - ((eq direction :to-user) - ;; change to decimal-comma - (while (string-match "\\." val) - (setq val (replace-match "," nil nil val)))) ;; gets rid of periods - (t - (error "ledger-commodity-string-number-decimalize: direction not properly specified %S" direction))) - (while (string-match "," val) - (setq val (replace-match "" nil nil val)))) - val)) +(defun ledger-strip (str char) + (let (new-str ) + + (dolist (ch (append str nil)) + (unless (= ch char) + (setq new-str (append new-str (list ch))))) + (concat new-str))) + +(defun ledger-string-to-number (str &optional decimal-comma) + "improve builtin string-to-number by handling internationalization, and return nil of number can't be parsed" + (let ((nstr (if (or decimal-comma + (assoc "decimal-comma" ledger-environment-alist)) + (ledger-strip str ?.) + (ledger-strip str ?,)))) + (while (string-match "," nstr) + (setq nstr (replace-match "." nil nil nstr))) + (string-to-number nstr))) + +(defun ledger-number-to-string (n &optional decimal-comma) + (let ((str (number-to-string n))) + (if (or decimal-comma + (assoc "decimal-comma" ledger-environment-alist)) + (while (string-match "\\." str) + (setq str (replace-match "," nil nil str))) + str))) + +;; (defun ledger-commodity-string-number-decimalize (number-string direction) +;; "Take NUMBER-STRING and ensure proper decimalization for use by string-to-number and number-to-string. + +;; DIRECTION can be :to-user or :from-user. All math calculations +;; are done with decimal-period, some users may prefer decimal-comma +;; which must be translated both directions." +;; (let ((val number-string)) +;; (if (assoc "decimal-comma" ledger-environment-alist) +;; (cond ((eq direction :from-user) +;; ;; change string to decimal-period +;; (while (string-match "," val) +;; (setq val (replace-match "." nil nil val)))) ;; switch to period separator +;; ((eq direction :to-user) +;; ;; change to decimal-comma +;; (while (string-match "\\." val) +;; (setq val (replace-match "," nil nil val)))) ;; gets rid of periods +;; (t +;; (error "ledger-commodity-string-number-decimalize: direction not properly specified %S" direction))) +;; (while (string-match "," val) +;; (setq val (replace-match "" nil nil val)))) +;; val)) @@ -121,12 +144,11 @@ which must be translated both directions." "Return string representing C1. Single character commodities are placed ahead of the value, longer ones are after the value." -(let ((val (ledger-commodity-string-number-decimalize - (number-to-string (car c1)) :to-user)) - (commodity (cadr c1))) + (let ((str (ledger-number-to-string (car c1))) + (commodity (cadr c1))) (if (> (length commodity) 1) - (concat val " " commodity) - (concat commodity " " val)))) + (concat str " " commodity) + (concat commodity " " str)))) (defun ledger-read-commodity-string (prompt) (let ((str (read-from-minibuffer diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 37722fbc..7e4a631c 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -217,7 +217,7 @@ BEG, END, and LEN control how far it can align." (let ((end-of-amount (re-search-forward "[-.,0-9]+" (line-end-position) t))) ;; determine if there is an amount to edit (if end-of-amount - (let ((val (ledger-commodity-string-number-decimalize (match-string 0) :from-user))) + (let ((val (ledger-string-to-number (match-string 0)))) (goto-char (match-beginning 0)) (delete-region (match-beginning 0) (match-end 0)) (calc) diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index ca4d0004..3ee20a59 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -33,7 +33,7 @@ (defvar ledger-target nil) (defgroup ledger-reconcile nil - "Options for Ledger-mode reconciliation" + "Options for Ledger-mode reconciliation" :group 'ledger) (defcustom ledger-recon-buffer-name "*Reconcile*" @@ -59,8 +59,8 @@ Then that transaction will be shown in its source buffer." (defcustom ledger-reconcile-toggle-to-pending t "If true then toggle between uncleared and pending. reconcile-finish will mark all pending posting cleared." - :type 'boolean - :group 'ledger-reconcile) + :type 'boolean + :group 'ledger-reconcile) (defcustom ledger-reconcile-default-date-format "%Y/%m/%d" "Default date format for the reconcile buffer" @@ -85,10 +85,10 @@ reconcile-finish will mark all pending posting cleared." ;; split arguments like the shell does, so you need to ;; specify the individual fields in the command line. (if (ledger-exec-ledger buffer (current-buffer) - "balance" "--limit" "cleared or pending" "--empty" "--collapse" - "--format" "%(display_total)" account) - (ledger-split-commodity-string - (buffer-substring-no-properties (point-min) (point-max)))))) + "balance" "--limit" "cleared or pending" "--empty" "--collapse" + "--format" "%(display_total)" account) + (ledger-split-commodity-string + (buffer-substring-no-properties (point-min) (point-max)))))) (defun ledger-display-balance () "Display the cleared-or-pending balance. @@ -96,12 +96,12 @@ And calculate the target-delta of the account being reconciled." (interactive) (let* ((pending (ledger-reconcile-get-cleared-or-pending-balance ledger-buf ledger-acct))) (when pending - (if ledger-target - (message "Pending balance: %s, Difference from target: %s" - (ledger-commodity-to-string pending) - (ledger-commodity-to-string (-commodity ledger-target pending))) - (message "Pending balance: %s" - (ledger-commodity-to-string pending)))))) + (if ledger-target + (message "Pending balance: %s, Difference from target: %s" + (ledger-commodity-to-string pending) + (ledger-commodity-to-string (-commodity ledger-target pending))) + (message "Pending balance: %s" + (ledger-commodity-to-string pending)))))) (defun is-stdin (file) "True if ledger FILE is standard input." @@ -125,27 +125,27 @@ And calculate the target-delta of the account being reconciled." status) (when (ledger-reconcile-get-buffer where) (with-current-buffer (ledger-reconcile-get-buffer where) - (ledger-goto-line (cdr where)) - (forward-char) - (setq status (ledger-toggle-current (if ledger-reconcile-toggle-to-pending - 'pending - 'cleared)))) - ;; remove the existing face and add the new face + (ledger-goto-line (cdr where)) + (forward-char) + (setq status (ledger-toggle-current (if ledger-reconcile-toggle-to-pending + 'pending + 'cleared)))) + ;; remove the existing face and add the new face (remove-text-properties (line-beginning-position) - (line-end-position) - (list 'face)) + (line-end-position) + (list 'face)) (cond ((eq status 'pending) - (add-text-properties (line-beginning-position) - (line-end-position) - (list 'face 'ledger-font-reconciler-pending-face ))) - ((eq status 'cleared) - (add-text-properties (line-beginning-position) - (line-end-position) - (list 'face 'ledger-font-reconciler-cleared-face ))) - (t - (add-text-properties (line-beginning-position) - (line-end-position) - (list 'face 'ledger-font-reconciler-uncleared-face ))))) + (add-text-properties (line-beginning-position) + (line-end-position) + (list 'face 'ledger-font-reconciler-pending-face ))) + ((eq status 'cleared) + (add-text-properties (line-beginning-position) + (line-end-position) + (list 'face 'ledger-font-reconciler-cleared-face ))) + (t + (add-text-properties (line-beginning-position) + (line-end-position) + (list 'face 'ledger-font-reconciler-uncleared-face ))))) (forward-line) (beginning-of-line) (ledger-display-balance))) @@ -157,18 +157,18 @@ Return the number of uncleared xacts found." (let ((inhibit-read-only t)) (erase-buffer) (prog1 - (ledger-do-reconcile) + (ledger-do-reconcile) (set-buffer-modified-p t)))) (defun ledger-reconcile-refresh-after-save () "Refresh the recon-window after the ledger buffer is saved." (let ((curbuf (current-buffer)) - (curpoint (point)) - (recon-buf (get-buffer ledger-recon-buffer-name))) + (curpoint (point)) + (recon-buf (get-buffer ledger-recon-buffer-name))) (when (buffer-live-p recon-buf) (with-current-buffer recon-buf - (ledger-reconcile-refresh) - (set-buffer-modified-p nil)) + (ledger-reconcile-refresh) + (set-buffer-modified-p nil)) (select-window (get-buffer-window curbuf)) (goto-char curpoint)))) @@ -198,19 +198,19 @@ Return the number of uncleared xacts found." (progn (beginning-of-line) (let* ((where (get-text-property (1+ (point)) 'where)) - (target-buffer (if where - (ledger-reconcile-get-buffer where) - nil)) - (cur-buf (get-buffer ledger-recon-buffer-name))) + (target-buffer (if where + (ledger-reconcile-get-buffer where) + nil)) + (cur-buf (get-buffer ledger-recon-buffer-name))) (when target-buffer - (switch-to-buffer-other-window target-buffer) - (ledger-goto-line (cdr where)) - (forward-char) - (recenter) - (ledger-highlight-xact-under-point) - (forward-char -1) - (if come-back - (switch-to-buffer-other-window cur-buf)))))) + (switch-to-buffer-other-window target-buffer) + (ledger-goto-line (cdr where)) + (forward-char) + (recenter) + (ledger-highlight-xact-under-point) + (forward-char -1) + (if come-back + (switch-to-buffer-other-window cur-buf)))))) (defun ledger-reconcile-save () "Save the ledger buffer." @@ -218,7 +218,7 @@ Return the number of uncleared xacts found." (let ((curpoint (point))) (dolist (buf (cons ledger-buf ledger-bufs)) (with-current-buffer buf - (save-buffer))) + (save-buffer))) (with-current-buffer (get-buffer ledger-recon-buffer-name) (set-buffer-modified-p nil) (ledger-display-balance) @@ -247,84 +247,84 @@ and exit reconcile mode" "Quit the reconcile window without saving ledger buffer." (interactive) (let ((recon-buf (get-buffer ledger-recon-buffer-name)) - buf) + buf) (if recon-buf - (with-current-buffer recon-buf - (ledger-reconcile-quit-cleanup) - (setq buf ledger-buf) - ;; Make sure you delete the window before you delete the buffer, - ;; otherwise, madness ensues - (delete-window (get-buffer-window recon-buf)) - (kill-buffer recon-buf) - (set-window-buffer (selected-window) buf))))) + (with-current-buffer recon-buf + (ledger-reconcile-quit-cleanup) + (setq buf ledger-buf) + ;; Make sure you delete the window before you delete the buffer, + ;; otherwise, madness ensues + (delete-window (get-buffer-window recon-buf)) + (kill-buffer recon-buf) + (set-window-buffer (selected-window) buf))))) (defun ledger-reconcile-quit-cleanup () "Cleanup all hooks established by reconcile mode." (interactive) (let ((buf ledger-buf)) (if (buffer-live-p buf) - (with-current-buffer buf - (remove-hook 'after-save-hook 'ledger-reconcile-refresh-after-save t) - (when ledger-narrow-on-reconcile - (ledger-occur-quit-buffer buf) - (ledger-highlight-xact-under-point)))))) + (with-current-buffer buf + (remove-hook 'after-save-hook 'ledger-reconcile-refresh-after-save t) + (when ledger-narrow-on-reconcile + (ledger-occur-quit-buffer buf) + (ledger-highlight-xact-under-point)))))) (defun ledger-marker-where-xact-is (emacs-xact posting) "Find the position of the EMACS-XACT in the `ledger-buf'. POSTING is used in `ledger-clear-whole-transactions' is nil." (let ((buf (if (is-stdin (nth 0 emacs-xact)) - ledger-buf - (find-file-noselect (nth 0 emacs-xact))))) + ledger-buf + (find-file-noselect (nth 0 emacs-xact))))) (cons buf (if ledger-clear-whole-transactions - (nth 1 emacs-xact) ;; return line-no of xact - (nth 0 posting))))) ;; return line-no of posting + (nth 1 emacs-xact) ;; return line-no of xact + (nth 0 posting))))) ;; return line-no of posting (defun ledger-do-reconcile () "Return the number of uncleared transactions in the account and display them in the *Reconcile* buffer." (let* ((buf ledger-buf) (account ledger-acct) - (ledger-success nil) + (ledger-success nil) (xacts (with-temp-buffer - (when (ledger-exec-ledger buf (current-buffer) - "--uncleared" "--real" "emacs" account) - (setq ledger-success t) - (goto-char (point-min)) - (unless (eobp) - (if (looking-at "(") - (read (current-buffer)))))))) ;current-buffer is the *temp* created above + (when (ledger-exec-ledger buf (current-buffer) + "--uncleared" "--real" "emacs" account) + (setq ledger-success t) + (goto-char (point-min)) + (unless (eobp) + (if (looking-at "(") + (read (current-buffer)))))))) ;current-buffer is the *temp* created above (if (and ledger-success (> (length xacts) 0)) - (let ((date-format (cdr (assoc "date-format" ledger-environment-alist)))) - (dolist (xact xacts) - (dolist (posting (nthcdr 5 xact)) - (let ((beg (point)) - (where (ledger-marker-where-xact-is xact posting))) - (insert (format "%s %-4s %-30s %-30s %15s\n" - (format-time-string (if date-format - date-format - ledger-reconcile-default-date-format) (nth 2 xact)) - (if (nth 3 xact) - (nth 3 xact) - "") - (nth 4 xact) (nth 1 posting) (nth 2 posting))) - (if (nth 3 posting) - (if (eq (nth 3 posting) 'pending) - (set-text-properties beg (1- (point)) - (list 'face 'ledger-font-reconciler-pending-face - 'where where)) - (set-text-properties beg (1- (point)) - (list 'face 'ledger-font-reconciler-cleared-face - 'where where))) - (set-text-properties beg (1- (point)) - (list 'face 'ledger-font-reconciler-uncleared-face - 'where where)))) )) - (goto-char (point-max)) - (delete-char -1)) ;gets rid of the extra line feed at the bottom of the list - (if ledger-success - (insert (concat "There are no uncleared entries for " account)) - (insert "Ledger has reported a problem. Check *Ledger Error* buffer."))) + (let ((date-format (cdr (assoc "date-format" ledger-environment-alist)))) + (dolist (xact xacts) + (dolist (posting (nthcdr 5 xact)) + (let ((beg (point)) + (where (ledger-marker-where-xact-is xact posting))) + (insert (format "%s %-4s %-30s %-30s %15s\n" + (format-time-string (if date-format + date-format + ledger-reconcile-default-date-format) (nth 2 xact)) + (if (nth 3 xact) + (nth 3 xact) + "") + (nth 4 xact) (nth 1 posting) (nth 2 posting))) + (if (nth 3 posting) + (if (eq (nth 3 posting) 'pending) + (set-text-properties beg (1- (point)) + (list 'face 'ledger-font-reconciler-pending-face + 'where where)) + (set-text-properties beg (1- (point)) + (list 'face 'ledger-font-reconciler-cleared-face + 'where where))) + (set-text-properties beg (1- (point)) + (list 'face 'ledger-font-reconciler-uncleared-face + 'where where)))) )) + (goto-char (point-max)) + (delete-char -1)) ;gets rid of the extra line feed at the bottom of the list + (if ledger-success + (insert (concat "There are no uncleared entries for " account)) + (insert "Ledger has reported a problem. Check *Ledger Error* buffer."))) (goto-char (point-min)) (set-buffer-modified-p nil) (toggle-read-only t) @@ -338,30 +338,30 @@ ledger buffer is at the bottom of the main window. The key to this is to ensure the window is selected when the buffer point is moved and recentered. If they aren't strange things happen." - (let ((recon-window (get-buffer-window (get-buffer ledger-recon-buffer-name)))) - (when recon-window - (fit-window-to-buffer recon-window) - (with-current-buffer buf - (add-hook 'kill-buffer-hook 'ledger-reconcile-quit nil t) - (if (get-buffer-window buf) - (select-window (get-buffer-window buf))) - (goto-char (point-max)) - (recenter -1)) - (select-window recon-window) - (ledger-reconcile-visit t)) - (add-hook 'post-command-hook 'ledger-reconcile-track-xact nil t))) + (let ((recon-window (get-buffer-window (get-buffer ledger-recon-buffer-name)))) + (when recon-window + (fit-window-to-buffer recon-window) + (with-current-buffer buf + (add-hook 'kill-buffer-hook 'ledger-reconcile-quit nil t) + (if (get-buffer-window buf) + (select-window (get-buffer-window buf))) + (goto-char (point-max)) + (recenter -1)) + (select-window recon-window) + (ledger-reconcile-visit t)) + (add-hook 'post-command-hook 'ledger-reconcile-track-xact nil t))) (defun ledger-reconcile-track-xact () "Force the ledger buffer to recenter on the transaction at point in the reconcile buffer." (if (and ledger-buffer-tracks-reconcile-buffer - (member this-command (list 'next-line - 'previous-line - 'mouse-set-point - 'ledger-reconcile-toggle - 'end-of-buffer - 'beginning-of-buffer))) + (member this-command (list 'next-line + 'previous-line + 'mouse-set-point + 'ledger-reconcile-toggle + 'end-of-buffer + 'beginning-of-buffer))) (save-excursion - (ledger-reconcile-visit t)))) + (ledger-reconcile-visit t)))) (defun ledger-reconcile-open-windows (buf rbuf) "Ensure that the ledger buffer BUF is split by RBUF." @@ -374,39 +374,39 @@ moved and recentered. If they aren't strange things happen." "Start reconciling, prompt for account." (interactive) (let ((account (ledger-read-account-with-prompt "Account to reconcile")) - (buf (current-buffer)) + (buf (current-buffer)) (rbuf (get-buffer ledger-recon-buffer-name))) ;; this means only one *Reconcile* buffer, ever Set up the ;; reconcile buffer (if rbuf ;; *Reconcile* already exists - (with-current-buffer rbuf - (set 'ledger-acct account) ;; already buffer local - (when (not (eq buf rbuf)) - ;; called from some other ledger-mode buffer - (ledger-reconcile-quit-cleanup) - (set 'ledger-buf buf)) ;; should already be buffer-local - - (unless (get-buffer-window rbuf) - (ledger-reconcile-open-windows buf rbuf))) - - ;; no recon-buffer, starting from scratch. - (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t) - - (with-current-buffer (setq rbuf - (get-buffer-create ledger-recon-buffer-name)) - (ledger-reconcile-open-windows buf rbuf) - (ledger-reconcile-mode) - (make-local-variable 'ledger-target) - (set (make-local-variable 'ledger-buf) buf) - (set (make-local-variable 'ledger-acct) account))) + (with-current-buffer rbuf + (set 'ledger-acct account) ;; already buffer local + (when (not (eq buf rbuf)) + ;; called from some other ledger-mode buffer + (ledger-reconcile-quit-cleanup) + (set 'ledger-buf buf)) ;; should already be buffer-local + + (unless (get-buffer-window rbuf) + (ledger-reconcile-open-windows buf rbuf))) + + ;; no recon-buffer, starting from scratch. + (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t) + + (with-current-buffer (setq rbuf + (get-buffer-create ledger-recon-buffer-name)) + (ledger-reconcile-open-windows buf rbuf) + (ledger-reconcile-mode) + (make-local-variable 'ledger-target) + (set (make-local-variable 'ledger-buf) buf) + (set (make-local-variable 'ledger-acct) account))) ;; Narrow the ledger buffer (with-current-buffer rbuf (save-excursion - (if ledger-narrow-on-reconcile - (ledger-occur-mode account ledger-buf))) + (if ledger-narrow-on-reconcile + (ledger-occur-mode account ledger-buf))) (if (> (ledger-reconcile-refresh) 0) - (ledger-reconcile-change-target)) + (ledger-reconcile-change-target)) (ledger-display-balance)))) (defvar ledger-reconcile-mode-abbrev-table) @@ -417,45 +417,45 @@ moved and recentered. If they aren't strange things happen." (setq ledger-target (ledger-read-commodity-string ledger-reconcile-target-prompt-string))) (define-derived-mode ledger-reconcile-mode text-mode "Reconcile" - "A mode for reconciling ledger entries." - (let ((map (make-sparse-keymap))) - (define-key map [(control ?m)] 'ledger-reconcile-visit) - (define-key map [return] 'ledger-reconcile-visit) - (define-key map [(control ?l)] 'ledger-reconcile-refresh) - (define-key map [(control ?c) (control ?c)] 'ledger-reconcile-finish) - (define-key map [? ] 'ledger-reconcile-toggle) - (define-key map [?a] 'ledger-reconcile-add) - (define-key map [?d] 'ledger-reconcile-delete) - (define-key map [?g] 'ledger-reconcile); - (define-key map [?n] 'next-line) - (define-key map [?p] 'previous-line) - (define-key map [?t] 'ledger-reconcile-change-target) - (define-key map [?s] 'ledger-reconcile-save) - (define-key map [?q] 'ledger-reconcile-quit) - (define-key map [?b] 'ledger-display-balance) - - (define-key map [menu-bar] (make-sparse-keymap "ldg-recon-menu")) - (define-key map [menu-bar ldg-recon-menu] (cons "Reconcile" map)) - (define-key map [menu-bar ldg-recon-menu qui] '("Quit" . ledger-reconcile-quit)) - (define-key map [menu-bar ldg-recon-menu sep1] '("--")) - (define-key map [menu-bar ldg-recon-menu pre] '("Previous Entry" . previous-line)) - (define-key map [menu-bar ldg-recon-menu vis] '("Visit Source" . ledger-reconcile-visit)) - (define-key map [menu-bar ldg-recon-menu nex] '("Next Entry" . next-line)) - (define-key map [menu-bar ldg-recon-menu sep2] '("--")) - (define-key map [menu-bar ldg-recon-menu del] '("Delete Entry" . ledger-reconcile-delete)) - (define-key map [menu-bar ldg-recon-menu add] '("Add Entry" . ledger-reconcile-add)) - (define-key map [menu-bar ldg-recon-menu tog] '("Toggle Entry" . ledger-reconcile-toggle)) - (define-key map [menu-bar ldg-recon-menu sep3] '("--")) - (define-key map [menu-bar ldg-recon-menu bal] '("Show Cleared Balance" . ledger-display-balance)) - (define-key map [menu-bar ldg-recon-menu tgt] '("Change Target Balance" . ledger-reconcile-change-target)) - (define-key map [menu-bar ldg-recon-menu sep4] '("--")) - (define-key map [menu-bar ldg-recon-menu rna] '("Reconcile New Account" . ledger-reconcile)) - (define-key map [menu-bar ldg-recon-menu sep5] '("--")) - (define-key map [menu-bar ldg-recon-menu fin] '("Finish" . ledger-reconcile-finish)) - (define-key map [menu-bar ldg-recon-menu ref] '("Refresh" . ledger-reconcile-refresh)) - (define-key map [menu-bar ldg-recon-menu sav] '("Save" . ledger-reconcile-save)) - - (use-local-map map))) + "A mode for reconciling ledger entries." + (let ((map (make-sparse-keymap))) + (define-key map [(control ?m)] 'ledger-reconcile-visit) + (define-key map [return] 'ledger-reconcile-visit) + (define-key map [(control ?l)] 'ledger-reconcile-refresh) + (define-key map [(control ?c) (control ?c)] 'ledger-reconcile-finish) + (define-key map [? ] 'ledger-reconcile-toggle) + (define-key map [?a] 'ledger-reconcile-add) + (define-key map [?d] 'ledger-reconcile-delete) + (define-key map [?g] 'ledger-reconcile); + (define-key map [?n] 'next-line) + (define-key map [?p] 'previous-line) + (define-key map [?t] 'ledger-reconcile-change-target) + (define-key map [?s] 'ledger-reconcile-save) + (define-key map [?q] 'ledger-reconcile-quit) + (define-key map [?b] 'ledger-display-balance) + + (define-key map [menu-bar] (make-sparse-keymap "ldg-recon-menu")) + (define-key map [menu-bar ldg-recon-menu] (cons "Reconcile" map)) + (define-key map [menu-bar ldg-recon-menu qui] '("Quit" . ledger-reconcile-quit)) + (define-key map [menu-bar ldg-recon-menu sep1] '("--")) + (define-key map [menu-bar ldg-recon-menu pre] '("Previous Entry" . previous-line)) + (define-key map [menu-bar ldg-recon-menu vis] '("Visit Source" . ledger-reconcile-visit)) + (define-key map [menu-bar ldg-recon-menu nex] '("Next Entry" . next-line)) + (define-key map [menu-bar ldg-recon-menu sep2] '("--")) + (define-key map [menu-bar ldg-recon-menu del] '("Delete Entry" . ledger-reconcile-delete)) + (define-key map [menu-bar ldg-recon-menu add] '("Add Entry" . ledger-reconcile-add)) + (define-key map [menu-bar ldg-recon-menu tog] '("Toggle Entry" . ledger-reconcile-toggle)) + (define-key map [menu-bar ldg-recon-menu sep3] '("--")) + (define-key map [menu-bar ldg-recon-menu bal] '("Show Cleared Balance" . ledger-display-balance)) + (define-key map [menu-bar ldg-recon-menu tgt] '("Change Target Balance" . ledger-reconcile-change-target)) + (define-key map [menu-bar ldg-recon-menu sep4] '("--")) + (define-key map [menu-bar ldg-recon-menu rna] '("Reconcile New Account" . ledger-reconcile)) + (define-key map [menu-bar ldg-recon-menu sep5] '("--")) + (define-key map [menu-bar ldg-recon-menu fin] '("Finish" . ledger-reconcile-finish)) + (define-key map [menu-bar ldg-recon-menu ref] '("Refresh" . ledger-reconcile-refresh)) + (define-key map [menu-bar ldg-recon-menu sav] '("Save" . ledger-reconcile-save)) + + (use-local-map map))) (provide 'ldg-reconcile) diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el index 83bc2197..736fd811 100644 --- a/lisp/ldg-regex.el +++ b/lisp/ldg-regex.el @@ -37,7 +37,7 @@ "-?[1-9][0-9.]*[,]?[0-9]*") (defconst ledger-amount-decimal-period-regex - "-?[1-9][0-9.]*[.]?[0-9]*") + "-?[1-9][0-9,]*[.]?[0-9]*") (defconst ledger-other-entries-regex "\\(^[~=A-Za-z].+\\)+") diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el index c3b83f55..9b16522f 100644 --- a/lisp/ldg-report.el +++ b/lisp/ldg-report.el @@ -295,32 +295,32 @@ Optional EDIT the command." "\n\n") (let ((data-pos (point)) (register-report (string-match " reg\\(ister\\)? " cmd)) - files-in-report) + files-in-report) (shell-command ;; --subtotal does not produce identifiable transactions, so don't ;; prepend location information for them (if (and register-report - (not (string-match "--subtotal" cmd))) - (concat cmd " --prepend-format='%(filename):%(beg_line):'") - cmd) + (not (string-match "--subtotal" cmd))) + (concat cmd " --prepend-format='%(filename):%(beg_line):'") + cmd) t nil) (when register-report (goto-char data-pos) (while (re-search-forward "^\\(/[^:]+\\)?:\\([0-9]+\\)?:" nil t) - (let ((file (match-string 1)) - (line (string-to-number (match-string 2)))) - (delete-region (match-beginning 0) (match-end 0)) - (when file - (set-text-properties (line-beginning-position) (line-end-position) - (list 'ledger-source (cons file (save-window-excursion - (save-excursion - (find-file file) - (widen) - (ledger-goto-line line) - (point-marker)))))) - (add-text-properties (line-beginning-position) (line-end-position) - (list 'face 'ledger-font-report-clickable-face)) - (end-of-line))))) + (let ((file (match-string 1)) + (line (string-to-number (match-string 2)))) + (delete-region (match-beginning 0) (match-end 0)) + (when file + (set-text-properties (line-beginning-position) (line-end-position) + (list 'ledger-source (cons file (save-window-excursion + (save-excursion + (find-file file) + (widen) + (ledger-goto-line line) + (point-marker)))))) + (add-text-properties (line-beginning-position) (line-end-position) + (list 'face 'ledger-font-report-clickable-face)) + (end-of-line))))) (goto-char data-pos))) -- cgit v1.2.3 From a04b8a8fdb57e7da5cc9390d861ce1c91bbff501 Mon Sep 17 00:00:00 2001 From: David Keegan Date: Sun, 14 Apr 2013 12:26:38 +0100 Subject: Function name mismatch causes revert error. --- lisp/ldg-occur.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-occur.el b/lisp/ldg-occur.el index 96c364d6..c14ddc84 100644 --- a/lisp/ldg-occur.el +++ b/lisp/ldg-occur.el @@ -59,7 +59,7 @@ "A list of currently active overlays to the ledger buffer.") (make-variable-buffer-local 'ledger-occur-overlay-list) -(defun ledger-remove-all-overlays () +(defun ledger-occur-remove-all-overlays () "Remove all overlays from the ledger buffer." (interactive) (remove-overlays)) -- cgit v1.2.3 From 19be97c2468743dd05687169fea7c0228364eb6c Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 15 Apr 2013 08:14:54 -0700 Subject: commodities cleanup --- lisp/ldg-commodities.el | 36 +++++------------------------------- 1 file changed, 5 insertions(+), 31 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el index da551965..fdc5e802 100644 --- a/lisp/ldg-commodities.el +++ b/lisp/ldg-commodities.el @@ -91,12 +91,10 @@ Returns a list with (value commodity)." (error "Can't add different commodities, %S to %S" c1 c2))) (defun ledger-strip (str char) - (let (new-str ) - - (dolist (ch (append str nil)) - (unless (= ch char) - (setq new-str (append new-str (list ch))))) - (concat new-str))) + (let (new-str) + (concat (dolist (ch (append str nil) new-str) + (unless (= ch char) + (setq new-str (append new-str (list ch)))))))) (defun ledger-string-to-number (str &optional decimal-comma) "improve builtin string-to-number by handling internationalization, and return nil of number can't be parsed" @@ -104,7 +102,7 @@ Returns a list with (value commodity)." (assoc "decimal-comma" ledger-environment-alist)) (ledger-strip str ?.) (ledger-strip str ?,)))) - (while (string-match "," nstr) + (while (string-match "," nstr) ;if there is a comma now, it is a thousands separator (setq nstr (replace-match "." nil nil nstr))) (string-to-number nstr))) @@ -115,30 +113,6 @@ Returns a list with (value commodity)." (while (string-match "\\." str) (setq str (replace-match "," nil nil str))) str))) - -;; (defun ledger-commodity-string-number-decimalize (number-string direction) -;; "Take NUMBER-STRING and ensure proper decimalization for use by string-to-number and number-to-string. - -;; DIRECTION can be :to-user or :from-user. All math calculations -;; are done with decimal-period, some users may prefer decimal-comma -;; which must be translated both directions." -;; (let ((val number-string)) -;; (if (assoc "decimal-comma" ledger-environment-alist) -;; (cond ((eq direction :from-user) -;; ;; change string to decimal-period -;; (while (string-match "," val) -;; (setq val (replace-match "." nil nil val)))) ;; switch to period separator -;; ((eq direction :to-user) -;; ;; change to decimal-comma -;; (while (string-match "\\." val) -;; (setq val (replace-match "," nil nil val)))) ;; gets rid of periods -;; (t -;; (error "ledger-commodity-string-number-decimalize: direction not properly specified %S" direction))) -;; (while (string-match "," val) -;; (setq val (replace-match "" nil nil val)))) -;; val)) - - (defun ledger-commodity-to-string (c1) "Return string representing C1. -- cgit v1.2.3 From db4731d8a913aabb296ead5212fde8e281cbe5e8 Mon Sep 17 00:00:00 2001 From: George Kettleborough Date: Mon, 15 Apr 2013 21:41:02 +0100 Subject: Clean up payee regexes --- lisp/ldg-regex.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el index 736fd811..bf7e6c95 100644 --- a/lisp/ldg-regex.el +++ b/lisp/ldg-regex.el @@ -46,16 +46,16 @@ "^[;#|\\*%].*\\|[ \t]+;.*") (defconst ledger-payee-any-status-regex - "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") + "^[0-9]+[-/][-/.=0-9]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.+?\\)\\s-*\\(;\\|$\\)") (defconst ledger-payee-pending-regex - "^[0-9]+[-/][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)") + "^[0-9]+[-/][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\s-*\\(;\\|$\\)") (defconst ledger-payee-cleared-regex - "^[0-9]+[-/][-/.=0-9]+\\s-\\*\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)") + "^[0-9]+[-/][-/.=0-9]+\\s-\\*\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\s-*\\(;\\|$\\)") (defconst ledger-payee-uncleared-regex - "^[0-9]+[-/][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)") + "^[0-9]+[-/][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\s-*\\(;\\|$\\)") (defconst ledger-init-string-regex "^--.+?\\($\\|[ ]\\)") -- cgit v1.2.3 From 2c07d4152a38cdd7f22392ddf39a737cbbdc3555 Mon Sep 17 00:00:00 2001 From: George Kettleborough Date: Mon, 15 Apr 2013 21:42:20 +0100 Subject: Fix completion on payees --- lisp/ldg-mode.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 86889dda..6bad10d2 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -75,8 +75,12 @@ Can indent, complete or align depending on context." (if (= (point) (line-beginning-position)) (indent-to ledger-post-account-alignment-column) (save-excursion - (re-search-backward ledger-account-or-metadata-regex - (line-beginning-position) t)) + (re-search-backward + (macroexpand + `(rx (or (regex ,ledger-account-any-status-regex) + (regex ,ledger-metadata-regex) + (regex ,ledger-payee-any-status-regex)))) + (line-beginning-position) t)) (when (= (point) (match-end 0)) (ledger-pcomplete interactively)))) (ledger-post-align-postings)) -- cgit v1.2.3 From a052898b601da0e09fe3e45e2f2938221c7265bd Mon Sep 17 00:00:00 2001 From: George Kettleborough Date: Tue, 16 Apr 2013 16:12:30 +0100 Subject: Fix payees and accounts matching to themselves This would sometimes cause a double tab to be necessary for completion, although did also provide an accidental "feature" that repeated tabs would cycle all the way back to the original input --- lisp/ldg-complete.el | 108 ++++++++++++++++++++++++++------------------------- 1 file changed, 56 insertions(+), 52 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index 3ba35909..e3820924 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -122,18 +122,19 @@ Return list." (setq prefix (concat prefix (and prefix ":") (car elements)) root (cdr xact)) - (setq root nil elements nil))) + (setq root nil elements nil))) (setq elements (cdr elements))) + (setq root (delete (list (car elements) t) root)) (and root (sort (mapcar (function (lambda (x) - (let ((term (if prefix - (concat prefix ":" (car x)) - (car x)))) - (if (> (length (cdr x)) 1) - (concat term ":") - term)))) + (let ((term (if prefix + (concat prefix ":" (car x)) + (car x)))) + (if (> (length (cdr x)) 1) + (concat term ":") + term)))) (cdr root)) 'string-lessp)))) @@ -144,21 +145,24 @@ Return list." (if (eq (save-excursion (ledger-thing-at-point)) 'transaction) (if (null current-prefix-arg) - (ledger-payees-in-buffer) ;; this completes against payee names - (progn - (let ((text (buffer-substring-no-properties (line-beginning-position) - (line-end-position)))) - (delete-region (line-beginning-position) - (line-end-position)) - (condition-case nil - (ledger-add-transaction text t) - (error nil))) - (forward-line) - (goto-char (line-end-position)) - (search-backward ";" (line-beginning-position) t) - (skip-chars-backward " \t0123456789.,") - (throw 'pcompleted t))) - (ledger-accounts))))) + (delete + (caar (ledger-parse-arguments)) + (ledger-payees-in-buffer)) ;; this completes against payee names + (progn + (let ((text (buffer-substring-no-properties + (line-beginning-position) + (line-end-position)))) + (delete-region (line-beginning-position) + (line-end-position)) + (condition-case nil + (ledger-add-transaction text t) + (error nil))) + (forward-line) + (goto-char (line-end-position)) + (search-backward ";" (line-beginning-position) t) + (skip-chars-backward " \t0123456789.,") + (throw 'pcompleted t))) + (ledger-accounts))))) (defun ledger-fully-complete-xact () "Completes a transaction if there is another matching payee in the buffer. @@ -203,43 +207,43 @@ ledger-magic-tab in the previous commands list so that ledger-magic-tab would cycle properly" (interactive "p") (if (and interactively - pcomplete-cycle-completions - pcomplete-current-completions - (memq last-command '(ledger-magic-tab - ledger-pcomplete - pcomplete-expand-and-complete - pcomplete-reverse))) + pcomplete-cycle-completions + pcomplete-current-completions + (memq last-command '(ledger-magic-tab + ledger-pcomplete + pcomplete-expand-and-complete + pcomplete-reverse))) (progn - (delete-backward-char pcomplete-last-completion-length) - (if (eq this-command 'pcomplete-reverse) - (progn + (delete-backward-char pcomplete-last-completion-length) + (if (eq this-command 'pcomplete-reverse) + (progn (push (car (last pcomplete-current-completions)) pcomplete-current-completions) - (setcdr (last pcomplete-current-completions 2) nil)) - (nconc pcomplete-current-completions - (list (car pcomplete-current-completions))) - (setq pcomplete-current-completions - (cdr pcomplete-current-completions))) - (pcomplete-insert-entry pcomplete-last-completion-stub + (setcdr (last pcomplete-current-completions 2) nil)) + (nconc pcomplete-current-completions + (list (car pcomplete-current-completions))) + (setq pcomplete-current-completions + (cdr pcomplete-current-completions))) + (pcomplete-insert-entry pcomplete-last-completion-stub (car pcomplete-current-completions) - nil pcomplete-last-completion-raw)) + nil pcomplete-last-completion-raw)) (setq pcomplete-current-completions nil - pcomplete-last-completion-raw nil) + pcomplete-last-completion-raw nil) (catch 'pcompleted (let* ((pcomplete-stub) - pcomplete-seen pcomplete-norm-func - pcomplete-args pcomplete-last pcomplete-index - (pcomplete-autolist pcomplete-autolist) - (pcomplete-suffix-list pcomplete-suffix-list) - (completions (pcomplete-completions)) - (result (pcomplete-do-complete pcomplete-stub completions))) - (and result - (not (eq (car result) 'listed)) - (cdr result) - (pcomplete-insert-entry pcomplete-stub (cdr result) - (memq (car result) - '(sole shortest)) - pcomplete-last-completion-raw)))))) + pcomplete-seen pcomplete-norm-func + pcomplete-args pcomplete-last pcomplete-index + (pcomplete-autolist pcomplete-autolist) + (pcomplete-suffix-list pcomplete-suffix-list) + (completions (pcomplete-completions)) + (result (pcomplete-do-complete pcomplete-stub completions))) + (and result + (not (eq (car result) 'listed)) + (cdr result) + (pcomplete-insert-entry pcomplete-stub (cdr result) + (memq (car result) + '(sole shortest)) + pcomplete-last-completion-raw)))))) (provide 'ldg-complete) -- cgit v1.2.3 From 03b3ef5f0b56286f7ee8498588f5d07c19d8b6f6 Mon Sep 17 00:00:00 2001 From: George Kettleborough Date: Tue, 16 Apr 2013 16:45:01 +0100 Subject: Make union of regexps at compile time --- lisp/ldg-mode.el | 7 +++---- lisp/ldg-regex.el | 6 +++++- 2 files changed, 8 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 6bad10d2..2b707e26 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -76,10 +76,9 @@ Can indent, complete or align depending on context." (indent-to ledger-post-account-alignment-column) (save-excursion (re-search-backward - (macroexpand - `(rx (or (regex ,ledger-account-any-status-regex) - (regex ,ledger-metadata-regex) - (regex ,ledger-payee-any-status-regex)))) + (rx-static-or ledger-account-any-status-regex + ledger-metadata-regex + ledger-payee-any-status-regex) (line-beginning-position) t)) (when (= (point) (match-end 0)) (ledger-pcomplete interactively)))) diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el index bf7e6c95..c9e60e71 100644 --- a/lisp/ldg-regex.el +++ b/lisp/ldg-regex.el @@ -78,7 +78,11 @@ "\\|" ledger-metadata-regex)) - +(defmacro rx-static-or (&rest rx-strs) + "Returns rx union of regexps which can be symbols that eval to strings." + `(rx (or ,@(mapcar #'(lambda (rx-str) + `(regexp ,(eval rx-str))) + rx-strs)))) (defmacro ledger-define-regexp (name regex docs &rest args) "Simplify the creation of a Ledger regex and helper functions." -- cgit v1.2.3 From 1761e6a447c6514a4260746e6a78e400be5c0e4e Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Thu, 18 Apr 2013 18:30:27 -0700 Subject: Sort buffer now attempts to keep point at the same xact. --- lisp/ldg-sort.el | 75 +++++++++++++++++++++++++++++++++----------------------- 1 file changed, 44 insertions(+), 31 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-sort.el b/lisp/ldg-sort.el index a50cd1cc..06efd348 100644 --- a/lisp/ldg-sort.el +++ b/lisp/ldg-sort.el @@ -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) - - (let ((inhibit-field-text-motion t)) - (sort-subr - nil - 'ledger-next-record-function - 'ledger-end-record-function - 'ledger-sort-startkey)))) + (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)))) + + (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) -- cgit v1.2.3 From ebdff209ab8762367ce0db66ad0fa386642e61ad Mon Sep 17 00:00:00 2001 From: George Kettleborough Date: Sun, 21 Apr 2013 14:14:08 +0100 Subject: Add highlighting for multiple line comments --- lisp/ldg-fonts.el | 30 +++++++++++++++++++++++++++++- lisp/ldg-mode.el | 4 ++++ lisp/ldg-regex.el | 7 +++++++ 3 files changed, 40 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ldg-fonts.el b/lisp/ldg-fonts.el index 8ba84c84..fc0b7813 100644 --- a/lisp/ldg-fonts.el +++ b/lisp/ldg-fonts.el @@ -115,6 +115,7 @@ ;; ledger-font-other-face) (,ledger-comment-regex 0 'ledger-font-comment-face) + (,ledger-multiline-comment-regex 0 'ledger-font-comment-face) (,ledger-payee-pending-regex 2 'ledger-font-payee-pending-face) ; Works (,ledger-payee-cleared-regex 2 @@ -130,7 +131,34 @@ (,ledger-other-entries-regex 1 'ledger-font-other-face)) "Expressions to highlight in Ledger mode.") - + +(defun ledger-extend-region-multiline-comment () + "Adjusts the variables font-lock-beg and font-lock-end if they + fall within a multiline comment. Returns non-nil if an + adjustment is made." + (let (beg end) + ;; fix beg + (save-excursion + (goto-char font-lock-beg) + (end-of-line) + (when (re-search-backward ledger-multiline-comment-start-regex nil t) + (setq beg (point)) + (re-search-forward ledger-multiline-comment-regex nil t) + (if (and (>= (point) font-lock-beg) + (/= beg font-lock-beg)) + (setq font-lock-beg beg) + (setq beg nil)))) + ;; fix end + (save-excursion + (goto-char font-lock-end) + (end-of-line) + (when (re-search-backward ledger-multiline-comment-start-regex nil t) + (re-search-forward ledger-multiline-comment-regex nil t) + (setq end (point)) + (if (> end font-lock-end) + (setq font-lock-end end) + (setq end nil)))) + (or beg end))) (provide 'ldg-fonts) diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el index 2b707e26..160296c3 100644 --- a/lisp/ldg-mode.el +++ b/lisp/ldg-mode.el @@ -110,6 +110,10 @@ Can indent, complete or align depending on context." (if (boundp 'font-lock-defaults) (set (make-local-variable 'font-lock-defaults) '(ledger-font-lock-keywords nil t))) + (setq font-lock-extend-region-functions + (list #'font-lock-extend-region-wholelines + #'ledger-extend-region-multiline-comment)) + (setq font-lock-multiline nil) (set (make-local-variable 'pcomplete-parse-arguments-function) 'ledger-parse-arguments) diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el index c9e60e71..cdd06d39 100644 --- a/lisp/ldg-regex.el +++ b/lisp/ldg-regex.el @@ -45,6 +45,13 @@ (defconst ledger-comment-regex "^[;#|\\*%].*\\|[ \t]+;.*") +(defconst ledger-multiline-comment-start-regex + "^!comment$") +(defconst ledger-multiline-comment-end-regex + "^!end_comment$") +(defconst ledger-multiline-comment-regex + "^!comment\n\\(.*\n\\)*?!end_comment$") + (defconst ledger-payee-any-status-regex "^[0-9]+[-/][-/.=0-9]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.+?\\)\\s-*\\(;\\|$\\)") -- cgit v1.2.3 From 26fd5b26d863e2aa729b818b2fab33cffbcc306e Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Mon, 22 Apr 2013 06:13:11 -0700 Subject: Remove intangible property from occur overlays. --- lisp/ldg-occur.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/ldg-occur.el b/lisp/ldg-occur.el index c14ddc84..3ae1ea17 100644 --- a/lisp/ldg-occur.el +++ b/lisp/ldg-occur.el @@ -130,8 +130,7 @@ When REGEX is nil, unhide everything, and remove higlight" buffer-matches)))) (mapcar (lambda (ovl) (overlay-put ovl ledger-occur-overlay-property-name t) - (overlay-put ovl 'invisible t) - (overlay-put ovl 'intangible t)) + (overlay-put ovl 'invisible t)) (push (make-overlay (cadr (car(last buffer-matches))) (point-max) (current-buffer) t nil) overlays))))) -- cgit v1.2.3