display-commentary.scm 2.4 KB

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