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

[Po Lu]

branch: feature/android
commit 55388c288a0b05fe51f15b065db5b61c99bab867
Merge: 02c214a5e00 b0b968d9af3
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>

    Merge remote-tracking branch 'origin/master' into feature/android
---
 lisp/emacs-lisp/gv.el     |  7 ++++++
 lisp/gnus/gnus-search.el  | 61 ++++++++++++++++++++++++++++++++++-------------
 lisp/progmodes/eglot.el   |  9 +++----
 lisp/progmodes/flymake.el | 56 ++++++++++++++++++++++++++++++++++++-------
 src/fns.c                 | 14 +++++++++++
 src/lisp.h                |  1 +
 src/treesit.c             | 19 ++++-----------
 7 files changed, 122 insertions(+), 45 deletions(-)

diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index ac001af06bd..6c3036da2f2 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -639,6 +639,13 @@ REF must have been previously obtained with `gv-ref'."
 
 ;;; Generalized variables.
 
+;; You'd think noone would write `(setf (error ...) ..)' but it
+;; appears naturally as the result of macroexpansion of things like
+;; (setf (case-exhaustive ...)).
+;; We could generalize this to `throw' and `signal', but it seems
+;; preferable to wait until there's a concrete need.
+(gv-define-expander error (lambda (_do &rest args) `(error . ,args)))
+
 ;; Some Emacs-related place types.
 (gv-define-simple-setter buffer-file-name set-visited-file-name t)
 (make-obsolete-generalized-variable
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 12d9dacf132..98a7e23428b 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -2183,7 +2183,8 @@ checked for articles; if t all groups on the server 
containing
 the article's group will be searched; if a list then all servers
 in this list will be searched.  If possible the newly found
 articles are added to the summary buffer; otherwise the full
-thread is displayed in a new ephemeral nnselect buffer."
+thread along with the original articles are displayed in a new
+ephemeral nnselect buffer."
   (let* ((group (or group gnus-newsgroup-name))
          (server (or server (gnus-group-server group)))
          (query
@@ -2207,22 +2208,48 @@ thread is displayed in a new ephemeral nnselect buffer."
                          (cons 'search-group-spec
                                (list (list server group))))))
           #'<) nil t)
-      ;; Otherwise create an ephemeral search group. If we return to
-      ;; the current summary buffer after exiting the thread we would
-      ;; end up overwriting any changes we made, so we exit the
-      ;; current summary buffer first.
-      (gnus-summary-exit)
-      (gnus-group-read-ephemeral-search-group
-       nil
-       (list (cons 'search-query-spec query)
-             (cons 'search-group-spec
-                   (if (listp gnus-refer-thread-use-search)
-                       gnus-refer-thread-use-search
-                     (list (list server))))))
-      (if (gnus-id-to-article (mail-header-id header))
-          (gnus-summary-goto-subject
-           (gnus-id-to-article (mail-header-id header)))
-        (message "Thread search failed")))))
+      ;; Otherwise create an ephemeral search group: record the
+      ;; current summary contents; exit the current group (so that
+      ;; changes are saved); then create a new ephemeral group with
+      ;; the original articles plus those of the thread.
+      (let ((selection (seq-map (lambda (x) (vector group x 100))
+                                gnus-newsgroup-articles))
+            (thread  (gnus-search-run-query
+                      (list (cons 'search-query-spec query)
+                            (cons 'search-group-spec
+                                  (if (listp gnus-refer-thread-use-search)
+                                      gnus-refer-thread-use-search
+                                    (list (list server))))))))
+        (if (< (nnselect-artlist-length thread) 2)
+            (message "No other articles in thread")
+          (setq selection
+                (seq-into
+                 (seq-union selection thread
+                            (lambda (x y)
+                              (and (equal (nnselect-artitem-group x)
+                                          (nnselect-artitem-group y))
+                                   (eql (nnselect-artitem-number x)
+                                        (nnselect-artitem-number y)))))
+                 'vector))
+          (gnus-summary-exit)
+          (gnus-group-read-ephemeral-group
+           (concat "nnselect-" (message-unique-id))
+           (list 'nnselect "nnselect")
+           nil
+           (cons (current-buffer) gnus-current-window-configuration)
+           nil nil
+           (list
+            (cons 'nnselect-specs
+                  (list
+                   (cons 'nnselect-function 'identity)
+                   (cons 'nnselect-args
+                         selection)))
+            (cons 'nnselect-artlist nil))
+           (nnselect-artlist-length selection))
+          (if (gnus-id-to-article (mail-header-id header))
+              (gnus-summary-goto-subject
+               (gnus-id-to-article (mail-header-id header)))
+            (message "Thread search failed")))))))
 
 (defun gnus-search-get-active (srv)
   (let ((method (gnus-server-to-method srv))
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index 24f2fda5ae5..7ad33fa3786 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -3295,10 +3295,11 @@ Returns a list as described in docstring of 
`imenu--index-alist'."
                               `(:textDocument
                                 ,(eglot--TextDocumentIdentifier))
                               :cancel-on-input non-essential))
-         (head (and res (elt res 0))))
-    (eglot--dcase head
-      (((SymbolInformation)) (eglot--imenu-SymbolInformation res))
-      (((DocumentSymbol)) (eglot--imenu-DocumentSymbol res)))))
+         (head (and (cl-plusp (length res)) (elt res 0))))
+    (when head
+      (eglot--dcase head
+        (((SymbolInformation)) (eglot--imenu-SymbolInformation res))
+        (((DocumentSymbol)) (eglot--imenu-DocumentSymbol res))))))
 
 (cl-defun eglot--apply-text-edits (edits &optional version)
   "Apply EDITS for current buffer if at VERSION, or if it's nil."
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index ac408145696..b744a717c5c 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -446,6 +446,27 @@ verify FILTER, a function, and sort them by COMPARE (using 
KEY)."
   "Face used for showing summarized descriptions of notes."
   :package-version '(Flymake . "1.3.4"))
 
+(defface flymake-end-of-line-diagnostics-face
+  '((t :height 0.7 :box (:line-width 1)))
+  "Face used for end-of-line diagnostics.
+See variable `flymake-show-diagnostics-at-end-of-line'."
+  :package-version '("Flymake" . "1.3.5"))
+
+(defface flymake-error-echo-at-eol
+  '((t :inherit (flymake-end-of-line-diagnostics-face compilation-error)))
+  "Face like `flymake-error-echo', but for end-of-line overlays."
+  :package-version '("Flymake" . "1.3.5"))
+
+(defface flymake-warning-echo-at-eol
+  '((t :inherit (flymake-end-of-line-diagnostics-face compilation-warning)))
+  "Face like `flymake-warning-echo', but for end-of-line overlays."
+  :package-version '("Flymake" . "1.3.5"))
+
+(defface flymake-note-echo-at-eol
+  '((t :inherit (flymake-end-of-line-diagnostics-face flymake-note)))
+  "Face like `flymake-note-echo', but for end-of-line overlays."
+  :package-version '("Flymake" . "1.3.5"))
+
 (defcustom flymake-show-diagnostics-at-end-of-line nil
   "If non-nil, add diagnostic summary messages at end-of-line."
   :type 'boolean
@@ -606,7 +627,7 @@ Node `(Flymake)Flymake error types'"
 (put 'flymake-error 'severity (warning-numeric-level :error))
 (put 'flymake-error 'mode-line-face 'flymake-error-echo)
 (put 'flymake-error 'echo-face 'flymake-error-echo)
-(put 'flymake-error 'eol-face 'flymake-error-echo)
+(put 'flymake-error 'eol-face 'flymake-error-echo-at-eol)
 (put 'flymake-error 'flymake-type-name "error")
 
 (put 'flymake-warning 'face 'flymake-warning)
@@ -614,7 +635,7 @@ Node `(Flymake)Flymake error types'"
 (put 'flymake-warning 'severity (warning-numeric-level :warning))
 (put 'flymake-warning 'mode-line-face 'flymake-warning-echo)
 (put 'flymake-warning 'echo-face 'flymake-warning-echo)
-(put 'flymake-warning 'eol-face 'flymake-warning-echo)
+(put 'flymake-warning 'eol-face 'flymake-warning-echo-at-eol)
 (put 'flymake-warning 'flymake-type-name "warning")
 
 (put 'flymake-note 'face 'flymake-note)
@@ -622,7 +643,7 @@ Node `(Flymake)Flymake error types'"
 (put 'flymake-note 'severity (warning-numeric-level :debug))
 (put 'flymake-note 'mode-line-face 'flymake-note-echo)
 (put 'flymake-note 'echo-face 'flymake-note-echo)
-(put 'flymake-note 'eol-face 'flymake-note-echo)
+(put 'flymake-note 'eol-face 'flymake-note-echo-at-eol)
 (put 'flymake-note 'flymake-type-name "note")
 
 (defun flymake--lookup-type-property (type prop &optional default)
@@ -768,7 +789,7 @@ Return nil or the overlay created."
                (end (min (1+ start) (point-max)))
                (eolov (car
                        (cl-remove-if-not
-                        (lambda (o) (overlay-get o 'flymake-source-ovs))
+                        (lambda (o) (overlay-get o 'flymake-eol-source-region))
                         (overlays-at start))))
                (bs (flymake-diagnostic-oneliner diagnostic t)))
           (setq bs (propertize bs 'face eol-face))
@@ -779,15 +800,17 @@ Return nil or the overlay created."
           (cond (eolov
                  (overlay-put eolov 'before-string
                               (concat (overlay-get eolov 'before-string) " " 
bs))
-                 (overlay-put eolov 'flymake-source-ovs
-                              (cons ov (overlay-get eolov 
'flymake-source-ovs))))
+                 (let ((e (overlay-get eolov 'flymake-eol-source-region)))
+                   (setcar e (min (car e) (overlay-start ov)))
+                   (setcdr e (max (cdr e) (overlay-end ov)))))
                 (t
                  (setq eolov (make-overlay start end nil t nil))
                  (setq bs (concat "   " bs))
                  (put-text-property 0 1 'cursor t bs)
                  (overlay-put eolov 'before-string bs)
                  (overlay-put eolov 'evaporate (not (= start end)))
-                 (overlay-put eolov 'flymake-source-ovs (list ov))
+                 (overlay-put eolov 'flymake-eol-source-region
+                              (cons (overlay-start ov) (overlay-end ov)))
                  (overlay-put ov 'eol-ov eolov))))))
     ;; Now ensure some essential defaults are set
     ;;
@@ -1308,12 +1331,27 @@ Do it only if `flymake-no-changes-timeout' is non-nil."
 (make-obsolete 'flymake-mode-on 'flymake-mode "26.1")
 (make-obsolete 'flymake-mode-off 'flymake-mode "26.1")
 
-(defun flymake-after-change-function (start stop _len)
+(defun flymake-after-change-function (start stop pre-change-len)
   "Start syntax check for current buffer if it isn't already running.
 START and STOP and LEN are as in `after-change-functions'."
   (let((new-text (buffer-substring start stop)))
     (push (list start stop new-text) flymake--recent-changes)
-    (flymake--schedule-timer-maybe)))
+    (flymake--schedule-timer-maybe))
+  ;; Some special handling to prevent eol overlays from temporarily
+  ;; moving to wrong line
+  (when (and flymake-show-diagnostics-at-end-of-line
+             (zerop pre-change-len))
+    (save-excursion
+      (goto-char start)
+      (when-let* ((probe (search-forward "\n" stop t))
+                  (eolovs (cl-remove-if-not
+                           (lambda (o)
+                             (let ((reg (overlay-get o 
'flymake-eol-source-region)))
+                               (and reg (< (car reg) (1- probe)))))
+                           (overlays-at (line-end-position)))))
+        (goto-char start)
+        (let ((newend (line-end-position)))
+          (dolist (ov eolovs) (move-overlay ov newend (1+ newend))))))))
 
 (defun flymake-after-save-hook ()
   (when flymake-start-on-save-buffer
diff --git a/src/fns.c b/src/fns.c
index 46fc20f9a77..2efeeb2792f 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1966,6 +1966,20 @@ assq_no_quit (Lisp_Object key, Lisp_Object alist)
   return Qnil;
 }
 
+/* Assq but doesn't signal.  Unlike assq_no_quit, this function still
+   detect circular lists; like assq_no_quit, this function does not
+   allow quits and never signals.  If anything goes wrong, it returns
+   Qnil.  */
+Lisp_Object
+assq_no_signal (Lisp_Object key, Lisp_Object alist)
+{
+  Lisp_Object tail = alist;
+  FOR_EACH_TAIL_SAFE (tail)
+    if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
+      return XCAR (tail);
+  return Qnil;
+}
+
 DEFUN ("assoc", Fassoc, Sassoc, 2, 3, 0,
        doc: /* Return non-nil if KEY is equal to the car of an element of 
ALIST.
 The value is actually the first element of ALIST whose car equals KEY.
diff --git a/src/lisp.h b/src/lisp.h
index 67dc88358d7..fd3d949559b 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4036,6 +4036,7 @@ extern Lisp_Object concat3 (Lisp_Object, Lisp_Object, 
Lisp_Object);
 extern bool equal_no_quit (Lisp_Object, Lisp_Object);
 extern Lisp_Object nconc2 (Lisp_Object, Lisp_Object);
 extern Lisp_Object assq_no_quit (Lisp_Object, Lisp_Object);
+extern Lisp_Object assq_no_signal (Lisp_Object, Lisp_Object);
 extern Lisp_Object assoc_no_quit (Lisp_Object, Lisp_Object);
 extern void clear_string_char_byte_cache (void);
 extern ptrdiff_t string_char_to_byte (Lisp_Object, ptrdiff_t);
diff --git a/src/treesit.c b/src/treesit.c
index d2dd83b29fe..cbcc688571b 100644
--- a/src/treesit.c
+++ b/src/treesit.c
@@ -3153,17 +3153,6 @@ treesit_traverse_child_helper (TSTreeCursor *cursor,
     }
 }
 
-/* Assq but doesn't signal.  */
-static Lisp_Object
-safe_assq (Lisp_Object key, Lisp_Object alist)
-{
-  Lisp_Object tail = alist;
-  FOR_EACH_TAIL_SAFE (tail)
-    if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
-      return XCAR (tail);
-  return Qnil;
-}
-
 /* Given a symbol THING, and a language symbol LANGUAGE, find the
    corresponding predicate definition in treesit-things-settings.
    Don't check for the type of THING and LANGUAGE.
@@ -3172,11 +3161,11 @@ safe_assq (Lisp_Object key, Lisp_Object alist)
 static Lisp_Object
 treesit_traverse_get_predicate (Lisp_Object thing, Lisp_Object language)
 {
-  Lisp_Object cons = safe_assq (language, Vtreesit_thing_settings);
+  Lisp_Object cons = assq_no_quit (language, Vtreesit_thing_settings);
   if (NILP (cons))
     return Qnil;
   Lisp_Object definitions = XCDR (cons);
-  Lisp_Object entry = safe_assq (thing, definitions);
+  Lisp_Object entry = assq_no_quit (thing, definitions);
   if (NILP (entry))
     return Qnil;
   /* ENTRY looks like (THING PRED).  */
@@ -3218,7 +3207,7 @@ treesit_traverse_validate_predicate (Lisp_Object pred,
        {
          *signal_data = list2 (build_string ("Cannot find the definition "
                                              "of the predicate in "
-                                             "`treesit-things-settings'"),
+                                             "`treesit-thing-settings'"),
                                pred);
          return false;
        }
@@ -3716,7 +3705,7 @@ DEFUN ("treesit-node-match-p",
        doc: /* Check whether NODE matches PREDICATE.
 
 PREDICATE can be a regexp matching node type, a predicate function,
-and more, see `treesit-things-definition' for detail.  Return non-nil
+and more, see `treesit-thing-settings' for detail.  Return non-nil
 if NODE matches PRED, nil otherwise.  */)
   (Lisp_Object node, Lisp_Object predicate)
 {