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

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

View file

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