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

Lisp code cleanup

Browse source 
Most of the files have been touched several times and the indentation structure
was wrong.  I ran all the files through the emacs indent region function to get back to
a baseline
This commit is contained in:
Craig Earls 2013-02-05 12:33:42 -07:00
parent d67c42207f
commit 4d7c492939
13 changed files with 303 additions and 303 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

50
lisp/ldg-complete.el
View file

@ -89,9 +89,9 @@
(let ((entry (assoc (car elements) root))) (let ((entry (assoc (car elements) root)))
(if entry (if entry
(setq root (cdr entry)) (setq root (cdr entry))
(setq entry (cons (car elements) (list t))) (setq entry (cons (car elements) (list t)))
(nconc root (list entry)) (nconc root (list entry))
(setq root (cdr entry)))) (setq root (cdr entry))))
(setq elements (cdr elements))))))))) (setq elements (cdr elements)))))))))
(defun ledger-accounts () (defun ledger-accounts ()
@ -106,18 +106,18 @@
(setq prefix (concat prefix (and prefix ":") (setq prefix (concat prefix (and prefix ":")
(car elements)) (car elements))
root (cdr entry)) root (cdr entry))
(setq root nil elements nil))) (setq root nil elements nil)))
(setq elements (cdr elements))) (setq elements (cdr elements)))
(and root (and root
(sort (sort
(mapcar (function (mapcar (function
(lambda (x) (lambda (x)
(let ((term (if prefix (let ((term (if prefix
(concat prefix ":" (car x)) (concat prefix ":" (car x))
(car x)))) (car x))))
(if (> (length (cdr x)) 1) (if (> (length (cdr x)) 1)
(concat term ":") (concat term ":")
term)))) term))))
(cdr root)) (cdr root))
'string-lessp)))) 'string-lessp))))
@ -129,21 +129,21 @@
(ledger-thing-at-point)) 'entry) (ledger-thing-at-point)) 'entry)
(if (null current-prefix-arg) (if (null current-prefix-arg)
(ledger-entries) ; this completes against entry names (ledger-entries) ; this completes against entry names
(progn (progn
(let ((text (buffer-substring (line-beginning-position) (let ((text (buffer-substring (line-beginning-position)
(line-end-position)))) (line-end-position))))
(delete-region (line-beginning-position) (delete-region (line-beginning-position)
(line-end-position)) (line-end-position))
(condition-case err (condition-case err
(ledger-add-entry text t) (ledger-add-entry text t)
((error) ((error)
(insert text)))) (insert text))))
(forward-line) (forward-line)
(goto-char (line-end-position)) (goto-char (line-end-position))
(search-backward ";" (line-beginning-position) t) (search-backward ";" (line-beginning-position) t)
(skip-chars-backward " \t0123456789.,") (skip-chars-backward " \t0123456789.,")
(throw 'pcompleted t))) (throw 'pcompleted t)))
(ledger-accounts))))) (ledger-accounts)))))
(defun ledger-fully-complete-entry () (defun ledger-fully-complete-entry ()
"Do appropriate completion for the thing at point" "Do appropriate completion for the thing at point"

4
lisp/ldg-exec.el
View file

@ -68,8 +68,8 @@
(goto-char (point-min)) (goto-char (point-min))
(delete-horizontal-space) (delete-horizontal-space)
(setq version-strings (split-string (setq version-strings (split-string
(buffer-substring-no-properties (point) (buffer-substring-no-properties (point)
(+ (point) 12)))) (+ (point) 12))))
(if (and (string-match (regexp-quote "Ledger") (car version-strings)) (if (and (string-match (regexp-quote "Ledger") (car version-strings))
(or (string= needed (car (cdr version-strings))) (or (string= needed (car (cdr version-strings)))
(string< needed (car (cdr version-strings))))) (string< needed (car (cdr version-strings)))))

2
lisp/ldg-fonts.el
View file

@ -52,7 +52,7 @@
:group 'ledger-faces) :group 'ledger-faces)
(defface ledger-font-comment-face (defface ledger-font-comment-face
`((t :foreground "orange" )) `((t :foreground "orange" ))
"Face for Ledger comments" "Face for Ledger comments"
:group 'ledger-faces) :group 'ledger-faces)

162
lisp/ldg-mode.el
View file

@ -43,77 +43,77 @@ customizable to ease retro-entry.")
;;;###autoload ;;;###autoload
(define-derived-mode ledger-mode text-mode "Ledger" (define-derived-mode ledger-mode text-mode "Ledger"
"A mode for editing ledger data files." "A mode for editing ledger data files."
(ledger-check-version) (ledger-check-version)
(ledger-post-setup) (ledger-post-setup)
(set (make-local-variable 'comment-start) " ; ") (set (make-local-variable 'comment-start) " ; ")
(set (make-local-variable 'comment-end) "") (set (make-local-variable 'comment-end) "")
(set (make-local-variable 'indent-tabs-mode) nil) (set (make-local-variable 'indent-tabs-mode) nil)
(if (boundp 'font-lock-defaults) (if (boundp 'font-lock-defaults)
(set (make-local-variable 'font-lock-defaults) (set (make-local-variable 'font-lock-defaults)
'(ledger-font-lock-keywords nil t))) '(ledger-font-lock-keywords nil t)))
(set (make-local-variable 'pcomplete-parse-arguments-function) (set (make-local-variable 'pcomplete-parse-arguments-function)
'ledger-parse-arguments) 'ledger-parse-arguments)
(set (make-local-variable 'pcomplete-command-completion-function) (set (make-local-variable 'pcomplete-command-completion-function)
'ledger-complete-at-point) 'ledger-complete-at-point)
(set (make-local-variable 'pcomplete-termination-string) "") (set (make-local-variable 'pcomplete-termination-string) "")
(let ((map (current-local-map))) (let ((map (current-local-map)))
(define-key map [(control ?c) (control ?a)] 'ledger-add-entry) (define-key map [(control ?c) (control ?a)] 'ledger-add-entry)
(define-key map [(control ?c) (control ?d)] 'ledger-delete-current-entry) (define-key map [(control ?c) (control ?d)] 'ledger-delete-current-entry)
(define-key map [(control ?c) (control ?y)] 'ledger-set-year) (define-key map [(control ?c) (control ?y)] 'ledger-set-year)
(define-key map [(control ?c) (control ?m)] 'ledger-set-month) (define-key map [(control ?c) (control ?m)] 'ledger-set-month)
(define-key map [(control ?c) (control ?c)] 'ledger-toggle-current) (define-key map [(control ?c) (control ?c)] 'ledger-toggle-current)
(define-key map [(control ?c) (control ?e)] 'ledger-toggle-current-entry) (define-key map [(control ?c) (control ?e)] 'ledger-toggle-current-entry)
(define-key map [(control ?c) (control ?r)] 'ledger-reconcile) (define-key map [(control ?c) (control ?r)] 'ledger-reconcile)
(define-key map [(control ?c) (control ?s)] 'ledger-sort-region) (define-key map [(control ?c) (control ?s)] 'ledger-sort-region)
(define-key map [(control ?c) (control ?t)] 'ledger-test-run) (define-key map [(control ?c) (control ?t)] 'ledger-test-run)
(define-key map [(control ?c) (control ?v)] 'ledger-post-edit-amount) (define-key map [(control ?c) (control ?v)] 'ledger-post-edit-amount)
(define-key map [(control ?c) (control ?f)] 'ledger-occur) (define-key map [(control ?c) (control ?f)] 'ledger-occur)
(define-key map [tab] 'pcomplete) (define-key map [tab] 'pcomplete)
(define-key map [(control ?i)] 'pcomplete) (define-key map [(control ?i)] 'pcomplete)
(define-key map [(control ?c) tab] 'ledger-fully-complete-entry) (define-key map [(control ?c) tab] 'ledger-fully-complete-entry)
(define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-entry) (define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-entry)
(define-key map [(control ?c) (control ?o) (control ?r)] 'ledger-report) (define-key map [(control ?c) (control ?o) (control ?r)] 'ledger-report)
(define-key map [(control ?c) (control ?o) (control ?g)] 'ledger-report-goto) (define-key map [(control ?c) (control ?o) (control ?g)] 'ledger-report-goto)
(define-key map [(control ?c) (control ?o) (control ?a)] 'ledger-report-redo) (define-key map [(control ?c) (control ?o) (control ?a)] 'ledger-report-redo)
(define-key map [(control ?c) (control ?o) (control ?s)] 'ledger-report-save) (define-key map [(control ?c) (control ?o) (control ?s)] 'ledger-report-save)
(define-key map [(control ?c) (control ?o) (control ?e)] 'ledger-report-edit) (define-key map [(control ?c) (control ?o) (control ?e)] 'ledger-report-edit)
(define-key map [(control ?c) (control ?o) (control ?k)] 'ledger-report-kill) (define-key map [(control ?c) (control ?o) (control ?k)] 'ledger-report-kill)
(define-key map [(meta ?p)] 'ledger-post-prev-xact) (define-key map [(meta ?p)] 'ledger-post-prev-xact)
(define-key map [(meta ?n)] 'ledger-post-next-xact) (define-key map [(meta ?n)] 'ledger-post-next-xact)
(define-key map [menu-bar] (make-sparse-keymap "ldg-menu")) (define-key map [menu-bar] (make-sparse-keymap "ldg-menu"))
(define-key map [menu-bar ldg-menu] (cons "Ledger" map)) (define-key map [menu-bar ldg-menu] (cons "Ledger" map))
(define-key map [report-kill] '(menu-item "Kill Report" ledger-report-kill :enable ledger-works)) (define-key map [report-kill] '(menu-item "Kill Report" ledger-report-kill :enable ledger-works))
(define-key map [report-edit] '(menu-item "Edit Report" ledger-report-edit :enable ledger-works)) (define-key map [report-edit] '(menu-item "Edit Report" ledger-report-edit :enable ledger-works))
(define-key map [report-save] '(menu-item "Save Report" ledger-report-save :enable ledger-works)) (define-key map [report-save] '(menu-item "Save Report" ledger-report-save :enable ledger-works))
(define-key map [report-rrun] '(menu-item "Re-run Report" ledger-report-redo :enable ledger-works)) (define-key map [report-rrun] '(menu-item "Re-run Report" ledger-report-redo :enable ledger-works))
(define-key map [report-goto] '(menu-item "Goto Report" ledger-report-goto :enable ledger-works)) (define-key map [report-goto] '(menu-item "Goto Report" ledger-report-goto :enable ledger-works))
(define-key map [report-run] '(menu-item "Run Report" ledger-report :enable ledger-works)) (define-key map [report-run] '(menu-item "Run Report" ledger-report :enable ledger-works))
(define-key map [sep5] '(menu-item "--")) (define-key map [sep5] '(menu-item "--"))
(define-key map [set-month] '(menu-item "Set Month" ledger-set-month :enable ledger-works)) (define-key map [set-month] '(menu-item "Set Month" ledger-set-month :enable ledger-works))
(define-key map [set-year] '(menu-item "Set Year" ledger-set-year :enable ledger-works)) (define-key map [set-year] '(menu-item "Set Year" ledger-set-year :enable ledger-works))
(define-key map [sep1] '("--")) (define-key map [sep1] '("--"))
(define-key map [sort-buff] '(menu-item "Sort Buffer" ledger-sort-buffer)) (define-key map [sort-buff] '(menu-item "Sort Buffer" ledger-sort-buffer))
(define-key map [sort-reg] '(menu-item "Sort Region" ledger-sort-region :enable mark-active)) (define-key map [sort-reg] '(menu-item "Sort Region" ledger-sort-region :enable mark-active))
(define-key map [sep2] '(menu-item "--")) (define-key map [sep2] '(menu-item "--"))
(define-key map [toggle-post] '(menu-item "Toggle Current Posting" ledger-toggle-current)) (define-key map [toggle-post] '(menu-item "Toggle Current Posting" ledger-toggle-current))
(define-key map [toggle-xact] '(menu-item "Toggle Current Transaction" ledger-toggle-current-entry)) (define-key map [toggle-xact] '(menu-item "Toggle Current Transaction" ledger-toggle-current-entry))
(define-key map [sep4] '(menu-item "--")) (define-key map [sep4] '(menu-item "--"))
(define-key map [edit-amount] '(menu-item "Calc on Amount" ledger-post-edit-amount)) (define-key map [edit-amount] '(menu-item "Calc on Amount" ledger-post-edit-amount))
(define-key map [sep] '(menu-item "--")) (define-key map [sep] '(menu-item "--"))
(define-key map [delete-xact] '(menu-item "Delete Entry" ledger-delete-current-entry)) (define-key map [delete-xact] '(menu-item "Delete Entry" ledger-delete-current-entry))
(define-key map [add-xact] '(menu-item "Add Entry" ledger-add-entry :enable ledger-works)) (define-key map [add-xact] '(menu-item "Add Entry" ledger-add-entry :enable ledger-works))
(define-key map [sep3] '(menu-item "--")) (define-key map [sep3] '(menu-item "--"))
(define-key map [reconcile] '(menu-item "Reconcile Account" ledger-reconcile :enable ledger-works)) (define-key map [reconcile] '(menu-item "Reconcile Account" ledger-reconcile :enable ledger-works))
(define-key map [reconcile] '(menu-item "Hide Xacts" ledger-occur)) (define-key map [reconcile] '(menu-item "Hide Xacts" ledger-occur))
)) ))
(defun ledger-time-less-p (t1 t2) (defun ledger-time-less-p (t1 t2)
"Say whether time value T1 is less than time value T2." "Say whether time value T1 is less than time value T2."
@ -133,8 +133,8 @@ Return the difference in the format of a time value."
(ledger-iterate-entries (ledger-iterate-entries
(function (function
(lambda (start date mark desc) (lambda (start date mark desc)
(if (ledger-time-less-p moment date) (if (ledger-time-less-p moment date)
(throw 'found t))))))) (throw 'found t)))))))
(defun ledger-iterate-entries (callback) (defun ledger-iterate-entries (callback)
(goto-char (point-min)) (goto-char (point-min))
@ -149,18 +149,18 @@ Return the difference in the format of a time value."
(let ((found (match-string 2))) (let ((found (match-string 2)))
(if found (if found
(setq current-year (string-to-number found)) (setq current-year (string-to-number found))
(let ((start (match-beginning 0)) (let ((start (match-beginning 0))
(year (match-string 3)) (year (match-string 3))
(month (string-to-number (match-string 4))) (month (string-to-number (match-string 4)))
(day (string-to-number (match-string 5))) (day (string-to-number (match-string 5)))
(mark (match-string 6)) (mark (match-string 6))
(desc (match-string 7))) (desc (match-string 7)))
(if (and year (> (length year) 0)) (if (and year (> (length year) 0))
(setq year (string-to-number year))) (setq year (string-to-number year)))
(funcall callback start (funcall callback start
(encode-time 0 0 0 day month (encode-time 0 0 0 day month
(or year current-year)) (or year current-year))
mark desc))))) mark desc)))))
(forward-line)))) (forward-line))))
(defun ledger-set-year (newyear) (defun ledger-set-year (newyear)
@ -168,14 +168,14 @@ Return the difference in the format of a time value."
(interactive "p") (interactive "p")
(if (= newyear 1) (if (= newyear 1)
(setq ledger-year (read-string "Year: " (ledger-current-year))) (setq ledger-year (read-string "Year: " (ledger-current-year)))
(setq ledger-year (number-to-string newyear)))) (setq ledger-year (number-to-string newyear))))
(defun ledger-set-month (newmonth) (defun ledger-set-month (newmonth)
"Set ledger's idea of the current month to the prefix argument." "Set ledger's idea of the current month to the prefix argument."
(interactive "p") (interactive "p")
(if (= newmonth 1) (if (= newmonth 1)
(setq ledger-month (read-string "Month: " (ledger-current-month))) (setq ledger-month (read-string "Month: " (ledger-current-month)))
(setq ledger-month (format "%02d" newmonth)))) (setq ledger-month (format "%02d" newmonth))))
(defun ledger-add-entry (entry-text &optional insert-at-point) (defun ledger-add-entry (entry-text &optional insert-at-point)
(interactive (list (interactive (list
@ -202,7 +202,7 @@ Return the difference in the format of a time value."
(goto-char (point-min)) (goto-char (point-min))
(if (looking-at "Error: ") (if (looking-at "Error: ")
(error (buffer-string)) (error (buffer-string))
(buffer-string))) (buffer-string)))
"\n")))) "\n"))))
(defun ledger-current-entry-bounds () (defun ledger-current-entry-bounds ()

6
lisp/ldg-new.el
View file

@ -47,9 +47,9 @@
(require 'ldg-fonts) (require 'ldg-fonts)
(require 'ldg-occur) (require 'ldg-occur)
;(autoload #'ledger-mode "ldg-mode" nil t) ;(autoload #'ledger-mode "ldg-mode" nil t)
;(autoload #'ledger-fully-complete-entry "ldg-complete" nil t) ;(autoload #'ledger-fully-complete-entry "ldg-complete" nil t)
;(autoload #'ledger-toggle-current "ldg-state" nil t) ;(autoload #'ledger-toggle-current "ldg-state" nil t)
(autoload #'ledger-texi-update-test "ldg-texi" nil t) (autoload #'ledger-texi-update-test "ldg-texi" nil t)
(autoload #'ledger-texi-update-examples "ldg-texi" nil t) (autoload #'ledger-texi-update-examples "ldg-texi" nil t)

44
lisp/ldg-post.el
View file

@ -66,16 +66,16 @@
PROMPT is a string to prompt with. CHOICES is a list of strings PROMPT is a string to prompt with. CHOICES is a list of strings
to choose from." to choose from."
(cond (cond
(ledger-post-use-iswitchb (ledger-post-use-iswitchb
(let* ((iswitchb-use-virtual-buffers nil) (let* ((iswitchb-use-virtual-buffers nil)
(iswitchb-make-buflist-hook (iswitchb-make-buflist-hook
(lambda () (lambda ()
(setq iswitchb-temp-buflist choices)))) (setq iswitchb-temp-buflist choices))))
(iswitchb-read-buffer prompt))) (iswitchb-read-buffer prompt)))
(ledger-post-use-ido (ledger-post-use-ido
(ido-completing-read prompt choices)) (ido-completing-read prompt choices))
(t (t
(completing-read prompt choices)))) (completing-read prompt choices))))
(defvar ledger-post-current-list nil) (defvar ledger-post-current-list nil)
@ -96,12 +96,12 @@ to choose from."
(match-end ledger-regex-post-line-group-account)) (match-end ledger-regex-post-line-group-account))
(insert account) (insert account)
(cond (cond
((> existing-len account-len) ((> existing-len account-len)
(insert (make-string (- existing-len account-len) ? ))) (insert (make-string (- existing-len account-len) ? )))
((< existing-len account-len) ((< existing-len account-len)
(dotimes (n (- account-len existing-len)) (dotimes (n (- account-len existing-len))
(if (looking-at "[ \t]\\( [ \t]\\|\t\\)") (if (looking-at "[ \t]\\( [ \t]\\|\t\\)")
(delete-char 1))))))) (delete-char 1)))))))
(goto-char pos))) (goto-char pos)))
(defun ledger-next-amount (&optional end) (defun ledger-next-amount (&optional end)
@ -130,12 +130,12 @@ This is done so that the last digit falls in COLUMN, which defaults to 52."
(setq adjust (- target-col col)) (setq adjust (- target-col col))
(if (< col target-col) (if (< col target-col)
(insert (make-string (- target-col col) ? )) (insert (make-string (- target-col col) ? ))
(move-to-column target-col) (move-to-column target-col)
(if (looking-back " ") (if (looking-back " ")
(delete-char (- col target-col)) (delete-char (- col target-col))
(skip-chars-forward "^ \t") (skip-chars-forward "^ \t")
(delete-horizontal-space) (delete-horizontal-space)
(insert " "))) (insert " ")))
(forward-line)))))) (forward-line))))))
(defun ledger-post-align-amount () (defun ledger-post-align-amount ()

122
lisp/ldg-regex.el
View file

@ -27,10 +27,10 @@
(defmacro ledger-define-regexp (name regex docs &rest args) (defmacro ledger-define-regexp (name regex docs &rest args)
"Simplify the creation of a Ledger regex and helper functions." "Simplify the creation of a Ledger regex and helper functions."
(let ((defs (let ((defs
(list (list
`(defconst `(defconst
,(intern (concat "ledger-" (symbol-name name) "-regexp")) ,(intern (concat "ledger-" (symbol-name name) "-regexp"))
,(eval regex)))) ,(eval regex))))
(addend 0) last-group) (addend 0) last-group)
(if (null args) (if (null args)
(progn (progn
@ -38,82 +38,82 @@
defs defs
(list (list
`(defconst `(defconst
,(intern ,(intern
(concat "ledger-regex-" (symbol-name name) "-group")) (concat "ledger-regex-" (symbol-name name) "-group"))
1))) 1)))
(nconc (nconc
defs defs
(list (list
`(defconst `(defconst
,(intern (concat "ledger-regex-" (symbol-name name) ,(intern (concat "ledger-regex-" (symbol-name name)
"-group--count")) "-group--count"))
1))) 1)))
(nconc (nconc
defs defs
(list (list
`(defmacro `(defmacro
,(intern (concat "ledger-regex-" (symbol-name name))) ,(intern (concat "ledger-regex-" (symbol-name name)))
(&optional string) (&optional string)
,(format "Return the match string for the %s" name) ,(format "Return the match string for the %s" name)
(match-string (match-string
,(intern (concat "ledger-regex-" (symbol-name name) ,(intern (concat "ledger-regex-" (symbol-name name)
"-group")) "-group"))
string))))) string)))))
(dolist (arg args) (dolist (arg args)
(let (var grouping target) (let (var grouping target)
(if (symbolp arg) (if (symbolp arg)
(setq var arg target arg) (setq var arg target arg)
(assert (listp arg)) (assert (listp arg))
(if (= 2 (length arg)) (if (= 2 (length arg))
(setq var (car arg) (setq var (car arg)
target (cadr arg)) target (cadr arg))
(setq var (car arg) (setq var (car arg)
grouping (cadr arg) grouping (cadr arg)
target (caddr arg)))) target (caddr arg))))
(if (and last-group (if (and last-group
(not (eq last-group (or grouping target)))) (not (eq last-group (or grouping target))))
(incf addend (incf addend
(symbol-value (symbol-value
(intern-soft (concat "ledger-regex-" (intern-soft (concat "ledger-regex-"
(symbol-name last-group) (symbol-name last-group)
"-group--count"))))) "-group--count")))))
(nconc (nconc
defs defs
(list (list
`(defconst `(defconst
,(intern (concat "ledger-regex-" (symbol-name name) ,(intern (concat "ledger-regex-" (symbol-name name)
"-group-" (symbol-name var))) "-group-" (symbol-name var)))
,(+ addend ,(+ addend
(symbol-value (symbol-value
(intern-soft (intern-soft
(if grouping (if grouping
(concat "ledger-regex-" (symbol-name grouping) (concat "ledger-regex-" (symbol-name grouping)
"-group-" (symbol-name target)) "-group-" (symbol-name target))
(concat "ledger-regex-" (symbol-name target) (concat "ledger-regex-" (symbol-name target)
"-group")))))))) "-group"))))))))
(nconc (nconc
defs defs
(list (list
`(defmacro `(defmacro
,(intern (concat "ledger-regex-" (symbol-name name) ,(intern (concat "ledger-regex-" (symbol-name name)
"-" (symbol-name var))) "-" (symbol-name var)))
(&optional string) (&optional string)
,(format "Return the sub-group match for the %s %s." ,(format "Return the sub-group match for the %s %s."
name var) name var)
(match-string (match-string
,(intern (concat "ledger-regex-" (symbol-name name) ,(intern (concat "ledger-regex-" (symbol-name name)
"-group-" (symbol-name var))) "-group-" (symbol-name var)))
string)))) string))))
(setq last-group (or grouping target)))) (setq last-group (or grouping target))))
(nconc defs (nconc defs
(list (list
`(defconst ,(intern (concat "ledger-regex-" (symbol-name name) `(defconst ,(intern (concat "ledger-regex-" (symbol-name name)
"-group--count")) "-group--count"))
,(length args))))) ,(length args)))))
(cons 'progn defs))) (cons 'progn defs)))

14
lisp/ldg-register.el
View file

@ -37,8 +37,8 @@
:group 'ledger-register) :group 'ledger-register)
(defface ledger-register-pending-face (defface ledger-register-pending-face
'((((background light)) (:weight bold)) '((((background light)) (:weight bold))
(((background dark)) (:weight bold))) (((background dark)) (:weight bold)))
"Face used to highlight pending entries in a register report." "Face used to highlight pending entries in a register report."
:group 'ledger-register) :group 'ledger-register)
@ -55,9 +55,9 @@
(save-excursion (save-excursion
(goto-line (nth 1 post)) (goto-line (nth 1 post))
(point-marker)) (point-marker))
(save-excursion (save-excursion
(goto-line (nth 0 xact)) (goto-line (nth 0 xact))
(point-marker))))))) (point-marker)))))))
(insert (format ledger-register-line-format (insert (format ledger-register-line-format
(format-time-string ledger-register-date-format (format-time-string ledger-register-date-format
(nth 2 post)) (nth 2 post))
@ -66,8 +66,8 @@
(set-text-properties beg (1- (point)) (set-text-properties beg (1- (point))
(list 'face 'ledger-register-pending-face (list 'face 'ledger-register-pending-face
'where where)) 'where where))
(set-text-properties beg (1- (point)) (set-text-properties beg (1- (point))
(list 'where where)))) (list 'where where))))
(setq index (1+ index))))) (setq index (1+ index)))))
(goto-char (point-min)) (goto-char (point-min))
) )

