Mercurial > hg > xemacs-beta
annotate lisp/occur.el @ 5466:3600e23880f7
Added tag last-gplv2 for changeset 1c87bdc11d65
| author | Stephen J. Turnbull <stephen@xemacs.org> |
|---|---|
| date | Wed, 27 Apr 2011 04:17:14 +0900 |
| parents | ed74d2ca7082 |
| children | ac37a5f7e5be |
| rev | line source |
|---|---|
| 3000 | 1 ;;; occur.el --- Show all lines in the current buffer containing a match for REGEXP. |
| 2 | |
| 3 ;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1996, 1997, 2000, 2001, | |
| 4 ;; 2002, 2003, 2004, 2005 Free Software Foundation, Inc. | |
| 5 | |
| 6 ;; Maintainer: XEmacs Development Team | |
| 7 ;; Keywords: internal | |
| 8 | |
| 9 ;; This file is part of XEmacs. | |
| 10 | |
| 11 ;; XEmacs is free software; you can redistribute it and/or modify | |
| 12 ;; it under the terms of the GNU General Public License as published by | |
| 13 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 14 ;; any later version. | |
| 15 | |
| 16 ;; XEmacs is distributed in the hope that it will be useful, | |
| 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 19 ;; GNU General Public License for more details. | |
| 20 | |
| 21 ;; You should have received a copy of the GNU General Public License | |
| 22 ;; along with XEmacs; see the file COPYING. If not, write to the | |
| 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
| 24 ;; Boston, MA 02110-1301, USA. | |
| 25 | |
| 26 ;;; Synched up with: FSF 22.0.50.1 (CVS) | |
| 27 | |
| 28 (require 'next-error) | |
| 29 (defun query-replace-descr (string) | |
| 30 (mapconcat 'isearch-text-char-description string "")) | |
| 31 | |
| 32 (defvar occur-mode-map () | |
| 33 "Keymap for `occur-mode'.") | |
| 34 (if occur-mode-map | |
| 35 () | |
| 36 (setq occur-mode-map (make-sparse-keymap)) | |
| 37 (set-keymap-name occur-mode-map 'occur-mode-map) ; XEmacs | |
| 38 (define-key occur-mode-map 'button2 'occur-mode-mouse-goto) ; XEmacs | |
| 39 (define-key occur-mode-map "\C-c\C-c" 'occur-mode-goto-occurrence) | |
| 40 (define-key occur-mode-map "\C-m" 'occur-mode-goto-occurrence) | |
| 41 (define-key occur-mode-map "o" 'occur-mode-goto-occurrence-other-window) | |
| 42 (define-key occur-mode-map "\C-o" 'occur-mode-display-occurrence) | |
| 43 (define-key occur-mode-map "\M-n" 'occur-next) | |
| 44 (define-key occur-mode-map "\M-p" 'occur-prev) | |
| 45 (define-key occur-mode-map "r" 'occur-rename-buffer) | |
| 46 (define-key occur-mode-map "c" 'clone-buffer) | |
| 47 (define-key occur-mode-map "g" 'revert-buffer) | |
| 48 (define-key occur-mode-map "q" 'quit-window) | |
| 49 (define-key occur-mode-map "z" 'kill-this-buffer) | |
| 50 (define-key occur-mode-map "\C-c\C-f" 'next-error-follow-minor-mode)) | |
| 51 | |
| 52 (defvar occur-revert-arguments nil | |
| 53 "Arguments to pass to `occur-1' to revert an Occur mode buffer. | |
| 54 See `occur-revert-function'.") | |
| 55 | |
| 56 (defcustom occur-mode-hook nil ; XEmacs | |
| 57 "Hook run when entering Occur mode." | |
| 58 :type 'hook | |
| 59 :group 'matching) | |
| 60 | |
| 61 (defcustom occur-hook nil | |
| 62 "Hook run by Occur when there are any matches." | |
| 63 :type 'hook | |
| 64 :group 'matching) | |
| 65 | |
| 66 (put 'occur-mode 'mode-class 'special) | |
| 67 ;;;###autoload | |
| 68 (defun occur-mode () | |
| 69 "Major mode for output from \\[occur]. | |
| 70 \\<occur-mode-map>Move point to one of the items in this buffer, then use | |
| 71 \\[occur-mode-goto-occurrence] to go to the occurrence that the item refers to. | |
| 72 Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. | |
| 73 | |
| 74 \\{occur-mode-map}" | |
| 75 (interactive) | |
| 76 (kill-all-local-variables) | |
| 77 (use-local-map occur-mode-map) | |
| 78 (setq major-mode 'occur-mode) | |
| 79 (setq mode-name (gettext "Occur")) ; XEmacs | |
| 80 (set (make-local-variable 'revert-buffer-function) 'occur-revert-function) | |
| 81 (make-local-variable 'occur-revert-arguments) | |
| 82 (add-hook 'change-major-mode-hook 'turn-off-font-lock t t) | |
| 83 (setq next-error-function 'occur-next-error) | |
| 84 (require 'mode-motion) ; XEmacs | |
| 85 (setq mode-motion-hook 'mode-motion-highlight-line) ; XEmacs | |
| 86 (run-mode-hooks 'occur-mode-hook)) | |
| 87 | |
| 88 (defun occur-revert-function (ignore1 ignore2) | |
| 89 "Handle `revert-buffer' for Occur mode buffers." | |
| 90 (apply 'occur-1 (append occur-revert-arguments (list (buffer-name))))) | |
| 91 | |
| 92 ;; FSF Version of next function: | |
| 93 ; (defun occur-mode-mouse-goto (event) | |
| 94 ; "In Occur mode, go to the occurrence whose line you click on." | |
| 95 ; (interactive "e") | |
| 96 ; (let (pos) | |
| 97 ; (save-excursion | |
| 98 ; (set-buffer (window-buffer (posn-window (event-end event)))) | |
| 99 ; (save-excursion | |
| 100 ; (goto-char (posn-point (event-end event))) | |
| 101 ; (setq pos (occur-mode-find-occurrence)))) | |
| 102 ; (pop-to-buffer (marker-buffer pos)) | |
| 103 ; (goto-char pos))) | |
| 104 | |
| 105 (defun occur-mode-mouse-goto (event) | |
| 106 "Go to the occurrence highlighted by mouse. | |
| 107 This function should be bound to a mouse key in the `*Occur*' buffer." | |
| 108 (interactive "e") | |
| 109 (let ((window-save (selected-window)) | |
| 110 (frame-save (selected-frame))) | |
| 111 ;; preserve the window/frame setup | |
| 112 (unwind-protect | |
| 113 (progn | |
| 114 (mouse-set-point event) | |
| 115 (occur-mode-goto-occurrence)) | |
| 116 (select-frame frame-save) | |
| 117 (select-window window-save)))) | |
| 118 | |
| 119 (defun occur-mode-find-occurrence () | |
| 120 (let ((pos (get-text-property (point) 'occur-target))) | |
| 121 (unless pos | |
| 122 (error "No occurrence on this line")) | |
| 123 (unless (buffer-live-p (marker-buffer pos)) | |
| 124 (error "Buffer for this occurrence was killed")) | |
| 125 pos)) | |
| 126 | |
| 127 (defun occur-mode-goto-occurrence () | |
| 128 "Go to the occurrence the current line describes." | |
| 129 (interactive) | |
| 130 (let ((pos (occur-mode-find-occurrence))) | |
| 131 (pop-to-buffer (marker-buffer pos)) | |
| 132 (goto-char pos))) | |
| 133 | |
| 134 (defun occur-mode-goto-occurrence-other-window () | |
| 135 "Go to the occurrence the current line describes, in another window." | |
| 136 (interactive) | |
| 137 (let ((pos (occur-mode-find-occurrence))) | |
| 138 (switch-to-buffer-other-window (marker-buffer pos)) | |
| 139 (goto-char pos))) | |
| 140 | |
| 141 (defun occur-mode-display-occurrence () | |
| 142 "Display in another window the occurrence the current line describes." | |
| 143 (interactive) | |
| 144 (let ((pos (occur-mode-find-occurrence)) | |
| 145 window | |
| 146 ;; Bind these to ensure `display-buffer' puts it in another window. | |
| 147 same-window-buffer-names | |
| 148 same-window-regexps) | |
| 149 (setq window (display-buffer (marker-buffer pos))) | |
| 150 ;; This is the way to set point in the proper window. | |
| 151 (save-selected-window | |
| 152 (select-window window) | |
| 153 (goto-char pos)))) | |
| 154 | |
| 155 (defun occur-find-match (n search message) | |
| 156 (if (not n) (setq n 1)) | |
| 157 (let ((r)) | |
| 158 (while (> n 0) | |
| 159 (setq r (funcall search (point) 'occur-match)) | |
| 160 (and r | |
| 161 (get-text-property r 'occur-match) | |
| 162 (setq r (funcall search r 'occur-match))) | |
| 163 (if r | |
| 164 (goto-char r) | |
| 165 (error message)) | |
| 166 (setq n (1- n))))) | |
| 167 | |
| 168 (defun occur-next (&optional n) | |
| 169 "Move to the Nth (default 1) next match in an Occur mode buffer." | |
| 170 (interactive "p") | |
| 171 (occur-find-match n #'next-single-property-change "No more matches")) | |
| 172 | |
| 173 (defun occur-prev (&optional n) | |
| 174 "Move to the Nth (default 1) previous match in an Occur mode buffer." | |
| 175 (interactive "p") | |
| 176 (occur-find-match n #'previous-single-property-change "No earlier matches")) | |
| 177 | |
| 178 (defun occur-next-error (&optional argp reset) | |
| 179 "Move to the Nth (default 1) next match in an Occur mode buffer. | |
| 3299 | 180 Compatibility function for \\[next-error-framework-next-error] invocations." |
| 3000 | 181 (interactive "p") |
| 182 ;; we need to run occur-find-match from within the Occur buffer | |
| 183 (with-current-buffer | |
| 184 ;; Choose the buffer and make it current. | |
| 185 (if (next-error-buffer-p (current-buffer)) | |
| 186 (current-buffer) | |
| 187 (next-error-find-buffer nil nil | |
| 188 (lambda () | |
| 189 (eq major-mode 'occur-mode)))) | |
| 190 | |
| 191 (goto-char (cond (reset (point-min)) | |
| 192 ((< argp 0) (line-beginning-position)) | |
| 193 ((line-end-position)))) | |
| 194 (occur-find-match | |
| 195 (abs argp) | |
| 196 (if (> 0 argp) | |
| 197 #'previous-single-property-change | |
| 198 #'next-single-property-change) | |
| 199 "No more matches") | |
| 200 ;; In case the *Occur* buffer is visible in a nonselected window. | |
| 201 (set-window-point (get-buffer-window (current-buffer)) (point)) | |
| 202 (occur-mode-goto-occurrence))) | |
| 203 | |
| 204 (defface match | |
| 205 '((((class color) (background light)) | |
| 206 (:background "Tan")) | |
| 207 (((class color) (background dark)) | |
| 208 (:background "RoyalBlue3")) | |
| 209 (((class color)) | |
| 210 (:background "blue" :foreground "white")) | |
| 211 (((type tty) (class mono)) | |
| 212 (:inverse-video t)) | |
| 213 (t (:background "gray"))) | |
| 214 "Face used to highlight matches permanently." | |
| 215 :group 'matching | |
| 216 :version "22.1") | |
| 217 | |
| 218 (defcustom list-matching-lines-default-context-lines 0 | |
| 219 "*Default number of context lines included around `list-matching-lines' matches. | |
| 220 A negative number means to include that many lines before the match. | |
| 221 A positive number means to include that many lines both before and after." | |
| 222 :type 'integer | |
| 223 :group 'matching) | |
| 224 | |
| 3112 | 225 ;;;###autoload |
| 3000 | 226 (defalias 'list-matching-lines 'occur) |
| 227 | |
| 228 (defcustom list-matching-lines-face 'match | |
| 229 "*Face used by \\[list-matching-lines] to show the text that matches. | |
| 230 If the value is nil, don't highlight the matching portions specially." | |
| 231 :type 'face | |
| 232 :group 'matching) | |
| 233 | |
| 234 (defcustom list-matching-lines-buffer-name-face 'underline | |
| 235 "*Face used by \\[list-matching-lines] to show the names of buffers. | |
| 236 If the value is nil, don't highlight the buffer names specially." | |
| 237 :type 'face | |
| 238 :group 'matching) | |
| 239 | |
| 240 (defun occur-accumulate-lines (count &optional keep-props) | |
| 241 (save-excursion | |
| 242 (let ((forwardp (> count 0)) | |
| 243 result beg end) | |
| 244 (while (not (or (zerop count) | |
| 245 (if forwardp | |
| 246 (eobp) | |
| 247 (bobp)))) | |
| 248 (setq count (+ count (if forwardp -1 1))) | |
| 249 (setq beg (line-beginning-position) | |
| 250 end (line-end-position)) | |
| 3017 | 251 (if (and keep-props (if-boundp 'jit-lock-mode jit-lock-mode) |
| 3000 | 252 (text-property-not-all beg end 'fontified t)) |
| 3017 | 253 (if-fboundp 'jit-lock-fontify-now |
| 3000 | 254 (jit-lock-fontify-now beg end))) |
| 255 (push | |
| 256 (funcall (if keep-props | |
| 257 #'buffer-substring | |
| 258 #'buffer-substring-no-properties) | |
| 259 beg end) | |
| 260 result) | |
| 261 (forward-line (if forwardp 1 -1))) | |
| 262 (nreverse result)))) | |
| 263 | |
| 264 (defun occur-read-primary-args () | |
| 265 (list (let* ((default (or (symbol-near-point) | |
| 266 (and regexp-history | |
| 267 (car regexp-history)))) | |
| 268 (minibuffer-history-minimum-string-length 0) | |
| 269 (input | |
| 270 (if default | |
| 271 ;; XEmacs: rewritten for I18N3 snarfing | |
| 272 (read-from-minibuffer | |
| 273 (format "List lines matching regexp (default `%s'): " | |
| 274 default) nil nil nil 'regexp-history nil | |
| 275 default) | |
| 276 (read-from-minibuffer | |
| 277 "List lines matching regexp: " | |
| 278 nil nil nil | |
| 279 'regexp-history)))) | |
| 280 (if (equal input "") | |
| 281 default | |
| 282 input)) | |
| 283 (when current-prefix-arg | |
| 284 (prefix-numeric-value current-prefix-arg)))) | |
| 285 | |
| 286 ;;;###autoload | |
| 287 (defun occur-rename-buffer (&optional unique-p interactive-p) | |
| 288 "Rename the current *Occur* buffer to *Occur: original-buffer-name*. | |
| 289 Here `original-buffer-name' is the buffer name were Occur was originally run. | |
| 290 When given the prefix argument, or called non-interactively, the renaming | |
| 291 will not clobber the existing buffer(s) of that name, but use | |
| 292 `generate-new-buffer-name' instead. You can add this to `occur-hook' | |
| 293 if you always want a separate *Occur* buffer for each buffer where you | |
| 294 invoke `occur'." | |
| 295 (interactive "P\np") | |
| 296 (with-current-buffer | |
| 297 (if (eq major-mode 'occur-mode) (current-buffer) (get-buffer "*Occur*")) | |
| 298 (rename-buffer (concat "*Occur: " | |
| 299 (mapconcat #'buffer-name | |
| 300 (car (cddr occur-revert-arguments)) "/") | |
| 301 "*") | |
| 302 (or unique-p (not interactive-p))))) | |
| 303 | |
| 304 ;;;###autoload | |
| 305 (defun occur (regexp &optional nlines) | |
| 306 "Show all lines in the current buffer containing a match for REGEXP. | |
| 307 This function can not handle matches that span more than one line. | |
| 308 | |
| 309 Each line is displayed with NLINES lines before and after, or -NLINES | |
| 310 before if NLINES is negative. | |
| 311 NLINES defaults to `list-matching-lines-default-context-lines'. | |
| 312 Interactively it is the prefix arg. | |
| 313 | |
| 314 The lines are shown in a buffer named `*Occur*'. | |
| 315 It serves as a menu to find any of the occurrences in this buffer. | |
| 316 \\<occur-mode-map>\\[describe-mode] in that buffer will explain how. | |
| 317 | |
| 318 If REGEXP contains upper case characters (excluding those preceded by `\\'), | |
| 319 the matching is case-sensitive." | |
| 320 (interactive (occur-read-primary-args)) | |
| 321 (occur-1 regexp nlines (list (current-buffer)))) | |
| 322 | |
| 323 ;;;###autoload | |
| 324 (defun multi-occur (bufs regexp &optional nlines) | |
| 325 "Show all lines in buffers BUFS containing a match for REGEXP. | |
| 326 This function acts on multiple buffers; otherwise, it is exactly like | |
| 327 `occur'." | |
| 328 (interactive | |
| 329 (cons | |
| 330 (let* ((bufs (list (read-buffer "First buffer to search: " | |
| 331 (current-buffer) t))) | |
| 332 (buf nil) | |
| 3299 | 333 ; (ido-ignore-item-temp-list bufs) |
| 334 ) | |
| 3000 | 335 (while (not (string-equal |
| 336 (setq buf (read-buffer | |
| 337 (if (and-boundp 'read-buffer-function | |
| 338 '(eq read-buffer-function 'ido-read-buffer)) | |
| 339 "Next buffer to search (C-j to end): " | |
| 340 "Next buffer to search (RET to end): ") | |
| 341 nil t)) | |
| 342 "")) | |
| 343 (add-to-list 'bufs buf) | |
| 3299 | 344 ; (setq ido-ignore-item-temp-list bufs) |
| 345 ) | |
| 3000 | 346 (nreverse (mapcar #'get-buffer bufs))) |
| 347 (occur-read-primary-args))) | |
| 348 (occur-1 regexp nlines bufs)) | |
| 349 | |
| 350 ;;;###autoload | |
| 351 (defun multi-occur-by-filename-regexp (bufregexp regexp &optional nlines) | |
| 352 "Show all lines matching REGEXP in buffers named by BUFREGEXP. | |
| 353 See also `multi-occur'." | |
| 354 (interactive | |
| 355 (cons | |
| 356 (let* ((default (car regexp-history)) | |
| 357 (input | |
| 358 (read-from-minibuffer | |
| 359 "List lines in buffers whose filename matches regexp: " | |
| 360 nil | |
| 361 nil | |
| 362 nil | |
| 363 'regexp-history))) | |
| 364 (if (equal input "") | |
| 365 default | |
| 366 input)) | |
| 367 (occur-read-primary-args))) | |
| 368 (when bufregexp | |
| 369 (occur-1 regexp nlines | |
| 370 (delq nil | |
| 371 (mapcar (lambda (buf) | |
| 372 (when (and (buffer-file-name buf) | |
| 373 (string-match bufregexp | |
| 374 (buffer-file-name buf))) | |
| 375 buf)) | |
| 376 (buffer-list)))))) | |
| 377 | |
| 378 (defun occur-1 (regexp nlines bufs &optional buf-name) | |
| 379 (unless buf-name | |
| 380 (setq buf-name "*Occur*")) | |
| 381 (let (occur-buf | |
| 382 (active-bufs (delq nil (mapcar #'(lambda (buf) | |
| 383 (when (buffer-live-p buf) buf)) | |
| 384 bufs)))) | |
| 385 ;; Handle the case where one of the buffers we're searching is the | |
| 386 ;; output buffer. Just rename it. | |
| 387 (when (member buf-name (mapcar 'buffer-name active-bufs)) | |
| 388 (with-current-buffer (get-buffer buf-name) | |
| 389 (rename-uniquely))) | |
| 390 | |
| 391 ;; Now find or create the output buffer. | |
| 392 ;; If we just renamed that buffer, we will make a new one here. | |
| 393 (setq occur-buf (get-buffer-create buf-name)) | |
| 394 | |
| 395 (with-current-buffer occur-buf | |
| 396 (occur-mode) | |
| 397 (let ((inhibit-read-only t)) | |
| 398 (erase-buffer) | |
| 399 (let ((count (occur-engine | |
| 400 regexp active-bufs occur-buf | |
| 401 (or nlines list-matching-lines-default-context-lines) | |
| 402 (and case-fold-search | |
| 403 (no-upper-case-p regexp t)) | |
| 404 list-matching-lines-buffer-name-face | |
| 405 nil list-matching-lines-face t))) | |
| 406 (let* ((bufcount (length active-bufs)) | |
| 407 (diff (- (length bufs) bufcount))) | |
| 408 (message "Searched %d buffer%s%s; %s match%s for `%s'" | |
| 409 bufcount (if (= bufcount 1) "" "s") | |
| 410 (if (zerop diff) "" (format " (%d killed)" diff)) | |
| 411 (if (zerop count) "no" (format "%d" count)) | |
| 412 (if (= count 1) "" "es") | |
| 413 regexp)) | |
| 414 (setq occur-revert-arguments (list regexp nlines bufs)) | |
| 415 (if (= count 0) | |
| 416 (kill-buffer occur-buf) | |
| 417 (display-buffer occur-buf) | |
| 418 (setq next-error-last-buffer occur-buf) | |
| 419 (setq buffer-read-only t) | |
| 420 (set-buffer-modified-p nil) | |
| 421 (run-hooks 'occur-hook))))))) | |
| 422 | |
| 423 (defun occur-engine-add-prefix (lines) | |
| 424 (mapcar | |
| 425 #'(lambda (line) | |
| 426 (concat " :" line "\n")) | |
| 427 lines)) | |
| 428 | |
| 429 (defun occur-engine (regexp buffers out-buf nlines case-fold-search | |
| 430 title-face prefix-face match-face keep-props) | |
| 431 (with-current-buffer out-buf | |
| 432 (let ((globalcount 0) | |
| 433 ;; Don't generate undo entries for creation of the initial contents. | |
| 434 (buffer-undo-list t) | |
| 435 (coding nil)) | |
| 436 ;; Map over all the buffers | |
| 437 (dolist (buf buffers) | |
| 438 (when (buffer-live-p buf) | |
| 439 (let ((matches 0) ;; count of matched lines | |
| 440 (lines 1) ;; line count | |
| 441 (matchbeg 0) | |
| 442 (origpt nil) | |
| 443 (begpt nil) | |
| 444 (endpt nil) | |
| 445 (marker nil) | |
| 446 (curstring "") | |
| 447 (headerpt (with-current-buffer out-buf (point)))) | |
| 448 (save-excursion | |
| 449 (set-buffer buf) | |
| 450 (or coding | |
| 451 ;; Set CODING only if the current buffer locally | |
| 452 ;; binds buffer-file-coding-system. | |
| 453 (not (local-variable-p 'buffer-file-coding-system (current-buffer))) | |
| 454 (setq coding buffer-file-coding-system)) | |
| 455 (save-excursion | |
| 456 (goto-char (point-min)) ;; begin searching in the buffer | |
| 457 (while (not (eobp)) | |
| 458 (setq origpt (point)) | |
| 459 (when (setq endpt (re-search-forward regexp nil t)) | |
| 460 (setq matches (1+ matches)) ;; increment match count | |
| 461 (setq matchbeg (match-beginning 0)) | |
| 462 (setq lines (+ lines (1- (count-lines origpt endpt)))) | |
| 463 (save-excursion | |
| 464 (goto-char matchbeg) | |
| 465 (setq begpt (line-beginning-position) | |
| 466 endpt (line-end-position))) | |
| 467 (setq marker (make-marker)) | |
| 468 (set-marker marker matchbeg) | |
| 469 (if (and keep-props | |
| 4103 | 470 (if-boundp 'jit-lock-mode jit-lock-mode) |
| 3000 | 471 (text-property-not-all begpt endpt 'fontified t)) |
|
5368
ed74d2ca7082
Use ', not #', when a given symbol may not have a function binding at read time
Aidan Kehoe <kehoea@parhasard.net>
parents:
4103
diff
changeset
|
472 (if-fboundp 'jit-lock-fontify-now |
| 3000 | 473 (jit-lock-fontify-now begpt endpt))) |
| 474 (setq curstring (buffer-substring begpt endpt)) | |
| 475 ;; Depropertize the string, and maybe | |
| 476 ;; highlight the matches | |
| 477 (let ((len (length curstring)) | |
| 478 (start 0)) | |
| 479 (unless keep-props | |
| 480 (set-text-properties 0 len nil curstring)) | |
| 481 (while (and (< start len) | |
| 482 (string-match regexp curstring start)) | |
| 483 (add-text-properties | |
| 484 (match-beginning 0) (match-end 0) | |
| 485 (append | |
| 486 `(occur-match t) | |
| 487 (when match-face | |
| 488 ;; Use `face' rather than `font-lock-face' here | |
| 489 ;; so as to override faces copied from the buffer. | |
| 490 `(face ,match-face))) | |
| 491 curstring) | |
| 492 (setq start (match-end 0)))) | |
| 493 ;; Generate the string to insert for this match | |
| 494 (let* ((out-line | |
| 495 (concat | |
| 496 ;; Using 7 digits aligns tabs properly. | |
| 497 (apply #'propertize (format "%7d:" lines) | |
| 498 (append | |
| 499 (when prefix-face | |
| 500 `(font-lock-face prefix-face)) | |
| 501 '(occur-prefix t))) | |
| 502 ;; We don't put `mouse-face' on the newline, | |
| 503 ;; because that loses. And don't put it | |
| 504 ;; on context lines to reduce flicker. | |
| 505 (propertize curstring 'mouse-face 'highlight) | |
| 506 "\n")) | |
| 507 (data | |
| 508 (if (= nlines 0) | |
| 509 ;; The simple display style | |
| 510 out-line | |
| 511 ;; The complex multi-line display | |
| 512 ;; style. Generate a list of lines, | |
| 513 ;; concatenate them all together. | |
| 514 (apply #'concat | |
| 515 (nconc | |
| 516 (occur-engine-add-prefix (nreverse (cdr (occur-accumulate-lines (- (1+ (abs nlines))) keep-props)))) | |
| 517 (list out-line) | |
| 518 (if (> nlines 0) | |
| 519 (occur-engine-add-prefix | |
| 520 (cdr (occur-accumulate-lines (1+ nlines) keep-props))))))))) | |
| 521 ;; Actually insert the match display data | |
| 522 (with-current-buffer out-buf | |
| 523 (let ((beg (point)) | |
| 524 (end (progn (insert data) (point)))) | |
| 525 (unless (= nlines 0) | |
| 526 (insert "-------\n")) | |
| 527 (add-text-properties | |
| 528 beg end | |
| 529 `(occur-target ,marker help-echo "mouse-2: go to this occurrence"))))) | |
| 530 (goto-char endpt)) | |
| 531 (if endpt | |
| 532 (progn | |
| 533 (setq lines (1+ lines)) | |
| 534 ;; On to the next match... | |
| 535 (forward-line 1)) | |
| 536 (goto-char (point-max)))))) | |
| 537 (when (not (zerop matches)) ;; is the count zero? | |
| 538 (setq globalcount (+ globalcount matches)) | |
| 539 (with-current-buffer out-buf | |
| 540 (goto-char headerpt) | |
| 541 (let ((beg (point)) | |
| 542 end) | |
| 543 (insert (format "%d match%s for \"%s\" in buffer: %s\n" | |
| 544 matches (if (= matches 1) "" "es") | |
| 545 regexp (buffer-name buf))) | |
| 546 (setq end (point)) | |
| 547 (add-text-properties beg end | |
| 548 (append | |
| 549 (when title-face | |
| 550 `(font-lock-face ,title-face)) | |
| 551 `(occur-title ,buf)))) | |
| 552 (goto-char (point-min))))))) | |
| 553 (if coding | |
| 554 ;; CODING is buffer-file-coding-system of the first buffer | |
| 555 ;; that locally binds it. Let's use it also for the output | |
| 556 ;; buffer. | |
| 557 (set-buffer-file-coding-system coding)) | |
| 558 ;; Return the number of matches | |
| 559 globalcount))) | |
| 560 | |
| 561 (provide 'occur) |