Merge remote-tracking branch 'origin/master' into feature/android

5 files changed, 178 insertions, 20 deletions

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)))))