Features Download
From: <frozenlock <at> gmail.com>
Subject: New contribution: Bill-of-materials -- org-bom.el
Newsgroups: gmane.emacs.orgmode
Date: Sunday 3rd April 2011 21:24:05 UTC (over 5 years ago)
Hello all!

This is my contribution to the wonderful world of org mode: a  
bill-of-materials maker.

This module will scan your entire buffer, collect data, store it in a local
database and give it to you in a table. The power users might also want to 

use the database directly.
For more info, please read the tutorial!

Also please keep in mind that I'm in no way an expert elisper and that my  
program is surely not the most pretty or optimized one around.

Here is the program: http://pastebin.com/w28yaUFz

I've also included it in this email, please enjoy!

;; Copyright 2011 Christian Fortin
;; Filename: org-bom.el
;; Version: 0.1
;; Author: Christian Fortin 
;; Keywords: org, bill-of-materials, collection, tables
;; Description: Create a bill-of-materials (bom) of the entire org buffer
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;* BOM tutorial
;; This module collects information across the entire org buffer, making it
easy to retrieve and sort data.
;; It uses the column name as a landmark. We will refer to them  
as 'Keywords'. The keywords are searched using a string-match function,  
which gives the ability to have multiple column with the same  
functionality, but also to use the column name as we would usually with  
org-mode. For example, we can have 'tag' and 'tag2', both are recognized by
the BOM module and can be used in a spreadsheet-like formula without any  
;; The BOM is compiled and printed by using a dynamic block;
;; '#+BEGIN: bom'
;; '#+END'
;; Here is the keyword's list:
;; 1. _Component_
;; This is the most important keyword and act as the trigger.
;; For this example, let's say we write down things we want to buy. In this
case, a new keyboard for our computer.
;; This is how the table should be:
;; | | Material |
;; | ! | Component |
;; |---+-----------|
;; | | Keyboard |
;; And here is what the bill of material for this table is:
;; #+BEGIN: bom :no-tag t
;; | Section | Component | Quantity |
;; |--------------+-----------+----------|
;; | BOM tutorial | Keyboard | 1 |
;; #+END:
;; As you can see, the heading was automatically used as the 'section',  
which doesn't require attention for now. The quantity is, unsurprisingly,  
1. Now suppose that our friend too wants a new keyboard.
;; | | For | Material |
;; | ! | | Component |
;; |---+--------+-----------|
;; | | Me | Keyboard |
;; | | Friend | Keyboard |
;; #+BEGIN: bom :no-tag t
;; | Section | Component | Quantity |
;; |--------------+-----------+----------|
;; | BOM tutorial | Keyboard | 2 |
;; #+END:
;; As expected, we get 2 keyboards.
;; 2. _Section_
;; The section is used to separate what would otherwise be an identical  
component. Suppose we don't want our friend's wishes to be in the same BOM 

