emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[nongnu] master beac792: * externals-list ("markdown-mode"): New package


From: Stefan Monnier
Subject: [nongnu] master beac792: * externals-list ("markdown-mode"): New package
Date: Thu, 3 Dec 2020 11:22:37 -0500 (EST)

branch: master
commit beac792ce1efe3278d5610ae7e675419d7dd7053
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    * externals-list ("markdown-mode"): New package
    
    * GNUmakefile (SITE_DIR): Remove unused var.
    (clean): Remove the .elc and -autoloads.el files instead of the `archive`.
    (MISSING_script, MISSING_PKGS): Add new rule so we can
    `make packages/<pkgname>` in order to populate that directory.
    
    * admin/archive-contents.el (archive--get-package-spec): Return the
    spec *with* the package name.
    (archive--metadata, archive--external-package-sync): Take a pkg-spec
    rather than a package name.
    (batch-make-archive, batch-generate-description-file): Adjust accordingly.
    (archive--make-one-package): Adjust accordingly.  Only add "0." instead
    of ".0." if the version already ends with a "separator" (like `snapshot`).
    (archive--make-one-package): Use `version-to-list`'s -4 (used for
    "snapshot") as the indicator for dont-release.
    (archive--override-version): Take a pkg-spec instead of just version-map.
    Use :dont-release to turn that marker into "snapshot".
    (version-regexp-alist): Add entries to support a few more formats
    encountered so far.
    (archive--use-worktree, archive--use-worktree-p): Remove; assume that
    worktree are supported.
    (archive--external-package-sync): Handle cases where there's no remote
    tracking branch yet.
    (batch-archive-update-worktrees): New function.
    (archive--ortb, archive--git-branch-p): New functions.
    (archive--fetch): Use them.  Don't change directory.  Handle the case
    where there's no remote tracking branch yet.
    (archive--push): Handle the case where there's no remote tracking
    branch yet.
    (archive--batch-fetch-and): Don't sync the worktree.
---
 GNUmakefile               |  25 +++++--
 admin/archive-contents.el | 182 +++++++++++++++++++++++++++++-----------------
 externals-list            |   8 +-
 3 files changed, 140 insertions(+), 75 deletions(-)

diff --git a/GNUmakefile b/GNUmakefile
index c6511f7..1b53f4e 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -4,7 +4,6 @@
 EMACS=emacs --batch
 
 ARCHIVE_TMP=archive-tmp
-SITE_DIR=site
 
 .PHONY: archive-tmp changelogs process-archive archive-full org-fetch clean 
all do-it
 
@@ -102,7 +101,9 @@ org-fetch: archive-tmp
        fi
 
 clean:
