From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Tino Calancha Newsgroups: gmane.emacs.devel Subject: Re: Ibuffer improvements: filtering, documentation, bug fix, tests Date: Thu, 15 Dec 2016 15:27:08 +0900 Message-ID: <87y3zhn1vn.fsf@gmail.com> References: <877f7zhg79.fsf@gmail.com> <87twamnx3f.fsf@gmail.com> <87r35hor1o.fsf@gmail.com> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: blaine.gmane.org 1481783385 19091 195.159.176.226 (15 Dec 2016 06:29:45 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Thu, 15 Dec 2016 06:29:45 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.50 (gnu/linux) Cc: tino.calancha@gmail.com, emacs-devel To: Christopher Genovese Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Thu Dec 15 07:29:35 2016 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cHPXq-0002xa-Pq for ged-emacs-devel@m.gmane.org; Thu, 15 Dec 2016 07:29:35 +0100 Original-Received: from localhost ([::1]:52608 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cHPXt-0006ba-C4 for ged-emacs-devel@m.gmane.org; Thu, 15 Dec 2016 01:29:37 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:55931) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cHPX4-000628-SR for emacs-devel@gnu.org; Thu, 15 Dec 2016 01:28:53 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cHPWy-000163-7W for emacs-devel@gnu.org; Thu, 15 Dec 2016 01:28:46 -0500 Original-Received: from mail-pg0-f68.google.com ([74.125.83.68]:35856) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cHPWx-0000wk-In for emacs-devel@gnu.org; Thu, 15 Dec 2016 01:28:40 -0500 Original-Received: by mail-pg0-f68.google.com with SMTP id x23so5008469pgx.3 for ; Wed, 14 Dec 2016 22:28:17 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=+nKLqDTropPUwP5oHJj042559XLeYjWInnOhpnRohNA=; b=f/AXffbLy/3Rb0Uh2arTh6JNyMxnZzLSUqsMVINhF1RB1PhqNMjpqLRsB0U0rr48vn 7mEdSOauOBlHJlj4XGyoun+LZ227smZ3VunPFw6YfyXoYyumo6BRfveBjnjsTwKcELuy PDP2Rc9T+v7PvPI1neLGUN6OSC4bE/MSqE4hTJd/fqTl74xyBiKUh3QbRVbin2XjMp+3 sFbVudK2qCjPXrMl8HyBwoRV3Rae5vb7P/Vl5Ff76OcKIgCfYiz4IEoWQZDn68Hl695O Dt7MGUiqf4iayJhFnnI0CwlNPGi+/UE4csm2wke1WUZoZEf57uzFkbEGRONKLHbxGpiQ OnBA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=+nKLqDTropPUwP5oHJj042559XLeYjWInnOhpnRohNA=; b=FKwK04EiTmDxsB8E4L2kgUEYRQwtM/BMK1Csav/dCdmxtpYwqNKwc9JjDgEunUSshf EBtaQL3PTEsX6TdBHZ+LzDvfJ7H9FDSKrUHzikkFD60NmwAO0kG/sdggA3P8wszoWez6 uKQ/ToV+CF70/c9WAET7DJz/tWxhL5UxJNMYlFFaL3xbL3aD4WAXEl0Dh26CmM0EwznY 66XVwUhjdnfNwF/HKofOJW1k/MRAW1DsFo4Lgcf2U9xCJWZ8rjcz3KSWv3dalMdEKsFl j/Qdr2WXmJ1sV/9JyAMzPYanxh4+C9/HpthrRqZ9mhmCDch+v0J+yiYl8wPWgsaTSVoD /gBQ== X-Gm-Message-State: AKaTC03zV/uj4EsFtA4txQIZDaaYoUCtytokf5NDOlVKlFLiL1xOrx8npZTQ60dtIiAuhQ== X-Received: by 10.84.209.143 with SMTP id y15mr1621121plh.96.1481783235614; Wed, 14 Dec 2016 22:27:15 -0800 (PST) Original-Received: from calancha-pc (177.192.218.133.dy.bbexcite.jp. [133.218.192.177]) by smtp.gmail.com with ESMTPSA id p64sm1157172pfi.88.2016.12.14.22.27.13 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 14 Dec 2016 22:27:14 -0800 (PST) In-Reply-To: (Christopher Genovese's message of "Wed, 14 Dec 2016 14:47:42 -0500") X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] [fuzzy] X-Received-From: 74.125.83.68 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:210471 Archived-At: Christopher Genovese writes: > I just had a chance to apply the patch, rebuild, and test. > 1. The "(ignore qualifier)" statement you added to several of the > filters causes the filters to always return nil. Removing this > ignore fixes the problem and makes the tests pass. > > But I think this is actually a new problem that was introduced > in more recent changes to ibuf-macs.el. What seems to be happening > on first look is that the filter code in define-ibuffer-filter is now wrapped > in a condition-case inside a lambda making the ignore form the body form > and thus always giving a nil result. In the versions when we started this, > the filter function was directly wrapped in a lambda so the ignore directive > you included could take effect. > > Looking in the current version of ibuf-macs.el for the definition of > define-ibuffer-filter it has > > (condition-case nil > ,@body > (error (ibuffer-pop-filter) > ...)) > > but I think this should have the spliced ,@body wrapped in a progn. > That would also solve the problem. Whether the ignore would suppress > the compiler warnings in that position as you intended, I'm not sure. Right. Thank you! I was confused for the doc string of condition-case: it calls the second argument bodyform, instead of form, so i though it's a body of lisp expressions. I have wrapped ,@body in a progn as you suggested (commit 0a5898c). Also, we don't need those (ignore qualifier) anymore because the handler of the condition-case already uses qualifier. > 2. This patch removed the additional default saved filters that I had added > ("TeX", "text document", "web"), which is fine. But one of my tests > used one of those saved filters because I had it predefined in ibuffer-saved-filters. > It's an easy change either way to fix this. Sorry for that, i didn't notice that i drop that part :-S Below is the updated patch with 1) and 2) fixed. If we don't see any more issues until next week then let's push the first part of the patch: that is without changing previous keybindings. After that, i will open a new thread to ask opinion to our colleagues about whether they agree to update the keybindings. Thank you very much. Tino ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; >From 978d08828593b3004c64a1741c042b7c37107ed4 Mon Sep 17 00:00:00 2001 From: Christopher Genovese Date: Thu, 15 Dec 2016 15:09:01 +0900 Subject: [PATCH 1/2] ibuffer: New filters and commands Add several new filters and improve documentation. See discussion on: https://lists.gnu.org/archive/html/emacs-devel/2016-11/msg00399.html * lisp/ibuf-ext.el: Add paragraph to file commentary. (ibuffer-saved-filters, ibuffer-filtering-qualifiers) (ibuffer-filter-groups): Update doc string. (ibuffer-unary-operand): Add new function that transparently handles 'not' formats for compound filters. (ibuffer-included-in-filter-p): Handle 'not' fully; update doc string. (ibuffer-included-in-filter-p-1): Handle 'and' compound filters. (ibuffer-decompose-filter): Handle 'and' as well, and handle 'not' consistently with other uses. (ibuffer-and-filter): New defun analogous to 'ibuffer-or-filter'. (ibuffer--or-and-filter): New defun. (ibuffer-or-filter, ibuffer-and-filter): Use it. (ibuffer-format-qualifier): Handle 'and' filters as well. (ibuffer-filter-by-basename, ibuffer-filter-by-file-extension) (ibuffer-filter-by-directory, ibuffer-filter-by-starred-name) (ibuffer-filter-by-modified, ibuffer-filter-by-visiting-file): Add new pre-defined filters. (ibuffer-filter-chosen-by-completion): Add new interactive command for easily choosing a filter from the descriptions. * lisp/ibuffer.el (ibuffer-mode-map): Bind ibuffer-filter-by-basename, ibuffer-filter-by-file-extension, ibuffer-filter-by-starred-name, ibuffer-filter-by-modified, ibuffer-filter-by-visiting-file to '/b', '/.', '/*', '/i', '/v' respectively; bind 'ibuffer-or-filter', 'ibuffer-and-filter', 'ibuffer-pop-filter' ,'ibuffer-pop-filter-group' and 'ibuffer-filter-disable' to '/|', '/&', '/', '/S-' and '/ DEL' respectively. * test/lisp/ibuffer-tests.el (ibuffer-autoload): Add appropriate skip specification. Add menu entries for the new filters. (ibuffer-filter-inclusion-1, ibuffer-filter-inclusion-2 ibuffer-filter-inclusion-3, ibuffer-filter-inclusion-4 ibuffer-filter-inclusion-5, ibuffer-filter-inclusion-6 ibuffer-filter-inclusion-7, ibuffer-filter-inclusion-8 ibuffer-decompose-filter, ibuffer-and-filter ibuffer-or-filter): Add new tests; they are skipped unless ibuf-ext is loaded. ; * etc/NEWS: Add entries for new user-facing features. --- etc/NEWS | 21 ++ lisp/ibuf-ext.el | 347 +++++++++++++++++------ lisp/ibuffer.el | 55 +++- test/lisp/ibuffer-tests.el | 667 ++++++++++++++++++++++++++++++++++++++++++++- 4 files changed, 1009 insertions(+), 81 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index fdd901f..d7b7431 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -333,6 +333,27 @@ bound to 'Buffer-menu-unmark-all-buffers'. ** Ibuffer --- +*** New filter commands `ibuffer-filter-by-basename', +`ibuffer-filter-by-file-extension', `ibuffer-filter-by-directory', +`ibuffer-filter-by-starred-name', `ibuffer-filter-by-modified' +and `ibuffer-filter-by-visiting-file'; bound respectively +to '/b', '/.', '//', '/*', '/i' and '/v'. + +--- +*** Two new commands 'ibuffer-filter-chosen-by-completion' +and `ibuffer-and-filter', the second bound to '/&'. + +--- +*** The commands `ibuffer-pop-filter', `ibuffer-pop-filter-group', +`ibuffer-or-filter' and `ibuffer-filter-disable' have the alternative +bindings '/', '/S-', '/|' and '/DEL', respectively. + +--- +*** The data format specifying filters has been extended to allow +explicit logical 'and', and a more flexible form for logical 'not'. +See 'ibuffer-filtering-qualifiers' doc string for full details. + +--- *** A new command 'ibuffer-copy-buffername-as-kill'; bound to 'B'. diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 9ce7b5a..7ebfecd 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -28,6 +28,13 @@ ;; These functions should be automatically loaded when called, but you ;; can explicitly (require 'ibuf-ext) in your ~/.emacs to have them ;; preloaded. +;; +;; For details on the structure of ibuffer filters and filter groups, +;; see the documentation for variables `ibuffer-filtering-qualifiers', +;; `ibuffer-filter-groups', and `ibuffer-saved-filters' in that order. +;; The variable `ibuffer-filtering-alist' contains names and +;; descriptions of the currently defined filters; also see the macro +;; `define-ibuffer-filter'. ;;; Code: @@ -139,19 +146,33 @@ ibuffer-update-saved-filters-format (fixed (mapcar fix-filter filters))) (cons old-format-detected fixed)))) -(defcustom ibuffer-saved-filters '(("gnus" +(defcustom ibuffer-saved-filters '(("programming" + (or (derived-mode . prog-mode) + (mode . ess-mode) + (mode . compilation-mode))) + ("text document" + (and (derived-mode . text-mode) + (not (starred-name)))) + ("TeX" + (or (derived-mode . tex-mode) + (mode . latex-mode) + (mode . context-mode) + (mode . ams-tex-mode) + (mode . bibtex-mode))) + ("web" + (or (derived-mode . sgml-mode) + (derived-mode . css-mode) + (mode . javascript-mode) + (mode . js2-mode) + (mode . scss-mode) + (derived-mode . haml-mode) + (mode . sass-mode))) + ("gnus" (or (mode . message-mode) (mode . mail-mode) (mode . gnus-group-mode) (mode . gnus-summary-mode) - (mode . gnus-article-mode))) - ("programming" - (or (mode . emacs-lisp-mode) - (mode . cperl-mode) - (mode . c-mode) - (mode . java-mode) - (mode . idl-mode) - (mode . lisp-mode)))) + (mode . gnus-article-mode)))) "An alist mapping saved filter names to filter specifications. @@ -214,8 +235,48 @@ ibuffer-old-saved-filters-warning ")) (defvar ibuffer-filtering-qualifiers nil - "A list like (SYMBOL . QUALIFIER) which filters the current buffer list. -See also `ibuffer-filtering-alist'.") + "A list specifying the filters currently acting on the buffer list. + +If this list is nil, then no filters are currently in +effect. Otherwise, each element of this list specifies a single +filter, and all of the specified filters in the list are applied +successively to the buffer list. + +Each filter specification can be of two types: simple or compound. + +A simple filter specification has the form (SYMBOL . QUALIFIER), +where SYMBOL is a key in the alist `ibuffer-filtering-alist' that +determines the filter function to use and QUALIFIER is the data +passed to that function (along with the buffer being considered). + +A compound filter specification can have one of four forms: + +-- (not FILTER-SPEC) + + Represents the logical complement of FILTER-SPEC, which + is any single filter specification, simple or compound. + The form (not . FILTER-SPEC) is also accepted here. + +-- (and FILTER-SPECS...) + + Represents the logical-and of the filters defined by one or + more filter specifications FILTER-SPECS..., where each + specification can be simple or compound. Note that and is + implicitly applied to the filters in the top-level list. + +-- (or FILTER-SPECS...) + + Represents the logical-or of the filters defined by one or + more filter specifications FILTER-SPECS..., where each + specification can be simple or compound. + +-- (saved . \"NAME\") + + Represents the filter saved under the string NAME + in the alist `ibuffer-saved-filters'. It is an + error to name a filter that has not been saved. + +This variable is local to each ibuffer buffer.") ;; This is now frobbed by `define-ibuffer-filter'. (defvar ibuffer-filtering-alist nil @@ -247,10 +308,18 @@ ibuffer-cached-filter-formats (defvar ibuffer-compiled-filter-formats nil) (defvar ibuffer-filter-groups nil - "A list like ((\"NAME\" ((SYMBOL . QUALIFIER) ...) ...) which groups buffers. -The SYMBOL should be one from `ibuffer-filtering-alist'. -The QUALIFIER should be the same as QUALIFIER in -`ibuffer-filtering-qualifiers'.") + "An alist giving this buffer's active filter groups, or nil if none. + +This alist maps filter group labels to filter specification +lists. Each element has the form (\"LABEL\" FILTER-SPECS...), +where FILTER-SPECS... represents one or more filter +specifications of the same form as allowed as elements of +`ibuffer-filtering-qualifiers'. + +Each filter group is displayed as a separate section in the +ibuffer list, headed by LABEL and displaying only the buffers +that pass through all the filters associated with NAME in this +list.") (defcustom ibuffer-show-empty-filter-groups t "If non-nil, then show the names of filter groups which are empty." @@ -260,20 +329,21 @@ ibuffer-show-empty-filter-groups (defcustom ibuffer-saved-filter-groups nil "An alist of filtering groups to switch between. -This variable should look like ((\"STRING\" QUALIFIERS) - (\"STRING\" QUALIFIERS) ...), where -QUALIFIERS is a list of the same form as -`ibuffer-filtering-qualifiers'. +Each element is of the form (\"NAME\" . FILTER-GROUP-LIST), +where NAME is a unique but arbitrary name and FILTER-GROUP-LIST +is a list of filter groups with the same structure as +allowed for `ibuffer-filter-groups'. -See also the variables `ibuffer-filter-groups', -`ibuffer-filtering-qualifiers', `ibuffer-filtering-alist', and the -functions `ibuffer-switch-to-saved-filter-groups', -`ibuffer-save-filter-groups'." +See also the functions `ibuffer-save-filter-groups' and +`ibuffer-switch-to-saved-filter-groups' for saving and switching +between sets of filter groups, and the variable +`ibuffer-save-with-custom' that affects how this information is +saved." :type '(repeat sexp) :group 'ibuffer) (defvar ibuffer-hidden-filter-groups nil - "A list of filtering groups which are currently hidden.") + "The list of filter groups that are currently hidden.") (defvar ibuffer-filter-group-kill-ring nil) @@ -602,18 +672,38 @@ print ;;;###autoload (defun ibuffer-included-in-filters-p (buf filters) + "Return non-nil if BUF passes all FILTERS. + +BUF is a lisp buffer object, and FILTERS is a list of filter +specifications with the same structure as +`ibuffer-filtering-qualifiers'." (not (memq nil ;; a filter will return nil if it failed - (mapcar - ;; filter should be like (TYPE . QUALIFIER), or - ;; (or (TYPE . QUALIFIER) (TYPE . QUALIFIER) ...) - #'(lambda (qual) - (ibuffer-included-in-filter-p buf qual)) - filters)))) + (mapcar #'(lambda (filter) + (ibuffer-included-in-filter-p buf filter)) + filters)))) + +(defun ibuffer-unary-operand (filter) + "Extracts operand from a unary compound FILTER specification. + +FILTER should be a cons cell of either form (f . d) or (f d), +where operand d is itself a cons cell, or nil. Returns d." + (let* ((tail (cdr filter)) + (maybe-q (car-safe tail))) + (if (consp maybe-q) maybe-q tail))) (defun ibuffer-included-in-filter-p (buf filter) + "Return non-nil if BUF pass FILTER. + +BUF is a lisp buffer object, and FILTER is a filter +specification, with the same structure as an element of the list +`ibuffer-filtering-qualifiers'." (if (eq (car filter) 'not) - (not (ibuffer-included-in-filter-p-1 buf (cdr filter))) + (let ((inner (ibuffer-unary-operand filter))) + ;; Allows (not (not ...)) etc, which may be overkill + (if (eq (car inner) 'not) + (ibuffer-included-in-filter-p buf (ibuffer-unary-operand inner)) + (not (ibuffer-included-in-filter-p-1 buf inner)))) (ibuffer-included-in-filter-p-1 buf filter))) (defun ibuffer-included-in-filter-p-1 (buf filter) @@ -621,9 +711,19 @@ ibuffer-included-in-filter-p-1 (not (pcase (car filter) (`or + ;;; ATTN: Short-circuiting alternative with parallel structure w/`and + ;;(catch 'has-match + ;; (dolist (filter-spec (cdr filter) nil) + ;; (when (ibuffer-included-in-filter-p buf filter-spec) + ;; (throw 'has-match t)))) (memq t (mapcar #'(lambda (x) - (ibuffer-included-in-filter-p buf x)) - (cdr filter)))) + (ibuffer-included-in-filter-p buf x)) + (cdr filter)))) + (`and + (catch 'no-match + (dolist (filter-spec (cdr filter) t) + (unless (ibuffer-included-in-filter-p buf filter-spec) + (throw 'no-match nil))))) (`saved (let ((data (assoc (cdr filter) ibuffer-saved-filters))) (unless data @@ -916,17 +1016,17 @@ ibuffer-pop-filter (when buf (ibuffer-jump-to-buffer (buffer-name buf))))) -(defun ibuffer-push-filter (qualifier) - "Add QUALIFIER to `ibuffer-filtering-qualifiers'." - (push qualifier ibuffer-filtering-qualifiers)) +(defun ibuffer-push-filter (filter-specification) + "Add FILTER-SPECIFICATION to `ibuffer-filtering-qualifiers'." + (push filter-specification ibuffer-filtering-qualifiers)) ;;;###autoload (defun ibuffer-decompose-filter () - "Separate the top compound filter (OR, NOT, or SAVED) in this buffer. + "Separate this buffer's top compound filter (AND, OR, NOT, or SAVED). This means that the topmost filter on the filtering stack, which must be a complex filter like (OR [name: foo] [mode: bar-mode]), will be -turned into two separate filters [name: foo] and [mode: bar-mode]." +turned into separate filters, like [name: foo] and [mode: bar-mode]." (interactive) (unless ibuffer-filtering-qualifiers (error "No filters in effect")) @@ -935,14 +1035,14 @@ ibuffer-decompose-filter (tail (cdr filters)) (value (pcase (caar filters) - (`or (nconc head tail)) + ((or `or 'and) (nconc head tail)) (`saved (let ((data (assoc head ibuffer-saved-filters))) (unless data (ibuffer-filter-disable) (error "Unknown saved filter %s" head)) (append (cdr data) tail))) - (`not (cons head tail)) + (`not (cons (ibuffer-unary-operand (car filters)) tail)) (_ (error "Filter type %s is not compound" (caar filters)))))) (setq ibuffer-filtering-qualifiers value)) @@ -971,31 +1071,36 @@ ibuffer-negate-filter ibuffer-filtering-qualifiers)) (ibuffer-update nil t)) +(defun ibuffer--or-and-filter (op decompose) + (if decompose + (if (eq op (caar ibuffer-filtering-qualifiers)) + (ibuffer-decompose-filter) + (error "Top filter is not an %s" (upcase (symbol-name op)))) + (when (< (length ibuffer-filtering-qualifiers) 2) + (error "Need two filters to %s" (upcase (symbol-name op)))) + ;; If either filter is an op, eliminate unnecessary nesting. + (let ((first (pop ibuffer-filtering-qualifiers)) + (second (pop ibuffer-filtering-qualifiers))) + (push (nconc (if (eq op (car first)) first (list op first)) + (if (eq op (car second)) (cdr second) (list second))) + ibuffer-filtering-qualifiers))) + (ibuffer-update nil t)) + ;;;###autoload -(defun ibuffer-or-filter (&optional reverse) +(defun ibuffer-or-filter (&optional decompose) "Replace the top two filters in this buffer with their logical OR. -If optional argument REVERSE is non-nil, instead break the top OR +If optional argument DECOMPOSE is non-nil, instead break the top OR filter into parts." (interactive "P") - (if reverse - (progn - (when (or (null ibuffer-filtering-qualifiers) - (not (eq 'or (caar ibuffer-filtering-qualifiers)))) - (error "Top filter is not an OR")) - (let ((lim (pop ibuffer-filtering-qualifiers))) - (setq ibuffer-filtering-qualifiers - (nconc (cdr lim) ibuffer-filtering-qualifiers)))) - (when (< (length ibuffer-filtering-qualifiers) 2) - (error "Need two filters to OR")) - ;; If the second filter is an OR, just add to it. - (let ((first (pop ibuffer-filtering-qualifiers)) - (second (pop ibuffer-filtering-qualifiers))) - (if (eq 'or (car second)) - (push (nconc (list 'or first) (cdr second)) - ibuffer-filtering-qualifiers) - (push (list 'or first second) - ibuffer-filtering-qualifiers)))) - (ibuffer-update nil t)) + (ibuffer--or-and-filter 'or decompose)) + +;;;###autoload +(defun ibuffer-and-filter (&optional decompose) + "Replace the top two filters in this buffer with their logical AND. +If optional argument DECOMPOSE is non-nil, instead break the top AND +filter into parts." + (interactive "P") + (ibuffer--or-and-filter 'and decompose)) (defun ibuffer-maybe-save-stuff () (when ibuffer-save-with-custom @@ -1069,7 +1174,9 @@ ibuffer-format-filter-group-data (defun ibuffer-format-qualifier (qualifier) (if (eq (car-safe qualifier) 'not) - (concat " [NOT" (ibuffer-format-qualifier-1 (cdr qualifier)) "]") + (concat " [NOT" + (ibuffer-format-qualifier-1 (ibuffer-unary-operand qualifier)) + "]") (ibuffer-format-qualifier-1 qualifier))) (defun ibuffer-format-qualifier-1 (qualifier) @@ -1078,14 +1185,16 @@ ibuffer-format-qualifier-1 (concat " [filter: " (cdr qualifier) "]")) (`or (concat " [OR" (mapconcat #'ibuffer-format-qualifier - (cdr qualifier) "") "]")) + (cdr qualifier) "") "]")) + (`and + (concat " [AND" (mapconcat #'ibuffer-format-qualifier + (cdr qualifier) "") "]")) (_ (let ((type (assq (car qualifier) ibuffer-filtering-alist))) (unless qualifier - (error "Ibuffer: bad qualifier %s" qualifier)) + (error "Ibuffer: bad qualifier %s" qualifier)) (concat " [" (cadr type) ": " (format "%s]" (cdr qualifier))))))) - (defun ibuffer-list-buffer-modes (&optional include-parents) "Create a completion table of buffer modes currently in use. If INCLUDE-PARENTS is non-nil then include parent modes." @@ -1103,7 +1212,7 @@ ibuffer-list-buffer-modes ;;;###autoload (autoload 'ibuffer-filter-by-mode "ibuf-ext") (define-ibuffer-filter mode - "Toggle current view to buffers with major mode QUALIFIER." + "Limit current view to buffers with major mode QUALIFIER." (:description "major mode" :reader (let* ((buf (ibuffer-current-buffer)) @@ -1123,7 +1232,7 @@ mode ;;;###autoload (autoload 'ibuffer-filter-by-used-mode "ibuf-ext") (define-ibuffer-filter used-mode - "Toggle current view to buffers with major mode QUALIFIER. + "Limit current view to buffers with major mode QUALIFIER. Called interactively, this function allows selection of modes currently used by buffers." (:description "major mode in use" @@ -1142,7 +1251,7 @@ used-mode ;;;###autoload (autoload 'ibuffer-filter-by-derived-mode "ibuf-ext") (define-ibuffer-filter derived-mode - "Toggle current view to buffers whose major mode inherits from QUALIFIER." + "Limit current view to buffers whose major mode inherits from QUALIFIER." (:description "derived mode" :reader (intern @@ -1153,22 +1262,73 @@ derived-mode ;;;###autoload (autoload 'ibuffer-filter-by-name "ibuf-ext") (define-ibuffer-filter name - "Toggle current view to buffers with name matching QUALIFIER." + "Limit current view to buffers with name matching QUALIFIER." (:description "buffer name" :reader (read-from-minibuffer "Filter by name (regexp): ")) (string-match qualifier (buffer-name buf))) +;;;###autoload (autoload 'ibuffer-filter-by-starred-name "ibuf-ext") +(define-ibuffer-filter starred-name + "Limit current view to buffers with name beginning and ending +with *, along with an optional suffix of the form digits or +." + (:description "starred buffer name" + :reader nil) + (string-match "\\`\\*[^*]+\\*\\(?:<[[:digit:]]+>\\)?\\'" (buffer-name buf))) + ;;;###autoload (autoload 'ibuffer-filter-by-filename "ibuf-ext") (define-ibuffer-filter filename - "Toggle current view to buffers with filename matching QUALIFIER." - (:description "filename" - :reader (read-from-minibuffer "Filter by filename (regexp): ")) + "Limit current view to buffers with full file name matching QUALIFIER. + +For example, for a buffer associated with file '/a/b/c.d', this +matches against '/a/b/c.d'." + (:description "full file name" + :reader (read-from-minibuffer "Filter by full file name (regexp): ")) (ibuffer-awhen (with-current-buffer buf (ibuffer-buffer-file-name)) (string-match qualifier it))) +;;;###autoload (autoload 'ibuffer-filter-by-basename "ibuf-ext") +(define-ibuffer-filter basename + "Limit current view to buffers with file basename matching QUALIFIER. + +For example, for a buffer associated with file '/a/b/c.d', this +matches against 'c.d'." + (:description "file basename" + :reader (read-from-minibuffer + "Filter by file name, without directory part (regex): ")) + (ibuffer-awhen (with-current-buffer buf (ibuffer-buffer-file-name)) + (string-match qualifier (file-name-nondirectory it)))) + +;;;###autoload (autoload 'ibuffer-filter-by-file-extension "ibuf-ext") +(define-ibuffer-filter file-extension + "Limit current view to buffers with filename extension matching QUALIFIER. + +The separator character (typically `.') is not part of the +pattern. For example, for a buffer associated with file +'/a/b/c.d', this matches against 'd'." + (:description "filename extension" + :reader (read-from-minibuffer + "Filter by filename extension without separator (regex): ")) + (ibuffer-awhen (with-current-buffer buf (ibuffer-buffer-file-name)) + (string-match qualifier (or (file-name-extension it) "")))) + +;;;###autoload (autoload 'ibuffer-filter-by-directory "ibuf-ext") +(define-ibuffer-filter directory + "Limit current view to buffers with directory matching QUALIFIER. + +For a buffer associated with file '/a/b/c.d', this matches +against '/a/b'. For a buffer not associated with a file, this +matches against the value of `default-directory' in that buffer." + (:description "directory name" + :reader (read-from-minibuffer "Filter by directory name (regex): ")) + (ibuffer-aif (with-current-buffer buf (ibuffer-buffer-file-name)) + (let ((dirname (file-name-directory it))) + (when dirname (string-match qualifier dirname))) + (when default-directory (string-match qualifier default-directory)))) + ;;;###autoload (autoload 'ibuffer-filter-by-size-gt "ibuf-ext") (define-ibuffer-filter size-gt - "Toggle current view to buffers with size greater than QUALIFIER." + "Limit current view to buffers with size greater than QUALIFIER." (:description "size greater than" :reader (string-to-number (read-from-minibuffer "Filter by size greater than: "))) @@ -1177,16 +1337,30 @@ size-gt ;;;###autoload (autoload 'ibuffer-filter-by-size-lt "ibuf-ext") (define-ibuffer-filter size-lt - "Toggle current view to buffers with size less than QUALIFIER." + "Limit current view to buffers with size less than QUALIFIER." (:description "size less than" :reader (string-to-number (read-from-minibuffer "Filter by size less than: "))) (< (with-current-buffer buf (buffer-size)) qualifier)) +;;;###autoload (autoload 'ibuffer-filter-by-modified "ibuf-ext") +(define-ibuffer-filter modified + "Limit current view to buffers that are marked as modified." + (:description "modified" + :reader nil) + (buffer-modified-p buf)) + +;;;###autoload (autoload 'ibuffer-filter-by-visiting-file "ibuf-ext") +(define-ibuffer-filter visiting-file + "Limit current view to buffers that are visiting a file." + (:description "visiting a file" + :reader nil) + (with-current-buffer buf (buffer-file-name))) + ;;;###autoload (autoload 'ibuffer-filter-by-content "ibuf-ext") (define-ibuffer-filter content - "Toggle current view to buffers whose contents match QUALIFIER." + "Limit current view to buffers whose contents match QUALIFIER." (:description "content" :reader (read-from-minibuffer "Filter by content (regexp): ")) (with-current-buffer buf @@ -1196,12 +1370,33 @@ content ;;;###autoload (autoload 'ibuffer-filter-by-predicate "ibuf-ext") (define-ibuffer-filter predicate - "Toggle current view to buffers for which QUALIFIER returns non-nil." + "Limit current view to buffers for which QUALIFIER returns non-nil." (:description "predicate" :reader (read-minibuffer "Filter by predicate (form): ")) (with-current-buffer buf (eval qualifier))) +;;;###autoload (autoload 'ibuffer-filter-chosen-by-completion "ibuf-ext") +(defun ibuffer-filter-chosen-by-completion () + "Select and apply filter chosen by completion against available filters. +Indicates corresponding key sequences in echo area after filtering. + +The completion matches against the filter description text of +each filter in `ibuffer-filtering-alist'." + (interactive) + (let* ((filters (mapcar (lambda (x) (cons (cadr x) (car x))) + ibuffer-filtering-alist)) + (match (completing-read "Filter by: " filters nil t)) + (filter (cdr (assoc match filters))) + (command (intern (concat "ibuffer-filter-by-" (symbol-name filter))))) + (call-interactively command) + (message "%s can be run with key sequences: %s" + command + (mapconcat #'key-description + (where-is-internal command ibuffer-mode-map nil t) + "or ")))) + + ;;; Sorting ;;;###autoload diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 94cee32..5a74084 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -518,26 +518,37 @@ ibuffer-mode-map (define-key map (kbd "s f") 'ibuffer-do-sort-by-filename/process) (define-key map (kbd "s m") 'ibuffer-do-sort-by-major-mode) + (define-key map (kbd "/ RET") 'ibuffer-filter-by-mode) (define-key map (kbd "/ m") 'ibuffer-filter-by-used-mode) (define-key map (kbd "/ M") 'ibuffer-filter-by-derived-mode) (define-key map (kbd "/ n") 'ibuffer-filter-by-name) - (define-key map (kbd "/ c") 'ibuffer-filter-by-content) - (define-key map (kbd "/ e") 'ibuffer-filter-by-predicate) + (define-key map (kbd "/ *") 'ibuffer-filter-by-starred-name) (define-key map (kbd "/ f") 'ibuffer-filter-by-filename) - (define-key map (kbd "/ >") 'ibuffer-filter-by-size-gt) + (define-key map (kbd "/ b") 'ibuffer-filter-by-basename) + (define-key map (kbd "/ .") 'ibuffer-filter-by-file-extension) (define-key map (kbd "/ <") 'ibuffer-filter-by-size-lt) + (define-key map (kbd "/ >") 'ibuffer-filter-by-size-gt) + (define-key map (kbd "/ i") 'ibuffer-filter-by-modified) + (define-key map (kbd "/ v") 'ibuffer-filter-by-visiting-file) + (define-key map (kbd "/ c") 'ibuffer-filter-by-content) + (define-key map (kbd "/ e") 'ibuffer-filter-by-predicate) + (define-key map (kbd "/ r") 'ibuffer-switch-to-saved-filters) (define-key map (kbd "/ a") 'ibuffer-add-saved-filters) (define-key map (kbd "/ x") 'ibuffer-delete-saved-filters) (define-key map (kbd "/ d") 'ibuffer-decompose-filter) (define-key map (kbd "/ s") 'ibuffer-save-filters) (define-key map (kbd "/ p") 'ibuffer-pop-filter) + (define-key map (kbd "/ ") 'ibuffer-pop-filter) (define-key map (kbd "/ !") 'ibuffer-negate-filter) (define-key map (kbd "/ t") 'ibuffer-exchange-filters) (define-key map (kbd "/ TAB") 'ibuffer-exchange-filters) (define-key map (kbd "/ o") 'ibuffer-or-filter) + (define-key map (kbd "/ |") 'ibuffer-or-filter) + (define-key map (kbd "/ &") 'ibuffer-and-filter) (define-key map (kbd "/ g") 'ibuffer-filters-to-filter-group) (define-key map (kbd "/ P") 'ibuffer-pop-filter-group) + (define-key map (kbd "/ S-") 'ibuffer-pop-filter-group) (define-key map (kbd "/ D") 'ibuffer-decompose-filter-group) (define-key map (kbd "/ /") 'ibuffer-filter-disable) @@ -657,13 +668,43 @@ ibuffer-mode-map ibuffer-filter-by-derived-mode)) (define-key-after map [menu-bar view filter filter-by-name] '(menu-item "Add filter by buffer name..." ibuffer-filter-by-name)) + (define-key-after map [menu-bar view filter filter-by-starred-name] + '(menu-item "Add filter by starred buffer name..." + ibuffer-filter-by-starred-name + :help "List buffers whose names begin with a star")) (define-key-after map [menu-bar view filter filter-by-filename] - '(menu-item "Add filter by filename..." ibuffer-filter-by-filename)) + '(menu-item "Add filter by full filename..." ibuffer-filter-by-filename + :help + (concat "For a buffer associated with file '/a/b/c.d', " + "list buffer if a given pattern matches '/a/b/c.d'"))) + (define-key-after map [menu-bar view filter filter-by-basename] + '(menu-item "Add filter by file basename..." + ibuffer-filter-by-basename + :help (concat "For a buffer associated with file '/a/b/c.d', " + "list buffer if a given pattern matches 'c.d'"))) + (define-key-after map [menu-bar view filter filter-by-file-extension] + '(menu-item "Add filter by file name extension..." + ibuffer-filter-by-file-extension + :help (concat "For a buffer associated with file '/a/b/c.d', " + "list buffer if a given pattern matches 'd'"))) + (define-key-after map [menu-bar view filter filter-by-directory] + '(menu-item "Add filter by filename's directory..." + ibuffer-filter-by-directory + :help + (concat "For a buffer associated with file '/a/b/c.d', " + "list buffer if a given pattern matches '/a/b'"))) (define-key-after map [menu-bar view filter filter-by-size-lt] '(menu-item "Add filter by size less than..." ibuffer-filter-by-size-lt)) (define-key-after map [menu-bar view filter filter-by-size-gt] '(menu-item "Add filter by size greater than..." ibuffer-filter-by-size-gt)) + (define-key-after map [menu-bar view filter filter-by-modified] + '(menu-item "Add filter by modified buffer" ibuffer-filter-by-modified + :help "List buffers that are marked as modified")) + (define-key-after map [menu-bar view filter filter-by-visiting-file] + '(menu-item "Add filter by buffer visiting a file" + ibuffer-filter-by-visiting-file + :help "List buffers that are visiting files")) (define-key-after map [menu-bar view filter filter-by-content] '(menu-item "Add filter by content (regexp)..." ibuffer-filter-by-content)) @@ -673,6 +714,12 @@ ibuffer-mode-map (define-key-after map [menu-bar view filter pop-filter] '(menu-item "Remove top filter" ibuffer-pop-filter :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers))) + (define-key-after map [menu-bar view filter and-filter] + '(menu-item "AND top two filters" ibuffer-and-filter + :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers + (cdr ibuffer-filtering-qualifiers)) + :help + "Create a new filter which is the logical AND of the top two filters")) (define-key-after map [menu-bar view filter or-filter] '(menu-item "OR top two filters" ibuffer-or-filter :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers diff --git a/test/lisp/ibuffer-tests.el b/test/lisp/ibuffer-tests.el index 92ed101..40760ab 100644 --- a/test/lisp/ibuffer-tests.el +++ b/test/lisp/ibuffer-tests.el @@ -24,7 +24,8 @@ (require 'ibuf-macs)) (ert-deftest ibuffer-autoload () - "Tests to see whether reftex-auc has been autoloaded" + "Tests to see whether ibuffer has been autoloaded" + (skip-unless (not (featurep 'ibuf-ext))) (should (fboundp 'ibuffer-mark-unsaved-buffers)) (should @@ -138,5 +139,669 @@ (should-not ibuffer-filtering-qualifiers)) (setq ibuffer-filtering-qualifiers filters)))) +;; Test Filter Inclusion +(let* (test-buffer-list ; accumulated buffers to clean up + ;; Utility functions without polluting the environment + (set-buffer-mode + (lambda (buffer mode) + "Set BUFFER's major mode to MODE, a mode function, or fundamental." + (with-current-buffer buffer + (funcall (or mode #'fundamental-mode))))) + (set-buffer-contents + (lambda (buffer size include-content) + "Add exactly SIZE bytes to BUFFER, including INCLUDE-CONTENT." + (when (or size include-content) + (let* ((unit "\n") + (chunk "ccccccccccccccccccccccccccccccc\n") + (chunk-size (length chunk)) + (size (if (and size include-content (stringp include-content)) + (- size (length include-content)) + size))) + (unless (or (null size) (> size 0)) + (error "size argument must be nil or positive")) + (with-current-buffer buffer + (when include-content + (insert include-content)) + (when size + (dotimes (_ (floor size chunk-size)) + (insert chunk)) + (dotimes (_ (mod size chunk-size)) + (insert unit))) + ;; prevent query on cleanup + (set-buffer-modified-p nil)))))) + (create-file-buffer + (lambda (prefix &rest args-plist) + "Create a file and buffer with designated properties. + PREFIX is a string giving the beginning of the name, and ARGS-PLIST + is a series of keyword-value pairs, with allowed keywords + :suffix STRING, :size NUMBER, :mode MODE-FUNC, :include-content STRING. + Returns the created buffer." + (let* ((suffix (plist-get args-plist :suffix)) + (size (plist-get args-plist :size)) + (include (plist-get args-plist :include-content)) + (mode (plist-get args-plist :mode)) + (file (make-temp-file prefix nil suffix)) + (buf (find-file-noselect file t))) + (push buf test-buffer-list) ; record for cleanup + (funcall set-buffer-mode buf mode) + (funcall set-buffer-contents buf size include) + buf))) + (create-non-file-buffer + (lambda (prefix &rest args-plist) + "Create a non-file and buffer with designated properties. + PREFIX is a string giving the beginning of the name, and ARGS-PLIST + is a series of keyword-value pairs, with allowed keywords + :size NUMBER, :mode MODE-FUNC, :include-content STRING. + Returns the created buffer." + (let* ((size (plist-get args-plist :size)) + (include (plist-get args-plist :include-content)) + (mode (plist-get args-plist :mode)) + (buf (generate-new-buffer prefix))) + (push buf test-buffer-list) ; record for cleanup + (funcall set-buffer-mode buf mode) + (funcall set-buffer-contents buf size include) + buf))) + (clean-up + (lambda () + "Restore all emacs state modified during the tests" + (while test-buffer-list ; created temporary buffers + (let ((buf (pop test-buffer-list))) + (with-current-buffer buf (bury-buffer)) ; ensure not selected + (kill-buffer buf)))))) + ;; Tests + (ert-deftest ibuffer-filter-inclusion-1 () + "Tests inclusion using basic filter combinators with a single buffer." + (skip-unless (featurep 'ibuf-ext)) + (unwind-protect + (let ((buf + (funcall create-file-buffer "ibuf-test-1" :size 100 + :include-content "One ring to rule them all\n"))) + (should (ibuffer-included-in-filters-p buf '((size-gt . 99)))) + (should (ibuffer-included-in-filters-p buf '((size-lt . 101)))) + (should (ibuffer-included-in-filters-p + buf '((mode . fundamental-mode)))) + (should (ibuffer-included-in-filters-p + buf '((content . "ring to rule them all")))) + (should (ibuffer-included-in-filters-p + buf '((and (content . "ring to rule them all"))))) + (should (ibuffer-included-in-filters-p + buf '((and (and (content . "ring to rule them all")))))) + (should (ibuffer-included-in-filters-p + buf '((and (and (and (content . "ring to rule them all"))))))) + (should (ibuffer-included-in-filters-p + buf '((or (content . "ring to rule them all"))))) + (should (ibuffer-included-in-filters-p + buf '((not (not (content . "ring to rule them all")))))) + (should (ibuffer-included-in-filters-p + buf '((and (size-gt . 99) + (content . "ring to rule them all") + (mode . fundamental-mode) + (basename . "\\`ibuf-test-1"))))) + (should (ibuffer-included-in-filters-p + buf '((not (or (not (size-gt . 99)) + (not (content . "ring to rule them all")) + (not (mode . fundamental-mode)) + (not (basename . "\\`ibuf-test-1"))))))) + (should (ibuffer-included-in-filters-p + buf '((and (or (size-gt . 99) (size-lt . 10)) + (and (content . "ring.*all") + (content . "rule") + (content . "them all") + (content . "One")) + (not (mode . text-mode)) + (basename . "\\`ibuf-test-1")))))) + (funcall clean-up))) + + (ert-deftest ibuffer-filter-inclusion-2 () + "Tests inclusion of basic filters in combination on a single buffer." + (skip-unless (featurep 'ibuf-ext)) + (unwind-protect + (let ((buf + (funcall create-file-buffer "ibuf-test-2" :size 200 + :mode #'text-mode + :include-content "and in the darkness find them\n"))) + (should (ibuffer-included-in-filters-p buf '((size-gt . 199)))) + (should (ibuffer-included-in-filters-p buf '((size-lt . 201)))) + (should (ibuffer-included-in-filters-p buf '((not size-gt . 200)))) + (should (ibuffer-included-in-filters-p buf '((not (size-gt . 200))))) + (should (ibuffer-included-in-filters-p + buf '((and (size-gt . 199) (size-lt . 201))))) + (should (ibuffer-included-in-filters-p + buf '((or (size-gt . 199) (size-gt . 201))))) + (should (ibuffer-included-in-filters-p + buf '((or (size-gt . 201) (size-gt . 199))))) + (should (ibuffer-included-in-filters-p + buf '((size-gt . 199) (mode . text-mode) + (content . "darkness find them")))) + (should (ibuffer-included-in-filters-p + buf '((and (size-gt . 199) (mode . text-mode) + (content . "darkness find them"))))) + (should (ibuffer-included-in-filters-p + buf '((not (or (not (size-gt . 199)) (not (mode . text-mode)) + (not (content . "darkness find them"))))))) + (should (ibuffer-included-in-filters-p + buf '((or (size-gt . 200) (content . "darkness find them") + (derived-mode . emacs-lisp-mode))))) + (should-not (ibuffer-included-in-filters-p + buf '((or (size-gt . 200) (content . "rule them all") + (derived-mode . emacs-lisp-mode)))))) + (funcall clean-up))) + + (ert-deftest ibuffer-filter-inclusion-3 () + "Tests inclusion with filename filters on specified buffers." + (skip-unless (featurep 'ibuf-ext)) + (unwind-protect + (let* ((bufA + (funcall create-file-buffer "ibuf-test-3.a" :size 50 + :mode #'text-mode + :include-content "...but a multitude of drops?\n")) + (bufB + (funcall create-non-file-buffer "ibuf-test-3.b" :size 50 + :mode #'text-mode + :include-content "...but a multitude of drops?\n")) + (dirA (with-current-buffer bufA default-directory)) + (dirB (with-current-buffer bufB default-directory))) + (should (ibuffer-included-in-filters-p + bufA '((basename . "ibuf-test-3")))) + (should (ibuffer-included-in-filters-p + bufA '((basename . "test-3\\.a")))) + (should (ibuffer-included-in-filters-p + bufA '((file-extension . "a")))) + (should (ibuffer-included-in-filters-p + bufA (list (cons 'directory dirA)))) + (should-not (ibuffer-included-in-filters-p + bufB '((basename . "ibuf-test-3")))) + (should-not (ibuffer-included-in-filters-p + bufB '((file-extension . "b")))) + (should (ibuffer-included-in-filters-p + bufB (list (cons 'directory dirB)))) + (should (ibuffer-included-in-filters-p + bufA '((name . "ibuf-test-3")))) + (should (ibuffer-included-in-filters-p + bufB '((name . "ibuf-test-3"))))) + (funcall clean-up))) + + (ert-deftest ibuffer-filter-inclusion-4 () + "Tests inclusion with various filters on a single buffer." + (skip-unless (featurep 'ibuf-ext)) + (unwind-protect + (let ((buf + (funcall create-file-buffer "ibuf-test-4" + :mode #'emacs-lisp-mode :suffix ".el" + :include-content "(message \"--%s--\" 'emacs-rocks)\n"))) + (should (ibuffer-included-in-filters-p + buf '((file-extension . "el")))) + (should (ibuffer-included-in-filters-p + buf '((derived-mode . prog-mode)))) + (should (ibuffer-included-in-filters-p + buf '((used-mode . emacs-lisp-mode)))) + (should (ibuffer-included-in-filters-p + buf '((mode . emacs-lisp-mode)))) + (with-current-buffer buf (set-buffer-modified-p t)) + (should (ibuffer-included-in-filters-p buf '((modified)))) + (with-current-buffer buf (set-buffer-modified-p nil)) + (should (ibuffer-included-in-filters-p buf '((not modified)))) + (should (ibuffer-included-in-filters-p + buf '((and (file-extension . "el") + (derived-mode . prog-mode) + (not modified))))) + (should (ibuffer-included-in-filters-p + buf '((or (file-extension . "tex") + (derived-mode . prog-mode) + (modified))))) + (should (ibuffer-included-in-filters-p + buf '((file-extension . "el") + (derived-mode . prog-mode) + (not modified))))) + (funcall clean-up))) + + (ert-deftest ibuffer-filter-inclusion-5 () + "Tests inclusion with various filters on a single buffer." + (skip-unless (featurep 'ibuf-ext)) + (unwind-protect + (let ((buf + (funcall create-non-file-buffer "ibuf-test-5.el" + :mode #'emacs-lisp-mode + :include-content + "(message \"--%s--\" \"It really does!\")\n"))) + (should-not (ibuffer-included-in-filters-p + buf '((file-extension . "el")))) + (should (ibuffer-included-in-filters-p + buf '((size-gt . 18)))) + (should (ibuffer-included-in-filters-p + buf '((predicate . (lambda () + (> (- (point-max) (point-min)) 18)))))) + (should (ibuffer-included-in-filters-p + buf '((and (mode . emacs-lisp-mode) + (or (starred-name) + (size-gt . 18)) + (and (not (size-gt . 100)) + (content . "[Ii]t *really does!") + (or (name . "test-5") + (not (filename . "test-5"))))))))) + (funcall clean-up))) + + (ert-deftest ibuffer-filter-inclusion-6 () + "Tests inclusion using saved filters and DeMorgan's laws." + (skip-unless (featurep 'ibuf-ext)) + (unwind-protect + (let ((buf + (funcall create-non-file-buffer "*ibuf-test-6*" :size 65 + :mode #'text-mode)) + (buf2 + (funcall create-file-buffer "ibuf-test-6a" :suffix ".html" + :mode #'html-mode + :include-content + "

