emacs-diffs
[Top][All Lists]
Advanced

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

feature/android bb95cdaa069 1/2: Merge remote-tracking branch 'origin/ma


From: Po Lu
Subject: feature/android bb95cdaa069 1/2: Merge remote-tracking branch 'origin/master' into feature/android
Date: Tue, 16 May 2023 21:33:15 -0400 (EDT)

branch: feature/android
commit bb95cdaa0693ecea2953d14f2808a23b66ac9446
Merge: bb8bf9203ed 6cb963b73c3
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>

    Merge remote-tracking branch 'origin/master' into feature/android
---
 doc/emacs/package.texi                     |  11 +++
 doc/misc/use-package.texi                  |  50 ++++++++++++-
 etc/NEWS                                   |  11 +++
 lib/file-has-acl.c                         |  37 +++++++---
 lib/gettime.c                              |   4 +-
 lib/gettimeofday.c                         |  14 ++--
 lib/nanosleep.c                            |   3 +-
 lib/pselect.c                              |   6 +-
 lib/stat-time.h                            |  33 +++------
 lib/timespec.h                             |   5 +-
 lib/utimens.c                              |  20 +++---
 lisp/emacs-lisp/package-vc.el              |  40 +++++++++++
 lisp/progmodes/eglot.el                    |  42 ++++++-----
 lisp/use-package/use-package-core.el       | 111 ++++++++++++++++++++++++++++-
 lisp/use-package/use-package-ensure.el     |   3 +-
 lisp/windmove.el                           |   2 +
 m4/gnulib-common.m4                        |   6 +-
 test/lisp/net/tramp-tests.el               |  12 ++++
 test/lisp/use-package/use-package-tests.el |  54 ++++++++++++++
 19 files changed, 380 insertions(+), 84 deletions(-)

diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi
index 6722185cb20..1229557673d 100644
--- a/doc/emacs/package.texi
+++ b/doc/emacs/package.texi
@@ -682,6 +682,17 @@ A string providing the repository-relative name of the 
documentation
 file from which to build an Info file.  This can be a Texinfo file or
 an Org file.
 
+@item :make
+A string or list of strings providing the target or targets defined in
+the repository Makefile which should run before building the Info
+file.  Only takes effect when @code{package-vc-allow-side-effects} is
+non-nil.
+
+@item :shell-command
+A string providing the shell command to run before building the Info
+file.  Only takes effect when @code{package-vc-allow-side-effects} is
+non-@code{nil}.
+
 @item :vc-backend
 A symbol naming the VC backend to use for downloading a copy of the
 package's repository (@pxref{Version Control Systems,,,emacs, The GNU
diff --git a/doc/misc/use-package.texi b/doc/misc/use-package.texi
index 87105c4db00..d75cb67e089 100644
--- a/doc/misc/use-package.texi
+++ b/doc/misc/use-package.texi
@@ -1554,8 +1554,11 @@ The standard Emacs package manager is documented in the 
Emacs manual
 (@pxref{Package Installation,,, emacs, GNU Emacs Manual}).  The
 @code{use-package} macro provides the @code{:ensure} and @code{:pin}
 keywords that interface with that package manager to automatically
-install packages.  This is particularly useful if you use your init
-file on more than one system.
+install packages.  The @code{:vc} keyword may be used to control how
+package sources are downloaded; e.g., from remote hosts
+(@pxref{Fetching Package Sources,,, emacs, GNU Emacs Manual}).  This
+is particularly useful if you use your init file on more than one
+system.
 
 @menu
 * Install package::
@@ -1607,6 +1610,49 @@ packages:
 You can override the above setting for a single package by adding
 @w{@code{:ensure nil}} to its declaration.
 
+@findex :vc
+The @code{:vc} keyword can be used to control how packages are
+downloaded and/or installed. More specifically, it allows one to fetch
+and update packages directly from a version control system. This is
+especially convenient when wanting to install a package that is not on
+any package archive.
+
+The keyword accepts the same arguments as specified in
+@pxref{Fetching Package Sources,,, emacs, GNU Emacs Manual}, except
+that a name need not explicitly be given: it is inferred from the
+declaration.  The accepted property list is augmented by a @code{:rev}
+keyword, which has the same shape as the @code{REV} argument to
+@code{package-vc-install}.  Notably -- even when not specified --
+@code{:rev} defaults to checking out the last release of the package.
+You can use @code{:rev :newest} to check out the latest commit.
+
+For example,
+
+@example
+@group
+(use-package bbdb
+  :vc (:url "https://git.savannah.nongnu.org/git/bbdb.git";
+       :rev :newest))
+@end group
+@end example
+
+would try -- by invoking @code{package-vc-install} -- to install the
+latest commit of the package @code{foo} from the specified remote.
+
+This can also be used for local packages, by combining it with the
+@code{:load-path} (@pxref{Load path}) keyword:
+
+@example
+@group
+;; Use a local copy of BBDB instead of the one from GNU ELPA.
+(use-package bbdb
+  :vc t
+  :load-path "/path/to/bbdb/dir/")
+@end group
+@end example
+
+The above dispatches to @code{package-vc-install-from-checkout}.
+
 @node Pinning packages
 @section Pinning packages using @code{:pin}
 @cindex installing package from specific archive
