Skip to content
Newer
Older
100644 47 lines (42 sloc) 2.59 KB
10bf002 @pupeno Scanner to search for includes.
authored Nov 17, 2005
1 ;;;; Copyright (C) 2005 José Pablo Ezequiel "Pupeno" Fernández Silva
2 ;;;;
9b16ce1 @pupeno scons-chicken -> SConsChicken
authored Jan 13, 2007
3 ;;;; This file is part of SCons Chicken.
10bf002 @pupeno Scanner to search for includes.
authored Nov 17, 2005
4 ;;;;
9b16ce1 @pupeno scons-chicken -> SConsChicken
authored Jan 13, 2007
5 ;;;; SCons Chicken is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version.
6 ;;;; SCons Chicken 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 General Public License for more details.
7 ;;;; You should have received a copy of the GNU General Public License along with SCons Chicken; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
10bf002 @pupeno Scanner to search for includes.
authored Nov 17, 2005
8
9 (use srfi-1 srfi-13 posix)
10 (define rest cdr)
11
12 (define (get-includes filename)
da8ade6 @pupeno set-dispatch-read-syntax! seems not to exist anymore, ignoring the pr…
authored Jan 13, 2007
13 ;; (set-dispatch-read-syntax! #\>
14 ;; (lambda (p)
15 ;; (let loop ((c (read-char p)))
16 ;; (cond ((eof-object? c)
17 ;; (error 'get-includes "unexpected end of file"))
18 ;; ((and (char=? c #\<)
19 ;; (char=? #\# (peek-char p)))
20 ;; (read-char p)
21 ;; #f)
22 ;; (else (loop (read-char p)))))))
10bf002 @pupeno Scanner to search for includes.
authored Nov 17, 2005
23 (call-with-input-file filename
24 (lambda (file-port)
25 (let process-form ((form (read file-port))) ; Read a form from form-port
ead5517 @pupeno Make the reader extension handling work (thank you Felix).
authored Nov 24, 2005
26 (cond
27 ((eof-object? form) ; If it is eof
28 '()) ; return the empty list.
29 ((and (pair? form) ; Is it a pair
30 (eq? (first form) 'include)) ; and an 'include, then
31 (lset-union eq? ; make the union
32 (rest form) ; of the include and
33 (process-form (read file-port)))) ; the rest of the includes on file.
34 (else ; Otherwise
35 (process-form (read file-port)))))))) ; keep processing.
10bf002 @pupeno Scanner to search for includes.
authored Nov 17, 2005
36
37 ;; Get the list of files passed as arguments to this program.
38 (define file (first (rest (argv))))
39
3f07256 @pupeno Handle non-existing files.
authored Nov 28, 2005
40 ;; Check if the file exists. It is not an error because it is ok to include a file that doesn't exists and gets generated latter (is it ?). This is the case of chicken-syntax-case.
41 (when (file-exists? file)
42 ;; Get a list of the extensions needed by those files.
43 (define includes (get-includes file))
44
45 ;; Print the list of includes with no parenthesis and separated by spaces.
46 (display (string-join includes " "))
47 (newline))
Something went wrong with that request. Please try again.