From 30745bed078a9c71aef2bc868c43c922a1da124a Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Tue, 15 Jan 2013 11:18:18 -0800 Subject: [PATCH] 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 --- nickle/retab | 58 +++++++++++++++++++++++++ scheme/gnet-partslist-bom.scm | 2 +- scheme/gnet-partslist-common.scm | 73 ++++++++++++++++++++++++++++++++ scheme/gnet-partslist-csv.scm | 2 +- 4 files changed, 133 insertions(+), 2 deletions(-) create mode 100644 nickle/retab create mode 100644 scheme/gnet-partslist-common.scm diff --git a/nickle/retab b/nickle/retab new file mode 100644 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 dd90ea0..718d76c 100644 --- 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 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 291bb0a..53f9849 100644 --- 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) -- 2.47.2