code.delx.au - gnu-emacs-elpa/blob - admin/archive-contents.el

   1 ;;; archive-contents.el --- Auto-generate an Emacs Lisp package archive.  -*- lexical-binding:t -*-
   2
   3 ;; Copyright (C) 2011, 2012, 2013  Free Software Foundation, Inc
   4
   5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
   6
   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.
  11
  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.
  16
  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/>.
  19
  20 ;;; Commentary:
  21
  22 ;;; Code:
  23
  24 (eval-when-compile (require 'cl))
  25 (require 'lisp-mnt)
  26 (require 'package)
  27 (require 'pcase)
  28
  29 (defconst archive-contents-subdirectory-regexp
  30   "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)")
  31
  32 (defconst archive-re-no-dot "\\`\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"
  33   "Regular expression matching all files except \".\" and \"..\".")
  34
  35 (defun archive--convert-require (elt)
  36   (list (car elt)
  37         (version-to-list (car (cdr elt)))))
  38
  39 (defun archive--strip-rcs-id (str)
  40   "Strip RCS version ID from the version string STR.
  41 If the result looks like a dotted numeric version, return it.
  42 Otherwise return nil."
  43   (when str
  44     (when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str)
  45       (setq str (substring str (match-end 0))))
  46     (condition-case nil
  47         (if (version-to-list str)
  48             str)
  49       (error nil))))
  50
  51 (defun archive--delete-elc-files (dir &optional only-orphans)
  52   "Recursively delete all .elc files in DIR.
  53 Delete backup files also."
  54   (dolist (f (directory-files dir t archive-re-no-dot))
  55     (cond ((file-directory-p f)
  56            (archive--delete-elc-files f))
  57           ((or (and (string-match "\\.elc\\'" f)
  58                     (not (and only-orphans
  59                               (file-readable-p (replace-match ".el" t t f)))))
  60                (backup-file-name-p f))
  61            (delete-file f)))))
  62
  63 (defun batch-make-archive ()
  64   "Process package content directories and generate the archive-contents file."
  65   (let ((packages '(1))) ; format-version.
  66     (dolist (dir (directory-files default-directory nil archive-re-no-dot))
  67       (condition-case v
  68           (if (not (file-directory-p dir))
  69               (message "Skipping non-package file %s" dir)
  70             (let* ((pkg (file-name-nondirectory dir))
  71                    (autoloads-file (expand-file-name (concat pkg "-autoloads.el") dir))
  72                    simple-p)
  73               ;; Omit autoloads and .elc files from the package.
  74               (if (file-exists-p autoloads-file)
  75                   (delete-file autoloads-file))
  76               (archive--delete-elc-files dir)
  77               ;; Test whether this is a simple or multi-file package.
  78               (setq simple-p (archive--simple-package-p dir pkg))
  79               (push (if (car simple-p)
  80                         (apply #'archive--process-simple-package
  81                                dir pkg (cdr simple-p))
  82                       (apply 'archive--write-pkg-file dir pkg (cdr simple-p))
  83                       (archive--process-multi-file-package dir pkg))
  84                     packages)))
  85         (error (error "Error in %s: %S" dir v))))
  86     (with-temp-buffer
  87       (pp (nreverse packages) (current-buffer))
  88       (write-region nil nil "archive-contents"))))
  89
  90 (defconst archive--revno-re "[0-9a-f]+")
  91
  92 (defun archive-prepare-packages (srcdir)
  93   "Prepare the `packages' directory inside the Git checkout.
  94 Expects to be called from within the `packages' directory.
  95 \"Prepare\" here is for subsequent construction of the packages and archive,
  96 so it is meant to refresh any generated files we may need.
  97 Currently only refreshes the ChangeLog files."
  98   (setq srcdir (file-name-as-directory (expand-file-name srcdir)))
  99   (let* ((wit ".changelog-witness")
 100          (prevno (with-temp-buffer
 101                    (ignore-errors (insert-file-contents wit))
 102                    (if (looking-at (concat archive--revno-re "$"))
 103                        (match-string 0)
 104                      (error "Can't find previous revision name"))))
 105          (new-revno
 106           (or (with-temp-buffer
 107                 (let ((default-directory srcdir))
 108                   (call-process "git" nil '(t) nil "rev-parse" "HEAD")
 109                   (goto-char (point-min))
 110                   (when (looking-at (concat archive--revno-re "$"))
 111                     (match-string 0))))
 112               (error "Couldn't find the current revision's name")))
 113          (pkgs '()))
 114     (unless (equal prevno new-revno)
 115       (with-temp-buffer
 116         (let ((default-directory srcdir))
 117           (unless (zerop (call-process "git" nil '(t) nil "diff"
 118                                        "--dirstat=cumulative,0"
 119                                        prevno))
 120             (error "Error signaled by git diff --dirstat %d" prevno)))
 121         (goto-char (point-min))
 122         (while (re-search-forward "^[ \t.0-9%]* packages/\\([-[:alnum:]]+\\)/$"
 123                                   nil t)
 124           (push (match-string 1) pkgs))))
 125     (let ((default-directory (expand-file-name "packages/")))
 126       (dolist (pkg pkgs)
 127         (condition-case v
 128             (if (file-directory-p pkg)
 129                 (archive--make-changelog pkg (expand-file-name "packages/"
 130                                                                srcdir)))
 131           (error (message "Error: %S" v)))))
 132     (write-region new-revno nil wit nil 'quiet)
 133     ;; Also update the ChangeLog of external packages.
 134     (let ((default-directory (expand-file-name "packages/")))
 135       (dolist (dir (directory-files "."))
 136         (and (not (member dir '("." "..")))
 137              (file-directory-p dir)
 138              (let ((index (expand-file-name
 139                            (concat "packages/" dir "/.git/index")
 140                            srcdir))
 141                    (cl (expand-file-name "ChangeLog" dir)))
 142                (and (file-exists-p index)
 143                     (or (not (file-exists-p cl))
 144                         (file-newer-than-file-p index cl))))
 145              (archive--make-changelog
 146               dir (expand-file-name "packages/" srcdir)))))
 147     ))
 148
 149 (defun archive--simple-package-p (dir pkg)
 150   "Test whether DIR contains a simple package named PKG.
 151 Return a list (SIMPLE VERSION DESCRIPTION REQ), where
 152 SIMPLE is non-nil if the package is indeed simple;
 153 VERSION is the version string of the simple package;
 154 DESCRIPTION is the brief description of the package;
 155 REQ is a list of requirements.
 156 Otherwise, return nil."
 157   (let* ((pkg-file (expand-file-name (concat pkg "-pkg.el") dir))
 158          (mainfile (expand-file-name (concat pkg ".el") dir))
 159          (files (directory-files dir nil "\\.el\\'"))
 160          version description req)
 161     (setq files (delete (concat pkg "-pkg.el") files))
 162     (setq files (delete (concat pkg "-autoloads.el") files))
 163     (cond
 164      ((and (not (file-exists-p pkg-file))
 165            (file-exists-p mainfile))
 166       (with-temp-buffer
 167         (insert-file-contents mainfile)
 168         (goto-char (point-min))
 169         (if (not (looking-at ";;;.*---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ \t]*\\)?$"))
 170             (error "Can't parse first line of %s" mainfile)
 171           (setq description (match-string 1))
 172           (setq version
 173                 (or (archive--strip-rcs-id (lm-header "package-version"))
 174                     (archive--strip-rcs-id (lm-header "version"))
 175                     (error "Missing `version' header")))
 176           ;; Grab the other fields, which are not mandatory.
 177           (let ((requires-str (lm-header "package-requires")))
 178             (if requires-str
 179                 (setq req (mapcar 'archive--convert-require
 180                                   (car (read-from-string requires-str))))))
 181           (list (= (length files) 1) version description req))))
 182      ((not (file-exists-p pkg-file))
 183       (error "Can find single file nor package desc file in %s" dir)))))
 184
 185 (defun archive--process-simple-package (dir pkg vers desc req)
 186   "Deploy the contents of DIR into the archive as a simple package.
 187 Rename DIR/PKG.el to PKG-VERS.el, delete DIR, and return the descriptor."
 188   ;; Write DIR/foo.el to foo-VERS.el and delete DIR
 189   (rename-file (expand-file-name (concat pkg ".el") dir)
 190                (concat pkg "-" vers ".el"))
 191   ;; Add the content of the ChangeLog.
 192   (let ((cl (expand-file-name "ChangeLog" dir)))
 193     (with-current-buffer (find-file-noselect (concat pkg "-" vers ".el"))
 194       (goto-char (point-max))
 195       (re-search-backward "^;;;.*ends here")
 196       (re-search-backward "^(provide")
 197       (skip-chars-backward " \t\n")
 198       (insert "\n\n;;;; ChangeLog:\n\n")
 199       (let* ((start (point))
 200              (end (copy-marker start t)))
 201         (insert-file-contents cl)
 202         (goto-char end)
 203         (unless (bolp) (insert "\n"))
 204         (while (progn (forward-line -1) (>= (point) start))
 205           (insert ";; ")))
 206       (set (make-local-variable 'backup-inhibited) t)
 207       (basic-save-buffer)               ;Less chatty than save-buffer.
 208       (kill-buffer)))
 209   (delete-directory dir t)
 210   (cons (intern pkg) (vector (version-to-list vers) req desc 'single)))
 211
 212 (defun archive--make-changelog (dir srcdir)
 213   "Export Git log info of DIR into a ChangeLog file."
 214   (message "Refreshing ChangeLog in %S" dir)
 215   (let ((default-directory (file-name-as-directory (expand-file-name dir))))
 216     (with-temp-buffer
 217       (set-buffer-multibyte nil)
 218       (let ((coding-system-for-read 'binary)
 219             (coding-system-for-write 'binary))
 220         (if (file-readable-p "ChangeLog") (insert-file-contents "ChangeLog"))
 221         (let ((old-md5 (md5 (current-buffer))))
 222           (erase-buffer)
 223           (let ((default-directory
 224                   (file-name-as-directory (expand-file-name dir srcdir))))
 225             (call-process "git" nil (current-buffer) nil
 226                           "log" "--date=short"
 227                           "--format=%cd  %aN  <%ae>%n%n%w(80,8,8)%B%n"
 228                           "."))
 229           (tabify (point-min) (point-max))
 230           (goto-char (point-min))
 231           (while (re-search-forward "\n\n\n+" nil t)
 232             (replace-match "\n\n"))
 233           (if (equal old-md5 (md5 (current-buffer)))
 234               (message "ChangeLog's md5 unchanged for %S" dir)
 235             (write-region (point-min) (point-max) "ChangeLog" nil 'quiet)))))))
 236
 237 (defun archive--process-multi-file-package (dir pkg)
 238   "Deploy the contents of DIR into the archive as a multi-file package.
 239 Rename DIR/ to PKG-VERS/, and return the descriptor."
 240   (let* ((exp (archive--multi-file-package-def dir pkg))
 241          (vers (nth 2 exp))
 242          (req (mapcar 'archive--convert-require (nth 4 exp))))
 243     (unless (equal (nth 1 exp) pkg)
 244       (error (format "Package name %s doesn't match file name %s"
 245                      (nth 1 exp) pkg)))
 246     (rename-file dir (concat pkg "-" vers))
 247     (cons (intern pkg) (vector (version-to-list vers) req (nth 3 exp) 'tar))))
 248
 249 (defun archive--multi-file-package-def (dir pkg)
 250   "Return the `define-package' form in the file DIR/PKG-pkg.el."
 251   (let ((pkg-file (expand-file-name (concat pkg "-pkg.el") dir)))
 252     (with-temp-buffer
 253       (unless (file-exists-p pkg-file)
 254         (error "File not found: %s" pkg-file))
 255       (insert-file-contents pkg-file)
 256       (goto-char (point-min))
 257       (read (current-buffer)))))
 258
 259 (defun archive--refresh-pkg-file ()
 260   (let* ((dir (directory-file-name default-directory))
 261          (pkg (file-name-nondirectory dir))
 262          (simple-p (archive--simple-package-p dir pkg)))
 263     (if simple-p
 264         (progn
 265           ;; (message "Refreshing pkg description of %s" pkg)
 266           (apply 'archive--write-pkg-file dir pkg (cdr simple-p)))
 267       ;; (message "Not refreshing pkg description of %s" pkg)
 268       )))
 269
 270 (defun archive--write-pkg-file (pkg-dir name version desc requires &rest ignored)
 271   (let ((pkg-file (expand-file-name (concat name "-pkg.el") pkg-dir))
 272         (print-level nil)
 273         (print-quoted t)
 274         (print-length nil))
 275     (write-region
 276      (concat (format ";; Generated package description from %s.el\n"
 277                      name)
 278              (prin1-to-string
 279               (list 'define-package
 280                     name
 281                     version
 282                     desc
 283                     (list 'quote
 284                           ;; Turn version lists into string form.
 285                           (mapcar
 286                            (lambda (elt)
 287                              (list (car elt)
 288                                    (package-version-join (cadr elt))))
 289                            requires))))
 290              "\n")
 291      nil
 292      pkg-file)))
 293
 294 ;;; Make the HTML pages for online browsing.
 295
 296 (defun archive--html-header (title)
 297   (format "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">
 298 <html>
 299 <head>
 300   <title>%s</title>
 301   <meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\">
 302 </head>
 303 <body>
 304 <h1 align=\"center\">%s</h1>\n"
 305           title title))
 306
 307 (defun archive--html-bytes-format (bytes) ;Aka memory-usage-format.
 308   (setq bytes (/ bytes 1024.0))
 309   (let ((units '(;; "B"
 310                  "kB" "MB" "GB" "TB")))
 311     (while (>= bytes 1024)
 312       (setq bytes (/ bytes 1024.0))
 313       (setq units (cdr units)))
 314     (cond
 315      ;; ((integerp bytes) (format "%4d%s" bytes (car units)))
 316      ((>= bytes 100) (format "%4.0f%s" bytes (car units)))
 317      ((>= bytes 10) (format "%4.1f%s" bytes (car units)))
 318      (t (format "%4.2f%s" bytes (car units))))))
 319
 320 (defun archive--get-prop (prop name srcdir mainsrcfile)
 321   (let ((kprop (intern (format ":%s" (downcase prop)))))
 322     (or
 323      (let ((pkgdescfile (expand-file-name (format "%s-pkg.el" name)
 324                                           srcdir)))
 325        (when (file-readable-p pkgdescfile)
 326          (with-temp-buffer
 327            (insert-file-contents pkgdescfile)
 328            (let ((desc (read (current-buffer))))
 329              (plist-get (cdr desc) kprop)))))
 330      (when (file-readable-p mainsrcfile)
 331        (with-temp-buffer
 332          (insert-file-contents mainsrcfile)
 333          (lm-header prop))))))
 334
 335 (defun archive--get-section (hsection fsection srcdir mainsrcfile)
 336   (when (consp fsection)
 337     (while (cdr-safe fsection)
 338       (setq fsection
 339             (if (file-readable-p (expand-file-name (car fsection) srcdir))
 340                 (car fsection)
 341               (cdr fsection))))
 342     (when (consp fsection) (setq fsection (car fsection))))
 343   (cond
 344    ((file-readable-p (expand-file-name fsection srcdir))
 345     (with-temp-buffer
 346       (insert-file-contents (expand-file-name fsection srcdir))
 347       (buffer-string)))
 348    ((file-readable-p mainsrcfile)
 349     (with-temp-buffer
 350       (insert-file-contents mainsrcfile)
 351       (let ((start (lm-section-start hsection)))
 352         (when start
 353           (insert
 354            (prog1
 355                (buffer-substring start (lm-section-end hsection))
 356              (erase-buffer)))
 357           (emacs-lisp-mode)
 358           (goto-char (point-min))
 359           (delete-region (point) (line-beginning-position 2))
 360           (uncomment-region (point-min) (point-max))
 361           (when (looking-at "^\\([ \t]*\n\\)+")
 362             (replace-match ""))
 363           (goto-char (point-max))
 364           (skip-chars-backward " \t\n")
 365           (delete-region (point) (point-max))
 366           (buffer-string)))))))
 367
 368 (defun archive--quote (txt)
 369   (replace-regexp-in-string "<" "&lt;"
 370                             (replace-regexp-in-string "&" "&amp;" txt)))
 371
 372 (defun archive--insert-repolinks (name srcdir mainsrcfile)
 373   (let ((url (archive--get-prop "URL" name srcdir mainsrcfile)))
 374     (if url
 375         (insert (format "<p>Origin: <a href=%S>%s</a></p>\n"
 376                         url (archive--quote url)))
 377       (let* ((externals
 378               (with-temp-buffer
 379                 (insert-file-contents
 380                  (expand-file-name "../../../elpa/externals-list" srcdir))
 381                 (read (current-buffer))))
 382              (external (eq :external (nth 1 (assoc name externals))))
 383              (git-sv "http://git.savannah.gnu.org/")
 384              (urls (if external
 385                        '("cgit/emacs/elpa.git/?h=externals/"
 386                          "gitweb/?p=emacs/elpa.git;a=shortlog;h=refs/heads/externals/")
 387                      '("cgit/emacs/elpa.git/tree/packages/"
 388                        "gitweb/?p=emacs/elpa.git;a=tree;f=packages/"))))
 389         (insert (format
 390                  (concat "<p>Browse repository: <a href=%S>%s</a>"
 391                          " or <a href=%S>%s</a></p>\n")
 392                  (concat git-sv (nth 0 urls) name)
 393                  'CGit
 394                  (concat git-sv (nth 1 urls) name)
 395                  'Gitweb))))))
 396
 397 (defun archive--html-make-pkg (pkg files)
 398   (let* ((name (symbol-name (car pkg)))
 399          (latest (package-version-join (aref (cdr pkg) 0)))
 400          (srcdir (expand-file-name name "../../build/packages"))
 401          (mainsrcfile (expand-file-name (format "%s.el" name) srcdir))
 402          (desc (aref (cdr pkg) 2)))
 403     (with-temp-buffer
 404       (insert (archive--html-header (format "GNU ELPA - %s" name)))
 405       (insert (format "<p>Description: %s</p>\n" (archive--quote desc)))
 406       (let* ((file (cdr (assoc latest files)))
 407              (attrs (file-attributes file)))
 408         (insert (format "<p>Latest: <a href=%S>%s</a>, %s, %s</p>\n"
 409                         file (archive--quote file)
 410                         (format-time-string "%Y-%b-%d" (nth 5 attrs))
 411                         (archive--html-bytes-format (nth 7 attrs)))))
 412       (let ((maint (archive--get-prop "Maintainer" name srcdir mainsrcfile)))
 413         (when maint
 414           (insert (format "<p>Maintainer: %s</p>\n" (archive--quote maint)))))
 415       (archive--insert-repolinks name srcdir mainsrcfile)
 416       (let ((rm (archive--get-section
 417                  "Commentary" '("README" "README.rst" "README.md" "README.org")
 418                  srcdir mainsrcfile)))
 419         (when rm
 420           (write-region rm nil (concat name "-readme.txt"))
 421           (insert "<h2>Full description</h2><pre>\n" (archive--quote rm)
 422                   "\n</pre>\n")))
 423       (unless (< (length files) 2)
 424         (insert (format "<h2>Old versions</h2><table cellpadding=\"3\" border=\"1\">\n"))
 425         (dolist (file files)
 426           (unless (equal (pop file) latest)
 427             (let ((attrs (file-attributes file)))
 428               (insert (format "<tr><td><a href=%S>%s</a></td><td>%s</td><td>%s</td>\n"
 429                               file (archive--quote file)
 430                               (format-time-string "%Y-%b-%d" (nth 5 attrs))
 431                               (archive--html-bytes-format (nth 7 attrs)))))))
 432         (insert "</table>\n"))
 433       (let ((news (archive--get-section
 434                    "News" '("NEWS" "NEWS.rst" "NEWS.md" "NEWS.org")
 435                    srcdir mainsrcfile)))
 436         (when news
 437           (insert "<h2>News</h2><pre>\n" (archive--quote news) "\n</pre>\n")))
 438       (insert "</body>\n")
 439       (write-region (point-min) (point-max) (concat name ".html")))))
 440
 441 (defun archive--html-make-index (pkgs)
 442   (with-temp-buffer
 443     (insert (archive--html-header "GNU ELPA Packages"))
 444     (insert "<table cellpadding=\"3\" border=\"1\">\n")
 445     (insert "<tr><th>Package</th><th>Version</th><th>Description</th></tr>\n")
 446     (dolist (pkg pkgs)
 447       (insert (format "<tr><td><a href=\"%s.html\">%s</a></td><td>%s</td><td>%s</td></tr>\n"
 448                       (car pkg) (car pkg)
 449                       (package-version-join (aref (cdr pkg) 0))
 450                       (aref (cdr pkg) 2))))
 451     (insert "</table></body>\n")
 452     (write-region (point-min) (point-max) "index.html")))
 453
 454 (defun batch-html-make-index ()
 455   (let ((packages (make-hash-table :test #'equal))
 456         (archive-contents
 457          (with-temp-buffer
 458            (insert-file-contents "archive-contents")
 459            (goto-char (point-min))
 460            ;; Skip the first element which is a version number.
 461            (cdr (read (current-buffer))))))
 462     (dolist (file (directory-files default-directory nil))
 463       (cond
 464        ((member file '("." ".." "elpa.rss" "index.html" "archive-contents")))
 465        ((string-match "\\.html\\'" file))
 466        ((string-match "-readme\\.txt\\'" file)
 467         (let ((name (substring file 0 (match-beginning 0))))
 468           (puthash name (gethash name packages) packages)))
 469        ((string-match "-\\([0-9][^-]*\\)\\.\\(tar\\|el\\)\\'" file)
 470         (let ((name (substring file 0 (match-beginning 0)))
 471               (version (match-string 1 file)))
 472           (push (cons version file) (gethash name packages))))
 473        (t (message "Unknown file %S" file))))
 474     (dolist (pkg archive-contents)
 475       (archive--html-make-pkg pkg (gethash (symbol-name (car pkg)) packages)))
 476     ;; FIXME: Add (old?) packages that are in `packages' but not in
 477     ;; archive-contents.
 478     (archive--html-make-index archive-contents)))
 479
 480 ;;; Maintain external packages.
 481
 482 (defconst archive--elpa-git-url "git://git.sv.gnu.org/emacs/elpa")
 483
 484 (defun archive-add/remove/update-externals ()
 485   (let ((exts (with-current-buffer (find-file-noselect "externals-list")
 486                 (goto-char (point-min))
 487                 (read (current-buffer)))))
 488     (let ((default-directory (expand-file-name "packages/")))
 489       ;; Remove "old/odd" externals.
 490       (dolist (dir (directory-files "."))
 491         (cond
 492          ((member dir '("." "..")) nil)
 493          ((assoc dir exts) nil)
 494          ((file-directory-p (expand-file-name (format "%s/.git" dir)))
 495           (let ((status
 496                  (with-temp-buffer
 497                    (let ((default-directory (file-name-as-directory
 498                                              (expand-file-name dir))))
 499                      (call-process "git" nil t nil "status" "--porcelain")
 500                      (buffer-string)))))
 501             (if (zerop (length status))
 502                 (progn (delete-directory dir 'recursive t)
 503                        (message "Deleted all of %s" dir))
 504               (message "Keeping leftover unclean %s:\n%s" dir status))))))
 505       (pcase-dolist (`(,dir ,kind ,_url) exts)
 506         (cond
 507          ((eq kind :subtree) nil)       ;Nothing to do.
 508          ((not (eq kind :external))
 509           (message "Unknown external package kind `%S' for %s" kind dir))
 510          ((not (file-exists-p dir))
 511           (let* ((branch (concat "externals/" dir))
 512                  (output
 513                   (with-temp-buffer
 514                     ;; FIXME: Use git-new-workdir!
 515                     (call-process "git" nil t nil "clone"
 516                                   "--reference" ".." "--branch" branch
 517                                   archive--elpa-git-url dir)
 518                     (buffer-string))))
 519             (message "Cloning branch %s:\n%s" dir output)))
 520          ((not (file-directory-p (concat dir "/.git")))
 521           (message "%s is in the way of an external, please remove!" dir))
 522          (t
 523           (let ((default-directory (file-name-as-directory
 524                                     (expand-file-name dir))))
 525             (with-temp-buffer
 526               (message "Running git pull in %S" default-directory)
 527               (call-process "git" nil t nil "pull")
 528               (message "Updated %s:%s" dir (buffer-string))))
 529           ))))))
 530
 531 (provide 'archive-contents)
 532 ;;; archive-contents.el ends here