98
lisp/ldg-report.el
View file

@ -39,7 +39,7 @@ the substitution. See the documentation of the individual functions
in that variable for more information on the behavior of each in that variable for more information on the behavior of each
specifier." specifier."
:type '(repeat (list (string :tag "Report Name") :type '(repeat (list (string :tag "Report Name")
(string :tag "Command Line"))) (string :tag "Command Line")))
:group 'ledger) :group 'ledger)
(defcustom ledger-report-format-specifiers (defcustom ledger-report-format-specifiers
@ -73,40 +73,40 @@ text that should replace the format specifier."
(defvar ledger-report-mode-abbrev-table) (defvar ledger-report-mode-abbrev-table)
(define-derived-mode ledger-report-mode text-mode "Ledger-Report" (define-derived-mode ledger-report-mode text-mode "Ledger-Report"
"A mode for viewing ledger reports." "A mode for viewing ledger reports."
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
(define-key map [? ] 'scroll-up) (define-key map [? ] 'scroll-up)
(define-key map [backspace] 'scroll-down) (define-key map [backspace] 'scroll-down)
(define-key map [?r] 'ledger-report-redo) (define-key map [?r] 'ledger-report-redo)
(define-key map [?s] 'ledger-report-save) (define-key map [?s] 'ledger-report-save)
(define-key map [?k] 'ledger-report-kill) (define-key map [?k] 'ledger-report-kill)
(define-key map [?e] 'ledger-report-edit) (define-key map [?e] 'ledger-report-edit)
(define-key map [?q] 'ledger-report-quit) (define-key map [?q] 'ledger-report-quit)
(define-key map [(control ?c) (control ?l) (control ?r)] (define-key map [(control ?c) (control ?l) (control ?r)]
'ledger-report-redo) 'ledger-report-redo)
(define-key map [(control ?c) (control ?l) (control ?S)] (define-key map [(control ?c) (control ?l) (control ?S)]
'ledger-report-save) 'ledger-report-save)
(define-key map [(control ?c) (control ?l) (control ?k)] (define-key map [(control ?c) (control ?l) (control ?k)]
'ledger-report-kill) 'ledger-report-kill)
(define-key map [(control ?c) (control ?l) (control ?e)] (define-key map [(control ?c) (control ?l) (control ?e)]
'ledger-report-edit) 'ledger-report-edit)
(define-key map [(control ?c) (control ?c)] 'ledger-report-visit-source) (define-key map [(control ?c) (control ?c)] 'ledger-report-visit-source)
(define-key map [menu-bar] (make-sparse-keymap "ldg-rep")) (define-key map [menu-bar] (make-sparse-keymap "ldg-rep"))
(define-key map [menu-bar ldg-rep] (cons "Reports" map)) (define-key map [menu-bar ldg-rep] (cons "Reports" map))
(define-key map [menu-bar ldg-rep lrq] '("Quit" . ledger-report-quit)) (define-key map [menu-bar ldg-rep lrq] '("Quit" . ledger-report-quit))
(define-key map [menu-bar ldg-rep s2] '("--")) (define-key map [menu-bar ldg-rep s2] '("--"))
(define-key map [menu-bar ldg-rep lrd] '("Scroll Down" . scroll-down)) (define-key map [menu-bar ldg-rep lrd] '("Scroll Down" . scroll-down))
(define-key map [menu-bar ldg-rep lru] '("Scroll Up" . scroll-up)) (define-key map [menu-bar ldg-rep lru] '("Scroll Up" . scroll-up))
(define-key map [menu-bar ldg-rep s1] '("--")) (define-key map [menu-bar ldg-rep s1] '("--"))
(define-key map [menu-bar ldg-rep lrk] '("Kill Report" . ledger-report-kill)) (define-key map [menu-bar ldg-rep lrk] '("Kill Report" . ledger-report-kill))
(define-key map [menu-bar ldg-rep lrr] '("Re-run Report" . ledger-report-redo)) (define-key map [menu-bar ldg-rep lrr] '("Re-run Report" . ledger-report-redo))
(define-key map [menu-bar ldg-rep lre] '("Edit Report" . ledger-report-edit)) (define-key map [menu-bar ldg-rep lre] '("Edit Report" . ledger-report-edit))
(define-key map [menu-bar ldg-rep lrs] '("Save Report" . ledger-report-save)) (define-key map [menu-bar ldg-rep lrs] '("Save Report" . ledger-report-save))
(use-local-map map))) (use-local-map map)))
(defun ledger-report-read-name () (defun ledger-report-read-name ()
"Read the name of a ledger report to use, with completion. "Read the name of a ledger report to use, with completion.
@ -201,13 +201,13 @@ this variable would be set in a file local variable comment block at the
end of a ledger file which is included in some other file." end of a ledger file which is included in some other file."
(if ledger-master-file (if ledger-master-file
(expand-file-name ledger-master-file) (expand-file-name ledger-master-file)
(buffer-file-name))) (buffer-file-name)))
(defun ledger-read-string-with-default (prompt default) (defun ledger-read-string-with-default (prompt default)
(let ((default-prompt (concat prompt (let ((default-prompt (concat prompt
(if default (if default
(concat " (" default "): ") (concat " (" default "): ")
": ")))) ": "))))
(read-string default-prompt nil nil default))) (read-string default-prompt nil nil default)))
(defun ledger-report-payee-format-specifier () (defun ledger-report-payee-format-specifier ()
@ -234,7 +234,7 @@ the default."
(default (default
(if (eq (ledger-context-line-type context) 'acct-transaction) (if (eq (ledger-context-line-type context) 'acct-transaction)
(regexp-quote (ledger-context-field-value context 'account)) (regexp-quote (ledger-context-field-value context 'account))
nil))) nil)))
(ledger-read-string-with-default "Account" default))) (ledger-read-string-with-default "Account" default)))
(defun ledger-report-expand-format-specifiers (report-cmd) (defun ledger-report-expand-format-specifiers (report-cmd)
@ -248,9 +248,9 @@ the default."
(with-current-buffer ledger-buf (with-current-buffer ledger-buf
(shell-quote-argument (funcall f)))) (shell-quote-argument (funcall f))))
t t expanded-cmd)) t t expanded-cmd))
(progn (progn
(set-window-configuration ledger-original-window-cfg) (set-window-configuration ledger-original-window-cfg)
(error "Invalid ledger report format specifier '%s'" specifier))))) (error "Invalid ledger report format specifier '%s'" specifier)))))
expanded-cmd)) expanded-cmd))
(defun ledger-report-cmd (report-name edit) (defun ledger-report-cmd (report-name edit)
@ -280,12 +280,12 @@ the default."
(shell-command (shell-command
(if register-report (if register-report
(concat cmd " --prepend-format='%(filename):%(beg_line):'") (concat cmd " --prepend-format='%(filename):%(beg_line):'")
cmd) t nil) cmd) t nil)
(when register-report (when register-report
(goto-char data-pos) (goto-char data-pos)
(while (re-search-forward "^\\([^:]+\\)?:\\([0-9]+\\)?:" nil t) (while (re-search-forward "^\\([^:]+\\)?:\\([0-9]+\\)?:" nil t)
(let ((file (match-string 1)) (let ((file (match-string 1))
(line (string-to-number (match-string 2)))) (line (string-to-number (match-string 2))))
(delete-region (match-beginning 0) (match-end 0)) (delete-region (match-beginning 0) (match-end 0))
(set-text-properties (line-beginning-position) (line-end-position) (set-text-properties (line-beginning-position) (line-end-position)
(list 'ledger-source (cons file (save-window-excursion (list 'ledger-source (cons file (save-window-excursion
@ -307,14 +307,14 @@ the default."
(widen) (widen)
(if (markerp line-or-marker) (if (markerp line-or-marker)
(goto-char line-or-marker) (goto-char line-or-marker)
(goto-char (point-min)) (goto-char (point-min))
(forward-line (1- line-or-marker)) (forward-line (1- line-or-marker))
(re-search-backward "^[0-9]+") (re-search-backward "^[0-9]+")
(beginning-of-line) (beginning-of-line)
(let ((start-of-txn (point))) (let ((start-of-txn (point)))
(forward-paragraph) (forward-paragraph)
(narrow-to-region start-of-txn (point)) (narrow-to-region start-of-txn (point))
(backward-paragraph)))))) (backward-paragraph))))))
(defun ledger-report-goto () (defun ledger-report-goto ()
"Goto the ledger report buffer." "Goto the ledger report buffer."
@ -487,7 +487,7 @@ specified line, returns nil."
(let ((left (forward-line offset))) (let ((left (forward-line offset)))
(if (not (equal left 0)) (if (not (equal left 0))
nil nil
(ledger-context-at-point))))) (ledger-context-at-point)))))
(defun ledger-context-line-type (context-info) (defun ledger-context-line-type (context-info)
(nth 0 context-info)) (nth 0 context-info))
@ -525,6 +525,6 @@ specified line, returns nil."
(let ((context-info (ledger-context-other-line i))) (let ((context-info (ledger-context-other-line i)))
(if (eq (ledger-context-line-type context-info) 'entry) (if (eq (ledger-context-line-type context-info) 'entry)
(ledger-context-field-value context-info 'payee) (ledger-context-field-value context-info 'payee)
nil)))) nil))))
(provide 'ldg-report) (provide 'ldg-report)

