summaryrefslogtreecommitdiff
path: root/scripts/snarf-check-and-output-texi
diff options
context:
space:
mode:
authorNeil Jerram <neil@ossau.uklinux.net>2001-11-16 09:55:54 +0000
committerNeil Jerram <neil@ossau.uklinux.net>2001-11-16 09:55:54 +0000
commitcecb4a5e9dbaebcc28f3be0a02feac4263a2cfcc (patch)
tree786d449cb6dbfaa57724d24c85b67b8b073fddcb /scripts/snarf-check-and-output-texi
parent73c844bf02487de732da88ec290a44029a8247d9 (diff)
downloadguile-cecb4a5e9dbaebcc28f3be0a02feac4263a2cfcc.tar.gz
* These changes add a @deffnx C function declaration and function
index entries for each Guile primitive to the copy of the doc snarf output that is used for reference manual synchronization. Online help is unchanged.
Diffstat (limited to 'scripts/snarf-check-and-output-texi')
-rwxr-xr-xscripts/snarf-check-and-output-texi52
1 files changed, 44 insertions, 8 deletions
diff --git a/scripts/snarf-check-and-output-texi b/scripts/snarf-check-and-output-texi
index a300ca78e..f6ca78757 100755
--- a/scripts/snarf-check-and-output-texi
+++ b/scripts/snarf-check-and-output-texi
@@ -39,7 +39,11 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
(define-macro (unless cond . body)
`(if (not ,cond) (begin ,@body)))
-(define (snarf-check-and-output-texi)
+(define *manual-flag* #f)
+
+(define (snarf-check-and-output-texi . flags)
+ (if (memq '--manual flags)
+ (set! *manual-flag* #t))
(process-stream (current-input-port)))
(define (process-stream port)
@@ -122,6 +126,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
(define *file* #f)
(define *line* #f)
+(define *c-function-name* #f)
(define *function-name* #f)
(define *snarf-type* #f)
(define *args* #f)
@@ -131,12 +136,16 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
(define (begin-multiline)
(set! *file* #f)
(set! *line* #f)
+ (set! *c-function-name* #f)
(set! *function-name* #f)
(set! *snarf-type* #f)
(set! *args* #f)
(set! *sig* #f)
(set! *docstring* #f))
+(define *primitive-deffnx-signature* "@deffnx primitive ")
+(define *primitive-deffnx-sig-length* (string-length *primitive-deffnx-signature*))
+
(define (end-multiline)
(let* ((req (car *sig*))
(opt (cadr *sig*))
@@ -170,16 +179,40 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
(if (not (null? tail))
(begin
(format #t "~A" (car tail))
- (loop-tail (cdr tail)))))))))))))))
+ (loop-tail (cdr tail))))))))))))))
+ (scm-deffnx
+ (if (and *manual-flag* (eq? *snarf-type* 'primitive))
+ (with-output-to-string
+ (lambda ()
+ (format #t "@deffnx function SCM ~A (" *c-function-name*)
+ (unless (null? *args*)
+ (format #t "SCM ~A" (car *args*))
+ (let loop ((args (cdr *args*)))
+ (unless (null? args)
+ (format #t ", SCM ~A" (car args))
+ (loop (cdr args)))))
+ (format #t ")\n")))
+ #f)))
(format #t "\n ~A\n" *function-name*)
(format #t "@c snarfed from ~A:~A\n" *file* *line*)
(format #t "@deffn primitive ~A\n" nice-sig)
- (let loop ((strings *docstring*))
- (if (not (null? strings))
- (begin
- (display (car strings))
- (loop (cdr strings)))))
- (display "\n@end deffn\n"))))
+ (let loop ((strings *docstring*) (scm-deffnx scm-deffnx))
+ (cond ((null? strings))
+ ((or (not scm-deffnx)
+ (and (>= (string-length (car strings))
+ *primitive-deffnx-sig-length*)
+ (string=? (substring (car strings)
+ 0 *primitive-deffnx-sig-length*)
+ *primitive-deffnx-signature*)))
+ (display (car strings))
+ (loop (cdr strings) scm-deffnx))
+ (else (display scm-deffnx)
+ (loop strings #f))))
+ (display "\n")
+ (when *manual-flag*
+ (format #t "@findex ~A\n" *function-name*)
+ (format #t "@findex ~A\n" *c-function-name*))
+ (display "@end deffn\n"))))
(define (texi-quote s)
(let rec ((i 0))
@@ -221,6 +254,9 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
(define do-command
(match-lambda
+ (('cname ('id . name))
+ (set! *c-function-name* (texi-quote (symbol->string name))))
+
(('fname ('string . name))
(set! *function-name* (texi-quote name)))