blob: bd538eac28d27ff8911d67a460a30eb4cc4b0cc1 (
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
|
;; This file is part of Idest
;; Copyright (C) 2011 Sergey Poznyakoff
;;
;; Idest 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 3, or (at your option)
;; any later version.
;;
;; Idest 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.
;;
;; You should have received a copy of the GNU General Public License
;; along with Idest. If not, see <http://www.gnu.org/licenses/>.
(define-module (idest list-modules))
(use-modules (ice-9 getopt-long)
(srfi srfi-1))
(define (strip-suffix name)
(call-with-current-continuation
(lambda (return)
(for-each
(lambda (suf)
(if (and (not (string-null? suf)) (string-suffix? suf name))
(return
(substring name 0 (- (string-length name) (string-length suf))))))
%load-extensions)
(return #f))))
(define-public (idest-list-modules type)
(let ((saved-load-hook %load-hook)
;; Collect a list of possible modules. List elements are conses:
;; (basename . dir)
;; where basename is the module name and dir is the directory where
;; it is found. Make sure only one entry for each basename exists.
;; Sort the list alphabetically on basename.
(candidates
(sort
(fold
(lambda (elt prev)
(catch 'misc-error
(lambda ()
(let ((dir (string-append elt "/idest/"
(symbol->string type))))
(if (and dir
(file-exists? dir)
(eq? (stat:type (stat dir)) 'directory))
(let ((d (opendir dir)))
(let loop ((file (readdir d)))
(cond
((not (eof-object? file))
(if (eq? (stat:type
(stat (string-append dir "/" file)))
'regular)
(let ((base (strip-suffix file)))
(if (and base
(not (assoc-ref prev base)))
(set! prev (cons (cons base dir)
prev)))))
(loop (readdir d)))))))))
(lambda (key . args)
#f))
prev)
'()
%load-path)
(lambda (a b)
(string<? (car a) (car b))))))
;; Try out each candidate and print ist name, directory and description
;; if it happens to be a valid idest format module.
;; Take care not to bail out on errors. Disable %load-hook as it migh
;; clobber the output.
(set! %load-hook #f)
(for-each
(lambda (candidate)
(catch 'misc-error
(lambda ()
(let ((mod (resolve-module
(list 'idest type
(string->symbol (car candidate))))))
; Check if it defines idest-main
(module-ref mod 'idest-main)
(format #t "~A (from ~A): ~A~%"
(car candidate) (cdr candidate)
(catch #t
(lambda ()
(module-ref mod 'description))
(lambda (key . args)
"no description")))))
(lambda (key . args)
#f)))
candidates)
(newline)
(set! %load-hook saved-load-hook)))
|