14
lisp/ldg-sort.el
View file

@ -23,11 +23,11 @@
;; the form YYYY/mm/dd. ;; the form YYYY/mm/dd.
(defun ledger-next-record-function () (defun ledger-next-record-function ()
(if (re-search-forward (if (re-search-forward
(concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+"
"\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t) "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t)
(goto-char (match-beginning 0)) (goto-char (match-beginning 0))
(goto-char (point-max)))) (goto-char (point-max))))
(defun ledger-end-record-function () (defun ledger-end-record-function ()
(forward-paragraph)) (forward-paragraph))
@ -42,7 +42,7 @@
(setq new-beg (point)) (setq new-beg (point))
(goto-char end) (goto-char end)
(ledger-next-record-function) ;make sure end of region is at the beginning of (ledger-next-record-function) ;make sure end of region is at the beginning of
;next record after the region ;next record after the region
(setq new-end (point)) (setq new-end (point))
(narrow-to-region beg end) (narrow-to-region beg end)
(goto-char (point-min)) (goto-char (point-min))
@ -55,7 +55,7 @@
(defun ledger-sort-buffer () (defun ledger-sort-buffer ()
(interactive) (interactive)
(ledger-sort-region (point-min) (point-max))) (ledger-sort-region (point-min) (point-max)))
(provide 'ldg-sort) (provide 'ldg-sort)

60
lisp/ldg-state.el
View file

@ -28,9 +28,9 @@
(if (not (null state)) (if (not (null state))
(if (and style (eq style 'cleared)) (if (and style (eq style 'cleared))
'cleared) 'cleared)
(if (and style (eq style 'pending)) (if (and style (eq style 'pending))
'pending 'pending
'cleared))) 'cleared)))
(defun ledger-entry-state () (defun ledger-entry-state ()
(save-excursion (save-excursion
@ -106,23 +106,23 @@ dropped."
(progn (progn
(insert "* ") (insert "* ")
(setq inserted t))) (setq inserted t)))
(if (and style (eq style 'pending)) (if (and style (eq style 'pending))
(progn (progn
(insert "! ") (insert "! ")
(setq inserted t)) (setq inserted t))
(progn (progn
(insert "* ") (insert "* ")
(setq inserted t)))) (setq inserted t))))
(if (and inserted (if (and inserted
(re-search-forward "\\(\t\\| [ \t]\\)" (re-search-forward "\\(\t\\| [ \t]\\)"
(line-end-position) t)) (line-end-position) t))
(cond (cond
((looking-at "\t") ((looking-at "\t")
(delete-char 1)) (delete-char 1))
((looking-at " [ \t]") ((looking-at " [ \t]")
(delete-char 2)) (delete-char 2))
((looking-at " ") ((looking-at " ")
(delete-char 1)))) (delete-char 1))))
(setq clear inserted))))) (setq clear inserted)))))
;; Clean up the entry so that it displays minimally ;; Clean up the entry so that it displays minimally
(save-excursion (save-excursion
@ -135,12 +135,12 @@ dropped."
(skip-chars-forward " \t") (skip-chars-forward " \t")
(let ((cleared (if (member (char-after) '(?\* ?\!)) (let ((cleared (if (member (char-after) '(?\* ?\!))
(char-after) (char-after)
? ))) ? )))
(if first (if first
(setq state cleared (setq state cleared
first nil) first nil)
(if (/= state cleared) (if (/= state cleared)
(setq hetero t)))) (setq hetero t))))
(forward-line)) (forward-line))
(when (and (not hetero) (/= state ? )) (when (and (not hetero) (/= state ? ))
(goto-char (car bounds)) (goto-char (car bounds))
@ -162,12 +162,12 @@ dropped."
(if (re-search-forward "\\(\t\\| [ \t]\\)" (if (re-search-forward "\\(\t\\| [ \t]\\)"
(line-end-position) t) (line-end-position) t)
(cond (cond
((looking-at "\t") ((looking-at "\t")
(delete-char 1)) (delete-char 1))
((looking-at " [ \t]") ((looking-at " [ \t]")
(delete-char 2)) (delete-char 2))
((looking-at " ") ((looking-at " ")
(delete-char 1))))))) (delete-char 1)))))))
clear)) clear))
(defun ledger-toggle-current (&optional style) (defun ledger-toggle-current (&optional style)
@ -186,7 +186,7 @@ dropped."
(forward-line) (forward-line)
(goto-char (line-beginning-position)))) (goto-char (line-beginning-position))))
(ledger-toggle-current-entry style)) (ledger-toggle-current-entry style))
(ledger-toggle-current-transaction style))) (ledger-toggle-current-transaction style)))
(defun ledger-toggle-current-entry (&optional style) (defun ledger-toggle-current-entry (&optional style)
(interactive) (interactive)
@ -201,10 +201,10 @@ dropped."
(delete-char 1) (delete-char 1)
(if (and style (eq style 'cleared)) (if (and style (eq style 'cleared))
(insert " *"))) (insert " *")))
(if (and style (eq style 'pending)) (if (and style (eq style 'pending))
(insert " ! ") (insert " ! ")
(insert " * ")) (insert " * "))
(setq clear t)))) (setq clear t))))
clear)) clear))
(provide 'ldg-state) (provide 'ldg-state)

