From 15af15e54912d52e1840a257d0e01593e311b6d5 Mon Sep 17 00:00:00 2001 From: Tak Ota Date: Fri, 3 Dec 2010 20:58:06 -0500 Subject: [PATCH] * lisp/replace.el: Add "collect" feature to occur. (occur-collect-regexp-history): New var. (occur-read-primary-args): Return a replace string for nlines, if needed. (occur): Extend the meaning of nlines. --- lisp/ChangeLog | 7 +++++ lisp/replace.el | 82 ++++++++++++++++++++++++++++++++++++++++--------- 2 files changed, 74 insertions(+), 15 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 141881a17a4..187a36a5f5d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2010-12-04 Tak Ota + + * replace.el: Add "collect" feature to occur. + (occur-collect-regexp-history): New var. + (occur-read-primary-args): Return a replace string for nlines, if needed. + (occur): Extend the meaning of nlines. + 2010-12-04 Stefan Monnier * progmodes/which-func.el (which-func-ff-hook): Log the error message. diff --git a/lisp/replace.el b/lisp/replace.el index baea2820433..28f3a845c2a 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -532,6 +532,9 @@ 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-collect-regexp-history '("\\1") + "History of regexp for occur's collect operation") + (defun read-regexp (prompt &optional default-value) "Read regexp as a string using the regexp history and some useful defaults. Prompt for a regular expression with PROMPT (without a colon and @@ -1007,10 +1010,25 @@ which means to discard all text properties." :version "22.1") (defun occur-read-primary-args () - (list (read-regexp "List lines matching regexp" - (car regexp-history)) - (when current-prefix-arg - (prefix-numeric-value current-prefix-arg)))) + (let* ((perform-collect (consp current-prefix-arg)) + (regexp (read-regexp (if perform-collect + "Collect strings matching regexp" + "List lines matching regexp") + (car regexp-history)))) + (list regexp + (if perform-collect + ;; Perform collect operation + (if (zerop (regexp-opt-depth regexp)) + ;; No subexpression so collect the entire match. + "\\&" + ;; Get the regexp for collection pattern. + (let ((default (car occur-collect-regexp-history))) + (read-string + (format "Regexp to collect (default %s): " default) + nil 'occur-collect-regexp-history default))) + ;; Otherwise normal occur takes numerical prefix argument. + (when current-prefix-arg + (prefix-numeric-value current-prefix-arg)))))) (defun occur-rename-buffer (&optional unique-p interactive-p) "Rename the current *Occur* buffer to *Occur: original-buffer-name*. @@ -1043,7 +1061,18 @@ It serves as a menu to find any of the occurrences in this buffer. \\\\[describe-mode] in that buffer will explain how. If REGEXP contains upper case characters (excluding those preceded by `\\') -and `search-upper-case' is non-nil, the matching is case-sensitive." +and `search-upper-case' is non-nil, the matching is case-sensitive. + +When NLINES is a string or when the function is called +interactively with prefix argument without a number (`C-u' alone +as prefix) the matching strings are collected into the `*Occur*' +buffer by using NLINES as a replacement regexp. NLINES may +contain \\& and \\N which convention follows `replace-match'. +For example, providing \"defun\\s +\\(\\S +\\)\" for REGEXP and +\"\\1\" for NLINES collects all the function names in a lisp +program. When there is no parenthesized subexpressions in REGEXP +the entire match is collected. In any case the searched buffers +are not modified." (interactive (occur-read-primary-args)) (occur-1 regexp nlines (list (current-buffer)))) @@ -1125,20 +1154,43 @@ See also `multi-occur'." (setq occur-buf (get-buffer-create buf-name)) (with-current-buffer occur-buf - (occur-mode) + (if (stringp nlines) + (fundamental-mode) ;; This is for collect opeartion. + (occur-mode)) (let ((inhibit-read-only t) ;; Don't generate undo entries for creation of the initial contents. (buffer-undo-list t)) (erase-buffer) - (let ((count (occur-engine - regexp active-bufs occur-buf - (or nlines list-matching-lines-default-context-lines) - (if (and case-fold-search search-upper-case) - (isearch-no-upper-case-p regexp t) - case-fold-search) - list-matching-lines-buffer-name-face - nil list-matching-lines-face - (not (eq occur-excluded-properties t))))) + (let ((count + (if (stringp nlines) + ;; Treat nlines as a regexp to collect. + (let ((bufs active-bufs) + (count 0)) + (while bufs + (with-current-buffer (car bufs) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + ;; Insert the replacement regexp. + (let ((str (match-substitute-replacement nlines))) + (if str + (with-current-buffer occur-buf + (insert str) + (setq count (1+ count)) + (or (zerop (current-column)) + (insert "\n")))))))) + (setq bufs (cdr bufs))) + count) + ;; Perform normal occur. + (occur-engine + regexp active-bufs occur-buf + (or nlines list-matching-lines-default-context-lines) + (if (and case-fold-search search-upper-case) + (isearch-no-upper-case-p regexp t) + case-fold-search) + list-matching-lines-buffer-name-face + nil list-matching-lines-face + (not (eq occur-excluded-properties t)))))) (let* ((bufcount (length active-bufs)) (diff (- (length bufs) bufcount))) (message "Searched %d buffer%s%s; %s match%s%s"