[nongnu] elpa-admin 5319f2f 062/439: * archive-contents.el: Make `site' more incrementally.

[Philip Kaludercic]

branch: elpa-admin
commit 5319f2f7681821b961e863e49f47c97ec6dc0d59
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    * archive-contents.el: Make `site' more incrementally.
    (archive--delete-elc-files): New arg` only-orphans'.
    (archive--simple-package-p): Don't count .elc files; add default version.
    (batch-make-site-dir): Don't force recompilation of all .elc files.
    Don't generate silly backup versions of the autoloads file.
---
 admin/archive-contents.el | 25 +++++++++++++++++--------
 1 file changed, 17 insertions(+), 8 deletions(-)

diff --git a/admin/archive-contents.el b/admin/archive-contents.el
index e94093a..f3b250a 100644
--- a/admin/archive-contents.el
+++ b/admin/archive-contents.el
@@ -45,13 +45,15 @@ Otherwise return nil."
            str)
       (error nil))))
 
-(defun archive--delete-elc-files (dir)
+(defun archive--delete-elc-files (dir &optional only-orphans)
   "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)
+         ((or (and (string-match "\\.elc\\'" f)
+                    (not (and only-orphans
+                              (file-readable-p (replace-match ".el" t t f)))))
               (backup-file-name-p f))
           (delete-file f)))))
 
@@ -91,9 +93,13 @@ 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))
+         (files (directory-files dir nil archive-re-no-dot))
         version description req commentary)
+    (dolist (file (prog1 files (setq files ())))
+      (unless (string-match "\\.elc\\'" file)
+        (push file files)))
     (when (and (or (not (file-exists-p pkg-file))
-                  (= (length (directory-files dir nil archive-re-no-dot)) 2))
+                  (= (length files) 2))
               (file-exists-p mainfile))
       (with-temp-buffer
        (insert-file-contents mainfile)
@@ -103,7 +109,8 @@ Otherwise, return nil."
               (setq description (match-string 1))
               (setq version
                     (or (archive--strip-rcs-id (lm-header "package-version"))
-                        (archive--strip-rcs-id (lm-header "version")))))
+                        (archive--strip-rcs-id (lm-header "version"))
+                         "0.0")))
             (progn
               ;; Grab the other fields, which are not mandatory.
               (let ((requires-str (lm-header "package-requires")))
@@ -182,9 +189,9 @@ PKG-readme.txt.  Return the descriptor."
            ;; Omit autoloads and .elc files from the package.
            (if (file-exists-p autoloads-file)
                (delete-file autoloads-file))
-           (archive--delete-elc-files dir)
+           (archive--delete-elc-files dir 'only-orphans)
            ;; Test whether this is a simple or multi-file package.
-           (setq simple-p (archive--simple-package-p dir pkg))
+            (setq simple-p (archive--simple-package-p dir pkg))
            (if simple-p
                (progn
                  (apply 'archive--write-pkg-file dir pkg simple-p)
@@ -195,9 +202,11 @@ PKG-readme.txt.  Return the descriptor."
                                (expand-file-name (concat pkg "-" version)
                                                  site-dir)
                                t)
-           (package-generate-autoloads pkg dir)
+            (let ((make-backup-files nil))
+              (package-generate-autoloads pkg dir))
            (let ((load-path (cons dir load-path)))
-             (byte-recompile-directory dir 0 t))))
+              ;; FIXME: Don't compile the -pkg.el files!
+             (byte-recompile-directory dir 0))))
      ;; Error handler
      (error (message "%s" (cadr v))))))