;;; Code:
-(defvar case-replace t "\
-*Non-nil means query-replace should preserve case in replacements.")
+(defcustom case-replace t
+ "*Non-nil means query-replace should preserve case in replacements."
+ :type 'boolean
+ :group 'matching)
(defvar query-replace-history nil)
(setq from (car (if regexp-flag regexp-search-ring search-ring)))
(setq from (read-from-minibuffer (format "%s: " string)
nil nil nil
- 'query-replace-history)))
+ 'query-replace-history nil t)))
(setq to (read-from-minibuffer (format "%s %s with: " string from)
nil nil nil
- 'query-replace-history))
+ 'query-replace-history nil t))
(list from to current-prefix-arg)))
(defun query-replace (from-string to-string &optional arg)
(car regexp-search-ring)
(read-from-minibuffer "Map query replace (regexp): "
nil nil nil
- 'query-replace-history)))
+ 'query-replace-history nil t)))
(setq to (read-from-minibuffer
(format "Query replace %s with (space-separated strings): "
from)
nil nil nil
- 'query-replace-history))
+ 'query-replace-history nil t))
(list from to current-prefix-arg)))
(let (replacements)
(if (listp to-strings)
What you probably want is a loop like this:
(while (search-forward FROM-STRING nil t)
(replace-match TO-STRING nil t))
-which will run faster and will not set the mark or print anything."
+which will run faster and will not set the mark or print anything.
+\(You may need a more complex loop if FROM-STRING can match the null string
+and TO-STRING is also null.)"
(interactive (query-replace-read-args "Replace string" nil))
(perform-replace from-string to-string nil nil delimited))
Applies to all lines after point."
(interactive (list (read-from-minibuffer
"Keep lines (containing match for regexp): "
- nil nil nil 'regexp-history)))
+ nil nil nil 'regexp-history nil t)))
(save-excursion
(or (bolp) (forward-line 1))
(let ((start (point)))
Applies to lines after point."
(interactive (list (read-from-minibuffer
"Flush lines (containing match for regexp): "
- nil nil nil 'regexp-history)))
+ nil nil nil 'regexp-history nil t)))
(save-excursion
(while (and (not (eobp))
(re-search-forward regexp nil t))
(defalias 'count-matches 'how-many)
(defun how-many (regexp)
"Print number of matches for REGEXP following point."
- (interactive (list (read-from-minibuffer
- "How many matches for (regexp): "
- nil nil nil 'regexp-history)))
+ (interactive (list(read-from-minibuffer
+ "How many matches for (regexp): "
+ nil nil nil 'regexp-history nil t)))
(let ((count 0) opoint)
(save-excursion
(while (and (not (eobp))
(define-key occur-mode-map [mouse-2] 'occur-mode-mouse-goto)
(define-key occur-mode-map "\C-c\C-c" 'occur-mode-goto-occurrence)
(define-key occur-mode-map "\C-m" 'occur-mode-goto-occurrence)
+ (define-key occur-mode-map "\M-n" 'occur-next)
+ (define-key occur-mode-map "\M-p" 'occur-prev)
(define-key occur-mode-map "g" 'revert-buffer))
-(defvar occur-buffer nil)
-(defvar occur-nlines nil)
-(defvar occur-pos-list nil)
+
+(defvar occur-buffer nil
+ "Name of buffer for last occur.")
+
+
+(defvar occur-nlines nil
+ "Number of lines of context to show around matching line.")
+
(defvar occur-command-arguments nil
"Arguments that were given to `occur' when it made this buffer.")
+(put 'occur-mode 'mode-class 'special)
+
(defun occur-mode ()
"Major mode for output from \\[occur].
\\<occur-mode-map>Move point to one of the items in this buffer, then use
(setq revert-buffer-function 'occur-revert-function)
(make-local-variable 'occur-buffer)
(make-local-variable 'occur-nlines)
- (make-local-variable 'occur-pos-list)
(make-local-variable 'occur-command-arguments)
(run-hooks 'occur-mode-hook))
(if (or (null occur-buffer)
(null (buffer-name occur-buffer)))
(progn
- (setq occur-buffer nil
- occur-pos-list nil)
+ (setq occur-buffer nil)
(error "Buffer in which occurrences were found is deleted")))
- (let* ((line-count
- (count-lines (point-min)
- (save-excursion
- (beginning-of-line)
- (point))))
- (occur-number (save-excursion
- (beginning-of-line)
- (/ (1- line-count)
- (cond ((< occur-nlines 0)
- (- 2 occur-nlines))
- ((> occur-nlines 0)
- (+ 2 (* 2 occur-nlines)))
- (t 1)))))
- (pos (nth occur-number occur-pos-list)))
- (if (< line-count 1)
- (error "No occurrence on this line"))
- (or pos
- (error "No occurrence on this line"))
- pos))
+ (let ((pos (get-text-property (point) 'occur)))
+ (if (null pos)
+ (error "No occurrence on this line")
+ pos)))
(defun occur-mode-goto-occurrence ()
"Go to the occurrence the current line describes."
(let ((pos (occur-mode-find-occurrence)))
(pop-to-buffer occur-buffer)
(goto-char (marker-position pos))))
+
+(defun occur-next (&optional n)
+ "Move to the Nth (default 1) next match in the *Occur* buffer."
+ (interactive "p")
+ (if (not n) (setq n 1))
+ (let ((r))
+ (while (> n 0)
+ (if (get-text-property (point) 'occur-point)
+ (forward-char 1))
+ (setq r (next-single-property-change (point) 'occur-point))
+ (if r
+ (goto-char r)
+ (error "no more matches"))
+ (setq n (1- n)))))
+
+
+
+(defun occur-prev (&optional n)
+ "Move to the Nth (default 1) previous match in the *Occur* buffer."
+ (interactive "p")
+ (if (not n) (setq n 1))
+ (let ((r))
+ (while (> n 0)
+
+ (setq r (get-text-property (point) 'occur-point))
+ (if r (forward-char -1))
+
+ (setq r (previous-single-property-change (point) 'occur-point))
+ (if r
+ (goto-char (- r 1))
+ (error "no earlier matches"))
+
+ (setq n (1- n)))))
\f
-(defvar list-matching-lines-default-context-lines 0
+(defcustom list-matching-lines-default-context-lines 0
"*Default number of context lines to include around a `list-matching-lines'
match. A negative number means to include that many lines before the match.
-A positive number means to include that many lines both before and after.")
+A positive number means to include that many lines both before and after."
+ :type 'integer
+ :group 'matching)
(defalias 'list-matching-lines 'occur)
The lines are shown in a buffer named `*Occur*'.
It serves as a menu to find any of the occurrences in this buffer.
-\\[describe-mode] in that buffer will explain how."
+\\<occur-mode-map>\\[describe-mode] in that buffer will explain how.
+
+If REGEXP contains upper case characters (excluding those preceded by `\\'),
+the matching is case-sensitive."
(interactive
(list (let* ((default (car regexp-history))
(input
(format "List lines matching regexp (default `%s'): "
default)
"List lines matching regexp: ")
- nil nil nil 'regexp-history)))
+ nil nil nil 'regexp-history nil t)))
(if (string-equal input "")
default
(set-text-properties 0 (length input) nil input)
(prefix-numeric-value nlines)
list-matching-lines-default-context-lines))
(first t)
+ ;;flag to prevent printing separator for first match
+ (occur-num-matches 0)
(buffer (current-buffer))
(dir default-directory)
(linenum 1)
- (prevpos (point-min))
- (final-context-start (make-marker)))
+ (prevpos
+ ;;position of most recent match
+ (point-min))
+ (case-fold-search (and case-fold-search
+ (isearch-no-upper-case-p regexp t)))
+ (final-context-start
+ ;; Marker to the start of context immediately following
+ ;; the matched text in *Occur*.
+ (make-marker)))
;;; (save-excursion
;;; (beginning-of-line)
;;; (setq linenum (1+ (count-lines (point-min) (point))))
(occur-mode)
(setq occur-buffer buffer)
(setq occur-nlines nlines)
- (setq occur-pos-list ())
(setq occur-command-arguments
(list regexp nlines)))
(if (eq buffer standard-output)
(setq linenum (+ linenum (count-lines prevpos (point)))))
(setq prevpos (point))
(goto-char (match-end 0))
- (let* ((start (save-excursion
+ (let* ((start
+ ;;start point of text in source buffer to be put
+ ;;into *Occur*
+ (save-excursion
(goto-char (match-beginning 0))
- (forward-line (if (< nlines 0) nlines (- nlines)))
+ (forward-line (if (< nlines 0)
+ nlines
+ (- nlines)))
(point)))
- (end (save-excursion
- (goto-char (match-end 0))
- (if (> nlines 0)
- (forward-line (1+ nlines))
- (forward-line 1))
- (point)))
- ;; Record where the actual match
- (match-offset
- (save-excursion
- (goto-char (match-beginning 0))
- (beginning-of-line)
- ;; +6 to skip over line number
- (+ 6 (- (match-beginning 0) (point)))))
- (match-len (- (match-end 0) (match-beginning 0)))
+ (end
+ ;; end point of text in source buffer to be put
+ ;; into *Occur*
+ (save-excursion
+ (goto-char (match-end 0))
+ (if (> nlines 0)
+ (forward-line (1+ nlines))
+ (forward-line 1))
+ (point)))
+ (match-beg
+ ;; Amount of context before matching text
+ (- (match-beginning 0) start))
+ (match-len
+ ;; Length of matching text
+ (- (match-end 0) (match-beginning 0)))
(tag (format "%5d" linenum))
(empty (make-string (length tag) ?\ ))
- tem)
+ tem
+ ;; Number of lines of context to show for current match.
+ occur-marker
+ ;; Marker pointing to end of match in source buffer.
+ (text-beg
+ ;; Marker pointing to start of text for one
+ ;; match in *Occur*.
+ (make-marker))
+ (text-end
+ ;; Marker pointing to end of text for one match
+ ;; in *Occur*.
+ (make-marker))
+ )
(save-excursion
- (setq tem (make-marker))
- (set-marker tem (point))
+ (setq occur-marker (make-marker))
+ (set-marker occur-marker (point))
(set-buffer standard-output)
- (setq occur-pos-list (cons tem occur-pos-list))
+ (setq occur-num-matches (1+ occur-num-matches))
(or first (zerop nlines)
(insert "--------\n"))
(setq first nil)
+
+ ;; Insert matching text including context lines from
+ ;; source buffer into *Occur*
+ (set-marker text-beg (point))
(insert-buffer-substring buffer start end)
+ (set-marker text-end (point))
+
+ ;; Highlight text that was matched.
+ (if list-matching-lines-face
+ (put-text-property
+ (+ (marker-position text-beg) match-beg)
+ (+ (marker-position text-beg) match-beg match-len)
+ 'face list-matching-lines-face))
+
+ ;; `occur-point' property is used by occur-next and
+ ;; occur-prev to move between matching lines.
+ (put-text-property
+ (+ (marker-position text-beg) match-beg match-len)
+ (+ (marker-position text-beg) match-beg match-len 1)
+ 'occur-point t)
(set-marker final-context-start
(- (point) (- end (match-end 0))))
- (backward-char (- end start))
- (setq tem nlines)
+
+ ;; Now go back to the start of the matching text
+ ;; adding the space and colon to the start of each line.
+ (goto-char (- (point) (- end start)))
+ ;; Insert space and colon for lines of context before match.
+ (setq tem (if (< linenum nlines)
+ (- nlines linenum)
+ nlines))
(while (> tem 0)
(insert empty ?:)
(forward-line 1)
(setq tem (1- tem)))
- (let ((this-linenum linenum)
- line-start)
+
+ ;; Insert line number and colon for the lines of
+ ;; matching text.
+ (let ((this-linenum linenum))
(while (< (point) final-context-start)
(if (null tag)
(setq tag (format "%5d" this-linenum)))
(insert tag ?:)
- (setq line-start
- (save-excursion
- (beginning-of-line)
- (point)))
- (put-text-property line-start
- (save-excursion
- (end-of-line)
- (point))
- 'mouse-face 'highlight)
- (if list-matching-lines-face
- (put-text-property
- (+ line-start match-offset)
- (+ line-start match-offset match-len)
- 'face list-matching-lines-face))
(forward-line 1)
(setq tag nil)
(setq this-linenum (1+ this-linenum)))
(insert empty ?:)
(forward-line 1)
(setq this-linenum (1+ this-linenum))))
- (while (< tem nlines)
+
+ ;; Insert space and colon for lines of context after match.
+ (while (and (< (point) (point-max)) (< tem nlines))
(insert empty ?:)
(forward-line 1)
(setq tem (1+ tem)))
+
+ ;; Add text properties. The `occur' prop is used to
+ ;; store the marker of the matching text in the
+ ;; source buffer.
+ (put-text-property (marker-position text-beg)
+ (- (marker-position text-end) 1)
+ 'mouse-face 'highlight)
+ (put-text-property (marker-position text-beg)
+ (marker-position text-end)
+ 'occur occur-marker)
(goto-char (point-max)))
(forward-line 1)))
(set-buffer standard-output)
- ;; Put positions in increasing order to go with buffer.
- (setq occur-pos-list (nreverse occur-pos-list))
+ ;; Go back to top of *Occur* and finish off by printing the
+ ;; number of matching lines.
(goto-char (point-min))
(let ((message-string
- (if (= (length occur-pos-list) 1)
+ (if (= occur-num-matches 1)
"1 line"
- (format "%d lines" (length occur-pos-list)))))
+ (format "%d lines" occur-num-matches))))
(insert message-string)
(if (interactive-p)
(message "%s matched" message-string)))))))))
(stack nil)
(next-rotate-count 0)
(replace-count 0)
- (lastrepl nil) ;Position after last match considered.
+ (nonempty-match nil)
+
+ ;; Data for the next match. If a cons, it has the same format as
+ ;; (match-data); otherwise it is t if a match is possible at point.
(match-again t)
+
(message
(if query-flag
(substitute-command-keys
;; Loop finding occurrences that perhaps should be replaced.
(while (and keep-going
(not (eobp))
- (funcall search-function search-string nil t)
- ;; If the search string matches immediately after
- ;; the previous match, but it did not match there
- ;; before the replacement was done, ignore the match.
- (if (or (eq lastrepl (point))
- (and regexp-flag
- (eq lastrepl (match-beginning 0))
- (not match-again)))
- (if (eobp)
- nil
- ;; Don't replace the null string
- ;; right after end of previous replacement.
- (forward-char 1)
- (funcall search-function search-string nil t))
- t))
-
- ;; Save the data associated with the real match.
- ;; For speed, use only integers and reuse the list used last time.
- (setq real-match-data (match-data t real-match-data))
-
- ;; Before we make the replacement, decide whether the search string
- ;; can match again just after this match.
- (if regexp-flag
- (setq match-again (looking-at search-string)))
+ ;; Use the next match if it is already known;
+ ;; otherwise, search for a match after moving forward
+ ;; one char if progress is required.
+ (setq real-match-data
+ (if (consp match-again)
+ (progn (goto-char (nth 1 match-again))
+ match-again)
+ (and (or match-again
+ (progn
+ (forward-char 1)
+ (not (eobp))))
+ (funcall search-function search-string nil t)
+ ;; For speed, use only integers and
+ ;; reuse the list used last time.
+ (match-data t real-match-data)))))
+
+ ;; Record whether the match is nonempty, to avoid an infinite loop
+ ;; repeatedly matching the same empty string.
+ (setq nonempty-match
+ (/= (nth 0 real-match-data) (nth 1 real-match-data)))
+
+ ;; If the match is empty, record that the next one can't be adjacent.
+ ;; Otherwise, if matching a regular expression, do the next
+ ;; match now, since the replacement for this match may
+ ;; affect whether the next match is adjacent to this one.
+ (setq match-again
+ (and nonempty-match
+ (or (not regexp-flag)
+ (and (looking-at search-string)
+ (match-data)))))
+
;; If time for a change, advance to next replacement string.
(if (and (listp replacements)
(= next-rotate-count replace-count))
(let ((message-log-max nil))
(message message from-string next-replacement))
(setq key (read-event))
+ ;; Necessary in case something happens during read-event
+ ;; that clobbers the match data.
+ (store-match-data real-match-data)
(setq key (vector key))
(setq def (lookup-key map key))
;; Restore the match data while we process the command.
;; Before we make the replacement,
;; decide whether the search string
;; can match again just after this match.
- (if regexp-flag
- (setq match-again (looking-at search-string))))
+ (if (and regexp-flag nonempty-match)
+ (setq match-again (and (looking-at search-string)
+ (match-data)))))
((eq def 'delete-and-edit)
(delete-region (match-beginning 0) (match-end 0))
(store-match-data
(setq stack
(cons (cons (point)
(or replaced (match-data t)))
- stack))))
- (setq lastrepl (point)))
+ stack)))))
(replace-dehighlight))
(or unread-command-events
(message "Replaced %d occurrence%s"
(if (= replace-count 1) "" "s")))
(and keep-going stack)))
-(defvar query-replace-highlight nil
- "*Non-nil means to highlight words during query replacement.")
+(defcustom query-replace-highlight t
+ "*Non-nil means to highlight words during query replacement."
+ :type 'boolean
+ :group 'matching)
(defvar replace-overlay nil)
HCoop / bpt / emacs.git / blobdiff