summaryrefslogtreecommitdiff
path: root/module/scripts/generate-autoload.scm
blob: 781931015515c17423680e6a0d319d78fa8a493e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
;;; generate-autoload --- Display define-module form with autoload info

;; 	Copyright (C) 2001, 2006 Free Software Foundation, Inc.
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public License
;; as published by the Free Software Foundation; either version 3, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this software; see the file COPYING.LESSER.  If
;; not, write to the Free Software Foundation, Inc., 51 Franklin
;; Street, Fifth Floor, Boston, MA 02110-1301 USA

;;; Author: Thien-Thi Nguyen

;;; Commentary:

;; Usage: generate-autoload [OPTIONS] FILE1 FILE2 ...
;;
;; The autoload form is displayed to standard output:
;;
;; (define-module (guile-user)
;;   :autoload (ZAR FOO) (FOO-1 FOO-2 ...)
;;     :
;;     :
;;   :autoload (ZAR BAR) (BAR-1 BAR-2 ...))
;;
;; For each file, a symbol triggers an autoload if it is found in one
;; of these situations:
;;  - in the `:export' clause of a `define-module' form
;;  - in a top-level `export' or `export-syntax' form
;;  - in a `define-public' form
;;  - in a `defmacro-public' form
;;
;; The module name is inferred from the `define-module' form.  If either the
;; module name or the exports list cannot be determined, no autoload entry is
;; generated for that file.
;;
;; Options:
;; --target MODULE-NAME         -- Use MODULE-NAME instead of `(guile-user)'.
;;                                 Note that some shells may require you to
;;                                 quote the argument to handle parentheses
;;                                 and spaces.
;;
;; Usage examples from Scheme code as a module:
;; (use-modules (scripts generate-autoload))
;; (generate-autoload "generate-autoload")
;; (generate-autoload "--target" "(my module)" "generate-autoload")
;; (apply generate-autoload "--target" "(my module)" '("foo" "bar" "baz"))

;;; Code:

(define-module (scripts generate-autoload)
  :export (generate-autoload))

(define (autoload-info file)
  (let ((p (open-input-file file)))
    (let loop ((form (read p)) (module-name #f) (exports '()))
      (if (eof-object? form)
          (and module-name
               (not (null? exports))
               (list module-name exports)) ; ret
          (cond ((and (list? form)
                      (< 1 (length form))
                      (eq? 'define-module (car form)))
                 (loop (read p)
                       (cadr form)
                       (cond ((member ':export form)
                              => (lambda (val)
                                   (append (cadr val) exports)))
                             (else exports))))
                ((and (list? form)
                      (< 1 (length form))
                      (memq (car form) '(export export-syntax)))
                 (loop (read p)
                       module-name
                       (append (cdr form) exports)))
                ((and (list? form)
                      (< 2 (length form))
                      (eq? 'define-public (car form))
                      (list? (cadr form))
                      (symbol? (caadr form)))
                 (loop (read p)
                       module-name
                       (cons (caadr form) exports)))
                ((and (list? form)
                      (< 2 (length form))
                      (eq? 'define-public (car form))
                      (symbol? (cadr form)))
                 (loop (read p)
                       module-name
                       (cons (cadr form) exports)))
                ((and (list? form)
                      (< 3 (length form))
                      (eq? 'defmacro-public (car form))
                      (symbol? (cadr form)))
                 (loop (read p)
                       module-name
                       (cons (cadr form) exports)))
                (else (loop (read p) module-name exports)))))))

(define (generate-autoload . args)
  (let* ((module-count 0)
         (syms-count 0)
         (target-override (cond ((member "--target" args) => cadr)
                                (else #f)))
         (files (if target-override (cddr args) (cdr args))))
    (display ";;; do not edit --- generated ")
    (display (strftime "%Y-%m-%d %H:%M:%S" (localtime (current-time))))
    (newline)
    (display "(define-module ")
    (display (or target-override "(guile-user)"))
    (for-each (lambda (file)
                (cond ((autoload-info file)
                       => (lambda (info)
                            (and info
                                 (apply (lambda (module-name exports)
                                          (set! module-count (1+ module-count))
                                          (set! syms-count (+ (length exports)
                                                              syms-count))
                                          (for-each display
                                                    (list "\n  :autoload "
                                                          module-name " "
                                                          exports)))
                                        info))))))
              files)
    (display ")")
    (newline)
    (for-each display (list "  ;;; "
                            syms-count " symbols in "
                            module-count " modules\n"))))

(define main generate-autoload)

;;; generate-autoload ends here