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

Lots of code cleanup. (if () (progn …) ==> (when () …) all over the place

Browse source
This commit is contained in:
Craig Earls 2013-03-25 01:21:19 -04:00
parent cc62e6a886
commit d3fe4c666f
12 changed files with 156 additions and 186 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
lisp/ldg-commodities.el
View file

@ -50,7 +50,7 @@
(string-to-number
(ledger-commodity-string-number-decimalize
(delete-and-extract-region (match-beginning 0) (match-end 0)) :from-user))
(nth 0 (split-string (buffer-substring (point-min) (point-max))))))
(nth 0 (split-string (buffer-substring-no-properties (point-min) (point-max))))))
((re-search-forward "0" nil t)
;; couldn't find a decimal number, look for a single 0,
;; indicating account with zero balance

11
lisp/ldg-complete.el
View file

@ -19,9 +19,6 @@
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
;; MA 02111-1307, USA.
;;(require 'esh-util)
;;(require 'esh-arg)
;;; Commentary:
;; Functions providing payee and account auto complete.
@ -126,8 +123,8 @@ Return tree structure"
(if (null current-prefix-arg)
(ledger-payees-in-buffer) ;; this completes against payee names
(progn
(let ((text (buffer-substring (line-beginning-position)
(line-end-position))))
(let ((text (buffer-substring-no-properties (line-beginning-position)
(line-end-position))))
(delete-region (line-beginning-position)
(line-end-position))
(condition-case err
@ -154,7 +151,7 @@ Does not use ledger xact"
;; Search backward for a matching payee
(when (re-search-backward
(concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.*"
(regexp-quote name) ".*\\)" ) nil t) ;; "\\(\t\\|\n\\| [ \t]\\)"
(regexp-quote name) ".*\\)" ) nil t)
(setq rest-of-name (match-string 3))
;; Start copying the postings
(forward-line)
@ -180,7 +177,7 @@ Does not use ledger xact"
(defun ledger-pcomplete (&optional interactively)
"Complete rip-off of pcomplete from pcomplete.el, only added
ledger-magic-tab in the previos commads list so that
ledger-magic-tab in the previous commands list so that
ledger-magic-tab would cycle properly"
(interactive "p")
(if (and interactively

31
lisp/ldg-exec.el
View file

@ -53,7 +53,7 @@
(with-current-buffer ledger-output-buffer
(goto-char (point-min))
(if (and (> (buffer-size) 1) (looking-at (regexp-quote "While")))
nil
nil ;; failure, there is an error starting with "While"
ledger-output-buffer)))
(defun ledger-exec-ledger (input-buffer &optional output-buffer &rest args)
@ -77,27 +77,24 @@
(defun ledger-version-greater-p (needed)
"Verify the ledger binary is usable for `ledger-mode' (version greater than NEEDED)."
(let ((buffer ledger-buf)
(version-strings '())
(version-number))
(version-strings '()))
(with-temp-buffer
(if (ledger-exec-ledger (current-buffer) (current-buffer) "--version")
(progn
(goto-char (point-min))
(delete-horizontal-space)
(setq version-strings (split-string
(buffer-substring-no-properties (point)
(point-max))))
(if (and (string-match (regexp-quote "Ledger") (car version-strings))
(or (string= needed (car (cdr version-strings)))
(string< needed (car (cdr version-strings)))))
t
nil))))))
(when (ledger-exec-ledger (current-buffer) (current-buffer) "--version")
(goto-char (point-min))
(delete-horizontal-space)
(setq version-strings (split-string
(buffer-substring-no-properties (point)
(point-max))))
(if (and (string-match (regexp-quote "Ledger") (car version-strings))
(or (string= needed (cadr version-strings))
(string< needed (cadr version-strings))))
t ;; success
nil))))) ;;failure
(defun ledger-check-version ()
"Verify that ledger works and is modern enough."
(interactive)
(setq ledger-works (ledger-version-greater-p ledger-version-needed))
(if ledger-works
(if (setq ledger-works (ledger-version-greater-p ledger-version-needed))
(message "Good Ledger Version")
(message "Bad Ledger Version")))

22
lisp/ldg-init.el
View file

@ -33,16 +33,16 @@
(setq ledger-environment-alist nil)
(goto-char (point-min))
(while (re-search-forward "^--.+?\\($\\|[ ]\\)" nil t )
(let ((matchb (match-beginning 0)) ;; save the match data, string-match stomp on it
(let ((matchb (match-beginning 0)) ;; save the match data, string-match stamp on it
(matche (match-end 0)))
(end-of-line)
(setq ledger-environment-alist
(append ledger-environment-alist
(list (cons (let ((flag (buffer-substring (+ 2 matchb) matche)))
(list (cons (let ((flag (buffer-substring-no-properties (+ 2 matchb) matche)))
(if (string-match "[ \t\n\r]+\\'" flag)
(replace-match "" t t flag)
flag))
(let ((value (buffer-substring matche (point) )))
(let ((value (buffer-substring-no-properties matche (point) )))
(if (> (length value) 0)
value
t))))))))
@ -53,16 +53,12 @@
(let ((init-base-name (file-name-nondirectory ledger-init-file-name)))
(if (get-buffer init-base-name) ;; init file already loaded, parse it and leave it
(ledger-init-parse-initialization init-base-name)
(if (and ;; init file not loaded, load, parse and kill
ledger-init-file-name
(file-exists-p ledger-init-file-name)
(file-readable-p ledger-init-file-name))
(progn
(find-file-noselect ledger-init-file-name)
(ledger-init-parse-initialization init-base-name)
(kill-buffer init-base-name))))))
(when (and ledger-init-file-name
(file-exists-p ledger-init-file-name)
(file-readable-p ledger-init-file-name))
(find-file-noselect ledger-init-file-name)
(ledger-init-parse-initialization init-base-name)
(kill-buffer init-base-name)))))
(provide 'ldg-init)

50
lisp/ldg-occur.el
View file

@ -63,27 +63,24 @@
"Highlight transactions that match REGEX in BUFFER, hiding others.
When REGEX is nil, unhide everything, and remove higlight"
(progn
(set-buffer buffer)
(setq ledger-occur-mode
(if (or (null regex)
(zerop (length regex)))
nil
(concat " Ledger-Narrowed: " regex)))
(force-mode-line-update)
(ledger-occur-remove-overlays)
(if ledger-occur-mode
(let* ((buffer-matches (ledger-occur-find-matches regex))
(ovl-bounds (ledger-occur-create-xact-overlay-bounds buffer-matches)))
(setq ledger-occur-overlay-list
(ledger-occur-create-xact-overlays ovl-bounds))
(setq ledger-occur-overlay-list
(append ledger-occur-overlay-list
(ledger-occur-create-narrowed-overlays buffer-matches)))
(setq ledger-occur-last-match regex)
(if (get-buffer-window buffer)
(select-window (get-buffer-window buffer)))))
(recenter)))
(set-buffer buffer)
(setq ledger-occur-mode
(if (or (null regex)
(zerop (length regex)))
nil
(concat " Ledger-Narrowed: " regex)))
(force-mode-line-update)
(ledger-occur-remove-overlays)
(if ledger-occur-mode
(let* ((buffer-matches (ledger-occur-find-matches regex))
(ovl-bounds (ledger-occur-create-xact-overlay-bounds buffer-matches)))
(setq ledger-occur-overlay-list
(append (ledger-occur-create-xact-overlays ovl-bounds)
(ledger-occur-create-narrowed-overlays buffer-matches)))
(setq ledger-occur-last-match regex)
(if (get-buffer-window buffer)
(select-window (get-buffer-window buffer)))))
(recenter))
(defun ledger-occur (regex)
"Perform a simple grep in current buffer for the regular expression REGEX.
@ -163,12 +160,11 @@ Argument OVL-BOUNDS contains bounds for the transactions to be left visible."
(defun ledger-occur-quit-buffer (buffer)
"Quits hidings transaction in the given BUFFER.
Used for coordinating `ledger-occur' with other buffers, like reconcile."
(progn
(set-buffer buffer)
(setq ledger-occur-mode nil)
(force-mode-line-update)
(ledger-occur-remove-overlays)
(recenter)))
(set-buffer buffer)
(setq ledger-occur-mode nil)
(force-mode-line-update)
(ledger-occur-remove-overlays)
(recenter))
(defun ledger-occur-remove-overlays ()
"Remove the transaction hiding overlays."

2
lisp/ldg-post.el
View file

@ -135,7 +135,7 @@ Return the width of the amount field as an integer."
(match-end 3)) (point))))
(defvar ledger-post-account-regex
(concat "\\(^[ ]+\\)"
(concat "\\(^[ \t]+\\)"
"\\([\\[(*!;a-zA-Z0-9]+?\\)"))
(defun ledger-next-account (&optional end)

117
lisp/ldg-reconcile.el
View file

@ -66,9 +66,10 @@ reconcile-finish will mark all pending posting cleared."
(defun ledger-reconcile-get-cleared-or-pending-balance ()
"Calculate the cleared or pending balance of the account."
(interactive)
(let ((buffer ledger-buf)
(account ledger-acct)
(val nil))
;; these vars are buffer local, need to hold them for use in the
;; temp buffer below
(let ((buffer ledger-buf)
(account ledger-acct))
(with-temp-buffer
;; note that in the line below, the --format option is
;; separated from the actual format string. emacs does not
@ -77,16 +78,15 @@ reconcile-finish will mark all pending posting cleared."
(if (ledger-exec-ledger buffer (current-buffer)
"balance" "--limit" "cleared or pending" "--empty"
"--format" "%(display_total)" account)
(setq val
(ledger-split-commodity-string
(buffer-substring-no-properties (point-min) (point-max))))))))
(ledger-split-commodity-string
(buffer-substring-no-properties (point-min) (point-max)))))))
(defun ledger-display-balance ()
"Display the cleared-or-pending balance.
And calculate the target-delta of the account being reconciled."
(interactive)
(let* ((pending (ledger-reconcile-get-cleared-or-pending-balance)))
(if pending
(when pending
(if ledger-target
(message "Pending balance: %s, Difference from target: %s"
(ledger-commodity-to-string pending)
@ -150,23 +150,21 @@ Return the number of uncleared xacts found."
(interactive)
(let ((inhibit-read-only t))
(erase-buffer)
(prog1 (ledger-do-reconcile)
(set-buffer-modified-p t)
;;(goto-char (point-min))
)))
(prog1
(ledger-do-reconcile)
(set-buffer-modified-p t))))
(defun ledger-reconcile-refresh-after-save ()
"Refresh the recon-window after the ledger buffer is saved."
(let ((curbuf (current-buffer))
(curpoint (point))
(recon-buf (get-buffer ledger-recon-buffer-name)))
(if (buffer-live-p recon-buf)
(progn
(with-current-buffer recon-buf
(ledger-reconcile-refresh)
(set-buffer-modified-p nil))
(select-window (get-buffer-window curbuf))
(goto-char curpoint)))))
(when (buffer-live-p recon-buf)
(with-current-buffer recon-buf
(ledger-reconcile-refresh)
(set-buffer-modified-p nil))
(select-window (get-buffer-window curbuf))
(goto-char curpoint))))
(defun ledger-reconcile-add ()
"Use ledger xact to add a new transaction."
@ -247,7 +245,7 @@ and exit reconcile mode"
(if recon-buf
(with-current-buffer recon-buf
(ledger-reconcile-quit-cleanup)
(set 'buf ledger-buf)
(setq buf ledger-buf)
;; Make sure you delete the window before you delete the buffer,
;; otherwise, madness ensues
(delete-window (get-buffer-window recon-buf))
@ -261,10 +259,9 @@ and exit reconcile mode"
(if (buffer-live-p buf)
(with-current-buffer buf
(remove-hook 'after-save-hook 'ledger-reconcile-refresh-after-save t)
(if ledger-narrow-on-reconcile
(progn
(ledger-occur-quit-buffer buf)
(ledger-highlight-xact-under-point)))))))
(when ledger-narrow-on-reconcile
(ledger-occur-quit-buffer buf)
(ledger-highlight-xact-under-point))))))
(defun ledger-marker-where-xact-is (emacs-xact posting)
"Find the position of the EMACS-XACT in the `ledger-buf'.
@ -285,14 +282,13 @@ POSTING is used in `ledger-clear-whole-transactions' is nil."
(ledger-success nil)
(xacts
(with-temp-buffer
(if (ledger-exec-ledger buf (current-buffer)
"--uncleared" "--real" "emacs" account)
(progn
(setq ledger-success t)
(goto-char (point-min))
(unless (eobp)
(if (looking-at "(")
(read (current-buffer))))))))) ;current-buffer is the *temp* created above
(when (ledger-exec-ledger buf (current-buffer)
"--uncleared" "--real" "emacs" account)
(setq ledger-success t)
(goto-char (point-min))
(unless (eobp)
(if (looking-at "(")
(read (current-buffer)))))))) ;current-buffer is the *temp* created above
(if (and ledger-success (> (length xacts) 0))
(let ((date-format (cdr (assoc "date-format" ledger-environment-alist))))
(dolist (xact xacts)
@ -351,15 +347,15 @@ moved and recentered. If they aren't strange things happen."
(defun ledger-reconcile-track-xact ()
"Force the ledger buffer to recenter on the transaction at point in the reconcile buffer."
(if (member this-command (list 'next-line
'previous-line
'mouse-set-point
'ledger-reconcile-toggle
'end-of-buffer
'beginning-of-buffer))
(if ledger-buffer-tracks-reconcile-buffer
(save-excursion
(ledger-reconcile-visit t)))))
(if (and ledger-buffer-tracks-reconcile-buffer
(member this-command (list 'next-line
'previous-line
'mouse-set-point
'ledger-reconcile-toggle
'end-of-buffer
'beginning-of-buffer)))
(save-excursion
(ledger-reconcile-visit t))))
(defun ledger-reconcile-open-windows (buf rbuf)
"Ensure that the ledger buffer BUF is split by RBUF."
@ -373,33 +369,30 @@ moved and recentered. If they aren't strange things happen."
(interactive)
(let ((account (ledger-post-read-account-with-prompt "Account to reconcile"))
(buf (current-buffer))
(rbuf (get-buffer ledger-recon-buffer-name))) ;; this means
;; only one
;; *Reconcile*
;; buffer, ever
;; Set up the reconcile buffer
(if rbuf ;; *Reconcile* already exists
(rbuf (get-buffer ledger-recon-buffer-name)))
;; this means only one *Reconcile* buffer, ever Set up the
;; reconcile buffer
(if rbuf ;; *Reconcile* already exists
(with-current-buffer rbuf
(set 'ledger-acct account) ;; already buffer local
(if (not (eq buf rbuf))
(progn ;; called from some other ledger-mode buffer
(ledger-reconcile-quit-cleanup)
(set 'ledger-buf buf))) ;; should already be
;; buffer-local
(set 'ledger-acct account) ;; already buffer local
(when (not (eq buf rbuf))
;; called from some other ledger-mode buffer
(ledger-reconcile-quit-cleanup)
(set 'ledger-buf buf)) ;; should already be buffer-local
(unless (get-buffer-window rbuf)
(ledger-reconcile-open-windows buf rbuf)))
(progn ;; no recon-buffer, starting from scratch.
(add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t)
(with-current-buffer (setq rbuf
(get-buffer-create ledger-recon-buffer-name))
(ledger-reconcile-open-windows buf rbuf)
(ledger-reconcile-mode)
(make-local-variable 'ledger-target)
(set (make-local-variable 'ledger-buf) buf)
(set (make-local-variable 'ledger-acct) account))))
;; no recon-buffer, starting from scratch.
(add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t)
(with-current-buffer (setq rbuf
(get-buffer-create ledger-recon-buffer-name))
(ledger-reconcile-open-windows buf rbuf)
(ledger-reconcile-mode)
(make-local-variable 'ledger-target)
(set (make-local-variable 'ledger-buf) buf)
(set (make-local-variable 'ledger-acct) account)))
;; Narrow the ledger buffer
(with-current-buffer rbuf

53
lisp/ldg-report.el
View file

@ -30,8 +30,7 @@
(defgroup ledger-report nil
"Customization option for the Report buffer"
:group 'ledger
)
:group 'ledger)
(defcustom ledger-reports
'(("bal" "ledger -f %(ledger-file) bal")
@ -319,18 +318,17 @@ Optional EDIT the command."
(let ((file (match-string 1))
(line (string-to-number (match-string 2))))
(delete-region (match-beginning 0) (match-end 0))
(if file
(progn
(set-text-properties (line-beginning-position) (line-end-position)
(list 'ledger-source (cons file (save-window-excursion
(save-excursion
(find-file file)
(widen)
(ledger-goto-line line)
(point-marker))))))
(add-text-properties (line-beginning-position) (line-end-position)
(list 'face 'ledger-font-report-clickable-face))
(end-of-line))))))
(when file
(set-text-properties (line-beginning-position) (line-end-position)
(list 'ledger-source (cons file (save-window-excursion
(save-excursion
(find-file file)
(widen)
(ledger-goto-line line)
(point-marker))))))
(add-text-properties (line-beginning-position) (line-end-position)
(list 'face 'ledger-font-report-clickable-face))
(end-of-line)))))
(goto-char data-pos)))
@ -340,20 +338,19 @@ Optional EDIT the command."
(let* ((prop (get-text-property (point) 'ledger-source))
(file (if prop (car prop)))
(line-or-marker (if prop (cdr prop))))
(if (and file line-or-marker)
(progn
(find-file-other-window file)
(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)))))))
(when (and file line-or-marker)
(find-file-other-window file)
(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))))))
(defun ledger-report-goto ()
"Goto the ledger report buffer."

2
lisp/ldg-schedule.el
View file

@ -223,7 +223,7 @@ returns true if the date meets the requirements"
;; read the descriptor string into a lisp object the transform the
;; string descriptor into useable things
(ledger-transform-auto-tree
(read (buffer-substring (point-min) (point-max))))))
(read (buffer-substring-no-properties (point-min) (point-max))))))
(defun ledger-transform-auto-tree (tree)
"Takes a lisp list of date descriptor strings, TREE, and returns a string with a lambda function of date."

32
lisp/ldg-sort.el
View file

@ -47,26 +47,22 @@
(match-end 0)))
(defun ledger-sort-insert-start-mark ()
(interactive)
(let (has-old-marker)
(save-excursion
(goto-char (point-min))
(setq has-old-marker (ledger-sort-find-start))
(if has-old-marker
(delete-region (match-beginning 0) (match-end 0))))
(beginning-of-line)
(insert "\n; Ledger-mode: Start sort\n\n")))
(interactive)
(save-excursion
(goto-char (point-min))
(if (ledger-sort-find-start)
(delete-region (match-beginning 0) (match-end 0))))
(beginning-of-line)
(insert "\n; Ledger-mode: Start sort\n\n"))
(defun ledger-sort-insert-end-mark ()
(interactive)
(let (has-old-marker)
(save-excursion
(goto-char (point-min))
(setq has-old-marker (ledger-sort-find-end))
(if has-old-marker
(delete-region (match-beginning 0) (match-end 0))))
(beginning-of-line)
(insert "\n; Ledger-mode: End sort\n\n")))
(interactive)
(save-excursion
(goto-char (point-min))
(if (ledger-sort-find-end)
(delete-region (match-beginning 0) (match-end 0))))
(beginning-of-line)
(insert "\n; Ledger-mode: End sort\n\n"))
(defun ledger-sort-region (beg end)
"Sort the region from BEG to END in chronological order."

7
lisp/ldg-state.el
View file

@ -245,10 +245,9 @@ dropped."
(eq (ledger-state-from-char (char-after)) 'cleared))
(progn
(delete-char 1)
(if (and style (eq style 'cleared))
(progn
(insert " *")
(setq status 'cleared))))
(when (and style (eq style 'cleared))
(insert " *")
(setq status 'cleared)))
(if (and style (eq style 'pending))
(progn
(insert " ! ")

13
lisp/ldg-xact.el
View file

@ -44,12 +44,10 @@ within the transaction."
(backward-paragraph)
(if (/= (point) (point-min))
(forward-line))
(beginning-of-line)
(setq beg-pos (point))
(setq beg-pos (line-beginning-position))
(forward-paragraph)
(forward-line -1)
(end-of-line)
(setq end-pos (1+ (point)))
(setq end-pos (1+ (line-end-position)))
(list beg-pos end-pos))))
@ -80,11 +78,12 @@ within the transaction."
(defsubst ledger-goto-line (line-number)
"Rapidly move point to line LINE-NUMBER."
(goto-char (point-min)) (forward-line (1- line-number)))
(goto-char (point-min))
(forward-line (1- line-number)))
(defun ledger-thing-at-point ()
"Describe thing at points. Return 'transaction, 'posting, or nil."
(let ((here (point)))
(let ((here (point)))
(goto-char (line-beginning-position))
(cond ((looking-at "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.+?)\\)?\\s-+")
(goto-char (match-end 0))
@ -105,7 +104,7 @@ within the transaction."
(concat ledger-year "/" ledger-month "/") 'ledger-minibuffer-history)))
(let* ((here (point))
(extents (ledger-find-xact-extents (point)))
(transaction (buffer-substring (car extents) (cadr extents)))
(transaction (buffer-substring-no-properties (car extents) (cadr extents)))
encoded-date)
(if (string-match ledger-date-regex date)
(setq encoded-date