Fix Bug 962

This commit is contained in:
Craig Earls 2013-05-11 19:14:51 -07:00
parent bb181c494a
commit a7097c9e41
2 changed files with 82 additions and 81 deletions

View file

@ -49,10 +49,10 @@
(defcustom ledger-post-use-completion-engine :built-in (defcustom ledger-post-use-completion-engine :built-in
"Which completion engine to use, :iswitchb or :ido chose those engines, "Which completion engine to use, :iswitchb or :ido chose those engines,
:built-in uses built-in Ledger-mode completion" :built-in uses built-in Ledger-mode completion"
:type '(radio (const :tag "built in completion" :built-in) :type '(radio (const :tag "built in completion" :built-in)
(const :tag "ido completion" :ido) (const :tag "ido completion" :ido)
(const :tag "iswitchb completion" :iswitchb) ) (const :tag "iswitchb completion" :iswitchb) )
:group 'ledger-post) :group 'ledger-post)
(defun ledger-post-all-accounts () (defun ledger-post-all-accounts ()
"Return a list of all accounts in the buffer." "Return a list of all accounts in the buffer."
@ -77,15 +77,15 @@
PROMPT is a string to prompt with. CHOICES is a list of strings PROMPT is a string to prompt with. CHOICES is a list of strings
to choose from." to choose from."
(cond ((eq ledger-post-use-completion-engine :iswitchb) (cond ((eq ledger-post-use-completion-engine :iswitchb)
(let* ((iswitchb-use-virtual-buffers nil) (let* ((iswitchb-use-virtual-buffers nil)
(iswitchb-make-buflist-hook (iswitchb-make-buflist-hook
(lambda () (lambda ()
(setq iswitchb-temp-buflist choices)))) (setq iswitchb-temp-buflist choices))))
(iswitchb-read-buffer prompt))) (iswitchb-read-buffer prompt)))
((eq ledger-post-use-completion-engine :ido) ((eq ledger-post-use-completion-engine :ido)
(ido-completing-read prompt choices)) (ido-completing-read prompt choices))
(t (t
(completing-read prompt choices)))) (completing-read prompt choices))))
(defvar ledger-post-current-list nil) (defvar ledger-post-current-list nil)
@ -107,12 +107,12 @@ to choose from."
(match-end ledger-regex-post-line-group-account)) (match-end ledger-regex-post-line-group-account))
(insert account) (insert account)
(cond (cond
((> existing-len account-len) ((> existing-len account-len)
(insert (make-string (- existing-len account-len) ? ))) (insert (make-string (- existing-len account-len) ? )))
((< existing-len account-len) ((< existing-len account-len)
(dotimes (n (- account-len existing-len)) (dotimes (n (- account-len existing-len))
(if (looking-at "[ \t]\\( [ \t]\\|\t\\)") (if (looking-at "[ \t]\\( [ \t]\\|\t\\)")
(delete-char 1))))))) (delete-char 1)))))))
(goto-char pos))) (goto-char pos)))
@ -133,13 +133,13 @@ point at beginning of the commodity."
"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 and leave point Return the column of the beginning of the account and leave point
at beginning of account" at beginning of account"
(if (> end (point)) (if (> end (point))
(when (re-search-forward ledger-account-any-status-regex (1+ end) t) (when (re-search-forward ledger-account-any-status-regex (1+ end) t)
;; the 1+ is to make sure we can catch the newline ;; the 1+ is to make sure we can catch the newline
(if (match-beginning 1) (if (match-beginning 1)
(goto-char (match-beginning 1)) (goto-char (match-beginning 1))
(goto-char (match-beginning 2))) (goto-char (match-beginning 2)))
(current-column)))) (current-column))))
(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
@ -149,64 +149,65 @@ region align the posting on the current line."
(save-excursion (save-excursion
(if (or (not (mark)) (if (or (not (mark))
(not (use-region-p))) (not (use-region-p)))
(set-mark (point))) (set-mark (point)))
(let* ((inhibit-modification-hooks t) (let* ((inhibit-modification-hooks 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) (mark)))) (if mark-first (point) (mark))))
acct-start-column acct-end-column acct-adjust amt-width acct-start-column acct-end-column acct-adjust amt-width
(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 (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
(line-beginning-position))) (line-beginning-position)))
;; This is the guts of the alignment loop ;; This is the guts of the alignment loop
(while (and (or (setq acct-start-column (ledger-next-account (line-end-position))) (while (and (or (setq acct-start-column (ledger-next-account (line-end-position)))
lines-left) lines-left)
(< (point) end-region)) (< (point) end-region))
(when acct-start-column (when acct-start-column
(setq acct-end-column (save-excursion (setq acct-end-column (save-excursion
(goto-char (match-end 2)) (goto-char (match-end 2))
(current-column))) (current-column)))
(when (/= (setq acct-adjust (- ledger-post-account-alignment-column acct-start-column)) 0) (when (/= (setq acct-adjust (- ledger-post-account-alignment-column acct-start-column)) 0)
(setq acct-end-column (+ acct-end-column acct-adjust)) ;;adjust the account ending column (setq acct-end-column (+ acct-end-column acct-adjust)) ;;adjust the account ending column
(if (> acct-adjust 0) (if (> acct-adjust 0)
(insert (make-string acct-adjust ? )) (insert (make-string acct-adjust ? ))
(delete-char acct-adjust))) (delete-char acct-adjust)))
(when (setq amt-width (ledger-next-amount (line-end-position))) (when (setq amt-width (ledger-next-amount (line-end-position)))
(if (/= 0 (setq amt-adjust (- (if (> (- ledger-post-amount-alignment-column amt-width) (if (/= 0 (setq amt-adjust (- (if (> (- ledger-post-amount-alignment-column amt-width)
(+ 2 acct-end-column)) (+ 2 acct-end-column))
ledger-post-amount-alignment-column ;;we have room ledger-post-amount-alignment-column ;;we have room
(+ acct-end-column 2 amt-width)) (+ acct-end-column 2 amt-width))
amt-width amt-width
(current-column)))) (current-column))))
(if (> amt-adjust 0) (if (> amt-adjust 0)
(insert (make-string amt-adjust ? )) (insert (make-string amt-adjust ? ))
(delete-char amt-adjust))))) (delete-char amt-adjust)))))
(forward-line) (forward-line)
(setq lines-left (not (eobp)))) (setq lines-left (not (eobp))))
(setq inhibit-modification-hooks nil)))) (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.
BEG, END, and LEN control how far it can align." BEG, END, and LEN control how far it can align."
(if ledger-post-auto-adjust-postings (if ledger-post-auto-adjust-postings
(save-excursion (save-excursion
(goto-char beg) (goto-char beg)
(when (<= end (line-end-position)) (when (<= end (line-end-position))
(goto-char (line-beginning-position)) (goto-char (line-beginning-position))
(if (looking-at ledger-post-line-regexp) (if (looking-at ledger-post-line-regexp)
(ledger-post-align-postings)))))) (ledger-post-align-postings))))))
(defun ledger-post-edit-amount () (defun ledger-post-edit-amount ()
"Call 'calc-mode' and push the amount in the posting to the top of stack." "Call 'calc-mode' and push the amount in the posting to the top of stack."
@ -217,16 +218,16 @@ BEG, END, and LEN control how far it can align."
(let ((end-of-amount (re-search-forward "[-.,0-9]+" (line-end-position) t))) (let ((end-of-amount (re-search-forward "[-.,0-9]+" (line-end-position) t)))
;; determine if there is an amount to edit ;; determine if there is an amount to edit
(if end-of-amount (if end-of-amount
(let ((val (ledger-string-to-number (match-string 0)))) (let ((val (ledger-string-to-number (match-string 0))))
(goto-char (match-beginning 0)) (goto-char (match-beginning 0))
(delete-region (match-beginning 0) (match-end 0)) (delete-region (match-beginning 0) (match-end 0))
(calc) (calc)
(calc-eval val 'push)) ;; edit the amount (calc-eval val 'push)) ;; edit the amount
(progn ;;make sure there are two spaces after the account name and go to calc (progn ;;make sure there are two spaces after the account name and go to calc
(if (search-backward " " (- (point) 3) t) (if (search-backward " " (- (point) 3) t)
(goto-char (line-end-position)) (goto-char (line-end-position))
(insert " ")) (insert " "))
(calc)))))) (calc))))))
(defun ledger-post-prev-xact () (defun ledger-post-prev-xact ()
"Move point to the previous transaction." "Move point to the previous transaction."

View file

@ -68,7 +68,7 @@
"^--.+?\\($\\|[ ]\\)") "^--.+?\\($\\|[ ]\\)")
(defconst ledger-account-any-status-regex (defconst ledger-account-any-status-regex
"^[ \t]+\\([*!]\\s-+\\)?[[(]?\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") "^[ \t]+\\([*!]\\s-+\\)?\\([[(]?.+?\\)\\(\t\\|\n\\| [ \t]\\)")
(defconst ledger-account-pending-regex (defconst ledger-account-pending-regex
"\\(^[ \t]+\\)\\(!\\s-*.*?\\)\\( \\|\t\\|$\\)") "\\(^[ \t]+\\)\\(!\\s-*.*?\\)\\( \\|\t\\|$\\)")