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
| | ;;; elpa-bundle.el --- maintain bundled elpa packages -*- lexical-binding: t -*-
(require 'package)
(require 'lisp-mnt)
;;; functions named 'elpaa--' are copied from elpa-admin.el, modified as indicated
(defvar elpaa--url "https://elpa.gnu.org/nongnu/")
(defun elpaa--default-url (pkgname) (concat elpaa--url pkgname ".html"))
(defun elpaa--alist-to-plist-args (alist)
(mapcar (lambda (x)
(if (and (not (consp x))
(or (keywordp x)
(not (symbolp x))
(memq x '(nil t))))
x `',x))
(apply #'nconc
(mapcar (lambda (pair) (list (car pair) (cdr pair))) alist))))
(defun elpaa--override-version (pkg-spec orig-fun header)
(let ((str (funcall orig-fun header)))
(or (if (or (equal header "version")
(and str (equal header "package-version")))
(let ((version-map (plist-get (cdr pkg-spec) :version-map))
(dont-release (plist-get (cdr pkg-spec) :dont-release)))
(or (cadr (assoc str version-map))
(and str dont-release
(string-match dont-release str)
(replace-match "snapshot" t t str)))))
str)))
;;; mainfile inlined.
(defun elpaa--metadata (dir pkg-spec)
"Return a list (SIMPLE VERSION DESCRIPTION REQ EXTRAS),
where SIMPLE is non-nil if the package is simple;
VERSION is the version string of the simple package;
DESCRIPTION is the brief description of the package;
REQ is a list of requirements;
EXTRAS is an alist with additional metadata.
PKG is the name of the package and DIR is the directory where it is."
(let* ((pkg (car pkg-spec))
(mainfile (concat pkg ".el")) ;; FIXME: ignoring :main-file :lisp-dir
(files (directory-files dir nil "\\`dir\\'\\|\\.el\\'")))
(setq files (delete (concat pkg "-pkg.el") files))
(setq files (delete (concat pkg "-autoloads.el") files))
(cond
((file-exists-p mainfile)
(with-temp-buffer
(insert-file-contents mainfile)
(goto-char (point-min))
(let* ((pkg-desc
(unwind-protect
(progn
(when (or (plist-get (cdr pkg-spec) :version-map)
(plist-get (cdr pkg-spec) :dont-release))
(advice-add 'lm-header :around
(apply-partially
#'elpaa--override-version
pkg-spec)))
(package-buffer-info))
(advice-remove 'lm-header
#'elpaa--override-version)))
(extras (package-desc-extras pkg-desc))
(version (package-desc-version pkg-desc))
(keywords (lm-keywords-list))
;; (_ (elpaa--version-to-list version)) ; Sanity check!
(pt (lm-header "package-type"))
(simple (if pt (equal pt "simple") (= (length files) 1)))
(found-url (alist-get :url extras))
(found-keywords (alist-get :keywords extras)))
(when (and keywords (not found-keywords))
;; Using an old package-buffer-info which doesn't include
;; keywords. Fix it by hand.
(push (cons :keywords keywords) extras))
(unless found-url
;; Provide a good default URL.
(push (cons :url (elpaa--default-url pkg)) extras))
(list simple
(package-version-join version)
(package-desc-summary pkg-desc)
(package-desc-reqs pkg-desc)
extras))))
(t
(error "Can't find main file %s file in %s" mainfile dir)))))
;; elpa--temp-file deleted
(defun elpaa--write-pkg-file (pkg-dir name metadata)
(let ((pkg-file (expand-file-name (concat name "-pkg.el") pkg-dir))
(print-level nil)
(print-quoted t)
(print-length nil))
(write-region
(concat (format ";; Generated package description from %s.el -*- no-byte-compile: t -*-\n"
name)
(prin1-to-string
(cl-destructuring-bind (version desc requires extras)
(cdr metadata)
(nconc
(list 'define-package
name
version
desc
(list 'quote
;; Turn version lists into string form.
(mapcar
(lambda (elt)
(list (car elt)
(package-version-join (cadr elt))))
requires)))
(elpaa--alist-to-plist-args extras))))
"\n")
nil
pkg-file)))
(defun elpa-bundle-pkg-spec ()
"Return elpa admin package spec for package in default-directory."
(let* ((dir default-directory)
(pkg (file-name-nondirectory (directory-file-name dir))))
;; This is the elpa admin package spec, _not_ the package.el
;; package descriptor. We don't need :url here.
;;
;; FIXME: we do need :lisp-dir; so far, we can just look for
;; a 'lisp' subdirectory.
;;
;; FIXME: we need :main-file to generate -pkg.el. So far
;; that's only tramp; we could hard-code an exceptions list
;; here.
(list pkg)))
(defun elpa-bundle-generate-pkg-file ()
"Generate package descriptor file for package in default-directory."
(let* ((dir default-directory)
(pkg (file-name-nondirectory (directory-file-name dir)))
(pkg-spec (elpa-bundle-pkg-spec))
(metadata (elpaa--metadata dir pkg-spec)))
(elpaa--write-pkg-file dir pkg metadata)))
(defun elpa-bundle-generate-autoloads ()
"Generate autoloads file for package in default-directory."
(package-generate-autoloads (elpa-bundle-pkg-spec) default-directory))
(defun elpa-bundle-activate-all ()
"Activate all bundled packages."
;; `default-directory' is emacs/elpa/[PKGNAME], unless the package
;; is under emacs/lisp somewhere.
;; FIXME: currently this only supports emacs/elpa; use 'git
;; submodule foreach' to get list of package dirs.
(let ((package-user-dir (expand-file-name "elpa" (getenv "emacs_dir")))
(package-directory-list nil))
(package-load-all-descriptors)
(dolist (elt package-alist)
(package-activate-1 (car (cdr elt))))))
(defun elpa-bundle-byte-compile ()
"Byte-compile package in default-directory."
;; bundled packages may depend on other bundled packages
(elpa-bundle-activate-all)
;; This is how package.el compiles packages.
(byte-recompile-directory default-directory 0 t))
;;; elpa-bundle.el ends here
|