Skip to content

Commit

Permalink
Provide functions for shifting date on the current line
Browse files Browse the repository at this point in the history
  • Loading branch information
vkazanov authored and dnicolodi committed May 20, 2024
1 parent bc753ce commit cbe65aa
Show file tree
Hide file tree
Showing 2 changed files with 52 additions and 8 deletions.
16 changes: 16 additions & 0 deletions beancount-tests.el
Original file line number Diff line number Diff line change
Expand Up @@ -332,3 +332,19 @@ known option nmaes."
(insert "foo ^link baz")
(goto-char 7)
(should (equal (thing-at-point 'beancount-link) "^link"))))

(ert-deftest beancount/date-shift-up-day ()
:tags '(date-shift)
(with-temp-buffer
(insert "2024-05-11\n")
(goto-char 0)
(beancount-date-up-day)
(should (equal (thing-at-point 'line) "2024-05-12\n"))))

(ert-deftest beancount/date-shift-down-day ()
:tags '(date-shift)
(with-temp-buffer
(insert "2024-05-11\n")
(goto-char 0)
(beancount-date-down-day)
(should (equal (thing-at-point 'line) "2024-05-10\n"))))
44 changes: 36 additions & 8 deletions beancount.el
Original file line number Diff line number Diff line change
Expand Up @@ -345,6 +345,8 @@ are reserved for the mode anyway.)")
(define-key map (vconcat p [(control t)]) #'beancount-region-value)
(define-key map (vconcat p [(control y)]) #'beancount-region-cost)
(define-key map (vconcat p [(control i)]) #'beancount-insert-prices)
(define-key map (vconcat p [(left)]) #'beancount-date-down-day)
(define-key map (vconcat p [(right)]) #'beancount-date-up-day)
(define-key map (vconcat p [(\;)]) #'beancount-align-to-previous-number)
(define-key map (vconcat p [(\:)]) #'beancount-align-numbers)
(when beancount-mode-old-style-keybindings
Expand Down Expand Up @@ -876,14 +878,40 @@ what that column is and returns it (an integer)."
"Start a new timestamped directive with date DAYS before today."
(interactive "P")
(unless (bolp) (newline))
(insert (beancount--shift-current-date days) " "))

(defun beancount--shift-current-date (days)
"Return ISO-8601 formatted date DAYS before today."
(let ((days-to-shift (- (or days 0))))
(format-time-string
"%Y-%m-%d"
(time-add (current-time) (days-to-time days-to-shift)))))
(insert (format-time-string "%Y-%m-%d" (time-add (current-time) (days-to-time (- (or days 0)))))))

(defun beancount--parse-date (string)
"Parse the STRING date in the format %Y-%m-%d into a Lisp timestamp."
(save-match-data
(string-match (concat "\\`\\([0-9][0-9][0-9][0-9]\\)-\\([0-9][0-9]\\)-\\([0-9][0-9]\\)\\'") string)
(encode-time (list 0 0 0
(string-to-number (match-string 3 string))
(string-to-number (match-string 2 string))
(string-to-number (match-string 1 string))
nil -1 nil))))

(defun beancount--format-date (time)
"Format the Lisp timestamp TIME into a date in the format %Y-%m-%d."
(format-time-string "%Y-%m-%d" time))

(defun beancount--shift-date-at-point (days)
"Shift the date under point by a specified number of DAYS."
(if (thing-at-point-looking-at beancount-date-regexp 10)
(let ((date (beancount--parse-date (match-string 0))))
(replace-match (beancount–-format-date (time-add date (days-to-time days))) t t))
(user-error "No date at point")))

(defun beancount-date-up-day (&optional days)
"Increase the date in the current line by one day.
With prefix ARG, change that many days."
(interactive "p" beancount-mode)
(beancount--shift-date-at-point (or days 1)))

(defun beancount-date-down-day (&optional days)
"Decrease the date in the current line by one day.
With prefix ARG, change that many days."
(interactive "p" beancount-mode)
(beancount--shift-date-at-point (- (or days 1))))

(defvar beancount-install-dir nil
"Directory in which Beancount's source is located.
Expand Down

0 comments on commit cbe65aa

Please sign in to comment.