aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/replace.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/replace.el')
-rw-r--r--lisp/replace.el124
1 files changed, 75 insertions, 49 deletions
diff --git a/lisp/replace.el b/lisp/replace.el
index 92edd2e2657..4a8b39dbca7 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1016,18 +1016,7 @@ which means to discard all text properties."
1016 (setq count (+ count (if forwardp -1 1))) 1016 (setq count (+ count (if forwardp -1 1)))
1017 (setq beg (line-beginning-position) 1017 (setq beg (line-beginning-position)
1018 end (line-end-position)) 1018 end (line-end-position))
1019 (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode) 1019 (push (occur-engine-line beg end keep-props) result)
1020 (text-property-not-all beg end 'fontified t))
1021 (if (fboundp 'jit-lock-fontify-now)
1022 (jit-lock-fontify-now beg end)))
1023 (push
1024 (if (and keep-props (not (eq occur-excluded-properties t)))
1025 (let ((str (buffer-substring beg end)))
1026 (remove-list-of-text-properties
1027 0 (length str) occur-excluded-properties str)
1028 str)
1029 (buffer-substring-no-properties beg end))
1030 result)
1031 (forward-line (if forwardp 1 -1))) 1020 (forward-line (if forwardp 1 -1)))
1032 (nreverse result)))) 1021 (nreverse result))))
1033 1022
@@ -1056,7 +1045,7 @@ invoke `occur'."
1056 1045
1057(defun occur (regexp &optional nlines) 1046(defun occur (regexp &optional nlines)
1058 "Show all lines in the current buffer containing a match for REGEXP. 1047 "Show all lines in the current buffer containing a match for REGEXP.
1059This function can not handle matches that span more than one line. 1048If a match spreads across multiple lines, all those lines are shown.
1060 1049
1061Each line is displayed with NLINES lines before and after, or -NLINES 1050Each line is displayed with NLINES lines before and after, or -NLINES
1062before if NLINES is negative. 1051before if NLINES is negative.
@@ -1166,12 +1155,15 @@ See also `multi-occur'."
1166 (not (eq occur-excluded-properties t))))) 1155 (not (eq occur-excluded-properties t)))))
1167 (let* ((bufcount (length active-bufs)) 1156 (let* ((bufcount (length active-bufs))
1168 (diff (- (length bufs) bufcount))) 1157 (diff (- (length bufs) bufcount)))
1169 (message "Searched %d buffer%s%s; %s match%s for `%s'" 1158 (message "Searched %d buffer%s%s; %s match%s%s"
1170 bufcount (if (= bufcount 1) "" "s") 1159 bufcount (if (= bufcount 1) "" "s")
1171 (if (zerop diff) "" (format " (%d killed)" diff)) 1160 (if (zerop diff) "" (format " (%d killed)" diff))
1172 (if (zerop count) "no" (format "%d" count)) 1161 (if (zerop count) "no" (format "%d" count))
1173 (if (= count 1) "" "es") 1162 (if (= count 1) "" "es")
1174 regexp)) 1163 ;; Don't display regexp if with remaining text
1164 ;; it is longer than window-width.
1165 (if (> (+ (length regexp) 42) (window-width))
1166 "" (format " for `%s'" (query-replace-descr regexp)))))
1175 (setq occur-revert-arguments (list regexp nlines bufs)) 1167 (setq occur-revert-arguments (list regexp nlines bufs))
1176 (if (= count 0) 1168 (if (= count 0)
1177 (kill-buffer occur-buf) 1169 (kill-buffer occur-buf)
@@ -1218,24 +1210,17 @@ See also `multi-occur'."
1218 (when (setq endpt (re-search-forward regexp nil t)) 1210 (when (setq endpt (re-search-forward regexp nil t))
1219 (setq matches (1+ matches)) ;; increment match count 1211 (setq matches (1+ matches)) ;; increment match count
1220 (setq matchbeg (match-beginning 0)) 1212 (setq matchbeg (match-beginning 0))
1221 (setq lines (+ lines (1- (count-lines origpt endpt)))) 1213 ;; Get beginning of first match line and end of the last.
1222 (save-excursion 1214 (save-excursion
1223 (goto-char matchbeg) 1215 (goto-char matchbeg)
1224 (setq begpt (line-beginning-position) 1216 (setq begpt (line-beginning-position))
1225 endpt (line-end-position))) 1217 (goto-char endpt)
1218 (setq endpt (line-end-position)))
1219 ;; Sum line numbers up to the first match line.
1220 (setq lines (+ lines (count-lines origpt begpt)))
1226 (setq marker (make-marker)) 1221 (setq marker (make-marker))
1227 (set-marker marker matchbeg) 1222 (set-marker marker matchbeg)
1228 (if (and keep-props 1223 (setq curstring (occur-engine-line begpt endpt keep-props))
1229 (if (boundp 'jit-lock-mode) jit-lock-mode)
1230 (text-property-not-all begpt endpt 'fontified t))
1231 (if (fboundp 'jit-lock-fontify-now)
1232 (jit-lock-fontify-now begpt endpt)))
1233 (if (and keep-props (not (eq occur-excluded-properties t)))
1234 (progn
1235 (setq curstring (buffer-substring begpt endpt))
1236 (remove-list-of-text-properties
1237 0 (length curstring) occur-excluded-properties curstring))
1238 (setq curstring (buffer-substring-no-properties begpt endpt)))
1239 ;; Highlight the matches 1224 ;; Highlight the matches
1240 (let ((len (length curstring)) 1225 (let ((len (length curstring))
1241 (start 0)) 1226 (start 0))
@@ -1252,24 +1237,33 @@ See also `multi-occur'."
1252 curstring) 1237 curstring)
1253 (setq start (match-end 0)))) 1238 (setq start (match-end 0))))
1254 ;; Generate the string to insert for this match 1239 ;; Generate the string to insert for this match
1255 (let* ((out-line 1240 (let* ((match-prefix
1241 ;; Using 7 digits aligns tabs properly.
1242 (apply #'propertize (format "%7d:" lines)
1243 (append
1244 (when prefix-face
1245 `(font-lock-face prefix-face))
1246 `(occur-prefix t mouse-face (highlight)
1247 occur-target ,marker follow-link t
1248 help-echo "mouse-2: go to this occurrence"))))
1249 (match-str
1250 ;; We don't put `mouse-face' on the newline,
1251 ;; because that loses. And don't put it
1252 ;; on context lines to reduce flicker.
1253 (propertize curstring 'mouse-face (list 'highlight)
1254 'occur-target marker
1255 'follow-link t
1256 'help-echo
1257 "mouse-2: go to this occurrence"))
1258 (out-line
1256 (concat 1259 (concat
1257 ;; Using 7 digits aligns tabs properly. 1260 match-prefix
1258 (apply #'propertize (format "%7d:" lines) 1261 ;; Add non-numeric prefix to all non-first lines
1259 (append 1262 ;; of multi-line matches.
1260 (when prefix-face 1263 (replace-regexp-in-string
1261 `(font-lock-face prefix-face)) 1264 "\n"
1262 `(occur-prefix t mouse-face (highlight) 1265 "\n :"
1263 occur-target ,marker follow-link t 1266 match-str)
1264 help-echo "mouse-2: go to this occurrence")))
1265 ;; We don't put `mouse-face' on the newline,
1266 ;; because that loses. And don't put it
1267 ;; on context lines to reduce flicker.
1268 (propertize curstring 'mouse-face (list 'highlight)
1269 'occur-target marker
1270 'follow-link t
1271 'help-echo
1272 "mouse-2: go to this occurrence")
1273 ;; Add marker at eol, but no mouse props. 1267 ;; Add marker at eol, but no mouse props.
1274 (propertize "\n" 'occur-target marker))) 1268 (propertize "\n" 'occur-target marker)))
1275 (data 1269 (data
@@ -1288,7 +1282,11 @@ See also `multi-occur'."
1288 (goto-char endpt)) 1282 (goto-char endpt))
1289 (if endpt 1283 (if endpt
1290 (progn 1284 (progn
1291 (setq lines (1+ lines)) 1285 ;; Sum line numbers between first and last match lines.
1286 (setq lines (+ lines (count-lines begpt endpt)
1287 ;; Add 1 for empty last match line since
1288 ;; count-lines returns 1 line less.
1289 (if (and (bolp) (eolp)) 1 0)))
1292 ;; On to the next match... 1290 ;; On to the next match...
1293 (forward-line 1)) 1291 (forward-line 1))
1294 (goto-char (point-max)))))) 1292 (goto-char (point-max))))))
@@ -1298,9 +1296,13 @@ See also `multi-occur'."
1298 (goto-char headerpt) 1296 (goto-char headerpt)
1299 (let ((beg (point)) 1297 (let ((beg (point))
1300 end) 1298 end)
1301 (insert (format "%d match%s for \"%s\" in buffer: %s\n" 1299 (insert (format "%d match%s%s in buffer: %s\n"
1302 matches (if (= matches 1) "" "es") 1300 matches (if (= matches 1) "" "es")
1303 regexp (buffer-name buf))) 1301 ;; Don't display regexp for multi-buffer.
1302 (if (> (length buffers) 1)
1303 "" (format " for \"%s\""
1304 (query-replace-descr regexp)))
1305 (buffer-name buf)))
1304 (setq end (point)) 1306 (setq end (point))
1305 (add-text-properties beg end 1307 (add-text-properties beg end
1306 (append 1308 (append
@@ -1308,6 +1310,18 @@ See also `multi-occur'."
1308 `(font-lock-face ,title-face)) 1310 `(font-lock-face ,title-face))
1309 `(occur-title ,buf)))) 1311 `(occur-title ,buf))))
1310 (goto-char (point-min))))))) 1312 (goto-char (point-min)))))))
1313 ;; Display total match count and regexp for multi-buffer.
1314 (when (and (not (zerop globalcount)) (> (length buffers) 1))
1315 (goto-char (point-min))
1316 (let ((beg (point))
1317 end)
1318 (insert (format "%d match%s total for \"%s\":\n"
1319 globalcount (if (= globalcount 1) "" "es")
1320 (query-replace-descr regexp)))
1321 (setq end (point))
1322 (add-text-properties beg end (when title-face
1323 `(font-lock-face ,title-face))))
1324 (goto-char (point-min)))
1311 (if coding 1325 (if coding
1312 ;; CODING is buffer-file-coding-system of the first buffer 1326 ;; CODING is buffer-file-coding-system of the first buffer
1313 ;; that locally binds it. Let's use it also for the output 1327 ;; that locally binds it. Let's use it also for the output
@@ -1316,6 +1330,18 @@ See also `multi-occur'."
1316 ;; Return the number of matches 1330 ;; Return the number of matches
1317 globalcount))) 1331 globalcount)))
1318 1332
1333(defun occur-engine-line (beg end &optional keep-props)
1334 (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode)
1335 (text-property-not-all beg end 'fontified t))
1336 (if (fboundp 'jit-lock-fontify-now)
1337 (jit-lock-fontify-now beg end)))
1338 (if (and keep-props (not (eq occur-excluded-properties t)))
1339 (let ((str (buffer-substring beg end)))
1340 (remove-list-of-text-properties
1341 0 (length str) occur-excluded-properties str)
1342 str)
1343 (buffer-substring-no-properties beg end)))
1344
1319;; Generate context display for occur. 1345;; Generate context display for occur.
1320;; OUT-LINE is the line where the match is. 1346;; OUT-LINE is the line where the match is.
1321;; NLINES and KEEP-PROPS are args to occur-engine. 1347;; NLINES and KEEP-PROPS are args to occur-engine.