3 ; Strip away arch tail if any
4 (define (noarch X) (if (find ":" X) (0 $it X) X))
6 ; Strip away all version specs from a dependency line
8 (replace " \\([^)]*\\)" (copy X) "" 0))
10 ; Return list of "manually installed"
11 (define (manual) (map noarch (exec "apt-mark showmanual")))
13 ; Return list of "all installed"
14 (define (installed) (map noarch (exec "apt-mark showinstall")))
16 ; Return the provided package, if any, of a given package, or nil
18 (if (exec (format "dpkg-query -W -f '${Provides}' %s" P)) ($it 0) nil))
20 ; Return the "raw dependency line" for a package
21 (define (raw-depends P)
22 (exec (format "dpkg-query -W -f '${Pre-Depends} ${Depends}' %s" P)))
24 ; Set up hash table of provided packages by currently installed. This
25 ; is needed for following up dependencies, which for an option
26 ; dependency only automatically resolves the first of options.
27 (define PROV:PROV nil)
28 (write 2 "Initializing ")
29 (dolist (P (installed))
30 (let ((PV (provides P)))
31 (if (= (% (inc COUNT) 100)) (write 2 "."))
32 (if (PROV P) (push P (PROV P)) (PROV P (list P)))
33 (if (PROV PV) (push P (PROV PV)) (PROV PV (list P)))))
35 (PROV (P 0) (sort (unique (P 1)))))
36 (write-line 2 " done")
38 ; Look up the list of packages that providing the P package
39 (define (provided P) (PROV P))
41 ; Return the "depends choice" of autmatically dependent package
42 ; considering the options of providing that package as currently
43 ; installed. Only the first of providers is an automatic dependency.
44 ; Thus, return a) the depedent package itself if it's the first of its
45 ; providers, or b) that first of providers if the dependent package is
46 ; not among the providers (a fully virtual package), or c) nil if the
47 ; depedent package is a provider but not the first.
48 (define (depends-choice P)
49 (let ((Y (if (PROV P) (first $it) nil)))
50 (if (null? Y) nil (member P (PROV P)) (and (= P Y) P) Y)))
52 ; Resolve a depedency item with respect to package provisions, where
53 ; an option depedency only automatically pulls in its first option.
55 (define (depends-choices X)
56 (depends-choice (trim (first (parse (noversions X) "|")))))
58 ; Fix up a dependency line into list of packages, after cleanup
59 (define (depends-fix X)
60 (clean null? (map depends-choices (clean empty? (map trim (parse X ","))))))
62 ; Return dependencies of a package, with caching.
65 (if (DEP X) $it (DEP X (flat (map depends-fix (raw-depends X))))))
67 ; Expand a list of packages to include the closure of dependencies
70 (write-line 2 (format "checking %d manual packages" (length X)))
71 (while (!= X (setf L (sort (union X (apply union (map depends X))))))
73 (write-line 2 (format " %d manual+dependent packages so far" (length X)))
77 ## main: report the set difference between "all installed" and the
78 ## dependency closure of "manually installed"
80 (let ((X (installed)) (Y nil))
81 (write-line 2 (format "There are %d installed packages" (length X)))
82 (setf Y (difference (installed) (closure (manual))))
83 (write-line 2 (format "=> %d automatic recommended packages" (length Y)))