;;; archive-contents.el --- Auto-generate an Emacs Lisp package archive. -*- lexical-binding:t -*-
-;; Copyright (C) 2011-2015 Free Software Foundation, Inc
+;; Copyright (C) 2011-2016 Free Software Foundation, Inc
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
(error "Can't parse first line of %s" mainfile)
;; Grab the other fields, which are not mandatory.
(let* ((description (match-string 1))
- (pv )
(version
(or (lm-header "package-version")
(lm-header "version")
(replace-regexp-in-string "<" "<"
(replace-regexp-in-string "&" "&" txt)))
-(defun archive--insert-repolinks (name srcdir mainsrcfile url)
+(defun archive--insert-repolinks (name srcdir _mainsrcfile url)
(when url
(insert (format "<p>Home page: <a href=%S>%s</a></p>\n"
url (archive--quote url)))
packages)
(archive--html-make-index archive-contents)))
+(defun archive--pull (dirname)
+ (let ((default-directory (file-name-as-directory
+ (expand-file-name dirname))))
+ (with-temp-buffer
+ (message "Running git pull in %S" default-directory)
+ (call-process "git" nil t nil "pull")
+ (message "Updated %s:\n%s" dirname (buffer-string)))))
+
;;; Maintain external packages.
(defconst archive--elpa-git-url "git://git.sv.gnu.org/emacs/elpa")
(defconst archive--emacs-git-url "git://git.sv.gnu.org/emacs.git")
(defun archive--sync-emacs-repo ()
- "Clone and sync Emacs repository."
- (let ((reference (expand-file-name
- (or (getenv "EMACS_CLONE_REFERENCE") "../emacs/master")))
- (emacs-repo-root (expand-file-name "emacs")))
- (when (and (file-exists-p emacs-repo-root)
- (not (file-exists-p
- (expand-file-name "README" emacs-repo-root))))
- (message "Cleaning stalled Emacs clone: %s" emacs-repo-root)
- (delete-directory emacs-repo-root t))
- (cond ((file-exists-p emacs-repo-root)
- (let ((default-directory emacs-repo-root))
- (message "Running git pull in %S" default-directory)
- (call-process "git" nil t nil "pull")))
- ((file-exists-p reference)
- (message "Emacs repository reference found: %s" reference)
- (call-process
- "git" nil t nil
- "clone" archive--emacs-git-url
- "--reference" reference
- emacs-repo-root))
- (t
- (error
- (concat "Emacs repository not found at: %s\n"
- "Point EMACS_CLONE_REFERENCE environment variable to an "
- "existing checkout.") reference)))))
+ "Sync Emacs repository, if applicable.
+Return non-nil if there's an \"emacs\" repository present."
+ ;; Support for :core packages is important for elpa.gnu.org, but for other
+ ;; cases such as "in-place installation", it's rather secondary since
+ ;; those users can just as well use a development version of Emacs to get
+ ;; those packages.
+ ;; So make the handling of :core packages depend on whether or not the user
+ ;; has setup a clone of Emacs under the "emacs" subdirectory.
+ (let ((emacs-repo-root (expand-file-name "emacs")))
+ (if (not (file-directory-p emacs-repo-root))
+ (progn (message "No \"emacs\" subdir: will skip :core packages")
+ nil)
+ (archive--pull emacs-repo-root)
+ t)))
(defun archive--find-non-trivial-file (dir)
(catch 'found-important-file
(throw 'found-important-file file)))
nil))
-(defun archive--cleanup-packages (externals-list)
+(defun archive--cleanup-packages (externals-list with-core)
"Remove subdirectories of `packages/' that do not correspond to known packages.
This is any subdirectory inside `packages/' that's not under
-version control nor listed in EXTERNALS-LIST."
+version control nor listed in EXTERNALS-LIST.
+If WITH-CORE is non-nil, it means we manage :core packages as well."
(let ((default-directory (expand-file-name "packages/")))
(dolist (dir (directory-files "."))
(cond
((or (not (file-directory-p dir)) (file-symlink-p dir))
- ;; We only add/remove plain directories in elpa/packages (not symlinks).
+ ;; We only add/remove plain directories in elpa/packages (not
+ ;; symlinks).
nil)
((member dir '("." "..")) nil)
((assoc dir externals-list) nil)
(message "Deleted all of %s" dir))
(message "Keeping leftover unclean %s:\n%s" dir status))))
;; Check if `dir' is under version control.
- ((not (zerop (call-process "git" nil nil nil
- "ls-files" "--error-unmatch" dir)))
+ ((and with-core
+ (not (zerop (call-process "git" nil nil nil
+ "ls-files" "--error-unmatch" dir))))
;; Not under version control. Check if it only contains
;; symlinks and generated files, in which case it is probably
;; a leftover :core package that can safely be deleted.
- (let ((file (archive--find-non-trivial-file dir)))
- (if file
- (message "Keeping %s for non-trivial file \"%s\"" dir file)
- (progn
- (message "Deleted untracked package %s" dir)
- (delete-directory dir 'recursive t)))))))))
+ ;; (let ((file (archive--find-non-trivial-file dir)))
+ ;; (if file
+ ;; (message "Keeping %s for non-trivial file \"%s\"" dir file)
+ ;; (progn
+ ;; (message "Deleted untracked package %s" dir)
+ ;; (delete-directory dir 'recursive t))))
+ )))))
(defun archive--external-package-sync (name)
"Sync external package named NAME."
(let* ((branch (concat "externals/" name))
(output
(with-temp-buffer
- ;; FIXME: Use git-new-workdir!
+ ;; FIXME: Use `git worktree'!
(call-process "git" nil t nil "clone"
"--reference" ".." "--single-branch"
"--branch" branch
(message "Cloning branch %s:\n%s" name output)))
((not (file-directory-p (concat name "/.git")))
(message "%s is in the way of an external, please remove!" name))
- (t
- (let ((default-directory (file-name-as-directory
- (expand-file-name name))))
- (with-temp-buffer
- (message "Running git pull in %S" default-directory)
- (call-process "git" nil t nil "pull")
- (message "Updated %s:%s" name (buffer-string))))))))
+ (t (archive--pull name)))))
(defun archive--core-package-empty-dest-p (dest)
"Return non-nil if DEST is an empty variant."
(let ((externals-list
(with-current-buffer (find-file-noselect "externals-list")
(read (buffer-string)))))
- (archive--cleanup-packages externals-list)
- (archive--sync-emacs-repo)
- (pcase-dolist ((and definition `(,name ,kind ,_url)) externals-list)
- (pcase kind
- (`:subtree nil) ;Nothing to do.
- (`:external (archive--external-package-sync name))
- (`:core (archive--core-package-sync definition))
- (_ (message "Unknown external package kind `%S' for %s" kind name))))))
+ (let ((with-core (archive--sync-emacs-repo)))
+ (archive--cleanup-packages externals-list with-core)
+ (pcase-dolist ((and definition `(,name ,kind ,_url)) externals-list)
+ (pcase kind
+ (`:subtree nil) ;Nothing to do.
+ (`:external (archive--external-package-sync name))
+ (`:core (when with-core (archive--core-package-sync definition)))
+ (_ (message "Unknown external package kind `%S' for %s"
+ kind name)))))))
(provide 'archive-contents)
;;; archive-contents.el ends here