From a331e8c0820b1c1e5c45c51e26d89cd9ffad6b9d Mon Sep 17 00:00:00 2001 From: "Christopher R. Genovese" Date: Thu, 17 Nov 2016 00:44:27 -0500 Subject: [PATCH] Ibuffer improvements: filters, documentation, bug fixes, tests + Provides compound filter to support explicit logical 'and' While current and saved ibuffer filter lists offer an implicit logical 'and', it can be useful for defining complex filters and filter groups to be able to use 'and' explicitly within a filter. Although this could be achieved with DeMorgan's laws using 'or' and 'not', or saved filters, both options are unnecessarily onerous. Providing an 'and' conveniently increases filtering power at negligible cost. + Accepts 'not' compound in (not . qualifier), (not qualifier) forms The original 'not' compound filter expects the form (not . qualifier), e.g., (not size-gt . 100). This adds support, at negligible cost, for the alternative, more lispy, form like (not (size-gt . 100)) or (not (or ...)). The original looks nice with nullary filters like (not modified), and the new form is pleasantly consistent with sexp structure of 'and' and 'or'. + Significant documentation improvements for filtering The structure of compound filters had not been documented. The new documentation gives an authoritative source for each concept and makes the language used throughout more clear and consistent (e.g., distinguishing qualifier data from general filter specifications). + Defines several commonly needed filters The existing 'filename' matches against the full pathname of the buffer's file. This can be inconvenient for precisely filtering files, so several new filters are pre-defined to match particular pathname components. In addition, convenient nullary filters for starred and modified buffers are provided. + Fixes bug in `ibuffer-save-filters' The structure of `ibuffer-saved-filters' and `ibuffer-save-filter' were inconsistent, with the former having an extra list level in each alist element. This version fixes the inconsistency by simplifying `ibuffer-saved-filters' to remove the extra list level and automatically checks to repair existing formats. (Alternatively, the access code could be special-cased leaving the variable format intact. This alternative would arguably be lower impact, but the change made seemed asthetically nicer.) + Defines completion-based interactive filtering command New command to select a filter by completion on filter descriptions. Easy to use and bound to /-TAB mnemonically. + Fixes small bug in original test The one original test failed unexpectedly if ibuf-ext were loaded. + Adds a substantial number of additional tests with feature ibuf-ext Many new tests in ert, leaving the environment untouched, cover most aspects of filtering, old and new. + Makes a few mnemonic changes to default filtering part of keymap These changs are mostly quite small but distributed across several functions and docstrings. See the change log below. Change Log: 2016-11-16 Christopher R. Genovese * lisp/ibuf-ext.el: added paragraph to file commentary * lisp/ibuf-ext.el (ibuffer-saved-filters): clarified documentation, specified customization type, and simplified data format to be consistent with `ibuffer-save-filters' * lisp/ibuf-ext.el (ibuffer-update-saved-filters-format): new function that transforms `ibuffer-saved-filters'-style alist format * lisp/ibuf-ext.el (ibuffer-repair-saved-filters): new function that transforms `ibuffer-saved-filters' to new format if needed * lisp/ibuf-ext.el (ibuffer-filtering-qualifiers): new documentation is the authoritative source for filter specification format * lisp/ibuf-ext.el (ibuffer-filter-groups): new documentation clarifies filter group structure and role * lisp/ibuf-ext.el (ibuffer-unary-operand): new function transparently handles not formats for compound filters * lisp/ibuf-ext.el (ibuffer-included-in-filter-p): new docstring and now handles 'not' fully * lisp/ibuf-ext.el (ibuffer-included-in-filter-p-1): handles 'and' compound filters and consistent handling of 'saved' filter data * lisp/ibuf-ext.el (ibuffer-decompose-filter): handles 'and' as well, made handling of 'saved' filter data and 'not' consistent with other uses * lisp/ibuf-ext.el (ibuffer-and-filter): new function analogous to `ibuffer-or-filter' for completeness * lisp/ibuf-ext.el (ibuffer-maybe-save-stuff): handle 'saved' filter data consistently with other uses * lisp/ibuf-ext.el (ibuffer-format-qualifier): handle 'and' filters * lisp/ibuf-ext.el (ibuffer-filter-by-*): new pre-defined filters filename-base, filename-extension, filename-directory, filename-root, starred-name, and modified * lisp/ibuf-ext.el (ibuffer-filter-chosen-by-completion): new interactive command for easily choosing a filter * lisp/ibuf-ext.el: many small improvements throughout to docstrings, variable naming, and spacing * lisp/ibuffer.el: keymap and menu additions/changes for filtering * test/lisp/ibuffer-tests.el (ibuffer-autoload): added appropriate skip specification * test/lisp/ibuffer-tests.el (ibuffer-*): many additional tests that are skipped unless ibuf-ext is loaded. --- lisp/ibuf-ext.el | 492 +++++++++++++++++++++++++++++++-------- lisp/ibuffer.el | 67 +++++- test/lisp/ibuffer-tests.el | 565 ++++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 1021 insertions(+), 103 deletions(-) diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index b3d1452..a9b337b 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: @@ -37,7 +44,9 @@ (require 'ibuf-macs) (require 'cl-lib)) + ;;; Utility functions + (defun ibuffer-delete-alist (key alist) "Delete all entries in ALIST that have a key equal to KEY." (let (entry) @@ -119,35 +128,177 @@ Buffers whose major mode is in this list, are not searched." (defvar ibuffer-auto-buffers-changed nil) -(defcustom ibuffer-saved-filters '(("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))))) - - "An alist of filter qualifiers 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'. -See also the variables `ibuffer-filtering-qualifiers', -`ibuffer-filtering-alist', and the functions -`ibuffer-switch-to-saved-filters', `ibuffer-save-filters'." - :type '(repeat sexp) +(defun ibuffer-update-saved-filters-format (filters) + "Transforms alist from old to new `ibuffer-saved-filters' format. + +Specifically, converts old-format alist with values of the +form (STRING (FILTER-SPECS...)) to alist with values of the +form (STRING FILTER-SPECS...), where each filter spec should be a +cons cell with a symbol in the car. Any elements in the latter +form are kept as is. + +Returns (OLD-FORMAT-DETECTED? . UPDATED-SAVED-FILTERS-LIST)." + (when filters + (let* ((old-format-detected nil) + (fix-filter (lambda (filter-spec) + (if (symbolp (car (cadr filter-spec))) + filter-spec + (setq old-format-detected t) ; side-effect + (cons (car filter-spec) (cadr filter-spec))))) + (fixed (mapcar fix-filter filters))) + (cons old-format-detected fixed)))) + +(defcustom ibuffer-saved-filters '(("programming" + (or (derived-mode . prog-mode) + (mode . ess-mode) + (mode . compilation-mode))) + ("text document" + (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)))) + + "An alist mapping saved filter names to filter specifications. + +Each element should look like (\"NAME\" . FILTER-LIST), where +FILTER-LIST has the same structure as the variable +`ibuffer-filtering-qualifiers', which see. The filters defined +here are joined with an implicit logical `and' and associated +with NAME. The combined specification can be used by name in +other filter specifications via the `saved' qualifier (again, see +`ibuffer-filtering-qualifiers'). They can also be switched to by +name (see the functions `ibuffer-switch-to-saved-filters' and +`ibuffer-save-filters'). The variable `ibuffer-save-with-custom' +affects how this information is saved for future sessions. This +variable can be set directly from lisp code." + :type '(alist :key-type (string :tag "Filter name") + :value-type (repeat :tag "Filter specification" sexp)) + :set (lambda (symbol value) + ;; Just set-default but update legacy old-style format + (set-default symbol (cdr (ibuffer-update-saved-filters-format value)))) :group 'ibuffer) +(defvar ibuffer-old-saved-filters-warning + (concat "Deprecated format detected for variable `ibuffer-saved-filters'. + +The format has been repaired and the variable modified accordingly. +You can save the current value through the customize system by +either clicking or hitting return " + (make-text-button + "here" nil + 'face '(:weight bold :inherit button) + 'mouse-face '(:weight normal :background "gray50" :inherit button) + 'follow-link t + 'help-echo "Click or RET: save new value in customize" + 'action (lambda (b) + (if (not (fboundp 'customize-save-variable)) + (message "Customize not available; value not saved") + (customize-save-variable 'ibuffer-saved-filters + ibuffer-saved-filters) + (message "Saved updated ibuffer-saved-filters.")))) + ". See below for +an explanation and alternative ways to save the repaired value. + +Explanation: For the list variable `ibuffer-saved-filters', +elements of the form (STRING (FILTER-SPECS...)) are deprecated +and should instead have the form (STRING FILTER-SPECS...), where +each filter spec is a cons cell with a symbol in the car. See +`ibuffer-saved-filters' for details. The repaired value fixes +this format without changing the meaning of the saved filters. + +Alternative ways to save the repaired value: + + 1. Do M-x customize-variable and entering `ibuffer-saved-filters' + when prompted. + + 2. Set the updated value manually by copying the + following emacs-lisp form to your emacs init file. + +%s +")) + +(defun ibuffer-repair-saved-filters () + "Updates `ibuffer-saved-filters' to its new-style format, if needed. + +If this list has any elements of the old-style format, a +deprecation warning is raised, with a button allowing persistent +update. Any updated filters retain their meaning in the new +format. See `ibuffer-update-saved-filters-format' and +`ibuffer-saved-filters' for details of the old and new formats." + (when (and (boundp 'ibuffer-saved-filters) ibuffer-saved-filters) + (let ((fixed (ibuffer-update-saved-filters-format ibuffer-saved-filters))) + (prog1 + (setq ibuffer-saved-filters (cdr fixed)) + (when-let (old-format-detected? (car fixed)) + (let ((warning-series t) + (updated-form + (with-output-to-string + (pp `(setq ibuffer-saved-filters ',ibuffer-saved-filters))))) + (display-warning + 'ibuffer + (format ibuffer-old-saved-filters-warning updated-form)))))))) + (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 @@ -179,10 +330,18 @@ to this variable." (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." @@ -192,20 +351,21 @@ The QUALIFIER should be the same as QUALIFIER in (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) @@ -512,18 +672,38 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'." ;;;###autoload (defun ibuffer-included-in-filters-p (buf filters) + "Does the buffer BUF successfully pass all of the given 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) + "Does the buffer BUF successfully 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))) + ;; ATTN: Allows (not (not ...)) etc. Is fixing this worthwhile? + (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) @@ -531,17 +711,25 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'." (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 - (ibuffer-filter-disable t) - (error "Unknown saved filter %s" (cdr filter))) - (ibuffer-included-in-filters-p buf (cadr data)))) + (let ((data (assoc (cdr filter) ibuffer-saved-filters))) + (unless data + (ibuffer-filter-disable t) + (error "Unknown saved filter %s" (cdr filter))) + (ibuffer-included-in-filters-p buf (cdr data)))) (_ (pcase-let ((`(,_type ,_desc ,func) (assq (car filter) ibuffer-filtering-alist))) @@ -828,39 +1016,36 @@ group definitions by setting `ibuffer-filter-groups' to nil." (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) (when (null ibuffer-filtering-qualifiers) (error "No filters in effect")) (let ((lim (pop ibuffer-filtering-qualifiers))) (pcase (car lim) - (`or + ((or 'or 'and) (setq ibuffer-filtering-qualifiers (append - (cdr lim) - ibuffer-filtering-qualifiers))) + (cdr lim) + ibuffer-filtering-qualifiers))) (`saved - (let ((data - (assoc (cdr lim) - ibuffer-saved-filters))) - (unless data - (ibuffer-filter-disable) - (error "Unknown saved filter %s" (cdr lim))) - (setq ibuffer-filtering-qualifiers (append - (cadr data) - ibuffer-filtering-qualifiers)))) + (let ((data (assoc (cdr lim) ibuffer-saved-filters))) + (unless data + (ibuffer-filter-disable) + (error "Unknown saved filter %s" (cdr lim))) + (setq ibuffer-filtering-qualifiers (append + (cdr data) + ibuffer-filtering-qualifiers)))) (`not - (push (cdr lim) - ibuffer-filtering-qualifiers)) + (push (ibuffer-unary-operand lim) ibuffer-filtering-qualifiers)) (_ (error "Filter type %s is not compound" (car lim))))) (ibuffer-update nil t)) @@ -892,12 +1077,12 @@ turned into two separate filters [name: foo] and [mode: bar-mode]." (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 + (if decompose (progn (when (or (null ibuffer-filtering-qualifiers) (not (eq 'or (caar ibuffer-filtering-qualifiers)))) @@ -917,6 +1102,32 @@ filter into parts." ibuffer-filtering-qualifiers)))) (ibuffer-update nil t)) +;;;###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") + (if decompose + (progn + (when (or (null ibuffer-filtering-qualifiers) + (not (eq 'and (caar ibuffer-filtering-qualifiers)))) + (error "Top filter is not an AND")) + (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 AND")) + ;; If the second filter is an AND, just add to it. + (let ((first (pop ibuffer-filtering-qualifiers)) + (second (pop ibuffer-filtering-qualifiers))) + (if (eq 'and (car second)) + (push (nconc (list 'and first) (cdr second)) + ibuffer-filtering-qualifiers) + (push (list 'and first second) + ibuffer-filtering-qualifiers)))) + (ibuffer-update nil t)) + (defun ibuffer-maybe-save-stuff () (when ibuffer-save-with-custom (if (fboundp 'customize-save-variable) @@ -939,7 +1150,7 @@ Interactively, prompt for NAME, and use the current filters." ibuffer-filtering-qualifiers))) (ibuffer-aif (assoc name ibuffer-saved-filters) (setcdr it filters) - (push (list name filters) ibuffer-saved-filters)) + (push (cons name filters) ibuffer-saved-filters)) (ibuffer-maybe-save-stuff)) ;;;###autoload @@ -989,7 +1200,9 @@ Interactively, prompt for NAME, and use the current filters." (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) @@ -998,14 +1211,16 @@ Interactively, prompt for NAME, and use the current filters." (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." @@ -1023,7 +1238,7 @@ If INCLUDE-PARENTS is non-nil then include parent 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)) @@ -1043,7 +1258,7 @@ If INCLUDE-PARENTS is non-nil then include parent modes." ;;;###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" @@ -1062,7 +1277,7 @@ currently used by buffers." ;;;###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 @@ -1073,22 +1288,83 @@ currently used by buffers." ;;;###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 with *." + (:description "starred buffer name" + :reader nil) + (string-match "\\`*" (buffer-name buf))) + +;; This should probably be called pathname but kept for backward compatibility ;;;###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): ")) +(define-ibuffer-filter filename + "Limit current view to buffers with full file pathname matching QUALIFIER. + +For example, for a buffer associated with file '/a/b/c.d', this +matches against '/a/b/c.d'." + (:description "file pathname" + :reader (read-from-minibuffer "Filter by file pathname (regexp): ")) (ibuffer-awhen (with-current-buffer buf (ibuffer-buffer-file-name)) (string-match qualifier it))) +;; If filename above were renamed to pathname, this could be called filename. +;;;###autoload (autoload 'ibuffer-filter-by-filename-base "ibuf-ext") +(define-ibuffer-filter filename-base + "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-filename-extension "ibuf-ext") +(define-ibuffer-filter filename-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-filename-root "ibuf-ext") +(define-ibuffer-filter filename-root + "Limit current view to buffers with file basename matching QUALIFIER. + +The filename root is the part of the full pathname of the file without +the directory or extension/suffix components. For example, for a buffer +associated with file '/a/b/c.d', this matches against 'c'." + (:description "filename root" + :reader (read-from-minibuffer "Filter by filename root (regex): ")) + (ibuffer-awhen (with-current-buffer buf (ibuffer-buffer-file-name)) + (string-match qualifier (file-name-base it)))) + +;;;###autoload (autoload 'ibuffer-filter-by-filename-directory "ibuf-ext") +(define-ibuffer-filter filename-directory + "Limit current view to buffers with filename directory matching QUALIFIER. + +For example, for a buffer associated with file '/a/b/c.d', this +matches against '/a/b'." + (:description "directory name" + :reader (read-from-minibuffer "Filter by directory name (regex): ")) + (ibuffer-awhen (with-current-buffer buf (ibuffer-buffer-file-name)) + (let ((dirname (file-name-directory it))) + (when dirname (string-match qualifier dirname))))) + ;;;###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: "))) @@ -1097,16 +1373,23 @@ currently used by buffers." ;;;###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-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 @@ -1116,12 +1399,33 @@ currently used by buffers." ;;;###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 b33c2e3..181a01c 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -518,28 +518,40 @@ directory, like `default-directory'." (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 "/ F") 'ibuffer-filter-by-filename-base) + (define-key map (kbd "/ .") 'ibuffer-filter-by-filename-extension) + (define-key map (kbd "/ r") 'ibuffer-filter-by-filename-root) + (define-key map (kbd "/ /") 'ibuffer-filter-by-filename-directory) (define-key map (kbd "/ <") 'ibuffer-filter-by-size-lt) - (define-key map (kbd "/ r") 'ibuffer-switch-to-saved-filters) + (define-key map (kbd "/ >") 'ibuffer-filter-by-size-gt) + (define-key map (kbd "/ i") 'ibuffer-filter-by-modified) + (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 "/ w") '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) + (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) @@ -647,29 +659,62 @@ directory, like `default-directory'." (define-key-after map [menu-bar view filter filter-disable] '(menu-item "Disable all filtering" ibuffer-filter-disable :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers))) + (define-key-after map [menu-bar view filter filter-by-mode] '(menu-item "Add filter by any major mode..." ibuffer-filter-by-mode)) (define-key-after map [menu-bar view filter filter-by-used-mode] '(menu-item "Add filter by a major mode in use..." ibuffer-filter-by-used-mode)) (define-key-after map [menu-bar view filter filter-by-derived-mode] - '(menu-item "Add filter by derived mode..." + '(menu-item "Add filter by derived mode..." 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 pathname..." 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-filename-base] + '(menu-item "Add filter by file basename..." + ibuffer-filter-by-filename-base + :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-filename-extension] + '(menu-item "Add filter by filename extension..." + ibuffer-filter-by-filename-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-filename-root] + '(menu-item "Add filter by filename root..." + ibuffer-filter-by-filename-root + :help (concat "For a buffer associated with file '/a/b/c.d', " + "list buffer if a given pattern matches 'c'"))) + (define-key-after map [menu-bar view filter filter-by-filename-directory] + '(menu-item "Add filter by filename's directory..." + ibuffer-filter-by-filename-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-content] '(menu-item "Add filter by content (regexp)..." ibuffer-filter-by-content)) (define-key-after map [menu-bar view filter filter-by-predicate] '(menu-item "Add filter by Lisp predicate..." ibuffer-filter-by-predicate)) + (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))) @@ -682,6 +727,12 @@ directory, like `default-directory'." (define-key-after map [menu-bar view filter negate-filter] '(menu-item "Negate top filter" ibuffer-negate-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 decompose-filter] '(menu-item "Decompose top filter" ibuffer-decompose-filter :enable (and (featurep 'ibuf-ext) diff --git a/test/lisp/ibuffer-tests.el b/test/lisp/ibuffer-tests.el index de281c0..aa06994 100644 --- a/test/lisp/ibuffer-tests.el +++ b/test/lisp/ibuffer-tests.el @@ -22,7 +22,8 @@ (require 'ibuffer) (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 @@ -30,5 +31,567 @@ (symbol-function 'ibuffer-mark-unsaved-buffers)))) +;; 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 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) + (filename-base . "\\`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 (filename-base . "\\`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)) + (filename-base . "\\`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"))) + (message "--> %s" buf) + (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))))) + (message "--> %s" buf)) + (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 '((filename-base . "ibuf-test-3")))) + (should (ibuffer-included-in-filters-p + bufA '((filename-root . "ibuf-test-3")))) + (should (ibuffer-included-in-filters-p + bufA '((filename-base . "test-3\\.a")))) + (should (ibuffer-included-in-filters-p + bufA '((filename-extension . "a")))) + (should (ibuffer-included-in-filters-p + bufA (list (cons 'filename-directory dirA)))) + (should-not (ibuffer-included-in-filters-p + bufB '((filename-base . "ibuf-test-3")))) + (should-not (ibuffer-included-in-filters-p + bufB '((filename-root . "ibuf-test-3")))) + (should-not (ibuffer-included-in-filters-p + bufB '((filename-extension . "b")))) + (should-not (ibuffer-included-in-filters-p + bufB (list (cons 'filename-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 '((filename-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 (filename-extension . "el") + (derived-mode . prog-mode) + (not modified))))) + (should (ibuffer-included-in-filters-p + buf '((or (filename-extension . "tex") + (derived-mode . prog-mode) + (modified))))) + (should (ibuffer-included-in-filters-p + buf '((filename-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 '((filename-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 on a single buffer." + (skip-unless (featurep 'ibuf-ext)) + (unwind-protect + (let ((buf + (funcall create-non-file-buffer "ibuf-test-8" + :mode #'artist-mode))) + (should (ibuffer-included-in-filters-p + buf '((and (not (starred-name)) + (name . "test-8") + (not (size-gt . 100)) + (mode . picture-mode)))))) + (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))])) + (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))))))) + (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))])) + (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))))))) + (funcall clean-up)))) + +(ert-deftest ibuffer-save-filters () + "Tests that `ibuffer-save-filters' saves in the proper format." + (skip-unless (featurep 'ibuf-ext)) + (let ((ibuffer-save-with-custom nil) + (ibuffer-saved-filters nil) + (test1 '((mode . org-mode) + (or (size-gt . 10000) + (and (not (starred-name)) + (filename-directory . "\"))))) + (test2 '((or (mode . emacs-lisp-mode) (filename-extension . "elc?") + (and (starred-name) (name . "elisp")) + (mode . lisp-interaction-mode)))) + (test3 '((size-lt . 100) (derived-mode . prog-mode) + (or (filename-root . "scratch") + (filename-root . "bonz") + (filename-root . "temp"))))) + (ibuffer-save-filters "test1" test1) + (should (equal (car ibuffer-saved-filters) (cons "test1" test1))) + (ibuffer-save-filters "test2" test2) + (should (equal (car ibuffer-saved-filters) (cons "test2" test2))) + (should (equal (cadr ibuffer-saved-filters) (cons "test1" test1))) + (ibuffer-save-filters "test3" test3) + (should (equal (car ibuffer-saved-filters) (cons "test3" test3))) + (should (equal (cadr ibuffer-saved-filters) (cons "test2" test2))) + (should (equal (car (cddr ibuffer-saved-filters)) (cons "test1" test1))) + (should (equal (cdr (assoc "test1" ibuffer-saved-filters)) test1)) + (should (equal (cdr (assoc "test2" ibuffer-saved-filters)) test2)) + (should (equal (cdr (assoc "test3" ibuffer-saved-filters)) test3)))) + +(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)) + (filename-directory . "\\")))) + (test5 '(or (filename-root . "scratch") + (filename-root . "bonz") + (filename-root . "temp"))) + (test6 '(or (mode . emacs-lisp-mode) (filename-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 'filename-directory) + ": " "\\"))))) + (should (equal (ibuffer-format-qualifier test5) + (funcall tag "OR" + (funcall tag (funcall description 'filename-root) + ": " "scratch") + (funcall tag (funcall description 'filename-root) + ": " "bonz") + (funcall tag (funcall description 'filename-root) + ": " "temp")))) + (should (equal (ibuffer-format-qualifier test6) + (funcall tag "OR" + (funcall tag (funcall description 'mode) + ": " "emacs-lisp-mode") + (funcall tag (funcall description 'filename-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.0