as our, but still have them in the same table.
;; | | For | Material |
;; | ! | Section | Component |
;; |---+---------+-----------|
;; | | Me | Keyboard |
;; | | Friend | Keyboard |
;; This will results in the following BOM:
;; #+BEGIN: bom :no-tag t
;; | Section | Component | Quantity |
;; |---------+-----------+----------|
;; | Friend | Keyboard | 1 |
;; | Me | Keyboard | 1 |
;; #+END:
;; Please note that when a component is given a section, it isn't  
associated with the heading anymore. In fact a section should almost always
be given. Using headings will simply complicate your writing by forcing you
to pre-sort materials in an unnatural way. As an alternative, you can set  
a ':SECTION:' property in the heading, which will be inherited by all the  
components without a specified section.
;; 3. _Qty_
;; With this keyword, it is possible to specify a quantity for the  
associated component. In our always improving scenario, we now want to give
a keyboard to another of our friend (as a gift). This is going to be bought
at the same time as our keyboard, so they belong together.
;; | | For | Material | |
;; | ! | Section | Component | Qty |
;; |---+---------+-----------+-----|
;; | | Me | Keyboard | 2 |
;; | | Friend | Keyboard | 1 |
;; #+BEGIN: bom :no-tag t
;; | Section | Component | Quantity |
;; |---------+-----------+----------|
;; | Friend | Keyboard | 1 |
;; | Me | Keyboard | 2 |
;; #+END:
;; *Important*: If Qty keyword is present, then any empty field will be  
considered as _zero_. This way, multiple column quantity are made quite  
;; | | For | Material | Personal | Gift |
;; | ! | Section | Component | Qty | Qty2 |
;; |---+---------+-----------+----------+------|
;; | | Me | Keyboard | 1 | 1 |
;; | | Friend | Keyboard | 1 | |
;; #+BEGIN: bom :no-tag t
;; | Section | Component | Quantity |
;; |---------+-----------+----------|
;; | Friend | Keyboard | 1 |
;; | Me | Keyboard | 2 |
;; #+END:
;; 4. _Tag_
;; When a BOM starts to get big, we often need a quick reminder of why we  
need certain component. Another use is also to identify the component. As  
the Qty keyword, multiple Tag columns can be associated with a single  
component. Here we will simply use the tag as a reminder of what we want to
look for in the store.
;; | | For | Material | Personal | Gift | Need |
;; | ! | Section | Component | Qty | Qty2 | Tag |
;; |---+---------+-----------+----------+------+--------------------|
;; | | Me | Keyboard | 1 | 1 | Matching colors |
;; | | Friend | Keyboard | 1 | | Dinosaurs pictures |
;; To show the tag column in the BOM, we simply remove the no-tag
;; #+BEGIN: bom
;; | Section | Tag | Component | Quantity |
;; |---------+--------------------+-----------+----------|
;; | Friend | Dinosaurs pictures | Keyboard | 1 |
;; | Me | Matching colors | Keyboard | 2 |
;; #+END:
;; 5. Renaming BOM columns
;; It is possible to rename the BOM columns with the following parameters:
;; :col-name-component
;; :col-name-section
;; :col-name-quantity
;; :col-name-tag
;; This is how our renamed BOM would look like:
;; #+BEGIN: bom :col-name-section For :col-name-tag  
Need :col-name-component Stuff :col-name-quantity Qty
;; | For | Need | Stuff | Qty |
;; |--------+--------------------+----------+-----|
;; | Friend | Dinosaurs pictures | Keyboard | 1 |
;; | Me | Matching colors | Keyboard | 2 |
;; #+END:
;; 6. Multiple component's column
;; There is two way to add components in a section. Either by adding other 

rows with the same section's name, or by adding other columns. Both have  
their uses and they should come to you quite naturally. In our example, we 

want more stuff.
;; | | For | Material | Personal | Gift | Need | Stuff | More stuff | Much 

more stuff | How many |
;; | ! | Section | Component | Qty | Qty2 | Tag | Component | Component |  
Component | Qty |
;; | 
;; | | Me | Keyboard | 1 | 1 | Matching colors | Mouse | Headset | USB  
flash drive | 23 |
;; | | Friend | Keyboard | 1 | | Dinosaurs pictures | | | | |
;; | | Friend | | | | | | | CDs | 50 |
;; | | Friend | Mouse | 1 | | | | | | |
;; This is beginning to get interesting. Note that even if we can name the 

additional columns 'Component2' or 'ComponentAAA', there's no use to do it 

if no table-formula uses the column names. Now suppose we want to get OUR  
to-buy list. Simply specify the section's parameter ':section Me':
;; #+BEGIN: bom :col-name-section For :col-name-tag  
Need :col-name-component Stuff :col-name-quantity Qty :section Me
;; | Need | Stuff | Qty |
;; |-----------------+-----------------+-----|
;; | | USB flash drive | 23 |
;; | | Headset | 1 |
;; | | Mouse | 1 |
;; | Matching colors | Keyboard | 2 |
;; #+END:
;; Wait, where's the section column?
;; Well we don't need it anymore, as we specified one.
;; By now you should envision how it can be useful to be able to add  
components anywhere in an Org file (even in a drawer) and still be able to 

select which section's BOM you want.
;;* BOM advanced
;; Some BOM's function are quite specialized and were written mostly for  
the author. However, here is how to use them:
;; 1. *org-bom-description*
;; This is a plist database in which a description (:description) can be  
associated with a component (:name). This is used when a component is used 

often and requires a description.
;; - Description keyword
;; By setting the parameter ':description t', the description column will  
be activated and filled with any description associated with a component  
;; 2. Dynamic block bom-datasheet
;; A really specialized function; will add latex commands line to insert  
pdfs associated with the component (:name). The entire pdf filenames  
(with .pdf) must be in the org-bom-description plist, as :pdf-filename. A  
latex command such as '#+LATEX_HEADER:  
\newcommand{\DATASHEET-PATH}{Name-of-the-folder/}' shall be inserted at the
beginning of the org document, where Name-of-the-folder is the folder where
the datasheets' files are.

;; The :description parameter can be activated to insert a summary table  
with the component's name and description before the datasheets.

;; The program begins here

