[Author Prev][Author Next][Thread Prev][Thread Next][Author Index][Thread Index]
gEDA-cvs: CVS update: Makefile.am
User: pbernaud
Date: 05/02/24 17:01:45
Modified: . Makefile.am
Added: . notangle_guile.in
Removed: . notangle_guile.scm.in
Log:
Renamed notangle_guile.scm.in to notangle_guile.in.
Revision Changes Path
1.5 +2 -2 eda/geda/devel/libgeda/scripts/Makefile.am
(In the diff below, changes in quantity of whitespace are not shown.)
Index: Makefile.am
===================================================================
RCS file: /home/cvspsrv/cvsroot/eda/geda/devel/libgeda/scripts/Makefile.am,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- Makefile.am 10 Feb 2002 04:44:12 -0000 1.4
+++ Makefile.am 24 Feb 2005 22:01:45 -0000 1.5
@@ -1,8 +1,8 @@
-EXTRA_DIST = geda_totexi.in prepnoweb notangle_guile.scm.in
+EXTRA_DIST = geda_totexi.in prepnoweb notangle_guile.in
MOSTLYCLEANFILES = *.log *~
CLEANFILES = *.log *~
DISTCLEANFILES = *.log core FILE *~ prototype.bak \
- geda_totexi notangle_guile.scm
+ geda_totexi notangle_guile
MAINTAINERCLEANFILES = *.log *~ Makefile.in configure
1.1 eda/geda/devel/libgeda/scripts/notangle_guile.in
Index: notangle_guile.in
===================================================================
#! @GUILEINTERP@ \
-e main -s
!#
;;; Copyright (C) 2001, 2005 by Patrick Bernaud. All rights reserved
;;; See file COPYRIGHT for more information.
;;; This scripts is supposed to do the same things as notangle do.
;;; Its purpose it to avoid the need of a complete noweb installation
;;; to simply get the sources from a noweb file, provided the user
;;; has a Guile interpreter.
(use-modules (ice-9 getopt-long)
(ice-9 regex))
(debug-enable 'backtrace)
(define noweb-rootname "*")
(define noweb-filename #f)
(define code-chunks '())
(define def-regexp (make-regexp "^\<\<(.*)\>\>="))
(define ref-regexp (make-regexp "\<\<([^>]*)\>\>"))
(define end-regexp (make-regexp "^@\ ?"))
(define (tangle-step1)
;; reads and returns a code chunk
(define (read-code-chunk)
(let loop ((line (read-line (current-input-port) 'concat)))
(if (not (eof-object? line))
(let ((res (regexp-exec end-regexp line)))
;; code chunk ends at line that match end-regexp (^@\ ?)
(if (regexp-match? res)
;; reached end of chunk
'()
;; end not yet reached, continues the analyze
(append (list line)
(loop (read-line (current-input-port) 'concat))))))))
;; identifies code chunk and adds them to the association table
(let loop ((line ""))
(if (not (eof-object? line))
(let ((m (regexp-exec def-regexp line)))
(if (regexp-match? m)
(add-code-chunk (match:substring m 1) (read-code-chunk)))
(loop (read-line))))))
(define (tangle-step2)
;; search in the association table for a code chunk named name
;; and output its content recursively, looking for embedded references
(define (output-code-chunk name offset)
(let ((code (assoc-ref code-chunks name))
(first #t))
;; check there actually exists a code chunk with this name
(if code
;; yes, go on and process each line of the code chunk
(for-each
(lambda (line)
;; the offset must not be printed when it is the first line
;; of a code chunk
(if (not first) (display offset) (set! first #f))
;; search for one (or more) chunk reference in the current line
(let loop ((l line))
(let ((m (regexp-exec ref-regexp l)))
(if (regexp-match? m)
;; found a reference in the line, process it
(begin
(display (match:prefix m))
(output-code-chunk (match:substring m 1)
(string-append offset
(make-string
(match:start m)
#\space)))
(loop (match:suffix m)))
;; no reference found, output the full line
(display l)))))
code)
(error (format #f "undefined chunk name: \<\<~a\>\>~%" name)))))
;; check there is a code chunk with name rootname
(if (assoc-ref code-chunks noweb-rootname)
;; ok, start tangling from rootname and null offset
(output-code-chunk noweb-rootname "")
(error (format #f "The root module \<\<~a\>\> was not defined.~%"
noweb-rootname))))
(define (tangle-noweb)
;; first reads the file and collect the code chunks
(tangle-step1)
;; then assemble them
(tangle-step2))
(define (add-code-chunk name code)
;; the last newline char of a code chunk must be removed
(let ((last (1- (length code))))
(if (>= last 0)
(list-set! code last (remove-newline (list-ref code last)))))
;; add a new entry for name to the association list code-chunks
;; or complete an entry if it already exists
(set! code-chunks
(assoc-set! code-chunks name
(let ((code-prev (assoc-ref code-chunks name)))
;; check if chunk is already defined
(if code-prev
;; yes, append new code
(append code-prev (list "\n") code)
;; otherwise, only associate name with code
code)))))
(define (remove-newline str)
(cond ((string-null? str) str)
((char=? (string-ref str (1- (string-length str))) #\newline)
(substring str 0 (1- (string-length str))))
(else str)))
(define option-spec
'((rootname (required? #f) (single-char #\R) (value #t))
(help (required? #f) (single-char #\h))
(version (required? #f) (single-char #\v))
))
(define (display-usage)
(display "Usage: notangle_guile [options...] [file]\n")
(display " --help, -h Show this usage information\n")
(display " --version, -v Show version information\n")
(display " --rootname=value, -Rvalue Set root code chunk name to value\n")
(exit))
(define (display-version)
(display "notangle_guile 20050224\n")
(exit))
(define (main args)
;; processing command line
(let* ((opts (getopt-long args option-spec))
(help-wanted (option-ref opts 'help #f))
(version-wanted (option-ref opts 'version #f))
(rootname (option-ref opts 'rootname #f))
(filename (option-ref opts '() #f)))
;; display version if -v flag
(if version-wanted (display-version))
;; display usage if -h flag
(if help-wanted (display-usage))
;; if a filename is given, filename is a string
;; else, filename is set to #f
(if (not (null? filename))
(if (file-exists? (car filename))
(set! noweb-filename (car filename))
(error (format #f "couldn't find file ~a~%" (car filename)))))
;; if rootname is given, rootname is a string
;; else, rootname is set to #f
(if (string? rootname)
(set! noweb-rootname rootname)))
;; start tangling
(if (string? noweb-filename)
;; work on a file
(with-input-from-file noweb-filename
(lambda ()
(tangle-noweb)))
;; no file specified, work on current input port
(tangle-noweb)))