[O] New contribution: Bill-of-materials -- org-bom.el

[frozenlock]

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 <frozenlock AT gmail DOT com>
;;    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
;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;    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 confusion.
;;
;;  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 easily:
;;     
;;     |   | 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 parameter.
;;     #+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 (:name).
;;    
;;    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"
 `(remove-if-not
   #'(lambda (component)
       (equal (,(read (concat "component-" (symbol-name selector))) component) ,section))
   ,database))

(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 list
      (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 quantity
		 (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."
  (interactive)
  (save-excursion
    (save-restriction
      (setq *org-bom-database* nil) ;; Reset the database before each new buffer-wide scan
      (widen)
      (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."
  (interactive)
  (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 quantity
		    (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) col)))))))))
			       ;; 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, :col-name-quantity and col-name-description."
  (unless (if (and (plist-get params :local-only) (plist-get params :section))
	      (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" )))))))))

  (org-table-align)
  (message "Bill of materials created"))


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


(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 \":col-name-description\"."

  (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")))))
	       (org-table-align)
	       (next-line)
	       (newline)))
    (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 "}"))
		 (newline))
	(message (concat temp-name " doesn't have a datasheet... moving on."))))))


(provide 'org-bom)

;;========================================
;; The program ends here
;;========================================