1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
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)
|
