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

* snarf-check-and-output-texi: print optional args in a prettier

Browse source 
manner.
This commit is contained in:
Michael Livshin 2001-08-06 23:19:05 +00:00
parent 5753f02f67
commit fd7ec88302
2 changed files with 22 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

5
scripts/ChangeLog
View file

@ -1,3 +1,8 @@
2001-08-07 Michael Livshin <mlivshin@bigfoot.com>
* snarf-check-and-output-texi: print optional args in a prettier
manner.
2001-08-01 Thien-Thi Nguyen <ttn@revel.glug.org> 2001-08-01 Thien-Thi Nguyen <ttn@revel.glug.org>
* PROGRAM, README, display-commentary, doc-snarf, * PROGRAM, README, display-commentary, doc-snarf,

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

@ -152,26 +152,25 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
(with-output-to-string (with-output-to-string
(lambda () (lambda ()
(format #t "~A" *function-name*) (format #t "~A" *function-name*)
(let loop-req ((r 0)) (let loop-req ((args *args*) (r 0))
(if (< r req) (if (< r req)
(begin (begin
(format #t " ~A" (list-ref *args* r)) (format #t " ~A" (car args))
(loop-req (+ 1 r))) (loop-req (cdr args) (+ 1 r)))
(begin (let loop-opt ((o 0) (args args) (tail '()))
(if (> opt 0) (if (< o opt)
(format #t "~A[" (if (> req 0) " " ""))) (begin
(let loop-opt ((o 0) (space #f)) (format #t " [~A" (car args))
(if (< o opt) (loop-opt (+ 1 o) (cdr args) (cons #\] tail)))
(begin (begin
(format #t "~A~A" (if space " " "") (if (> var 0)
(list-ref *args* (+ r o))) (format #t " . ~A"
(loop-opt (+ 1 o) #t)) (car args)))
(begin (let loop-tail ((tail tail))
(if (> opt 0) (if (not (null? tail))
(format #t "]")) (begin
(if (> var 0) (format #t "~A" (car tail))
(format #t " . ~A" (loop-tail (cdr tail)))))))))))))))
(car (last-pair *args*)))))))))))))))
(format #t "\n ~A\n" *function-name*) (format #t "\n ~A\n" *function-name*)
(format #t "@c snarfed from ~A:~A\n" *file* *line*) (format #t "@c snarfed from ~A:~A\n" *file* *line*)
(format #t "@deffn primitive ~A\n" nice-sig) (format #t "@deffn primitive ~A\n" nice-sig)