sfos/ledger
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge pull request #226 from the-kenny/emacs-bugfixes

Browse source 
Bugfixes & Improvements for Emacs Support

Thanks!
This commit is contained in:
Craig Earls 2013-12-29 16:55:54 -08:00
commit c00e4eb8c6
5 changed files with 94 additions and 46 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

59
lisp/ledger-context.el
View file

@ -28,29 +28,30 @@
(eval-when-compile (eval-when-compile
(require 'cl)) (require 'cl))
;; *-string constants are assembled in the single-line-config macro to ;; ledger-*-string constants are assembled in the
;; form the regex and list of elements ;; `ledger-single-line-config' macro to form the regex and list of
(defconst indent-string "\\(^[ \t]+\\)") ;; elements
(defconst status-string "\\([*! ]?\\)") (defconst ledger-indent-string "\\(^[ \t]+\\)")
(defconst account-string "[\\[(]?\\(.*?\\)[])]?") (defconst ledger-status-string "\\([*! ]?\\)")
(defconst amount-string "[ \t]?\\(-?[0-9]+\\.[0-9]*\\)") (defconst ledger-account-string "[\\[(]?\\(.*?\\)[])]?")
(defconst comment-string "[ \t]*;[ \t]*\\(.*?\\)") (defconst ledger-amount-string "[ \t]?\\(-?[0-9]+\\.[0-9]*\\)")
(defconst nil-string "\\([ \t]+\\)") (defconst ledger-comment-string "[ \t]*;[ \t]*\\(.*?\\)")
(defconst commodity-string "\\(.+?\\)") (defconst ledger-nil-string "\\([ \t]+\\)")
(defconst date-string "^\\([0-9]\\{4\\}[/-][01]?[0-9][/-][0123]?[0-9]\\)") (defconst ledger-commodity-string "\\(.+?\\)")
(defconst code-string "\\((.*)\\)?") (defconst ledger-date-string "^\\([0-9]\\{4\\}[/-][01]?[0-9][/-][0123]?[0-9]\\)")
(defconst payee-string "\\(.*\\)") (defconst ledger-code-string "\\((.*)\\)?")
(defconst ledger-payee-string "\\(.*\\)")
(defmacro line-regex (&rest elements) (defmacro ledger-line-regex (&rest elements)
(let (regex-string) (let (regex-string)
(concat (dolist (e elements regex-string) (concat (dolist (e elements regex-string)
(setq regex-string (setq regex-string
(concat regex-string (concat regex-string
(eval (eval
(intern (intern
(concat (symbol-name e) "-string")))))) "[ \t]*$"))) (concat "ledger-" (symbol-name e) "-string")))))) "[ \t]*$")))
(defmacro single-line-config2 (&rest elements) (defmacro ledger-single-line-config2 (&rest elements)
"Take list of ELEMENTS and return regex and element list for use in context-at-point" "Take list of ELEMENTS and return regex and element list for use in context-at-point"
(let (regex-string) (let (regex-string)
`'(,(concat (dolist (e elements regex-string) `'(,(concat (dolist (e elements regex-string)
@ -58,26 +59,26 @@
(concat regex-string (concat regex-string
(eval (eval
(intern (intern
(concat (symbol-name e) "-string")))))) "[ \t]*$") (concat "ledger-" (symbol-name e) "-string")))))) "[ \t]*$")
,elements))) ,elements)))
(defmacro single-line-config (&rest elements) (defmacro ledger-single-line-config (&rest elements)
"Take list of ELEMENTS and return regex and element list for use in context-at-point" "Take list of ELEMENTS and return regex and element list for use in context-at-point"
`'(,(eval `(line-regex ,@elements)) `'(,(eval `(ledger-line-regex ,@elements))
,elements)) ,elements))
(defconst ledger-line-config (defconst ledger-line-config
(list (list 'xact (list (single-line-config date nil status nil code nil payee nil comment) (list (list 'xact (list (ledger-single-line-config date nil status nil code nil payee nil comment)
(single-line-config date nil status nil code nil payee) (ledger-single-line-config date nil status nil code nil payee)
(single-line-config date nil status nil payee))) (ledger-single-line-config date nil status nil payee)))
(list 'acct-transaction (list (single-line-config indent comment) (list 'acct-transaction (list (ledger-single-line-config indent comment)
(single-line-config2 indent status account nil commodity amount nil comment) (ledger-single-line-config2 indent status account nil commodity amount nil comment)
(single-line-config2 indent status account nil commodity amount) (ledger-single-line-config2 indent status account nil commodity amount)
(single-line-config2 indent status account nil amount nil commodity comment) (ledger-single-line-config2 indent status account nil amount nil commodity comment)
(single-line-config2 indent status account nil amount nil commodity) (ledger-single-line-config2 indent status account nil amount nil commodity)
(single-line-config2 indent status account nil amount) (ledger-single-line-config2 indent status account nil amount)
(single-line-config2 indent status account nil comment) (ledger-single-line-config2 indent status account nil comment)
(single-line-config2 indent status account))))) (ledger-single-line-config2 indent status account)))))
(defun ledger-extract-context-info (line-type pos) (defun ledger-extract-context-info (line-type pos)
"Get context info for current line with LINE-TYPE. "Get context info for current line with LINE-TYPE.

2
lisp/ledger-init.el
View file

@ -30,6 +30,8 @@
(defvar ledger-environment-alist nil) (defvar ledger-environment-alist nil)
(defvar ledger-default-date-format "%Y/%m/%d")
(defun ledger-init-parse-initialization (buffer) (defun ledger-init-parse-initialization (buffer)
(with-current-buffer buffer (with-current-buffer buffer
(let (environment-alist) (let (environment-alist)

60
lisp/ledger-mode.el
View file

@ -145,16 +145,58 @@ Can indent, complete or align depending on context."
(defvar ledger-mode-abbrev-table) (defvar ledger-mode-abbrev-table)
(defun ledger-insert-effective-date () (defun ledger-remove-effective-date ()
"Removes the effective date from a transaction or posting."
(interactive) (interactive)
(let ((context (car (ledger-context-at-point))) (let ((context (car (ledger-context-at-point))))
(date-string (format-time-string (cdr (assoc "date-format" ledger-environment-alist))))) (save-excursion
(cond ((eq 'xact context) (save-restriction
(beginning-of-line) (narrow-to-region (point-at-bol) (point-at-eol))
(insert date-string "=")) (beginning-of-line)
((eq 'acct-transaction context) (cond ((eq 'xact context)
(end-of-line) (re-search-forward ledger-iso-date-regexp)
(insert " ; [=" date-string "]"))))) (when (= (char-after) ?=)
(let ((eq-pos (point)))
(delete-region
eq-pos
(re-search-forward ledger-iso-date-regexp)))))
((eq 'acct-transaction context)
;; Match "; [=date]" & delete string
(when (re-search-forward
(concat ledger-comment-regex
"\\[=" ledger-iso-date-regexp "\\]")
nil 'noerr)
(replace-match ""))))))))
(defun ledger-insert-effective-date (&optional arg)
"Insert an effective date to the transaction or posting.
Replace the current effective date if there's one in the same
line.
With a prefix argument, remove the effective date. "
(interactive "P")
(if (and (listp arg)
(= 4 (prefix-numeric-value arg)))
(ledger-remove-effective-date)
(let* ((context (car (ledger-context-at-point)))
(date-format (or
(cdr (assoc "date-format" ledger-environment-alist))
ledger-default-date-format))
(date-string (format-time-string date-format)))
(save-restriction
(narrow-to-region (point-at-bol) (point-at-eol))
(cond
((eq 'xact context)
(beginning-of-line)
(re-search-forward ledger-iso-date-regexp)
(when (= (char-after) ?=)
(ledger-remove-effective-date))
(insert "=" date-string))
((eq 'acct-transaction context)
(end-of-line)
(ledger-remove-effective-date)
(insert " ; [=" date-string "]")))))))
(defun ledger-mode-remove-extra-lines () (defun ledger-mode-remove-extra-lines ()
(goto-char (point-min)) (goto-char (point-min))

14
lisp/ledger-reconcile.el
View file

@ -28,6 +28,7 @@
;;; Code: ;;; Code:
(require 'easymenu) (require 'easymenu)
(require 'ledger-init)
(defvar ledger-buf nil) (defvar ledger-buf nil)
(defvar ledger-bufs nil) (defvar ledger-bufs nil)
@ -64,7 +65,7 @@ reconcile-finish will mark all pending posting cleared."
:type 'boolean :type 'boolean
:group 'ledger-reconcile) :group 'ledger-reconcile)
(defcustom ledger-reconcile-default-date-format "%Y/%m/%d" (defcustom ledger-reconcile-default-date-format ledger-default-date-format
"Default date format for the reconcile buffer" "Default date format for the reconcile buffer"
:type 'string :type 'string
:group 'ledger-reconcile) :group 'ledger-reconcile)
@ -109,7 +110,7 @@ And calculate the target-delta of the account being reconciled."
(message "Pending balance: %s" (message "Pending balance: %s"
(ledger-commodity-to-string pending)))))) (ledger-commodity-to-string pending))))))
(defun is-stdin (file) (defun ledger-is-stdin (file)
"True if ledger FILE is standard input." "True if ledger FILE is standard input."
(or (or
(equal file "") (equal file "")
@ -279,7 +280,7 @@ and exit reconcile mode"
(defun ledger-marker-where-xact-is (emacs-xact posting) (defun ledger-marker-where-xact-is (emacs-xact posting)
"Find the position of the EMACS-XACT in the `ledger-buf'. "Find the position of the EMACS-XACT in the `ledger-buf'.
POSTING is used in `ledger-clear-whole-transactions' is nil." POSTING is used in `ledger-clear-whole-transactions' is nil."
(let ((buf (if (is-stdin (nth 0 emacs-xact)) (let ((buf (if (ledger-is-stdin (nth 0 emacs-xact))
ledger-buf ledger-buf
(find-file-noselect (nth 0 emacs-xact))))) (find-file-noselect (nth 0 emacs-xact)))))
(cons (cons
@ -306,15 +307,14 @@ POSTING is used in `ledger-clear-whole-transactions' is nil."
(if (looking-at "(") (if (looking-at "(")
(read (current-buffer)))))))) ;current-buffer is the *temp* created above (read (current-buffer)))))))) ;current-buffer is the *temp* created above
(if (and ledger-success (> (length xacts) 0)) (if (and ledger-success (> (length xacts) 0))
(let ((date-format (cdr (assoc "date-format" ledger-environment-alist)))) (let ((date-format (or (cdr (assoc "date-format" ledger-environment-alist))
ledger-default-date-format)))
(dolist (xact xacts) (dolist (xact xacts)
(dolist (posting (nthcdr 5 xact)) (dolist (posting (nthcdr 5 xact))
(let ((beg (point)) (let ((beg (point))
(where (ledger-marker-where-xact-is xact posting))) (where (ledger-marker-where-xact-is xact posting)))
(insert (format "%s %-4s %-30s %-30s %15s\n" (insert (format "%s %-4s %-30s %-30s %15s\n"
(format-time-string (if date-format (format-time-string date-format (nth 2 xact))
date-format
ledger-reconcile-default-date-format) (nth 2 xact))
(if (nth 3 xact) (if (nth 3 xact)
(nth 3 xact) (nth 3 xact)
"") "")

5
lisp/ledger-schedule.el
View file

@ -30,6 +30,8 @@
;; function slot of the symbol VARNAME. Then use VARNAME as the ;; function slot of the symbol VARNAME. Then use VARNAME as the
;; function without have to use funcall. ;; function without have to use funcall.
(require 'ledger-init)
(defgroup ledger-schedule nil (defgroup ledger-schedule nil
"Support for automatically recommendation transactions." "Support for automatically recommendation transactions."
:group 'ledger) :group 'ledger)
@ -288,7 +290,8 @@ returns true if the date meets the requirements"
"Format CANDIDATE-ITEMS for display." "Format CANDIDATE-ITEMS for display."
(let ((candidates (ledger-schedule-list-upcoming-xacts candidate-items early horizon)) (let ((candidates (ledger-schedule-list-upcoming-xacts candidate-items early horizon))
(schedule-buf (get-buffer-create ledger-schedule-buffer-name)) (schedule-buf (get-buffer-create ledger-schedule-buffer-name))
(date-format (cdr (assoc "date-format" ledger-environment-alist)))) (date-format (or (cdr (assoc "date-format" ledger-environment-alist))
ledger-default-date-format)))
(with-current-buffer schedule-buf (with-current-buffer schedule-buf
(erase-buffer) (erase-buffer)
(dolist (candidate candidates) (dolist (candidate candidates)