feature/native-comp 15d4fee 3/3: Merge remote-tracking branch 'savannah/master' into HEAD

[Andrea Corallo]

branch: feature/native-comp
commit 15d4fee69fa637191ed985af2397e732001dab6f
Merge: 3efb280 f56830a
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>

    Merge remote-tracking branch 'savannah/master' into HEAD
---
 etc/NEWS                     |  3 ++
 lisp/files.el                |  2 ++
 lisp/progmodes/project.el    |  9 +++---
 lisp/replace.el              | 72 +++++++++++++++++++++++++++++++++++++++++++-
 lisp/textmodes/mhtml-mode.el | 50 ------------------------------
 nt/inc/ms-w32.h              | 11 -------
 src/sysdep.c                 |  3 ++
 src/xdisp.c                  |  4 +++
 test/lisp/replace-tests.el   | 42 ++++++++++++++++++++++++++
 9 files changed, 130 insertions(+), 66 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 64cf0ab..3086ffa 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -109,6 +109,9 @@ setting the variable 'auto-save-visited-mode' 
buffer-locally to nil.
 
 * Changes in Specialized Modes and Packages in Emacs 28.1
 
+** New bindings in occur-mode, 'next-error-no-select' bound to 'n' and
+'previous-error-no-select' bound to 'p'.
+
 ** EIEIO: 'oset' and 'oset-default' are declared obsolete.
 
 ** New minor mode 'cl-font-lock-built-in-mode' for `lisp-mode'.
diff --git a/lisp/files.el b/lisp/files.el
index cefae20..742fd78 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1921,6 +1921,8 @@ killed."
        (setq buffer-file-truename otrue)
        (setq dired-directory odir)
        (lock-buffer)
+        (if (get-buffer oname)
+            (kill-buffer oname))
        (rename-buffer oname)))
     (unless (eq (current-buffer) obuf)
       (with-current-buffer obuf
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 1f2a4e8..2d0b6c4 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -115,10 +115,11 @@ the user for a different project to look in."
         maybe-prompt)
       (setq dir (project-prompt-project-dir)
             pr (project--find-in-directory dir))))
-    (if pr
-        (project--add-to-project-list-front pr)
-      (project--remove-from-project-list dir)
-      (setq pr (cons 'transient dir)))
+    (when maybe-prompt
+      (if pr
+          (project--add-to-project-list-front pr)
+        (project--remove-from-project-list dir)
+        (setq pr (cons 'transient dir))))
     pr))
 
 (defun project--find-in-directory (dir)
diff --git a/lisp/replace.el b/lisp/replace.el
index f3a71f8..69092c1 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -757,6 +757,13 @@ which will run faster and will not set the mark or print 
anything."
 Maximum length of the history list is determined by the value
 of `history-length', which see.")
 