Hello, World!

"))) + (should (ibuffer-included-in-filters-p buf '((starred-name)))) + (should-not (ibuffer-included-in-filters-p + buf '((saved . "text document")))) + (should (ibuffer-included-in-filters-p buf2 '((saved . "web")))) + (should (ibuffer-included-in-filters-p + buf2 '((not (and (not (derived-mode . sgml-mode)) + (not (derived-mode . css-mode)) + (not (mode . javascript-mode)) + (not (mode . js2-mode)) + (not (mode . scss-mode)) + (not (derived-mode . haml-mode)) + (not (mode . sass-mode))))))) + (should (ibuffer-included-in-filters-p + buf '((and (starred-name) + (or (size-gt . 50) (filename . "foo")))))) + (should (ibuffer-included-in-filters-p + buf '((not (or (not starred-name) + (and (size-lt . 51) + (not (filename . "foo"))))))))) + (funcall clean-up))) + + (ert-deftest ibuffer-filter-inclusion-7 () + "Tests inclusion with various filters on a single buffer." + (skip-unless (featurep 'ibuf-ext)) + (unwind-protect + (let ((buf + (funcall create-non-file-buffer "ibuf-test-7" + :mode #'artist-mode))) + (should (ibuffer-included-in-filters-p + buf '((not (starred-name))))) + (should (ibuffer-included-in-filters-p + buf '((not starred-name)))) + (should (ibuffer-included-in-filters-p + buf '((not (not (not starred-name)))))) + (should (ibuffer-included-in-filters-p + buf '((not (modified))))) + (should (ibuffer-included-in-filters-p + buf '((not modified)))) + (should (ibuffer-included-in-filters-p + buf '((not (not (not modified))))))) + (funcall clean-up))) + + (ert-deftest ibuffer-filter-inclusion-8 () + "Tests inclusion with various filters." + (skip-unless (featurep 'ibuf-ext)) + (unwind-protect + (let ((bufA + (funcall create-non-file-buffer "ibuf-test-8a" + :mode #'artist-mode)) + (bufB (funcall create-non-file-buffer "*ibuf-test-8b*" :size 32)) + (bufC (funcall create-file-buffer "ibuf-test8c" :suffix "*" + :size 64)) + (bufD (funcall create-file-buffer "*ibuf-test8d" :size 128)) + (bufE (funcall create-file-buffer "*ibuf-test8e" :suffix "*<2>" + :size 16)) + (bufF (and (funcall create-non-file-buffer "*ibuf-test8f*") + (funcall create-non-file-buffer "*ibuf-test8f*" + :size 8)))) + (with-current-buffer bufA (set-buffer-modified-p t)) + (should (ibuffer-included-in-filters-p + bufA '((and (not starred-name) + (modified) + (name . "test-8") + (not (size-gt . 100)) + (mode . picture-mode))))) + (with-current-buffer bufA (set-buffer-modified-p nil)) + (should-not (ibuffer-included-in-filters-p + bufA '((or (starred-name) (visiting-file) (modified))))) + (should (ibuffer-included-in-filters-p + bufB '((and (starred-name) + (name . "test.*8b") + (size-gt . 31) + (not visiting-file))))) + (should (ibuffer-included-in-filters-p + bufC '((and (not (starred-name)) + (visiting-file) + (name . "8c[^*]*\\*") + (size-lt . 65))))) + (should (ibuffer-included-in-filters-p + bufD '((and (not (starred-name)) + (visiting-file) + (name . "\\`\\*.*test8d") + (size-lt . 129) + (size-gt . 127))))) + (should (ibuffer-included-in-filters-p + bufE '((and (starred-name) + (visiting-file) + (name . "8e.*?\\*<[[:digit:]]+>") + (size-gt . 10))))) + (should (ibuffer-included-in-filters-p + bufF '((and (starred-name) + (not (visiting-file)) + (name . "8f\\*<[[:digit:]]>") + (size-lt . 10)))))) + (funcall clean-up)))) + +;; Test Filter Combination and Decomposition +(let* (ibuffer-to-kill ; if non-nil, kill this buffer at cleanup + (ibuffer-already 'check) ; existing ibuffer buffer to use but not kill + ;; Utility functions without polluting the environment + (get-test-ibuffer + (lambda () + "Returns a test ibuffer-mode buffer, creating one if necessary. + If a new buffer is created, it is named \"*Test-Ibuffer*\" and is + saved to `ibuffer-to-kill' for later cleanup." + (when (eq ibuffer-already 'check) + (setq ibuffer-already + (catch 'found-buf + (dolist (buf (buffer-list) nil) + (when (with-current-buffer buf + (derived-mode-p 'ibuffer-mode)) + (throw 'found-buf buf)))))) + (or ibuffer-already + ibuffer-to-kill + (let ((test-ibuf-name "*Test-Ibuffer*")) + (ibuffer nil test-ibuf-name nil t) + (setq ibuffer-to-kill (get-buffer test-ibuf-name)))))) + (clean-up + (lambda () + "Restore all emacs state modified during the tests" + (when ibuffer-to-kill ; created ibuffer + (with-current-buffer ibuffer-to-kill + (set-buffer-modified-p nil) + (bury-buffer)) + (kill-buffer ibuffer-to-kill) + (setq ibuffer-to-kill nil)) + (when (and ibuffer-already (not (eq ibuffer-already 'check))) + ;; restore existing ibuffer state + (ibuffer-update nil t))))) + ;; Tests + (ert-deftest ibuffer-decompose-filter () + "Tests `ibuffer-decompose-filter' for and, or, not, and saved." + (skip-unless (featurep 'ibuf-ext)) + (unwind-protect + (let ((ibuf (funcall get-test-ibuffer))) + (with-current-buffer ibuf + (let ((ibuffer-filtering-qualifiers nil) + (ibuffer-filter-groups nil) + (filters '((size-gt . 100) (not (starred-name)) + (name . "foo")))) + (progn + (push (cons 'or filters) ibuffer-filtering-qualifiers) + (ibuffer-decompose-filter) + (should (equal filters ibuffer-filtering-qualifiers)) + (setq ibuffer-filtering-qualifiers nil)) + (progn + (push (cons 'and filters) ibuffer-filtering-qualifiers) + (ibuffer-decompose-filter) + (should (equal filters ibuffer-filtering-qualifiers)) + (setq ibuffer-filtering-qualifiers nil)) + (progn + (push (list 'not (car filters)) ibuffer-filtering-qualifiers) + (ibuffer-decompose-filter) + (should (equal (list (car filters)) + ibuffer-filtering-qualifiers)) + (setq ibuffer-filtering-qualifiers nil)) + (progn + (push (cons 'not (car filters)) ibuffer-filtering-qualifiers) + (ibuffer-decompose-filter) + (should (equal (list (car filters)) + ibuffer-filtering-qualifiers)) + (setq ibuffer-filtering-qualifiers nil)) + (let ((gnus (assoc "gnus" ibuffer-saved-filters))) + (push '(saved . "gnus") ibuffer-filtering-qualifiers) + (ibuffer-decompose-filter) + (should (equal (cdr gnus) ibuffer-filtering-qualifiers)) + (ibuffer-decompose-filter) + (should (equal (cdr (cadr gnus)) ibuffer-filtering-qualifiers)) + (setq ibuffer-filtering-qualifiers nil)) + (when (not (assoc "__unknown__" ibuffer-saved-filters)) + (push '(saved . "__uknown__") ibuffer-filtering-qualifiers) + (should-error (ibuffer-decompose-filter) :type 'error) + (setq ibuffer-filtering-qualifiers nil)) + (progn + (push (car filters) ibuffer-filtering-qualifiers) + (should-error (ibuffer-decompose-filter) :type 'error) + (setq ibuffer-filtering-qualifiers nil))))) + (funcall clean-up))) + + (ert-deftest ibuffer-and-filter () + "Tests `ibuffer-and-filter' in an Ibuffer buffer." + (skip-unless (featurep 'ibuf-ext)) + (unwind-protect + (let ((ibuf (funcall get-test-ibuffer))) + (with-current-buffer ibuf + (let ((ibuffer-filtering-qualifiers nil) + (ibuffer-filter-groups nil) + (filters [(size-gt . 100) (not (starred-name)) + (filename . "A") (mode . text-mode)])) + (should-error (ibuffer-and-filter) :type 'error) + (progn + (push (aref filters 1) ibuffer-filtering-qualifiers) + (should-error (ibuffer-and-filter) :type 'error)) + (should (progn + (push (aref filters 0) ibuffer-filtering-qualifiers) + (ibuffer-and-filter) + (and (equal (list 'and (aref filters 0) (aref filters 1)) + (car ibuffer-filtering-qualifiers)) + (null (cdr ibuffer-filtering-qualifiers))))) + (should (progn + (ibuffer-and-filter 'decompose) + (and (equal (aref filters 0) + (pop ibuffer-filtering-qualifiers)) + (equal (aref filters 1) + (pop ibuffer-filtering-qualifiers)) + (null ibuffer-filtering-qualifiers)))) + (should (progn + (push (list 'and (aref filters 2) (aref filters 3)) + ibuffer-filtering-qualifiers) + (push (list 'and (aref filters 0) (aref filters 1)) + ibuffer-filtering-qualifiers) + (ibuffer-and-filter) + (and (equal (list 'and (aref filters 0) (aref filters 1) + (aref filters 2) (aref filters 3)) + (car ibuffer-filtering-qualifiers)) + (null (cdr ibuffer-filtering-qualifiers))))) + (pop ibuffer-filtering-qualifiers) + (should (progn + (push (list 'or (aref filters 2) (aref filters 3)) + ibuffer-filtering-qualifiers) + (push (list 'and (aref filters 0) (aref filters 1)) + ibuffer-filtering-qualifiers) + (ibuffer-and-filter) + (and (equal (list 'and (aref filters 0) (aref filters 1) + (list 'or (aref filters 2) + (aref filters 3))) + (car ibuffer-filtering-qualifiers)) + (null (cdr ibuffer-filtering-qualifiers))))) + (pop ibuffer-filtering-qualifiers) + (should (progn + (push (list 'and (aref filters 2) (aref filters 3)) + ibuffer-filtering-qualifiers) + (push (list 'or (aref filters 0) (aref filters 1)) + ibuffer-filtering-qualifiers) + (ibuffer-and-filter) + (and (equal (list 'and (list 'or (aref filters 0) + (aref filters 1)) + (aref filters 2) (aref filters 3)) + (car ibuffer-filtering-qualifiers)) + (null (cdr ibuffer-filtering-qualifiers))))) + (pop ibuffer-filtering-qualifiers) + (should (progn + (push (list 'or (aref filters 2) (aref filters 3)) + ibuffer-filtering-qualifiers) + (push (list 'or (aref filters 0) (aref filters 1)) + ibuffer-filtering-qualifiers) + (ibuffer-and-filter) + (and (equal (list 'and + (list 'or (aref filters 0) + (aref filters 1)) + (list 'or (aref filters 2) + (aref filters 3))) + (car ibuffer-filtering-qualifiers)) + (null (cdr ibuffer-filtering-qualifiers)))))))) + (funcall clean-up))) + + (ert-deftest ibuffer-or-filter () + "Tests `ibuffer-or-filter' in an Ibuffer buffer." + (skip-unless (featurep 'ibuf-ext)) + (unwind-protect + (let ((ibuf (funcall get-test-ibuffer))) + (with-current-buffer ibuf + (let ((ibuffer-filtering-qualifiers nil) + (ibuffer-filter-groups nil) + (filters [(size-gt . 100) (not (starred-name)) + (filename . "A") (mode . text-mode)])) + (should-error (ibuffer-or-filter) :type 'error) + (progn + (push (aref filters 1) ibuffer-filtering-qualifiers) + (should-error (ibuffer-or-filter) :type 'error)) + (should (progn + (push (aref filters 0) ibuffer-filtering-qualifiers) + (ibuffer-or-filter) + (and (equal (list 'or (aref filters 0) (aref filters 1)) + (car ibuffer-filtering-qualifiers)) + (null (cdr ibuffer-filtering-qualifiers))))) + (should (progn + (ibuffer-or-filter 'decompose) + (and (equal (aref filters 0) + (pop ibuffer-filtering-qualifiers)) + (equal (aref filters 1) + (pop ibuffer-filtering-qualifiers)) + (null ibuffer-filtering-qualifiers)))) + (should (progn + (push (list 'or (aref filters 2) (aref filters 3)) + ibuffer-filtering-qualifiers) + (push (list 'or (aref filters 0) (aref filters 1)) + ibuffer-filtering-qualifiers) + (ibuffer-or-filter) + (and (equal (list 'or (aref filters 0) (aref filters 1) + (aref filters 2) (aref filters 3)) + (car ibuffer-filtering-qualifiers)) + (null (cdr ibuffer-filtering-qualifiers))))) + (pop ibuffer-filtering-qualifiers) + (should (progn + (push (list 'and (aref filters 2) (aref filters 3)) + ibuffer-filtering-qualifiers) + (push (list 'or (aref filters 0) (aref filters 1)) + ibuffer-filtering-qualifiers) + (ibuffer-or-filter) + (and (equal (list 'or (aref filters 0) (aref filters 1) + (list 'and (aref filters 2) + (aref filters 3))) + (car ibuffer-filtering-qualifiers)) + (null (cdr ibuffer-filtering-qualifiers))))) + (pop ibuffer-filtering-qualifiers) + (should (progn + (push (list 'or (aref filters 2) (aref filters 3)) + ibuffer-filtering-qualifiers) + (push (list 'and (aref filters 0) (aref filters 1)) + ibuffer-filtering-qualifiers) + (ibuffer-or-filter) + (and (equal (list 'or (list 'and (aref filters 0) + (aref filters 1)) + (aref filters 2) (aref filters 3)) + (car ibuffer-filtering-qualifiers)) + (null (cdr ibuffer-filtering-qualifiers))))) + (pop ibuffer-filtering-qualifiers) + (should (progn + (push (list 'and (aref filters 2) (aref filters 3)) + ibuffer-filtering-qualifiers) + (push (list 'and (aref filters 0) (aref filters 1)) + ibuffer-filtering-qualifiers) + (ibuffer-or-filter) + (and (equal (list 'or + (list 'and (aref filters 0) + (aref filters 1)) + (list 'and (aref filters 2) + (aref filters 3))) + (car ibuffer-filtering-qualifiers)) + (null (cdr ibuffer-filtering-qualifiers)))))))) + (funcall clean-up)))) + +(ert-deftest ibuffer-format-qualifier () + "Tests string recommendation of filter from `ibuffer-format-qualifier'." + (skip-unless (featurep 'ibuf-ext)) + (let ((test1 '(mode . org-mode)) + (test2 '(size-lt . 100)) + (test3 '(derived-mode . prog-mode)) + (test4 '(or (size-gt . 10000) + (and (not (starred-name)) + (directory . "\\")))) + (test5 '(or (filename . "scratch") + (filename . "bonz") + (filename . "temp"))) + (test6 '(or (mode . emacs-lisp-mode) (file-extension . "elc?") + (and (starred-name) (name . "elisp")) + (mode . lisp-interaction-mode))) + (description (lambda (q) + (cadr (assq q ibuffer-filtering-alist)))) + (tag (lambda (&rest args ) + (concat " [" (apply #'concat args) "]")))) + (should (equal (ibuffer-format-qualifier test1) + (funcall tag (funcall description 'mode) + ": " "org-mode"))) + (should (equal (ibuffer-format-qualifier test2) + (funcall tag (funcall description 'size-lt) + ": " "100"))) + (should (equal (ibuffer-format-qualifier test3) + (funcall tag (funcall description 'derived-mode) + ": " "prog-mode"))) + (should (equal (ibuffer-format-qualifier test4) + (funcall tag "OR" + (funcall tag (funcall description 'size-gt) + ": " (format "%s" 10000)) + (funcall tag "AND" + (funcall tag "NOT" + (funcall tag + (funcall description + 'starred-name) + ": " "nil")) + (funcall tag + (funcall description 'directory) + ": " "\\"))))) + (should (equal (ibuffer-format-qualifier test5) + (funcall tag "OR" + (funcall tag (funcall description 'filename) + ": " "scratch") + (funcall tag (funcall description 'filename) + ": " "bonz") + (funcall tag (funcall description 'filename) + ": " "temp")))) + (should (equal (ibuffer-format-qualifier test6) + (funcall tag "OR" + (funcall tag (funcall description 'mode) + ": " "emacs-lisp-mode") + (funcall tag (funcall description 'file-extension) + ": " "elc?") + (funcall tag "AND" + (funcall tag + (funcall description 'starred-name) + ": " "nil") + (funcall tag + (funcall description 'name) + ": " "elisp")) + (funcall tag (funcall description 'mode) + ": " "lisp-interaction-mode")))))) + +(ert-deftest ibuffer-unary-operand () + "Tests `ibuffer-unary-operand': (not cell) or (not . cell) -> cell." + (skip-unless (featurep 'ibuf-ext)) + (should (equal (ibuffer-unary-operand '(not . (mode "foo"))) + '(mode "foo"))) + (should (equal (ibuffer-unary-operand '(not (mode "foo"))) + '(mode "foo"))) + (should (equal (ibuffer-unary-operand '(not "cdr")) + '("cdr"))) + (should (equal (ibuffer-unary-operand '(not)) nil)) + (should (equal (ibuffer-unary-operand '(not . a)) 'a))) + (provide 'ibuffer-tests) ;; ibuffer-tests.el ends here -- 2.10.2 >From 84859fefa1c1ef0ca5ff77657852014fa751e619 Mon Sep 17 00:00:00 2001 From: Christopher Genovese Date: Thu, 15 Dec 2016 15:09:49 +0900 Subject: [PATCH 2/2] ibuffer: Update key bindings * lisp/ibuffer.el (ibuffer-mode-map): Bind 'ibuffer-filter-by-directory' and 'ibuffer-filter-chosen-by-completion' to '//' and '/TAB' respectively. Rebind 'ibuffer-filter-disable' to '/ DEL'. ; * etc/NEWS: Update NEWS entries. --- etc/NEWS | 10 ++++++---- lisp/ibuffer.el | 5 +++-- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index d7b7431..7cfc234 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -341,12 +341,14 @@ to '/b', '/.', '//', '/*', '/i' and '/v'. --- *** Two new commands 'ibuffer-filter-chosen-by-completion' -and `ibuffer-and-filter', the second bound to '/&'. +and `ibuffer-and-filter'; bound to '/ TAB' and '/&' +respectively. --- -*** The commands `ibuffer-pop-filter', `ibuffer-pop-filter-group', -`ibuffer-or-filter' and `ibuffer-filter-disable' have the alternative -bindings '/', '/S-', '/|' and '/DEL', respectively. +*** The key binding for `ibuffer-filter-disable' has being changed +to '/DEL'; the commands `ibuffer-pop-filter', `ibuffer-pop-filter-group' +and `ibuffer-or-filter' have the alternative bindings '/', '/S-' +and '/|'. --- *** The data format specifying filters has been extended to allow diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 5a74084..db9cfeb 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -526,12 +526,14 @@ ibuffer-mode-map (define-key map (kbd "/ f") 'ibuffer-filter-by-filename) (define-key map (kbd "/ b") 'ibuffer-filter-by-basename) (define-key map (kbd "/ .") 'ibuffer-filter-by-file-extension) + (define-key map (kbd "/ /") 'ibuffer-filter-by-directory) (define-key map (kbd "/ <") 'ibuffer-filter-by-size-lt) (define-key map (kbd "/ >") 'ibuffer-filter-by-size-gt) (define-key map (kbd "/ i") 'ibuffer-filter-by-modified) (define-key map (kbd "/ v") 'ibuffer-filter-by-visiting-file) (define-key map (kbd "/ c") 'ibuffer-filter-by-content) (define-key map (kbd "/ e") 'ibuffer-filter-by-predicate) + (define-key map (kbd "/ TAB") 'ibuffer-filter-chosen-by-completion) (define-key map (kbd "/ r") 'ibuffer-switch-to-saved-filters) (define-key map (kbd "/ a") 'ibuffer-add-saved-filters) @@ -542,7 +544,6 @@ ibuffer-mode-map (define-key map (kbd "/ ") 'ibuffer-pop-filter) (define-key map (kbd "/ !") 'ibuffer-negate-filter) (define-key map (kbd "/ t") 'ibuffer-exchange-filters) - (define-key map (kbd "/ TAB") 'ibuffer-exchange-filters) (define-key map (kbd "/ o") 'ibuffer-or-filter) (define-key map (kbd "/ |") 'ibuffer-or-filter) (define-key map (kbd "/ &") 'ibuffer-and-filter) @@ -550,7 +551,7 @@ ibuffer-mode-map (define-key map (kbd "/ P") 'ibuffer-pop-filter-group) (define-key map (kbd "/ S-") 'ibuffer-pop-filter-group) (define-key map (kbd "/ D") 'ibuffer-decompose-filter-group) - (define-key map (kbd "/ /") 'ibuffer-filter-disable) + (define-key map (kbd "/ DEL") 'ibuffer-filter-disable) (define-key map (kbd "M-n") 'ibuffer-forward-filter-group) (define-key map "\t" 'ibuffer-forward-filter-group) -- 2.10.2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; In GNU Emacs 26.0.50.1 (x86_64-pc-linux-gnu, GTK+ Version 3.22.4) of 2016-12-14 Repository revision: 0a5898c3dd2e32431268bc2bcf3536d4cd62ad39