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