[elpa] elpa-admin c51af29 058/357: Reorganize repository layout, allowing site installation.

[Stefan Monnier]

branch: elpa-admin
commit c51af29e76f92ff9dbbd5befa2419f6d76ed54fd
Merge: 45792fe 4866cb7
Author: Chong Yidong <cyd@stupidchicken.com>
Commit: Chong Yidong <cyd@stupidchicken.com>

    Reorganize repository layout, allowing site installation.
    
    A Makefile with "site", "archive" and "archive-full" rules can now be
    used for site-installation, partial archive deployment, and full
    archive deployment respectively.
    
    Rewrite the admin/archive-contents.el script to handle these changes.
---
 README                    |  69 ++++++------
 admin/archive-contents.el | 264 +++++++++++++++++++++++++++++++---------------
 2 files changed, 211 insertions(+), 122 deletions(-)

diff --git a/README b/README
index c8a4fd4..097e430 100644
--- a/README
+++ b/README
@@ -12,8 +12,7 @@ for testing purposes).
 
 * DIRECTORY LAYOUT
 
-** admin/    -- scripts for deploying the package archive.
-                See the DEPLOYMENT section for details.
+** admin/    -- scripts for administering the package archive.
 ** html/     -- HTML for the elpa.gnu.org website.
 ** packages/ -- source code for the packages.
 
@@ -21,60 +20,52 @@ for testing purposes).
 * PACKAGES
 
 ** Contents of the packages/ directory:
-
-This directory holds the package sources.  Unlike the deployed package
-archive, multi-file packages are present here as directories, not tar
-files.  So, edits to the sources can be easily managed by Bzr.
-
-*** Package sources
-In the form of *.el files for simple (1-file) packages, or
-subdirectories for multi-file packages.
+This directory holds the package sources, with one subdirectory for
+each package.
 
 ** To add a package:
 
-*** Add a simple (1-file) package as packages/NAME-VERSION.el.
+*** Add a simple (1-file) package as packages/NAME/NAME.el.
 
-*** Add a multi-file package a directory, packages/NAME-VERSION.
+*** Add a multi-file package as a directory, packages/NAME.
 
-*** Commit your changes
-This is done the usual way ("bzr add", "bzr commit", etc).
+*** Commit your changes the usual way ("bzr add", "bzr commit", etc).
 
 Changes in the Bzr repository do not immediately propagate to the
 user-facing archive (what users see when they do `M-x list-packages').
-That is done by deploying the archive (see below).
+That is done by deploying the archive.
 
 
 * DEPLOYMENT
 
-** The package-update.sh script
+** To use the package repository as a "site installation" of packages:
 
-Use the script admin/package-update.sh to deploy a partial or full
-copy of the package archive.  To run a partial deployment:
+  make site
 
-  /PATH/TO/admin/package-update.sh DEST
+This compiles and generates autoloads for all the packages in the
+packages/ directory, and creates a site/ directory containing symlinks
+to the package directories.
 
-This deploys the packages in packages/ to DEST/packages.
+Now you have to add this site/ directory to `package-directory-list',
+and all the packages will be available.
 
-To run a full deployment:
+** To deploy the package repository as a remotely-accessible archive:
 
-  /PATH/TO/admin/package-update.sh DEST 1
+  make archive
 
-A full deployment additionally copies the admin scripts to DEST/admin,
-creates a full tarball in DEST/packages/emacs-packages-latest.tgz, and
-fetches externally hosted packages (currently, the Org daily builds)
-and adds them to the archive.
+or
 
-The package-update.sh script only works if it lives in a bzr
-repository.  It uses `bzr export' to deploy from the repository to the
-destination directory.  If you have uncommitted changes in the working
-copy, those changes are not deployed.
+  make archive-full
 
-You can view the deployment log at DEST/update-log.
+This deploys the packages to the archive/ directory.  Unlike "make
+site", this makes a full copy of the packages, and tars up multi-file
+packages.
 
-The other scripts in the admin/ subdirectory are used for fetching the
-Org dailies.
+A full deployment also copies the admin scripts to archive/admin, and
+fetches externally hosted packages (currently, the Org daily builds)
+and adds them to the archive.
 
-** Accessing a deployed archive
+** To access a deployed archive
 
 To access the archive via HTPP, have a symlink (say) /var/www/packages
 pointing to DEST/packages, and set up Emacs with
@@ -94,13 +85,13 @@ logging in (login access set up by FSF admins), and
 su elpa
 cd ~elpa/elpa
 bzr up
-./admin/package-update /home/elpa/staging/ 1
 
-The symlink /var/www/packages points to /home/elpa/staging/packages.
+Then make a full archive deployment, as discussed above.  The symlink
+/var/www/packages points to the staging package directory under
+/home/elpa/.
 
-The Org mode dailies are fetched and added by the script
-admin/org-synch.sh, which is run as a cron job (we also run this
-script during deployment).
+The Org mode dailies are also fetched and added by the script
+admin/org-synch.sh, run as a cron job.
 
 
 This file is part of GNU Emacs.
diff --git a/admin/archive-contents.el b/admin/archive-contents.el
index 6c315ca..e94093a 100644
--- a/admin/archive-contents.el
+++ b/admin/archive-contents.el
@@ -1,4 +1,4 @@
-;;; archive-contents.el --- Auto-generate the `archive-contents' file
+;;; archive-contents.el --- Auto-generate an Emacs Lisp package archive.
 
 ;; Copyright (C) 2011  Free Software Foundation, Inc
 
@@ -26,11 +26,14 @@
 (defconst archive-contents-subdirectory-regexp
   
"\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)")
 
-(defun archive-contents--convert-require (elt)
+(defconst archive-re-no-dot "\\`\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"
+  "Regular expression matching all files except \".\" and \"..\".")
+
+(defun archive--convert-require (elt)
   (list (car elt)
        (version-to-list (car (cdr elt)))))
 
-(defun archive-contents--strip-rcs-id (str)
+(defun archive--strip-rcs-id (str)
   "Strip RCS version ID from the version string STR.
 If the result looks like a dotted numeric version, return it.
 Otherwise return nil."
@@ -42,90 +45,185 @@ Otherwise return nil."
            str)
       (error nil))))
 
