Added raw copies of my custom ledger scripts and elisp additions. Next need to isolate features and make them more generic for reuse by other Ledger users.

1 files changed, 212 insertions, 0 deletions

diff --git a/contrib/raw/ledger-matching.el b/contrib/raw/ledger-matching.el
new file mode 100644
index 00000000..d12c3937
--- /dev/null
+++ b/contrib/raw/ledger-matching.el
@@ -0,0 +1,212 @@
+;; 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)