commit f92925864613035c2e627862433112b12cf0d6dd (HEAD, refs/remotes/origin/master) Author: Dmitry Gutov Date: Mon Jun 1 04:44:33 2020 +0300 Change xref-find-apropos to pass PATTERN to backend verbatim * lisp/progmodes/xref.el (xref-backend-apropos): Rename this generic's second arg to PATTERN, to clarify that it should be handled entirely in the backend, with no pre-processing by the command. (xref-find-apropos): Update accordingly, but keep compatibility with backends in older Emacs versions. (xref-apropos-regexp): Extract from xref-find-apropos. * lisp/progmodes/etags.el (xref-backend-apropos): Use it here. * lisp/progmodes/elisp-mode.el (xref-backend-apropos): And here. diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index d37eb8c152..a0a0a0dc6a 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -863,9 +863,10 @@ non-nil result supercedes the xrefs produced by (declare-function project-external-roots "project") -(cl-defmethod xref-backend-apropos ((_backend (eql elisp)) regexp) +(cl-defmethod xref-backend-apropos ((_backend (eql elisp)) pattern) (apply #'nconc - (let (lst) + (let ((regexp (xref-apropos-regexp pattern)) + lst) (dolist (sym (apropos-internal regexp)) (push (elisp--xref-find-definitions sym) lst)) (nreverse lst)))) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 897f105019..edadbbdafc 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -2080,8 +2080,8 @@ file name, add `tag-partial-file-name-match-p' to the list value.") (cl-defmethod xref-backend-definitions ((_backend (eql etags)) symbol) (etags--xref-find-definitions symbol)) -(cl-defmethod xref-backend-apropos ((_backend (eql etags)) symbol) - (etags--xref-find-definitions symbol t)) +(cl-defmethod xref-backend-apropos ((_backend (eql etags)) pattern) + (etags--xref-find-definitions (xref-apropos-regexp pattern) t)) (defun etags--xref-find-definitions (pattern &optional regexp?) ;; This emulates the behavior of `find-tag-in-order' but instead of diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 2477884f1a..5b5fb4bc47 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -273,7 +273,11 @@ find a search tool; by default, this uses \"find | grep\" in the (project-external-roots pr))))) (cl-defgeneric xref-backend-apropos (backend pattern) - "Find all symbols that match regexp PATTERN.") + "Find all symbols that match PATTERN string. +The second argument has the same meaning as in `apropos'. + +If BACKEND is implemented in Lisp, it can use +`xref-apropos-regexp' to convert the pattern to regexp.") (cl-defgeneric xref-backend-identifier-at-point (_backend) "Return the relevant identifier at point. @@ -1098,14 +1102,24 @@ The argument has the same meaning as in `apropos'." "Search for pattern (word list or regexp): " nil 'xref--read-pattern-history))) (require 'apropos) - (xref--find-xrefs pattern 'apropos - (apropos-parse-pattern - (if (string-equal (regexp-quote pattern) pattern) - ;; Split into words - (or (split-string pattern "[ \t]+" t) - (user-error "No word list given")) - pattern)) - nil)) + (let* ((newpat + (if (and (version< emacs-version "28.0.50") + (memq (xref-find-backend) '(elisp etags))) + ;; Handle backends in older Emacs. + (xref-apropos-regexp pattern) + ;; Delegate pattern handling to the backend fully. + ;; The old way didn't work for "external" backends. + pattern))) + (xref--find-xrefs pattern 'apropos newpat nil))) + +(defun xref-apropos-regexp (pattern) + "Return an Emacs regexp from PATTERN similar to `apropos'." + (apropos-parse-pattern + (if (string-equal (regexp-quote pattern) pattern) + ;; Split into words + (or (split-string pattern "[ \t]+" t) + (user-error "No word list given")) + pattern))) ;;; Key bindings commit 43caa9680b0d000014b4b9004389b7b193a51629 Author: Philipp Stephani Date: Sun May 31 19:50:04 2020 +0200 Unbreak compilation with CHECK_STRUCTS defined. * src/pdumper.c (dump_float): Update hash value after commit 9f7bfb6cb06f1480a0904184cabf187e03628e55. The struct layout is still compatible. diff --git a/src/pdumper.c b/src/pdumper.c index bac6900cd1..7f6876666b 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2239,7 +2239,7 @@ dump_bignum (struct dump_context *ctx, Lisp_Object object) static dump_off dump_float (struct dump_context *ctx, const struct Lisp_Float *lfloat) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Float_50A7B216D9) +#if CHECK_STRUCTS && !defined (HASH_Lisp_Float_7E7D284C02) # error "Lisp_Float changed. See CHECK_STRUCTS comment in config.h." #endif eassert (ctx->header.cold_start); commit f56830acbfac8ddedafbabc9be379cd197c9d65b Author: Tom Tromey Date: Sun May 31 10:20:12 2020 -0600 Remove mhtml--extend-font-lock-region (Bug#41441) * lisp/textmodes/mhtml-mode.el (mhtml--extend-font-lock-region): Remove. (mhtml-mode): Don't set font-lock-extend-region-functions. diff --git a/lisp/textmodes/mhtml-mode.el b/lisp/textmodes/mhtml-mode.el index b9161d9697..1ae07c0a30 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. commit dc4db3ef09dd5851c48421757a5b5e0f439a143e Author: Eli Zaretskii Date: Sun May 31 17:34:09 2020 +0300 Protect bidi cache from inadvertent resets * src/xdisp.c (Fline_pixel_height, Fmove_point_visually): Save and restore the bidi cache, to avoid inadvertently resetting it by starting a new iteration through buffer text. This could cause trouble if these functions are called during a redisplay cycle, especially while we were processing RTL text. diff --git a/src/xdisp.c b/src/xdisp.c index db0ec68315..ea28395cf5 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); commit abe7c22da96694ced1bc80ec7eb9eb8a662a568b Author: Tino Calancha Date: Sun May 31 12:31:27 2020 +0200 occur: Add bindings for next-error-no-select Make the navigation in the occur buffer closer to the navigation in the compilation buffer. Add bindings to navigate the occur matches (Bug#39121). Honor `next-error-highlight' and `next-error-highlight-no-select' when navigating the occurrences. * lisp/replace.el (occur-highlight-regexp, occur-highlight-overlay): New variables. (occur-1): Set `occur-highlight-regexp' to the searched regexp. (occur-goto-locus-delete-o, occur--highlight-occurrence): New defuns. (occur-mode-display-occurrence, occur-mode-goto-occurrence): Use `occur--highlight-occurrence'. (occur-mode-map): Bind n to `next-error-no-select' and p to `previous-error-no-select' * etc/NEWS (Changes in Specialized Modes and Packages in Emacs 28.1): Announce this change. * test/lisp/replace-tests.el (replace-tests-with-highlighted-occurrence): Add helper macro. (occur-highlight-occurrence): Add test. diff --git a/etc/NEWS b/etc/NEWS index 64cf0abbdb..3086ffaf91 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/replace.el b/lisp/replace.el index f3a71f87fe..69092c16f9 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/test/lisp/replace-tests.el b/test/lisp/replace-tests.el index f5cff92d54..aed14c3357 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