-       rm -rf archive $(ARCHIVE_TMP) $(SITE_DIR)
+#      rm -rf archive $(ARCHIVE_TMP)
+       rm -f packages/*/*-autoloads.el
+       find packages -name '*.elc' -print0 | xargs -0 rm -f
 
 ########## Rules for in-place installation ####################################
 pkgs := $(foreach pkg, $(wildcard packages/*), \
@@ -202,10 +203,9 @@ pkg_descs:=$(foreach pkg, $(pkgs), $(pkg)/$(notdir 
$(pkg))-pkg.el)
 # Use order-only prerequisites, so that autoloads are done first.
 all-in-place: | $(extra_elcs) $(autoloads) $(pkg_descs) elcs
 
-##### Compiling the files of just a single package
 
-# FIXME: This should be tuned to as to "git worktree add" the branch
-# if the $(1) directory doesn't exist yet!
+#### `make package/<pkgname>` to compile the files of a single package     ####
+
 define RULE-singlepkg
 $(filter $(1)/%, $(elcs)): $1/$(notdir $(1))-pkg.el \
                            $1/$(notdir $(1))-autoloads.el
@@ -213,7 +213,20 @@ $(1): $(filter $(1)/%, $(elcs))
 endef
 $(foreach pkg, $(pkgs), $(eval $(call RULE-singlepkg, $(pkg))))
 
-##### Fetching updates from upstream
+
+#### `make package/<pkgname>` to populate one package's subdirectory       ####
+
+MISSING_script := (sed -ne 's|^.("\([^"]*\)".*|packages/\1|p' externals-list; \
+                   ls -1d packages/*; ls -1d packages/*)                     \
+                  | sort | uniq -u
+MISSING_PKGS := $(shell $(MISSING_script))
+
+$(MISSING_PKGS):
+       $(EMACS) -l admin/archive-contents.el \
+                -f batch-archive-update-worktrees "$(@F)"
+
+
+#### Fetching updates from upstream                                        ####
 
 .PHONY: fetch/%
 fetch/%:
diff --git a/admin/archive-contents.el b/admin/archive-contents.el
index f085bf6..41ea6c9 100644
--- a/admin/archive-contents.el
+++ b/admin/archive-contents.el
@@ -81,6 +81,7 @@ Delete backup files also."
          (if (not (file-directory-p dir))
              (message "Skipping non-package file %s" dir)
            (let* ((pkg (file-name-nondirectory dir))
+                  (pkg-spec (archive--get-package-spec pkg))
                   (autoloads-file (expand-file-name (concat pkg 
"-autoloads.el") dir)))
              ;; Omit autoloads and .elc files from the package.
               (when (file-exists-p autoloads-file)
@@ -88,7 +89,7 @@ Delete backup files also."
              (archive--delete-elc-files dir)
              (let ((metadata (or (with-demoted-errors
                                     ;;(format "batch-make-archive %s: %%s" dir)
-                                    (archive--metadata dir pkg))
+                                    (archive--metadata dir pkg-spec))
                                   '(nil "0"))))
                 ;; (nth 1 metadata) is nil for "org" which is the only package
                 ;; still using the "org-pkg.el file to specify the metadata.
@@ -270,7 +271,7 @@ commit which modified the \"Version:\" pseudo header."
          (spec (assoc pkgname specs)))
     (if (null spec)
         (error "Unknown package `%S`" pkgname)
-      (cdr spec))))
+      spec)))
 
 (defun batch-make-all-packages (&rest _)
   "Check all the packages and build the relevant new tarballs."
@@ -287,11 +288,10 @@ commit which modified the \"Version:\" pseudo header."
   "Build the new tarballs (if needed) for PKGNAME."
   (let* ((dir (expand-file-name pkgname "packages")))
     (archive--message "Checking package %s for updates..." pkgname)
-    (archive--external-package-sync pkgname)
     (let* ((pkg-spec (archive--get-package-spec pkgname))
+           (_ (archive--external-package-sync pkg-spec))
            (_ (archive--message "pkg-spec for %s: %S" pkgname pkg-spec))
-           (version-map (plist-get pkg-spec :version-map))
-           (metadata (archive--metadata dir pkgname version-map))
+           (metadata (archive--metadata dir pkg-spec))
            (vers (nth 1 metadata)))
       (archive--message "metadata = %S" metadata)
       (if (null metadata)
@@ -306,7 +306,11 @@ commit which modified the \"Version:\" pseudo header."
                ;; Add a ".0." so that when the version number goes from
                ;; NN.MM to NN.MM.1 we don't end up with the devel build
                ;; of NN.MM comparing as more recent than NN.MM.1.
-               (devel-vers (concat vers ".0." date-version))
+               ;; But be careful to turn "2.3" into "2.3.0.DATE"
+               ;; and "2.3b" into "2.3b0.DATE".
+               (devel-vers
+                (concat vers (if (string-match "[0-9]\\'" vers) ".")
+                        "0." date-version))
                (tarball (concat archive--devel-subdir
                                 (format "%s-%s.tar" pkgname devel-vers)))
                (archive--name (concat archive--name "-devel")))
@@ -316,21 +320,23 @@ commit which modified the \"Version:\" pseudo header."
         ;; Try and build the latest release tarball.
         (cond
          ((or (equal vers "0")
-              (let ((dont-release (plist-get pkg-spec :dont-release)))
-                (when dont-release (string-match dont-release vers))))
+              ;; -4 is used for "NN.MMsnapshot" and "NN.MM-git"
+              (member '-4 (version-to-list vers)))
           (archive--message "Package %s not released yet!" pkgname))
          (t
           (let ((tarball (concat archive--release-subdir
                                  (format "%s-%s.tar" pkgname vers))))
-            (archive--make-one-tarball tarball
-                                       dir pkgname metadata
-                                       (lambda ()
-                                         (archive--get-release-revision
-                                          dir pkgname vers 
version-map))))))))))
+            (archive--make-one-tarball
+             tarball dir pkgname metadata
+             (lambda ()
+               (archive--get-release-revision
+                dir pkgname vers
+                (plist-get (cdr pkg-spec) :version-map)))))))))))
 
 (defun archive--call (destination program &rest args)
   "Like ‘call-process’ for PROGRAM, DESTINATION, ARGS.
 The INFILE and DISPLAY arguments are fixed as nil."
+  ;; (message "call-process %s %S" program args)
   (apply #'call-process program nil destination nil args))
 
 (defconst archive--revno-re "[0-9a-f]+")
@@ -416,14 +422,25 @@ Currently only refreshes the ChangeLog files."
 (defconst archive-default-url-re (format archive-default-url-format ".*"))
 
 
-(defun archive--override-version (version-map orig-fun header)
+(defun archive--override-version (pkg-spec orig-fun header)
   (let ((str (funcall orig-fun header)))
     (or (if (or (equal header "version")
                 (and str (equal header "package-version")))
-            (cadr (assoc str version-map)))
+            (let ((version-map (plist-get (cdr pkg-spec) :version-map))
+                  (dont-release (plist-get (cdr pkg-spec) :dont-release)))
+              (or (cadr (assoc str version-map))
+                  (and str dont-release
+                       (string-match dont-release str)
+                       (replace-match "snapshot" t t str)))))
         str)))
 
-(defun archive--metadata (dir pkg &optional version-map)
+;; Some packages use version numbers which `version-to-list' doesn't
+;; recognize out of the box.  So here we help.
+
+(add-to-list 'version-regexp-alist '("^[-.+ ]*beta-?$" . -2)) ;"1.0.0-beta-3"
+(add-to-list 'version-regexp-alist '("^[-.+ ]*dev$" . -4))    ;2.5-dev
+
+(defun archive--metadata (dir pkg-spec)
   "Return a list (SIMPLE VERSION DESCRIPTION REQ EXTRAS),
 where SIMPLE is non-nil if the package is simple;
 VERSION is the version string of the simple package;
@@ -432,7 +449,8 @@ REQ is a list of requirements;
 EXTRAS is an alist with additional metadata.
 
 PKG is the name of the package and DIR is the directory where it is."
-  (let* ((mainfile (expand-file-name (concat pkg ".el") dir))
+  (let* ((pkg (car pkg-spec))
+         (mainfile (expand-file-name (concat pkg ".el") dir))
          (files (directory-files dir nil "\\`dir\\'\\|\\.el\\'")))
     (setq files (delete (concat pkg "-pkg.el") files))
     (setq files (delete (concat pkg "-autoloads.el") files))
@@ -444,11 +462,12 @@ PKG is the name of the package and DIR is the directory 
where it is."
         (let* ((pkg-desc
                 (unwind-protect
                     (progn
-                      (when version-map
+                      (when (or (plist-get (cdr pkg-spec) :version-map)
+                                (plist-get (cdr pkg-spec) :dont-release))
                         (advice-add 'lm-header :around
                                     (apply-partially
                                      #'archive--override-version
-                                     version-map)))
+                                     pkg-spec)))
                       (package-buffer-info))
                   (advice-remove 'lm-header
                                  #'archive--override-version)))
@@ -591,8 +610,9 @@ Rename DIR/ to PKG-VERS/, and return the descriptor."
 (defun archive-refresh-pkg-file ()
   ;; Note: Used via --batch by GNUmakefile rule.
   (let* ((dir (directory-file-name default-directory))
-         (pkg (file-name-nondirectory dir)))
-    (archive--write-pkg-file dir pkg (archive--metadata dir pkg))))
+         (pkg (file-name-nondirectory dir))
+         (pkg-spec (archive--get-package-spec pkg)))
+    (archive--write-pkg-file dir pkg (archive--metadata dir pkg-spec))))
 
 (defun archive--write-pkg-file (pkg-dir name metadata)
   ;; FIXME: Use package-generate-description-file!
@@ -629,10 +649,9 @@ Rename DIR/ to PKG-VERS/, and return the descriptor."
     (let* ((file (pop command-line-args-left))
            (dir (file-name-directory file))
            (pkg (file-name-nondirectory (directory-file-name dir)))
-           (pkg-spec (archive--get-package-spec pkg))
-           (version-map (plist-get pkg-spec :version-map)))
+           (pkg-spec (archive--get-package-spec pkg)))
       (archive--write-pkg-file dir pkg
-                               (archive--metadata dir pkg version-map)))))
+                               (archive--metadata dir pkg-spec)))))
 
 ;;; Make the HTML pages for online browsing.
 
@@ -1010,32 +1029,30 @@ If WITH-CORE is non-nil, it means we manage :core 
packages as well."
           ;;       (delete-directory dir 'recursive t))))
           ))))))
 
-(defvar archive--use-worktree nil)
-(defun archive--use-worktree-p ()
-  (unless archive--use-worktree
-    (setq archive--use-worktree
-          (list
-           (ignore-errors
-             (zerop (archive--call nil "git" "worktree" "list"))))))
-  (car archive--use-worktree))
-
-(defun archive--external-package-sync (name)
-  "Sync external package named NAME."
-  (let ((default-directory (expand-file-name "packages/")))
+
+(defun archive--external-package-sync (pkg-spec)
+  "Sync external package named PKG-SPEC."
+  (let ((name (car pkg-spec))
+        (default-directory (expand-file-name "packages/")))
     (unless (file-directory-p default-directory)
       (make-directory default-directory))
     (cond ((not (file-exists-p name))
            (let* ((branch (concat "externals/" name))
                   (output
                    (with-temp-buffer
-                     (if (archive--use-worktree-p)
-                         (archive--call t "git" "worktree" "add"
-                                       "-B" branch
-                                       name (concat "origin/" branch))
-                       (archive--call t "git" "clone"
-                                     "--reference" ".." "--single-branch"
-                                     "--branch" branch
-                                     archive--elpa-git-url name))
+                     (cond
+                      ((archive--git-branch-p (archive--ortb pkg-spec))
+                       (archive--call t "git" "worktree" "add"
+                                      "-B" branch
+                                      name (archive--ortb pkg-spec)))
+                      ((archive--git-branch-p branch)
+                       (archive--call t "git" "worktree" "add" name branch))
+                      ((archive--git-branch-p (archive--urtb pkg-spec))
+                       (archive--call t "git" "worktree" "add"
+                                      "-B" branch "--no-track"
+                                      name (archive--urtb pkg-spec)))
+                      (t (error "No branch %s for the worktree of %s"
+                                branch name)))
                      (buffer-string))))
              (message "Cloning branch %s:\n%s" name output)))
           ((not (file-exists-p (concat name "/.git")))
@@ -1140,17 +1157,32 @@ If WITH-CORE is non-nil, it means we manage :core 
packages as well."
 
 (defun archive-add/remove/update-externals ()
   "Remove non-package directories and fetch external packages."
-  (let ((externals-list (archive--read-externals-list)))
+  (let ((specs (archive--read-externals-list)))
     (let ((with-core (archive--sync-emacs-repo)))
-      (archive--cleanup-packages externals-list with-core)
-      (pcase-dolist ((and definition `(,name ,kind ,_url)) externals-list)
+      (archive--cleanup-packages specs with-core)
+      (pcase-dolist ((and pkg-spec `(,name ,kind ,_url)) specs)
         (pcase kind
-          (`:subtree nil)               ;Nothing to do.
-          (`:external (archive--external-package-sync name))
-          (`:core (when with-core (archive--core-package-sync definition)))
+          (`:external (archive--external-package-sync pkg-spec))
+          (`:core (when with-core (archive--core-package-sync pkg-spec)))
           (_ (message "Unknown external package kind `%S' for %s"
                       kind name)))))))
 
+(defun batch-archive-update-worktrees (&rest _)
+  (let ((specs (archive--form-from-file-contents "externals-list"))
+        (pkgs command-line-args-left))
+    (setq command-line-args-left nil)
+    (if (equal pkgs '("-")) (setq pkgs (mapcar #'car specs)))
+    (dolist (pkg pkgs)
+      (let* ((pkg-spec (assoc pkg specs))
+             (kind (nth 1 pkg-spec)))
+        (pcase kind
+          (`:external (archive--external-package-sync pkg-spec))
+          ;; (`:core (when with-core (archive--core-package-sync definition)))
+          (_ (if pkg-spec
+                 (message "Unknown external package kind `%S' for %s"
+                          kind pkg)
+               (message "Unknown external package %s" pkg))))))))
+
 ;;; Manage .gitignore
 
 (defun archive-gitignore-externals (elf gf)
@@ -1181,14 +1213,22 @@ If WITH-CORE is non-nil, it means we manage :core 
packages as well."
   (format "refs/remotes/upstream/%s/%s" (car pkg-spec)
           (archive--branch pkg-spec)))
 
+(defun archive--ortb (pkg-spec)
+  "Return our origin remote tracking branch for PKG-SPEC."
+  ;; We can't use the shorthand "origin/externals/%s" when we pass it to
+  ;; `git-show-ref'.
+  (format "refs/remotes/origin/externals/%s" (car pkg-spec)))
+
+(defun archive--git-branch-p (branch)
+  "Return non-nil iff BRANCH is an existing branch."
+  (equal 0 (archive--call t "git" "show-ref" "--verify" "--quiet" branch)))
+
 (defun archive--fetch (pkg-spec &optional k)
   (let* ((pkg (car pkg-spec))
          (url (plist-get (cdr pkg-spec) :external))
          (branch (archive--branch pkg-spec))
-         (default-directory (archive--dirname pkg "packages"))
          (urtb (archive--urtb pkg-spec))
-         (refspec (format "refs/heads/%s:%s"
-                          branch urtb)))
+         (refspec (format "refs/heads/%s:%s" branch urtb)))
     (if (not url)
         (message "Missing upstream URL in externals-list for %s" pkg)
       (message "Fetching updates for %s..." pkg)
@@ -1197,9 +1237,12 @@ If WITH-CORE is non-nil, it means we manage :core 
packages as well."
          ((not (equal 0 (archive--call t "git" "fetch" "--no-tags"
                                        url refspec)))
           (message "Fetch error for %s:\n%s" pkg (buffer-string)))
-         ((not (equal 0 (archive--call t "git" "log"
-                                       (format "origin/externals/%s...%s"
-                                               pkg urtb))))
+         ((let* ((ortb (archive--ortb pkg-spec))
+                 (exists (archive--git-branch-p ortb)))
+            (not (equal 0 (archive--call t "git" "log"
+                                         (if exists
+                                             (format "%s...%s" ortb urtb)
+                                           urtb)))))
           (message "Log error for %s:\n%s" pkg (buffer-string)))
          ((eq (point-min) (point-max))
           (message "No pending upstream changes for %s" pkg))
@@ -1208,25 +1251,28 @@ If WITH-CORE is non-nil, it means we manage :core 
packages as well."
 
 (defun archive--push (pkg-spec)
   (let* ((pkg (car pkg-spec))
-         (url (plist-get (cdr pkg-spec) :external))
-         (branch (archive--branch pkg-spec))
+         ;; (url (plist-get (cdr pkg-spec) :external))
+         ;; (branch (archive--branch pkg-spec))
+         (ortb (archive--ortb pkg-spec))
          (urtb (archive--urtb pkg-spec)))
     ;; FIXME: Arrange to merge if it's not a fast-forward.
     (with-temp-buffer
       (cond
-       ((zerop (archive--call t "git" "merge-base" "--is-ancestor"
-                              urtb (format "externals/%s" pkg)))
+       ((zerop (archive--call t "git" "merge-base" "--is-ancestor" urtb ortb))
         (message "Nothing to push for %s" pkg))
-       ((not (zerop (archive--call t "git" "merge-base" "--is-ancestor"
-                                   (format "externals/%s" pkg) urtb)))
+       ((and
+         (not (zerop (archive--call t "git" "merge-base" "--is-ancestor"
+                                    ortb urtb)))
+         (archive--git-branch-p ortb))
         (message "Can't push %s: not a fast-forward" pkg))
-       ((not (equal 0 (archive--call t "git" "push" "origin"
-                                     (format "%s:externals/%s" urtb pkg))))
+       ((not (equal 0 (archive--call t "git" "push" "--set-upstream"
+                                     "origin"
+                                     (format "%s:refs/heads/externals/%s"
+                                             urtb pkg))))
         (message "Fetch error for %s:\n%s" pkg (buffer-string)))
        (t
         (message "Pushed %s successfully:\n%s" pkg (buffer-string))
-        (let ((default-directory (expand-file-name "../../")))
-          (archive--external-package-sync pkg)))))))
+        (archive--external-package-sync pkg-spec))))))
 
 (defun archive--batch-fetch-and (k)
   (let ((specs (archive--form-from-file-contents "externals-list"))
@@ -1236,8 +1282,8 @@ If WITH-CORE is non-nil, it means we manage :core 
packages as well."
     (dolist (pkg pkgs)
       (let* ((pkg-spec (assoc pkg specs)))
         (if (not pkg-spec) (message "Unknown package: %s" pkg)
-          (unless (file-directory-p (expand-file-name pkg "packages"))
-            (archive--external-package-sync pkg))
+          ;; (unless (file-directory-p (expand-file-name pkg "packages"))
+          ;;   (archive--external-package-sync pkg-spec))
           (archive--fetch pkg-spec k))))))
 
 (defun batch-fetch-and-show (&rest _)
diff --git a/externals-list b/externals-list
index 54a8752..4fe63cb 100644
--- a/externals-list
+++ b/externals-list
@@ -36,7 +36,13 @@
   ;; The version 4.7.1 from Melpa-stable seems to correspond to
   ;; revision a9134009.
   :version-map ((nil "4.7.1" "a9134009bd037a39cbda21806867d0534d340bca")))
+ ("markdown-mode"      :external "https://github.com/jrblevin/markdown-mode";
+  ;; Not needed any more:
+  ;; :dont-release "-dev\\'"
+  )
  ("sly"                        :external "https://github.com/joaotavora/sly";
-  :version-map (("1.0.0-beta-3" "1.0.0beta3")))
+  ;; Not needed any more:
+  ;; :version-map (("1.0.0-beta-3" "1.0.0beta3"))
+  )
  ("tuareg"             :external "https://github.com/ocaml/tuareg.git";)
  )



reply via email to

[Prev in Thread] Current Thread [Next in Thread]