Copy old gnet-partslist-common into local repo. Add retab

gnet-partslist-common.scm was part of the old gEDA distribution and
the local scripts were using it. Copy it here now that it's gone from upstream.

Signed-off-by: Keith Packard <keithp@keithp.com>

diff --git a/nickle/retab b/nickle/retab
new file mode 100644 (file)
index 0000000..b04ee10
--- /dev/null
+++ b/nickle/retab
@@ -0,0 +1,58 @@
+#!/usr/bin/nickle
+
+string[*][*]   lines;
+int[*]         widths;
+
+string[*] get_one(file in) {
+       string  l = File::fgets(in);
+       return String::wordsplit(l, "\t");
+}
+
+string[*][*] get_all(file in) {
+       string[...][*] l = {};
+       while (!File::end(in))
+               l[dim(l)] = get_one(in);
+       return l;
+}
+
+int[*] find_widths(string[*][*] lines) {
+       int[...]        w = {};
+       for (int r = 0; r < dim(lines); r++) {
+               for (int c = 0; c < dim(lines[r]); c++) {
+                       int     len = String::length(lines[r][c]);
+                       if (c >= dim(w))
+                               w[c] = len;
+                       else
+                               w[c] = max(w[c], len);
+               }
+       }
+       return w;
+}
+
+void print_one(string s, int w) {
+       int     l = String::length(s);
+       printf ("%s ", s);
+       while (l < w) {
+               putchar(' ');
+               l++;
+       }
+}
+
+void print_line(string[*] line) {
+       for (int c = 0; c < dim(line); c++)
+               print_one(line[c], widths[c]);
+       putchar('\n');
+}
+
+void print_all() {
+       for (int r = 0; r < dim(lines); r++)
+               print_line(lines[r]);
+}
+
+void doit () {
+       lines = get_all(stdin);
+       widths = find_widths(lines);
+       print_all();
+}
+
+doit();

diff --git a/scheme/gnet-partslist-bom.scm b/scheme/gnet-partslist-bom.scm
index dd90ea037f7c9379056deea606cfd7516d436b0e..718d76c60eea4f66eedd577105bd4ce750c8f9c3 100644 (file)
--- a/scheme/gnet-partslist-bom.scm
+++ b/scheme/gnet-partslist-bom.scm
@@ -16,7 +16,7 @@
 ; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ; The /'s may not work on win32
-(load (string-append gedadata "/scheme/gnet-partslist-common.scm"))
+(load-from-path "gnet-partslist-common.scm")
 
 (define (caddddddr s)
   (car (cdr (cdr (cdr (cdr (cdr (cdr s))))))))

diff --git a/scheme/gnet-partslist-common.scm b/scheme/gnet-partslist-common.scm
new file mode 100644 (file)
index 0000000..d4c235d
--- /dev/null
+++ b/scheme/gnet-partslist-common.scm
@@ -0,0 +1,73 @@
+; Copyright (C) 2001-2010 MIYAMOTO Takanori
+; gnet-partslist-common.scm
+; 
+; 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 2 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, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define (get-parts-table packages)
+  (if (null? packages)
+      '()
+      (let ((package (car packages)))
+       (if (string=? (get-device package) "include")
+           (get-parts-table (cdr packages))
+           (cons (list package
+                       (get-device package)
+                       (get-value package)  
+                       (gnetlist:get-package-attribute package "footprint")) ;; sdb change
+                 (get-parts-table (cdr packages)))))))
+
+(define (write-one-row ls separator end-char port)
+  (if (null? ls)
+      '()
+      (begin (display (car ls) port)
+            (for-each (lambda (st) (display separator port)(display st port)) (cdr ls))
+            (display end-char port))))
+
+(define (get-sortkey-value ls key-column)
+  (list-ref (car ls) key-column))
+
+(define (marge-sort-sub ls1 ls2 key-column)
+  (if (or (null? ls1) (null? ls2))
+      (append ls1 ls2)
+      (if (string-ci<=? (get-sortkey-value ls1  key-column) (get-sortkey-value ls2 key-column))
+         (cons (car ls1) (marge-sort-sub (cdr ls1) ls2 key-column))
+         (cons (car ls2) (marge-sort-sub ls1 (cdr ls2) key-column)))))
+
+(define (marge-sort ls key-column)
+  (let ((midpoint (inexact->exact (floor (/ (length ls) 2)))))
+    (if (<= (length ls) 1)
+       (append ls)
+       (let ((top-half (reverse (list-tail (reverse ls) midpoint)))
+             (bottom-half (list-tail ls (- (length ls) midpoint))))
+         (set! top-half (marge-sort top-half key-column))
+         (set! bottom-half (marge-sort bottom-half key-column))
+         (marge-sort-sub top-half bottom-half key-column)))))
+
+(define (marge-sort-with-multikey ls key-columns)
+  (if (or (<= (length ls) 1) (null? key-columns))
+      (append ls)
+      (let* ((key-column (car key-columns))
+            (sorted-ls (marge-sort ls key-column))
+            (key-column-only-ls 
+             ((lambda (ls) (let loop ((l ls))
+                             (if (null? l)
+                                 '()
+                                 (cons (get-sortkey-value l key-column) (loop (cdr l))))))
+              sorted-ls))
+            (first-value (get-sortkey-value sorted-ls key-column))
+            (match-length (length (member first-value (reverse key-column-only-ls))))
+            (first-ls (list-tail (reverse sorted-ls) (- (length sorted-ls) match-length)))
+            (rest-ls (list-tail sorted-ls match-length)))
+       (append (marge-sort-with-multikey first-ls (cdr key-columns))
+               (marge-sort-with-multikey rest-ls key-columns)))))

diff --git a/scheme/gnet-partslist-csv.scm b/scheme/gnet-partslist-csv.scm
index 291bb0a00fe54628b9171ccc2c1a09d5011b9618..53f98496090947a48992ae2a76a5830aeda2bad6 100644 (file)
--- a/scheme/gnet-partslist-csv.scm
+++ b/scheme/gnet-partslist-csv.scm
@@ -16,7 +16,7 @@
 ; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ; The /'s may not work on win32
-(load (string-append gedadata "/scheme/gnet-partslist-common.scm"))
+(load-from-path "gnet-partslist-common.scm")
 
 (define partslist-csv:write-top-header
   (lambda (port)