gnetlist/scheme/gnet-bom.scm

   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., 675 Mass Ave, Cambridge, MA 02139, USA.
  19
  20
  21 ;; --------------------------------------------------------------------------
  22 ;;
  23 ;; Bill of Material backend written by Matt Ettus starts here
  24 ;;
  25
  26 ;;; Bill Of Materials Generator
  27 ;;; You must have a file called attribs in the pwd
  28 ;;; The file should be a text list of attributes you want listed,
  29 ;;; One per line.  No comments are allowed in the file.
  30 ;;; Questions? Contact matt@ettus.com
  31 ;;; This software is released under the terms of the GNU GPL
  32
  33 (use-modules (ice-9 rdelim))  ;; guile-1.8 fix
  34
  35 (define bom
  36   (lambda (output-filename)
  37     (let ((port (if (string=? "-" output-filename)
  38                       (current-output-port)
  39                       (open-output-file output-filename)))
  40           (attriblist (bom:parseconfig (open-input-file "attribs"))))
  41       (bom:printlist (cons 'refdes attriblist) port)
  42       (bom:components port packages attriblist)
  43       (close-output-port port))))
  44
  45 (define bom:printlist
  46   (lambda (ls port)
  47     (if (null? ls)
  48         (newline port)
  49         (begin
  50           (display (car ls) port)
  51           (write-char #\tab port)
  52           (bom:printlist (cdr ls) port)))))
  53
  54 ; Parses attrib file. Returns a list of read attributes.
  55 (define bom:parseconfig
  56   (lambda (port)
  57     (let ((read-from-file (read-delimited " \n\t" port)))
  58       (cond ((eof-object? read-from-file)
  59              '())
  60             ((= 0 (string-length read-from-file))
  61              (bom:parseconfig port))
  62             (else
  63              (cons read-from-file (bom:parseconfig port)))))))
  64
  65 (define bom:components
  66   (lambda (port ls attriblist)
  67     (if (not (null? ls))
  68         (let ((package (car ls)))
  69           (if (not (string=? "1" (gnetlist:get-package-attribute package "nobom")))
  70             (begin
  71               (display package port)
  72               (write-char #\tab port)
  73               (bom:printlist (bom:find-attribs package attriblist) port)))
  74           (bom:components port (cdr ls) attriblist)))))
  75
  76 (define bom:find-attribs
  77   (lambda (package attriblist)
  78     (if (null? attriblist)
  79         '()
  80         (cons (gnetlist:get-package-attribute package (car attriblist))
  81               (bom:find-attribs package (cdr attriblist))))))
  82
  83 ;;
  84 ;; Bill of Material backend written by Matt Ettus ends here
  85 ;;
  86 ;; --------------------------------------------------------------------------
  87