8
lisp/ldg-test.el
View file

@ -67,9 +67,9 @@
(ledger-mode) (ledger-mode)
(if input (if input
(insert input) (insert input)
(insert "2012-03-17 Payee\n") (insert "2012-03-17 Payee\n")
(insert " Expenses:Food $20\n") (insert " Expenses:Food $20\n")
(insert " Assets:Cash\n")) (insert " Assets:Cash\n"))
(insert "\ntest reg\n") (insert "\ntest reg\n")
(if output (if output
(insert output)) (insert output))
@ -90,7 +90,7 @@
(let ((prev-directory default-directory)) (let ((prev-directory default-directory))
(cd ledger-source-directory) (cd ledger-source-directory)
(unwind-protect (unwind-protect
(async-shell-command (format "\"%s\" %s" command args)) (async-shell-command (format "\"%s\" %s" command args))
(cd prev-directory))))))) (cd prev-directory)))))))
(provide 'ldg-test) (provide 'ldg-test)

18
lisp/ldg-texi.el
View file

@ -94,17 +94,17 @@
(if (string-match "\\$LEDGER" command) (if (string-match "\\$LEDGER" command)
(replace-match (format "%s -f \"%s\" %s" ledger-path (replace-match (format "%s -f \"%s\" %s" ledger-path
data-file ledger-normalization-args) t t command) data-file ledger-normalization-args) t t command)
(concat (format "%s -f \"%s\" %s " ledger-path (concat (format "%s -f \"%s\" %s " ledger-path
data-file ledger-normalization-args) command))) data-file ledger-normalization-args) command)))
(defun ledger-texi-invoke-command (command) (defun ledger-texi-invoke-command (command)
(with-temp-buffer (shell-command command t (current-buffer)) (with-temp-buffer (shell-command command t (current-buffer))
(if (= (point-min) (point-max)) (if (= (point-min) (point-max))
(progn (progn
(push-mark nil t) (push-mark nil t)
(message "Command '%s' yielded no result at %d" command (point)) (message "Command '%s' yielded no result at %d" command (point))
(ding)) (ding))
(buffer-string)))) (buffer-string))))
(defun ledger-texi-write-test-data (name input) (defun ledger-texi-write-test-data (name input)
(let ((path (expand-file-name name temporary-file-directory))) (let ((path (expand-file-name name temporary-file-directory)))
@ -149,7 +149,7 @@
(let ((section-name (if (string= section "smex") (let ((section-name (if (string= section "smex")
"smallexample" "smallexample"
"example")) "example"))
(output (ledger-texi-invoke-command (output (ledger-texi-invoke-command
(ledger-texi-expand-command command data-file)))) (ledger-texi-expand-command command data-file))))
(insert "@" section-name ?\n output (insert "@" section-name ?\n output