diff --git a/etc/NEWS b/etc/NEWS
index a342614a9ef..d16eee547de 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -312,6 +312,11 @@ When non-nil, it will automatically register every package 
as a
 project, that you can quickly select using 'project-switch-project'
 ('C-x p p').
 
+---
+*** New user option 'package-vc-allow-side-effects'.
+When non-nil, package specifications with side-effects for building
+software will used when building a package.
+
 ** Flymake
 
 +++
@@ -340,6 +345,12 @@ instead of:
         and another_expression):
         do_something()
 
+** use-package
+
++++
+*** New ':vc' keyword.
+This keyword enables the user to install packages using 'package-vc'.
+
 
 * New Modes and Packages in Emacs 30.1
 
diff --git a/lib/file-has-acl.c b/lib/file-has-acl.c
index 38bc806dc49..4cddc80bd13 100644
--- a/lib/file-has-acl.c
+++ b/lib/file-has-acl.c
@@ -29,7 +29,10 @@
 
 #include "acl-internal.h"
 
+#include "minmax.h"
+
 #if USE_ACL && HAVE_LINUX_XATTR_H && HAVE_LISTXATTR
+# include <stdckdint.h>
 # include <string.h>
 # include <arpa/inet.h>
 # include <sys/xattr.h>
@@ -181,32 +184,44 @@ file_has_acl (char const *name, struct stat const *sb)
              && errno == ERANGE)
         {
           free (heapbuf);
-          listbufsize = listxattr (name, NULL, 0);
-          if (listbufsize < 0)
-            return -1;
-          if (SIZE_MAX < listbufsize)
+          ssize_t newsize = listxattr (name, NULL, 0);
+          if (newsize <= 0)
+            return newsize;
+
+          /* Grow LISTBUFSIZE to at least NEWSIZE.  Grow it by a
+             nontrivial amount too, to defend against denial of
+             service by an adversary that fiddles with ACLs.  */
+          bool overflow = ckd_add (&listbufsize, listbufsize, listbufsize >> 
1);
+          listbufsize = MAX (listbufsize, newsize);
+          if (overflow || SIZE_MAX < listbufsize)
             {
               errno = ENOMEM;
               return -1;
             }
+
           listbuf = heapbuf = malloc (listbufsize);
           if (!listbuf)
             return -1;
         }
 
+      /* In Fedora 39, a file can have both NFSv4 and POSIX ACLs,
+         but if it has an NFSv4 ACL that's the one that matters.
+         In earlier Fedora the two types of ACLs were mutually exclusive.
+         Attempt to work correctly on both kinds of systems.  */
+      bool nfsv4_acl
+        = 0 < listsize && have_xattr (XATTR_NAME_NFSV4_ACL, listbuf, listsize);
       int ret