(require 'org)
(require 'org-table)
(require 'cl)

;;========== Database section ==========

(defvar *org-bom-database* nil
"Global variable used to build a database of the components used, as well  
as their section, tags and quantity.")

(defvar *org-bom-description* nil
"Need to be given by the user, either by a timely defvar at startup or by a
setf. A suggested use is to bind it to a local user's database. Should be a
plist with at least \":name\" and \":description\". It should also contain 

\":datasheet-pdf\" in order to use the bom-datasheet dynamic block.")

(defun org-bom-add-component (comp) (push comp *org-bom-database*))

(defstruct component name section quantity tag)

(defmacro org-bom-select-in-db (database selector section)
"Return every entry in the database which has the corresponding value for a
given selector. Can be the database's argument of itself in case of  
multiple selectors"
#'(lambda (component)
(equal (,(read (concat "component-" (symbol-name selector)))  
component) ,section))

(defun org-bom-check-and-push-to-db (name section quantity tag)
"Check if the combo name-section is already in the database. If it is, add 

the quantity and the tag, otherwise create a new entry."
(let ((temp-db *org-bom-database*) (temp-car-db nil) (exists-flag nil)) ;; 

Make a copy of the database
(while (setq temp-car-db (pop temp-db)) ;; remove and test each item in the
(if (and (gnus-string-equal (component-name temp-car-db) name)  
(gnus-string-equal (component-section temp-car-db) section))
(progn (setf (component-quantity temp-car-db) (+ (component-quantity  
temp-car-db) quantity)) ;; if the combo name-section exists, simply add the
(if (not (string= "" tag)) ;; Don't add empty string
(push tag (component-tag temp-car-db)))
(setf exists-flag t)))) ;; set the exist flag t
(if (not exists-flag) (org-bom-add-component (make-component :name name
:section section
:quantity quantity
:tag (list tag)))))) ;; if it's a new component (in the section), then add 

it in the database

;;========== End of database section ==========

(defun org-bom-total (&optional section-override)
"Go to every tables in the buffer and get info from them."
(setq *org-bom-database* nil) ;; Reset the database before each new  
buffer-wide scan
(org-table-map-tables (lambda () (org-bom-prepare-tabledata-for-database  
section-override)) t))))

(defun org-bom-prepare-tabledata-for-database (&optional section-override)
"Scan in the current table for any column named as \"Component\". Optional 

info \"section\" must be somewhere before the components' column. If no  
section is given, then will check for a \"SECTION\" property. If none is  
found, the heading will be taken as a section. A section-override will  
asign every single component to this section. Optional info \"Qty\" and  
\"Tag\" should be a column somewhere after the components column, as many  
times as needed. To add another components column, simply add another  
\"Component\". Note that if a \"Qty\" column is present, it will default to
0 if the field is empty. This gives the possibility to have many quantity  
columns without the need to enter 0 multiple times."
(setq org-bom-alist nil) ;; Reset the alist value before we search in table
(unless (org-at-table-p) (error "Not at a table"))
(let ((beg (org-table-begin))
(end (org-table-end))
(sectionp nil)
(first-data-row nil)
(section-property (org-entry-get nil "SECTION" 'selective))
(current-heading (if (org-before-first-heading-p)
(format "") ;; If we are before the first heading, then simply default  
to "".
(org-get-heading 1))))
(goto-char beg)
(when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t)
(setq names (org-split-string (match-string 1) " *| *")
cnt 1)
(setq first-data-row (org-table-current-line))
(while (setq name (pop names)) ;; search through every table's column name
(setq cnt (1+ cnt))
(if (and (not section-override) (string-match "section" name)) ;; if a  
section column exists, take its number
(setq sectionp cnt))
(if (string-match "component" name) ;; if a components column exists, take 

its number
(let ((col cnt) ;; the count number is now the column to use; also set the 

all markers to nil
(qtyp nil)
(qty-col-counter 0)
(qty-col (list nil))
(qty-temp-names names)
(tagp nil)
(tag-col-counter 0)
(tag-col (list nil))
(temp-names2 names))
(while (and (car qty-temp-names)
(not (string-match "component" (car qty-temp-names)))) ;; While  
not "components" column, check for Qty
(setf qty-col-counter (1+ qty-col-counter))
(if (string-match "Qty" (pop qty-temp-names)) ;; check if the column is the
(progn (setq qtyp t)
(push qty-col-counter qty-col))))
(while (and (car temp-names2)
(not (string-match "component" (car temp-names2))))
(setf tag-col-counter (1+ tag-col-counter))
(if (string-match "tag" (pop temp-names2))
(progn (setq tagp t)
(push tag-col-counter tag-col)))) ;; push the column number to a list
(org-table-goto-line first-data-row) ;; return to the table's beginning
(while (org-table-goto-line (+ (org-table-current-line) 1)) ;; for all row 

in the column
(let ((comp-name nil) ;; initiate the database's input variables and the  
temporary tag's column list
(quantity 0)
(temp-col-qty qty-col)
(section nil)
(tag "")
(temp-col-tag tag-col))
(if (string< "" (setq comp-name (org-trim (org-table-get-field  
(org-table-goto-column col))))) ;; If there's no component, don't bother
(progn (if (not (setf section section-override)) ;; If section-override,  
stop there
(progn (if sectionp
(setq section (org-trim (org-table-get-field (org-table-goto-column  
sectionp))))) ;; Get the section's value (if it exists)
(if (or (eq sectionp nil) (string= "" section))
(setf section (or section-property current-heading))))) ;; if no section's 

value exists, give the SECTION property or the heading name
(if qtyp (while (car temp-col-qty)
(setf quantity (+ quantity (max 0 (string-to-number (org-trim  
(org-table-get-field (org-table-goto-column (+ (pop temp-col-qty)  
;; if no Qty column exists, default to 1.
;; if a Qty column exists, default to 0.
(setq quantity 1))
(if tagp (while (car temp-col-tag)
(setf tag (concat tag " "(org-trim (org-table-get-field  
(org-table-goto-column (+ (pop temp-col-tag) col)))))))
;; if no tag, default to empty string""
(setq tag ""))
(org-bom-check-and-push-to-db comp-name section quantity tag)))))))))))

(defun org-dblock-write:bom (params)
"Insert a table with every component gathered in the buffer.

Set \":local-only\" to get components marked with the current heading as  
their \"section\". Components with given section (either in a table or a  
property) will NOT appear.

Set \":section\" to get a specified section only. Note that if a section is
given to a component, it won't appear in a local-only table.

Set \":total\" to merge every section together and obtain a grand total.

Set \":no-tag\" to remove the tags column.

Set \":description\" to insert a description column. You must have a PLIST 

with \":name\" and \":description\" in it. The function will search for a  
matching component's name and get its description.

The columns' name can be set  
with :col-name-tag, :col-name-component, :col-name-section,
and col-name-description."
(unless (if (and (plist-get params :local-only) (plist-get params
(error "Specify a section OR local-only, not both"))
;; Set options given by the user
(let ((local-only (plist-get params :local-only))
(section-name (plist-get params :section))
(grand-total (plist-get params :total))
(col-name-section (or (if (plist-get params :col-name-section)
(symbol-name (plist-get params :col-name-section))) "Section"))
(col-name-quantity (or (if (plist-get params :col-name-quantity)
(symbol-name (plist-get params :col-name-quantity))) "Quantity"))
(col-name-tag (or (if (plist-get params :col-name-tag)
(symbol-name (plist-get params :col-name-tag))) "Tag"))
(col-name-component (or (if (plist-get params :col-name-component)
(symbol-name (plist-get params :col-name-component))) "Component"))
(col-name-description (or (if (plist-get params :col-name-description)
(symbol-name (plist-get params :col-name-description))) "Description"))
(insert-col-section (not (or (plist-get params :total) (plist-get  
params :local-only) (plist-get params :section)))) ;; No use to put a  
section column if it's given local or given by the user
(insert-col-description (if (plist-get params :description) t nil)) ;;  
Activate if the user want to use it
(insert-col-tag (if (plist-get params :no-tag) nil t)) ;; Default ON, must 

be turned off by the user
(insert-col-component t)(insert-col-quantity t) ;; Always true, for now
(number-of-column nil)
(column-counter 1)
(section-column-number nil)
(tag-column-number nil)
(component-column-number nil)
(quantity-column-number nil))
(if grand-total (setf grand-total "Grand-total")) ;; Replace by a  
meaningful string
(org-bom-total grand-total) ;; Scan the entire buffer
(if section-name (setf section-name (symbol-name section-name))) ;; convert
the section-name in a string, so the user don't have to enter it as one
(let ((temp-db *org-bom-database*)) ;; Here starts the data distribution
(if (or section-name local-only)
(setf temp-db (org-bom-select-in-db temp-db section
(or section-name (org-get-heading))))) ;; if a section is defined, then  
keep only the database's relevant part
(setf number-of-column (if insert-col-section 3 2)) ;; If there's no  
section's column, set the minimum number of column: 2
(setf number-of-column (if insert-col-description (+ number-of-column 1)  
number-of-column)) ;; Add a column when the descrition is enabled
(setf number-of-column (if insert-col-tag (+ number-of-column 1)  
number-of-column)) ;; Add a column when Tag is enabled
(org-table-create (concat (int-to-string number-of-column)"x"  
(int-to-string (+ 1 (length temp-db))))) ;;create a table

;; This section could be prettier... macro perhaps?
(if insert-col-section
(progn (org-table-goto-column column-counter)
(setf section-column-number column-counter)
(setf column-counter (1+ column-counter))
(insert col-name-section)))
(if insert-col-tag
(progn (org-table-goto-column column-counter)
(setf tag-column-number column-counter)
(setf column-counter (1+ column-counter))
(insert col-name-tag)))
(if insert-col-component
(progn (org-table-goto-column column-counter)
(setf component-column-number column-counter)
(setf column-counter (1+ column-counter))
(insert col-name-component)))
(if insert-col-quantity
(progn (org-table-goto-column column-counter)
(setf quantity-column-number column-counter)
(setf column-counter (1+ column-counter))
(insert col-name-quantity)))
(if insert-col-description
(progn (org-table-goto-column column-counter)
(setf description-column-number column-counter)
(setf column-counter (1+ column-counter))
(insert col-name-description)))
(while temp-db
(let ((current-db-item (pop temp-db)))
(org-table-goto-line (+ (org-table-current-line) 1))
(if insert-col-section
(progn (org-table-goto-column section-column-number)
(insert (component-section current-db-item))))
(if insert-col-tag
(progn (org-table-goto-column tag-column-number)
(let ((temp-tag (component-tag current-db-item)))
(while temp-tag
(insert (pop temp-tag))
(insert " "))))) ;; Insert a white space between the tags
(if insert-col-component
(progn (org-table-goto-column component-column-number)
(insert (component-name current-db-item))))
(if insert-col-quantity
(progn (org-table-goto-column quantity-column-number)
(insert (int-to-string (component-quantity current-db-item)))))
(if insert-col-description
(progn (org-table-goto-column description-column-number)
(insert (or (plist-get (org-bom-get-current-component (component-name  
current-db-item)):description) "N/A" )))))))))

(message "Bill of materials created"))

(defun org-bom-get-current-component (name)
(car (remove-if-not
#'(lambda (component)
(equal (plist-get component :name) name))

(defun org-dblock-write:bom-datasheet (params)
"This is used to add used components datasheet (for LaTeX only). The  
filename will be taken in the *org-bom-description* plist, with the  
property :datasheet. A latex command such as \"#+LATEX_HEADER:  
\newcommand{\DATASHEET-PATH}{Name-of-the-folder/}\" shall be inserted at  
the beginning of the org document, where Name-of-the-folder is the folder  
where the datasheets files are. Note that the entire filename must be in  
the plist; \"datasheet.pdf\". Set \":description\" to enable a summary of  
components before the datasheets. As for the BOM dynamic block, the columns
names can be changed with \":col-name-component\" and  

(org-bom-total) ;; Scan the entire buffer
(let ((temp-database *org-bom-database*)
(all-component-names nil)
(temp-filename nil)
(temp-name nil))
(while temp-database
(add-to-list 'all-component-names (component-name (pop temp-database))));; 

Gather every component used
(sort all-component-names 'string<)
(if (plist-get params :description)
(progn (let ((col-name-component (or (if (plist-get  
params :col-name-component)
(symbol-name (plist-get params :col-name-component))) "Component"))
(col-name-description (or (if (plist-get params :col-name-description)
(symbol-name (plist-get params :col-name-description))) "Description"))
(temp-all-component-names all-component-names))
(org-table-create (concat (int-to-string 2)"x" (int-to-string (+ 1 (length 

all-component-names))))) ;;create a table
(org-table-goto-column 1)
(insert col-name-component)
(org-table-goto-column 2)
(insert col-name-description)
(while temp-all-component-names
(progn (setf temp-name (pop temp-all-component-names))
(org-table-goto-line (+ (org-table-current-line) 1))
(org-table-goto-column 1)
(insert temp-name)
(org-table-goto-column 2)
(insert (or (plist-get (org-bom-get-current-component  
temp-name) :description) "N/A")))))
(while all-component-names ;; for every component,
(setf temp-name (pop all-component-names))
(setf temp-filename (plist-get (org-bom-get-current-component  
temp-name) :datasheet-pdf)) ;; get the filename associated with the  
component's name
(if temp-filename
(progn (insert  
(concat "#+LaTeX: " "\\includepdf[pages={1-}]{\DATASHEET-PATH/"  
temp-filename "}"))
(message (concat temp-name " doesn't have a datasheet... moving on."))))))

(provide 'org-bom)

;; The program ends here
CD: 16ms