[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[ELPA-diffs] /srv/bzr/emacs/elpa r296: * admin/archive-contents.el: Crea
From: |
Stefan Monnier |
Subject: |
[ELPA-diffs] /srv/bzr/emacs/elpa r296: * admin/archive-contents.el: Create web pages. |
Date: |
Thu, 01 Nov 2012 00:11:20 -0400 |
User-agent: |
Bazaar (2.5.0) |
------------------------------------------------------------
revno: 296
committer: Stefan Monnier <address@hidden>
branch nick: elpa
timestamp: Thu 2012-11-01 00:11:20 -0400
message:
* admin/archive-contents.el: Create web pages.
modified:
admin/archive-contents.el
admin/update-archive.sh
=== modified file 'admin/archive-contents.el'
--- a/admin/archive-contents.el 2012-10-22 21:56:43 +0000
+++ b/admin/archive-contents.el 2012-11-01 04:11:20 +0000
@@ -21,6 +21,7 @@
;;; Code:
+(eval-when-compile (require 'cl))
(require 'lisp-mnt)
(require 'package)
@@ -252,9 +253,109 @@
nil
pkg-file)))
+;;; Make the HTML pages for online browsing.
+
+(defun archive--html-header (title)
+ (format "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">
+<html>
+<head>
+ <title>%s</title>
+ <meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\">
+</head>
+<body>
+<h1 align=\"center\">%s</h1>"
+ title title))
+
+(defun archive--html-bytes-format (bytes) ;Aka memory-usage-format.
+ (setq bytes (/ bytes 1024.0))
+ (let ((units '(;; "B"
+ "kB" "MB" "GB" "TB")))
+ (while (>= bytes 1024)
+ (setq bytes (/ bytes 1024.0))
+ (setq units (cdr units)))
+ (cond
+ ;; ((integerp bytes) (format "%4d%s" bytes (car units)))
+ ((>= bytes 100) (format "%4.0f%s" bytes (car units)))
+ ((>= bytes 10) (format "%4.1f%s" bytes (car units)))
+ (t (format "%4.2f%s" bytes (car units))))))
+
+(defun archive--html-make-pkg (pkg files)
+ (let ((name (symbol-name (car pkg)))
+ (latest (package-version-join (aref (cdr pkg) 0)))
+ (desc (aref (cdr pkg) 2)))
+ ;; FIXME: Add maintainer info.
+ (with-temp-buffer
+ (insert (archive--html-header (format "GNU ELPA - %s" name)))
+ (insert (format "<p>Description: %s</p>\n" desc))
+ (let* ((file (cdr (assoc latest files)))
+ (attrs (file-attributes file)))
+ (insert (format "<p>Latest: <a href=%S>%s</a>, %s, %s</p>\n"
+ file file
+ (format-time-string "%Y-%b-%d" (nth 5 attrs))
+ (archive--html-bytes-format (nth 7 attrs)))))
+ ;; FIXME: This URL is wrong for Org.
+ (let ((repurl (concat
"http://bzr.sv.gnu.org/lh/emacs/elpa/files/head:/packages/" name)))
+ (insert (format "<p>Repository: <a href=%S>%s</a></p>" repurl repurl)))
+ (let ((readme (concat name "-readme.txt"))
+ (end (copy-marker (point) t)))
+ (when (file-readable-p readme)
+ (insert "<p>Full description:<pre>\n")
+ (insert-file-contents readme)
+ (goto-char end)
+ (insert "\n</pre></p>")))
+ (unless (< (length files) 2)
+ (insert (format "<p>Old versions:<table cellpadding=\"3\"
border=\"1\">\n"))
+ (dolist (file files)
+ (unless (equal (pop file) latest)
+ (let ((attrs (file-attributes file)))
+ (insert (format "<tr><td><a
href=%S>%s</a></td><td>%s</td><td>%s</td>\n"
+ file file
+ (format-time-string "%Y-%b-%d" (nth 5 attrs))
+ (archive--html-bytes-format (nth 7 attrs)))))))
+ (insert "</table></body>\n"))
+ (write-region (point-min) (point-max) (concat name ".html")))))
+
+(defun archive--html-make-index (pkgs)
+ (with-temp-buffer
+ (insert (archive--html-header "GNU ELPA Packages"))
+ (insert "<table cellpadding=\"3\" border=\"1\">\n")
+ (insert "<tr><th>Package</th><th>Version</th><th>Description</th></tr>\n")
+ (dolist (pkg pkgs)
+ (insert (format "<tr><td><a
href=\"%s.html\">%s</a></td><td>%s</td><td>%s</td></tr>\n"
+ (car pkg) (car pkg)
+ (package-version-join (aref (cdr pkg) 0))
+ (aref (cdr pkg) 2))))
+ (insert "</table></body>\n")
+ (write-region (point-min) (point-max) "index.html")))
+
+(defun batch-html-make-index ()
+ (let ((packages (make-hash-table :test #'equal))
+ (archive-contents
+ (with-temp-buffer
+ (insert-file-contents "archive-contents")
+ (goto-char (point-min))
+ ;; Skip the first element which is a version number.
+ (cdr (read (current-buffer))))))
+ (dolist (file (directory-files default-directory nil))
+ (cond
+ ((member file '("." ".." "elpa.rss" "index.html" "archive-contents")))
+ ((string-match "\\.html\\'" file))
+ ((string-match "-readme\\.txt\\'" file)
+ (let ((name (substring file 0 (match-beginning 0))))
+ (puthash name (gethash name packages) packages)))
+ ((string-match "-\\([0-9][^-]*\\)\\.\\(tar\\|el\\)\\'" file)
+ (let ((name (substring file 0 (match-beginning 0)))
+ (version (match-string 1 file)))
+ (push (cons version file) (gethash name packages))))
+ (t (message "Unknown file %S" file))))
+ (dolist (pkg archive-contents)
+ (archive--html-make-pkg pkg (gethash (symbol-name (car pkg)) packages)))
+ ;; FIXME: Add (old?) packages that are in `packages' but not in
+ ;; archive-contents.
+ (archive--html-make-index archive-contents)))
+
;; Local Variables:
-;; no-byte-compile: t
;; lexical-binding: t
;; End:
=== modified file 'admin/update-archive.sh'
--- a/admin/update-archive.sh 2012-10-31 17:07:10 +0000
+++ b/admin/update-archive.sh 2012-11-01 04:11:20 +0000
@@ -30,8 +30,7 @@
cat -
echo "Error: $title"
else
- set -- $(host -t mx gnu.org);
- mx_gnu_org="$4"
+ mx_gnu_org="$(host -t mx gnu.org | sed 's/.*[ ]//')"
(sleep 5; echo "HELO elpa.gnu.org"
sleep 1; echo "MAIL FROM: <address@hidden>"
sleep 1; echo "RCPT TO: <address@hidden>"
@@ -43,7 +42,7 @@
ENDDOC
cat -
- echo ".") | telnet "$mx_gnu_org" smtp
+ echo "."; sleep 1) | telnet "$mx_gnu_org" smtp
fi
}
@@ -83,5 +82,10 @@
mv build/archive/* staging/ 2>/dev/null
rm -rf build/archive)
+# Make the HTML files.
+(cd ~elpa/staging/packages
+ emacs --batch -l ~elpa/build/admin/archive-contents.el \
+ --eval '(batch-html-make-index)')
+
# "make archive-full" already does fetch the daily org build.
#admin/org-synch.sh ~elpa/staging/packages ~elpa/build/admin
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [ELPA-diffs] /srv/bzr/emacs/elpa r296: * admin/archive-contents.el: Create web pages.,
Stefan Monnier <=