2 # aside from this initial boilerplate, this is actually -*- scheme -*- code
3 main
='(module-ref (resolve-module '\''(scripts api-diff)) '\'main
')'
4 exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
6 ;;; api-diff
--- diff guile-api.alist files
8 ;; Copyright
(C
) 2002, 2006 Free Software Foundation
, Inc.
10 ;; This program is free software
; you can redistribute it and
/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation
; either version
2, or
13 ;; (at your option
) any later version.
15 ;; This program is distributed
in the hope that it will be useful
,
16 ;; but WITHOUT ANY WARRANTY
; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License
for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this software
; see the
file COPYING. If not
, write to
22 ;; the Free Software Foundation
, Inc.
, 51 Franklin Street
, Fifth Floor
,
23 ;; Boston
, MA
02110-1301 USA
25 ;;; Author
: Thien-Thi Nguyen
<ttn@gnu.org
>
29 ;; Usage
: api-diff
[-d GROUPS
] ALIST-FILE-A ALIST-FILE-B
31 ;; Read
in the alists from files ALIST-FILE-A and ALIST-FILE-B
32 ;; and display a
(count
) summary of the groups defined therein.
33 ;; Optional arg
"--details" (or
"-d") specifies a comma-separated
34 ;; list of groups
, in which case api-diff displays instead the
35 ;; elements added and deleted
for each of the specified groups.
37 ;; For scheme programming
, this module exports the proc
:
38 ;; (api-diff A-file B-file
)
40 ;; Note that the convention is that the
"older" alist
/file is
43 ;; TODO
: Develop scheme interface.
47 (define-module
(scripts api-diff
)
48 :use-module
(ice-9 common-list
)
49 :use-module
(ice-9 format
)
50 :use-module
(ice-9 getopt-long
)
51 :autoload
(srfi srfi-13
) (string-tokenize
)
54 (define
(read-alist-file
file)
55 (with-input-from-file
file
58 (define put set-object-property
!)
59 (define get object-property
)
61 (define
(read-api-alist-file
file)
62 (let* ((alist
(read-alist-file
file))
63 (meta
(assq-ref alist
'meta))
64 (interface (assq-ref alist 'interface
)))
65 (put interface
'meta meta)
66 (put interface 'groups
(let ((ht
(make-hash-table
31)))
67 (for-each
(lambda
(group
)
68 (hashq-set
! ht group
'()))
69 (assq-ref meta 'groups
))
73 (define
(hang-by-the-roots interface
)
74 (let ((ht
(get interface
'groups)))
76 (for-each (lambda (group)
79 (hashq-ref ht group))))
80 (assq-ref x 'groups
)))
85 (let ((result
(set-difference a b
)))
87 #f ; CL weenies bite me
90 (define
(diff+note
! a b note-removals note-additions note-same
)
92 (cond
((diff? a b
) => (lambda
(x
) (note-removals x
) (set! same?
#f))))
93 (cond
((diff? b a
) => (lambda
(x
) (note-additions x
) (set! same?
#f))))
94 (and same?
(note-same
))))
96 (define
(group-diff i-old i-new . options
)
97 (let* ((i-old
(hang-by-the-roots i-old
))
98 (g-old
(hash-fold acons
'() (get i-old 'groups
)))
99 (g-old-names
(map car g-old
))
100 (i-new
(hang-by-the-roots i-new
))
101 (g-new
(hash-fold acons
'() (get i-new 'groups
)))
102 (g-new-names
(map car g-new
)))
103 (cond
((null? options
)
104 (diff+note
! g-old-names g-new-names
106 (format
#t "groups-removed: ~A\n" removals))
108 (format
#t "groups-added: ~A\n" additions))
110 (for-each
(lambda
(group
)
111 (let* ((old
(assq-ref g-old group
))
112 (new
(assq-ref g-new group
))
113 (old-count
(and old
(length old
)))
114 (new-count
(and new
(length new
)))
115 (delta
(and old new
(- new-count old-count
))))
116 (format
#t " ~5@A ~5@A : "
120 (let ((add-count
0) (sub-count
0))
124 (set! sub-count
(length subs
)))
126 (set! add-count
(length adds
)))
128 (format
#t "~5@D ~5@D : ~5@D"
129 add-count
(- sub-count
) delta
)))
131 (format
#t "~5@A ~5@A : ~5@A" "-" "-" "-")))
132 (format
#t " ~A\n" group)))
133 (sort (union g-old-names g-new-names
)
135 (string
<?
(symbol-
>string a
)
136 (symbol-
>string b
))))))
137 ((assq-ref options
'details)
139 (for-each (lambda (group)
140 (let* ((old (or (assq-ref g-old group) '()))
141 (new
(or
(assq-ref g-new group
) '()))
142 (>>! (lambda (label ls)
143 (format #t "~A ~A:\n" group label)
144 (for-each (lambda (x)
145 (format #t " ~A\n" x))
149 (>>! 'removals removals
))
151 (>>! 'additions additions))
153 (format #t "~A: no changes\n"
157 (error "api-diff: group-diff: bad options")))))
159 (define (api-diff . args)
160 (let* ((p (getopt-long (cons 'api-diff args
)
161 '((details (single-char #\d)
165 (rest (option-ref p '() '("/dev/null" "/dev/null")))
166 (i-old (read-api-alist-file (car rest)))
167 (i-new (read-api-alist-file (cadr rest)))
169 (cond
((option-ref p
'details #f)
171 (set! options (cons (cons 'details
177 (apply group-diff i-old i-new options
)))
179 (define main api-diff
)
181 ;;; api-diff ends here