1;;; gEDA - GPL Electronic Design Automation
2;;; gnetlist - gEDA Netlist
3;;; Copyright (C) 1998-2010 Ales Hvezda
4;;; Copyright (C) 1998-2010 gEDA Contributors (see ChangeLog for details)
5;;;
6;;; This program is free software; you can redistribute it and/or modify
7;;; it under the terms of the GNU General Public License as published by
8;;; the Free Software Foundation; either version 2 of the License, or
9;;; (at your option) any later version.
10;;;
11;;; This program is distributed in the hope that it will be useful,
12;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with this program; if not, write to the Free Software
18;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
19;;; MA 02111-1301 USA.
20
21
22;; --------------------------------------------------------------------------
23;;
24;; Bill of Material backend written by Matt Ettus starts here
25;;
26
27;;; Bill Of Materials Generator
28;;; You must have a file called attribs in the pwd
29;;; The file should be a text list of attributes you want listed,
30;;; One per line.  No comments are allowed in the file.
31;;; Questions? Contact matt@ettus.com
32;;; This software is released under the terms of the GNU GPL
33
34(use-modules (ice-9 rdelim) ;; guile-1.8 fix
35             (gnetlist backend-getopt))
36
37(define bom:open-input-file
38  (lambda (options)
39    (let ((filename (backend-option-ref options 'attrib_file "attribs")))
40      (if (file-exists? filename)
41	  (open-input-file filename)
42	  (if (backend-option-ref options 'attribs) #f
43              (begin
44                (display (string-append "ERROR: Attribute file '" filename "' not found. You must do one of the following:\n"))
45                (display "         - Create an 'attribs' file\n")
46                (display "         - Specify an attribute file using -Oattrib_file=<filename>\n")
47                (display "         - Specify which attributes to include using -Oattribs=attrib1,attrib2,... (no spaces)\n")
48                #f))))))
49
50(define bom
51  (lambda (output-filename)
52    (let* ((options (backend-getopt
53                     (gnetlist:get-backend-arguments)
54                     '((attrib_file (value #t)) (attribs (value #t)))))
55           (port (if (string=? "-" output-filename)
56                     (current-output-port)
57                     (open-output-file output-filename)))
58           (attriblist (bom:parseconfig (bom:open-input-file options) options)))
59      (and attriblist
60           (begin (bom:printlist (cons 'refdes attriblist) port)
61                  (bom:components port packages attriblist)
62                  (close-output-port port))))))
63
64(define bom:printlist
65  (lambda (ls port)
66    (if (null? ls)
67	(newline port)
68	(begin
69	  (display (car ls) port)
70	  (write-char #\tab port)
71	  (bom:printlist (cdr ls) port)))))
72
73; Parses attrib file or argument. Returns a list of read attributes.
74(define bom:parseconfig
75  (lambda (port options)
76    (let ((attribs (backend-option-ref options 'attribs)))
77      (if attribs (string-split attribs #\,)
78          (and port
79               (let ((read-from-file (read-delimited " \n\t" port)))
80                 (cond ((eof-object? read-from-file)
81                        '())
82                       ((= 0 (string-length read-from-file))
83                        (bom:parseconfig port options))
84                       (else
85                        (cons read-from-file (bom:parseconfig port options))))))))))
86
87(define bom:components
88  (lambda (port ls attriblist)
89    (if (not (null? ls))
90	(let ((package (car ls)))
91          (if (not (string=? "1" (gnetlist:get-package-attribute package "nobom")))
92              (begin
93                (display package port)
94                (write-char #\tab port)
95                (bom:printlist (bom:find-attribs package attriblist) port)))
96	  (bom:components port (cdr ls) attriblist)))))
97
98(define bom:find-attribs
99  (lambda (package attriblist)
100    (if (null? attriblist)
101	'()
102	(cons (gnetlist:get-package-attribute package (car attriblist))
103	      (bom:find-attribs package (cdr attriblist))))))
104
105;;
106;; Bill of Material backend written by Matt Ettus ends here
107;;
108;; --------------------------------------------------------------------------
109
110