Lisp code cleanup
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
parent
d67c42207f
commit
4d7c492939
13 changed files with 303 additions and 303 deletions
|
|
@ -89,9 +89,9 @@
|
|||
(let ((entry (assoc (car elements) root)))
|
||||
(if entry
|
||||
(setq root (cdr entry))
|
||||
(setq entry (cons (car elements) (list t)))
|
||||
(nconc root (list entry))
|
||||
(setq root (cdr entry))))
|
||||
(setq entry (cons (car elements) (list t)))
|
||||
(nconc root (list entry))
|
||||
(setq root (cdr entry))))
|
||||
(setq elements (cdr elements)))))))))
|
||||
|
||||
(defun ledger-accounts ()
|
||||
|
|
@ -106,18 +106,18 @@
|
|||
(setq prefix (concat prefix (and prefix ":")
|
||||
(car elements))
|
||||
root (cdr entry))
|
||||
(setq root nil elements nil)))
|
||||
(setq root nil elements nil)))
|
||||
(setq elements (cdr elements)))
|
||||
(and root
|
||||
(sort
|
||||
(mapcar (function
|
||||
(lambda (x)
|
||||
(let ((term (if prefix
|
||||
(concat prefix ":" (car x))
|
||||
(car x))))
|
||||
(if (> (length (cdr x)) 1)
|
||||
(concat term ":")
|
||||
term))))
|
||||
(let ((term (if prefix
|
||||
(concat prefix ":" (car x))
|
||||
(car x))))
|
||||
(if (> (length (cdr x)) 1)
|
||||
(concat term ":")
|
||||
term))))
|
||||
(cdr root))
|
||||
'string-lessp))))
|
||||
|
||||
|
|
@ -129,21 +129,21 @@
|
|||
(ledger-thing-at-point)) 'entry)
|
||||
(if (null current-prefix-arg)
|
||||
(ledger-entries) ; this completes against entry names
|
||||
(progn
|
||||
(let ((text (buffer-substring (line-beginning-position)
|
||||
(line-end-position))))
|
||||
(delete-region (line-beginning-position)
|
||||
(line-end-position))
|
||||
(condition-case err
|
||||
(ledger-add-entry text t)
|
||||
((error)
|
||||
(insert text))))
|
||||
(forward-line)
|
||||
(goto-char (line-end-position))
|
||||
(search-backward ";" (line-beginning-position) t)
|
||||
(skip-chars-backward " \t0123456789.,")
|
||||
(throw 'pcompleted t)))
|
||||
(ledger-accounts)))))
|
||||
(progn
|
||||
(let ((text (buffer-substring (line-beginning-position)
|
||||
(line-end-position))))
|
||||
(delete-region (line-beginning-position)
|
||||
(line-end-position))
|
||||
(condition-case err
|
||||
(ledger-add-entry text t)
|
||||
((error)
|
||||
(insert text))))
|
||||
(forward-line)
|
||||
(goto-char (line-end-position))
|
||||
(search-backward ";" (line-beginning-position) t)
|
||||
(skip-chars-backward " \t0123456789.,")
|
||||
(throw 'pcompleted t)))
|
||||
(ledger-accounts)))))
|
||||
|
||||
(defun ledger-fully-complete-entry ()
|
||||
"Do appropriate completion for the thing at point"
|
||||
|
|
|
|||
|
|
@ -68,8 +68,8 @@
|
|||
(goto-char (point-min))
|
||||
(delete-horizontal-space)
|
||||
(setq version-strings (split-string
|
||||
(buffer-substring-no-properties (point)
|
||||
(+ (point) 12))))
|
||||
(buffer-substring-no-properties (point)
|
||||
(+ (point) 12))))
|
||||
(if (and (string-match (regexp-quote "Ledger") (car version-strings))
|
||||
(or (string= needed (car (cdr version-strings)))
|
||||
(string< needed (car (cdr version-strings)))))
|
||||
|
|
|
|||
|
|
@ -52,7 +52,7 @@
|
|||
:group 'ledger-faces)
|
||||
|
||||
(defface ledger-font-comment-face
|
||||
`((t :foreground "orange" ))
|
||||
`((t :foreground "orange" ))
|
||||
"Face for Ledger comments"
|
||||
:group 'ledger-faces)
|
||||
|
||||
|
|
|
|||
162
lisp/ldg-mode.el
162
lisp/ldg-mode.el
|
|
@ -43,77 +43,77 @@ customizable to ease retro-entry.")
|
|||
|
||||
;;;###autoload
|
||||
(define-derived-mode ledger-mode text-mode "Ledger"
|
||||
"A mode for editing ledger data files."
|
||||
(ledger-check-version)
|
||||
(ledger-post-setup)
|
||||
"A mode for editing ledger data files."
|
||||
(ledger-check-version)
|
||||
(ledger-post-setup)
|
||||
|
||||
(set (make-local-variable 'comment-start) " ; ")
|
||||
(set (make-local-variable 'comment-end) "")
|
||||
(set (make-local-variable 'indent-tabs-mode) nil)
|
||||
(set (make-local-variable 'comment-start) " ; ")
|
||||
(set (make-local-variable 'comment-end) "")
|
||||
(set (make-local-variable 'indent-tabs-mode) nil)
|
||||
|
||||
(if (boundp 'font-lock-defaults)
|
||||
(set (make-local-variable 'font-lock-defaults)
|
||||
'(ledger-font-lock-keywords nil t)))
|
||||
(if (boundp 'font-lock-defaults)
|
||||
(set (make-local-variable 'font-lock-defaults)
|
||||
'(ledger-font-lock-keywords nil t)))
|
||||
|
||||
(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-termination-string) "")
|
||||
(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-termination-string) "")
|
||||
|
||||
(let ((map (current-local-map)))
|
||||
(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 ?y)] 'ledger-set-year)
|
||||
(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 ?e)] 'ledger-toggle-current-entry)
|
||||
(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 ?t)] 'ledger-test-run)
|
||||
(define-key map [(control ?c) (control ?v)] 'ledger-post-edit-amount)
|
||||
(define-key map [(control ?c) (control ?f)] 'ledger-occur)
|
||||
(define-key map [tab] 'pcomplete)
|
||||
(define-key map [(control ?i)] 'pcomplete)
|
||||
(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 ?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 ?a)] 'ledger-report-redo)
|
||||
(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 ?k)] 'ledger-report-kill)
|
||||
(let ((map (current-local-map)))
|
||||
(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 ?y)] 'ledger-set-year)
|
||||
(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 ?e)] 'ledger-toggle-current-entry)
|
||||
(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 ?t)] 'ledger-test-run)
|
||||
(define-key map [(control ?c) (control ?v)] 'ledger-post-edit-amount)
|
||||
(define-key map [(control ?c) (control ?f)] 'ledger-occur)
|
||||
(define-key map [tab] 'pcomplete)
|
||||
(define-key map [(control ?i)] 'pcomplete)
|
||||
(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 ?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 ?a)] 'ledger-report-redo)
|
||||
(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 ?k)] 'ledger-report-kill)
|
||||
|
||||
(define-key map [(meta ?p)] 'ledger-post-prev-xact)
|
||||
(define-key map [(meta ?n)] 'ledger-post-next-xact)
|
||||
(define-key map [(meta ?p)] 'ledger-post-prev-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 ldg-menu] (cons "Ledger" map))
|
||||
(define-key map [menu-bar] (make-sparse-keymap "ldg-menu"))
|
||||
(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-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-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-run] '(menu-item "Run Report" ledger-report :enable ledger-works))
|
||||
(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-year] '(menu-item "Set Year" ledger-set-year :enable ledger-works))
|
||||
(define-key map [sep1] '("--"))
|
||||
(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 [sep2] '(menu-item "--"))
|
||||
(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 [sep4] '(menu-item "--"))
|
||||
(define-key map [edit-amount] '(menu-item "Calc on Amount" ledger-post-edit-amount))
|
||||
(define-key map [sep] '(menu-item "--"))
|
||||
(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 [sep3] '(menu-item "--"))
|
||||
(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 [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-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-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 [sep5] '(menu-item "--"))
|
||||
(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 [sep1] '("--"))
|
||||
(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 [sep2] '(menu-item "--"))
|
||||
(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 [sep4] '(menu-item "--"))
|
||||
(define-key map [edit-amount] '(menu-item "Calc on Amount" ledger-post-edit-amount))
|
||||
(define-key map [sep] '(menu-item "--"))
|
||||
(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 [sep3] '(menu-item "--"))
|
||||
(define-key map [reconcile] '(menu-item "Reconcile Account" ledger-reconcile :enable ledger-works))
|
||||
(define-key map [reconcile] '(menu-item "Hide Xacts" ledger-occur))
|
||||
))
|
||||
|
||||
(defun ledger-time-less-p (t1 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
|
||||
(function
|
||||
(lambda (start date mark desc)
|
||||
(if (ledger-time-less-p moment date)
|
||||
(throw 'found t)))))))
|
||||
(if (ledger-time-less-p moment date)
|
||||
(throw 'found t)))))))
|
||||
|
||||
(defun ledger-iterate-entries (callback)
|
||||
(goto-char (point-min))
|
||||
|
|
@ -149,18 +149,18 @@ Return the difference in the format of a time value."
|
|||
(let ((found (match-string 2)))
|
||||
(if found
|
||||
(setq current-year (string-to-number found))
|
||||
(let ((start (match-beginning 0))
|
||||
(year (match-string 3))
|
||||
(month (string-to-number (match-string 4)))
|
||||
(day (string-to-number (match-string 5)))
|
||||
(mark (match-string 6))
|
||||
(desc (match-string 7)))
|
||||
(if (and year (> (length year) 0))
|
||||
(setq year (string-to-number year)))
|
||||
(funcall callback start
|
||||
(encode-time 0 0 0 day month
|
||||
(or year current-year))
|
||||
mark desc)))))
|
||||
(let ((start (match-beginning 0))
|
||||
(year (match-string 3))
|
||||
(month (string-to-number (match-string 4)))
|
||||
(day (string-to-number (match-string 5)))
|
||||
(mark (match-string 6))
|
||||
(desc (match-string 7)))
|
||||
(if (and year (> (length year) 0))
|
||||
(setq year (string-to-number year)))
|
||||
(funcall callback start
|
||||
(encode-time 0 0 0 day month
|
||||
(or year current-year))
|
||||
mark desc)))))
|
||||
(forward-line))))
|
||||
|
||||
(defun ledger-set-year (newyear)
|
||||
|
|
@ -168,14 +168,14 @@ Return the difference in the format of a time value."
|
|||
(interactive "p")
|
||||
(if (= newyear 1)
|
||||
(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)
|
||||
"Set ledger's idea of the current month to the prefix argument."
|
||||
(interactive "p")
|
||||
(if (= newmonth 1)
|
||||
(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)
|
||||
(interactive (list
|
||||
|
|
@ -202,7 +202,7 @@ Return the difference in the format of a time value."
|
|||
(goto-char (point-min))
|
||||
(if (looking-at "Error: ")
|
||||
(error (buffer-string))
|
||||
(buffer-string)))
|
||||
(buffer-string)))
|
||||
"\n"))))
|
||||
|
||||
(defun ledger-current-entry-bounds ()
|
||||
|
|
|
|||
|
|
@ -47,9 +47,9 @@
|
|||
(require 'ldg-fonts)
|
||||
(require 'ldg-occur)
|
||||
|
||||
;(autoload #'ledger-mode "ldg-mode" nil t)
|
||||
;(autoload #'ledger-fully-complete-entry "ldg-complete" nil t)
|
||||
;(autoload #'ledger-toggle-current "ldg-state" nil t)
|
||||
;(autoload #'ledger-mode "ldg-mode" nil t)
|
||||
;(autoload #'ledger-fully-complete-entry "ldg-complete" nil t)
|
||||
;(autoload #'ledger-toggle-current "ldg-state" nil t)
|
||||
|
||||
(autoload #'ledger-texi-update-test "ldg-texi" nil t)
|
||||
(autoload #'ledger-texi-update-examples "ldg-texi" nil t)
|
||||
|
|
|
|||
|
|
@ -66,16 +66,16 @@
|
|||
PROMPT is a string to prompt with. CHOICES is a list of strings
|
||||
to choose from."
|
||||
(cond
|
||||
(ledger-post-use-iswitchb
|
||||
(let* ((iswitchb-use-virtual-buffers nil)
|
||||
(iswitchb-make-buflist-hook
|
||||
(lambda ()
|
||||
(setq iswitchb-temp-buflist choices))))
|
||||
(iswitchb-read-buffer prompt)))
|
||||
(ledger-post-use-ido
|
||||
(ido-completing-read prompt choices))
|
||||
(t
|
||||
(completing-read prompt choices))))
|
||||
(ledger-post-use-iswitchb
|
||||
(let* ((iswitchb-use-virtual-buffers nil)
|
||||
(iswitchb-make-buflist-hook
|
||||
(lambda ()
|
||||
(setq iswitchb-temp-buflist choices))))
|
||||
(iswitchb-read-buffer prompt)))
|
||||
(ledger-post-use-ido
|
||||
(ido-completing-read prompt choices))
|
||||
(t
|
||||
(completing-read prompt choices))))
|
||||
|
||||
(defvar ledger-post-current-list nil)
|
||||
|
||||
|
|
@ -96,12 +96,12 @@ to choose from."
|
|||
(match-end ledger-regex-post-line-group-account))
|
||||
(insert account)
|
||||
(cond
|
||||
((> existing-len account-len)
|
||||
(insert (make-string (- existing-len account-len) ? )))
|
||||
((< existing-len account-len)
|
||||
(dotimes (n (- account-len existing-len))
|
||||
(if (looking-at "[ \t]\\( [ \t]\\|\t\\)")
|
||||
(delete-char 1)))))))
|
||||
((> existing-len account-len)
|
||||
(insert (make-string (- existing-len account-len) ? )))
|
||||
((< existing-len account-len)
|
||||
(dotimes (n (- account-len existing-len))
|
||||
(if (looking-at "[ \t]\\( [ \t]\\|\t\\)")
|
||||
(delete-char 1)))))))
|
||||
(goto-char pos)))
|
||||
|
||||
(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))
|
||||
(if (< col target-col)
|
||||
(insert (make-string (- target-col col) ? ))
|
||||
(move-to-column target-col)
|
||||
(if (looking-back " ")
|
||||
(delete-char (- col target-col))
|
||||
(skip-chars-forward "^ \t")
|
||||
(delete-horizontal-space)
|
||||
(insert " ")))
|
||||
(move-to-column target-col)
|
||||
(if (looking-back " ")
|
||||
(delete-char (- col target-col))
|
||||
(skip-chars-forward "^ \t")
|
||||
(delete-horizontal-space)
|
||||
(insert " ")))
|
||||
(forward-line))))))
|
||||
|
||||
(defun ledger-post-align-amount ()
|
||||
|
|
|
|||
|
|
@ -27,10 +27,10 @@
|
|||
(defmacro ledger-define-regexp (name regex docs &rest args)
|
||||
"Simplify the creation of a Ledger regex and helper functions."
|
||||
(let ((defs
|
||||
(list
|
||||
`(defconst
|
||||
,(intern (concat "ledger-" (symbol-name name) "-regexp"))
|
||||
,(eval regex))))
|
||||
(list
|
||||
`(defconst
|
||||
,(intern (concat "ledger-" (symbol-name name) "-regexp"))
|
||||
,(eval regex))))
|
||||
(addend 0) last-group)
|
||||
(if (null args)
|
||||
(progn
|
||||
|
|
@ -38,82 +38,82 @@
|
|||
defs
|
||||
(list
|
||||
`(defconst
|
||||
,(intern
|
||||
(concat "ledger-regex-" (symbol-name name) "-group"))
|
||||
,(intern
|
||||
(concat "ledger-regex-" (symbol-name name) "-group"))
|
||||
1)))
|
||||
(nconc
|
||||
defs
|
||||
(list
|
||||
`(defconst
|
||||
,(intern (concat "ledger-regex-" (symbol-name name)
|
||||
"-group--count"))
|
||||
,(intern (concat "ledger-regex-" (symbol-name name)
|
||||
"-group--count"))
|
||||
1)))
|
||||
(nconc
|
||||
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)
|
||||
"-group"))
|
||||
string)))))
|
||||
|
||||
(dolist (arg args)
|
||||
(let (var grouping target)
|
||||
(if (symbolp arg)
|
||||
(setq var arg target arg)
|
||||
(assert (listp arg))
|
||||
(if (= 2 (length arg))
|
||||
(setq var (car arg)
|
||||
target (cadr arg))
|
||||
(setq var (car arg)
|
||||
grouping (cadr arg)
|
||||
target (caddr arg))))
|
||||
|
||||
(dolist (arg args)
|
||||
(let (var grouping target)
|
||||
(if (symbolp arg)
|
||||
(setq var arg target arg)
|
||||
(assert (listp arg))
|
||||
(if (= 2 (length arg))
|
||||
(setq var (car arg)
|
||||
target (cadr arg))
|
||||
(setq var (car arg)
|
||||
grouping (cadr arg)
|
||||
target (caddr arg))))
|
||||
|
||||
(if (and last-group
|
||||
(not (eq last-group (or grouping target))))
|
||||
(incf addend
|
||||
(symbol-value
|
||||
(intern-soft (concat "ledger-regex-"
|
||||
(symbol-name last-group)
|
||||
"-group--count")))))
|
||||
(nconc
|
||||
defs
|
||||
(list
|
||||
`(defconst
|
||||
,(intern (concat "ledger-regex-" (symbol-name name)
|
||||
"-group-" (symbol-name var)))
|
||||
,(+ addend
|
||||
(symbol-value
|
||||
(intern-soft
|
||||
(if grouping
|
||||
(concat "ledger-regex-" (symbol-name grouping)
|
||||
"-group-" (symbol-name target))
|
||||
(concat "ledger-regex-" (symbol-name target)
|
||||
"-group"))))))))
|
||||
(nconc
|
||||
defs
|
||||
(list
|
||||
`(defmacro
|
||||
,(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
|
||||
,(intern (concat "ledger-regex-" (symbol-name name)
|
||||
"-group-" (symbol-name var)))
|
||||
string))))
|
||||
(if (and last-group
|
||||
(not (eq last-group (or grouping target))))
|
||||
(incf addend
|
||||
(symbol-value
|
||||
(intern-soft (concat "ledger-regex-"
|
||||
(symbol-name last-group)
|
||||
"-group--count")))))
|
||||
(nconc
|
||||
defs
|
||||
(list
|
||||
`(defconst
|
||||
,(intern (concat "ledger-regex-" (symbol-name name)
|
||||
"-group-" (symbol-name var)))
|
||||
,(+ addend
|
||||
(symbol-value
|
||||
(intern-soft
|
||||
(if grouping
|
||||
(concat "ledger-regex-" (symbol-name grouping)
|
||||
"-group-" (symbol-name target))
|
||||
(concat "ledger-regex-" (symbol-name target)
|
||||
"-group"))))))))
|
||||
(nconc
|
||||
defs
|
||||
(list
|
||||
`(defmacro
|
||||
,(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
|
||||
,(intern (concat "ledger-regex-" (symbol-name name)
|
||||
"-group-" (symbol-name var)))
|
||||
string))))
|
||||
|
||||
(setq last-group (or grouping target))))
|
||||
(setq last-group (or grouping target))))
|
||||
|
||||
(nconc defs
|
||||
(list
|
||||
`(defconst ,(intern (concat "ledger-regex-" (symbol-name name)
|
||||
"-group--count"))
|
||||
,(length args)))))
|
||||
(nconc defs
|
||||
(list
|
||||
`(defconst ,(intern (concat "ledger-regex-" (symbol-name name)
|
||||
"-group--count"))
|
||||
,(length args)))))
|
||||
|
||||
(cons 'progn defs)))
|
||||
|
||||
|
|
|
|||
|
|
@ -37,8 +37,8 @@
|
|||
:group 'ledger-register)
|
||||
|
||||
(defface ledger-register-pending-face
|
||||
'((((background light)) (:weight bold))
|
||||
(((background dark)) (:weight bold)))
|
||||
'((((background light)) (:weight bold))
|
||||
(((background dark)) (:weight bold)))
|
||||
"Face used to highlight pending entries in a register report."
|
||||
:group 'ledger-register)
|
||||
|
||||
|
|
@ -55,9 +55,9 @@
|
|||
(save-excursion
|
||||
(goto-line (nth 1 post))
|
||||
(point-marker))
|
||||
(save-excursion
|
||||
(goto-line (nth 0 xact))
|
||||
(point-marker)))))))
|
||||
(save-excursion
|
||||
(goto-line (nth 0 xact))
|
||||
(point-marker)))))))
|
||||
(insert (format ledger-register-line-format
|
||||
(format-time-string ledger-register-date-format
|
||||
(nth 2 post))
|
||||
|
|
@ -66,8 +66,8 @@
|
|||
(set-text-properties beg (1- (point))
|
||||
(list 'face 'ledger-register-pending-face
|
||||
'where where))
|
||||
(set-text-properties beg (1- (point))
|
||||
(list 'where where))))
|
||||
(set-text-properties beg (1- (point))
|
||||
(list 'where where))))
|
||||
(setq index (1+ index)))))
|
||||
(goto-char (point-min))
|
||||
)
|
||||
|
|
|
|||
|
|
@ -39,7 +39,7 @@ the substitution. See the documentation of the individual functions
|
|||
in that variable for more information on the behavior of each
|
||||
specifier."
|
||||
:type '(repeat (list (string :tag "Report Name")
|
||||
(string :tag "Command Line")))
|
||||
(string :tag "Command Line")))
|
||||
:group 'ledger)
|
||||
|
||||
(defcustom ledger-report-format-specifiers
|
||||
|
|
@ -73,40 +73,40 @@ text that should replace the format specifier."
|
|||
(defvar ledger-report-mode-abbrev-table)
|
||||
|
||||
(define-derived-mode ledger-report-mode text-mode "Ledger-Report"
|
||||
"A mode for viewing ledger reports."
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map [? ] 'scroll-up)
|
||||
(define-key map [backspace] 'scroll-down)
|
||||
(define-key map [?r] 'ledger-report-redo)
|
||||
(define-key map [?s] 'ledger-report-save)
|
||||
(define-key map [?k] 'ledger-report-kill)
|
||||
(define-key map [?e] 'ledger-report-edit)
|
||||
(define-key map [?q] 'ledger-report-quit)
|
||||
(define-key map [(control ?c) (control ?l) (control ?r)]
|
||||
'ledger-report-redo)
|
||||
(define-key map [(control ?c) (control ?l) (control ?S)]
|
||||
'ledger-report-save)
|
||||
(define-key map [(control ?c) (control ?l) (control ?k)]
|
||||
'ledger-report-kill)
|
||||
(define-key map [(control ?c) (control ?l) (control ?e)]
|
||||
'ledger-report-edit)
|
||||
(define-key map [(control ?c) (control ?c)] 'ledger-report-visit-source)
|
||||
"A mode for viewing ledger reports."
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map [? ] 'scroll-up)
|
||||
(define-key map [backspace] 'scroll-down)
|
||||
(define-key map [?r] 'ledger-report-redo)
|
||||
(define-key map [?s] 'ledger-report-save)
|
||||
(define-key map [?k] 'ledger-report-kill)
|
||||
(define-key map [?e] 'ledger-report-edit)
|
||||
(define-key map [?q] 'ledger-report-quit)
|
||||
(define-key map [(control ?c) (control ?l) (control ?r)]
|
||||
'ledger-report-redo)
|
||||
(define-key map [(control ?c) (control ?l) (control ?S)]
|
||||
'ledger-report-save)
|
||||
(define-key map [(control ?c) (control ?l) (control ?k)]
|
||||
'ledger-report-kill)
|
||||
(define-key map [(control ?c) (control ?l) (control ?e)]
|
||||
'ledger-report-edit)
|
||||
(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 ldg-rep] (cons "Reports" map))
|
||||
|
||||
(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 lrq] '("Quit" . ledger-report-quit))
|
||||
(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 lru] '("Scroll Up" . scroll-up))
|
||||
(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 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 lrs] '("Save Report" . ledger-report-save))
|
||||
(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 lrd] '("Scroll Down" . scroll-down))
|
||||
(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 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 lre] '("Edit Report" . ledger-report-edit))
|
||||
(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 ()
|
||||
"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."
|
||||
(if ledger-master-file
|
||||
(expand-file-name ledger-master-file)
|
||||
(buffer-file-name)))
|
||||
(buffer-file-name)))
|
||||
|
||||
(defun ledger-read-string-with-default (prompt default)
|
||||
(let ((default-prompt (concat prompt
|
||||
(if default
|
||||
(concat " (" default "): ")
|
||||
": "))))
|
||||
": "))))
|
||||
(read-string default-prompt nil nil default)))
|
||||
|
||||
(defun ledger-report-payee-format-specifier ()
|
||||
|
|
@ -234,7 +234,7 @@ the default."
|
|||
(default
|
||||
(if (eq (ledger-context-line-type context) 'acct-transaction)
|
||||
(regexp-quote (ledger-context-field-value context 'account))
|
||||
nil)))
|
||||
nil)))
|
||||
(ledger-read-string-with-default "Account" default)))
|
||||
|
||||
(defun ledger-report-expand-format-specifiers (report-cmd)
|
||||
|
|
@ -248,9 +248,9 @@ the default."
|
|||
(with-current-buffer ledger-buf
|
||||
(shell-quote-argument (funcall f))))
|
||||
t t expanded-cmd))
|
||||
(progn
|
||||
(set-window-configuration ledger-original-window-cfg)
|
||||
(error "Invalid ledger report format specifier '%s'" specifier)))))
|
||||
(progn
|
||||
(set-window-configuration ledger-original-window-cfg)
|
||||
(error "Invalid ledger report format specifier '%s'" specifier)))))
|
||||
expanded-cmd))
|
||||
|
||||
(defun ledger-report-cmd (report-name edit)
|
||||
|
|
@ -280,12 +280,12 @@ the default."
|
|||
(shell-command
|
||||
(if register-report
|
||||
(concat cmd " --prepend-format='%(filename):%(beg_line):'")
|
||||
cmd) t nil)
|
||||
cmd) t nil)
|
||||
(when register-report
|
||||
(goto-char data-pos)
|
||||
(while (re-search-forward "^\\([^:]+\\)?:\\([0-9]+\\)?:" nil t)
|
||||
(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))
|
||||
(set-text-properties (line-beginning-position) (line-end-position)
|
||||
(list 'ledger-source (cons file (save-window-excursion
|
||||
|
|
@ -307,14 +307,14 @@ the default."
|
|||
(widen)
|
||||
(if (markerp line-or-marker)
|
||||
(goto-char line-or-marker)
|
||||
(goto-char (point-min))
|
||||
(forward-line (1- line-or-marker))
|
||||
(re-search-backward "^[0-9]+")
|
||||
(beginning-of-line)
|
||||
(let ((start-of-txn (point)))
|
||||
(forward-paragraph)
|
||||
(narrow-to-region start-of-txn (point))
|
||||
(backward-paragraph))))))
|
||||
(goto-char (point-min))
|
||||
(forward-line (1- line-or-marker))
|
||||
(re-search-backward "^[0-9]+")
|
||||
(beginning-of-line)
|
||||
(let ((start-of-txn (point)))
|
||||
(forward-paragraph)
|
||||
(narrow-to-region start-of-txn (point))
|
||||
(backward-paragraph))))))
|
||||
|
||||
(defun ledger-report-goto ()
|
||||
"Goto the ledger report buffer."
|
||||
|
|
@ -487,7 +487,7 @@ specified line, returns nil."
|
|||
(let ((left (forward-line offset)))
|
||||
(if (not (equal left 0))
|
||||
nil
|
||||
(ledger-context-at-point)))))
|
||||
(ledger-context-at-point)))))
|
||||
|
||||
(defun ledger-context-line-type (context-info)
|
||||
(nth 0 context-info))
|
||||
|
|
@ -525,6 +525,6 @@ specified line, returns nil."
|
|||
(let ((context-info (ledger-context-other-line i)))
|
||||
(if (eq (ledger-context-line-type context-info) 'entry)
|
||||
(ledger-context-field-value context-info 'payee)
|
||||
nil))))
|
||||
nil))))
|
||||
|
||||
(provide 'ldg-report)
|
||||
|
|
|
|||
|
|
@ -23,11 +23,11 @@
|
|||
;; the form YYYY/mm/dd.
|
||||
|
||||
(defun ledger-next-record-function ()
|
||||
(if (re-search-forward
|
||||
(concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+"
|
||||
"\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t)
|
||||
(goto-char (match-beginning 0))
|
||||
(goto-char (point-max))))
|
||||
(if (re-search-forward
|
||||
(concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+"
|
||||
"\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t)
|
||||
(goto-char (match-beginning 0))
|
||||
(goto-char (point-max))))
|
||||
|
||||
(defun ledger-end-record-function ()
|
||||
(forward-paragraph))
|
||||
|
|
@ -42,7 +42,7 @@
|
|||
(setq new-beg (point))
|
||||
(goto-char end)
|
||||
(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))
|
||||
(narrow-to-region beg end)
|
||||
(goto-char (point-min))
|
||||
|
|
@ -55,7 +55,7 @@
|
|||
|
||||
(defun ledger-sort-buffer ()
|
||||
(interactive)
|
||||
(ledger-sort-region (point-min) (point-max)))
|
||||
(ledger-sort-region (point-min) (point-max)))
|
||||
|
||||
|
||||
(provide 'ldg-sort)
|
||||
|
|
@ -28,9 +28,9 @@
|
|||
(if (not (null state))
|
||||
(if (and style (eq style 'cleared))
|
||||
'cleared)
|
||||
(if (and style (eq style 'pending))
|
||||
'pending
|
||||
'cleared)))
|
||||
(if (and style (eq style 'pending))
|
||||
'pending
|
||||
'cleared)))
|
||||
|
||||
(defun ledger-entry-state ()
|
||||
(save-excursion
|
||||
|
|
@ -106,23 +106,23 @@ dropped."
|
|||
(progn
|
||||
(insert "* ")
|
||||
(setq inserted t)))
|
||||
(if (and style (eq style 'pending))
|
||||
(progn
|
||||
(insert "! ")
|
||||
(setq inserted t))
|
||||
(progn
|
||||
(insert "* ")
|
||||
(setq inserted t))))
|
||||
(if (and style (eq style 'pending))
|
||||
(progn
|
||||
(insert "! ")
|
||||
(setq inserted t))
|
||||
(progn
|
||||
(insert "* ")
|
||||
(setq inserted t))))
|
||||
(if (and inserted
|
||||
(re-search-forward "\\(\t\\| [ \t]\\)"
|
||||
(line-end-position) t))
|
||||
(cond
|
||||
((looking-at "\t")
|
||||
(delete-char 1))
|
||||
((looking-at " [ \t]")
|
||||
(delete-char 2))
|
||||
((looking-at " ")
|
||||
(delete-char 1))))
|
||||
((looking-at "\t")
|
||||
(delete-char 1))
|
||||
((looking-at " [ \t]")
|
||||
(delete-char 2))
|
||||
((looking-at " ")
|
||||
(delete-char 1))))
|
||||
(setq clear inserted)))))
|
||||
;; Clean up the entry so that it displays minimally
|
||||
(save-excursion
|
||||
|
|
@ -135,12 +135,12 @@ dropped."
|
|||
(skip-chars-forward " \t")
|
||||
(let ((cleared (if (member (char-after) '(?\* ?\!))
|
||||
(char-after)
|
||||
? )))
|
||||
? )))
|
||||
(if first
|
||||
(setq state cleared
|
||||
first nil)
|
||||
(if (/= state cleared)
|
||||
(setq hetero t))))
|
||||
(if (/= state cleared)
|
||||
(setq hetero t))))
|
||||
(forward-line))
|
||||
(when (and (not hetero) (/= state ? ))
|
||||
(goto-char (car bounds))
|
||||
|
|
@ -162,12 +162,12 @@ dropped."
|
|||
(if (re-search-forward "\\(\t\\| [ \t]\\)"
|
||||
(line-end-position) t)
|
||||
(cond
|
||||
((looking-at "\t")
|
||||
(delete-char 1))
|
||||
((looking-at " [ \t]")
|
||||
(delete-char 2))
|
||||
((looking-at " ")
|
||||
(delete-char 1)))))))
|
||||
((looking-at "\t")
|
||||
(delete-char 1))
|
||||
((looking-at " [ \t]")
|
||||
(delete-char 2))
|
||||
((looking-at " ")
|
||||
(delete-char 1)))))))
|
||||
clear))
|
||||
|
||||
(defun ledger-toggle-current (&optional style)
|
||||
|
|
@ -186,7 +186,7 @@ dropped."
|
|||
(forward-line)
|
||||
(goto-char (line-beginning-position))))
|
||||
(ledger-toggle-current-entry style))
|
||||
(ledger-toggle-current-transaction style)))
|
||||
(ledger-toggle-current-transaction style)))
|
||||
|
||||
(defun ledger-toggle-current-entry (&optional style)
|
||||
(interactive)
|
||||
|
|
@ -201,10 +201,10 @@ dropped."
|
|||
(delete-char 1)
|
||||
(if (and style (eq style 'cleared))
|
||||
(insert " *")))
|
||||
(if (and style (eq style 'pending))
|
||||
(insert " ! ")
|
||||
(insert " * "))
|
||||
(setq clear t))))
|
||||
(if (and style (eq style 'pending))
|
||||
(insert " ! ")
|
||||
(insert " * "))
|
||||
(setq clear t))))
|
||||
clear))
|
||||
|
||||
(provide 'ldg-state)
|
||||
|
|
|
|||
|
|
@ -67,9 +67,9 @@
|
|||
(ledger-mode)
|
||||
(if input
|
||||
(insert input)
|
||||
(insert "2012-03-17 Payee\n")
|
||||
(insert " Expenses:Food $20\n")
|
||||
(insert " Assets:Cash\n"))
|
||||
(insert "2012-03-17 Payee\n")
|
||||
(insert " Expenses:Food $20\n")
|
||||
(insert " Assets:Cash\n"))
|
||||
(insert "\ntest reg\n")
|
||||
(if output
|
||||
(insert output))
|
||||
|
|
@ -90,7 +90,7 @@
|
|||
(let ((prev-directory default-directory))
|
||||
(cd ledger-source-directory)
|
||||
(unwind-protect
|
||||
(async-shell-command (format "\"%s\" %s" command args))
|
||||
(async-shell-command (format "\"%s\" %s" command args))
|
||||
(cd prev-directory)))))))
|
||||
|
||||
(provide 'ldg-test)
|
||||
|
|
|
|||
|
|
@ -94,17 +94,17 @@
|
|||
(if (string-match "\\$LEDGER" command)
|
||||
(replace-match (format "%s -f \"%s\" %s" ledger-path
|
||||
data-file ledger-normalization-args) t t command)
|
||||
(concat (format "%s -f \"%s\" %s " ledger-path
|
||||
data-file ledger-normalization-args) command)))
|
||||
(concat (format "%s -f \"%s\" %s " ledger-path
|
||||
data-file ledger-normalization-args) command)))
|
||||
|
||||
(defun ledger-texi-invoke-command (command)
|
||||
(with-temp-buffer (shell-command command t (current-buffer))
|
||||
(if (= (point-min) (point-max))
|
||||
(progn
|
||||
(push-mark nil t)
|
||||
(message "Command '%s' yielded no result at %d" command (point))
|
||||
(ding))
|
||||
(buffer-string))))
|
||||
(if (= (point-min) (point-max))
|
||||
(progn
|
||||
(push-mark nil t)
|
||||
(message "Command '%s' yielded no result at %d" command (point))
|
||||
(ding))
|
||||
(buffer-string))))
|
||||
|
||||
(defun ledger-texi-write-test-data (name input)
|
||||
(let ((path (expand-file-name name temporary-file-directory)))
|
||||
|
|
@ -149,7 +149,7 @@
|
|||
|
||||
(let ((section-name (if (string= section "smex")
|
||||
"smallexample"
|
||||
"example"))
|
||||
"example"))
|
||||
(output (ledger-texi-invoke-command
|
||||
(ledger-texi-expand-command command data-file))))
|
||||
(insert "@" section-name ?\n output
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue