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
|
;; Emacs script to generate a package provide list -*- lexical-binding:t -*-
(require 'json)
(require 'package)
(defvar package-skip-list
'("elpa-emacs")
"A list of package that should be skipped in the provide list")
(defun package-version-list-to-string (package-version-list)
"Convert a package version list to version string acceptable in Debian."
(and package-version-list
(let ((count 0)
version-list)
(dolist (item package-version-list)
(if (cl-minusp item)
(progn
;; This roughly matches the mapping in
;; `version-regexp-alist'.
(cl-case item
(-1 (push "~rc" version-list))
(-2 (push "~beta" version-list))
(-3 (push "~alpha" version-list))
(-4 (push "~snapshot" version-list))
(t (error "Unknown version: %d" item)))
;; no "." between prerelease name and number
(setq count 0))
(when (cl-plusp count)
(push "." version-list))
(push (number-to-string item) version-list)
(cl-incf count)))
(string-join (nreverse version-list)))))
(defun emacs-provided-package-versions ()
"Return an alist of Debian package name to version mapping."
(sort
(mapcan
(lambda (package-name)
(let* ((debian-package-name (concat "elpa-"
(symbol-name package-name)))
(debian-package-version (package-version-list-to-string
(package-builtin-package-version
package-name))))
(and (not (member debian-package-name package-skip-list))
`((,debian-package-name . ,debian-package-version)))))
(package-versioned-builtin-packages))))
(defun print-help ()
"Print help info"
(message "Generate information for Emacs built-in packages.
Modes:
--json Generate a report in human readable JSON format
--substvars Generate substvars for Emacs build process
--script-help This help info
"))
(defun generate-builtin-package-info-json ()
"Generate Emacs built-in-package info report in JSON format."
(princ
(format "%s\n"
(with-temp-buffer
(insert (json-encode (emacs-provided-package-versions)))
(json-pretty-print-buffer)
(buffer-string)))))
(defun generate-builtin-package-info-substvars ()
"Generate Emacs built-in package info as substvars for emacs-common."
(let (provides-substvars-list
replaces-substvars-list
(count 0))
(mapc (lambda (package-version)
(let* ((name (car package-version))
(version (cdr package-version))
(provides-entry-string
(concat name
(and version
(format " (= %s)" version))
","))
(replaces-entry-string
(concat name
(and version
(format " (<< %s)" version))
",")))
(when (cl-plusp count)
(push " " provides-substvars-list)
(push " " replaces-substvars-list))
(push provides-entry-string provides-substvars-list)
(push replaces-entry-string replaces-substvars-list)
(cl-incf count)))
(emacs-provided-package-versions))
(let ((debian-provides-substvars-string
(string-join (nreverse provides-substvars-list)))
(debian-replaces-substvars-string
(string-join (nreverse replaces-substvars-list))))
(princ
(format "emacs:Provides=%s\nemacs:Breaks=%s\nemacs:Replaces=%s\n"
debian-provides-substvars-string
debian-replaces-substvars-string
debian-replaces-substvars-string)))))
(defun main ()
"Main program entrance."
(if (not argv)
(print "Missing argument. Should specify \"--report\" or \"--substvars\"."
#'external-debugging-output)
(let ((option (pop argv)))
(pcase option
("--json" (generate-builtin-package-info-json))
("--substvars" (generate-builtin-package-info-substvars))
("--script-help" (print-help))
(_ (error "Unknown option \"%s\"." option)))))
(kill-emacs 0))
(main)
|
