display-commentary 2.5 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071
  1. #!/bin/sh
  2. # aside from this initial boilerplate, this is actually -*- scheme -*- code
  3. main='(module-ref (resolve-module '\''(scripts display-commentary)) '\'main')'
  4. exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
  5. !#
  6. ;;; display-commentary --- As advertized
  7. ;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.
  8. ;;
  9. ;; This program is free software; you can redistribute it and/or
  10. ;; modify it under the terms of the GNU General Public License as
  11. ;; published by the Free Software Foundation; either version 2, or
  12. ;; (at your option) any later version.
  13. ;;
  14. ;; This program is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  17. ;; General Public License for more details.
  18. ;;
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with this software; see the file COPYING. If not, write to
  21. ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  22. ;; Boston, MA 02110-1301 USA
  23. ;;; Author: Thien-Thi Nguyen
  24. ;;; Commentary:
  25. ;; Usage: display-commentary REF1 REF2 ...
  26. ;;
  27. ;; Display Commentary section from REF1, REF2 and so on.
  28. ;; Each REF may be a filename or module name (list of symbols).
  29. ;; In the latter case, a filename is computed by searching `%load-path'.
  30. ;;; Code:
  31. (define-module (scripts display-commentary)
  32. :use-module (ice-9 documentation)
  33. :export (display-commentary))
  34. (define (display-commentary-one file)
  35. (format #t "~A commentary:\n~A" file (file-commentary file)))
  36. (define (module-name->filename-frag ls) ; todo: export or move
  37. (let ((ls (map symbol->string ls)))
  38. (let loop ((ls (cdr ls)) (acc (car ls)))
  39. (if (null? ls)
  40. acc
  41. (loop (cdr ls) (string-append acc "/" (car ls)))))))
  42. (define (display-module-commentary module-name)
  43. (cond ((%search-load-path (module-name->filename-frag module-name))
  44. => (lambda (file)
  45. (format #t "module ~A\n" module-name)
  46. (display-commentary-one file)))))
  47. (define (display-commentary . refs)
  48. (for-each (lambda (ref)
  49. (cond ((string? ref)
  50. (if (equal? 0 (string-index ref #\())
  51. (display-module-commentary
  52. (with-input-from-string ref read))
  53. (display-commentary-one ref)))
  54. ((list? ref)
  55. (display-module-commentary ref))))
  56. refs))
  57. (define main display-commentary)
  58. ;;; display-commentary ends here