1 ;;; archive-contents.el --- Auto-generate the `archive-contents' file -*- lexical-binding: t -*-
3 ;; Copyright (C) 2011 Free Software Foundation, Inc
5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
7 ;; This program is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation, either version 3 of the License, or
10 ;; (at your option) any later version.
12 ;; This program is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
26 (defun batch-make-archive-contents ()
27 (let ((packages '(1))) ;I think this is the format-version.
28 (dolist (file (directory-files default-directory))
30 ((or `"." `".." `"elpa.rss" `"archive-contents") nil)
31 ((pred file-directory-p)
32 (if (not (string-match "-[0-9.]+\\'" file))
33 (message "Unknown package directory name format %s" file)
34 (let* ((pkg (substring file 0 (match-beginning 0)))
35 (vers (substring file (1+ (match-beginning 0))))
39 (expand-file-name (concat pkg "-pkg.el") file))
40 (goto-char (point-min))
41 (read (current-buffer)))))
42 (copy-file (expand-file-name "README" file)
43 (concat pkg "-readme.txt")
44 'ok-if-already-exists)
45 (unless (equal (nth 1 exp) pkg)
46 (message "Package name %s doesn't match file name %s"
48 (unless (equal (nth 2 exp) vers)
49 (message "Package version %s doesn't match file name %s"
51 (push (cons (intern pkg)
52 (vector (version-to-list vers)
57 ((pred (string-match "\\.el\\'"))
58 (if (not (string-match "-\\([0-9.]+\\)\\.el\\'" file))
59 (message "Unknown package file name format %s" file)
60 (let* ((pkg (substring file 0 (match-beginning 0)))
61 (vers (match-string 1 file))
64 (insert-file-contents file)
65 (goto-char (point-min))
66 (if (not (looking-at ";;;.*---[ \t]*\\(.*\\)\\(-\\*-.*-\\*-[ \t]*\\)?$"))
67 (message "Incorrectly formatted header in %s" file)
68 (prog1 (match-string 1)
69 (let ((commentary (lm-commentary)))
70 (with-current-buffer (find-file-noselect
71 (concat pkg "-readme.txt"))
75 (goto-char (point-min))
76 (while (looking-at ";*[ \t]*\\(commentary[: \t]*\\)?\n")
77 (delete-region (match-beginning 0)
79 (uncomment-region (point-min) (point-max))
80 (goto-char (point-max))
81 (while (progn (forward-line -1)
82 (looking-at "[ \t]*\n"))
83 (delete-region (match-beginning 0)
86 (push (cons (intern pkg)
87 (vector (version-to-list vers)
92 ((pred (string-match "\\.elc\\'")) nil)
93 ((pred (string-match "-readme\\.txt\\'")) nil)
95 (message "Unknown file %s" file))))
96 (with-current-buffer (find-file-noselect "archive-contents")
98 (pp (nreverse packages) (current-buffer))
101 (provide 'archive-contents)
102 ;;; archive-contents.el ends here