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