-        = (listsize < 0 ? -1
-           : (have_xattr (XATTR_NAME_POSIX_ACL_ACCESS, listbuf, listsize)
+        = (listsize <= 0 ? listsize
+           : (nfsv4_acl
+              || have_xattr (XATTR_NAME_POSIX_ACL_ACCESS, listbuf, listsize)
               || (S_ISDIR (sb->st_mode)
                   && have_xattr (XATTR_NAME_POSIX_ACL_DEFAULT,
                                  listbuf, listsize))));
-      bool nfsv4_acl_but_no_posix_acl
-        = ret == 0 && have_xattr (XATTR_NAME_NFSV4_ACL, listbuf, listsize);
       free (heapbuf);
 
-      /* If there is an NFSv4 ACL but no POSIX ACL, follow up with a
-         getxattr syscall to see whether the NFSv4 ACL is nontrivial.  */
-      if (nfsv4_acl_but_no_posix_acl)
+      /* If there is an NFSv4 ACL, follow up with a getxattr syscall
+         to see whether the NFSv4 ACL is nontrivial.  */
+      if (nfsv4_acl)
         {
           ret = getxattr (name, XATTR_NAME_NFSV4_ACL,
                           stackbuf.xattr, sizeof stackbuf.xattr);
diff --git a/lib/gettime.c b/lib/gettime.c
index f86cc4efbff..ec40ff903e1 100644
--- a/lib/gettime.c
+++ b/lib/gettime.c
@@ -35,8 +35,8 @@ gettime (struct timespec *ts)
 #else
   struct timeval tv;
   gettimeofday (&tv, NULL);
-  ts->tv_sec = tv.tv_sec;
-  ts->tv_nsec = tv.tv_usec * 1000;
+  *ts = (struct timespec) { .tv_sec  = tv.tv_sec,
+                            .tv_nsec = tv.tv_usec * 1000 };
 #endif
 }
 
diff --git a/lib/gettimeofday.c b/lib/gettimeofday.c
index d896ec132b9..c71629cbc57 100644
--- a/lib/gettimeofday.c
+++ b/lib/gettimeofday.c
@@ -113,8 +113,10 @@ gettimeofday (struct timeval *restrict tv, void *restrict 
tz)
   ULONGLONG since_1970 =
     since_1601 - (ULONGLONG) 134774 * (ULONGLONG) 86400 * (ULONGLONG) 10000000;
   ULONGLONG microseconds_since_1970 = since_1970 / (ULONGLONG) 10;
-  tv->tv_sec = microseconds_since_1970 / (ULONGLONG) 1000000;
-  tv->tv_usec = microseconds_since_1970 % (ULONGLONG) 1000000;
+  *tv = (struct timeval) {
+    .tv_sec  = microseconds_since_1970 / (ULONGLONG) 1000000,
+    .tv_usec = microseconds_since_1970 % (ULONGLONG) 1000000
+  };
 
   return 0;
 
@@ -127,10 +129,7 @@ gettimeofday (struct timeval *restrict tv, void *restrict 
tz)
   struct timeval otv;
   int result = gettimeofday (&otv, (struct timezone *) tz);
   if (result == 0)
-    {
-      tv->tv_sec = otv.tv_sec;
-      tv->tv_usec = otv.tv_usec;
-    }
+    *tv = otv;
 #  else
   int result = gettimeofday (tv, (struct timezone *) tz);
 #  endif
@@ -143,8 +142,7 @@ gettimeofday (struct timeval *restrict tv, void *restrict 
tz)
 #   error "Only 1-second nominal clock resolution found.  Is that intended?" \
           "If so, compile with the -DOK_TO_USE_1S_CLOCK option."
 #  endif
-  tv->tv_sec = time (NULL);
-  tv->tv_usec = 0;
+  *tv = (struct timeval) { .tv_sec = time (NULL), .tv_usec = 0 };
 
   return 0;
 
diff --git a/lib/nanosleep.c b/lib/nanosleep.c
index 3f295f49b5d..10974df461e 100644
--- a/lib/nanosleep.c
+++ b/lib/nanosleep.c
@@ -60,8 +60,7 @@ nanosleep (const struct timespec *requested_delay,
     static_assert (TYPE_MAXIMUM (time_t) / 24 / 24 / 60 / 60);
     const time_t limit = 24 * 24 * 60 * 60;
     time_t seconds = requested_delay->tv_sec;
-    struct timespec intermediate;
-    intermediate.tv_nsec = requested_delay->tv_nsec;
+    struct timespec intermediate = *requested_delay;
 
     while (limit < seconds)
       {
diff --git a/lib/pselect.c b/lib/pselect.c
index 52d38378783..1b8c19130c2 100644
--- a/lib/pselect.c
+++ b/lib/pselect.c
@@ -59,8 +59,10 @@ pselect (int nfds, fd_set *restrict rfds,
           return -1;
         }
 
-      tv.tv_sec = timeout->tv_sec;
-      tv.tv_usec = (timeout->tv_nsec + 999) / 1000;
+      tv = (struct timeval) {
+        .tv_sec = timeout->tv_sec,
+        .tv_usec = (timeout->tv_nsec + 999) / 1000
+      };
       tvp = &tv;
     }
   else
diff --git a/lib/stat-time.h b/lib/stat-time.h
index 5b2702356ee..af084102dae 100644
--- a/lib/stat-time.h
+++ b/lib/stat-time.h
@@ -122,10 +122,8 @@ get_stat_atime (struct stat const *st)
 #ifdef STAT_TIMESPEC
   return STAT_TIMESPEC (st, st_atim);
 #else
-  struct timespec t;
-  t.tv_sec = st->st_atime;
-  t.tv_nsec = get_stat_atime_ns (st);
-  return t;
+  return (struct timespec) { .tv_sec = st->st_atime,
+                             .tv_nsec = get_stat_atime_ns (st) };
 #endif
 }
 
@@ -136,10 +134,8 @@ get_stat_ctime (struct stat const *st)
 #ifdef STAT_TIMESPEC
   return STAT_TIMESPEC (st, st_ctim);
 #else
-  struct timespec t;
-  t.tv_sec = st->st_ctime;
-  t.tv_nsec = get_stat_ctime_ns (st);
-  return t;
+  return (struct timespec) { .tv_sec = st->st_ctime,
+                             .tv_nsec = get_stat_ctime_ns (st) };
 #endif
 }
 
@@ -150,10 +146,8 @@ get_stat_mtime (struct stat const *st)
 #ifdef STAT_TIMESPEC
   return STAT_TIMESPEC (st, st_mtim);
 #else
-  struct timespec t;
-  t.tv_sec = st->st_mtime;
-  t.tv_nsec = get_stat_mtime_ns (st);
-  return t;
+  return (struct timespec) { .tv_sec = st->st_mtime,
+                             .tv_nsec = get_stat_mtime_ns (st) };
 #endif
 }
 
