212 lines
7.5 KiB
EmacsLisp
212 lines
7.5 KiB
EmacsLisp
;; This library is intended to allow me to view a receipt on one panel, and tie it to ledger transactions in another
|
|
|
|
(require 'ldg-report)
|
|
|
|
(defgroup ledger-matching nil
|
|
"Ledger image matching")
|
|
|
|
(defcustom ledger-matching-sourcedir "~/AdamsInfoServ/BusinessDocuments/Ledger/Incoming"
|
|
"Source directory for images to process, ie: the incoming queue of images."
|
|
:group 'ledger-matching)
|
|
|
|
(defcustom ledger-matching-destdir "~/AdamsInfoServ/BusinessDocuments/Ledger/AdamsRussell/Receipts"
|
|
"Destination directory for images when matched, will still have a project directory appended to it."
|
|
:group 'ledger-matching)
|
|
|
|
(defcustom ledger-matching-relative-receipt-dir "Receipts"
|
|
"Relative directory root for destination images used in Ledger entries, will have the project directory appended and receipt filename."
|
|
:group 'ledger-matching)
|
|
|
|
(defcustom ledger-matching-convert-binary "/usr/bin/convert"
|
|
"Path to the Imagemagick convert command."
|
|
:group 'ledger-matching)
|
|
|
|
(defcustom ledger-matching-scale 50
|
|
"Scaling parameter to Imagemagick's convert to resize an image for viewing."
|
|
:group 'ledger-matching)
|
|
|
|
(defcustom ledger-matching-rotation 0
|
|
"Rotation parameter to Imagemagick's convert to rotate an image for viewing. Images on disk should always be upright for reading."
|
|
:group 'ledger-matching)
|
|
|
|
|
|
(defconst ledger-matching-image-buffer "*Receipt*"
|
|
"Buffer name we load images into. Created if it doesn't exist, and persists across image loads.")
|
|
|
|
|
|
(defvar ledger-matching-project "Internal"
|
|
"The directory appended to the destination for the project code where receipts will be stored.")
|
|
|
|
(defvar ledger-matching-image-offset 0
|
|
"The index of the current file from the SORTED source directory contents.")
|
|
|
|
(defvar ledger-matching-image-name nil
|
|
"The filename only of the current image.")
|
|
|
|
|
|
(defun ledger-matching-display-image (image-filename)
|
|
"Resize the image and load it into our viewing buffer."
|
|
|
|
;; Create our viewing buffer if needed, and set it. Do NOT switch,
|
|
;; this buffer isn't the primary. Let the user leave it where they
|
|
;; place it.
|
|
(unless (get-buffer ledger-matching-image-buffer)
|
|
(get-buffer-create ledger-matching-image-buffer))
|
|
(set-buffer ledger-matching-image-buffer)
|
|
(erase-buffer)
|
|
(goto-char (point-min))
|
|
(insert-string image-filename "\n")
|
|
|
|
;; Convert the source to the temporary dest applying resizing and rotation
|
|
(let* ((source (expand-file-name image-filename ledger-matching-sourcedir))
|
|
(dest (make-temp-file "ledger-matching-" nil ".jpg"))
|
|
(result (call-process ledger-matching-convert-binary nil (get-buffer "*Messages*") nil
|
|
source
|
|
"-scale" (concat (number-to-string ledger-matching-scale) "%")
|
|
"-rotate" (number-to-string ledger-matching-rotation)
|
|
dest)))
|
|
|
|
(if (/= 0 result)
|
|
|
|
;; Bomb out if the convert fails
|
|
(message "Error running convert, see *Messages* buffer for details.")
|
|
|
|
;; Insert scaled image into the viewing buffer, replacing
|
|
;; current contents Temp buffer is to force sync reading into
|
|
;; memory of the jpeg due to async race condition with display
|
|
;; and file deletion
|
|
(let ((image (create-image (with-temp-buffer
|
|
(insert-file-contents-literally dest)
|
|
(string-as-unibyte (buffer-string)))
|
|
'jpeg t)))
|
|
(insert-image image)
|
|
(goto-char (point-min))
|
|
|
|
;; Redisplay is required to prevent a race condition between displaying the image and the deletion. Apparently its async.
|
|
;; Either redisplay or the above string method work, both together can't hurt.
|
|
(redisplay)
|
|
))
|
|
|
|
;; Delete our temporary file
|
|
(delete-file dest)))
|
|
|
|
|
|
|
|
(defun ledger-matching-update-current-image ()
|
|
"Grab the image from the source directory by offset and display"
|
|
|
|
(let* ((file-listing (directory-files ledger-matching-sourcedir nil "\.jpg$" nil))
|
|
(len (safe-length file-listing)))
|
|
|
|
;; Ensure our offset doesn't exceed the file list
|
|
(cond ((= len 0)
|
|
(message "No files found in source directory."))
|
|
|
|
((< len 0)
|
|
(message "Error, list of files should never be negative. Epic fail."))
|
|
|
|
((>= ledger-matching-image-offset len)
|
|
(message "Hit end of list. Last image.")
|
|
(setq ledger-matching-image-offset (1- len)))
|
|
|
|
((< ledger-matching-image-offset 0)
|
|
(message "Beginning of list. First image.")
|
|
(setq ledger-matching-image-offset 0)))
|
|
|
|
;; Get the name for the offset
|
|
(setq ledger-matching-image-name (nth ledger-matching-image-offset file-listing))
|
|
|
|
(ledger-matching-display-image ledger-matching-image-name)))
|
|
|
|
|
|
|
|
(defun ledger-matching-image-offset-adjust (amount)
|
|
"Incr/decr the offset and update the receipt buffer."
|
|
|
|
(setq ledger-matching-image-offset (+ ledger-matching-image-offset amount))
|
|
(ledger-matching-update-current-image))
|
|
|
|
|
|
|
|
(defun ledger-receipt-matching ()
|
|
"Open the receipt buffer and start with the first image."
|
|
(interactive)
|
|
(setq ledger-matching-image-offset 0)
|
|
(ledger-matching-update-current-image))
|
|
|
|
|
|
|
|
(defun ledger-matching-tie-receipt-to-txn ()
|
|
(interactive)
|
|
(save-selected-window
|
|
(ledger-report-visit-source)
|
|
|
|
;; Assumes we're in a narrowed buffer with ONLY this txn
|
|
(backward-paragraph)
|
|
(beginning-of-line)
|
|
|
|
;; Update the ER and Project while I'm there
|
|
(save-excursion
|
|
(search-forward "; ER:")
|
|
(kill-line nil)
|
|
(insert " " *ledger-expense-shortcut-ER*))
|
|
(save-excursion
|
|
(search-forward "; PROJECT:")
|
|
(kill-line nil)
|
|
(insert " " *ledger-expense-shortcut-Proj*))
|
|
|
|
;; Goto the receipt line, unless their isn't one then add one
|
|
(unless (search-forward "RECEIPT:" nil t)
|
|
|
|
;; Still at date line if that failed
|
|
(next-line)
|
|
(newline)
|
|
(insert-string " ; RECEIPT:"))
|
|
|
|
;; Point immediately after : on tag
|
|
|
|
;; Check for existing jpg file
|
|
(if (search-forward ".jpg" (line-end-position) t)
|
|
|
|
;; if present make it a comma delimited list
|
|
(insert-string ",")
|
|
|
|
;; otherwise just add a space to pad
|
|
(insert-string " "))
|
|
|
|
;; Add our relative filename as the value of the RECEIPT tag
|
|
(insert-string (concat ledger-matching-relative-receipt-dir "/"
|
|
ledger-matching-project "/"
|
|
ledger-matching-image-name))
|
|
|
|
;; Create the destination project dir if it doesn't exist.
|
|
(let ((full-destination (concat ledger-matching-destdir "/" ledger-matching-project )))
|
|
(unless (file-accessible-directory-p full-destination)
|
|
(make-directory full-destination t)))
|
|
|
|
;; Rename the file from the source directory to its permanent home
|
|
(rename-file (concat ledger-matching-sourcedir "/"
|
|
ledger-matching-image-name)
|
|
(concat ledger-matching-destdir "/"
|
|
ledger-matching-project "/"
|
|
ledger-matching-image-name))
|
|
|
|
;; Update the receipt screen
|
|
(ledger-matching-update-current-image) ))
|
|
|
|
|
|
|
|
(defun ledger-receipt-skip ()
|
|
"Move the current image to the Skip directory because its not relevant."
|
|
|
|
(rename-file (concat ledger-matching-sourcedir "/"
|
|
ledger-matching-image-name)
|
|
(concat ledger-matching-sourcedir "/Skip/"
|
|
ledger-matching-image-name))
|
|
|
|
;; Update the receipt screen at the same offset
|
|
(ledger-matching-update-current-image))
|
|
|
|
|
|
|
|
(provide 'ledger-matching)
|