forked from dimitri/el-get
-
Notifications
You must be signed in to change notification settings - Fork 0
/
el-get-dependencies.el
185 lines (175 loc) · 8.73 KB
/
el-get-dependencies.el
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
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
;;; el-get --- Manage the external elisp bits and pieces you depend upon
;;
;; Copyright (C) 2010-2011 Dimitri Fontaine
;;
;; Author: Dimitri Fontaine <[email protected]>
;; URL: http://www.emacswiki.org/emacs/el-get
;; GIT: https://github.com/dimitri/el-get
;; Licence: WTFPL, grab your copy here: http://sam.zoy.org/wtfpl/
;;
;; This file is NOT part of GNU Emacs.
;;
;; Install
;; Please see the README.md file from the same distribution
(require 'cl-lib)
(require 'el-get-core)
(require 'el-get-recipes)
(eval-and-compile
(unless (fboundp 'string-suffix-p) ; introduced in 24.4
(defun string-suffix-p (suffix string &optional ignore-case)
"Return non-nil if SUFFIX is a suffix of STRING.
If IGNORE-CASE is non-nil, the comparison is done without paying
attention to case differences."
(let ((start-pos (- (length string) (length suffix))))
(and (>= start-pos 0)
(eq t (compare-strings suffix nil nil
string start-pos nil ignore-case)))))))
(defun el-get-dependencies (packages)
"Return the list of packages to install in order."
(cl-multiple-value-bind (plist all-sorted-p non-sorted)
(topological-sort
(apply 'append (mapcar 'el-get-dependencies-graph (el-get-as-list packages))))
(if all-sorted-p
plist
(error "Couldn't sort package dependencies for \"%s\"" packages))))
(defun el-get-dependencies-graph (package)
"Return the graph of packages on which PACKAGE depends"
(let* ((source (el-get-package-def (symbol-name package)))
(method (el-get-package-method source))
(pdeps (el-get-as-list (plist-get source :depends)))
(alldeps
;; Make sure all elpa packages depend on the package `package'.
;; The package `package' is an elpa package, though, so exclude it
;; to avoid a circular dependency.
(if (and (not (eq package 'package)) (eq method 'elpa))
(cons 'package pdeps)
pdeps)))
(append (list (append (list package) alldeps))
(cl-loop for p in pdeps append (el-get-dependencies-graph p)))))
;;
;; topological sort, see
;; http://rosettacode.org/wiki/Topological_sort#Common_Lisp
;;
(cl-defun topological-sort (graph &key (test 'eql))
"Returns a list of packages to install in order.
Graph is an association list whose keys are objects and whose
values are lists of objects on which the corresponding key depends.
Test is used to compare elements, and should be a suitable test for
hash-tables. Topological-sort returns two values. The first is a
list of objects sorted toplogically. The second is a boolean
indicating whether all of the objects in the input graph are present
in the topological ordering (i.e., the first value)."
(let* ((entries (make-hash-table :test test))
;; avoid obsolete `flet' & backward-incompatible `cl-flet'
(entry (lambda (v)
"Return the entry for vertex. Each entry is a cons whose
car is the number of outstanding dependencies of vertex
and whose cdr is a list of dependants of vertex."
(or (gethash v entries)
(puthash v (cons 0 '()) entries)))))
;; populate entries initially
(dolist (gvertex graph)
(cl-destructuring-bind (vertex &rest dependencies) gvertex
(let ((ventry (funcall entry vertex)))
(dolist (dependency dependencies)
(let ((dentry (funcall entry dependency)))
(unless (funcall test dependency vertex)
(cl-incf (car ventry))
(push vertex (cdr dentry))))))))
;; L is the list of sorted elements, and S the set of vertices
;; with no outstanding dependencies.
(let ((L '())
(S (cl-loop for entry being each hash-value of entries
using (hash-key vertex)
when (zerop (car entry)) collect vertex)))
;; Until there are no vertices with no outstanding dependencies,
;; process vertices from S, adding them to L.
(cl-do* () ((cl-endp S))
(let* ((v (pop S)) (ventry (funcall entry v)))
(remhash v entries)
(dolist (dependant (cdr ventry) (push v L))
(when (zerop (cl-decf (car (funcall entry dependant))))
(push dependant S)))))
;; return (1) the list of sorted items, (2) whether all items
;; were sorted, and (3) if there were unsorted vertices, the
;; hash table mapping these vertices to their dependants
(let ((all-sorted-p (zerop (hash-table-count entries))))
(cl-values (nreverse L)
all-sorted-p
(unless all-sorted-p
entries))))))
(defun el-get-auto-dependencies (package &optional interactive)
"Return a plist with `:depends' based on the `Package-Requires'
header in PACKAGE's elisp file(s).
A `:minimum-emacs-version' property may also be present."
(interactive (list (el-get-read-package-with-status "Auto-get dependencies of" "installed") t))
(unless (el-get-package-installed-p package)
(error "Tried to get Package-Requires of non-installed package, `%s'!" package))
(eval-and-compile
(require 'lisp-mnt)) ; `lm-header'
(cl-loop with deps and min-emacs and sub-pkgs
for pdir in (el-get-load-path package)
do (dolist (file (directory-files pdir t "\\.el\\'" t))
(if (string-suffix-p "-pkg.el" file)
(let ((def-pkg (el-get-read-from-file file)))
(push (intern (nth 1 def-pkg)) sub-pkgs)
(setq deps (nconc (el-get-unquote (nth 4 def-pkg)) deps)))
(with-temp-buffer
(insert-file-contents file)
(let ((pkg-reqs (lm-header "package-requires")))
(when pkg-reqs
(push (intern (file-name-base file)) sub-pkgs)
(setq deps (nconc (car (read-from-string pkg-reqs)) deps)))))))
finally do
(setq min-emacs (car (cdr (assq 'emacs deps)))
deps (cl-set-difference (remq 'emacs (delete-dups (mapcar #'car deps)))
sub-pkgs))
(let ((non-el-get-pkgs (cl-remove-if #'el-get-package-def deps)))
(when non-el-get-pkgs
(error "Found non el-get package(s): %s" non-el-get-pkgs)))
finally return
(if interactive
(let ((props-str
(apply #'concat ":depends " (prin1-to-string deps) "\n"
(when min-emacs
(list ":minimum-emacs-version " (prin1-to-string min-emacs) "\n")))))
(message "%s" props-str)
(kill-new props-str))
(nconc (if min-emacs (list :minimum-emacs-version min-emacs))
(list :depends deps)))))
(defun el-get-auto-update-dependencies (package buffer &optional interactive)
"Update the dependencies of PACKAGE according to its source headers.
Interactively, update the recipe in the current buffer if it's
visiting a recipe for the chosen PACKAGE, otherwise visit the
corresponding recipe file."
(interactive (let ((pkg (el-get-read-package-with-status
"Auto update dependencies of" "installed")))
(list pkg
(if (string= (file-name-base buffer-file-name) pkg)
(current-buffer) (find-file (el-get-recipe-filename pkg)))
t)))
(with-current-buffer buffer
(let* ((new-props (el-get-auto-dependencies package))
(recipe (save-excursion (goto-char (point-min))
(read (current-buffer)))))
(cl-loop with auto-updated = nil
for (prop newval) on new-props by #'cddr
for prop-name = (symbol-name prop)
unless (equal newval (plist-get recipe prop))
do (save-excursion
(goto-char (point-min))
(let ((have-prop (search-forward prop-name nil t)))
(if have-prop (let ((opoint (point)))
(forward-sexp)
(delete-region opoint (point)))
(insert prop-name))
(insert " ")
(prin1 newval (current-buffer))
(unless (looking-at-p " ; auto updated")
(insert " ; auto updated"))
(unless have-prop (insert "\n"))
(setq auto-updated t)))
finally (when interactive
(message "Dependencies of %s %s updated." package
(if auto-updated "have been" "didn't need to be")))))))
(provide 'el-get-dependencies)