@@ -168,8 +162,8 @@ get_stat_birthtime (_GL_UNUSED struct stat const *st)
      || defined HAVE_STRUCT_STAT_ST_BIRTHTIM_TV_NSEC)
   t = STAT_TIMESPEC (st, st_birthtim);
 #elif defined HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC
-  t.tv_sec = st->st_birthtime;
-  t.tv_nsec = st->st_birthtimensec;
+  t = (struct timespec) { .tv_sec = st->st_birthtime,
+                          .tv_nsec = st->st_birthtimensec };
 #elif defined _WIN32 && ! defined __CYGWIN__
   /* Native Windows platforms (but not Cygwin) put the "file creation
      time" in st_ctime (!).  See
@@ -177,13 +171,11 @@ get_stat_birthtime (_GL_UNUSED struct stat const *st)
 # if _GL_WINDOWS_STAT_TIMESPEC
   t = st->st_ctim;
 # else
-  t.tv_sec = st->st_ctime;
-  t.tv_nsec = 0;
+  t = (struct timespec) { .tv_sec = st->st_ctime };
 # endif
 #else
   /* Birth time is not supported.  */
-  t.tv_sec = -1;
-  t.tv_nsec = -1;
+  t = (struct timespec) { .tv_sec = -1, .tv_nsec = -1 };
 #endif
 
 #if (defined HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC \
@@ -195,10 +187,7 @@ get_stat_birthtime (_GL_UNUSED struct stat const *st)
      sometimes returns junk in the birth time fields; work around this
      bug if it is detected.  */
   if (! (t.tv_sec && 0 <= t.tv_nsec && t.tv_nsec < 1000000000))
-    {
-      t.tv_sec = -1;
-      t.tv_nsec = -1;
-    }
+    t = (struct timespec) { .tv_sec = -1, .tv_nsec = -1 };
 #endif
 
   return t;
diff --git a/lib/timespec.h b/lib/timespec.h
index 0bdfd76ef78..e94da75defe 100644
--- a/lib/timespec.h
+++ b/lib/timespec.h
@@ -55,10 +55,7 @@ enum { LOG10_TIMESPEC_RESOLUTION = LOG10_TIMESPEC_HZ };
 _GL_TIMESPEC_INLINE struct timespec
 make_timespec (time_t s, long int ns)
 {
-  struct timespec r;
-  r.tv_sec = s;
-  r.tv_nsec = ns;
-  return r;
+  return (struct timespec) { .tv_sec = s, .tv_nsec = ns };
 }
 
 /* Return negative, zero, positive if A < B, A == B, A > B, respectively.  */
diff --git a/lib/utimens.c b/lib/utimens.c
index 4c5377eca0f..faa197e6cb5 100644
--- a/lib/utimens.c
+++ b/lib/utimens.c
@@ -405,10 +405,10 @@ fdutimens (int fd, char const *file, struct timespec 
const timespec[2])
     struct timeval *t;
     if (ts)
       {
-        timeval[0].tv_sec = ts[0].tv_sec;
-        timeval[0].tv_usec = ts[0].tv_nsec / 1000;
-        timeval[1].tv_sec = ts[1].tv_sec;
-        timeval[1].tv_usec = ts[1].tv_nsec / 1000;
+        timeval[0] = (struct timeval) { .tv_sec  = ts[0].tv_sec,
+                                        .tv_usec = ts[0].tv_nsec / 1000 };
+        timeval[1] = (struct timeval) { .tv_sec  = ts[1].tv_sec,
+                                        .tv_usec = ts[1].tv_nsec / 1000 };
         t = timeval;
       }
     else
@@ -502,8 +502,8 @@ fdutimens (int fd, char const *file, struct timespec const 
timespec[2])
       struct utimbuf *ut;
       if (ts)
         {
-          utimbuf.actime = ts[0].tv_sec;
-          utimbuf.modtime = ts[1].tv_sec;
+          utimbuf = (struct utimbuf) { .actime  = ts[0].tv_sec,
+                                       .modtime = ts[1].tv_sec };
           ut = &utimbuf;
         }
       else
@@ -621,10 +621,10 @@ lutimens (char const *file, struct timespec const 
timespec[2])
     int result;
     if (ts)
       {
-        timeval[0].tv_sec = ts[0].tv_sec;
-        timeval[0].tv_usec = ts[0].tv_nsec / 1000;
-        timeval[1].tv_sec = ts[1].tv_sec;
-        timeval[1].tv_usec = ts[1].tv_nsec / 1000;
+        timeval[0] = (struct timeval) { .tv_sec = ts[0].tv_sec,
+                                        .tv_usec = ts[0].tv_nsec / 1000 };
+        timeval[1] = (struct timeval) { .tv_sec = ts[1].tv_sec,
+                                        .tv_usec = ts[1].tv_nsec / 1000 };
         t = timeval;
       }
     else
diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
index beca0bd00e2..35acd493b36 100644
--- a/lisp/emacs-lisp/package-vc.el
+++ b/lisp/emacs-lisp/package-vc.el
@@ -344,6 +344,40 @@ asynchronously."
         "\n")
        nil pkg-file nil 'silent))))
 
+(defcustom package-vc-allow-side-effects nil
+  "Whether to process :make and :shell-command spec arguments.
+
+It may be necessary to run :make and :shell-command arguments in
+order to initialize a package or build its documentation, but
+please be careful when changing this option, as installing and
+updating a package can run potentially harmful code.
+
+When set to a list of symbols (packages), run commands for only
+packages in the list.  When nil, never run commands.  Otherwise
+when non-nil, run commands for any package with :make or
+:shell-command specified.
+
+Package specs are loaded from trusted package archives."
+  :type '(choice (const :tag "Run for all packages" t)
+                 (repeat :tag "Run only for selected packages" (symbol :tag 
"Package name"))
+                 (const :tag "Never run" nil))
+  :version "30.1")
+
+(defun package-vc--make (pkg-spec pkg-desc)
+  "Process :make and :shell-command in PKG-SPEC.
+PKG-DESC is the package descriptor for the package that is being
+prepared."
+  (let ((target (plist-get pkg-spec :make))
+        (cmd (plist-get pkg-spec :shell-command))
+        (buf (format " *package-vc make %s*" (package-desc-name pkg-desc))))
+    (when (or cmd target)
+      (with-current-buffer (get-buffer-create buf)
+        (erase-buffer)
+        (when (and cmd (/= 0 (call-process shell-file-name nil t nil 
shell-command-switch cmd)))
+          (warn "Failed to run %s, see buffer %S" cmd (buffer-name)))
+        (when (and target (/= 0 (apply #'call-process "make" nil t nil (if 
(consp target) target (list target)))))
+          (warn "Failed to make %s, see buffer %S" target (buffer-name)))))))
+
 (declare-function org-export-to-file "ox" (backend file))
 
 (defun package-vc--build-documentation (pkg-desc file)
@@ -486,6 +520,12 @@ documentation and marking the package as installed."
       ;; Generate package file
       (package-vc--generate-description-file pkg-desc pkg-file)
 
+      ;; Process :make and :shell-command arguments before building 
documentation
+      (when (or (eq package-vc-allow-side-effects t)
+                (memq (package-desc-name pkg-desc)
+                      package-vc-allow-side-effects))
+        (package-vc--make pkg-spec pkg-desc))
+
       ;; Detect a manual
       (when (executable-find "install-info")
         (dolist (doc-file (ensure-list (plist-get pkg-spec :doc)))
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index 52f87c1af5d..a65795f1dfc 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -2371,23 +2371,31 @@ THINGS are either registrations or unregisterations 
(sic)."
   (_server (_method (eql window/showDocument)) &key
            uri external takeFocus selection)
   "Handle request window/showDocument."
-  (if (eq external t) (browse-url uri)
-    ;; Use run-with-timer to avoid nested client requests like the
-    ;; synchronous imenu case caused by which-func-mode.
-    (run-with-timer
-     0 nil
-     (lambda ()
-       (with-current-buffer (find-file-noselect (eglot--uri-to-path uri))
-         (cond (takeFocus
-                (pop-to-buffer (current-buffer))
-                (select-frame-set-input-focus (selected-frame)))
-               ((display-buffer (current-buffer))))
-         (when selection
-           (eglot--widening
-            (pcase-let ((`(,beg . ,end) (eglot--range-region selection)))
-              (goto-char beg)
-              (pulse-momentary-highlight-region beg end 'highlight))))))))
-  '(:success t))
+  (let ((success t)
+        (filename))
+    (cond
+     ((eq external t) (browse-url uri))
+     ((file-readable-p (setq filename (eglot--uri-to-path uri)))
+      ;; Use run-with-timer to avoid nested client requests like the
+      ;; "synchronous imenu" floated in bug#62116 presumably caused by
+      ;; which-func-mode.
+      (run-with-timer
+       0 nil
+       (lambda ()
+         (with-current-buffer (find-file-noselect filename)
+           (cond (takeFocus
+                  (pop-to-buffer (current-buffer))
+                  (select-frame-set-input-focus (selected-frame)))
+                 ((display-buffer (current-buffer))))
+           (when selection
+             (pcase-let ((`(,beg . ,end) (eglot--range-region selection)))
+               ;; FIXME: it is very naughty to use someone else's `--'
+               ;; function, but `xref--goto-char' happens to have
+               ;; exactly the semantics we want vis-a-vis widening.
+               (xref--goto-char beg)
+               (pulse-momentary-highlight-region beg end 'highlight)))))))
+     (t (setq success :json-false)))
+    `(:success ,success)))
 
 (defun eglot--TextDocumentIdentifier ()
   "Compute TextDocumentIdentifier object for current buffer."
diff --git a/lisp/use-package/use-package-core.el 
b/lisp/use-package/use-package-core.el
index 7ab5bdc276f..0d99e270a3f 100644
--- a/lisp/use-package/use-package-core.el
+++ b/lisp/use-package/use-package-core.el
@@ -76,6 +76,7 @@
     :functions
     :preface
     :if :when :unless
+    :vc
     :no-require
     :catch
     :after
@@ -1151,7 +1152,8 @@ meaning:
     #'use-package-normalize-paths))
 
 (defun use-package-handler/:load-path (name _keyword arg rest state)
-  (let ((body (use-package-process-keywords name rest state)))
+  (let ((body (use-package-process-keywords name rest
+                (plist-put state :load-path arg))))
     (use-package-concat
      (mapcar #'(lambda (path)
                  `(eval-and-compile (add-to-list 'load-path ,path)))
@@ -1577,6 +1579,109 @@ no keyword implies `:all'."
      (when use-package-compute-statistics
        `((use-package-statistics-gather :config ',name t))))))
 
+;;;; :vc
+
+(defun use-package-vc-install (arg &optional local-path)
+  "Install a package with `package-vc.el'.
+ARG is a list of the form (NAME OPTIONS REVISION), as returned by
+`use-package-normalize--vc-arg'.  If LOCAL-PATH is non-nil, call
+`package-vc-install-from-checkout'; otherwise, indicating a
+remote host, call `package-vc-install' instead."
+  (pcase-let* ((`(,name ,opts ,rev) arg)
+               (spec (if opts (cons name opts) name)))
+    (unless (package-installed-p name)
+      (if local-path
+          (package-vc-install-from-checkout local-path (symbol-name name))
+        (package-vc-install spec rev)))))
+
+(defun use-package-handler/:vc (name _keyword arg rest state)
+  "Generate code to install package NAME, or do so directly.
+When the use-package declaration is part of a byte-compiled file,
+install the package during compilation; otherwise, add it to the
+macro expansion and wait until runtime.  The remaining arguments
+are as follows:
+
+_KEYWORD is ignored.
+
+ARG is the normalized input to the `:vc' keyword, as returned by
+the `use-package-normalize/:vc' function.
+
+REST is a plist of other (following) keywords and their
+arguments, each having already been normalised by the respective
+function.
+
+STATE is a plist of any state that keywords processed before
+`:vc' (see `use-package-keywords') may have accumulated.
+
+Also see the Info node `(use-package) Creating an extension'."
+  (let ((body (use-package-process-keywords name rest state))
+        (local-path (car (plist-get state :load-path))))
+    ;; See `use-package-handler/:ensure' for an explanation.
+    (if (bound-and-true-p byte-compile-current-file)
+        (funcall #'use-package-vc-install arg local-path)        ; compile time
+      (push `(use-package-vc-install ',arg ,local-path) body)))) ; runtime
+
+(defun use-package-normalize--vc-arg (arg)
+  "Normalize possible arguments to the `:vc' keyword.
+ARG is a cons-cell of approximately the form that
+`package-vc-selected-packages' accepts, plus an additional `:rev'
+keyword.  If `:rev' is not given, it defaults to `:last-release'.
+
+Returns a list (NAME SPEC REV), where (NAME . SPEC) is compliant
+with `package-vc-selected-packages' and REV is a (possibly nil,
+indicating the latest commit) revision."
+  (cl-flet* ((ensure-string (s)
+               (if (and s (stringp s)) s (symbol-name s)))
+             (ensure-symbol (s)
+               (if (and s (stringp s)) (intern s) s))
+             (normalize (k v)
+               (pcase k
+                 (:rev (cond ((or (eq v :last-release) (not v)) :last-release)
+                             ((eq v :newest) nil)
+                             (t (ensure-string v))))
+                 (:vc-backend (ensure-symbol v))
+                 (_ (ensure-string v)))))
+    (pcase-let ((valid-kws '(:url :branch :lisp-dir :main-file :vc-backend 
:rev))
+                (`(,name . ,opts) arg))
+      (if (stringp opts)                ; (NAME . VERSION-STRING) ?
+          (list name opts)
+        ;; Error handling
+        (cl-loop for (k _) on opts by #'cddr
+                 if (not (member k valid-kws))
+                 do (use-package-error
+                     (format "Keyword :vc received unknown argument: %s. 
Supported keywords are: %s"
+                             k valid-kws)))
+        ;; Actual normalization
+        (list name
+              (cl-loop for (k v) on opts by #'cddr
+                       if (not (eq k :rev))
+                       nconc (list k (normalize k v)))
+              (normalize :rev (plist-get opts :rev)))))))
+
+(defun use-package-normalize/:vc (name _keyword args)
+  "Normalize possible arguments to the `:vc' keyword.
+NAME is the name of the `use-package' declaration, _KEYWORD is
+ignored, and ARGS it a list of arguments given to the `:vc'
+keyword, the cdr of which is ignored.
+
+See `use-package-normalize--vc-arg' for most of the actual
+normalization work.  Also see the Info
+node `(use-package) Creating an extension'."
+  (let ((arg (car args)))
+    (pcase arg
+      ((or 'nil 't) (list name))                 ; guess name
+      ((pred symbolp) (list arg))                ; use this name
+      ((pred stringp) (list name arg))           ; version string + guess name
+      ((pred plistp)                             ; plist + guess name
+       (use-package-normalize--vc-arg (cons name arg)))
+      (`(,(pred symbolp) . ,(or (pred plistp)    ; plist/version string + name
+                                (pred stringp)))
+       (use-package-normalize--vc-arg arg))
+      (_ (use-package-error "Unrecognised argument to :vc.\
+ The keyword wants an argument of nil, t, a name of a package,\
+ or a cons-cell as accepted by `package-vc-selected-packages', where \
+ the accepted plist is augmented by a `:rev' keyword.")))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;;; The main macro
@@ -1666,7 +1771,9 @@ Usage:
                  (compare with `custom-set-variables').
 :custom-face     Call `custom-set-faces' with each face definition.
 :ensure          Loads the package using package.el if necessary.
-:pin             Pin the package to an archive."
+:pin             Pin the package to an archive.
+:vc              Install the package directly from a version control system
+                 (using `package-vc.el')."
   (declare (indent defun))
   (unless (memq :disabled args)
     (macroexp-progn
diff --git a/lisp/use-package/use-package-ensure.el 
b/lisp/use-package/use-package-ensure.el
index e0ea982594e..395a0bbda00 100644
--- a/lisp/use-package/use-package-ensure.el
+++ b/lisp/use-package/use-package-ensure.el
@@ -182,7 +182,8 @@ manually updated package."
 
 ;;;###autoload
 (defun use-package-handler/:ensure (name _keyword ensure rest state)
-  (let* ((body (use-package-process-keywords name rest state)))
+  (let* ((body (use-package-process-keywords name rest state))
+         (ensure (and (not (plist-member rest :vc)) ensure)))
     ;; We want to avoid installing packages when the `use-package' macro is
     ;; being macro-expanded by elisp completion (see `lisp--local-variables'),
     ;; but still install packages when byte-compiling, to avoid requiring
diff --git a/lisp/windmove.el b/lisp/windmove.el
index 06ce16c0d42..746a440bacb 100644
--- a/lisp/windmove.el
+++ b/lisp/windmove.el
@@ -724,6 +724,8 @@ from the opposite side of the frame."
                                            nil windmove-wrap-around 'nomini)))
     (cond ((or (null other-window) (window-minibuffer-p other-window))
            (user-error "No window %s from selected window" dir))
+          ((window-minibuffer-p (selected-window))
+           (user-error "Can't swap window with the minibuffer"))
           (t
            (window-swap-states nil other-window)))))
 
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4
index edb8572da25..a2b53d33dca 100644
--- a/m4/gnulib-common.m4
+++ b/m4/gnulib-common.m4
@@ -1,4 +1,4 @@
-# gnulib-common.m4 serial 86
+# gnulib-common.m4 serial 87
 dnl Copyright (C) 2007-2023 Free Software Foundation, Inc.
 dnl This file is free software; the Free Software Foundation
 dnl gives unlimited permission to copy and/or distribute it,
@@ -1053,6 +1053,7 @@ AC_DEFUN([gl_CC_GNULIB_WARNINGS],
     dnl -Wno-float-conversion                 >= 4.9          >= 3.9
     dnl -Wno-float-equal                      >= 3            >= 3.9
     dnl -Wimplicit-fallthrough                >= 7            >= 3.9
+    dnl -Wno-missing-field-initializers       >= 4.0, < 11
     dnl -Wno-pedantic                         >= 4.8          >= 3.9
     dnl -Wno-sign-compare                     >= 3            >= 3.9
     dnl -Wno-sign-conversion                  >= 4.3          >= 3.9
@@ -1078,6 +1079,9 @@ AC_DEFUN([gl_CC_GNULIB_WARNINGS],
       #if __GNUC__ >= 7 || (__clang_major__ + (__clang_minor__ >= 9) > 3)
       -Wimplicit-fallthrough
       #endif
+      #if __GNUC__ >= 4 && __GNUC__ < 11 && !defined __clang__
+      -Wno-missing-field-initializers
+      #endif
       #if __GNUC__ + (__GNUC_MINOR__ >= 8) > 4 || (__clang_major__ + 
(__clang_minor__ >= 9) > 3)
       -Wno-pedantic
       #endif
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 840decbf5d5..6c773908e26 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -73,6 +73,7 @@
 (defvar tramp-persistency-file-name)
 (defvar tramp-remote-path)
 (defvar tramp-remote-process-environment)
+(defvar tramp-use-connection-share)
 
 ;; Needed for Emacs 27.
 (defvar lock-file-name-transforms)
@@ -6933,6 +6934,13 @@ This does not support external Emacs calls."
   "Check, whether an out-of-band method is used."
   (tramp-method-out-of-band-p tramp-test-vec 1))
 
+(defun tramp--test-putty-p ()
+  "Check, whether the method method usaes PuTTY.
+This does not support connection share for more than two connections."
+  (member
+   (file-remote-p ert-remote-temporary-file-directory 'method)
+   '("plink" "plinkx" "pscp" "psftp")))
+
 (defun tramp--test-rclone-p ()
   "Check, whether the remote host is offered by rclone.
 This requires restrictions of file name syntax."
@@ -7486,6 +7494,10 @@ process sentinels.  They shall not disturb each other."
                (string-to-number (getenv "REMOTE_PARALLEL_PROCESSES"))))
             ((getenv "EMACS_HYDRA_CI") 5)
              (t 10)))
+          ;; PuTTY-based methods can only share up to 10 connections.
+          (tramp-use-connection-share
+           (if (and (tramp--test-putty-p) (>= number-proc 10))
+               'suppress (bound-and-true-p tramp-use-connection-share)))
            ;; On hydra, timings are bad.
            (timer-repeat
             (cond
diff --git a/test/lisp/use-package/use-package-tests.el 
b/test/lisp/use-package/use-package-tests.el
index 6374a0d1037..c8c20fc51cb 100644
--- a/test/lisp/use-package/use-package-tests.el
+++ b/test/lisp/use-package/use-package-tests.el
@@ -1951,6 +1951,60 @@
     (should (eq (nth 1 binding) 'ignore))
     (should (eq (nth 2 binding) nil))))
 
+(ert-deftest use-package-test/:vc-1 ()
+  (match-expansion
+   (use-package foo :vc (:url "bar"))
+   '(progn (use-package-vc-install '(foo (:url "bar") :last-release) nil)
+           (require 'foo nil nil))))
+
+(ert-deftest use-package-test/:vc-2 ()
+  (match-expansion
+   (use-package foo
+     :vc (baz . (:url "baz" :vc-backend "Git"
+                 :main-file qux.el :rev "rev-string")))
+   '(progn (use-package-vc-install '(baz
+                                     (:url "baz" :vc-backend Git :main-file 
"qux.el")
+                                     "rev-string")
+                                   nil)
+           (require 'foo nil nil))))
+
+(ert-deftest use-package-test/:vc-3 ()
+  (match-expansion
+   (use-package foo :vc (bar . "baz"))
+   '(progn (use-package-vc-install '(bar "baz") nil)
+           (require 'foo nil nil))))
+
+(ert-deftest use-package-test/:vc-4 ()
+  (match-expansion
+   (use-package foo :vc (bar . (:url "baz" :rev :newest)))
+   '(progn (use-package-vc-install '(bar (:url "baz") nil) nil)
+           (require 'foo nil nil))))
+
+(ert-deftest use-package-test/:vc-5 ()
+  (let ((load-path? '(pred (apply-partially
+                            #'string=
+                            (expand-file-name "bar" user-emacs-directory)))))
+    (match-expansion
+     (use-package foo :vc other-name :load-path "bar")
+     `(progn (eval-and-compile
+               (add-to-list 'load-path ,load-path?))
+             (use-package-vc-install '(other-name) ,load-path?)
+             (require 'foo nil nil)))))
+
+(ert-deftest use-package-test-normalize/:vc ()
+  (should (equal '(foo "version-string")
+                 (use-package-normalize/:vc 'foo :vc '("version-string"))))
+  (should (equal '(bar "version-string")
+                 (use-package-normalize/:vc 'foo :vc '((bar . 
"version-string")))))
+  (should (equal '(foo (:url "bar") "baz")
+                 (use-package-normalize/:vc 'foo :vc '((:url "bar" :rev 
"baz")))))
+  (should (equal '(foo)
+                 (use-package-normalize/:vc 'foo :vc '(t))))
+  (should (equal '(foo)
+                 (use-package-normalize/:vc 'foo :vc nil)))
+  (should (equal '(bar)
+                 (use-package-normalize/:vc 'foo :vc '(bar)))))
+
 ;; Local Variables:
 ;; no-byte-compile: t
 ;; no-update-autoloads: t



reply via email to

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