+(defvar occur-highlight-regexp t
+  "Regexp matching part of visited source lines to highlight temporarily.
+Highlight entire line if t; don't highlight source lines if nil.")
+
+(defvar occur-highlight-overlay nil
+  "Overlay used to temporarily highlight occur matches.")
+
 (defvar occur-collect-regexp-history '("\\1")
   "History of regexp for occur's collect operation")
 
@@ -1113,6 +1120,8 @@ a previously found match."
     (define-key map "\C-m" 'occur-mode-goto-occurrence)
     (define-key map "o" 'occur-mode-goto-occurrence-other-window)
     (define-key map "\C-o" 'occur-mode-display-occurrence)
+    (define-key map "n" 'next-error-no-select)
+    (define-key map "p" 'previous-error-no-select)
     (define-key map "\M-n" 'occur-next)
     (define-key map "\M-p" 'occur-prev)
     (define-key map "r" 'occur-rename-buffer)
@@ -1261,9 +1270,12 @@ If not invoked by a mouse click, go to occurrence on the 
current line."
            (with-current-buffer (window-buffer (posn-window (event-end event)))
              (save-excursion
                (goto-char (posn-point (event-end event)))
-               (occur-mode-find-occurrence))))))
+               (occur-mode-find-occurrence)))))
+        (regexp occur-highlight-regexp))
     (pop-to-buffer (marker-buffer pos))
     (goto-char pos)
+    (let ((end-mk (save-excursion (re-search-forward regexp nil t))))
+      (occur--highlight-occurrence pos end-mk))
     (when buffer (next-error-found buffer (current-buffer)))
     (run-hooks 'occur-mode-find-occurrence-hook)))
 
@@ -1277,17 +1289,74 @@ If not invoked by a mouse click, go to occurrence on 
the current line."
     (next-error-found buffer (current-buffer))
     (run-hooks 'occur-mode-find-occurrence-hook)))
 
+;; Stolen from compile.el
+(defun occur-goto-locus-delete-o ()
+  (delete-overlay occur-highlight-overlay)
+  ;; Get rid of timer and hook that would try to do this again.
+  (if (timerp next-error-highlight-timer)
+      (cancel-timer next-error-highlight-timer))
+  (remove-hook 'pre-command-hook
+               #'occur-goto-locus-delete-o))
+
+;; Highlight the current visited occurrence.
+;; Adapted from `compilation-goto-locus'.
+(defun occur--highlight-occurrence (mk end-mk)
+  (let ((highlight-regexp occur-highlight-regexp))
+    (if (timerp next-error-highlight-timer)
+        (cancel-timer next-error-highlight-timer))
+    (unless occur-highlight-overlay
+      (setq occur-highlight-overlay
+           (make-overlay (point-min) (point-min)))
+      (overlay-put occur-highlight-overlay 'face 'next-error))
+    (with-current-buffer (marker-buffer mk)
+      (save-excursion
+        (if end-mk (goto-char end-mk) (end-of-line))
+        (let ((end (point)))
+         (if mk (goto-char mk) (beginning-of-line))
+         (if (and (stringp highlight-regexp)
+                  (re-search-forward highlight-regexp end t))
+             (progn
+               (goto-char (match-beginning 0))
+               (move-overlay occur-highlight-overlay
+                             (match-beginning 0) (match-end 0)
+                             (current-buffer)))
+           (move-overlay occur-highlight-overlay
+                         (point) end (current-buffer)))
+         (if (or (eq next-error-highlight t)
+                 (numberp next-error-highlight))
+             ;; We want highlighting: delete overlay on next input.
+             (add-hook 'pre-command-hook
+                       #'occur-goto-locus-delete-o)
+           ;; We don't want highlighting: delete overlay now.
+           (delete-overlay occur-highlight-overlay))
+         ;; We want highlighting for a limited time:
+         ;; set up a timer to delete it.
+         (when (numberp next-error-highlight)
+           (setq next-error-highlight-timer
+                 (run-at-time next-error-highlight nil
+                              'occur-goto-locus-delete-o))))))
+    (when (eq next-error-highlight 'fringe-arrow)
+      ;; We want a fringe arrow (instead of highlighting).
+      (setq next-error-overlay-arrow-position
+           (copy-marker (line-beginning-position))))))
+
 (defun occur-mode-display-occurrence ()
   "Display in another window the occurrence the current line describes."
   (interactive)
   (let ((buffer (current-buffer))
         (pos (occur-mode-find-occurrence))
+        (regexp occur-highlight-regexp)
+        (next-error-highlight next-error-highlight-no-select)
+        (display-buffer-overriding-action
+         '(nil (inhibit-same-window . t)))
        window)
     (setq window (display-buffer (marker-buffer pos) t))
     ;; This is the way to set point in the proper window.
     (save-selected-window
       (select-window window)
       (goto-char pos)
+      (let ((end-mk (save-excursion (re-search-forward regexp nil t))))
+        (occur--highlight-occurrence pos end-mk))
       (next-error-found buffer (current-buffer))
       (run-hooks 'occur-mode-find-occurrence-hook))))
 
@@ -1612,6 +1681,7 @@ See also `multi-occur'."
            (buffer-undo-list t)
            (occur--final-pos nil))
        (erase-buffer)
+        (set (make-local-variable 'occur-highlight-regexp) regexp)
        (let ((count
               (if (stringp nlines)
                    ;; Treat nlines as a regexp to collect.
diff --git a/lisp/textmodes/mhtml-mode.el b/lisp/textmodes/mhtml-mode.el
index b9161d9..1ae07c0 100644
--- a/lisp/textmodes/mhtml-mode.el
+++ b/lisp/textmodes/mhtml-mode.el
@@ -157,54 +157,6 @@ code();
         (mhtml--submode-name submode)
       "")))
 
-(defvar font-lock-beg)
-(defvar font-lock-end)
-
-(defun mhtml--extend-font-lock-region ()
-  "Extend the font lock region according to HTML sub-mode needs.
-
-This is used via `font-lock-extend-region-functions'.  It ensures
-that the font-lock region is extended to cover either whole
-lines, or to the spot where the submode changes, whichever is
-smallest."
-  (let ((orig-beg font-lock-beg)
-        (orig-end font-lock-end))
-    ;; The logic here may look odd but it is needed to ensure that we
-    ;; do the right thing when trying to limit the search.
-    (save-excursion
-      (goto-char font-lock-beg)
-      ;; previous-single-property-change starts by looking at the
-      ;; previous character, but we're trying to extend a region to
-      ;; include just characters with the same submode as this
-      ;; character.
-      (unless (eobp)
-        (forward-char))
-      (setq font-lock-beg (previous-single-property-change
-                           (point) 'mhtml-submode nil
-                           (line-beginning-position)))
-      (unless (eq (get-text-property font-lock-beg 'mhtml-submode)
-                  (get-text-property orig-beg 'mhtml-submode))
-        (cl-incf font-lock-beg))
-
-      (goto-char font-lock-end)
-      (unless (bobp)
-        (backward-char))
-      (setq font-lock-end (next-single-property-change
-                           (point) 'mhtml-submode nil
-                           (line-beginning-position 2)))
-      (unless (eq (get-text-property font-lock-end 'mhtml-submode)
-                  (get-text-property orig-end 'mhtml-submode))
-        (cl-decf font-lock-end)))
-
-    ;; Also handle the multiline property -- but handle it here, and
-    ;; not via font-lock-extend-region-functions, to avoid the
-    ;; situation where the two extension functions disagree.
-    ;; See bug#29159.
-    (font-lock-extend-region-multiline)
-
-    (or (/= font-lock-beg orig-beg)
-        (/= font-lock-end orig-end))))
-
 (defun mhtml--submode-fontify-one-region (submode beg end &optional loudly)
   (if submode
       (mhtml--with-locals submode
@@ -364,8 +316,6 @@ the rules from `css-mode'."
   (setq-local syntax-propertize-function #'mhtml-syntax-propertize)
   (setq-local font-lock-fontify-region-function
               #'mhtml--submode-fontify-region)
-  (setq-local font-lock-extend-region-functions
-              '(mhtml--extend-font-lock-region))
 
   ;; Attach this to both pre- and post- hooks just in case it ever
   ;; changes a key binding that might be accessed from the menu bar.
diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h
index cbe35ea..4cbae16 100644
--- a/nt/inc/ms-w32.h
+++ b/nt/inc/ms-w32.h
@@ -300,17 +300,6 @@ extern int sys_umask (int);
 #define execvp    _execvp
 #include <stdint.h>            /* for intptr_t */
 extern intptr_t _execvp (const char *, char **);
-#ifdef MINGW_W64
-/* GCC 6 has a builtin execve with the prototype shown below.  MinGW64
-   changed the prototype in its process.h to match that, although the
-   library function still calls _execve, which still returns intptr_t.
-   However, using the prototype with intptr_t causes GCC to emit
-   warnings.  Fortunately, execve is not used in the MinGW build, but
-   the code that references it is still compiled.  */
-extern int execve (const char *, char * const *, char * const *);
-#else
-extern intptr_t execve (const char *, char * const *, char * const *);
-#endif
 #define tcdrain _commit
 #define fdopen   _fdopen
 #define fsync    _commit
diff --git a/src/sysdep.c b/src/sysdep.c
index 86e7c20..cbd306a 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -199,6 +199,7 @@ maybe_disable_address_randomization (int argc, char **argv)
 }
 #endif
 
+#ifndef WINDOWSNT
 /* Execute the program in FILE, with argument vector ARGV and environ
    ENVP.  Return an error number if unsuccessful.  This is like execve
    except it reenables ASLR in the executed program if necessary, and
@@ -215,6 +216,8 @@ emacs_exec_file (char const *file, char *const *argv, char 
*const *envp)
   return errno;
 }
 
+#endif /* !WINDOWSNT */
+
 /* If FD is not already open, arrange for it to be open with FLAGS.  */
 static void
 force_open (int fd, int flags)
diff --git a/src/xdisp.c b/src/xdisp.c
index db0ec68..ea28395 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -1415,6 +1415,7 @@ Value is the height in pixels of the line at point.  */)
       set_buffer_internal_1 (XBUFFER (w->contents));
     }
   SET_TEXT_POS (pt, PT, PT_BYTE);
+  void *itdata = bidi_shelve_cache ();
   start_display (&it, w, pt);
   /* Start from the beginning of the screen line, to make sure we
      traverse all of its display elements, and thus capture the
@@ -1426,6 +1427,7 @@ Value is the height in pixels of the line at point.  */)
   if (old_buffer)
     set_buffer_internal_1 (old_buffer);
 
+  bidi_unshelve_cache (itdata, false);
   return result;
 }
 
@@ -24442,6 +24444,7 @@ Value is the new character position of point.  */)
       bool at_eol_p;
       bool overshoot_expected = false;
       bool target_is_eol_p = false;
+      void *itdata = bidi_shelve_cache ();
 
       /* Setup the arena.  */
       SET_TEXT_POS (pt, PT, PT_BYTE);
@@ -24670,6 +24673,7 @@ Value is the new character position of point.  */)
 
       /* Move point to that position.  */
       SET_PT_BOTH (IT_CHARPOS (it), IT_BYTEPOS (it));
+      bidi_unshelve_cache (itdata, false);
     }
 
   return make_fixnum (PT);
diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el
index f5cff92..aed14c3 100644
--- a/test/lisp/replace-tests.el
+++ b/test/lisp/replace-tests.el
@@ -546,4 +546,46 @@ Return the last evalled form in BODY."
       ?q
       (string= expected (buffer-string))))))
 
+(defmacro replace-tests-with-highlighted-occurrence (highlight-locus &rest 
body)
+  "Helper macro to test the highlight of matches when navigating occur buffer.
+
+Eval BODY with `next-error-highlight' and `next-error-highlight-no-select'
+bound to HIGHLIGHT-LOCUS."
+  (declare (indent 1) (debug (form body)))
+  `(let ((regexp "foo")
+         (next-error-highlight ,highlight-locus)
+         (next-error-highlight-no-select ,highlight-locus)
+         (buffer (generate-new-buffer "test"))
+         (inhibit-message t))
+     (unwind-protect
+         ;; Local bind to disable the deletion of `occur-highlight-overlay'
+         (cl-letf (((symbol-function 'occur-goto-locus-delete-o) (lambda ())))
+           (with-current-buffer buffer (dotimes (_ 3) (insert regexp ?\n)))
+           (pop-to-buffer buffer)
+           (occur regexp)
+           (pop-to-buffer "*Occur*")
+           (occur-next)
+           ,@body)
+       (kill-buffer buffer)
+       (kill-buffer "*Occur*"))))
+
+(ert-deftest occur-highlight-occurrence ()
+  "Test for https://debbugs.gnu.org/39121 ."
+  (let ((alist '((nil . nil) (0.5 . t) (t . t) (fringe-arrow . nil)))
+        (check-overlays
+         (lambda (has-ov)
+           (eq has-ov (not (null (overlays-in (point-min) (point-max))))))))
+    (pcase-dolist (`(,highlight-locus . ,has-overlay) alist)
+      ;; Visiting occurrences
+      (replace-tests-with-highlighted-occurrence highlight-locus
+        (occur-mode-goto-occurrence)
+        (should (funcall check-overlays has-overlay)))
+      ;; Displaying occurrences
+      (replace-tests-with-highlighted-occurrence highlight-locus
+        (occur-mode-display-occurrence)
+        (with-current-buffer (marker-buffer
+                              (get-text-property (point) 'occur-target))
+          (should (funcall check-overlays has-overlay)))))))
+
+
 ;;; replace-tests.el ends here