[emacs] C-x h M-x untabify RET
C-x h M-x indent-region RET [ci skip]
This commit is contained in:
thdox
parent
f8dd075e25
commit
8162cc783d
18 changed files with 573 additions and 573 deletions
|
|
@ -1,5 +1,5 @@
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; Ledger
|
||||
;; Ledger
|
||||
|
||||
;; Maybe later add this to the expense repo once it settles
|
||||
(add-to-list 'load-path "/home/adamsrl/.emacs.d/addons/ledger")
|
||||
|
|
@ -104,19 +104,19 @@
|
|||
|
||||
(defun ledger-expense-shortcut ()
|
||||
"Updates the ER and Project metadata with the current values of the shortcut variables."
|
||||
(interactive)
|
||||
(when (eq major-mode 'ledger-mode)
|
||||
(if (or (eql *ledger-expense-shortcut-ER* "")
|
||||
(eql *ledger-expense-shortcut-Proj* ""))
|
||||
(message "Run ledger-expense-shortcut-setup first.")
|
||||
(save-excursion
|
||||
(search-forward "; ER:")
|
||||
(kill-line nil)
|
||||
(insert " " *ledger-expense-shortcut-ER*))
|
||||
(save-excursion
|
||||
(search-forward "; PROJECT:")
|
||||
(kill-line nil)
|
||||
(insert " " *ledger-expense-shortcut-Proj*)))))
|
||||
(interactive)
|
||||
(when (eq major-mode 'ledger-mode)
|
||||
(if (or (eql *ledger-expense-shortcut-ER* "")
|
||||
(eql *ledger-expense-shortcut-Proj* ""))
|
||||
(message "Run ledger-expense-shortcut-setup first.")
|
||||
(save-excursion
|
||||
(search-forward "; ER:")
|
||||
(kill-line nil)
|
||||
(insert " " *ledger-expense-shortcut-ER*))
|
||||
(save-excursion
|
||||
(search-forward "; PROJECT:")
|
||||
(kill-line nil)
|
||||
(insert " " *ledger-expense-shortcut-Proj*)))))
|
||||
|
||||
(defun ledger-expense-split ()
|
||||
"Splits the current transaction between internal and projects."
|
||||
|
|
@ -158,33 +158,33 @@
|
|||
|
||||
(defun ledger-expense-personal ()
|
||||
"Makes the expense an personal one, eliminating metadata and receipts."
|
||||
(interactive)
|
||||
(when (eq major-mode 'ledger-mode) ; I made this local now, should only trigger in ldg-mode
|
||||
(save-excursion
|
||||
(end-of-line)
|
||||
(re-search-backward "^[0-9]\\{4\\}/")
|
||||
(let ((begin (point))
|
||||
(end (save-excursion (re-search-forward "^$"))))
|
||||
(when (re-search-forward "^ Dest:Projects" end t)
|
||||
(replace-match " Other:Personal"))
|
||||
(goto-char begin)
|
||||
(save-excursion
|
||||
(when (re-search-forward "^ +; ER:" end t)
|
||||
(beginning-of-line)
|
||||
(kill-line 1)))
|
||||
(save-excursion
|
||||
(when (re-search-forward "^ +; PROJECT:" end t)
|
||||
(beginning-of-line)
|
||||
(kill-line 1)))
|
||||
(save-excursion
|
||||
(when (re-search-forward "^ +; CATEGORY:" end t)
|
||||
(beginning-of-line)
|
||||
(kill-line 1)))
|
||||
(save-excursion
|
||||
(when (re-search-forward "^ +; RECEIPT:" end t)
|
||||
(beginning-of-line)
|
||||
(kill-line 1)))
|
||||
(ledger-toggle-current-entry)))))
|
||||
(interactive)
|
||||
(when (eq major-mode 'ledger-mode) ; I made this local now, should only trigger in ldg-mode
|
||||
(save-excursion
|
||||
(end-of-line)
|
||||
(re-search-backward "^[0-9]\\{4\\}/")
|
||||
(let ((begin (point))
|
||||
(end (save-excursion (re-search-forward "^$"))))
|
||||
(when (re-search-forward "^ Dest:Projects" end t)
|
||||
(replace-match " Other:Personal"))
|
||||
(goto-char begin)
|
||||
(save-excursion
|
||||
(when (re-search-forward "^ +; ER:" end t)
|
||||
(beginning-of-line)
|
||||
(kill-line 1)))
|
||||
(save-excursion
|
||||
(when (re-search-forward "^ +; PROJECT:" end t)
|
||||
(beginning-of-line)
|
||||
(kill-line 1)))
|
||||
(save-excursion
|
||||
(when (re-search-forward "^ +; CATEGORY:" end t)
|
||||
(beginning-of-line)
|
||||
(kill-line 1)))
|
||||
(save-excursion
|
||||
(when (re-search-forward "^ +; RECEIPT:" end t)
|
||||
(beginning-of-line)
|
||||
(kill-line 1)))
|
||||
(ledger-toggle-current-entry)))))
|
||||
|
||||
(defun ledger-expense-show-receipt ()
|
||||
"Uses the Receipt buffer to show the receipt of the txn we're on."
|
||||
|
|
|
|||
|
|
@ -202,13 +202,13 @@
|
|||
(defun ledger-receipt-skip ()
|
||||
"Move the current image to the Skip directory because its not relevant."
|
||||
|
||||
(rename-file (concat ledger-matching-sourcedir "/"
|
||||
ledger-matching-image-name)
|
||||
(concat ledger-matching-sourcedir "/Skip/"
|
||||
ledger-matching-image-name))
|
||||
(rename-file (concat ledger-matching-sourcedir "/"
|
||||
ledger-matching-image-name)
|
||||
(concat ledger-matching-sourcedir "/Skip/"
|
||||
ledger-matching-image-name))
|
||||
|
||||
;; Update the receipt screen at the same offset
|
||||
(ledger-matching-update-current-image))
|
||||
;; Update the receipt screen at the same offset
|
||||
(ledger-matching-update-current-image))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Items below are speed entry macros, and should eventually migrate to their own file.
|
||||
|
|
@ -242,19 +242,19 @@
|
|||
|
||||
(defun ledger-expense-shortcut ()
|
||||
"Updates the ER and Project metadata with the current values of the shortcut variables."
|
||||
(interactive)
|
||||
(when (eq major-mode 'ledger-mode)
|
||||
(if (or (eql *ledger-expense-shortcut-ER* "")
|
||||
(eql *ledger-expense-shortcut-Proj* ""))
|
||||
(message "Run ledger-expense-shortcut-setup first.")
|
||||
(save-excursion
|
||||
(search-forward "; ER:")
|
||||
(kill-line nil)
|
||||
(insert " " *ledger-expense-shortcut-ER*))
|
||||
(save-excursion
|
||||
(search-forward "; PROJECT:")
|
||||
(kill-line nil)
|
||||
(insert " " *ledger-expense-shortcut-Proj*)))))
|
||||
(interactive)
|
||||
(when (eq major-mode 'ledger-mode)
|
||||
(if (or (eql *ledger-expense-shortcut-ER* "")
|
||||
(eql *ledger-expense-shortcut-Proj* ""))
|
||||
(message "Run ledger-expense-shortcut-setup first.")
|
||||
(save-excursion
|
||||
(search-forward "; ER:")
|
||||
(kill-line nil)
|
||||
(insert " " *ledger-expense-shortcut-ER*))
|
||||
(save-excursion
|
||||
(search-forward "; PROJECT:")
|
||||
(kill-line nil)
|
||||
(insert " " *ledger-expense-shortcut-Proj*)))))
|
||||
|
||||
(defun ledger-expense-split ()
|
||||
"Splits the current transaction between internal and projects."
|
||||
|
|
@ -296,33 +296,33 @@
|
|||
|
||||
(defun ledger-expense-personal ()
|
||||
"Makes the expense an personal one, eliminating metadata and receipts."
|
||||
(interactive)
|
||||
(when (eq major-mode 'ledger-mode) ; I made this local now, should only trigger in ldg-mode
|
||||
(save-excursion
|
||||
(end-of-line)
|
||||
(re-search-backward "^[0-9]\\{4\\}/")
|
||||
(let ((begin (point))
|
||||
(end (save-excursion (re-search-forward "^$"))))
|
||||
(when (re-search-forward "^ Dest:Projects" end t)
|
||||
(replace-match " Other:Personal"))
|
||||
(goto-char begin)
|
||||
(save-excursion
|
||||
(when (re-search-forward "^ +; ER:" end t)
|
||||
(beginning-of-line)
|
||||
(kill-line 1)))
|
||||
(save-excursion
|
||||
(when (re-search-forward "^ +; PROJECT:" end t)
|
||||
(beginning-of-line)
|
||||
(kill-line 1)))
|
||||
(save-excursion
|
||||
(when (re-search-forward "^ +; CATEGORY:" end t)
|
||||
(beginning-of-line)
|
||||
(kill-line 1)))
|
||||
(save-excursion
|
||||
(when (re-search-forward "^ +; RECEIPT:" end t)
|
||||
(beginning-of-line)
|
||||
(kill-line 1)))
|
||||
(ledger-toggle-current-entry)))))
|
||||
(interactive)
|
||||
(when (eq major-mode 'ledger-mode) ; I made this local now, should only trigger in ldg-mode
|
||||
(save-excursion
|
||||
(end-of-line)
|
||||
(re-search-backward "^[0-9]\\{4\\}/")
|
||||
(let ((begin (point))
|
||||
(end (save-excursion (re-search-forward "^$"))))
|
||||
(when (re-search-forward "^ Dest:Projects" end t)
|
||||
(replace-match " Other:Personal"))
|
||||
(goto-char begin)
|
||||
(save-excursion
|
||||
(when (re-search-forward "^ +; ER:" end t)
|
||||
(beginning-of-line)
|
||||
(kill-line 1)))
|
||||
(save-excursion
|
||||
(when (re-search-forward "^ +; PROJECT:" end t)
|
||||
(beginning-of-line)
|
||||
(kill-line 1)))
|
||||
(save-excursion
|
||||
(when (re-search-forward "^ +; CATEGORY:" end t)
|
||||
(beginning-of-line)
|
||||
(kill-line 1)))
|
||||
(save-excursion
|
||||
(when (re-search-forward "^ +; RECEIPT:" end t)
|
||||
(beginning-of-line)
|
||||
(kill-line 1)))
|
||||
(ledger-toggle-current-entry)))))
|
||||
|
||||
(defun ledger-expense-show-receipt ()
|
||||
"Uses the Receipt buffer to show the receipt of the txn we're on."
|
||||
|
|
|
|||
|
|
@ -91,8 +91,8 @@ Returns a list with (value commodity)."
|
|||
(error "Can't add different commodities, %S to %S" c1 c2)))
|
||||
|
||||
(defun ledger-strip (str char)
|
||||
"Return STR with CHAR removed."
|
||||
(replace-regexp-in-string char "" str))
|
||||
"Return STR with CHAR removed."
|
||||
(replace-regexp-in-string char "" str))
|
||||
|
||||
(defun ledger-string-to-number (str &optional decimal-comma)
|
||||
"improve builtin string-to-number by handling internationalization, and return nil if number can't be parsed"
|
||||
|
|
@ -105,7 +105,7 @@ Returns a list with (value commodity)."
|
|||
(string-to-number nstr)))
|
||||
|
||||
(defun ledger-number-to-string (n &optional decimal-comma)
|
||||
"number-to-string that handles comma as decimal."
|
||||
"number-to-string that handles comma as decimal."
|
||||
(let ((str (number-to-string n)))
|
||||
(when (or decimal-comma
|
||||
(assoc "decimal-comma" ledger-environment-alist))
|
||||
|
|
@ -124,7 +124,7 @@ longer ones are after the value."
|
|||
(concat commodity " " str))))
|
||||
|
||||
(defun ledger-read-commodity-string (prompt)
|
||||
"Read an amount from mini-buffer using PROMPT."
|
||||
"Read an amount from mini-buffer using PROMPT."
|
||||
(let ((str (read-from-minibuffer
|
||||
(concat prompt " (" ledger-reconcile-default-commodity "): ")))
|
||||
comm)
|
||||
|
|
|
|||
|
|
@ -157,7 +157,7 @@
|
|||
(ledger-accounts)))))
|
||||
|
||||
(defun ledger-trim-trailing-whitespace (str)
|
||||
(replace-regexp-in-string "[ \t]*$" "" str))
|
||||
(replace-regexp-in-string "[ \t]*$" "" str))
|
||||
|
||||
(defun ledger-fully-complete-xact ()
|
||||
"Completes a transaction if there is another matching payee in the buffer.
|
||||
|
|
@ -235,7 +235,7 @@ ledger-magic-tab would cycle properly"
|
|||
pcomplete-seen pcomplete-norm-func
|
||||
pcomplete-args pcomplete-last pcomplete-index
|
||||
pcomplete-autolist
|
||||
(completions (pcomplete-completions))
|
||||
(completions (pcomplete-completions))
|
||||
(result (pcomplete-do-complete pcomplete-stub completions))
|
||||
(pcomplete-termination-string ""))
|
||||
(and result
|
||||
|
|
|
|||
|
|
@ -53,7 +53,7 @@
|
|||
(setq buffer-read-only t)))
|
||||
|
||||
(defun ledger-exec-success-p (ledger-output-buffer)
|
||||
"Return t if the ledger output in LEDGER-OUTPUT-BUFFER is successful."
|
||||
"Return t if the ledger output in LEDGER-OUTPUT-BUFFER is successful."
|
||||
(with-current-buffer ledger-output-buffer
|
||||
(goto-char (point-min))
|
||||
(if (and (> (buffer-size) 1) (looking-at (regexp-quote "While")))
|
||||
|
|
|
|||
|
|
@ -38,45 +38,45 @@
|
|||
:group 'ledger)
|
||||
|
||||
(defun ledger-fontify-buffer-part (&optional beg end len)
|
||||
"Fontify buffer from BEG to END, length LEN."
|
||||
(save-excursion
|
||||
(unless beg (setq beg (point-min)))
|
||||
(unless end (setq end (point-max)))
|
||||
(goto-char beg)
|
||||
(beginning-of-line)
|
||||
(while (< (point) end)
|
||||
(cond ((or (looking-at ledger-xact-start-regex)
|
||||
(looking-at ledger-posting-regex))
|
||||
(ledger-fontify-xact-at (point)))
|
||||
((looking-at ledger-directive-start-regex)
|
||||
(ledger-fontify-directive-at (point))))
|
||||
(ledger-navigate-next-xact-or-directive))))
|
||||
"Fontify buffer from BEG to END, length LEN."
|
||||
(save-excursion
|
||||
(unless beg (setq beg (point-min)))
|
||||
(unless end (setq end (point-max)))
|
||||
(goto-char beg)
|
||||
(beginning-of-line)
|
||||
(while (< (point) end)
|
||||
(cond ((or (looking-at ledger-xact-start-regex)
|
||||
(looking-at ledger-posting-regex))
|
||||
(ledger-fontify-xact-at (point)))
|
||||
((looking-at ledger-directive-start-regex)
|
||||
(ledger-fontify-directive-at (point))))
|
||||
(ledger-navigate-next-xact-or-directive))))
|
||||
|
||||
(defun ledger-fontify-xact-at (position)
|
||||
"Fontify the xact at POSITION."
|
||||
(interactive "d")
|
||||
(save-excursion
|
||||
(goto-char position)
|
||||
(let ((extents (ledger-navigate-find-element-extents position))
|
||||
(state (ledger-transaction-state)))
|
||||
(if (and ledger-fontify-xact-state-overrides state)
|
||||
(cond ((eq state 'cleared)
|
||||
(ledger-fontify-set-face extents 'ledger-font-xact-cleared-face))
|
||||
((eq state 'pending)
|
||||
(ledger-fontify-set-face extents 'ledger-font-xact-pending-face)))
|
||||
(ledger-fontify-xact-by-line extents)))))
|
||||
(interactive "d")
|
||||
(save-excursion
|
||||
(goto-char position)
|
||||
(let ((extents (ledger-navigate-find-element-extents position))
|
||||
(state (ledger-transaction-state)))
|
||||
(if (and ledger-fontify-xact-state-overrides state)
|
||||
(cond ((eq state 'cleared)
|
||||
(ledger-fontify-set-face extents 'ledger-font-xact-cleared-face))
|
||||
((eq state 'pending)
|
||||
(ledger-fontify-set-face extents 'ledger-font-xact-pending-face)))
|
||||
(ledger-fontify-xact-by-line extents)))))
|
||||
|
||||
(defun ledger-fontify-xact-by-line (extents)
|
||||
"Do line-by-line detailed fontification of xact in EXTENTS."
|
||||
(save-excursion
|
||||
(ledger-fontify-xact-start (car extents))
|
||||
(while (< (point) (cadr extents))
|
||||
(if (looking-at "[ \t]+;")
|
||||
(ledger-fontify-set-face (list (point) (progn
|
||||
(end-of-line)
|
||||
(point))) 'ledger-font-comment-face)
|
||||
(ledger-fontify-posting (point)))
|
||||
(forward-line))))
|
||||
"Do line-by-line detailed fontification of xact in EXTENTS."
|
||||
(save-excursion
|
||||
(ledger-fontify-xact-start (car extents))
|
||||
(while (< (point) (cadr extents))
|
||||
(if (looking-at "[ \t]+;")
|
||||
(ledger-fontify-set-face (list (point) (progn
|
||||
(end-of-line)
|
||||
(point))) 'ledger-font-comment-face)
|
||||
(ledger-fontify-posting (point)))
|
||||
(forward-line))))
|
||||
|
||||
(defun ledger-fontify-xact-start (pos)
|
||||
"POS should be at the beginning of a line starting an xact.
|
||||
|
|
@ -102,97 +102,97 @@ Fontify the first line of an xact"
|
|||
(forward-line)))
|
||||
|
||||
(defun ledger-fontify-posting (pos)
|
||||
"Fontify the posting at POS."
|
||||
(let* ((state nil)
|
||||
(end-of-line-comment nil)
|
||||
(end (progn (end-of-line)
|
||||
(point)))
|
||||
(start (progn (beginning-of-line)
|
||||
(point))))
|
||||
"Fontify the posting at POS."
|
||||
(let* ((state nil)
|
||||
(end-of-line-comment nil)
|
||||
(end (progn (end-of-line)
|
||||
(point)))
|
||||
(start (progn (beginning-of-line)
|
||||
(point))))
|
||||
|
||||
;; Look for a posting status flag
|
||||
(set-match-data nil 'reseat)
|
||||
(re-search-forward " \\([*!]\\) " end t)
|
||||
(if (match-string 1)
|
||||
(setq state (ledger-state-from-string (match-string 1))))
|
||||
(beginning-of-line)
|
||||
(re-search-forward "[[:graph:]]\\([ \t][ \t]\\)" end 'end) ;; find the end of the account, or end of line
|
||||
;; Look for a posting status flag
|
||||
(set-match-data nil 'reseat)
|
||||
(re-search-forward " \\([*!]\\) " end t)
|
||||
(if (match-string 1)
|
||||
(setq state (ledger-state-from-string (match-string 1))))
|
||||
(beginning-of-line)
|
||||
(re-search-forward "[[:graph:]]\\([ \t][ \t]\\)" end 'end) ;; find the end of the account, or end of line
|
||||
|
||||
(when (<= (point) end) ;; we are still on the line
|
||||
(ledger-fontify-set-face (list start (point))
|
||||
(cond ((eq state 'cleared)
|
||||
'ledger-font-posting-account-cleared-face)
|
||||
((eq state 'pending)
|
||||
'ledger-font-posting-account-pending-face)
|
||||
(t
|
||||
'ledger-font-posting-account-face)))
|
||||
(when (<= (point) end) ;; we are still on the line
|
||||
(ledger-fontify-set-face (list start (point))
|
||||
(cond ((eq state 'cleared)
|
||||
'ledger-font-posting-account-cleared-face)
|
||||
((eq state 'pending)
|
||||
'ledger-font-posting-account-pending-face)
|
||||
(t
|
||||
'ledger-font-posting-account-face)))
|
||||
|
||||
|
||||
(when (< (point) end) ;; there is still more to fontify
|
||||
(setq start (point)) ;; update start of next font region
|
||||
(setq end-of-line-comment (re-search-forward ";" end 'end)) ;; find the end of the line, or start of a comment
|
||||
(ledger-fontify-set-face (list start (point) )
|
||||
(cond ((eq state 'cleared)
|
||||
'ledger-font-posting-amount-cleared-face)
|
||||
((eq state 'pending)
|
||||
'ledger-font-posting-amount-pending-face)
|
||||
(t
|
||||
'ledger-font-posting-amount-face)))
|
||||
(when end-of-line-comment
|
||||
(setq start (point))
|
||||
(end-of-line)
|
||||
(ledger-fontify-set-face (list (- start 1) (point)) ;; subtract 1 from start because we passed the semi-colon
|
||||
'ledger-font-comment-face))))))
|
||||
(when (< (point) end) ;; there is still more to fontify
|
||||
(setq start (point)) ;; update start of next font region
|
||||
(setq end-of-line-comment (re-search-forward ";" end 'end)) ;; find the end of the line, or start of a comment
|
||||
(ledger-fontify-set-face (list start (point) )
|
||||
(cond ((eq state 'cleared)
|
||||
'ledger-font-posting-amount-cleared-face)
|
||||
((eq state 'pending)
|
||||
'ledger-font-posting-amount-pending-face)
|
||||
(t
|
||||
'ledger-font-posting-amount-face)))
|
||||
(when end-of-line-comment
|
||||
(setq start (point))
|
||||
(end-of-line)
|
||||
(ledger-fontify-set-face (list (- start 1) (point)) ;; subtract 1 from start because we passed the semi-colon
|
||||
'ledger-font-comment-face))))))
|
||||
|
||||
(defun ledger-fontify-directive-at (pos)
|
||||
"Fontify the directive at POS."
|
||||
(let ((extents (ledger-navigate-find-element-extents pos))
|
||||
(face 'ledger-font-default-face))
|
||||
(cond ((looking-at "=")
|
||||
(setq face 'ledger-font-auto-xact-face))
|
||||
((looking-at "~")
|
||||
(setq face 'ledger-font-periodic-xact-face))
|
||||
((looking-at "[;#%|\\*]")
|
||||
(setq face 'ledger-font-comment-face))
|
||||
((looking-at "\\(year\\)\\|Y")
|
||||
(setq face 'ledger-font-year-directive-face))
|
||||
((looking-at "account")
|
||||
(setq face 'ledger-font-account-directive-face))
|
||||
((looking-at "apply")
|
||||
(setq face 'ledger-font-apply-directive-face))
|
||||
((looking-at "alias")
|
||||
(setq face 'ledger-font-alias-directive-face))
|
||||
((looking-at "assert")
|
||||
(setq face 'ledger-font-assert-directive-face))
|
||||
((looking-at "\\(bucket\\)\\|A")
|
||||
(setq face 'ledger-font-bucket-directive-face))
|
||||
((looking-at "capture")
|
||||
(setq face 'ledger-font-capture-directive-face))
|
||||
((looking-at "check")
|
||||
(setq face 'ledger-font-check-directive-face))
|
||||
((looking-at "commodity")
|
||||
(setq face 'ledger-font-commodity-directive-face))
|
||||
((looking-at "define")
|
||||
(setq face 'ledger-font-define-directive-face))
|
||||
((looking-at "end")
|
||||
(setq face 'ledger-font-end-directive-face))
|
||||
((looking-at "expr")
|
||||
(setq face 'ledger-font-expr-directive-face))
|
||||
((looking-at "fixed")
|
||||
(setq face 'ledger-font-fixed-directive-face))
|
||||
((looking-at "include")
|
||||
(setq face 'ledger-font-include-directive-face))
|
||||
((looking-at "payee")
|
||||
(setq face 'ledger-font-payee-directive-face))
|
||||
((looking-at "P")
|
||||
(setq face 'ledger-font-price-directive-face))
|
||||
((looking-at "tag")
|
||||
(setq face 'ledger-font-tag-directive-face)))
|
||||
(ledger-fontify-set-face extents face)))
|
||||
"Fontify the directive at POS."
|
||||
(let ((extents (ledger-navigate-find-element-extents pos))
|
||||
(face 'ledger-font-default-face))
|
||||
(cond ((looking-at "=")
|
||||
(setq face 'ledger-font-auto-xact-face))
|
||||
((looking-at "~")
|
||||
(setq face 'ledger-font-periodic-xact-face))
|
||||
((looking-at "[;#%|\\*]")
|
||||
(setq face 'ledger-font-comment-face))
|
||||
((looking-at "\\(year\\)\\|Y")
|
||||
(setq face 'ledger-font-year-directive-face))
|
||||
((looking-at "account")
|
||||
(setq face 'ledger-font-account-directive-face))
|
||||
((looking-at "apply")
|
||||
(setq face 'ledger-font-apply-directive-face))
|
||||
((looking-at "alias")
|
||||
(setq face 'ledger-font-alias-directive-face))
|
||||
((looking-at "assert")
|
||||
(setq face 'ledger-font-assert-directive-face))
|
||||
((looking-at "\\(bucket\\)\\|A")
|
||||
(setq face 'ledger-font-bucket-directive-face))
|
||||
((looking-at "capture")
|
||||
(setq face 'ledger-font-capture-directive-face))
|
||||
((looking-at "check")
|
||||
(setq face 'ledger-font-check-directive-face))
|
||||
((looking-at "commodity")
|
||||
(setq face 'ledger-font-commodity-directive-face))
|
||||
((looking-at "define")
|
||||
(setq face 'ledger-font-define-directive-face))
|
||||
((looking-at "end")
|
||||
(setq face 'ledger-font-end-directive-face))
|
||||
((looking-at "expr")
|
||||
(setq face 'ledger-font-expr-directive-face))
|
||||
((looking-at "fixed")
|
||||
(setq face 'ledger-font-fixed-directive-face))
|
||||
((looking-at "include")
|
||||
(setq face 'ledger-font-include-directive-face))
|
||||
((looking-at "payee")
|
||||
(setq face 'ledger-font-payee-directive-face))
|
||||
((looking-at "P")
|
||||
(setq face 'ledger-font-price-directive-face))
|
||||
((looking-at "tag")
|
||||
(setq face 'ledger-font-tag-directive-face)))
|
||||
(ledger-fontify-set-face extents face)))
|
||||
|
||||
(defun ledger-fontify-set-face (extents face)
|
||||
"Set the text in EXTENTS to FACE."
|
||||
(put-text-property (car extents) (cadr extents) 'face face))
|
||||
"Set the text in EXTENTS to FACE."
|
||||
(put-text-property (car extents) (cadr extents) 'face face))
|
||||
|
||||
|
||||
(provide 'ledger-fontify)
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@
|
|||
(defvar ledger-default-date-format "%Y/%m/%d")
|
||||
|
||||
(defun ledger-init-parse-initialization (buffer)
|
||||
"Parse the .ledgerrc file in BUFFER."
|
||||
"Parse the .ledgerrc file in BUFFER."
|
||||
(with-current-buffer buffer
|
||||
(let (environment-alist)
|
||||
(goto-char (point-min))
|
||||
|
|
@ -56,7 +56,7 @@
|
|||
environment-alist)))
|
||||
|
||||
(defun ledger-init-load-init-file ()
|
||||
"Load and parse the .ledgerrc file."
|
||||
"Load and parse the .ledgerrc file."
|
||||
(interactive)
|
||||
(let ((init-base-name (file-name-nondirectory ledger-init-file-name)))
|
||||
(if (get-buffer init-base-name) ;; init file already loaded, parse it and leave it
|
||||
|
|
|
|||
|
|
@ -63,7 +63,7 @@
|
|||
|
||||
(defun ledger-mode-dump-variable (var)
|
||||
"Format VAR for dump to buffer."
|
||||
(if var
|
||||
(if var
|
||||
(insert (format " %s: %S\n" (symbol-name var) (eval var)))))
|
||||
|
||||
(defun ledger-mode-dump-group (group)
|
||||
|
|
@ -78,7 +78,7 @@
|
|||
|
||||
(defun ledger-mode-dump-configuration ()
|
||||
"Dump all customizations."
|
||||
(interactive)
|
||||
(interactive)
|
||||
(find-file "ledger-mode-dump")
|
||||
(ledger-mode-dump-group 'ledger))
|
||||
|
||||
|
|
@ -99,11 +99,11 @@
|
|||
|
||||
(defun ledger-read-account-with-prompt (prompt)
|
||||
"Read an account from the minibuffer with PROMPT."
|
||||
(let ((context (ledger-context-at-point)))
|
||||
(let ((context (ledger-context-at-point)))
|
||||
(ledger-read-string-with-default prompt
|
||||
(if (eq (ledger-context-current-field context) 'account)
|
||||
(regexp-quote (ledger-context-field-value context 'account))
|
||||
nil))))
|
||||
(if (eq (ledger-context-current-field context) 'account)
|
||||
(regexp-quote (ledger-context-field-value context 'account))
|
||||
nil))))
|
||||
|
||||
(defun ledger-read-date (prompt)
|
||||
"Return user-supplied date after `PROMPT', defaults to today."
|
||||
|
|
@ -222,7 +222,7 @@ With a prefix argument, remove the effective date."
|
|||
|
||||
(defun ledger-mode-remove-extra-lines ()
|
||||
"Get rid of multiple empty lines."
|
||||
(goto-char (point-min))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "\n\n\\(\n\\)+" nil t)
|
||||
(replace-match "\n\n")))
|
||||
|
||||
|
|
@ -338,10 +338,10 @@ With a prefix argument, remove the effective date."
|
|||
'(ledger-font-lock-keywords t t nil nil
|
||||
(font-lock-fontify-region-function . ledger-fontify-buffer-part))))
|
||||
|
||||
(set (make-local-variable 'pcomplete-parse-arguments-function) 'ledger-parse-arguments)
|
||||
(set (make-local-variable 'pcomplete-command-completion-function) 'ledger-complete-at-point)
|
||||
(set (make-local-variable 'pcomplete-parse-arguments-function) 'ledger-parse-arguments)
|
||||
(set (make-local-variable 'pcomplete-command-completion-function) 'ledger-complete-at-point)
|
||||
(add-hook 'completion-at-point-functions 'pcomplete-completions-at-point nil t)
|
||||
(add-hook 'after-save-hook 'ledger-report-redo)
|
||||
(add-hook 'after-save-hook 'ledger-report-redo)
|
||||
|
||||
(add-hook 'post-command-hook 'ledger-highlight-xact-under-point nil t)
|
||||
|
||||
|
|
|
|||
|
|
@ -39,49 +39,49 @@
|
|||
(goto-char (point-max))))
|
||||
|
||||
(defun ledger-navigate-start-xact-or-directive-p ()
|
||||
"Return t if at the beginning of an empty or all-whitespace line."
|
||||
(not (looking-at "[ \t]\\|\\(^$\\)")))
|
||||
"Return t if at the beginning of an empty or all-whitespace line."
|
||||
(not (looking-at "[ \t]\\|\\(^$\\)")))
|
||||
|
||||
(defun ledger-navigate-next-xact-or-directive ()
|
||||
"Move to the beginning of the next xact or directive."
|
||||
(interactive)
|
||||
(beginning-of-line)
|
||||
(if (ledger-navigate-start-xact-or-directive-p) ; if we are the start of an xact, move forward to the next xact
|
||||
(progn
|
||||
(forward-line)
|
||||
(if (not (ledger-navigate-start-xact-or-directive-p)) ; we have moved forward and are not at another xact, recurse forward
|
||||
(ledger-navigate-next-xact-or-directive)))
|
||||
(while (not (or (eobp) ; we didn't start off at the beginning of an xact
|
||||
(ledger-navigate-start-xact-or-directive-p)))
|
||||
(forward-line))))
|
||||
"Move to the beginning of the next xact or directive."
|
||||
(interactive)
|
||||
(beginning-of-line)
|
||||
(if (ledger-navigate-start-xact-or-directive-p) ; if we are the start of an xact, move forward to the next xact
|
||||
(progn
|
||||
(forward-line)
|
||||
(if (not (ledger-navigate-start-xact-or-directive-p)) ; we have moved forward and are not at another xact, recurse forward
|
||||
(ledger-navigate-next-xact-or-directive)))
|
||||
(while (not (or (eobp) ; we didn't start off at the beginning of an xact
|
||||
(ledger-navigate-start-xact-or-directive-p)))
|
||||
(forward-line))))
|
||||
|
||||
(defun ledger-navigate-prev-xact-or-directive ()
|
||||
"Move point to beginning of previous xact."
|
||||
(interactive)
|
||||
(let ((context (car (ledger-context-at-point))))
|
||||
(when (equal context 'acct-transaction)
|
||||
(ledger-navigate-beginning-of-xact))
|
||||
(beginning-of-line)
|
||||
(re-search-backward "^[[:graph:]]" nil t)))
|
||||
(interactive)
|
||||
(let ((context (car (ledger-context-at-point))))
|
||||
(when (equal context 'acct-transaction)
|
||||
(ledger-navigate-beginning-of-xact))
|
||||
(beginning-of-line)
|
||||
(re-search-backward "^[[:graph:]]" nil t)))
|
||||
|
||||
(defun ledger-navigate-beginning-of-xact ()
|
||||
"Move point to the beginning of the current xact."
|
||||
(interactive)
|
||||
;; need to start at the beginning of a line incase we are in the first line of an xact already.
|
||||
(beginning-of-line)
|
||||
(let ((sreg (concat "^\\(=\\|~\\|" ledger-iso-date-regexp "\\)")))
|
||||
(unless (looking-at sreg)
|
||||
(re-search-backward sreg nil t)
|
||||
(beginning-of-line)))
|
||||
(point))
|
||||
"Move point to the beginning of the current xact."
|
||||
(interactive)
|
||||
;; need to start at the beginning of a line incase we are in the first line of an xact already.
|
||||
(beginning-of-line)
|
||||
(let ((sreg (concat "^\\(=\\|~\\|" ledger-iso-date-regexp "\\)")))
|
||||
(unless (looking-at sreg)
|
||||
(re-search-backward sreg nil t)
|
||||
(beginning-of-line)))
|
||||
(point))
|
||||
|
||||
(defun ledger-navigate-end-of-xact ()
|
||||
"Move point to end of xact."
|
||||
(interactive)
|
||||
(interactive)
|
||||
(ledger-navigate-next-xact-or-directive)
|
||||
(re-search-backward ".$")
|
||||
(end-of-line)
|
||||
(point))
|
||||
(re-search-backward ".$")
|
||||
(end-of-line)
|
||||
(point))
|
||||
|
||||
(defun ledger-navigate-to-line (line-number)
|
||||
"Rapidly move point to line LINE-NUMBER."
|
||||
|
|
@ -95,61 +95,61 @@ Requires empty line separating xacts."
|
|||
(save-excursion
|
||||
(goto-char pos)
|
||||
(list (ledger-navigate-beginning-of-xact)
|
||||
(ledger-navigate-end-of-xact))))
|
||||
(ledger-navigate-end-of-xact))))
|
||||
|
||||
(defun ledger-navigate-find-directive-extents (pos)
|
||||
"Return the extents of the directive at POS."
|
||||
(goto-char pos)
|
||||
(let ((begin (progn (beginning-of-line)
|
||||
(point)))
|
||||
(end (progn (end-of-line)
|
||||
(+ 1 (point)))))
|
||||
;; handle block comments here
|
||||
(beginning-of-line)
|
||||
(if (looking-at " *;")
|
||||
(progn
|
||||
(while (and (looking-at " *;")
|
||||
(> (point) (point-min)))
|
||||
(forward-line -1))
|
||||
;; We are either at the beginning of the buffer, or we found
|
||||
;; a line outside the comment. If we are not at the
|
||||
;; beginning of the buffer then we need to move forward a
|
||||
;; line.
|
||||
(if (> (point) (point-min))
|
||||
(progn (forward-line 1)
|
||||
(beginning-of-line)))
|
||||
(setq begin (point))
|
||||
(goto-char pos)
|
||||
(beginning-of-line)
|
||||
(while (and (looking-at " *;")
|
||||
(< (point) (point-max)))
|
||||
(forward-line 1))
|
||||
(setq end (point))))
|
||||
(list begin end)))
|
||||
(goto-char pos)
|
||||
(let ((begin (progn (beginning-of-line)
|
||||
(point)))
|
||||
(end (progn (end-of-line)
|
||||
(+ 1 (point)))))
|
||||
;; handle block comments here
|
||||
(beginning-of-line)
|
||||
(if (looking-at " *;")
|
||||
(progn
|
||||
(while (and (looking-at " *;")
|
||||
(> (point) (point-min)))
|
||||
(forward-line -1))
|
||||
;; We are either at the beginning of the buffer, or we found
|
||||
;; a line outside the comment. If we are not at the
|
||||
;; beginning of the buffer then we need to move forward a
|
||||
;; line.
|
||||
(if (> (point) (point-min))
|
||||
(progn (forward-line 1)
|
||||
(beginning-of-line)))
|
||||
(setq begin (point))
|
||||
(goto-char pos)
|
||||
(beginning-of-line)
|
||||
(while (and (looking-at " *;")
|
||||
(< (point) (point-max)))
|
||||
(forward-line 1))
|
||||
(setq end (point))))
|
||||
(list begin end)))
|
||||
|
||||
(defun ledger-navigate-block-comment (pos)
|
||||
"Move past the block comment at POS, and return its extents."
|
||||
(interactive "d")
|
||||
(goto-char pos)
|
||||
(let ((begin (progn (beginning-of-line)
|
||||
(point)))
|
||||
(end (progn (end-of-line)
|
||||
(point))))
|
||||
;; handle block comments here
|
||||
(beginning-of-line)
|
||||
(if (looking-at " *;")
|
||||
(progn
|
||||
(while (and (looking-at " *;")
|
||||
(> (point) (point-min)))
|
||||
(forward-line -1))
|
||||
(setq begin (point))
|
||||
(goto-char pos)
|
||||
(beginning-of-line)
|
||||
(while (and (looking-at " *;")
|
||||
(< (point) (point-max)))
|
||||
(forward-line 1))
|
||||
(setq end (point))))
|
||||
(list begin end)))
|
||||
(interactive "d")
|
||||
(goto-char pos)
|
||||
(let ((begin (progn (beginning-of-line)
|
||||
(point)))
|
||||
(end (progn (end-of-line)
|
||||
(point))))
|
||||
;; handle block comments here
|
||||
(beginning-of-line)
|
||||
(if (looking-at " *;")
|
||||
(progn
|
||||
(while (and (looking-at " *;")
|
||||
(> (point) (point-min)))
|
||||
(forward-line -1))
|
||||
(setq begin (point))
|
||||
(goto-char pos)
|
||||
(beginning-of-line)
|
||||
(while (and (looking-at " *;")
|
||||
(< (point) (point-max)))
|
||||
(forward-line 1))
|
||||
(setq end (point))))
|
||||
(list begin end)))
|
||||
|
||||
|
||||
(defun ledger-navigate-find-element-extents (pos)
|
||||
|
|
|
|||
|
|
@ -118,7 +118,7 @@ currently active."
|
|||
Argument OVL-BOUNDS contains bounds for the transactions to be left visible."
|
||||
(let* ((beg (caar ovl-bounds))
|
||||
(end (cadar ovl-bounds)))
|
||||
(ledger-occur-remove-overlays)
|
||||
(ledger-occur-remove-overlays)
|
||||
(ledger-occur-make-invisible-overlay (point-min) (1- beg))
|
||||
(dolist (visible (cdr ovl-bounds))
|
||||
(ledger-occur-make-visible-overlay beg end)
|
||||
|
|
@ -143,25 +143,25 @@ Argument OVL-BOUNDS contains bounds for the transactions to be left visible."
|
|||
(while (not (eobp))
|
||||
;; if something found
|
||||
(when (setq endpoint (re-search-forward regex nil 'end))
|
||||
(setq bounds (ledger-navigate-find-element-extents endpoint))
|
||||
(push bounds lines)
|
||||
;; move to the end of the xact, no need to search inside it more
|
||||
(setq bounds (ledger-navigate-find-element-extents endpoint))
|
||||
(push bounds lines)
|
||||
;; move to the end of the xact, no need to search inside it more
|
||||
(goto-char (cadr bounds))))
|
||||
(nreverse lines))))
|
||||
|
||||
(defun ledger-occur-compress-matches (buffer-matches)
|
||||
"identify sequential xacts to reduce number of overlays required"
|
||||
(if buffer-matches
|
||||
(let ((points (list))
|
||||
(current-beginning (caar buffer-matches))
|
||||
(current-end (cadar buffer-matches)))
|
||||
(dolist (match (cdr buffer-matches))
|
||||
(if (< (- (car match) current-end) 2)
|
||||
(setq current-end (cadr match))
|
||||
(push (list current-beginning current-end) points)
|
||||
(setq current-beginning (car match))
|
||||
(setq current-end (cadr match))))
|
||||
(nreverse (push (list current-beginning current-end) points)))))
|
||||
(if buffer-matches
|
||||
(let ((points (list))
|
||||
(current-beginning (caar buffer-matches))
|
||||
(current-end (cadar buffer-matches)))
|
||||
(dolist (match (cdr buffer-matches))
|
||||
(if (< (- (car match) current-end) 2)
|
||||
(setq current-end (cadr match))
|
||||
(push (list current-beginning current-end) points)
|
||||
(setq current-beginning (car match))
|
||||
(setq current-end (cadr match))))
|
||||
(nreverse (push (list current-beginning current-end) points)))))
|
||||
|
||||
(provide 'ledger-occur)
|
||||
|
||||
|
|
|
|||
|
|
@ -95,8 +95,8 @@ at beginning of account"
|
|||
(current-column))))
|
||||
|
||||
(defun ledger-post-align-xact (pos)
|
||||
"Align all the posting in the xact at POS."
|
||||
(interactive "d")
|
||||
"Align all the posting in the xact at POS."
|
||||
(interactive "d")
|
||||
(let ((bounds (ledger-navigate-find-xact-extents pos)))
|
||||
(ledger-post-align-postings (car bounds) (cadr bounds))))
|
||||
|
||||
|
|
|
|||
|
|
@ -77,7 +77,7 @@ Default is ledger-default-date-format."
|
|||
:group 'ledger-reconcile)
|
||||
|
||||
(defcustom ledger-reconcile-buffer-header "Reconciling account %s\n\n"
|
||||
"Default header string for the reconcile buffer.
|
||||
"Default header string for the reconcile buffer.
|
||||
|
||||
If non-nil, the name of the account being reconciled will be substituted
|
||||
into the '%s'. If nil, no header will be displayed."
|
||||
|
|
@ -85,7 +85,7 @@ If non-nil, the name of the account being reconciled will be substituted
|
|||
:group 'ledger-reconcile)
|
||||
|
||||
(defcustom ledger-reconcile-buffer-line-format "%(date)s %-4(code)s %-50(payee)s %-30(account)s %15(amount)s\n"
|
||||
"Format string for the ledger reconcile posting format.
|
||||
"Format string for the ledger reconcile posting format.
|
||||
Available fields are date, status, code, payee, account,
|
||||
amount. The format for each field is %WIDTH(FIELD), WIDTH can be
|
||||
preced by a minus sign which mean to left justify and pad the
|
||||
|
|
@ -124,12 +124,12 @@ Possible values are '(date)', '(amount)', '(payee)' or '(0)' for no sorting, i.e
|
|||
"If S is shorter than LEN, pad it with PADDING on the left."
|
||||
(let ((extra (max 0 (- len (length s)))))
|
||||
(concat (make-string extra (string-to-char padding))
|
||||
s)))
|
||||
s)))
|
||||
(defun ledger-reconcile-s-pad-right (len padding s)
|
||||
"If S is shorter than LEN, pad it with PADDING on the right."
|
||||
(let ((extra (max 0 (- len (length s)))))
|
||||
(concat s
|
||||
(make-string extra (string-to-char padding)))))
|
||||
(make-string extra (string-to-char padding)))))
|
||||
(defun ledger-reconcile-s-left (len s)
|
||||
"Return up to the LEN first chars of S."
|
||||
(if (> (length s) len)
|
||||
|
|
@ -139,7 +139,7 @@ Possible values are '(date)', '(amount)', '(payee)' or '(0)' for no sorting, i.e
|
|||
"Return up to the LEN last chars of S."
|
||||
(let ((l (length s)))
|
||||
(if (> l len)
|
||||
(substring s (- l len) l)
|
||||
(substring s (- l len) l)
|
||||
s)))
|
||||
|
||||
(defun ledger-reconcile-truncate-right (str len)
|
||||
|
|
@ -253,9 +253,9 @@ Return the number of uncleared xacts found."
|
|||
(with-current-buffer recon-buf
|
||||
(ledger-reconcile-refresh)
|
||||
(set-buffer-modified-p nil))
|
||||
(when curbufwin
|
||||
(select-window curbufwin)
|
||||
(goto-char curpoint)))))
|
||||
(when curbufwin
|
||||
(select-window curbufwin)
|
||||
(goto-char curpoint)))))
|
||||
|
||||
(defun ledger-reconcile-add ()
|
||||
"Use ledger xact to add a new transaction."
|
||||
|
|
@ -281,34 +281,34 @@ Return the number of uncleared xacts found."
|
|||
(defun ledger-reconcile-visit (&optional come-back)
|
||||
"Recenter ledger buffer on transaction and COME-BACK if non-nil."
|
||||
(interactive)
|
||||
(beginning-of-line)
|
||||
(let* ((where (get-text-property (1+ (point)) 'where))
|
||||
(target-buffer (if where
|
||||
(ledger-reconcile-get-buffer where)
|
||||
nil))
|
||||
(cur-win (get-buffer-window (get-buffer ledger-recon-buffer-name))))
|
||||
(when target-buffer
|
||||
(switch-to-buffer-other-window target-buffer)
|
||||
(ledger-navigate-to-line (cdr where))
|
||||
(forward-char)
|
||||
(recenter)
|
||||
(ledger-highlight-xact-under-point)
|
||||
(forward-char -1)
|
||||
(when (and come-back cur-win)
|
||||
(select-window cur-win)
|
||||
(get-buffer ledger-recon-buffer-name)))))
|
||||
(beginning-of-line)
|
||||
(let* ((where (get-text-property (1+ (point)) 'where))
|
||||
(target-buffer (if where
|
||||
(ledger-reconcile-get-buffer where)
|
||||
nil))
|
||||
(cur-win (get-buffer-window (get-buffer ledger-recon-buffer-name))))
|
||||
(when target-buffer
|
||||
(switch-to-buffer-other-window target-buffer)
|
||||
(ledger-navigate-to-line (cdr where))
|
||||
(forward-char)
|
||||
(recenter)
|
||||
(ledger-highlight-xact-under-point)
|
||||
(forward-char -1)
|
||||
(when (and come-back cur-win)
|
||||
(select-window cur-win)
|
||||
(get-buffer ledger-recon-buffer-name)))))
|
||||
|
||||
|
||||
(defun ledger-reconcile-save ()
|
||||
"Save the ledger buffer."
|
||||
(interactive)
|
||||
(let ((cur-buf (current-buffer))
|
||||
(cur-point (point)))
|
||||
(dolist (buf (cons ledger-buf ledger-bufs))
|
||||
(with-current-buffer buf
|
||||
(basic-save-buffer)))
|
||||
(switch-to-buffer-other-window cur-buf)
|
||||
(goto-char cur-point)))
|
||||
(let ((cur-buf (current-buffer))
|
||||
(cur-point (point)))
|
||||
(dolist (buf (cons ledger-buf ledger-bufs))
|
||||
(with-current-buffer buf
|
||||
(basic-save-buffer)))
|
||||
(switch-to-buffer-other-window cur-buf)
|
||||
(goto-char cur-point)))
|
||||
|
||||
|
||||
(defun ledger-reconcile-finish ()
|
||||
|
|
@ -369,55 +369,55 @@ POSTING is used in `ledger-clear-whole-transactions' is nil."
|
|||
(nth 0 posting))))) ;; return line-no of posting
|
||||
|
||||
(defun ledger-reconcile-compile-format-string (fstr)
|
||||
"Return a function that implements the format string in FSTR."
|
||||
(let (fields
|
||||
(start 0))
|
||||
(while (string-match "(\\(.*?\\))" fstr start)
|
||||
(setq fields (cons (intern (match-string 1 fstr)) fields))
|
||||
(setq start (match-end 0)))
|
||||
(setq fields (list* 'format (replace-regexp-in-string "(.*?)" "" fstr) (nreverse fields)))
|
||||
`(lambda (date code status payee account amount)
|
||||
,fields)))
|
||||
"Return a function that implements the format string in FSTR."
|
||||
(let (fields
|
||||
(start 0))
|
||||
(while (string-match "(\\(.*?\\))" fstr start)
|
||||
(setq fields (cons (intern (match-string 1 fstr)) fields))
|
||||
(setq start (match-end 0)))
|
||||
(setq fields (list* 'format (replace-regexp-in-string "(.*?)" "" fstr) (nreverse fields)))
|
||||
`(lambda (date code status payee account amount)
|
||||
,fields)))
|
||||
|
||||
|
||||
|
||||
(defun ledger-reconcile-format-posting (beg where fmt date code status payee account amount)
|
||||
"Format posting for the reconcile buffer."
|
||||
(insert (funcall fmt date code status payee account amount))
|
||||
"Format posting for the reconcile buffer."
|
||||
(insert (funcall fmt date code status payee account amount))
|
||||
|
||||
; Set face depending on cleared status
|
||||
(if status
|
||||
(if (eq status '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))))
|
||||
; Set face depending on cleared status
|
||||
(if status
|
||||
(if (eq status '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))))
|
||||
|
||||
(defun ledger-reconcile-format-xact (xact fmt)
|
||||
"Format XACT using FMT."
|
||||
(let ((date-format (or (cdr (assoc "date-format" ledger-environment-alist))
|
||||
ledger-default-date-format)))
|
||||
(dolist (posting (nthcdr 5 xact))
|
||||
(let ((beg (point))
|
||||
(where (ledger-marker-where-xact-is xact posting)))
|
||||
(ledger-reconcile-format-posting beg
|
||||
where
|
||||
fmt
|
||||
(format-time-string date-format (nth 2 xact)) ; date
|
||||
(if (nth 3 xact) (nth 3 xact) "") ; code
|
||||
(nth 3 posting) ; status
|
||||
"Format XACT using FMT."
|
||||
(let ((date-format (or (cdr (assoc "date-format" ledger-environment-alist))
|
||||
ledger-default-date-format)))
|
||||
(dolist (posting (nthcdr 5 xact))
|
||||
(let ((beg (point))
|
||||
(where (ledger-marker-where-xact-is xact posting)))
|
||||
(ledger-reconcile-format-posting beg
|
||||
where
|
||||
fmt
|
||||
(format-time-string date-format (nth 2 xact)) ; date
|
||||
(if (nth 3 xact) (nth 3 xact) "") ; code
|
||||
(nth 3 posting) ; status
|
||||
(ledger-reconcile-truncate-right
|
||||
(nth 4 xact) ; payee
|
||||
ledger-reconcile-buffer-payee-max-chars)
|
||||
(nth 4 xact) ; payee
|
||||
ledger-reconcile-buffer-payee-max-chars)
|
||||
(ledger-reconcile-truncate-left
|
||||
(nth 1 posting) ; account
|
||||
ledger-reconcile-buffer-account-max-chars)
|
||||
(nth 2 posting)))))) ; amount
|
||||
(nth 1 posting) ; account
|
||||
ledger-reconcile-buffer-account-max-chars)
|
||||
(nth 2 posting)))))) ; amount
|
||||
|
||||
(defun ledger-do-reconcile (&optional sort)
|
||||
"SORT the uncleared transactions in the account and display them in the *Reconcile* buffer.
|
||||
|
|
@ -437,10 +437,10 @@ Return a count of the uncleared transactions."
|
|||
(unless (eobp)
|
||||
(if (looking-at "(")
|
||||
(read (current-buffer))))))) ;current-buffer is the *temp* created above
|
||||
(fmt (ledger-reconcile-compile-format-string ledger-reconcile-buffer-line-format)))
|
||||
(fmt (ledger-reconcile-compile-format-string ledger-reconcile-buffer-line-format)))
|
||||
(if (and ledger-success (> (length xacts) 0))
|
||||
(progn
|
||||
(insert (format ledger-reconcile-buffer-header account))
|
||||
(insert (format ledger-reconcile-buffer-header account))
|
||||
(dolist (xact xacts)
|
||||
(ledger-reconcile-format-xact xact fmt))
|
||||
(goto-char (point-max))
|
||||
|
|
@ -493,11 +493,11 @@ moved and recentered. If they aren't strange things happen."
|
|||
(pop-to-buffer rbuf)))
|
||||
|
||||
(defun ledger-reconcile-check-valid-account (account)
|
||||
"Check to see if ACCOUNT exists in the ledger file"
|
||||
(if (> (length account) 0)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(search-forward account nil t))))
|
||||
"Check to see if ACCOUNT exists in the ledger file"
|
||||
(if (> (length account) 0)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(search-forward account nil t))))
|
||||
|
||||
(defun ledger-reconcile ()
|
||||
"Start reconciling, prompt for account."
|
||||
|
|
@ -506,38 +506,38 @@ moved and recentered. If they aren't strange things happen."
|
|||
(buf (current-buffer))
|
||||
(rbuf (get-buffer ledger-recon-buffer-name)))
|
||||
|
||||
(when (ledger-reconcile-check-valid-account account)
|
||||
(add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t)
|
||||
(when (ledger-reconcile-check-valid-account account)
|
||||
(add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t)
|
||||
|
||||
(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)
|
||||
(setq ledger-buf buf)) ;; should already be buffer-local
|
||||
(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)
|
||||
(setq ledger-buf buf)) ;; should already be buffer-local
|
||||
|
||||
(unless (get-buffer-window rbuf)
|
||||
(ledger-reconcile-open-windows buf rbuf)))
|
||||
(unless (get-buffer-window rbuf)
|
||||
(ledger-reconcile-open-windows buf rbuf)))
|
||||
|
||||
;; no recon-buffer, starting from scratch.
|
||||
;; no recon-buffer, starting from scratch.
|
||||
|
||||
(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 (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 account)))
|
||||
(if (> (ledger-reconcile-refresh) 0)
|
||||
(ledger-reconcile-change-target))
|
||||
(ledger-display-balance)))))
|
||||
;; Narrow the ledger buffer
|
||||
(with-current-buffer rbuf
|
||||
(save-excursion
|
||||
(if ledger-narrow-on-reconcile
|
||||
(ledger-occur account)))
|
||||
(if (> (ledger-reconcile-refresh) 0)
|
||||
(ledger-reconcile-change-target))
|
||||
(ledger-display-balance)))))
|
||||
|
||||
(defvar ledger-reconcile-mode-abbrev-table)
|
||||
|
||||
|
|
@ -548,7 +548,7 @@ moved and recentered. If they aren't strange things happen."
|
|||
|
||||
(defmacro ledger-reconcile-change-sort-key-and-refresh (sort-by)
|
||||
"Set the sort-key to SORT-BY."
|
||||
`(lambda ()
|
||||
`(lambda ()
|
||||
(interactive)
|
||||
|
||||
(setq ledger-reconcile-sort-key ,sort-by)
|
||||
|
|
|
|||
|
|
@ -108,8 +108,8 @@
|
|||
defs
|
||||
(list
|
||||
`(defmacro
|
||||
,(intern (concat "ledger-regex-" (symbol-name name)))
|
||||
(&optional string)
|
||||
,(intern (concat "ledger-regex-" (symbol-name name)))
|
||||
(&optional string)
|
||||
,(format "Return the match string for the %s" name)
|
||||
(match-string
|
||||
,(intern (concat "ledger-regex-" (symbol-name name)
|
||||
|
|
@ -153,9 +153,9 @@
|
|||
defs
|
||||
(list
|
||||
`(defmacro
|
||||
,(intern (concat "ledger-regex-" (symbol-name name)
|
||||
"-" (symbol-name var)))
|
||||
(&optional string)
|
||||
,(intern (concat "ledger-regex-" (symbol-name name)
|
||||
"-" (symbol-name var)))
|
||||
(&optional string)
|
||||
,(format "Return the sub-group match for the %s %s."
|
||||
name var)
|
||||
(match-string
|
||||
|
|
@ -333,8 +333,8 @@
|
|||
"\\)"))
|
||||
|
||||
(defconst ledger-xact-start-regex
|
||||
(concat "^" ledger-iso-date-regexp ;; subexp 1
|
||||
"\\(=" ledger-iso-date-regexp "\\)?"
|
||||
(concat "^" ledger-iso-date-regexp ;; subexp 1
|
||||
"\\(=" ledger-iso-date-regexp "\\)?"
|
||||
))
|
||||
|
||||
(defconst ledger-xact-after-date-regex
|
||||
|
|
@ -345,17 +345,17 @@
|
|||
))
|
||||
|
||||
(defconst ledger-posting-regex
|
||||
(concat "^[ \t]+ ?" ;; initial white space
|
||||
"\\([*!]\\)? ?" ;; state, subexpr 1
|
||||
"\\([[:print:]]+\\([ \t][ \t]\\)\\)" ;; account, subexpr 2
|
||||
"\\([^;\n]*\\)" ;; amount, subexpr 4
|
||||
"\\(.*\\)" ;; comment, subexpr 5
|
||||
))
|
||||
(concat "^[ \t]+ ?" ;; initial white space
|
||||
"\\([*!]\\)? ?" ;; state, subexpr 1
|
||||
"\\([[:print:]]+\\([ \t][ \t]\\)\\)" ;; account, subexpr 2
|
||||
"\\([^;\n]*\\)" ;; amount, subexpr 4
|
||||
"\\(.*\\)" ;; comment, subexpr 5
|
||||
))
|
||||
|
||||
|
||||
|
||||
(defconst ledger-directive-start-regex
|
||||
"[=~;#%|\\*[A-Za-z]")
|
||||
"[=~;#%|\\*[A-Za-z]")
|
||||
|
||||
|
||||
(provide 'ledger-regex)
|
||||
|
|
|
|||
|
|
@ -57,7 +57,7 @@ specifier."
|
|||
'(("ledger-file" . ledger-report-ledger-file-format-specifier)
|
||||
("payee" . ledger-report-payee-format-specifier)
|
||||
("account" . ledger-report-account-format-specifier)
|
||||
("tagname" . ledger-report-tagname-format-specifier)
|
||||
("tagname" . ledger-report-tagname-format-specifier)
|
||||
("tagvalue" . ledger-report-tagvalue-format-specifier))
|
||||
"An alist mapping ledger report format specifiers to implementing functions.
|
||||
|
||||
|
|
@ -67,14 +67,14 @@ text that should replace the format specifier."
|
|||
:group 'ledger-report)
|
||||
|
||||
(defcustom ledger-report-auto-refresh t
|
||||
"If t then automatically rerun the report when the ledger buffer is saved."
|
||||
:type 'boolean
|
||||
:group 'ledger-report)
|
||||
"If t then automatically rerun the report when the ledger buffer is saved."
|
||||
:type 'boolean
|
||||
:group 'ledger-report)
|
||||
|
||||
(defcustom ledger-report-auto-refresh-sticky-cursor nil
|
||||
"If t then try to place cursor at same relative position as it was before auto-refresh."
|
||||
:type 'boolean
|
||||
:group 'ledger-report)
|
||||
"If t then try to place cursor at same relative position as it was before auto-refresh."
|
||||
:type 'boolean
|
||||
:group 'ledger-report)
|
||||
|
||||
(defvar ledger-report-buffer-name "*Ledger Report*")
|
||||
|
||||
|
|
@ -91,10 +91,10 @@ text that should replace the format specifier."
|
|||
(defvar ledger-report-cursor-line-number nil)
|
||||
|
||||
(defun ledger-report-reverse-report ()
|
||||
"Reverse the order of the report."
|
||||
(interactive)
|
||||
(ledger-report-reverse-lines)
|
||||
(setq ledger-report-is-reversed (not ledger-report-is-reversed)))
|
||||
"Reverse the order of the report."
|
||||
(interactive)
|
||||
(ledger-report-reverse-lines)
|
||||
(setq ledger-report-is-reversed (not ledger-report-is-reversed)))
|
||||
|
||||
(defun ledger-report-reverse-lines ()
|
||||
(goto-char (point-min))
|
||||
|
|
@ -203,7 +203,7 @@ used to generate the buffer, navigating the buffer, etc."
|
|||
(set (make-local-variable 'ledger-buf) buf)
|
||||
(set (make-local-variable 'ledger-report-name) report-name)
|
||||
(set (make-local-variable 'ledger-original-window-cfg) wcfg)
|
||||
(set (make-local-variable 'ledger-report-is-reversed) nil)
|
||||
(set (make-local-variable 'ledger-report-is-reversed) nil)
|
||||
(ledger-do-report (ledger-report-cmd report-name edit))
|
||||
(shrink-window-if-larger-than-buffer)
|
||||
(set-buffer-modified-p nil)
|
||||
|
|
@ -387,30 +387,30 @@ Optional EDIT the command."
|
|||
(defun ledger-report-redo ()
|
||||
"Redo the report in the current ledger report buffer."
|
||||
(interactive)
|
||||
(let ((cur-buf (current-buffer)))
|
||||
(if (and ledger-report-auto-refresh
|
||||
(or (string= (format-mode-line 'mode-name) "Ledger")
|
||||
(string= (format-mode-line 'mode-name) "Ledger-Report"))
|
||||
(get-buffer ledger-report-buffer-name))
|
||||
(progn
|
||||
(let ((cur-buf (current-buffer)))
|
||||
(if (and ledger-report-auto-refresh
|
||||
(or (string= (format-mode-line 'mode-name) "Ledger")
|
||||
(string= (format-mode-line 'mode-name) "Ledger-Report"))
|
||||
(get-buffer ledger-report-buffer-name))
|
||||
(progn
|
||||
|
||||
(pop-to-buffer (get-buffer ledger-report-buffer-name))
|
||||
(shrink-window-if-larger-than-buffer)
|
||||
(setq buffer-read-only nil)
|
||||
(setq ledger-report-cursor-line-number (line-number-at-pos))
|
||||
(erase-buffer)
|
||||
(ledger-do-report ledger-report-cmd)
|
||||
(setq buffer-read-only nil)
|
||||
(if ledger-report-is-reversed (ledger-report-reverse-lines))
|
||||
(if ledger-report-auto-refresh-sticky-cursor (forward-line (- ledger-report-cursor-line-number 5)))
|
||||
(pop-to-buffer cur-buf)))))
|
||||
(pop-to-buffer (get-buffer ledger-report-buffer-name))
|
||||
(shrink-window-if-larger-than-buffer)
|
||||
(setq buffer-read-only nil)
|
||||
(setq ledger-report-cursor-line-number (line-number-at-pos))
|
||||
(erase-buffer)
|
||||
(ledger-do-report ledger-report-cmd)
|
||||
(setq buffer-read-only nil)
|
||||
(if ledger-report-is-reversed (ledger-report-reverse-lines))
|
||||
(if ledger-report-auto-refresh-sticky-cursor (forward-line (- ledger-report-cursor-line-number 5)))
|
||||
(pop-to-buffer cur-buf)))))
|
||||
|
||||
(defun ledger-report-quit ()
|
||||
"Quit the ledger report buffer."
|
||||
(interactive)
|
||||
(ledger-report-goto)
|
||||
(set-window-configuration ledger-original-window-cfg)
|
||||
(kill-buffer (get-buffer ledger-report-buffer-name)))
|
||||
"Quit the ledger report buffer."
|
||||
(interactive)
|
||||
(ledger-report-goto)
|
||||
(set-window-configuration ledger-original-window-cfg)
|
||||
(kill-buffer (get-buffer ledger-report-buffer-name)))
|
||||
|
||||
(defun ledger-report-edit-reports ()
|
||||
"Edit the defined ledger reports."
|
||||
|
|
@ -418,10 +418,10 @@ Optional EDIT the command."
|
|||
(customize-variable 'ledger-reports))
|
||||
|
||||
(defun ledger-report-edit-report ()
|
||||
(interactive)
|
||||
"Edit the current report command in the mini buffer and re-run the report"
|
||||
(setq ledger-report-cmd (ledger-report-read-command ledger-report-cmd))
|
||||
(ledger-report-redo))
|
||||
(interactive)
|
||||
"Edit the current report command in the mini buffer and re-run the report"
|
||||
(setq ledger-report-cmd (ledger-report-read-command ledger-report-cmd))
|
||||
(ledger-report-redo))
|
||||
|
||||
(defun ledger-report-read-new-name ()
|
||||
"Read the name for a new report from the minibuffer."
|
||||
|
|
|
|||
|
|
@ -60,21 +60,21 @@
|
|||
:group 'ledger-schedule)
|
||||
|
||||
(defcustom ledger-schedule-week-days '(("Mo" 1)
|
||||
("Tu" 2)
|
||||
("We" 3)
|
||||
("Th" 4)
|
||||
("Fr" 5)
|
||||
("Sa" 6)
|
||||
("Su" 7))
|
||||
"List of weekday abbreviations. There must be exactly seven
|
||||
("Tu" 2)
|
||||
("We" 3)
|
||||
("Th" 4)
|
||||
("Fr" 5)
|
||||
("Sa" 6)
|
||||
("Su" 7))
|
||||
"List of weekday abbreviations. There must be exactly seven
|
||||
entries each with a two character abbreviation for a day and the
|
||||
number of that day in the week. "
|
||||
:type '(alist :value-type (group integer))
|
||||
:group 'ledger-schedule)
|
||||
:type '(alist :value-type (group integer))
|
||||
:group 'ledger-schedule)
|
||||
|
||||
(defsubst between (val low high)
|
||||
"Return TRUE if VAL > LOW and < HIGH."
|
||||
(and (>= val low) (<= val high)))
|
||||
"Return TRUE if VAL > LOW and < HIGH."
|
||||
(and (>= val low) (<= val high)))
|
||||
|
||||
(defun ledger-schedule-days-in-month (month year)
|
||||
"Return number of days in the MONTH, MONTH is from 1 to 12.
|
||||
|
|
@ -86,8 +86,8 @@ If YEAR is nil, assume it is not a leap year"
|
|||
(error "Month out of range, MONTH=%S" month)))
|
||||
|
||||
(defun ledger-schedule-encode-day-of-week (day-string)
|
||||
"Return the numerical day of week corresponding to DAY-STRING."
|
||||
(cadr (assoc day-string ledger-schedule-week-days)))
|
||||
"Return the numerical day of week corresponding to DAY-STRING."
|
||||
(cadr (assoc day-string ledger-schedule-week-days)))
|
||||
|
||||
;; Macros to handle date expressions
|
||||
|
||||
|
|
@ -173,10 +173,10 @@ the transaction should be logged for that day."
|
|||
xact-list)))
|
||||
|
||||
(defun ledger-schedule-read-descriptor-tree (descriptor-string)
|
||||
"Read DESCRIPTOR-STRING and return a form that evaluates dates."
|
||||
(ledger-schedule-transform-auto-tree
|
||||
(split-string
|
||||
(substring descriptor-string 1 (string-match "]" descriptor-string)) " ")))
|
||||
"Read DESCRIPTOR-STRING and return a form that evaluates dates."
|
||||
(ledger-schedule-transform-auto-tree
|
||||
(split-string
|
||||
(substring descriptor-string 1 (string-match "]" descriptor-string)) " ")))
|
||||
|
||||
(defun ledger-schedule-transform-auto-tree (descriptor-string-list)
|
||||
"Take DESCRIPTOR-STRING-LIST, and return a string with a lambda function of date."
|
||||
|
|
@ -202,84 +202,84 @@ the transaction should be logged for that day."
|
|||
(defun ledger-schedule-compile-constraints (descriptor-string)
|
||||
"Return a list with the year, month and day fields split."
|
||||
(let ((fields (split-string descriptor-string "[/\\-]" t)))
|
||||
(if (string-match "[A-Za-z]" descriptor-string)
|
||||
(ledger-schedule-constrain-day (nth 0 fields) (nth 1 fields) (nth 2 fields))
|
||||
(list 'and
|
||||
(ledger-schedule-constrain-day (nth 0 fields) (nth 1 fields) (nth 2 fields))
|
||||
(ledger-schedule-constrain-year (nth 0 fields) (nth 1 fields) (nth 2 fields))
|
||||
(ledger-schedule-constrain-month (nth 0 fields) (nth 1 fields) (nth 2 fields))))))
|
||||
(if (string-match "[A-Za-z]" descriptor-string)
|
||||
(ledger-schedule-constrain-day (nth 0 fields) (nth 1 fields) (nth 2 fields))
|
||||
(list 'and
|
||||
(ledger-schedule-constrain-day (nth 0 fields) (nth 1 fields) (nth 2 fields))
|
||||
(ledger-schedule-constrain-year (nth 0 fields) (nth 1 fields) (nth 2 fields))
|
||||
(ledger-schedule-constrain-month (nth 0 fields) (nth 1 fields) (nth 2 fields))))))
|
||||
|
||||
(defun ledger-schedule-constrain-year (year-desc month-desc day-desc)
|
||||
"Return a form that constrains the year.
|
||||
"Return a form that constrains the year.
|
||||
|
||||
YEAR-DESC, MONT-DESC, and DAY-DESC are the string portions of the
|
||||
date descriptor."
|
||||
(cond ((string= year-desc "*") t)
|
||||
((/= 0 (string-to-number year-desc))
|
||||
`(memq (nth 5 (decode-time date)) ',(mapcar 'string-to-number (split-string year-desc ","))))
|
||||
(t
|
||||
(error "Improperly specified year constraint: %s %s %s" year-desc month-desc day-desc))))
|
||||
(cond ((string= year-desc "*") t)
|
||||
((/= 0 (string-to-number year-desc))
|
||||
`(memq (nth 5 (decode-time date)) ',(mapcar 'string-to-number (split-string year-desc ","))))
|
||||
(t
|
||||
(error "Improperly specified year constraint: %s %s %s" year-desc month-desc day-desc))))
|
||||
|
||||
(defun ledger-schedule-constrain-month (year-desc month-desc day-desc)
|
||||
"Return a form that constrains the month.
|
||||
"Return a form that constrains the month.
|
||||
|
||||
YEAR-DESC, MONT-DESC, and DAY-DESC are the string portions of the
|
||||
date descriptor."
|
||||
(cond ((string= month-desc "*")
|
||||
t) ;; always match
|
||||
((string= month-desc "E") ;; Even
|
||||
`(evenp (nth 4 (decode-time date))))
|
||||
((string= month-desc "O") ;; Odd
|
||||
`(oddp (nth 4 (decode-time date))))
|
||||
((/= 0 (string-to-number month-desc)) ;; Starts with number
|
||||
`(memq (nth 4 (decode-time date)) ',(mapcar 'string-to-number (split-string month-desc ","))))
|
||||
(t
|
||||
(error "Improperly specified month constraint: %s %s %s" year-desc month-desc day-desc))))
|
||||
(cond ((string= month-desc "*")
|
||||
t) ;; always match
|
||||
((string= month-desc "E") ;; Even
|
||||
`(evenp (nth 4 (decode-time date))))
|
||||
((string= month-desc "O") ;; Odd
|
||||
`(oddp (nth 4 (decode-time date))))
|
||||
((/= 0 (string-to-number month-desc)) ;; Starts with number
|
||||
`(memq (nth 4 (decode-time date)) ',(mapcar 'string-to-number (split-string month-desc ","))))
|
||||
(t
|
||||
(error "Improperly specified month constraint: %s %s %s" year-desc month-desc day-desc))))
|
||||
|
||||
(defun ledger-schedule-constrain-day (year-desc month-desc day-desc)
|
||||
"Return a form that constrains the day.
|
||||
"Return a form that constrains the day.
|
||||
|
||||
YEAR-DESC, MONT-DESC, and DAY-DESC are the string portions of the
|
||||
date descriptor."
|
||||
(cond ((string= day-desc "*")
|
||||
t)
|
||||
((string-match "[A-Za-z]" day-desc) ;; There is something other than digits and commas
|
||||
(ledger-schedule-parse-complex-date year-desc month-desc day-desc))
|
||||
((/= 0 (string-to-number day-desc))
|
||||
`(memq (nth 3 (decode-time date)) ',(mapcar 'string-to-number (split-string day-desc ","))))
|
||||
(t
|
||||
(error "Improperly specified day constraint: %s %s %s" year-desc month-desc day-desc))))
|
||||
(cond ((string= day-desc "*")
|
||||
t)
|
||||
((string-match "[A-Za-z]" day-desc) ;; There is something other than digits and commas
|
||||
(ledger-schedule-parse-complex-date year-desc month-desc day-desc))
|
||||
((/= 0 (string-to-number day-desc))
|
||||
`(memq (nth 3 (decode-time date)) ',(mapcar 'string-to-number (split-string day-desc ","))))
|
||||
(t
|
||||
(error "Improperly specified day constraint: %s %s %s" year-desc month-desc day-desc))))
|
||||
|
||||
|
||||
|
||||
(defun ledger-schedule-parse-complex-date (year-desc month-desc day-desc)
|
||||
"Parse day descriptors that have repeats."
|
||||
(let ((years (mapcar 'string-to-number (split-string year-desc ",")))
|
||||
(months (mapcar 'string-to-number (split-string month-desc ",")))
|
||||
(day-parts (split-string day-desc "+"))
|
||||
(every-nth (string-match "+" day-desc)))
|
||||
(if every-nth
|
||||
(let ((base-day (string-to-number (car day-parts)))
|
||||
(increment (string-to-number (substring (cadr day-parts) 0
|
||||
(string-match "[A-Za-z]" (cadr day-parts)))))
|
||||
(day-of-week (ledger-schedule-encode-day-of-week
|
||||
(substring (cadr day-parts) (string-match "[A-Za-z]" (cadr day-parts))))))
|
||||
(ledger-schedule-constrain-every-count-day day-of-week increment (encode-time 0 0 0 base-day (car months) (car years))))
|
||||
(let ((count (string-to-number (substring (car day-parts) 0 1)))
|
||||
(day-of-week (ledger-schedule-encode-day-of-week
|
||||
(substring (car day-parts) (string-match "[A-Za-z]" (car day-parts))))))
|
||||
(ledger-schedule-constrain-day-in-month count day-of-week)))))
|
||||
"Parse day descriptors that have repeats."
|
||||
(let ((years (mapcar 'string-to-number (split-string year-desc ",")))
|
||||
(months (mapcar 'string-to-number (split-string month-desc ",")))
|
||||
(day-parts (split-string day-desc "+"))
|
||||
(every-nth (string-match "+" day-desc)))
|
||||
(if every-nth
|
||||
(let ((base-day (string-to-number (car day-parts)))
|
||||
(increment (string-to-number (substring (cadr day-parts) 0
|
||||
(string-match "[A-Za-z]" (cadr day-parts)))))
|
||||
(day-of-week (ledger-schedule-encode-day-of-week
|
||||
(substring (cadr day-parts) (string-match "[A-Za-z]" (cadr day-parts))))))
|
||||
(ledger-schedule-constrain-every-count-day day-of-week increment (encode-time 0 0 0 base-day (car months) (car years))))
|
||||
(let ((count (string-to-number (substring (car day-parts) 0 1)))
|
||||
(day-of-week (ledger-schedule-encode-day-of-week
|
||||
(substring (car day-parts) (string-match "[A-Za-z]" (car day-parts))))))
|
||||
(ledger-schedule-constrain-day-in-month count day-of-week)))))
|
||||
|
||||
(defun ledger-schedule-list-upcoming-xacts (candidate-items early horizon)
|
||||
"Search CANDIDATE-ITEMS for xacts that occur within the period today - EARLY to today + HORIZON."
|
||||
(let ((start-date (time-subtract (current-time) (days-to-time early)))
|
||||
test-date items)
|
||||
(loop for day from 0 to (+ early horizon) by 1 do
|
||||
(setq test-date (time-add start-date (days-to-time day)))
|
||||
(dolist (candidate candidate-items items)
|
||||
(if (funcall (car candidate) test-date)
|
||||
(setq items (append items (list (list test-date (cadr candidate))))))))
|
||||
items))
|
||||
"Search CANDIDATE-ITEMS for xacts that occur within the period today - EARLY to today + HORIZON."
|
||||
(let ((start-date (time-subtract (current-time) (days-to-time early)))
|
||||
test-date items)
|
||||
(loop for day from 0 to (+ early horizon) by 1 do
|
||||
(setq test-date (time-add start-date (days-to-time day)))
|
||||
(dolist (candidate candidate-items items)
|
||||
(if (funcall (car candidate) test-date)
|
||||
(setq items (append items (list (list test-date (cadr candidate))))))))
|
||||
items))
|
||||
|
||||
(defun ledger-schedule-create-auto-buffer (candidate-items early horizon ledger-buf)
|
||||
"Format CANDIDATE-ITEMS for display."
|
||||
|
|
@ -290,7 +290,7 @@ date descriptor."
|
|||
(with-current-buffer schedule-buf
|
||||
(erase-buffer)
|
||||
(dolist (candidate candidates)
|
||||
(insert (format-time-string date-format (car candidate) ) " " (cadr candidate) "\n"))
|
||||
(insert (format-time-string date-format (car candidate) ) " " (cadr candidate) "\n"))
|
||||
(ledger-mode))
|
||||
(length candidates)))
|
||||
|
||||
|
|
@ -311,15 +311,15 @@ Use a prefix arg to change the default value"
|
|||
(read-number "Look forward: " ledger-schedule-look-forward))
|
||||
(list ledger-schedule-file ledger-schedule-look-backward ledger-schedule-look-forward)))
|
||||
(if (and file
|
||||
(file-exists-p file))
|
||||
(progn
|
||||
(ledger-schedule-create-auto-buffer
|
||||
(ledger-schedule-scan-transactions file)
|
||||
look-backward
|
||||
look-forward
|
||||
(current-buffer))
|
||||
(pop-to-buffer ledger-schedule-buffer-name))
|
||||
(error "Could not find ledger schedule file at %s" file)))
|
||||
(file-exists-p file))
|
||||
(progn
|
||||
(ledger-schedule-create-auto-buffer
|
||||
(ledger-schedule-scan-transactions file)
|
||||
look-backward
|
||||
look-forward
|
||||
(current-buffer))
|
||||
(pop-to-buffer ledger-schedule-buffer-name))
|
||||
(error "Could not find ledger schedule file at %s" file)))
|
||||
|
||||
|
||||
(provide 'ledger-schedule)
|
||||
|
|
|
|||
|
|
@ -28,17 +28,17 @@
|
|||
|
||||
|
||||
(defun ledger-sort-find-start ()
|
||||
"Find the beginning of a sort region"
|
||||
"Find the beginning of a sort region"
|
||||
(if (re-search-forward ";.*Ledger-mode:.*Start sort" nil t)
|
||||
(match-end 0)))
|
||||
|
||||
(defun ledger-sort-find-end ()
|
||||
"Find the end of a sort region"
|
||||
"Find the end of a sort region"
|
||||
(if (re-search-forward ";.*Ledger-mode:.*End sort" nil t)
|
||||
(match-end 0)))
|
||||
|
||||
(defun ledger-sort-insert-start-mark ()
|
||||
"Insert a marker to start a sort region"
|
||||
"Insert a marker to start a sort region"
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
|
|
@ -48,7 +48,7 @@
|
|||
(insert "\n; Ledger-mode: Start sort\n\n"))
|
||||
|
||||
(defun ledger-sort-insert-end-mark ()
|
||||
"Insert a marker to end a sort region"
|
||||
"Insert a marker to end a sort region"
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
|
|
@ -64,7 +64,7 @@
|
|||
(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)
|
||||
point-delta
|
||||
|
|
@ -77,14 +77,14 @@
|
|||
(save-excursion
|
||||
(save-restriction
|
||||
(goto-char beg)
|
||||
;; make sure point is at the beginning of a xact
|
||||
;; make sure point is at the beginning of a xact
|
||||
(ledger-navigate-next-xact)
|
||||
(unless (looking-at ledger-payee-any-status-regex)
|
||||
(ledger-navigate-next-xact))
|
||||
(setq new-beg (point))
|
||||
(goto-char end)
|
||||
(ledger-navigate-next-xact)
|
||||
;; make sure end of region is at the beginning of next record
|
||||
;; 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)
|
||||
|
|
|
|||
|
|
@ -114,8 +114,8 @@ dropped."
|
|||
(when (not (eq (ledger-state-from-char (char-after)) 'comment))
|
||||
(insert (ledger-char-from-state cur-status) " ")
|
||||
(if (and (search-forward " " (line-end-position) t)
|
||||
(looking-at " "))
|
||||
(delete-char 2)))
|
||||
(looking-at " "))
|
||||
(delete-char 2)))
|
||||
(forward-line))
|
||||
(setq new-status nil)))
|
||||
|
||||
|
|
|
|||
|
|
@ -185,8 +185,8 @@ correct chronological place in the buffer."
|
|||
(goto-char (point-min))
|
||||
(if (looking-at "Error: ")
|
||||
(error (concat "Error in ledger-add-transaction: " (buffer-string)))
|
||||
(ledger-post-align-postings (point-min) (point-max))
|
||||
(buffer-string)))
|
||||
(ledger-post-align-postings (point-min) (point-max))
|
||||
(buffer-string)))
|
||||
"\n"))
|
||||
(progn
|
||||
(insert (car args) " \n\n")
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue