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