Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 889 lines (782 sloc) 35.766 kB
b8e8873 @tarsius follow header conventions
tarsius authored
1 ;;; org-bom.el --- Collect components across the entire org buffer
2
8112c83 @Frozenlock Initial commit - V0.3
authored
3 ; Copyright 2011 Free Software Foundation, Inc.
4 ;
5 ; Filename: org-bom.el
655caaa @tarsius delete trailing whitespace
tarsius authored
6 ; Version: 0.4
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
7 ; Author: Christian Fortin <frozenlock@gmail.com>
8112c83 @Frozenlock Initial commit - V0.3
authored
8 ; Keywords: org, bill-of-materials, collection, tables
9 ; Description: Create a bill-of-materials (bom) of the entire org buffer
10 ;
11 ; This program is free software: you can redistribute it and/or modify
12 ; it under the terms of the GNU General Public License as published by
13 ; the Free Software Foundation, either version 3 of the License, or
14 ; (at your option) any later version.
15 ;
16 ; This program is distributed in the hope that it will be useful,
17 ; but WITHOUT ANY WARRANTY without even the implied warranty of
18 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ; GNU General Public License for more details.
20 ;
21 ; You should have received a copy of the GNU General Public License
22 ; along with this program. If not, see <http://www.gnu.org/licenses/>.
b8e8873 @tarsius follow header conventions
tarsius authored
23
8112c83 @Frozenlock Initial commit - V0.3
authored
24 ;=====================================================
25 ; The program begins here
26 ;=====================================================
27
b8e8873 @tarsius follow header conventions
tarsius authored
28 ;;; Code:
29
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
30 (require 'cl)
8112c83 @Frozenlock Initial commit - V0.3
authored
31 (require 'org)
32 (require 'org-table)
33 (require 'gnus-util)
34
35 ;========== Global variable section ==========
36
37 (defvar org-bom-database nil
38 "Global variable used to build a database of the components used, as
655caaa @tarsius delete trailing whitespace
tarsius authored
39 well as their section, tags and quantity.")
8112c83 @Frozenlock Initial commit - V0.3
authored
40
41 (defvar org-bom-details nil
42 "Need to be given by the user. A suggested use is to bind it to
43 a local user's database. Should be a plist with at least \":name\" and
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
44 \":description\". It should also contain \":datasheetPdf\" in order
655caaa @tarsius delete trailing whitespace
tarsius authored
45 to use the bom-datasheet dynamic block.")
8112c83 @Frozenlock Initial commit - V0.3
authored
46
47 (defvar org-bom-update-enable t
48 "Scan the buffer and update the BOM when a dynamic block is
49 refreshed. Should be set to nil for a buffer-wide dynamic block,
50 such as with `org-update-all-dblocks'. However, be sure to update
655caaa @tarsius delete trailing whitespace
tarsius authored
51 manually with `org-bom-total' in this case.")
8112c83 @Frozenlock Initial commit - V0.3
authored
52
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
53 (defcustom org-bom-latex-mode nil
54 "If activated, every component's name will be replaced by a
55 reference to the datasheet and comments might be activated if
56 necessary (large number of tags). See `org-bom-latex-max-tags'.
57 Requires LaTeX package PDFCOMMENT, PDFPAGES and HYPERREF."
58 :type 'boolean
59 :group 'org-bom)
8112c83 @Frozenlock Initial commit - V0.3
authored
60
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
61 (defcustom org-bom-latex-max-tags 10
8112c83 @Frozenlock Initial commit - V0.3
authored
62 "Define the maximum number before the tags start being hidden in a
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
63 PDF comment. Set to nil to disable."
64 :type 'integer
65 :group 'org-bom)
8112c83 @Frozenlock Initial commit - V0.3
authored
66
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
67 (defcustom org-bom-latex-datasheetPath ""
68 "Default path to your datasheet."
69 :type 'string
70 :group 'org-bom)
8112c83 @Frozenlock Initial commit - V0.3
authored
71
72 ;========== Database section ==========
73
655caaa @tarsius delete trailing whitespace
tarsius authored
74 (defun org-bom-add-component (comp)
8112c83 @Frozenlock Initial commit - V0.3
authored
75 (push comp org-bom-database))
76
77 (defstruct component name section quantity tag)
78
79 (defun org-bom-select-in-db (database selector-fn value &optional remove part-match)
80 "Return every entry in the database which has the corresponding
81 value for a given selector. Can be the DATABASE's argument of
82 itself in case of multiple SELECTOR-FN. The SELECTOR-FN must be
83 the quoted function, such as 'component-name. If REMOVE is
84 non-nil, every entry with a match will be discarded rather than
85 keeped. If PART-MATCH is non-nil, `string-match' function is used
86 instead of `gnus-string-equal'."
87 (when (atom value)
88 (setf value (list value)))
89 (let ((temp-results database)
90 (results nil))
91 (dolist (current-value value)
92 (setf temp-results
655caaa @tarsius delete trailing whitespace
tarsius authored
93 (funcall (if remove 'remove-if 'remove-if-not)
8112c83 @Frozenlock Initial commit - V0.3
authored
94 #'(lambda (component)
95 (let ((current-component (funcall selector-fn component)))
96 (if (numberp current-component);if it's a component quantity
97 (equal current-component current-value)
98 (if part-match (string-match current-value current-component)
655caaa @tarsius delete trailing whitespace
tarsius authored
99 (gnus-string-equal current-component current-value)))))
8112c83 @Frozenlock Initial commit - V0.3
authored
100 (if remove temp-results database)))
101 (unless remove (setf results (append results temp-results)))); cumulate the results
102 (when remove (setf results temp-results))
103 (org-bom-sort results)))
655caaa @tarsius delete trailing whitespace
tarsius authored
104
8112c83 @Frozenlock Initial commit - V0.3
authored
105 (defun org-bom-check-and-push-to-db (name section quantity tag)
106 "Check if the combo name-section is already in the database. If it
655caaa @tarsius delete trailing whitespace
tarsius authored
107 is, add the quantity and the tag, otherwise create a new entry."
8112c83 @Frozenlock Initial commit - V0.3
authored
108 (let ((exists-flag nil))
109 (dolist (temp-car-db org-bom-database) ;For every item in the database...
655caaa @tarsius delete trailing whitespace
tarsius authored
110 (when (and (gnus-string-equal (component-name temp-car-db)
111 name)
112 (gnus-string-equal (component-section temp-car-db)
8112c83 @Frozenlock Initial commit - V0.3
authored
113 section))
655caaa @tarsius delete trailing whitespace
tarsius authored
114 (setf (component-quantity temp-car-db)
8112c83 @Frozenlock Initial commit - V0.3
authored
115 (+ (component-quantity temp-car-db) quantity)) ; if the combo name-section exists, simply add the quantity
655caaa @tarsius delete trailing whitespace
tarsius authored
116 (setf (component-tag temp-car-db)
8112c83 @Frozenlock Initial commit - V0.3
authored
117 (append tag (component-tag temp-car-db)))
118 (setf exists-flag t))) ; set the exist flag t
119 (if (not exists-flag) (org-bom-add-component (make-component :name name ; if it's a new component (in the section), then add it in the database
120 :section section
121 :quantity quantity
655caaa @tarsius delete trailing whitespace
tarsius authored
122 :tag tag)))))
8112c83 @Frozenlock Initial commit - V0.3
authored
123
124 ;========== End of database section ==========
125
655caaa @tarsius delete trailing whitespace
tarsius authored
126 (defun org-bom-total (&optional section-override)
8112c83 @Frozenlock Initial commit - V0.3
authored
127 "Go to every tables in the buffer and get info from them."
128 (interactive)
129 (save-excursion
130 (save-restriction
131 (setq org-bom-database nil) ; Reset the database before each new buffer-wide scan
132 (widen)
133 (org-bom-prepare-linedata-for-database section-override) ;scan for line items
655caaa @tarsius delete trailing whitespace
tarsius authored
134 (org-table-map-tables (lambda () (org-bom-prepare-tabledata-for-database
8112c83 @Frozenlock Initial commit - V0.3
authored
135 section-override)) t)
655caaa @tarsius delete trailing whitespace
tarsius authored
136 (setq org-bom-database
8112c83 @Frozenlock Initial commit - V0.3
authored
137 (org-bom-sort org-bom-database))))
138 (message "org-bom-total"))
139
140 (defun org-bom-sort (database)
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
141 "Return the DATABASE sorted alphabetically by component name"
8112c83 @Frozenlock Initial commit - V0.3
authored
142 (sort database ;sort in alphabetical order
655caaa @tarsius delete trailing whitespace
tarsius authored
143 (lambda (arg1 arg2)
8112c83 @Frozenlock Initial commit - V0.3
authored
144 (gnus-string< (component-name arg1)
145 (component-name arg2)))))
146
147 (defun org-bom-get-keyword-column-numbers ()
655caaa @tarsius delete trailing whitespace
tarsius authored
148 "Return a list of plists composed of \"components\", \"qty\",
8112c83 @Frozenlock Initial commit - V0.3
authored
149 \"tag\" and \"section\" column numbers."
150 (org-table-get-specials)
151 (let ((column-names org-table-column-names)
152 results
153 component-col
154 qty-col
155 tag-col
156 section-col
157 new-section-col
655caaa @tarsius delete trailing whitespace
tarsius authored
158 (push-the-list '(push (list :name component-col
159 :qty qty-col
160 :tag tag-col
8112c83 @Frozenlock Initial commit - V0.3
authored
161 :section section-col) results)))
162 (while column-names
163 (let* ((temp-name (pop column-names))
164 (name (car temp-name))
165 (ncolumn (string-to-number (cdr (last temp-name)))))
166 (when (string-match "section" name)
167 (setq new-section-col ncolumn))
168 (when (string-match "component" name)
169 (when component-col ;test if it's the first component column
170 (eval push-the-list));when new component, we know there's no further tag or qty
171 (setq qty-col nil tag-col nil);set them all to nil
172 (setq component-col ncolumn)
173 (setq section-col (or new-section-col section-col))
174 (setq new-section-col nil))
175 (when (string-match "qty" name)
176 (push ncolumn qty-col))
177 (when (string-match "tag" name)
178 (push ncolumn tag-col))))
179 (eval push-the-list)
180 results))
181
182 (defun org-bom-after-header-line ()
183 "Go to and return the position of the first non-header line."
184 (let ((beg (org-table-begin))
185 (end (org-table-end)))
186 (goto-char beg)
187 (if (and (re-search-forward org-table-dataline-regexp end t)
188 (re-search-forward org-table-hline-regexp end t)
189 (re-search-forward org-table-dataline-regexp end t))
190 (match-beginning 0))))
191
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
192 (defun org-bom-transfer ()
193 "Scan the buffer for an org-mode comment \"#+BOM-XFER:\".
194 Everything before the
195 keys (:FROM-SECTION, :TO-SECTION, :PART-MATCH, :EVERYTHING) is
196 considered to be the component's name, except the last
197 whitespaces. The only required key is the :TO-SECTION. It
198 specifies in which section the component must be sent.
199 Unless :FROM-SECTION is provided, the section from which to
200 transfer the components will be following the same rule as
201 `org-bom-prepare-tabledata-for-database'. A :PART-MATCH argument
202 can be provided and follows the same rule as
203 `org-bom-select-in-db' for the section selection. To disregard
204 the :FROM-SECTION altogether and simply take every instance of a
205 component in the entire database, provide :EVERYTHING non-nil."
206 (save-excursion
207 (goto-char (point-min))
208 (while (re-search-forward "^[ \t]*#\\+BOM-XFER:[ \t]+\\([^:\n]+\\)\\(.*\\)?" nil t)
209 (let* ((name (org-no-properties (match-string 1)))
210 (params (read (concat "(" (match-string 2) ")")))
211 (from-section (or (plist-get params :from-section) (org-bom-check-possible-section)))
212 (to-section (plist-get params :to-section))
213 (everything (plist-get params :everything))
214 (part-match (plist-get params :part-match)))
215 (setq name (org-trim name))
216 (let ((temp-database (org-bom-select-in-db org-bom-database 'component-name name)))
217 (unless everything
218 (setq temp-database (org-bom-select-in-db temp-database
219 'component-section
220 from-section
221 nil
222 part-match)))
223 (dolist (current-component temp-database)
224 (setf (component-section current-component) to-section)))))))
225
8112c83 @Frozenlock Initial commit - V0.3
authored
226 (defun org-bom-prepare-linedata-for-database (&optional section-override)
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
227 "Scan the buffer and add line-components to database. Search
228 for an org-mode comment \"#+BOM:\". Everything before the
229 keys (:section, :qty, :tag) is considered to be the component's
230 name, except the last whitespaces. The \"section\" priority is in
231 this order: Given with the :section key, in a :SECTION: property,
232 or the org heading."
8112c83 @Frozenlock Initial commit - V0.3
authored
233 (goto-char (point-min))
234 (while (re-search-forward "^[ \t]*#\\+BOM:[ \t]+\\([^:\n]+\\)\\(.*\\)?" nil t)
235 (let* ((name (org-no-properties (match-string 1)))
236 (params (read (concat "(" (match-string 2) ")")))
237 (quantity (or (plist-get params :qty) 1))
238 (section-given (plist-get params :section))
239 (tag (plist-get params :tag)))
240 (setq name (org-trim name))
241 (when section-given
242 (unless (stringp section-given)
243 (setq section-given (symbol-name section-given))))
244 (when tag
245 (unless (stringp tag)
246 (if (numberp tag)
247 (setq tag (number-to-string tag))
248 (setq tag (symbol-name tag)))))
249 (org-bom-check-and-push-to-db
250 name
655caaa @tarsius delete trailing whitespace
tarsius authored
251 (or section-override
8112c83 @Frozenlock Initial commit - V0.3
authored
252 section-given
253 (org-bom-check-possible-section))
254 quantity
255 (list (list tag))))));double `list' because there's a list per tag and a list per item
256
655caaa @tarsius delete trailing whitespace
tarsius authored
257
8112c83 @Frozenlock Initial commit - V0.3
authored
258 (defun org-bom-check-possible-section ()
259 "Return a possible section from properties or heading"
260 (let ((section-property (org-entry-get nil "SECTION" 'selective)))
261 (when section-property
262 (if (string= "" section-property)
263 (setq section-property nil))) ;; set to nil if empty string
264 (or section-property
265 (if (org-before-first-heading-p)
266 "" ; If we are before the first heading, default to "".
267 (substring-no-properties (org-get-heading t t))))))
655caaa @tarsius delete trailing whitespace
tarsius authored
268
8112c83 @Frozenlock Initial commit - V0.3
authored
269 (defun org-bom-prepare-tabledata-for-database (&optional section-override)
270 "Scan in the current table for any column named as \"Component\". If
271 a name in the \"Component\" column starts with the '-' character, it
272 will be escaped. Optional info \"section\" must be somewhere before
273 the components' column. If no section is given, then will check for
274 a :SECTION: property. If none is found, the heading will be taken
275 as a section. A section-override will asign every single component
276 to this section. Optional info \"Qty\" and \"Tag\" should be a
277 column somewhere after the components column, as many times as
278 needed. To add another components column, simply add another
279 \"Component\". Note that if a \"Qty\" column is present, it will
280 default to 0 if the field is empty. This gives the possibility to
281 have many quantity columns without the need to enter 0 multiple
655caaa @tarsius delete trailing whitespace
tarsius authored
282 times."
8112c83 @Frozenlock Initial commit - V0.3
authored
283
284 (unless (org-at-table-p) (error "Not at a table"))
285 (org-bom-after-header-line)
286 (forward-line -1) ;Don't go on the first dataline yet
287 (let ((end (org-table-end))
288 (beg (org-table-begin))
289 (dline org-table-dataline-regexp)
290 (possible-section (org-bom-check-possible-section)))
291 (while (re-search-forward dline end t)
292 (dolist (current-comp (org-bom-get-keyword-column-numbers))
293 (when (plist-get current-comp :name) ;test if there's a component column
655caaa @tarsius delete trailing whitespace
tarsius authored
294 (org-bom-check-and-push-to-db
8112c83 @Frozenlock Initial commit - V0.3
authored
295 (org-bom-comp-get-name (plist-get current-comp :name))
296 (or section-override
297 (org-bom-comp-get-section (plist-get current-comp :section)
298 possible-section))
299 (org-bom-comp-get-qty (plist-get current-comp :qty))
300 (org-bom-comp-get-tag (plist-get current-comp :tag))))))))
301
302
303
304 (defun org-bom-check-for-details-table ()
305 "Scans the buffer to find \"#+TBLNAME: bom-details and add the data
655caaa @tarsius delete trailing whitespace
tarsius authored
306 in `org-bom-details'. Please use the form
8112c83 @Frozenlock Initial commit - V0.3
authored
307 (let ((org-bom-details (copy-tree org-bom-details))) before calling this
308 command, otherwise `org-bom-details' will be overwritten."
309 (save-excursion
310 (save-restriction
311 (widen)
312 (goto-char (point-min))
313 (while (re-search-forward "#\\+TBLNAME: bom-details" nil t)
314 (forward-line)
315 (when (org-at-table-p)
316 (org-bom-add-details-from-table))))))
317
318
319 (defun org-bom-add-details-from-table ()
655caaa @tarsius delete trailing whitespace
tarsius authored
320 "Scans the table for a special row (\"!\"), looking for \"name\"
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
321 \"description\", \"price\", and \"datasheetPdf\". Adds the data to
8112c83 @Frozenlock Initial commit - V0.3
authored
322 `org-bom-details' Warning, case-sensitive!."
323 (org-table-get-specials) ;needed to refresh org-table-column-names
324 (let ((column-names (nreverse org-table-column-names))
325 (end (org-table-end))
326 (dline org-table-dataline-regexp)
327 (propertize '(lambda (arg) (read (concat ":" (car arg))))))
328 (when (assoc "name" column-names);if there isn't a component name, do nothing
329 (org-bom-after-header-line) (forward-line -1)
330 (while (re-search-forward dline end t)
331 (let ((temp-plist '()))
332 (dolist (current-column column-names)
655caaa @tarsius delete trailing whitespace
tarsius authored
333 (let ((property-value (org-bom-get-table-field
8112c83 @Frozenlock Initial commit - V0.3
authored
334 (string-to-number (cdr current-column)))))
335 (when (> (length property-value) 0)
336 (push property-value temp-plist)
655caaa @tarsius delete trailing whitespace
tarsius authored
337 (push (funcall propertize current-column)
8112c83 @Frozenlock Initial commit - V0.3
authored
338 temp-plist))))
339 (org-bom-add-or-replace-in-details temp-plist))))))
655caaa @tarsius delete trailing whitespace
tarsius authored
340
8112c83 @Frozenlock Initial commit - V0.3
authored
341
342 (defun org-bom-add-or-replace-in-details (plist)
655caaa @tarsius delete trailing whitespace
tarsius authored
343 "Add or replace the plist in `org-bom-details', depending on
8112c83 @Frozenlock Initial commit - V0.3
authored
344 whether it already exists."
655caaa @tarsius delete trailing whitespace
tarsius authored
345 (let ((component-details
8112c83 @Frozenlock Initial commit - V0.3
authored
346 (org-bom-get-current-component (plist-get plist :name))))
347 (if component-details ;if the component already exists
348 (let ((name-position (position ':name plist)))
349 (delete ;remove the name property
350 (nth name-position plist)
351 (delete ;remove the :name keyword
352 (nth name-position plist) plist))
353 (while plist
354 (plist-put component-details (pop plist) (pop plist))))
355 (push plist org-bom-details))))
655caaa @tarsius delete trailing whitespace
tarsius authored
356
8112c83 @Frozenlock Initial commit - V0.3
authored
357
358 (defun org-bom-comp-get-tag (&optional column-number)
655caaa @tarsius delete trailing whitespace
tarsius authored
359 "Retrieve the component-tag in the same row and apply some filter
8112c83 @Frozenlock Initial commit - V0.3
authored
360 functions."
361 (let (temp-tag
362 tag)
363 (dolist (col column-number)
364 (setq temp-tag (org-bom-get-table-field (org-table-goto-column col)))
365 (when (> (length temp-tag) 0) (pushnew temp-tag tag)))
366 (setq tag (org-bom-split-mix-tag tag)))) ; tags written as "foo-1, foo, bar," will be separated
655caaa @tarsius delete trailing whitespace
tarsius authored
367
8112c83 @Frozenlock Initial commit - V0.3
authored
368
369
370 (defun org-bom-comp-get-qty (&optional column-number)
655caaa @tarsius delete trailing whitespace
tarsius authored
371 "Retrieve the component-qty in the same row and apply some filter
8112c83 @Frozenlock Initial commit - V0.3
authored
372 functions. If column-number is nil, default to 1."
373 (let ((qty 0))
374 (dolist (col column-number)
655caaa @tarsius delete trailing whitespace
tarsius authored
375 (setq qty (+ qty (max 0 (string-to-number
376 (org-bom-get-table-field
8112c83 @Frozenlock Initial commit - V0.3
authored
377 (org-table-goto-column col)))))))
378 (if column-number qty 1)))
379
380
381 (defun org-bom-comp-get-name (column-number)
655caaa @tarsius delete trailing whitespace
tarsius authored
382 "Retrieve the component-name in the same row and apply some filter
8112c83 @Frozenlock Initial commit - V0.3
authored
383 functions. (Remove footnotes, make \"-\" an escape character)"
384 (let ((comp-name
385 (replace-regexp-in-string "\\[fn.*\\]" "" ;Remove any footnotes [fn*]
655caaa @tarsius delete trailing whitespace
tarsius authored
386 (org-bom-get-table-field
8112c83 @Frozenlock Initial commit - V0.3
authored
387 (org-table-goto-column column-number)))))
655caaa @tarsius delete trailing whitespace
tarsius authored
388 (if (string= "-" (if (> (length comp-name) 0)
8112c83 @Frozenlock Initial commit - V0.3
authored
389 (substring comp-name 0 1) ""))
390 (setf comp-name "")) ;if the special character '-' is present, replace by an empty string
391 comp-name))
392
393
394 (defun org-bom-comp-get-section (&optional column-number possible-section)
655caaa @tarsius delete trailing whitespace
tarsius authored
395 "Retrieve the component-section at COLUMN-NUMBER in the same row,
8112c83 @Frozenlock Initial commit - V0.3
authored
396 or the POSSIBLE-SECTION."
397 (or (when column-number
398 (let ((field (org-bom-get-table-field
399 (org-table-goto-column column-number))))
400 (if (string= "" field) nil field)))
401 possible-section))
402
655caaa @tarsius delete trailing whitespace
tarsius authored
403
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
404 (defun org-bom-get-table-field (&optional N REPLACE)
655caaa @tarsius delete trailing whitespace
tarsius authored
405 "Same as `org-table-get-field', but with some string cleaning."
8112c83 @Frozenlock Initial commit - V0.3
authored
406 (org-trim (substring-no-properties (org-table-get-field N))))
407
408 (defun org-bom-split-mix-tag (tag &optional separator)
655caaa @tarsius delete trailing whitespace
tarsius authored
409 "Separate the tags and mix them. For example: '(\"foo, bar, foo\" \"do, ré, mi\")
8112c83 @Frozenlock Initial commit - V0.3
authored
410 would give '(\"foo\" \"do\") '(\"bar\" \"\") '(\"foo\" \"mi\") with the '\", \" separator."
411 (let ((temp-tags tag) (new-tags nil))
412 (dolist (single-string-tags temp-tags) ;separate the tags into single string
413 (push (org-split-string single-string-tags (or separator ", ")) new-tags))
414 (org-bom-mix-alternate new-tags)))
655caaa @tarsius delete trailing whitespace
tarsius authored
415
8112c83 @Frozenlock Initial commit - V0.3
authored
416
417 (defun org-bom-mix-alternate (list)
418 "Create new lists composed alternatively of an element of each list"
419 (let ((temp-list nil))
420 (push (remove nil (mapcar 'car list)) temp-list) ;the first item is composed of the first element of each list
421 (when (remove nil (mapcar 'cdr list)) ;while everything is not nil
422 (setf temp-list (append temp-list (org-bom-mix-alternate (mapcar 'cdr list)))))
423 temp-list))
655caaa @tarsius delete trailing whitespace
tarsius authored
424
425
8112c83 @Frozenlock Initial commit - V0.3
authored
426 (defun org-bom-list-to-tsv-file (list &optional filename column)
427 "Export a list in a tsv file"
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
428 (with-temp-file (or filename "list-export.txt")
8112c83 @Frozenlock Initial commit - V0.3
authored
429 (let ((n-col (or column 1)))
430 (dolist (single-item list)
655caaa @tarsius delete trailing whitespace
tarsius authored
431 (if (> n-col 0)
8112c83 @Frozenlock Initial commit - V0.3
authored
432 (progn (setf n-col (1- n-col))
433 (insert single-item)
434 (if (> n-col 1)
435 (insert-tab)))
436 (setf n-col (1- (or column 1)))
437 (newline)
438 (insert single-item)
439 (if (> n-col 0)
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
440 (insert-tab)))))))
8112c83 @Frozenlock Initial commit - V0.3
authored
441
442 (defun org-bom-get-all (database selector-fn)
443 "Return every different instance of a certain type in a single list. For
444 example, (org-bom-get-all org-bom-database 'component-tag) will return every
445 tag in the database. Empty strings are removed."
446 (let ((collector nil))
447 (dolist (current-component database)
448 (let ((current-item (funcall selector-fn current-component)))
449 (push current-item collector)))
450 (delete-dups (remove "" collector))))
655caaa @tarsius delete trailing whitespace
tarsius authored
451
8112c83 @Frozenlock Initial commit - V0.3
authored
452
453 (defun org-bom-listify (list-with-lists)
454 "Return everything contained in the argument (lists within lists) as
455 a plain list"
456 (let ((new-list nil))
457 (if (listp list-with-lists)
458 (progn (dolist (temp-item list-with-lists) ;for each item
655caaa @tarsius delete trailing whitespace
tarsius authored
459 (if (atom temp-item)
8112c83 @Frozenlock Initial commit - V0.3
authored
460 (pushnew temp-item new-list) ;if it's an atom, add it to the list
461 (setf new-list (append new-list (org-bom-listify temp-item))))) ;otherwise listify it
462 (remove nil new-list)) ; remove any remaining 'nil' from the list
463 (list list-with-lists))))
655caaa @tarsius delete trailing whitespace
tarsius authored
464
8112c83 @Frozenlock Initial commit - V0.3
authored
465 (defun org-bom-tag-to-list (&optional section-name remove part-match)
466 "Return a list of all the tags in the section, those from the same
467 component in the same string. See `org-bom-select-in-db' for more details."
468 (let ((results nil)
469 (items (org-bom-get-all (if section-name
655caaa @tarsius delete trailing whitespace
tarsius authored
470 (org-bom-select-in-db org-bom-database
8112c83 @Frozenlock Initial commit - V0.3
authored
471 'component-section
472 section-name
473 remove
474 part-match)
475 org-bom-database) 'component-tag)))
476 (dolist (current-item items)
477 (dolist (current-tags current-item)
478 (push (funcall '(lambda (x) (org-bom-concat-list (nreverse x) " ")) current-tags) results)))
479 (sort (remove "" results) 'string<)))
480
481 (defun org-bom-tag-remove-to-list (section-name)
482 "Return a list of all the tags NOT in the section. In case of
483 multiple sections, add a \"+\" between."
484 (setf section-name (org-split-string section-name "+")) ; convert the section-name in a list of string, so the user don't have to enter it as one
655caaa @tarsius delete trailing whitespace
tarsius authored
485 (let ((list nil)
8112c83 @Frozenlock Initial commit - V0.3
authored
486 (temp-tag nil)
487 (component-db org-bom-database))
488 (dolist (current-section-name section-name); For every section-name
655caaa @tarsius delete trailing whitespace
tarsius authored
489 (setf component-db (org-bom-select-in-db
490 component-db
491 'component-section
492 current-section-name
493 'remove
8112c83 @Frozenlock Initial commit - V0.3
authored
494 'part-match))) ;remove any partly matching section-name
495 (dolist (current-component component-db) ;; Put every tag in a list
655caaa @tarsius delete trailing whitespace
tarsius authored
496 (dolist (single-component-tags (component-tag current-component))
8112c83 @Frozenlock Initial commit - V0.3
authored
497 (push (org-bom-concat-list (org-bom-listify single-component-tags) " ") list)))
498 (setf list (remove "" (sort list 'string<)))))
499
500 (defun org-bom-concat-list (list &optional separator)
501 "Concatenate in a single string every string in the list with an
502 optional separator, such as \" \"."
503 (concat (car list) (unless (atom (cdr list))
504 (concat separator (org-bom-concat-list (cdr list) separator)))))
505
506 (defun org-dblock-write:bom (params)
655caaa @tarsius delete trailing whitespace
tarsius authored
507 "Insert a table with every component gathered in the buffer.
8112c83 @Frozenlock Initial commit - V0.3
authored
508 See `org-bom-insert-table' for more details."
509 (let ((org-bom-details (copy-tree org-bom-details)))
655caaa @tarsius delete trailing whitespace
tarsius authored
510 (when org-bom-update-enable
8112c83 @Frozenlock Initial commit - V0.3
authored
511 (org-bom-check-for-details-table)
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
512 (org-bom-total); Scan the buffer and refresh the bill of materials
513 (org-bom-transfer))
8112c83 @Frozenlock Initial commit - V0.3
authored
514 (org-bom-insert-table params)
515 (message "Bill of materials created")))
516
517 (defun org-bom-stringify (&optional argument)
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
518 "If ARGUMENT is string, return unchanged. If it's a symbol,
519 return the symbol-name. If nil, return nil"
8112c83 @Frozenlock Initial commit - V0.3
authored
520 (if (null argument)
521 nil
522 (cond ((not (stringp argument)) (symbol-name argument))
523 ((not (null argument)) argument))))
524
525
526 (defun org-bom-insert-table (params)
527 "Insert a table with every component gathered in the buffer.
528
529 Set \":local-only\" to get components marked with the current heading
530 as their \"section\". Components with given section (either in a table
531 or a property) will NOT appear.
532
533 Set \":section\" to get a specified section only. Note that if a
534 section is given to a component, it won't appear in a local-only
535 table. In addition, set \"part-match\" to get partly matching
536 sections. In addition, a + sign will add an additionnal section. For
537 example: \":section A+B\" will retrieve section A and section B.
538
539 Set \":remove\" to remove the specified section and keep everything
540 else.
541
542 Set \":total\" to merge every section together and obtain a grand
543 total.
544
545 Set \":no-tag\" to remove the tags column.
546
547 Set \":description\" to insert a description column. You must have a
548 PLIST with \":name\" and \":description\" in it. The function will
549 search for a matching component's name and get its description. Copy
550 your property list to the variable `org-bom-details'.
551
552 Set \":org-bom-latex-max-tags\" to hide every remaining tags in a
553 pdf comment (need org-bom-latex-mode activated)
554
555 Set \":price\" to insert a price column. You must have a
556 PLIST with \":name\" and \":price\" in it. The function will
557 search for a matching component's name and get its price. Copy
558 your property list to the variable `org-bom-details'.
559
560 The columns' name can be set with :col-name-tag, :col-name-component,
655caaa @tarsius delete trailing whitespace
tarsius authored
561 :col-name-section, :col-name-quantity, col-name-price and
8112c83 @Frozenlock Initial commit - V0.3
authored
562 col-name-description.
563
564 See `org-bom-prepare-tabledata-for-database' for more information."
565 (unless (if (and (plist-get params :local-only) (plist-get params :section))
566 (error "Specify a section OR local-only, not both"))
567
568 ;; Check options given by the user
569 (let ((heading-list '())
570 (table-list '())
571 (local-only (plist-get params :local-only))
655caaa @tarsius delete trailing whitespace
tarsius authored
572 (section-name
8112c83 @Frozenlock Initial commit - V0.3
authored
573 (org-bom-stringify (plist-get params :section)))
574 (grand-total (plist-get params :total))
655caaa @tarsius delete trailing whitespace
tarsius authored
575 (col-name-section
8112c83 @Frozenlock Initial commit - V0.3
authored
576 (or (org-bom-stringify (plist-get params :col-name-section))
577 "Section"))
655caaa @tarsius delete trailing whitespace
tarsius authored
578 (col-name-price
8112c83 @Frozenlock Initial commit - V0.3
authored
579 (or (org-bom-stringify (plist-get params :col-name-price))
580 "Price"))
655caaa @tarsius delete trailing whitespace
tarsius authored
581 (col-name-quantity
8112c83 @Frozenlock Initial commit - V0.3
authored
582 (or (org-bom-stringify (plist-get params :col-name-quantity))
583 "Quantity"))
655caaa @tarsius delete trailing whitespace
tarsius authored
584 (col-name-tag
8112c83 @Frozenlock Initial commit - V0.3
authored
585 (or (org-bom-stringify (plist-get params :col-name-tag))
586 "Tag"))
655caaa @tarsius delete trailing whitespace
tarsius authored
587 (col-name-component
8112c83 @Frozenlock Initial commit - V0.3
authored
588 (or (org-bom-stringify (plist-get params :col-name-component))
589 "Component"))
655caaa @tarsius delete trailing whitespace
tarsius authored
590 (col-name-description
8112c83 @Frozenlock Initial commit - V0.3
authored
591 (or (org-bom-stringify (plist-get params :col-name-description))
592 "Description"))
655caaa @tarsius delete trailing whitespace
tarsius authored
593 (insert-col-section
594 (not (or (plist-get params :total)
595 (plist-get params :local-only)
8112c83 @Frozenlock Initial commit - V0.3
authored
596 (plist-get params :section)))) ; No use to put a section column if it's given local or given by the user
655caaa @tarsius delete trailing whitespace
tarsius authored
597 (insert-col-description
8112c83 @Frozenlock Initial commit - V0.3
authored
598 (if (plist-get params :description) t nil)) ; Activate if the user want to use it
655caaa @tarsius delete trailing whitespace
tarsius authored
599 (insert-col-price
8112c83 @Frozenlock Initial commit - V0.3
authored
600 (if (plist-get params :price) t nil)) ; Activate if the user want to use it
655caaa @tarsius delete trailing whitespace
tarsius authored
601 (insert-col-tag
8112c83 @Frozenlock Initial commit - V0.3
authored
602 (if (plist-get params :no-tag) nil t)) ; Default ON, must be turned off by the user
603 (insert-col-component t) ; Always true, for now
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
604 (insert-col-quantity
605 (if (plist-get params :no-quantity) nil t))
655caaa @tarsius delete trailing whitespace
tarsius authored
606 (remove-mark
8112c83 @Frozenlock Initial commit - V0.3
authored
607 (if (plist-get params :remove) t nil)) ; indicate if we should remove rather than keep
655caaa @tarsius delete trailing whitespace
tarsius authored
608 (part-match
8112c83 @Frozenlock Initial commit - V0.3
authored
609 (if (plist-get params :part-match) t nil)); If 't', a string-match will be used to select the section
610 (current-heading (if (org-before-first-heading-p)
611 (format "") ; If we are before the first heading, then simply default to "".
612 (org-get-heading t t))))
613 ;; End of user options
614
615 ;; select what is needed in the database
655caaa @tarsius delete trailing whitespace
tarsius authored
616 (when section-name
8112c83 @Frozenlock Initial commit - V0.3
authored
617 (setf section-name (org-split-string section-name "+"))) ; convert the section-name in a list of string, so the user don't have to enter it as one
618 (let ((temp-section-name)
655caaa @tarsius delete trailing whitespace
tarsius authored
619 (temp-db (org-bom-select-in-db
620 org-bom-database
621 'component-name
622 ""
8112c83 @Frozenlock Initial commit - V0.3
authored
623 'remove!))) ;Remove any blank names
655caaa @tarsius delete trailing whitespace
tarsius authored
624 (when (setf section-name
625 (or section-name
626 (if local-only (list current-heading))))
8112c83 @Frozenlock Initial commit - V0.3
authored
627 (setf temp-db (org-bom-totalize ;if a section is defined, then keep only the database's relevant part
655caaa @tarsius delete trailing whitespace
tarsius authored
628 (org-bom-select-in-db temp-db
629 'component-section
630 section-name
631 remove-mark
8112c83 @Frozenlock Initial commit - V0.3
authored
632 part-match))))
633 (if grand-total (setf temp-db (org-bom-totalize temp-db))) ; fuse all sections and get the total
655caaa @tarsius delete trailing whitespace
tarsius authored
634
8112c83 @Frozenlock Initial commit - V0.3
authored
635 ;; Now construct the orgtbl-lisp
636 ;;heading
637 (when insert-col-description
638 (push col-name-description heading-list))
639 (when insert-col-price
640 (push col-name-price heading-list))
641 (when insert-col-quantity
642 (push col-name-quantity heading-list))
643 (when insert-col-component
644 (push col-name-component heading-list))
645 (when insert-col-tag
646 (push col-name-tag heading-list))
647 (when insert-col-section
648 (push col-name-section heading-list))
655caaa @tarsius delete trailing whitespace
tarsius authored
649
8112c83 @Frozenlock Initial commit - V0.3
authored
650 ;;add a separator line to the table
655caaa @tarsius delete trailing whitespace
tarsius authored
651 (push 'hline table-list)
652
8112c83 @Frozenlock Initial commit - V0.3
authored
653 ;;now add the heading to the table
654 (push heading-list table-list)
655caaa @tarsius delete trailing whitespace
tarsius authored
655
8112c83 @Frozenlock Initial commit - V0.3
authored
656 ;;The body of the table
655caaa @tarsius delete trailing whitespace
tarsius authored
657 (setq table-list
658 (append table-list
659 (nreverse (org-bom-to-lisp-table
8112c83 @Frozenlock Initial commit - V0.3
authored
660 temp-db
661 insert-col-section
662 insert-col-tag
663 insert-col-price
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
664 insert-col-description
665 insert-col-quantity))))
655caaa @tarsius delete trailing whitespace
tarsius authored
666
8112c83 @Frozenlock Initial commit - V0.3
authored
667 ;;if there's a price, add a total line
668 (when insert-col-price
669 (setq table-list (nreverse table-list))
670 (push 'hline table-list)
671 (push (append '("TOTAL:")
672 (make-list (1- (length heading-list)) "")) table-list)
673 (setq table-list (nreverse table-list)))
655caaa @tarsius delete trailing whitespace
tarsius authored
674
675
8112c83 @Frozenlock Initial commit - V0.3
authored
676 (insert (orgtbl-to-orgtbl table-list
677 (list
678 :remove-newlines t
679 :tstart nil :tend nil
680 :hline "|---"
681 :sep " | "
682 :lstart "| "
683 :lend " |")))
684 (org-table-align)
685 (when insert-col-price
655caaa @tarsius delete trailing whitespace
tarsius authored
686 (org-table-store-formulas
687 (list (cons (concat "@>$"
688 (number-to-string (1+ (position col-name-price heading-list))))
8112c83 @Frozenlock Initial commit - V0.3
authored
689 "vsum(@I..@>>)")))
690 (org-table-iterate))))))
691
692
693
694
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
695 (defun org-bom-to-lisp-table (database &optional section tag price description quantity)
696 "Return an orgtbl compliant table from an org-bom DATABASE.
8112c83 @Frozenlock Initial commit - V0.3
authored
697 See `org-bom-to-lisp-table-row' for more details."
698 (let ((table '())) ;an empty list
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
699 (dolist (current-component database table)
655caaa @tarsius delete trailing whitespace
tarsius authored
700 (push (org-bom-to-lisp-table-row current-component
8112c83 @Frozenlock Initial commit - V0.3
authored
701 section
702 tag
703 price
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
704 description
705 quantity)
706 table))))
8112c83 @Frozenlock Initial commit - V0.3
authored
707
708
709
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
710 (defun org-bom-to-lisp-table-row (component &optional section tag price description quantity)
711 "Return an orgtbl compliant row for a given COMPONENT
8112c83 @Frozenlock Initial commit - V0.3
authored
712 from the org-bom-database."
713 (let ((list '())
714 (tags (component-tag component))
715 (name (component-name component))
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
716 (quantity-num (component-quantity component)))
8112c83 @Frozenlock Initial commit - V0.3
authored
717 (when section
718 (push (component-section component) list))
719 (when tag
720 (push (org-bom-to-lisp-table-tags (component-tag component)) list))
721 (when component
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
722 (push (org-bom-to-lisp-table-name (component-name component)) list))
723 (when quantity
8112c83 @Frozenlock Initial commit - V0.3
authored
724 (push (number-to-string (component-quantity component)) list))
725 (when price
655caaa @tarsius delete trailing whitespace
tarsius authored
726 (let ((current-price
8112c83 @Frozenlock Initial commit - V0.3
authored
727 (plist-get (org-bom-get-current-component name) :price)))
655caaa @tarsius delete trailing whitespace
tarsius authored
728 (push (if current-price
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
729 (number-to-string (* quantity-num
8112c83 @Frozenlock Initial commit - V0.3
authored
730 (string-to-number current-price)))
655caaa @tarsius delete trailing whitespace
tarsius authored
731 "" )
8112c83 @Frozenlock Initial commit - V0.3
authored
732 list)))
733 (when description
734 (push (or (plist-get
735 (org-bom-get-current-component name) :description)
655caaa @tarsius delete trailing whitespace
tarsius authored
736 "N/A" )
8112c83 @Frozenlock Initial commit - V0.3
authored
737 list))
655caaa @tarsius delete trailing whitespace
tarsius authored
738 (setq list (nreverse list))
8112c83 @Frozenlock Initial commit - V0.3
authored
739 list))
655caaa @tarsius delete trailing whitespace
tarsius authored
740
8112c83 @Frozenlock Initial commit - V0.3
authored
741
742
743 (defun org-bom-to-lisp-table-name (name)
655caaa @tarsius delete trailing whitespace
tarsius authored
744 "Check if `org-bom-latex-mode' is non-nil, if the datasheet exists
8112c83 @Frozenlock Initial commit - V0.3
authored
745 and add the necessary LaTeX command."
655caaa @tarsius delete trailing whitespace
tarsius authored
746 (let ((temp-datasheet
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
747 (plist-get (org-bom-get-current-component name) :datasheetPdf)))
8112c83 @Frozenlock Initial commit - V0.3
authored
748 (if (and (> (length temp-datasheet) 1) org-bom-latex-mode)
749 (concat "\\hyperref["temp-datasheet"]{"name"}")
750 name)))
751
752
753
754 (defun org-bom-to-lisp-table-tags (tags)
655caaa @tarsius delete trailing whitespace
tarsius authored
755 "Takes the initial tags list form org-bom-database and
8112c83 @Frozenlock Initial commit - V0.3
authored
756 convert it in a single string. If `org-bom-latex-mode' is
655caaa @tarsius delete trailing whitespace
tarsius authored
757 non-nil, and if the number of tags is greater than
8112c83 @Frozenlock Initial commit - V0.3
authored
758 `org-bom-latex-max-tags', a latex command to add a pdf comment
655caaa @tarsius delete trailing whitespace
tarsius authored
759 is inserted."
8112c83 @Frozenlock Initial commit - V0.3
authored
760 (let ((temp-tag (sort (delete-dups (org-bom-listify tags)) 'string<))
761 (single-tag nil)
762 (max-tags-activated? nil))
763 (with-temp-buffer ;easier than trying to concat everything
655caaa @tarsius delete trailing whitespace
tarsius authored
764 (when (and org-bom-latex-mode
765 (numberp org-bom-latex-max-tags)
8112c83 @Frozenlock Initial commit - V0.3
authored
766 (> (length temp-tag) org-bom-latex-max-tags))
767 (insert "\\pdfcomment[color=Ivory,subject={Tags},icon=Note,open=true,hoffset=-1cm]{")
768 (setq max-tags-activated? t))
769 (while (> (length temp-tag) 0)
770 (when (stringp (setf single-tag (pop temp-tag)))
655caaa @tarsius delete trailing whitespace
tarsius authored
771 (insert single-tag)
8112c83 @Frozenlock Initial commit - V0.3
authored
772 (if (> (length temp-tag) 0)
773 (insert ", "))); Insert a white space between the tags
655caaa @tarsius delete trailing whitespace
tarsius authored
774 (when (and org-bom-latex-mode (numberp org-bom-latex-max-tags)
8112c83 @Frozenlock Initial commit - V0.3
authored
775 (= (- (length temp-tag) org-bom-latex-max-tags) 0))
776 (delete-char -2) ;delete the last comma in the PDF comment
777 (insert "}{")))
778 (if max-tags-activated? (insert "}..."))
779 (replace-regexp-in-string "[\\]" "\\\\" (buffer-string)))))
780
781
782
783 (defun org-bom-totalize (database)
784 "Will ignore the sections and return a new database with a true
785 total for each component."
786 (let ((new-database nil))
787 (dolist (current-item-old-db database) ;scan the given database
788 (let ((exists-flag nil)) ; exist flag as nil
789 (dolist (current-item-new-db new-database) ;scan the 'new' database
655caaa @tarsius delete trailing whitespace
tarsius authored
790 (when (gnus-string-equal
791 (component-name current-item-new-db)
8112c83 @Frozenlock Initial commit - V0.3
authored
792 (component-name current-item-old-db)) ;when the same name is found
655caaa @tarsius delete trailing whitespace
tarsius authored
793 (setf (component-quantity current-item-new-db)
794 (+ (component-quantity current-item-new-db)
8112c83 @Frozenlock Initial commit - V0.3
authored
795 (component-quantity current-item-old-db))) ;simply add the quantity...
655caaa @tarsius delete trailing whitespace
tarsius authored
796 (push (component-tag current-item-old-db)
8112c83 @Frozenlock Initial commit - V0.3
authored
797 (component-tag current-item-new-db)) ; add the tags...
798 (setf exists-flag t))) ; and set the flag as t
655caaa @tarsius delete trailing whitespace
tarsius authored
799 (if (not exists-flag) (push (make-component
8112c83 @Frozenlock Initial commit - V0.3
authored
800 :name (component-name current-item-old-db) ;otherwise create a new entry with the same component name as the old database
801 :section "total" ;give a dummy name - should never really be used
802 :quantity (component-quantity current-item-old-db) ; take the old quantity
803 :tag (component-tag current-item-old-db)) new-database)))); finally take the old tags
804 (nreverse new-database)));reverse so it will be in the same order as before
655caaa @tarsius delete trailing whitespace
tarsius authored
805
8112c83 @Frozenlock Initial commit - V0.3
authored
806
807
808 (defun org-bom-get-current-component (name)
809 "Return the current component from the `org-bom-details' plist."
810 (car (remove-if-not
811 #'(lambda (component)
812 (equal (plist-get component :name) name))
813 org-bom-details)))
814
815 (defun org-bom-get-from-database (database selector value)
816 "Return every entry in the database which has the corresponding
817 value for a given selector. Can be the database's argument of itself
818 in case of multiple selectors"
819 (setf value (gnus-replace-in-string value "+" "[+]")) ;In a regexp, has a meaning and isn't considered a "string"
655caaa @tarsius delete trailing whitespace
tarsius authored
820 (remove-if-not
821 '(lambda (comp)
8112c83 @Frozenlock Initial commit - V0.3
authored
822 (string-match value (plist-get comp selector))) database))
823
824 (defun org-dblock-write:bom-datasheet (params)
655caaa @tarsius delete trailing whitespace
tarsius authored
825 "This is used to add used components datasheet (for LaTeX only).
8112c83 @Frozenlock Initial commit - V0.3
authored
826 For more details, see `org-bom-insert-datasheet-table'."
827 (let ((org-bom-details (copy-tree org-bom-details)))
655caaa @tarsius delete trailing whitespace
tarsius authored
828 (when org-bom-update-enable
8112c83 @Frozenlock Initial commit - V0.3
authored
829 (org-bom-check-for-details-table)
830 (org-bom-total)); Scan the buffer and refresh the bill of materials
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
831 (org-bom-insert-datasheet-table params)))
8112c83 @Frozenlock Initial commit - V0.3
authored
832
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
833 (defun org-bom-get-datasheet-info (component-name-list)
834 "Return a plist of the form \"(:name name :datasheetPdf
835 datasheetPdf :datasheetPath datasheetPath)\", given a
836 COMPONENT-NAME-LIST. Info is retrieved from `org-bom-details'."
837 (let ((datasheet-info nil))
838 (dolist (current-component component-name-list datasheet-info)
839 (let ((item-info (org-bom-get-current-component current-component)))
840 (push (list :name current-component
841 :datasheetPdf (plist-get item-info :datasheetPdf)
842 :datasheetPath (plist-get item-info :datasheetPath))
843 datasheet-info)))))
8112c83 @Frozenlock Initial commit - V0.3
authored
844
845
846 (defun org-bom-insert-datasheet-table (params)
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
847 "This is used to add used components datasheet (for LaTeX
848 only). The filename will be taken in the org-bom-details plist,
849 with the property :datasheetPdf, and the path
850 with :datasheetPath. Set \":description\" to enable a summary of
851 components before the datasheets. As for the BOM dynamic block,
852 the columns names can be changed with \":col-name-component\" and
853 \":col-name-description\"."
8112c83 @Frozenlock Initial commit - V0.3
authored
854 (save-excursion
855 (save-restriction
856 (widen)
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
857 (let ((all-component-names nil)
858 (temp-database (org-bom-select-in-db org-bom-database 'component-name "" 'remove))
859 (col-name-component (plist-get params :col-name-component) )
860 (col-name-description (plist-get params :col-name-description)))
861 (when (plist-get params :description)
862 (org-bom-insert-table (list :total t :no-tag t :no-quantity t :description t
863 :col-name-component col-name-component
864 :col-name-description col-name-description)))
865 (dolist (current-item temp-database)
866 (add-to-list 'all-component-names (component-name current-item))); Gather every component used
8112c83 @Frozenlock Initial commit - V0.3
authored
867 (setf all-component-names (sort all-component-names 'gnus-string<))
854e0a8 @Frozenlock seperate README, add bom-xfer and datasheetPath
authored
868 (let ((component-info (org-bom-get-datasheet-info all-component-names))
869 (used-datasheet)); do not include the same datasheet more than once.
870 (newline)
871 (dolist (current-component-info (nreverse component-info));reverse for alphabetic order
872 (let ((datasheet (plist-get current-component-info :datasheetPdf)))
873 (when (and (> (length datasheet) 0) (not (find datasheet used-datasheet :test 'gnus-string-equal)))
874 (add-to-list 'used-datasheet datasheet)
875 (insert (concat "#+LaTeX: " "\\includepdf[pages=-,landscape=true,addtotoc={1, subsection, 1, "
876 (plist-get current-component-info :name) ","
877 (plist-get current-component-info :datasheetPdf) "}]{"
878 (or (plist-get current-component-info :datasheetPath)
879 org-bom-latex-datasheetPath) "/"
880 (plist-get current-component-info :datasheetPdf)) "}")
881 (newline)))))))))
8112c83 @Frozenlock Initial commit - V0.3
authored
882
883
884 (provide 'org-bom)
885
886 ;========================================
887 ; The program ends here
888 ;========================================
Something went wrong with that request. Please try again.