[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
guile/guile-core/scripts PROGRAM generate-autol...
|
From: |
Thien-Thi Nguyen |
|
Subject: |
guile/guile-core/scripts PROGRAM generate-autol... |
|
Date: |
Mon, 09 Jul 2001 12:35:00 -0700 |
CVSROOT: /cvs
Module name: guile
Branch: branch_release-1-6
Changes by: Thien-Thi Nguyen <address@hidden> 01/07/09 12:35:00
Modified files:
guile-core/scripts: PROGRAM generate-autoload use2dot punify
display-commentary doc-snarf
read-scheme-source
snarf-check-and-output-texi
Log message:
Remove authorship comment.
CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/scripts/PROGRAM.diff?cvsroot=OldCVS&only_with_tag=branch_release-1-6&tr1=1.2&tr2=1.2.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/scripts/generate-autoload.diff?cvsroot=OldCVS&only_with_tag=branch_release-1-6&tr1=1.2&tr2=1.2.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/scripts/use2dot.diff?cvsroot=OldCVS&only_with_tag=branch_release-1-6&tr1=1.2&tr2=1.2.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/scripts/punify.diff?cvsroot=OldCVS&only_with_tag=branch_release-1-6&tr1=1.2&tr2=1.2.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/scripts/display-commentary.diff?cvsroot=OldCVS&only_with_tag=branch_release-1-6&tr1=1.2&tr2=1.2.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/scripts/doc-snarf.diff?cvsroot=OldCVS&only_with_tag=branch_release-1-6&tr1=1.2&tr2=1.2.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/scripts/read-scheme-source.diff?cvsroot=OldCVS&only_with_tag=branch_release-1-6&tr1=1.2&tr2=1.2.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/scripts/snarf-check-and-output-texi.diff?cvsroot=OldCVS&only_with_tag=branch_release-1-6&tr1=1.2&tr2=1.2.2.1&r1=text&r2=text
Patches:
Index: guile/guile-core/scripts/PROGRAM
diff -u guile/guile-core/scripts/PROGRAM:1.1
guile/guile-core/scripts/PROGRAM:1.2
--- guile/guile-core/scripts/PROGRAM:1.1 Sun Apr 29 18:38:42 2001
+++ guile/guile-core/scripts/PROGRAM Mon May 14 12:25:32 2001
@@ -22,6 +22,8 @@
;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;; Boston, MA 02111-1307 USA
+;;; Author: J.R.Hacker
+
;;; Commentary:
;; Usage: PROGRAM [ARGS]
@@ -29,8 +31,6 @@
;; PROGRAM does something.
;;
;; TODO: Write it!
-;;
-;; Author: J.R.Hacker
;;; Code:
Index: guile/guile-core/scripts/display-commentary
diff -u guile/guile-core/scripts/display-commentary:1.1
guile/guile-core/scripts/display-commentary:1.2
--- guile/guile-core/scripts/display-commentary:1.1 Sun Apr 29 18:38:42 2001
+++ guile/guile-core/scripts/display-commentary Mon May 14 12:25:32 2001
@@ -22,13 +22,13 @@
;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;; Boston, MA 02111-1307 USA
+;;; Author: Thien-Thi Nguyen
+
;;; Commentary:
;; Usage: display-commentary FILE1 FILE2 ...
;;
;; Display Commentary section from FILE1, FILE2 and so on.
-;;
-;; Author: Thien-Thi Nguyen
;;; Code:
Index: guile/guile-core/scripts/doc-snarf
diff -u guile/guile-core/scripts/doc-snarf:1.1
guile/guile-core/scripts/doc-snarf:1.2
--- guile/guile-core/scripts/doc-snarf:1.1 Sun Apr 29 18:38:42 2001
+++ guile/guile-core/scripts/doc-snarf Mon May 14 12:25:32 2001
@@ -22,6 +22,8 @@
;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;; Boston, MA 02111-1307 USA
+;;; Author: Martin Grabmueller
+
;;; Commentary:
;; Usage: doc-snarf FILE
@@ -74,8 +76,6 @@
;; TODO: Convert option lines to alist.
;; More parameterization.
;; ../libguile/guile-doc-snarf emulation
-
-;;; Author: Martin Grabmueller
(define doc-snarf-version "0.0.2") ; please update before publishing!
Index: guile/guile-core/scripts/generate-autoload
diff -u guile/guile-core/scripts/generate-autoload:1.1
guile/guile-core/scripts/generate-autoload:1.2
--- guile/guile-core/scripts/generate-autoload:1.1 Sun Apr 29 18:38:42 2001
+++ guile/guile-core/scripts/generate-autoload Mon May 14 12:25:32 2001
@@ -22,6 +22,8 @@
;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;; Boston, MA 02111-1307 USA
+;;; Author: Thien-Thi Nguyen
+
;;; Commentary:
;; Usage: generate-autoload [OPTIONS] FILE1 FILE2 ...
@@ -55,8 +57,6 @@
;; (generate-autoload "generate-autoload")
;; (generate-autoload "--target" "(my module)" "generate-autoload")
;; (apply generate-autoload "--target" "(my module)" '("foo" "bar" "baz"))
-;;
-;; Author: Thien-Thi Nguyen
;;; Code:
Index: guile/guile-core/scripts/punify
diff -u guile/guile-core/scripts/punify:1.1 guile/guile-core/scripts/punify:1.2
--- guile/guile-core/scripts/punify:1.1 Sun Apr 29 18:38:42 2001
+++ guile/guile-core/scripts/punify Mon May 14 12:25:32 2001
@@ -22,6 +22,8 @@
;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;; Boston, MA 02111-1307 USA
+;;; Author: Thien-Thi Nguyen
+
;;; Commentary:
;; Usage: punify FILE1 FILE2 ...
@@ -38,8 +40,6 @@
;; TODO: Read from stdin.
;; Handle vectors.
;; Identifier punification.
-;;
-;; Author: Thien-Thi Nguyen
;;; Code:
Index: guile/guile-core/scripts/read-scheme-source
diff -u guile/guile-core/scripts/read-scheme-source:1.1
guile/guile-core/scripts/read-scheme-source:1.2
--- guile/guile-core/scripts/read-scheme-source:1.1 Tue May 8 18:50:39 2001
+++ guile/guile-core/scripts/read-scheme-source Mon May 14 12:25:32 2001
@@ -22,6 +22,8 @@
;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;; Boston, MA 02111-1307 USA
+;;; Author: Thien-Thi Nguyen
+
;;; Commentary:
;; Usage: read-scheme-source FILE1 FILE2 ...
@@ -35,7 +37,7 @@
;;
;; (quote (filename FILENAME))
;;
-;; (quote (comment :leading-parens N
+;; (quote (comment :leading-semicolons N
;; :text LINE))
;;
;; (quote (whitespace :text LINE))
@@ -77,8 +79,6 @@
;;
;; TODO: Add option "--clump-comments", maybe w/ different clumping styles.
;; Make `annotate!' extensible.
-;;
-;; Author: Thien-Thi Nguyen
;;; Code:
@@ -154,8 +154,9 @@
((regexp-exec all-comment-rx line)
=> (lambda (m)
(nb! `'(comment
- :leading-parens ,(let ((m1 (vector-ref m 1)))
- (- (cdr m1) (car m1)))
+ :leading-semicolons
+ ,(let ((m1 (vector-ref m 1)))
+ (- (cdr m1) (car m1)))
:text ,line))))
(else
(unread-string line p)
Index: guile/guile-core/scripts/snarf-check-and-output-texi
diff -u guile/guile-core/scripts/snarf-check-and-output-texi:1.1
guile/guile-core/scripts/snarf-check-and-output-texi:1.2
--- guile/guile-core/scripts/snarf-check-and-output-texi:1.1 Thu May 31
05:45:32 2001
+++ guile/guile-core/scripts/snarf-check-and-output-texi Sun Jun 24
20:30:32 2001
@@ -27,8 +27,99 @@
;;; Code:
(define-module (scripts snarf-check-and-output-texi)
+ :use-module (ice-9 streams)
+ :use-module (ice-9 match)
:export (snarf-check-and-output-texi))
+;;; why aren't these in some module?
+
+(define-macro (when cond . body)
+ `(if ,cond (begin ,@body)))
+
+(define-macro (unless cond . body)
+ `(if (not ,cond) (begin ,@body)))
+
+(define (snarf-check-and-output-texi)
+ (process-stream (current-input-port)))
+
+(define (process-stream port)
+ (let loop ((input (stream-map (match-lambda
+ (('id . s)
+ (cons 'id (string->symbol s)))
+ (('int_dec . s)
+ (cons 'int (string->number s)))
+ (('int_oct . s)
+ (cons 'int (string->number s 8)))
+ (('int_hex . s)
+ (cons 'int (string->number s 16)))
+ ((and x (? symbol?))
+ (cons x x))
+ ((and x (? string?))
+ (cons 'string x))
+ (x x))
+ (make-stream (lambda (s)
+ (let loop ((s s))
+ (cond
+ ((stream-null? s) #t)
+ ((eq? 'eol (stream-car s))
+ (loop (stream-cdr s)))
+ (else (cons (stream-car s)
(stream-cdr s))))))
+ (port->stream port read)))))
+
+ (unless (stream-null? input)
+ (let ((token (stream-car input)))
+ (if (eq? (car token) 'snarf_cookie)
+ (dispatch-top-cookie (stream-cdr input)
+ loop)
+ (loop (stream-cdr input)))))))
+
+(define (dispatch-top-cookie input cont)
+
+ (when (stream-null? input)
+ (error 'syntax "premature end of file"))
+
+ (let ((token (stream-car input)))
+ (cond
+ ((eq? (car token) 'brace_open)
+ (consume-multiline (stream-cdr input)
+ cont))
+ (else
+ (consume-upto-cookie process-singleline
+ input
+ cont)))))
+
+(define (consume-upto-cookie process input cont)
+ (let loop ((acc '()) (input input))
+
+ (when (stream-null? input)
+ (error 'syntax "premature end of file in directive context"))
+
+ (let ((token (stream-car input)))
+ (cond
+ ((eq? (car token) 'snarf_cookie)
+ (process (reverse! acc))
+ (cont (stream-cdr input)))
+
+ (else (loop (cons token acc) (stream-cdr input)))))))
+
+(define (consume-multiline input cont)
+ (begin-multiline)
+
+ (let loop ((input input))
+
+ (when (stream-null? input)
+ (error 'syntax "premature end of file in multiline context"))
+
+ (let ((token (stream-car input)))
+ (cond
+ ((eq? (car token) 'brace_close)
+ (end-multiline)
+ (cont (stream-cdr input)))
+
+ (else (consume-upto-cookie process-multiline-directive
+ input
+ loop))))))
+
(define *file* #f)
(define *line* #f)
(define *function-name* #f)
@@ -36,63 +127,17 @@
(define *args* #f)
(define *sig* #f)
(define *docstring* #f)
-
-(define (doc-block args)
- (let loop ((args args))
- (if (not (null? args))
- (let ((arg (car args)))
- (if (not (null? arg))
- (begin
-
- (case (car arg)
-
- ((fname)
- (set! *function-name* (cdr arg)))
-
- ((type)
- (set! *snarf-type* (cdr arg)))
-
- ((location)
- (set! *file* (cadr arg))
- (set! *line* (cddr arg)))
-
- ((arglist)
- (set! *args* (cdr arg)))
-
- ((argsig)
- (set! *sig* (cdr arg)))
-
- ((docstring)
- (set! *docstring* (cdr arg)))
-
- (else
- (error (format #f "unknown doc attribute: ~A" (car arg)))))))
- (loop (cdr args)))))
- (output-doc-block))
-(define (doc-check arg)
- (if (not (null? arg))
+(define (begin-multiline)
+ (set! *file* #f)
+ (set! *line* #f)
+ (set! *function-name* #f)
+ (set! *snarf-type* #f)
+ (set! *args* #f)
+ (set! *sig* #f)
+ (set! *docstring* #f))
- (case (car arg)
-
- ((argpos)
- (let* ((name (cadr arg))
- (pos (caddr arg))
- (line (cadddr arg))
- (idx (list-index *args* name)))
- (cond
- ((not idx))
- ((not (number? pos)))
- ((= 0 pos))
- ((not (= (+ idx 1) pos))
- (display (format #f "~A:~A: wrong position for argument \"~A\":
~A (should be ~A)\n"
- *file* line name pos (+ idx 1))
- (current-error-port))))))
-
- (else
- (error (format #f "unknown check: ~A" (car arg)))))))
-
-(define (output-doc-block)
+(define (end-multiline)
(let* ((req (car *sig*))
(opt (cadr *sig*))
(var (caddr *sig*))
@@ -137,21 +182,99 @@
(loop (cdr strings)))))
(display "address@hidden deffn\n"))))
-(define (snarf-check-and-output-texi)
- (let loop ((form (read)))
- (if (not (eof-object? form))
- (begin
- (if (not (null? form))
-
- (case (car form)
-
- ((doc-block)
- (doc-block (cdr form)))
-
- ((doc-check)
- (doc-check (cdr form)))
-
- (else (error (format #f "unknown doc command: ~A" (car form))))))
- (loop (read))))))
+(define (texi-quote s)
+ (let rec ((i 0))
+ (if (= i (string-length s))
+ ""
+ (string-append (let ((ss (substring s i (+ i 1))))
+ (if (string=? ss "@")
+ "@@"
+ ss))
+ (rec (+ i 1))))))
+
+(define (process-multiline-directive l)
+
+ (define do-args
+ (match-lambda
+
+ (('(paren_close . paren_close))
+ '())
+
+ (('(comma . comma) rest ...)
+ (do-args rest))
+
+ (('(id . SCM) ('id . name) rest ...)
+ (cons name (do-args rest)))
+
+ (x (error (format #f "invalid argument syntax: ~A" (map cdr x))))))
+
+ (define do-arglist
+ (match-lambda
+
+ (('(paren_open . paren_open) '(id . void) '(paren_close . paren_close))
+ '())
+
+ (('(paren_open . paren_open) rest ...)
+ (do-args rest))
+
+ (x (error (format #f "invalid arglist syntax: ~A" (map cdr x))))))
+
+ (define do-command
+ (match-lambda
+
+ (('fname ('string . name))
+ (set! *function-name* (texi-quote name)))
+
+ (('type ('id . type))
+ (set! *snarf-type* type))
+
+ (('type ('int . num))
+ (set! *snarf-type* num))
+
+ (('location ('string . file) ('int . line))
+ (set! *file* file)
+ (set! *line* line))
+
+ (('arglist rest ...)
+ (set! *args* (do-arglist rest)))
+
+ (('argsig ('int . req) ('int . opt) ('int . var))
+ (set! *sig* (list req opt var)))
+
+ (x (error (format #f "unknown doc attribute: ~A" x)))))
+
+ (define do-directive
+ (match-lambda
+
+ ((('id . command) rest ...)
+ (do-command (cons command rest)))
+
+ ((('string . string) ...)
+ (set! *docstring* string))
+
+ (x (error (format #f "unknown doc attribute syntax: ~A" x)))))
+
+ (do-directive l))
+
+(define (process-singleline l)
+
+ (define do-argpos
+ (match-lambda
+ ((('id . name) ('int . pos) ('int . line))
+ (let ((idx (list-index *args* name)))
+ (when idx
+ (unless (= (+ idx 1) pos)
+ (display (format #f "~A:~A: wrong position for argument ~A: ~A
(should be ~A)\n"
+ *file* line name pos (+ idx 1)))))))
+ (x #f)))
+
+ (define do-command
+ (match-lambda
+ (('(id . argpos) rest ...)
+ (do-argpos rest))
+ (x (error (format #f "unknown check: ~A" x)))))
+
+ (when *function-name*
+ (do-command l)))
(define main snarf-check-and-output-texi)
Index: guile/guile-core/scripts/use2dot
diff -u guile/guile-core/scripts/use2dot:1.1
guile/guile-core/scripts/use2dot:1.2
--- guile/guile-core/scripts/use2dot:1.1 Sun Apr 29 18:38:42 2001
+++ guile/guile-core/scripts/use2dot Mon May 14 12:25:32 2001
@@ -22,6 +22,8 @@
;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;; Boston, MA 02111-1307 USA
+;;; Author: Thien-Thi Nguyen based on PERL script by Keisuke Nishida
+
;;; Commentary:
;; Usage: use2dot [OPTIONS] [FILE ...]
@@ -51,8 +53,6 @@
;; - add `--load-synonyms' option
;; - add `--ignore-module' option
;; - handle arbitrary command-line key/value configuration
-;;
-;; Author: Thien-Thi Nguyen based on PERL script by Keisuke Nishida
;;; Code:
- guile/guile-core/scripts PROGRAM generate-autol...,
Thien-Thi Nguyen <=