;; This library is intended to allow me to view a receipt on one panel, and tie it to ledger transactions in another (require 'ledger-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*)) ;; Just do the project for now. (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) (message "Filed %s to project %s" ledger-matching-image-name ledger-matching-project))) (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)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Items below are speed entry macros, and should eventually migrate to their own file. (defvar *ledger-expense-shortcut-ER* "Current expense report number, just last four digits (ie: 1234 results in AISER1234).") (defvar *ledger-expense-shortcut-split-ER* "Split (ie: internal) expense report number, just last four digits (ie: 1234 results in AISER1234).") (defvar *ledger-expense-shortcut-Proj* "" "Current export report project code (ie: AGIL1292)") (defun ledger-expense-shortcut-ER-format-specifier () *ledger-expense-shortcut-ER*) (defun ledger-expense-shortcut-Project-format-specifier () *ledger-expense-shortcut-Proj*) (defun ledger-expense-shortcut-setup (ER Split Proj) "Sets the variables expanded into the transaction." (interactive "MER Number (ER or IN and 4 digit number only): \nMSplit ER Number (ER or IN and 4 digit number only): \nMProject: ") (setq *ledger-expense-shortcut-ER* (concatenate 'string "AIS" ER)) (setq *ledger-expense-shortcut-split-ER* (concatenate 'string "AIS" Split)) (setq *ledger-expense-shortcut-Proj* Proj) (setq ledger-matching-project Proj) (message "Set Proj to %s and ER to %s, split to %s" *ledger-expense-shortcut-Proj* *ledger-expense-shortcut-ER* *ledger-expense-shortcut-split-ER*)) (defun ledger-expense-shortcut () "Updates the ER and Project metadata with the current values of the shortcut variables." (interactive) (when (eq major-mode 'ledger-mode) (if (or (eql *ledger-expense-shortcut-ER* "") (eql *ledger-expense-shortcut-Proj* "")) (message "Run ledger-expense-shortcut-setup first.") (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*))))) (defun ledger-expense-split () "Splits the current transaction between internal and projects." (interactive) (when (eq major-mode 'ledger-mode) ; I made this local now, should only trigger in ldg-mode (save-excursion (end-of-line) (re-search-backward "^[0-9]\\{4\\}/") (re-search-forward "^ +Dest:Projects") (move-beginning-of-line nil) (let ((begin (point)) (end (re-search-forward "^$"))) (goto-char end) (insert (buffer-substring begin end)) (goto-char end) (re-search-forward "^ Dest:Projects") (replace-match " Dest:Internal") (re-search-forward "; ER: +[A-Za-z0-9]+") (replace-match (concat "; ER: " *ledger-expense-shortcut-split-ER*) t) (when (re-search-forward "; CATEGORY: Meals" (save-excursion (re-search-forward "^$")) t) (replace-match "; CATEGORY: Travel" t)))) (re-search-backward "^[0-9]\\{4\\}/") (re-search-forward "^ +Dest:Projects") (insert-string " $") )) (defun ledger-expense-internal () "Makes the expense an internal one." (interactive) (when (eq major-mode 'ledger-mode) ; I made this local now, should only trigger in ldg-mode (save-excursion (end-of-line) (re-search-backward "^[0-9]\\{4\\}/") (let ((begin (point)) (end (save-excursion (re-search-forward "^$")))) (when (re-search-forward "^ Dest:Projects" end t) (replace-match " Dest:Internal") ) (when (re-search-forward "; CATEGORY: Meals" (save-excursion (re-search-forward "^$")) t) (replace-match "; CATEGORY: Travel" t)))))) (defun ledger-expense-personal () "Makes the expense an personal one, eliminating metadata and receipts." (interactive) (when (eq major-mode 'ledger-mode) ; I made this local now, should only trigger in ldg-mode (save-excursion (end-of-line) (re-search-backward "^[0-9]\\{4\\}/") (let ((begin (point)) (end (save-excursion (re-search-forward "^$")))) (when (re-search-forward "^ Dest:Projects" end t) (replace-match " Other:Personal")) (goto-char begin) (save-excursion (when (re-search-forward "^ +; ER:" end t) (beginning-of-line) (kill-line 1))) (save-excursion (when (re-search-forward "^ +; PROJECT:" end t) (beginning-of-line) (kill-line 1))) (save-excursion (when (re-search-forward "^ +; CATEGORY:" end t) (beginning-of-line) (kill-line 1))) (save-excursion (when (re-search-forward "^ +; RECEIPT:" end t) (beginning-of-line) (kill-line 1))) (ledger-toggle-current-entry))))) (defun ledger-expense-show-receipt () "Uses the Receipt buffer to show the receipt of the txn we're on." (when (eq major-mode 'ledger-mode) ; I made this local now, should only trigger in ldg-mode (save-excursion (end-of-line) (re-search-backward "^[0-9]\\{4\\}/") (let ((begin (point)) (end (save-excursion (re-search-forward "^$")))) (save-excursion (when (re-search-forward "^\\( +; RECEIPT: +\\)\\([^,]+?.jpg\\).*$" end t) (ledger-matching-display-image (concat "/home/adamsrl/AdamsInfoServ/BusinessDocuments/Ledger/AdamsRussell/" (match-string 2))) )))))) (provide 'ledger-matching)