From f836452beb0b1e1e11f297f448f452c01a8fa385 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 15 May 2023 22:09:04 -0700 Subject: [PATCH 1/7] Update from Gnulib by running admin/merge-gnulib --- 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 ++++++++++---------- m4/gnulib-common.m4 | 6 +++++- 9 files changed, 66 insertions(+), 62 deletions(-) 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 # include # include # include @@ -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/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 From 2b1e81df06dcca5212dd4887ea09db0544f6e11b Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 16 May 2023 17:19:20 +0200 Subject: [PATCH 2/7] Tweak tramp-test45-asynchronous-requests * test/lisp/net/tramp-tests.el (tramp-use-connection-share): Declare. (tramp--test-putty-p): New defun. (tramp-test45-asynchronous-requests): Tweak test. --- test/lisp/net/tramp-tests.el | 12 ++++++++++++ 1 file changed, 12 insertions(+) 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 From a8f2009d03138b3b3b6c75452aba7a17c68a60f7 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 16 May 2023 20:32:34 +0300 Subject: [PATCH 3/7] * lisp/windmove.el (windmove-swap-states-in-direction): Don't swap minibuffer. Guard against swapping the minibuffer when the minibuffer is in the selected window (bug#62427). The function was already protected when the minibuffer is in other-window. --- lisp/windmove.el | 2 ++ 1 file changed, 2 insertions(+) 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))))) From d3a17a58fbdb3482512264cebda2b6e8ae16b34e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Tue, 16 May 2023 19:23:33 +0100 Subject: [PATCH 4/7] Eglot: rework eglot-handle-request (bug#62116) Address comments in the bug tracker regarding widening, and prematurely reporting success to the server before knowing if the file can indeed be shown. https://debbugs.gnu.org/cgi/bugreport.cgi?bug=62116#70 https://debbugs.gnu.org/cgi/bugreport.cgi?bug=62116#79 * lisp/progmodes/eglot.el (eglot-handle-request): Rework. --- lisp/progmodes/eglot.el | 42 ++++++++++++++++++++++++----------------- 1 file changed, 25 insertions(+), 17 deletions(-) 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." From 5ac08768aa04b0a707eb421db78b7c18ec27b55a Mon Sep 17 00:00:00 2001 From: Joseph Turner Date: Sat, 13 May 2023 10:05:04 -0700 Subject: [PATCH 5/7] Support side-effects while building VC packages * doc/emacs/package.texi (Specifying Package Sources): Document new specification attributes. * lisp/emacs-lisp/package-vc.el (package-vc-allow-side-effects): Add new user option. (package-vc--make): Add handler for processing :make and :shell-command. (package-vc--unpack-1): Check 'package-vc-allow-side-effects' and invoke 'package-vc--make'. * etc/NEWS: Mention change. (Bug#63336) --- doc/emacs/package.texi | 9 ++++++++ etc/NEWS | 5 +++++ lisp/emacs-lisp/package-vc.el | 40 +++++++++++++++++++++++++++++++++++ 3 files changed, 54 insertions(+) diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index 6722185cb20..4f606b22e54 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -682,6 +682,15 @@ 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 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 package-vc-allow-side-effects is non-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/etc/NEWS b/etc/NEWS index b4846eb11b0..8c4af51b312 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -294,6 +294,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 +++ 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))) From 2ce279680bf9c1964e98e2aa48a03d6675c386fe Mon Sep 17 00:00:00 2001 From: Tony Zorman Date: Thu, 29 Dec 2022 11:05:04 +0100 Subject: [PATCH 6/7] Add :vc keyword to use-package for VC package support * lisp/use-package/use-package-core.el (use-package-keywords): Add :vc. (use-package-handler/:load-path): Insert 'load-path' into 'state'. (use-package-vc-install): Install the package with package-vc.el. (use-package-handler/:vc): Handler for the :vc keyword. (use-package-normalize--vc-arg): Normalization for more complex arguments to 'use-package-normalize/:vc', in order to make them compatible with the specification of 'package-vc-selected-packages'. (use-package-normalize/:vc): Normalizer for the :vc keyword. (use-package): Document :vc. * lisp/use-package/use-package-ensure.el (use-package-handler/:ensure): Do not ensure a package when :vc is used in the declaration. * test/lisp/use-package/use-package-tests.el (use-package-test/:vc-1): (use-package-test/:vc-2): (use-package-test/:vc-3): (use-package-test/:vc-4): (use-package-test/:vc-5): (use-package-test-normalize/:vc): Add tests for :vc. * etc/NEWS: Mention change. (Bug#60418) --- doc/misc/use-package.texi | 50 +++++++++- etc/NEWS | 6 ++ lisp/use-package/use-package-core.el | 111 ++++++++++++++++++++- lisp/use-package/use-package-ensure.el | 3 +- test/lisp/use-package/use-package-tests.el | 54 ++++++++++ 5 files changed, 219 insertions(+), 5 deletions(-) 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 8c4af51b312..ce865c9904d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -327,6 +327,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/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/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 From 6cb963b73c3768958e13e96b2534d1e99239a3ff Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 16 May 2023 21:28:56 +0200 Subject: [PATCH 7/7] ; Add missing markup to new documentation * doc/emacs/package.texi (Fetching Package Sources): Mark code as code. --- doc/emacs/package.texi | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index 4f606b22e54..1229557673d 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -685,11 +685,13 @@ 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 package-vc-allow-side-effects is non-nil. +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 package-vc-allow-side-effects is non-nil. +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