]> code.delx.au - gnu-emacs-elpa/blobdiff - admin/archive-contents.el
admin/archive-contents.el (archive--delete-elc-files): Delete backup files too.
[gnu-emacs-elpa] / admin / archive-contents.el
index 9a185fb16c571e9f5d735c39757dfafc040b9c37..e94093a70c950c8afeb13a7ad5006136de967853 100644 (file)
@@ -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
 
@@ -46,11 +46,13 @@ Otherwise return nil."
       (error nil))))
 
 (defun archive--delete-elc-files (dir)
-  "Recursively delete all .elc files in 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))
-         ((string-match "\\.elc\\'" f)
+         ((or (string-match "\\.elc\\'" f)
+              (backup-file-name-p f))
           (delete-file f)))))
 
 (defun batch-make-archive ()
@@ -59,10 +61,10 @@ Otherwise return nil."
     (dolist (dir (directory-files default-directory nil archive-re-no-dot))
       (condition-case v
          (if (not (file-directory-p dir))
-             1;(error "Skipping non-package file %s" 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)
+                  simple-p)
              ;; Omit autoloads and .elc files from the package.
              (if (file-exists-p autoloads-file)
                  (delete-file autoloads-file))
@@ -76,10 +78,9 @@ Otherwise return nil."
                    packages)))
        ;; Error handler
        (error (message "%s" (cadr v)))))
-    (with-current-buffer (find-file-noselect "archive-contents")
-      (erase-buffer)
+    (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.
@@ -117,7 +118,7 @@ Otherwise, return nil."
 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-current-buffer (find-file-noselect (concat pkg "-readme.txt"))
+  (with-temp-buffer
     (erase-buffer)
     (emacs-lisp-mode)
     (insert (or commentary
@@ -133,7 +134,7 @@ package commentary to PKG-readme.txt.  Return the descriptor."
                  (looking-at "[ \t]*\n"))
       (delete-region (match-beginning 0)
                     (match-end 0)))
-    (save-buffer))
+    (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"))
@@ -144,13 +145,7 @@ package commentary to PKG-readme.txt.  Return the descriptor."
   "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* ((pkg-file (expand-file-name (concat pkg "-pkg.el") dir))
-        (exp
-         (with-temp-buffer
-           (unless pkg-file (error "File not found: %s" pkg-file))
-           (insert-file-contents pkg-file)
-           (goto-char (point-min))
-           (read (current-buffer))))
+  (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)))
@@ -163,6 +158,73 @@ PKG-readme.txt.  Return the descriptor."
     (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
 ;; lexical-binding: t