-(defun batch-make-archive-contents ()
+(defun archive--delete-elc-files (dir)
+  "Recursively delete all .elc files in DIR.
+Delete backup files also."
+  (dolist (f (directory-files dir t archive-re-no-dot))
+    (cond ((file-directory-p f)
+          (archive--delete-elc-files f))
+         ((or (string-match "\\.elc\\'" f)
+              (backup-file-name-p f))
+          (delete-file f)))))
+
+(defun batch-make-archive ()
+  "Process package content directories and generate the archive-contents file."
   (let ((packages '(1))) ; format-version.
-    (dolist (file (directory-files default-directory))
+    (dolist (dir (directory-files default-directory nil archive-re-no-dot))
       (condition-case v
-       (cond
-        ((member file '("." ".." "elpa.rss" "archive-contents"))
-         nil)
-        ;; Multi-file package
-        ((file-directory-p file)
-         (let* ((pkg (file-name-nondirectory file))
-                (exp
-                 (with-temp-buffer
-                   (insert-file-contents
-                    (expand-file-name (concat pkg "-pkg.el") file))
-                   (goto-char (point-min))
-                   (read (current-buffer))))
-                (vers (nth 2 exp))
-                (req (mapcar 'archive-contents--convert-require
-                             (nth 4 exp)))
-                (readme (expand-file-name "README" file)))
-           (when (file-exists-p readme)
-             (copy-file readme
-                        (concat pkg "-readme.txt")
-                        'ok-if-already-exists))
-           (unless (equal (nth 1 exp) pkg)
-             (error (format "Package name %s doesn't match file name %s"
-                            (nth 1 exp) file)))
-           (push (cons (intern pkg)
-                       (vector (version-to-list vers) req (nth 3 exp) 'tar))
-                 packages)
-           (rename-file file (concat pkg "-" vers))))
-        ;; Simple package
-        ((string-match "\\([^/]+\\)\\.el\\'" file)
-         (let* ((pkg (match-string 1 file))
-                vers desc requires-str req)
-           (with-temp-buffer
-             (insert-file-contents file)
-             (goto-char (point-min))
-             (unless (looking-at ";;;.*---[ \t]*\\(.*\\)\\(-\\*-.*-\\*-[ 
\t]*\\)?$")
-               (error "Incorrectly formatted header in %s" file))
-             (setq vers
-                   (or (archive-contents--strip-rcs-id (lm-header 
"package-version"))
-                       (archive-contents--strip-rcs-id (lm-header "version"))
-                       (error "Missing version number in %s" file)))
-             (setq desc (match-string 1))
-             (let ((commentary (lm-commentary)))
-               (with-current-buffer (find-file-noselect
-                                     (concat pkg "-readme.txt"))
-                 (erase-buffer)
-                 (emacs-lisp-mode)
-                 (insert (or commentary
-                             (prog1 "No description"
-                               (message "Missing Commentary in %s"
-                                        file))))
-                 (goto-char (point-min))
-                 (while (looking-at ";*[ \t]*\\(commentary[: \t]*\\)?\n")
-                   (delete-region (match-beginning 0)
-                                  (match-end 0)))
-                 (uncomment-region (point-min) (point-max))
-                 (goto-char (point-max))
-                 (while (progn (forward-line -1)
-                               (looking-at "[ \t]*\n"))
-                   (delete-region (match-beginning 0)
-                                  (match-end 0)))
-                 (save-buffer)))
-             (setq req
-                   (let ((requires-str (lm-header "package-requires")))
-                     (if requires-str
-                         (mapcar 'archive-contents--convert-require
-                                 (car (read-from-string requires-str))))))
-             (push (cons (intern pkg)
-                         (vector (version-to-list vers) req desc 'single))
-                   packages)
-             (rename-file file (concat (or (file-name-directory file) "")
-                                       pkg "-" vers ".el")))))
-        ((not (or (string-match "\\.elc\\'" file)
-                  (string-match "-readme\\.txt\\'" file)))
-         (message "Unknown file %s" file)))
+         (if (not (file-directory-p dir))
+             (error "Skipping non-package file %s" dir)
+           (let* ((pkg (file-name-nondirectory dir))
+                  (autoloads-file (expand-file-name (concat pkg 
"-autoloads.el") dir))
+                  simple-p)
+             ;; Omit autoloads and .elc files from the package.
+             (if (file-exists-p autoloads-file)
+                 (delete-file autoloads-file))
+             (archive--delete-elc-files dir)
+             ;; Test whether this is a simple or multi-file package.
+             (setq simple-p (archive--simple-package-p dir pkg))
+             (push (if simple-p
+                       (apply 'archive--process-simple-package
+                              dir pkg simple-p)
+                     (archive--process-multi-file-package dir pkg))
+                   packages)))
        ;; Error handler
-       (error (message (cadr v)))))
-    (with-current-buffer (find-file-noselect "archive-contents")
-      (erase-buffer)
+       (error (message "%s" (cadr v)))))
+    (with-temp-buffer
       (pp (nreverse packages) (current-buffer))
-      (save-buffer))))
+      (write-region nil nil "archive-contents"))))
+
+(defun archive--simple-package-p (dir pkg)
+  "Test whether DIR contains a simple package named PKG.
+If so, return a list (VERSION DESCRIPTION REQ COMMENTARY), where
+VERSION is the version string of the simple package, DESCRIPTION
+is the brief description of the package, REQ is a list of
+requirements, and COMMENTARY is the package commentary.
+Otherwise, return nil."
+  (let* ((pkg-file (expand-file-name (concat pkg "-pkg.el") dir))
+        (mainfile (expand-file-name (concat pkg ".el") dir))
+        version description req commentary)
+    (when (and (or (not (file-exists-p pkg-file))
+                  (= (length (directory-files dir nil archive-re-no-dot)) 2))
+              (file-exists-p mainfile))
+      (with-temp-buffer
+       (insert-file-contents mainfile)
+       (goto-char (point-min))
+       (and (looking-at ";;;.*---[ \t]*\\(.*\\)\\(-\\*-.*-\\*-[ \t]*\\)?$")
+            (progn
+              (setq description (match-string 1))
+              (setq version
+                    (or (archive--strip-rcs-id (lm-header "package-version"))
+                        (archive--strip-rcs-id (lm-header "version")))))
+            (progn
+              ;; Grab the other fields, which are not mandatory.
+              (let ((requires-str (lm-header "package-requires")))
+                (if requires-str
+                    (setq req (mapcar 'archive--convert-require
+                                      (car (read-from-string requires-str))))))
+              (setq commentary (lm-commentary))
+              (list version description req commentary)))))))
+
+(defun archive--process-simple-package (dir pkg vers desc req commentary)
+  "Deploy the contents of DIR into the archive as a simple package.
+Rename DIR/PKG.el to PKG-VERS.el, delete DIR, and write the
+package commentary to PKG-readme.txt.  Return the descriptor."
+  ;; Write the readme file.
+  (with-temp-buffer
+    (erase-buffer)
+    (emacs-lisp-mode)
+    (insert (or commentary
+               (prog1 "No description"
+                 (message "Missing commentary in package %s" pkg))))
+    (goto-char (point-min))
+    (while (looking-at ";*[ \t]*\\(commentary[: \t]*\\)?\n")
+      (delete-region (match-beginning 0)
+                    (match-end 0)))
+    (uncomment-region (point-min) (point-max))
+    (goto-char (point-max))
+    (while (progn (forward-line -1)
+                 (looking-at "[ \t]*\n"))
+      (delete-region (match-beginning 0)
+                    (match-end 0)))
+    (write-region nil nil (concat pkg "-readme.txt")))
+  ;; Write DIR/foo.el to foo-VERS.el and delete DIR
+  (rename-file (expand-file-name (concat pkg ".el") dir)
+              (concat pkg "-" vers ".el"))
+  (delete-directory dir t)
+  (cons (intern pkg) (vector (version-to-list vers) req desc 'single)))
+
+(defun archive--process-multi-file-package (dir pkg)
+  "Deploy the contents of DIR into the archive as a multi-file package.
+Rename DIR/ to PKG-VERS/, and write the package commentary to
+PKG-readme.txt.  Return the descriptor."
+  (let* ((exp (archive--multi-file-package-def dir pkg))
+        (vers (nth 2 exp))
+        (req (mapcar 'archive--convert-require (nth 4 exp)))
+        (readme (expand-file-name "README" dir)))
+    (unless (equal (nth 1 exp) pkg)
+      (error (format "Package name %s doesn't match file name %s"
+                    (nth 1 exp) pkg)))
+    ;; Write the readme file.
+    (when (file-exists-p readme)
+      (copy-file readme (concat pkg "-readme.txt") 'ok-if-already-exists))
+    (rename-file dir (concat pkg "-" vers))
+    (cons (intern pkg) (vector (version-to-list vers) req (nth 3 exp) 'tar))))
+
+(defun archive--multi-file-package-def (dir pkg)
+  "Reurn the `define-package' form in the file DIR/PKG-pkg.el."
+  (let ((pkg-file (expand-file-name (concat pkg "-pkg.el") dir)))
+    (with-temp-buffer
+      (unless (file-exists-p pkg-file)
+       (error "File not found: %s" pkg-file))
+      (insert-file-contents pkg-file)
+      (goto-char (point-min))
+      (read (current-buffer)))))
+
+(defun batch-make-site-dir (package-dir site-dir)
+  (require 'package)
+  (setq package-dir (expand-file-name package-dir default-directory))
+  (setq site-dir (expand-file-name site-dir default-directory))
+  (dolist (dir (directory-files package-dir t archive-re-no-dot))
+   (condition-case v
+       (if (not (file-directory-p dir))
+           (error "Skipping non-package file %s" dir)
+         (let* ((pkg (file-name-nondirectory dir))
+                (autoloads-file (expand-file-name (concat pkg "-autoloads.el") 
dir))
+                simple-p version)
+           ;; Omit autoloads and .elc files from the package.
+           (if (file-exists-p autoloads-file)
+               (delete-file autoloads-file))
+           (archive--delete-elc-files dir)
+           ;; Test whether this is a simple or multi-file package.
+           (setq simple-p (archive--simple-package-p dir pkg))
+           (if simple-p
+               (progn
+                 (apply 'archive--write-pkg-file dir pkg simple-p)
+                 (setq version (car simple-p)))
+             (setq version
+                   (nth 2 (archive--multi-file-package-def dir pkg))))
+           (make-symbolic-link (expand-file-name dir package-dir)
+                               (expand-file-name (concat pkg "-" version)
+                                                 site-dir)
+                               t)
+           (package-generate-autoloads pkg dir)
+           (let ((load-path (cons dir load-path)))
+             (byte-recompile-directory dir 0 t))))
+     ;; Error handler
+     (error (message "%s" (cadr v))))))
+
+(defun archive--write-pkg-file (pkg-dir name version desc requires &rest 
ignored)
+  (let ((pkg-file (expand-file-name (concat name "-pkg.el") pkg-dir))
+       (print-level nil)
+       (print-length nil))
+    (write-region
+     (concat (format ";; Generated package description from %s.el\n"
+                    name)
+            (prin1-to-string
+             (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))))
+            "\n")
+     nil
+     pkg-file)))
+
 
 ;; Local Variables:
 ;; no-byte-compile: t