-
Notifications
You must be signed in to change notification settings - Fork 457
/
el-get-bundle.el
318 lines (277 loc) · 12.2 KB
/
el-get-bundle.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
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
;;; el-get-bundle.el --- An el-get wrapper
;; Author: INA Lintaro <tarao.gnn at gmail.com>
;; URL: https://github.com/tarao/bundle-el/tree/el-get
;; Version: 0.1
;; Keywords: emacs package install compile
;; Licence: WTFPL, grab your copy here: http://sam.zoy.org/wtfpl/
;; This file is NOT part of GNU Emacs.
;;; Code:
(require 'el-get)
(eval-when-compile (require 'cl-lib))
;; customization
(defgroup el-get-bundle nil "el-get-bundle"
:group 'el-get)
(defcustom el-get-bundle-byte-compile t
"t means to automatically byte-compile init forms."
:type 'boolean
:group 'el-get-bundle)
(defcustom el-get-bundle-sync t
"t means to run el-get with the argument 'sync.
The default can be overriden on a per-package basis by adding one of
`:bundle-async [t|nil]'
`:bundle-sync [t|nil]
to the list of keywords that follow
`el-get-bundle PACKAGE|el-get-bundle FEATURE in PACKAGE'."
:type 'boolean
:group 'el-get-bundle)
(defcustom el-get-bundle-init-directory
(expand-file-name "bundle-init/" el-get-dir)
"Directory to save auto generated init files."
:type 'directory
:group 'el-get-bundle)
(defvar el-get-bundle-sources nil)
(defvar el-get-bundle-init-count-alist nil)
(defvar el-get-bundle-init-alist nil)
(defconst el-get-bundle-gist-url-type-plist
'(http "http://gist.github.com/%s.git"
https "https://gist.github.com/%s.git"
git "git://gist.github.com/%s.git"
ssh "git@gist.github.com:%s.git")
"Plist mapping Gist types to their URL format strings.")
;; internals
(defsubst el-get-bundle-gist-url (id &optional src)
(let* ((type (or (plist-get src :url-type) el-get-github-default-url-type))
(str (or (plist-get el-get-bundle-gist-url-type-plist type)
(plist-get el-get-bundle-gist-url-type-plist 'http))))
(format str id)))
(defsubst el-get-bundle-load-file-el (&optional file)
(let ((file (or file load-file-name)))
(and file
(replace-regexp-in-string "\\.elc$" ".el" (expand-file-name file)))))
(defun el-get-bundle-package-def (src)
(ignore-errors
(let (el-get-sources)
(el-get-package-def (if (listp src) (el-get-source-name src) src)))))
(defalias 'el-get-bundle-defined-p (symbol-function 'el-get-bundle-package-def))
(defun el-get-bundle-guess-type (src)
(cond
((plist-member src :url)
(let ((url (plist-get src :url)))
(cond
((or (string-match-p "^git:" url) (string-match-p "\\.git$" url))
'git)
((or (string-match-p "^bzr:" url) (string-match-p "^lp:" url))
'bzr)
((string-match-p "^svn:" url)
'svn)
((string-match-p ":pserver:" url)
'cvs)
((string-match-p "ftp://" url)
'ftp)
((or (string-match-p "https?://" url) (string-match-p "\\.el$" url))
'http))))
(t 'elpa)))
(defun el-get-bundle-parse-name (sym)
(let ((spec (split-string (format "%s" sym) ":")) s)
(when (string= (or (nth 0 spec) "") "github") (setq spec (cdr spec)))
(cond
((and (> (length spec) 2) (string= (car spec) "gist"))
;; gist:12345:name
(let* ((id (nth 1 spec))
(name (intern (or (nth 2 spec) id)))
(type 'git) (url (el-get-bundle-gist-url id)))
(plist-put (plist-put (plist-put s :name name) :type type) :url url)))
((> (length spec) 1)
;; type:name
(let ((name (intern (nth 1 spec))) (type (intern (nth 0 spec))))
(plist-put (plist-put s :name name) :type type)))
((= (length (split-string (or (nth 0 spec) "") "/")) 2)
;; user/repository
(let ((name (intern (replace-regexp-in-string "^.*/" "" (nth 0 spec))))
(type 'github) (pkgname (nth 0 spec)))
(plist-put (plist-put (plist-put s :name name) :type type)
:pkgname pkgname)))
(t (plist-put s :name sym)))))
(defun el-get-bundle-init-id (callsite)
(let ((pair (assoc callsite el-get-bundle-init-count-alist)))
(if pair
(setcdr pair (1+ (cdr pair)))
(push (cons callsite 1) el-get-bundle-init-count-alist)
1)))
(defun el-get-bundle-load-init (el)
(el-get-byte-compile-file el byte-compile-warnings)
(load (expand-file-name (file-name-sans-extension el))))
(defun el-get-bundle-make-init (src)
(when (and el-get-bundle-byte-compile
(plist-get src :after)
load-file-name
(ignore-errors
(or (file-exists-p el-get-bundle-init-directory)
(make-directory el-get-bundle-init-directory t) t)))
(let* ((path (expand-file-name (convert-standard-filename load-file-name)))
(path (file-name-sans-extension path))
(callsite (replace-regexp-in-string "[^a-zA-Z0-9._-]" "_" path))
(package (plist-get src :name))
(id (el-get-bundle-init-id path))
(init-file (concat el-get-bundle-init-directory
(format "%s-%d_%s" callsite id package)))
(el (concat init-file ".el"))
(form (plist-get src :after))
(loader load-file-name))
(let ((loader-el (concat (file-name-sans-extension loader) ".el")))
(when (and (string-match-p "\\.elc$" loader)
(file-exists-p loader-el))
(setq loader loader-el)))
;; remember the package-initializer relation
(let* ((pair (assoc package el-get-bundle-init-alist))
(inits (cdr pair)))
(if pair
(setcdr pair (add-to-list 'inits init-file))
(push (cons package (list init-file)) el-get-bundle-init-alist)))
;; generate .el file
(when (or (not (file-exists-p el))
(file-newer-than-file-p loader el))
(with-temp-buffer
(if (listp form)
(dolist (exp form) (pp exp (current-buffer)))
(pp form (current-buffer)))
(write-region nil nil el)))
;; loader
`((el-get-bundle-load-init ,el)))))
;;;###autoload
(defun el-get-bundle-el-get (src sync)
(let ((package (plist-get src :name)) (def (el-get-bundle-package-def src))
(fs (plist-get src :features))
(ds (plist-get src :depends)))
;; merge features
(when (plist-member def :features)
(let ((old (el-get-as-list (plist-get def :features))))
(dolist (f old) (add-to-list 'fs f))
(setq src (plist-put src :features fs))))
;; merge depends
(when (plist-member def :depends)
(let ((old (el-get-as-list (plist-get def :depends))))
(dolist (d old) (add-to-list 'ds d))
(setq src (plist-put src :depends ds))))
;; merge src with the oriiginal definition
(setq def (let ((el-get-sources (list src)))
(el-get-package-def (el-get-source-name src))))
;; entering password via process-filter only works in async mode
(when (or (and (eq (plist-get def :type) 'cvs)
(eq (plist-get def :options) 'login)
(not (string-match-p "^:pserver:.*:.*@.*:.*$"
(or (plist-get def :url) ""))))
(eq (plist-get def :type) 'apt)
(eq (plist-get def :type) 'fink)
(eq (plist-get def :type) 'pacman))
(setq sync nil))
;; byte-compile :after script
(let ((form (or (el-get-bundle-make-init def) (plist-get def :after))))
(when form
(setq def (plist-put def :after `(progn ,@form)))))
(let ((toplevel (null el-get-bundle-sources)))
;; save sources to global variable
(when toplevel (setq el-get-bundle-sources el-get-sources))
(add-to-list 'el-get-bundle-sources def)
;; get
(prog1 (let ((el-get-sources el-get-bundle-sources))
(el-get sync package))
;; prevent :after from running twice
(plist-put def :after nil)
;; apply changes of sources to `el-get-sources' variable
(when toplevel
(setq el-get-sources el-get-bundle-sources
el-get-bundle-sources nil))))))
(defun el-get-bundle-post-update (package)
"Post update process for PACKAGE.
Invalidate byte-compiled package initialization forms of
PACKAGE (for future recompilation)."
(let ((inits (assoc package el-get-bundle-init-alist)))
(dolist (name (cdr (assoc package el-get-bundle-init-alist)))
(let ((file (concat name ".elc")))
(when (file-exists-p file)
(delete-file file))))))
(add-hook 'el-get-post-update-hooks #'el-get-bundle-post-update)
(defun el-get-bundle-clear-init-count (callsite)
;; clear the number of configurations so that the number starts with
;; 1 next time CALLSITE is loaded
(let ((key (file-name-sans-extension (expand-file-name callsite))))
(setq el-get-bundle-init-count-alist
(delq (assoc key el-get-bundle-init-count-alist)
el-get-bundle-init-count-alist))))
(add-hook 'after-load-functions #'el-get-bundle-clear-init-count)
;; commands
;;;###autoload
(defmacro el-get-bundle (package &rest form)
"Install PACKAGE and run initialization FORM.
PACKAGE can be either a simple package name or a package name
with a modifier before the name to specify local recipe source
information:
* `<owner>/' : specifies a Github owner name
* `gist:<id>' : specifies a Gist ID
* `<type>:' : specifies a type of the package source
If `FEATURE in PACKAGE' form is used instead of PACKAGE, then
that FEATURE is `require'd after installing PACKAGE. You can
also use `el-get-bundle!' macro if FEATURE and PACKAGE are the
same. If you wish to `require' more than one feature, then use
`:features' property in FORM.
The initialization FORM may start with a property list that
describes a local recipe. The property list may include the keyword
`:bundle-sync' with a value of either `t' or `nil' to request that
`el-get-bundle' invoke `el-get' synchronously (respectively asynchronously).
The keyword `:bundle-async' is the inverse of `:bundle-sync'.
\(Note that the request to run el-get synchronously may not be respected in all
circumstances: see the definition of `el-get-bundle-el-get' for details.)
The FORM after the property list is treated as initialization code,
which is actually an `:after' property of the local recipe.
A copy of the initialization code is stored in a directory
specified by `el-get-bundle-init-directory' and its byte-compiled
version is used if `el-get-bundle-byte-compile' is non-nil."
(declare (indent defun) (debug t))
(let* ((package (or (and (listp package) (nth 1 package)) package))
(src (el-get-bundle-parse-name package))
(sync el-get-bundle-sync) require)
;; set parsed name
(setq package (plist-get src :name))
;; (el-get-bundle FEATURE in PACKAGE ...) form
(when (eq (nth 0 form) 'in)
(let* ((name (nth 1 form))
(name (or (and (listp name) (nth 1 name)) name)))
(setq src (el-get-bundle-parse-name name)))
(setq form (nthcdr 2 form) require t))
;; parse keywords
(while (keywordp (nth 0 form))
(cl-case (nth 0 form)
(:bundle-sync (setq sync (nth 1 form)))
(:bundle-async (setq sync (not (nth 1 form))))
(t (setq src (plist-put src (nth 0 form) (nth 1 form)))))
(setq form (cdr-safe (cdr form))))
;; put default type
(unless (or (plist-member src :type) (el-get-bundle-defined-p src))
(setq src (plist-put src :type (el-get-bundle-guess-type src))))
;; features
(when (plist-member src :features)
(let ((fs (el-get-as-list (plist-get src :features))))
(setq src (plist-put src :features fs))))
(when (and require (or (not (plist-member src :features))
(plist-get src :features)))
;; put the feature into the features list
(let ((fs (plist-get src :features)))
(add-to-list 'fs package)
(setq src (plist-put src :features fs))))
;; init script
(setq src (plist-put src :after form))
`(el-get-bundle-el-get ',src ',(when sync 'sync))))
;;;###autoload
(defmacro el-get-bundle! (package &rest args)
"Install PACKAGE and run initialization form.
It is the same as `el-get-bundle' except that PACKAGE is explicitly
required."
(declare (indent defun) (debug t))
(if (eq (nth 0 args) 'in)
`(el-get-bundle ,package ,@args)
(let* ((package (or (and (listp package) (nth 1 package)) package))
(name (plist-get (el-get-bundle-parse-name package) :name)))
`(el-get-bundle ,name ,@(cl-list* 'in package args)))))
(provide 'el-get-bundle)
;;; el-get-bundle.el ends here