mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00
Code Activity

* These changes add a @deffnx C function declaration and function

Browse source 
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.
This commit is contained in:
Neil Jerram 2001-11-16 09:55:54 +00:00
parent 73c844bf02
commit cecb4a5e9d
6 changed files with 96 additions and 54 deletions
Download patch file Download diff file Expand all files Collapse all files

52
scripts/snarf-check-and-output-texi
View file

@ -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)))