From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Tak Ota Newsgroups: gmane.emacs.devel Subject: Re: collect-string Date: Thu, 2 Dec 2010 17:03:51 -0800 Message-ID: <20101202.170351.142719949.Takaaki.Ota@am.sony.com> References: <20101109.181250.505612453.Takaaki.Ota@am.sony.com> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset="us-ascii" Content-Transfer-Encoding: 7bit X-Trace: dough.gmane.org 1291338248 2428 80.91.229.12 (3 Dec 2010 01:04:08 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Fri, 3 Dec 2010 01:04:08 +0000 (UTC) Cc: stephen@xemacs.org, emacs-devel@gnu.org To: Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Fri Dec 03 02:04:04 2010 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1POK4B-0006qt-96 for ged-emacs-devel@m.gmane.org; Fri, 03 Dec 2010 02:04:03 +0100 Original-Received: from localhost ([127.0.0.1]:34290 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1POK4A-0003he-O6 for ged-emacs-devel@m.gmane.org; Thu, 02 Dec 2010 20:04:02 -0500 Original-Received: from [140.186.70.92] (port=44678 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1POK45-0003ee-5B for emacs-devel@gnu.org; Thu, 02 Dec 2010 20:03:58 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1POK42-000599-It for emacs-devel@gnu.org; Thu, 02 Dec 2010 20:03:56 -0500 Original-Received: from am1ehsobe005.messaging.microsoft.com ([213.199.154.208]:36100 helo=AM1EHSOBE005.bigfish.com) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1POK42-00058f-81 for emacs-devel@gnu.org; Thu, 02 Dec 2010 20:03:54 -0500 Original-Received: from mail33-am1-R.bigfish.com (10.3.201.249) by AM1EHSOBE005.bigfish.com (10.3.204.25) with Microsoft SMTP Server id 14.1.225.8; Fri, 3 Dec 2010 01:03:52 +0000 Original-Received: from mail33-am1 (localhost.localdomain [127.0.0.1]) by mail33-am1-R.bigfish.com (Postfix) with ESMTP id 7641E1C28420; Fri, 3 Dec 2010 01:03:52 +0000 (UTC) X-SpamScore: -12 X-BigFish: VPS-12(zz1432N98dNzz1202hzzz2fh2a8h691h668h61h) X-Forefront-Antispam-Report: KIP:(null); UIP:(null); IPVD:NLI; H:mail7.fw-bc.sony.com; RD:mail7.fw-bc.sony.com; EFVD:NLI Original-Received: from mail33-am1 (localhost.localdomain [127.0.0.1]) by mail33-am1 (MessageSwitch) id 1291338231672290_17168; Fri, 3 Dec 2010 01:03:51 +0000 (UTC) Original-Received: from AM1EHSMHS002.bigfish.com (unknown [10.3.201.249]) by mail33-am1.bigfish.com (Postfix) with ESMTP id 9ABD1E8057; Fri, 3 Dec 2010 01:03:51 +0000 (UTC) Original-Received: from mail7.fw-bc.sony.com (160.33.98.74) by AM1EHSMHS002.bigfish.com (10.3.207.102) with Microsoft SMTP Server (TLS) id 14.1.225.8; Fri, 3 Dec 2010 01:03:51 +0000 Original-Received: from mail1x.bc.in.sel.sony.com ([43.144.65.112]) by mail7.fw-bc.sony.com (Switch-3.4.2/Switch-3.3.2mp) with ESMTP id oB313mBp023670 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES256-SHA bits=256 verify=FAIL); Fri, 3 Dec 2010 01:03:49 GMT Original-Received: from localhost (tak-vaio-z1290-043191017095.am.sony.com [43.191.17.95]) by mail1x.bc.in.sel.sony.com (Switch-3.4.2/Switch-3.4.2) with ESMTP id oB313loE012730; Fri, 3 Dec 2010 01:03:47 GMT In-Reply-To: X-Mailer: Mew-6.3.50 on Emacs-23.2.90.1 (i386-mingw-nt6.1.7600 built on 2010-11-22) X-OriginatorOrg: am.sony.com X-detected-operating-system: by eggs.gnu.org: Windows 2000 SP2+, XP SP1+ (seldom 98) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:133331 Archived-At: Thanks Stefan. Thu, 2 Dec 2010 06:16:16 -0800: Stefan Monnier wrote: > >> > Now I am convinced. How about the change below? > >> Could you send it as a context patch? > > How about this? > > IIUC the new arg `collect' overrides `lines' in the sense that when > collect is non-nil lines is simply unused. So I suggest to just use > a single argument instead (`lines') and simply give additional semantics > to values that weren't supported until now. > E.g. if (numberp lines) then do as before, but if (consp lines) then > only keep the actual match, where (car lines) could specify which > submatch to keep. Very good point. It made the change much cleaner. > > > (list (read-regexp "List lines matching regexp" > > (car regexp-history)) > > (when current-prefix-arg > > ! (prefix-numeric-value current-prefix-arg)) > > ! (and current-prefix-arg > > ! (listp current-prefix-arg) > > ! (setq last-collect-number > > ! (read-number "Collect" last-collect-number))))) > > I recommend you first check (with regexp-opt-depth) whether there is > a submatch, and if not, don't `read-number'. It's likely to be a very > common case. Another excellent suggestion. > > > ! (if collect > > ! (with-current-buffer occur-buf > > ! (fundamental-mode) > > ! (let ((inhibit-read-only t) > > ! (buffer-undo-list t)) > > ! (erase-buffer) > > ! (while active-bufs > > ! (with-current-buffer (car active-bufs) > > ! (save-excursion > > ! (goto-char (point-min)) > > ! (while (re-search-forward regexp nil t) > > ! (let ((str (match-string collect))) > > ! (if str > > ! (with-current-buffer occur-buf > > ! (insert str) > > ! (or (zerop (current-column)) > > ! (insert "\n")))))))) > > ! (setq active-bufs (cdr active-bufs)))) > > ! (display-buffer occur-buf)) > > ! (with-current-buffer occur-buf > > ! (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* ((bufcount (length active-bufs)) > > ! (diff (- (length bufs) bufcount))) > > ! (message "Searched %d buffer%s%s; %s match%s for `%s'" > > ! bufcount (if (= bufcount 1) "" "s") > > ! (if (zerop diff) "" (format " (%d killed)" diff)) > > ! (if (zerop count) "no" (format "%d" count)) > > ! (if (= count 1) "" "es") > > ! regexp)) > > ! (setq occur-revert-arguments (list regexp nlines bufs)) > > ! (if (= count 0) > > ! (kill-buffer occur-buf) > > ! (display-buffer occur-buf) > > ! (setq next-error-last-buffer occur-buf) > > ! (setq buffer-read-only t) > > ! (set-buffer-modified-p nil) > > ! (run-hooks 'occur-hook)))))))) > > The "if collect" test should probably not be placed so far out: the > `collect' case should output the same message, run the same hooks, etc > as the non-collect case. How about this? See below. -Tak *** ../../../d/pub/emacs/emacs-23.2.90/lisp/replace.el Thu Dec 2 16:33:19 2010 --- replace.el Thu Dec 2 17:00:42 2010 *************** *** 527,532 **** --- 527,536 ---- Maximum length of the history list is determined by the value of `history-length', which see.") + (defvar occur-collect-submatch-history '("1") + "The history of list of parenthesized expression numbers as a + string in 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 *************** *** 1028,1037 **** (nreverse result)))) (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)))) (defun occur-rename-buffer (&optional unique-p interactive-p) "Rename the current *Occur* buffer to *Occur: original-buffer-name*. --- 1032,1058 ---- (nreverse result)))) (defun occur-read-primary-args () ! (let ((regexp) ! (do-collect (consp current-prefix-arg))) ! (list (setq regexp ! (read-regexp (if do-collect ! "Collect strings matching regexp" ! "List lines matching regexp") ! (car regexp-history))) ! (if do-collect ! (if (zerop (regexp-opt-depth regexp)) ! ;; no subexpression so collect entire the match ! '(0) ! ;; construct a list of subexpression integers ! (mapcar 'string-to-number ! (split-string ! (let ((default (car occur-collect-submatch-history))) ! (read-from-minibuffer ! (format "Subexpressions to collect (default %s): " default) ! "" nil nil 'occur-collect-submatch-history default) ! (car occur-collect-submatch-history))))) ! (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*. *************** *** 1064,1070 **** \\\\[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." (interactive (occur-read-primary-args)) (occur-1 regexp nlines (list (current-buffer)))) --- 1085,1101 ---- \\\\[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. ! ! When NLINES is a list of integers 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. The parenthesized match strings in REGEXP indicated by ! the integers in NLINES are collected. For example, providing ! \"defun \\(\\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." (interactive (occur-read-primary-args)) (occur-1 regexp nlines (list (current-buffer)))) *************** *** 1146,1165 **** (setq occur-buf (get-buffer-create buf-name)) (with-current-buffer occur-buf ! (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* ((bufcount (length active-bufs)) (diff (- (length bufs) bufcount))) (message "Searched %d buffer%s%s; %s match%s for `%s'" --- 1177,1226 ---- (setq occur-buf (get-buffer-create buf-name)) (with-current-buffer occur-buf ! (if (consp nlines) ! (fundamental-mode) ;; 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 ! (if (consp nlines) ! ;; nlines is a list of subexpression integers 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 mached subexpressions in a line ! (let ((first-subexp t)) ! (mapc ! (lambda (subexp) ! (let ((str (match-string subexp))) ! (if str ! (with-current-buffer occur-buf ! (if first-subexp ! (setq first-subexp nil) ! (insert " ")) ;; delimiter ! (insert str))))) ! nlines) ! (setq count (1+ count))) ! (with-current-buffer occur-buf ! (or (zerop (current-column)) ! (insert "\n")))))) ! (setq bufs (cdr bufs))) ! 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* ((bufcount (length active-bufs)) (diff (- (length bufs) bufcount))) (message "Searched %d buffer%s%s; %s match%s for `%s'"