Refactoring and style.
This commit is contained in:
Craig Earls
parent
250358ada0
commit
345f4a977e
10 changed files with 177 additions and 210 deletions
|
|
@ -41,6 +41,15 @@
|
|||
(defconst code-string "\\((\\(.*\\))\\)?")
|
||||
(defconst payee-string "\\(.*\\)")
|
||||
|
||||
(defmacro line-regex (&rest elements)
|
||||
(let (regex-string)
|
||||
(concat (dolist (e elements regex-string)
|
||||
(setq regex-string
|
||||
(concat regex-string
|
||||
(eval
|
||||
(intern
|
||||
(concat (symbol-name e) "-string")))))) "[ \t]*$")))
|
||||
|
||||
(defmacro single-line-config (&rest elements)
|
||||
"Take list of ELEMENTS and return regex and element list for use in context-at-point"
|
||||
(let (regex-string)
|
||||
|
|
@ -96,8 +105,8 @@ where the \"users\" point was."
|
|||
Leave point at the beginning of the thing under point"
|
||||
(let ((here (point)))
|
||||
(goto-char (line-beginning-position))
|
||||
(cond ((looking-at "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.+?)\\)?\\s-+")
|
||||
(goto-char (match-end 0))
|
||||
(cond ((looking-at "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.+?)\\)?\\s-+")
|
||||
(goto-char (match-end 0))
|
||||
'transaction)
|
||||
((looking-at "^\\s-+\\([*!]\\s-+\\)?[[(]?\\(.\\)")
|
||||
(goto-char (match-beginning 2))
|
||||
|
|
|
|||
|
|
@ -30,25 +30,25 @@
|
|||
|
||||
(defvar ledger-environment-alist nil)
|
||||
|
||||
(defun ledger-init-parse-initialization (file)
|
||||
(with-current-buffer file
|
||||
(setq ledger-environment-alist nil)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward ledger-init-string-regex nil t )
|
||||
(let ((matchb (match-beginning 0)) ;; save the match data, string-match stamp on it
|
||||
(matche (match-end 0)))
|
||||
(end-of-line)
|
||||
(setq ledger-environment-alist
|
||||
(append ledger-environment-alist
|
||||
(list (cons (let ((flag (buffer-substring-no-properties (+ 2 matchb) matche)))
|
||||
(if (string-match "[ \t\n\r]+\\'" flag)
|
||||
(replace-match "" t t flag)
|
||||
flag))
|
||||
(let ((value (buffer-substring-no-properties matche (point) )))
|
||||
(if (> (length value) 0)
|
||||
value
|
||||
t))))))))
|
||||
ledger-environment-alist))
|
||||
(defun ledger-init-parse-initialization (buffer)
|
||||
(with-current-buffer buffer
|
||||
(let (environment-alist)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward ledger-init-string-regex nil t )
|
||||
(let ((matchb (match-beginning 0)) ;; save the match data, string-match stamp on it
|
||||
(matche (match-end 0)))
|
||||
(end-of-line)
|
||||
(setq environment-alist
|
||||
(append environment-alist
|
||||
(list (cons (let ((flag (buffer-substring-no-properties (+ 2 matchb) matche)))
|
||||
(if (string-match "[ \t\n\r]+\\'" flag)
|
||||
(replace-match "" t t flag)
|
||||
flag))
|
||||
(let ((value (buffer-substring-no-properties matche (point) )))
|
||||
(if (> (length value) 0)
|
||||
value
|
||||
t))))))))
|
||||
environment-alist)))
|
||||
|
||||
(defun ledger-init-load-init-file ()
|
||||
(interactive)
|
||||
|
|
@ -59,7 +59,8 @@
|
|||
(file-exists-p ledger-init-file-name)
|
||||
(file-readable-p ledger-init-file-name))
|
||||
(find-file-noselect ledger-init-file-name)
|
||||
(ledger-init-parse-initialization init-base-name)
|
||||
(setq ledger-environment-alist
|
||||
(ledger-init-parse-initialization init-base-name))
|
||||
(kill-buffer init-base-name)))))
|
||||
|
||||
(provide 'ldg-init)
|
||||
|
|
|
|||
|
|
@ -41,26 +41,24 @@
|
|||
|
||||
(defun ledger-read-account-with-prompt (prompt)
|
||||
(let* ((context (ledger-context-at-point))
|
||||
(default
|
||||
(if (and (eq (ledger-context-line-type context) 'acct-transaction)
|
||||
(eq (ledger-context-current-field context) 'account))
|
||||
(regexp-quote (ledger-context-field-value context 'account))
|
||||
nil)))
|
||||
(default (if (and (eq (ledger-context-line-type context) 'acct-transaction)
|
||||
(eq (ledger-context-current-field context) 'account))
|
||||
(regexp-quote (ledger-context-field-value context 'account))
|
||||
nil)))
|
||||
(ledger-read-string-with-default prompt default)))
|
||||
|
||||
(defun ledger-read-string-with-default (prompt default)
|
||||
"Return user supplied string after PROMPT, or DEFAULT."
|
||||
(let ((default-prompt (concat prompt
|
||||
(if default
|
||||
(concat " (" default "): ")
|
||||
": "))))
|
||||
(read-string default-prompt nil 'ledger-minibuffer-history default)))
|
||||
(read-string (concat prompt
|
||||
(if default
|
||||
(concat " (" default "): ")
|
||||
": "))
|
||||
nil 'ledger-minibuffer-history default))
|
||||
|
||||
(defun ledger-display-balance-at-point ()
|
||||
"Display the cleared-or-pending balance.
|
||||
And calculate the target-delta of the account being reconciled."
|
||||
(interactive)
|
||||
|
||||
(let* ((account (ledger-read-account-with-prompt "Account balance to show"))
|
||||
(buffer (current-buffer))
|
||||
(balance (with-temp-buffer
|
||||
|
|
@ -134,7 +132,7 @@ Can be pcomplete, or align-posting"
|
|||
(define-key map [(control ?c) (control ?u)] 'ledger-schedule-upcoming)
|
||||
(define-key map [(control ?c) (control ?y)] 'ledger-set-year)
|
||||
(define-key map [(control ?c) (control ?p)] 'ledger-display-balance-at-point)
|
||||
(define-key map [tab] 'ledger-magic-tab)
|
||||
(define-key map [tab] 'ledger-magic-tab)
|
||||
(define-key map [(control ?i)] 'ledger-magic-tab)
|
||||
(define-key map [(control ?c) tab] 'ledger-fully-complete-xact)
|
||||
(define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-xact)
|
||||
|
|
@ -188,18 +186,7 @@ Can be pcomplete, or align-posting"
|
|||
(define-key map [reconcile] '(menu-item "Reconcile Account" ledger-reconcile :enable ledger-works))
|
||||
(define-key map [reconcile] '(menu-item "Narrow to REGEX" ledger-occur))))
|
||||
|
||||
(defun ledger-time-less-p (t1 t2)
|
||||
"Say whether time value T1 is less than time value T2."
|
||||
(or (< (car t1) (car t2))
|
||||
(and (= (car t1) (car t2))
|
||||
(< (nth 1 t1) (nth 1 t2)))))
|
||||
|
||||
(defun ledger-time-subtract (t1 t2)
|
||||
"Subtract two time values, T1 - T2.
|
||||
Return the difference in the format of a time value."
|
||||
(let ((borrow (< (cadr t1) (cadr t2))))
|
||||
(list (- (car t1) (car t2) (if borrow 1 0))
|
||||
(- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
|
||||
|
||||
|
||||
(defun ledger-set-year (newyear)
|
||||
|
|
@ -216,57 +203,7 @@ Return the difference in the format of a time value."
|
|||
(setq ledger-month (read-string "Month: " (ledger-current-month)))
|
||||
(setq ledger-month (format "%02d" newmonth))))
|
||||
|
||||
(defun ledger-add-transaction (transaction-text &optional insert-at-point)
|
||||
"Use ledger xact TRANSACTION-TEXT to add a transaction to the buffer.
|
||||
If INSERT-AT-POINT is non-nil insert the transaction
|
||||
there, otherwise call `ledger-xact-find-slot' to insert it at the
|
||||
correct chronological place in the buffer."
|
||||
(interactive (list
|
||||
(read-string "Transaction: " (concat ledger-year "/" ledger-month "/"))))
|
||||
(let* ((args (with-temp-buffer
|
||||
(insert transaction-text)
|
||||
(eshell-parse-arguments (point-min) (point-max))))
|
||||
(ledger-buf (current-buffer))
|
||||
exit-code)
|
||||
(unless insert-at-point
|
||||
(let ((date (car args)))
|
||||
(if (string-match ledger-iso-date-regexp date)
|
||||
(setq date
|
||||
(encode-time 0 0 0 (string-to-number (match-string 4 date))
|
||||
(string-to-number (match-string 3 date))
|
||||
(string-to-number (match-string 2 date)))))
|
||||
(ledger-xact-find-slot date)))
|
||||
(if (> (length args) 1)
|
||||
(save-excursion
|
||||
(insert
|
||||
(with-temp-buffer
|
||||
(setq exit-code
|
||||
(apply #'ledger-exec-ledger ledger-buf (current-buffer) "xact"
|
||||
(mapcar 'eval args)))
|
||||
(goto-char (point-min))
|
||||
(if (looking-at "Error: ")
|
||||
(error (concat "Error in ledger-add-transaction: " (buffer-string)))
|
||||
(buffer-string)))
|
||||
"\n"))
|
||||
(progn
|
||||
(insert (car args) " \n\n")
|
||||
(end-of-line -1)))))
|
||||
|
||||
(defun ledger-current-transaction-bounds ()
|
||||
"Return markers for the beginning and end of transaction surrounding point."
|
||||
(save-excursion
|
||||
(when (or (looking-at "^[0-9]")
|
||||
(re-search-backward "^[0-9]" nil t))
|
||||
(let ((beg (point)))
|
||||
(while (not (eolp))
|
||||
(forward-line))
|
||||
(cons (copy-marker beg) (point-marker))))))
|
||||
|
||||
(defun ledger-delete-current-transaction ()
|
||||
"Delete the transaction surrounging point."
|
||||
(interactive)
|
||||
(let ((bounds (ledger-current-transaction-bounds)))
|
||||
(delete-region (car bounds) (cdr bounds))))
|
||||
|
||||
(provide 'ldg-mode)
|
||||
|
||||
|
|
|
|||
|
|
@ -65,33 +65,6 @@
|
|||
(defconst ledger-version "3.0"
|
||||
"The version of ledger.el currently loaded.")
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun ledger-create-test ()
|
||||
"Create a regression test."
|
||||
(interactive)
|
||||
(save-restriction
|
||||
(org-narrow-to-subtree)
|
||||
(save-excursion
|
||||
(let (text beg)
|
||||
(goto-char (point-min))
|
||||
(forward-line 1)
|
||||
(setq beg (point))
|
||||
(search-forward ":PROPERTIES:")
|
||||
(goto-char (line-beginning-position))
|
||||
(setq text (buffer-substring-no-properties beg (point)))
|
||||
(goto-char (point-min))
|
||||
(re-search-forward ":ID:\\s-+\\([^-]+\\)")
|
||||
(find-file-other-window
|
||||
(format "~/src/ledger/test/regress/%s.test" (match-string 1)))
|
||||
(sit-for 0)
|
||||
(insert text)
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(goto-char (line-beginning-position))
|
||||
(delete-char 3)
|
||||
(forward-line 1))))))
|
||||
|
||||
(defun ledger-mode-dump-variable (var)
|
||||
(if var
|
||||
(insert (format " %s: %S\n" (symbol-name var) (eval var)))))
|
||||
|
|
|
|||
|
|
@ -96,8 +96,8 @@ When REGEX is nil, unhide everything, and remove higlight"
|
|||
(interactive
|
||||
(if ledger-occur-mode
|
||||
(list nil)
|
||||
(list (read-string (concat "Regexp<" (ledger-occur-prompt)
|
||||
">: ") nil 'ledger-occur-history (ledger-occur-prompt)))))
|
||||
(list (read-string (concat "Regexp<" (ledger-occur-prompt) ">: ")
|
||||
nil 'ledger-occur-history (ledger-occur-prompt)))))
|
||||
(ledger-occur-mode regex (current-buffer)))
|
||||
|
||||
(defun ledger-occur-prompt ()
|
||||
|
|
@ -121,21 +121,12 @@ When REGEX is nil, unhide everything, and remove higlight"
|
|||
(defun ledger-occur-create-narrowed-overlays(buffer-matches)
|
||||
(if buffer-matches
|
||||
(let ((overlays
|
||||
(let ((prev-end (point-min))
|
||||
(temp (point-max)))
|
||||
(let ((prev-end (point-min)))
|
||||
(mapcar (lambda (match)
|
||||
(progn
|
||||
(setq temp prev-end) ;; need a swap so that
|
||||
;; the last form in
|
||||
;; the lambda is the
|
||||
;; (make-overlay)
|
||||
(setq prev-end (1+ (cadr match)))
|
||||
;; add 1 so that we skip the
|
||||
;; empty line after the xact
|
||||
(make-overlay
|
||||
temp
|
||||
(car match)
|
||||
(current-buffer) t nil)))
|
||||
(prog1
|
||||
(make-overlay prev-end (car match)
|
||||
(current-buffer) t nil)
|
||||
(setq prev-end (1+ (cadr match)))))
|
||||
buffer-matches))))
|
||||
(mapcar (lambda (ovl)
|
||||
(overlay-put ovl ledger-occur-overlay-property-name t)
|
||||
|
|
@ -151,10 +142,9 @@ When REGEX is nil, unhide everything, and remove higlight"
|
|||
Argument OVL-BOUNDS contains bounds for the transactions to be left visible."
|
||||
(let ((overlays
|
||||
(mapcar (lambda (bnd)
|
||||
(make-overlay
|
||||
(car bnd)
|
||||
(cadr bnd)
|
||||
(current-buffer) t nil))
|
||||
(make-overlay (car bnd)
|
||||
(cadr bnd)
|
||||
(current-buffer) t nil))
|
||||
ovl-bounds)))
|
||||
(mapcar (lambda (ovl)
|
||||
(overlay-put ovl ledger-occur-overlay-property-name t)
|
||||
|
|
@ -196,9 +186,9 @@ Used for coordinating `ledger-occur' with other buffers, like reconcile."
|
|||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
;; Set initial values for variables
|
||||
(let ((curpoint nil)
|
||||
(endpoint nil)
|
||||
(lines (list)))
|
||||
(let (curpoint
|
||||
endpoint
|
||||
(lines (list)))
|
||||
;; Search loop
|
||||
(while (not (eobp))
|
||||
(setq curpoint (point))
|
||||
|
|
|
|||
|
|
@ -69,23 +69,23 @@
|
|||
|
||||
(declare-function iswitchb-read-buffer "iswitchb"
|
||||
(prompt &optional default require-match start matches-set))
|
||||
|
||||
(defvar iswitchb-temp-buflist)
|
||||
|
||||
(defun ledger-post-completing-read (prompt choices)
|
||||
"Use iswitchb as a `completing-read' replacement to choose from choices.
|
||||
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))))
|
||||
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))))
|
||||
|
||||
(defvar ledger-post-current-list nil)
|
||||
|
||||
|
|
|
|||
|
|
@ -28,8 +28,7 @@
|
|||
|
||||
(defun ledger-next-record-function ()
|
||||
"Move point to next transaction."
|
||||
(if (re-search-forward ledger-payee-any-status-regex
|
||||
nil t)
|
||||
(if (re-search-forward ledger-payee-any-status-regex nil t)
|
||||
(goto-char (match-beginning 0))
|
||||
(goto-char (point-max))))
|
||||
|
||||
|
|
|
|||
|
|
@ -30,15 +30,6 @@
|
|||
:type 'boolean
|
||||
:group 'ledger)
|
||||
|
||||
(defun ledger-toggle-state (state &optional style)
|
||||
"Return the correct toggle state given the current STATE, and STYLE."
|
||||
(if (not (null state))
|
||||
(if (and style (eq style 'cleared))
|
||||
'cleared)
|
||||
(if (and style (eq style 'pending))
|
||||
'pending
|
||||
'cleared)))
|
||||
|
||||
(defun ledger-transaction-state ()
|
||||
"Return the state of the transaction at point."
|
||||
(save-excursion
|
||||
|
|
@ -69,14 +60,10 @@
|
|||
|
||||
(defun ledger-state-from-char (state-char)
|
||||
"Get state from STATE-CHAR."
|
||||
(cond ((eql state-char ?\!)
|
||||
'pending)
|
||||
((eql state-char ?\*)
|
||||
'cleared)
|
||||
((eql state-char ?\;)
|
||||
'comment)
|
||||
(t
|
||||
nil)))
|
||||
(cond ((eql state-char ?\!) 'pending)
|
||||
((eql state-char ?\*) 'cleared)
|
||||
((eql state-char ?\;) 'comment)
|
||||
(t nil)))
|
||||
|
||||
(defun ledger-toggle-current-posting (&optional style)
|
||||
"Toggle the cleared status of the transaction under point.
|
||||
|
|
@ -90,7 +77,7 @@ achieved more certainly by passing the xact to ledger for
|
|||
formatting, but doing so causes inline math expressions to be
|
||||
dropped."
|
||||
(interactive)
|
||||
(let ((bounds (ledger-current-transaction-bounds))
|
||||
(let ((bounds (ledger-find-xact-extents (point)))
|
||||
new-status cur-status)
|
||||
;; Uncompact the xact, to make it easier to toggle the
|
||||
;; transaction
|
||||
|
|
@ -232,27 +219,25 @@ dropped."
|
|||
(defun ledger-toggle-current-transaction (&optional style)
|
||||
"Toggle the transaction at point using optional STYLE."
|
||||
(interactive)
|
||||
(let (status)
|
||||
(save-excursion
|
||||
(when (or (looking-at "^[0-9]")
|
||||
(re-search-backward "^[0-9]" nil t))
|
||||
(skip-chars-forward "0-9./=\\-")
|
||||
(delete-horizontal-space)
|
||||
(if (or (eq (ledger-state-from-char (char-after)) 'pending)
|
||||
(eq (ledger-state-from-char (char-after)) 'cleared))
|
||||
(progn
|
||||
(delete-char 1)
|
||||
(when (and style (eq style 'cleared))
|
||||
(insert " *")
|
||||
(setq status 'cleared)))
|
||||
(if (and style (eq style 'pending))
|
||||
(progn
|
||||
(insert " ! ")
|
||||
(setq status 'pending))
|
||||
(progn
|
||||
(insert " * ")
|
||||
(setq status 'cleared))))))
|
||||
status))
|
||||
(save-excursion
|
||||
(when (or (looking-at "^[0-9]")
|
||||
(re-search-backward "^[0-9]" nil t))
|
||||
(skip-chars-forward "0-9./=\\-")
|
||||
(delete-horizontal-space)
|
||||
(if (or (eq (ledger-state-from-char (char-after)) 'pending)
|
||||
(eq (ledger-state-from-char (char-after)) 'cleared))
|
||||
(progn
|
||||
(delete-char 1)
|
||||
(when (and style (eq style 'cleared))
|
||||
(insert " *")
|
||||
'cleared))
|
||||
(if (and style (eq style 'pending))
|
||||
(progn
|
||||
(insert " ! ")
|
||||
'pending)
|
||||
(progn
|
||||
(insert " * ")
|
||||
'cleared))))))
|
||||
|
||||
(provide 'ldg-state)
|
||||
|
||||
|
|
|
|||
|
|
@ -33,6 +33,33 @@
|
|||
:type 'file
|
||||
:group 'ledger-test)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun ledger-create-test ()
|
||||
"Create a regression test."
|
||||
(interactive)
|
||||
(save-restriction
|
||||
(org-narrow-to-subtree)
|
||||
(save-excursion
|
||||
(let (text beg)
|
||||
(goto-char (point-min))
|
||||
(forward-line 1)
|
||||
(setq beg (point))
|
||||
(search-forward ":PROPERTIES:")
|
||||
(goto-char (line-beginning-position))
|
||||
(setq text (buffer-substring-no-properties beg (point)))
|
||||
(goto-char (point-min))
|
||||
(re-search-forward ":ID:\\s-+\\([^-]+\\)")
|
||||
(find-file-other-window
|
||||
(format "~/src/ledger/test/regress/%s.test" (match-string 1)))
|
||||
(sit-for 0)
|
||||
(insert text)
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(goto-char (line-beginning-position))
|
||||
(delete-char 3)
|
||||
(forward-line 1))))))
|
||||
|
||||
(defun ledger-test-org-narrow-to-entry ()
|
||||
(outline-back-to-heading)
|
||||
(narrow-to-region (point) (progn (outline-next-heading) (point)))
|
||||
|
|
|
|||
|
|
@ -39,17 +39,14 @@ within the transaction."
|
|||
(interactive "d")
|
||||
(save-excursion
|
||||
(goto-char pos)
|
||||
(let ((end-pos pos)
|
||||
(beg-pos pos))
|
||||
(backward-paragraph)
|
||||
(if (/= (point) (point-min))
|
||||
(forward-line))
|
||||
(setq beg-pos (line-beginning-position))
|
||||
(forward-paragraph)
|
||||
(forward-line -1)
|
||||
(setq end-pos (1+ (line-end-position)))
|
||||
(list beg-pos end-pos))))
|
||||
|
||||
(list (progn
|
||||
(backward-paragraph)
|
||||
(if (/= (point) (point-min))
|
||||
(forward-line))
|
||||
(line-beginning-position))
|
||||
(progn
|
||||
(forward-paragraph)
|
||||
(line-beginning-position)))))
|
||||
|
||||
(defun ledger-highlight-xact-under-point ()
|
||||
"Move the highlight overlay to the current transaction."
|
||||
|
|
@ -76,6 +73,12 @@ within the transaction."
|
|||
(ledger-context-field-value context-info 'payee)
|
||||
nil))))
|
||||
|
||||
(defun ledger-time-less-p (t1 t2)
|
||||
"Say whether time value T1 is less than time value T2."
|
||||
(or (< (car t1) (car t2))
|
||||
(and (= (car t1) (car t2))
|
||||
(< (nth 1 t1) (nth 1 t2)))))
|
||||
|
||||
(defun ledger-xact-find-slot (moment)
|
||||
"Find the right place in the buffer for a transaction at MOMENT.
|
||||
MOMENT is an encoded date"
|
||||
|
|
@ -138,6 +141,49 @@ MOMENT is an encoded date"
|
|||
(replace-match date)
|
||||
(ledger-next-amount)))
|
||||
|
||||
(defun ledger-delete-current-transaction (pos)
|
||||
"Delete the transaction surrounging point."
|
||||
(interactive "d")
|
||||
(let ((bounds (ledger-find-xact-extents pos)))
|
||||
(delete-region (car bounds) (cadr bounds))))
|
||||
|
||||
(defun ledger-add-transaction (transaction-text &optional insert-at-point)
|
||||
"Use ledger xact TRANSACTION-TEXT to add a transaction to the buffer.
|
||||
If INSERT-AT-POINT is non-nil insert the transaction
|
||||
there, otherwise call `ledger-xact-find-slot' to insert it at the
|
||||
correct chronological place in the buffer."
|
||||
(interactive (list
|
||||
(read-string "Transaction: " (concat ledger-year "/" ledger-month "/"))))
|
||||
(let* ((args (with-temp-buffer
|
||||
(insert transaction-text)
|
||||
(eshell-parse-arguments (point-min) (point-max))))
|
||||
(ledger-buf (current-buffer))
|
||||
exit-code)
|
||||
(unless insert-at-point
|
||||
(let ((date (car args)))
|
||||
(if (string-match ledger-iso-date-regexp date)
|
||||
(setq date
|
||||
(encode-time 0 0 0 (string-to-number (match-string 4 date))
|
||||
(string-to-number (match-string 3 date))
|
||||
(string-to-number (match-string 2 date)))))
|
||||
(ledger-xact-find-slot date)))
|
||||
(if (> (length args) 1)
|
||||
(save-excursion
|
||||
(insert
|
||||
(with-temp-buffer
|
||||
(setq exit-code
|
||||
(apply #'ledger-exec-ledger ledger-buf (current-buffer) "xact"
|
||||
(mapcar 'eval args)))
|
||||
(goto-char (point-min))
|
||||
(if (looking-at "Error: ")
|
||||
(error (concat "Error in ledger-add-transaction: " (buffer-string)))
|
||||
(buffer-string)))
|
||||
"\n"))
|
||||
(progn
|
||||
(insert (car args) " \n\n")
|
||||
(end-of-line -1)))))
|
||||
|
||||
|
||||
(provide 'ldg-xact)
|
||||
|
||||
;;; ldg-xact.el ends here
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue