mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-23 18:47:57 +00:00
Fix case-folding in Occur
* lisp/replace.el (occur-engine): Bind case-fold-search in each buffer we search. (Bug#29254)
This commit is contained in:
Eli Zaretskii
parent
29520b083f
commit
cbd319a351
346
lisp/replace.el
346
lisp/replace.el
@ -1643,175 +1643,185 @@ See also `multi-occur'."
|
|||||||
(inhibit-field-text-motion t)
|
(inhibit-field-text-motion t)
|
||||||
(headerpt (with-current-buffer out-buf (point))))
|
(headerpt (with-current-buffer out-buf (point))))
|
||||||
(with-current-buffer buf
|
(with-current-buffer buf
|
||||||
(or coding
|
;; The following binding is for when case-fold-search
|
||||||
;; Set CODING only if the current buffer locally
|
;; has a local binding in the original buffer, in which
|
||||||
;; binds buffer-file-coding-system.
|
;; case we cannot bind it globally and let that have
|
||||||
(not (local-variable-p 'buffer-file-coding-system))
|
;; effect in every buffer we search.
|
||||||
(setq coding buffer-file-coding-system))
|
(let ((case-fold-search case-fold))
|
||||||
(save-excursion
|
(or coding
|
||||||
(goto-char (point-min)) ;; begin searching in the buffer
|
;; Set CODING only if the current buffer locally
|
||||||
(while (not (eobp))
|
;; binds buffer-file-coding-system.
|
||||||
(setq origpt (point))
|
(not (local-variable-p 'buffer-file-coding-system))
|
||||||
(when (setq endpt (re-search-forward regexp nil t))
|
(setq coding buffer-file-coding-system))
|
||||||
(setq lines (1+ lines)) ;; increment matching lines count
|
(save-excursion
|
||||||
(setq matchbeg (match-beginning 0))
|
(goto-char (point-min)) ;; begin searching in the buffer
|
||||||
;; Get beginning of first match line and end of the last.
|
(while (not (eobp))
|
||||||
(save-excursion
|
(setq origpt (point))
|
||||||
(goto-char matchbeg)
|
(when (setq endpt (re-search-forward regexp nil t))
|
||||||
(setq begpt (line-beginning-position))
|
(setq lines (1+ lines)) ;; increment matching lines count
|
||||||
(goto-char endpt)
|
(setq matchbeg (match-beginning 0))
|
||||||
(setq endpt (line-end-position)))
|
;; Get beginning of first match line and end of the last.
|
||||||
;; Sum line numbers up to the first match line.
|
(save-excursion
|
||||||
(setq curr-line (+ curr-line (count-lines origpt begpt)))
|
(goto-char matchbeg)
|
||||||
(setq marker (make-marker))
|
(setq begpt (line-beginning-position))
|
||||||
(set-marker marker matchbeg)
|
(goto-char endpt)
|
||||||
(setq curstring (occur-engine-line begpt endpt keep-props))
|
(setq endpt (line-end-position)))
|
||||||
;; Highlight the matches
|
;; Sum line numbers up to the first match line.
|
||||||
(let ((len (length curstring))
|
(setq curr-line (+ curr-line (count-lines origpt begpt)))
|
||||||
(start 0))
|
(setq marker (make-marker))
|
||||||
;; Count empty lines that don't use next loop (Bug#22062).
|
(set-marker marker matchbeg)
|
||||||
(when (zerop len)
|
(setq curstring (occur-engine-line begpt endpt keep-props))
|
||||||
(setq matches (1+ matches)))
|
;; Highlight the matches
|
||||||
(while (and (< start len)
|
(let ((len (length curstring))
|
||||||
(string-match regexp curstring start))
|
(start 0))
|
||||||
(setq matches (1+ matches))
|
;; Count empty lines that don't use next loop (Bug#22062).
|
||||||
(add-text-properties
|
(when (zerop len)
|
||||||
(match-beginning 0) (match-end 0)
|
(setq matches (1+ matches)))
|
||||||
'(occur-match t) curstring)
|
(while (and (< start len)
|
||||||
(when match-face
|
(string-match regexp curstring start))
|
||||||
;; Add `match-face' to faces copied from the buffer.
|
(setq matches (1+ matches))
|
||||||
(add-face-text-property
|
(add-text-properties
|
||||||
(match-beginning 0) (match-end 0)
|
(match-beginning 0) (match-end 0)
|
||||||
match-face nil curstring))
|
'(occur-match t) curstring)
|
||||||
;; Avoid infloop (Bug#7593).
|
(when match-face
|
||||||
(let ((end (match-end 0)))
|
;; Add `match-face' to faces copied from the buffer.
|
||||||
(setq start (if (= start end) (1+ start) end)))))
|
(add-face-text-property
|
||||||
;; Generate the string to insert for this match
|
(match-beginning 0) (match-end 0)
|
||||||
(let* ((match-prefix
|
match-face nil curstring))
|
||||||
;; Using 7 digits aligns tabs properly.
|
;; Avoid infloop (Bug#7593).
|
||||||
(apply #'propertize (format "%7d:" curr-line)
|
(let ((end (match-end 0)))
|
||||||
(append
|
(setq start (if (= start end) (1+ start) end)))))
|
||||||
(when prefix-face
|
;; Generate the string to insert for this match
|
||||||
`(font-lock-face ,prefix-face))
|
(let* ((match-prefix
|
||||||
`(occur-prefix t mouse-face (highlight)
|
;; Using 7 digits aligns tabs properly.
|
||||||
;; Allow insertion of text at
|
(apply #'propertize (format "%7d:" curr-line)
|
||||||
;; the end of the prefix (for
|
(append
|
||||||
;; Occur Edit mode).
|
(when prefix-face
|
||||||
front-sticky t rear-nonsticky t
|
`(font-lock-face ,prefix-face))
|
||||||
occur-target ,marker follow-link t
|
`(occur-prefix t mouse-face (highlight)
|
||||||
help-echo "mouse-2: go to this occurrence"))))
|
;; Allow insertion of text
|
||||||
(match-str
|
;; at the end of the prefix
|
||||||
;; We don't put `mouse-face' on the newline,
|
;; (for Occur Edit mode).
|
||||||
;; because that loses. And don't put it
|
front-sticky t
|
||||||
;; on context lines to reduce flicker.
|
rear-nonsticky t
|
||||||
(propertize curstring 'mouse-face (list 'highlight)
|
occur-target ,marker
|
||||||
'occur-target marker
|
follow-link t
|
||||||
'follow-link t
|
help-echo "mouse-2: go to this occurrence"))))
|
||||||
'help-echo
|
(match-str
|
||||||
"mouse-2: go to this occurrence"))
|
;; We don't put `mouse-face' on the newline,
|
||||||
(out-line
|
;; because that loses. And don't put it
|
||||||
(concat
|
;; on context lines to reduce flicker.
|
||||||
match-prefix
|
(propertize curstring 'mouse-face (list 'highlight)
|
||||||
;; Add non-numeric prefix to all non-first lines
|
'occur-target marker
|
||||||
;; of multi-line matches.
|
'follow-link t
|
||||||
(replace-regexp-in-string
|
'help-echo
|
||||||
"\n"
|
"mouse-2: go to this occurrence"))
|
||||||
(if prefix-face
|
(out-line
|
||||||
(propertize "\n :" 'font-lock-face prefix-face)
|
(concat
|
||||||
"\n :")
|
match-prefix
|
||||||
match-str)
|
;; Add non-numeric prefix to all non-first lines
|
||||||
;; Add marker at eol, but no mouse props.
|
;; of multi-line matches.
|
||||||
(propertize "\n" 'occur-target marker)))
|
(replace-regexp-in-string
|
||||||
(data
|
"\n"
|
||||||
(if (= nlines 0)
|
(if prefix-face
|
||||||
;; The simple display style
|
(propertize
|
||||||
out-line
|
"\n :" 'font-lock-face prefix-face)
|
||||||
;; The complex multi-line display style.
|
"\n :")
|
||||||
(setq ret (occur-context-lines
|
match-str)
|
||||||
out-line nlines keep-props begpt endpt
|
;; Add marker at eol, but no mouse props.
|
||||||
curr-line prev-line prev-after-lines
|
(propertize "\n" 'occur-target marker)))
|
||||||
prefix-face))
|
(data
|
||||||
;; Set first elem of the returned list to `data',
|
(if (= nlines 0)
|
||||||
;; and the second elem to `prev-after-lines'.
|
;; The simple display style
|
||||||
(setq prev-after-lines (nth 1 ret))
|
out-line
|
||||||
(nth 0 ret))))
|
;; The complex multi-line display style.
|
||||||
;; Actually insert the match display data
|
(setq ret (occur-context-lines
|
||||||
(with-current-buffer out-buf
|
out-line nlines keep-props begpt
|
||||||
(when (and list-matching-lines-jump-to-current-line
|
endpt curr-line prev-line
|
||||||
(not multi-occur-p)
|
prev-after-lines prefix-face))
|
||||||
(not orig-line-shown-p)
|
;; Set first elem of the returned list to `data',
|
||||||
(>= curr-line orig-line))
|
;; and the second elem to `prev-after-lines'.
|
||||||
(insert
|
(setq prev-after-lines (nth 1 ret))
|
||||||
(concat
|
(nth 0 ret))))
|
||||||
(propertize
|
;; Actually insert the match display data
|
||||||
(format "%7d:%s" orig-line orig-line-str)
|
(with-current-buffer out-buf
|
||||||
'face list-matching-lines-current-line-face
|
(when (and list-matching-lines-jump-to-current-line
|
||||||
'mouse-face 'mode-line-highlight
|
(not multi-occur-p)
|
||||||
'help-echo "Current line") "\n"))
|
(not orig-line-shown-p)
|
||||||
(setq orig-line-shown-p t finalpt (point)))
|
(>= curr-line orig-line))
|
||||||
(insert data)))
|
(insert
|
||||||
(goto-char endpt))
|
(concat
|
||||||
(if endpt
|
(propertize
|
||||||
(progn
|
(format "%7d:%s" orig-line orig-line-str)
|
||||||
;; Sum line numbers between first and last match lines.
|
'face list-matching-lines-current-line-face
|
||||||
(setq curr-line (+ curr-line (count-lines begpt endpt)
|
'mouse-face 'mode-line-highlight
|
||||||
;; Add 1 for empty last match line since
|
'help-echo "Current line") "\n"))
|
||||||
;; count-lines returns 1 line less.
|
(setq orig-line-shown-p t finalpt (point)))
|
||||||
(if (and (bolp) (eolp)) 1 0)))
|
(insert data)))
|
||||||
;; On to the next match...
|
(goto-char endpt))
|
||||||
(forward-line 1))
|
(if endpt
|
||||||
(goto-char (point-max)))
|
(progn
|
||||||
(setq prev-line (1- curr-line)))
|
;; Sum line numbers between first and last match lines.
|
||||||
;; Insert original line if haven't done yet.
|
(setq curr-line (+ curr-line (count-lines begpt endpt)
|
||||||
(when (and list-matching-lines-jump-to-current-line
|
;; Add 1 for empty last match line
|
||||||
(not multi-occur-p)
|
;; since count-lines returns one
|
||||||
(not orig-line-shown-p))
|
;; line less.
|
||||||
(with-current-buffer out-buf
|
(if (and (bolp) (eolp)) 1 0)))
|
||||||
(insert
|
;; On to the next match...
|
||||||
(concat
|
(forward-line 1))
|
||||||
(propertize
|
(goto-char (point-max)))
|
||||||
(format "%7d:%s" orig-line orig-line-str)
|
(setq prev-line (1- curr-line)))
|
||||||
'face list-matching-lines-current-line-face
|
;; Insert original line if haven't done yet.
|
||||||
'mouse-face 'mode-line-highlight
|
(when (and list-matching-lines-jump-to-current-line
|
||||||
'help-echo "Current line") "\n"))))
|
(not multi-occur-p)
|
||||||
;; Flush remaining context after-lines.
|
(not orig-line-shown-p))
|
||||||
(when prev-after-lines
|
(with-current-buffer out-buf
|
||||||
(with-current-buffer out-buf
|
(insert
|
||||||
(insert (apply #'concat (occur-engine-add-prefix
|
(concat
|
||||||
prev-after-lines prefix-face)))))))
|
(propertize
|
||||||
(when (not (zerop lines)) ;; is the count zero?
|
(format "%7d:%s" orig-line orig-line-str)
|
||||||
(setq global-lines (+ global-lines lines)
|
'face list-matching-lines-current-line-face
|
||||||
global-matches (+ global-matches matches))
|
'mouse-face 'mode-line-highlight
|
||||||
(with-current-buffer out-buf
|
'help-echo "Current line") "\n"))))
|
||||||
(goto-char headerpt)
|
;; Flush remaining context after-lines.
|
||||||
(let ((beg (point))
|
(when prev-after-lines
|
||||||
end)
|
(with-current-buffer out-buf
|
||||||
(insert (propertize
|
(insert (apply #'concat (occur-engine-add-prefix
|
||||||
(format "%d match%s%s%s in buffer: %s%s\n"
|
prev-after-lines prefix-face)))))))
|
||||||
matches (if (= matches 1) "" "es")
|
(when (not (zerop lines)) ;; is the count zero?
|
||||||
;; Don't display the same number of lines
|
(setq global-lines (+ global-lines lines)
|
||||||
;; and matches in case of 1 match per line.
|
global-matches (+ global-matches matches))
|
||||||
(if (= lines matches)
|
(with-current-buffer out-buf
|
||||||
"" (format " in %d line%s"
|
(goto-char headerpt)
|
||||||
lines (if (= lines 1) "" "s")))
|
(let ((beg (point))
|
||||||
;; Don't display regexp for multi-buffer.
|
end)
|
||||||
(if (> (length buffers) 1)
|
(insert (propertize
|
||||||
"" (occur-regexp-descr regexp))
|
(format "%d match%s%s%s in buffer: %s%s\n"
|
||||||
(buffer-name buf)
|
matches (if (= matches 1) "" "es")
|
||||||
(if in-region-p
|
;; Don't display the same number of lines
|
||||||
(format " within region: %d-%d"
|
;; and matches in case of 1 match per line.
|
||||||
occur--region-start
|
(if (= lines matches)
|
||||||
occur--region-end)
|
"" (format " in %d line%s"
|
||||||
""))
|
lines
|
||||||
'read-only t))
|
(if (= lines 1) "" "s")))
|
||||||
(setq end (point))
|
;; Don't display regexp for multi-buffer.
|
||||||
(add-text-properties beg end `(occur-title ,buf))
|
(if (> (length buffers) 1)
|
||||||
(when title-face
|
"" (occur-regexp-descr regexp))
|
||||||
(add-face-text-property beg end title-face))
|
(buffer-name buf)
|
||||||
(goto-char (if finalpt
|
(if in-region-p
|
||||||
(setq occur--final-pos
|
(format " within region: %d-%d"
|
||||||
(cl-incf finalpt (- end beg)))
|
occur--region-start
|
||||||
(point-min)))))))))
|
occur--region-end)
|
||||||
|
""))
|
||||||
|
'read-only t))
|
||||||
|
(setq end (point))
|
||||||
|
(add-text-properties beg end `(occur-title ,buf))
|
||||||
|
(when title-face
|
||||||
|
(add-face-text-property beg end title-face))
|
||||||
|
(goto-char (if finalpt
|
||||||
|
(setq occur--final-pos
|
||||||
|
(cl-incf finalpt (- end beg)))
|
||||||
|
(point-min))))))))))
|
||||||
;; Display total match count and regexp for multi-buffer.
|
;; Display total match count and regexp for multi-buffer.
|
||||||
(when (and (not (zerop global-lines)) (> (length buffers) 1))
|
(when (and (not (zerop global-lines)) (> (length buffers) 1))
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user