From 20a23440dfd1a24c7eeb55f4e40817eb3fd60467 Mon Sep 17 00:00:00 2001 From: Nathaniel Nicandro Date: Fri, 31 Aug 2018 17:30:24 -0500 Subject: [PATCH 1/8] [filter] Integrate with dired-details when toggling filter group The main idea is to take advantage of `add-to-invisibility-spec` and `remove-from-invisibility-spec` when toggling the filter group instead of overwriting the invisible property. * Add the functions `dired-utils-fillin-invisible-property` and `dired-utils-remove-invisibile-property` that adds or removes a specific invisible property while preserving any current value of the invisible property according to the semantics defined in `buffer-invisibility-spec`. * Add a new header property, `dired-filter-group-invisible-property` which stores the invisible property that is used when toggling the filter group. The property is formed from the name of the group and the current `point` at which the header will be inserted. This is so that filter groups with the same name but in different subdirectories have unique invisible properties. * Combine making and inserting a group header into the function `dired-filter-group--insert-header`. Since we require the `point` of insertion for `dired-filter-group-invisible-property` it makes sense to combine the two operations instead of assuming that when `dired-filter-group--make-header` is called it is at the insertion point. * Add the function `dired-filter-group--fillin-invisible-property` to add the invisible properties for the groups when they are inserted in `dired-filter-group--apply`. * When `dired-filter-group-toggle-header` is called, add or remove the corresponding invisible property of the group header from the `buffer-invisibility-spec`. --- dired-filter.el | 77 +++++++++++++++++++++++--------------------- dired-hacks-utils.el | 41 +++++++++++++++++++++-- 2 files changed, 80 insertions(+), 38 deletions(-) diff --git a/dired-filter.el b/dired-filter.el index edc5d38..aa820dc 100644 --- a/dired-filter.el +++ b/dired-filter.el @@ -656,20 +656,35 @@ The matched lines are returned as a string." map) "Keymap used when over a group header.") -(defun dired-filter-group--make-header (name &optional collapsed) - "Make group header named by NAME. +(defun dired-filter-group--insert-header (name &optional collapsed) + "Insert a group header named by NAME. Optional argument COLLAPSED specifies if the header is collapsed by default." - (concat (propertize - (concat - " " - (propertize (format "[ %s%s ]" name (if collapsed " ..." "")) - 'font-lock-face 'dired-filter-group-header)) - 'keymap dired-filter-group-header-map - 'dired-filter-group-collapsed collapsed - 'dired-filter-group-header name) - "\n")) + (insert + (concat (propertize + (concat + " " + (propertize (format "[ %s%s ]" name (if collapsed " ..." "")) + 'font-lock-face 'dired-filter-group-header)) + 'keymap dired-filter-group-header-map + 'dired-filter-group-collapsed collapsed + 'dired-filter-group-header name + 'dired-filter-group-invisible-property + (intern (format "%s-%d" name (point)))) + "\n"))) + +(defun dired-filter-group--fillin-invisible-property (beg end) + "Fillin the invisible property for the group between BEG and END. +BEG and END are the region in which to update the invisible text +property. The line before BEG is assumed to be the group header +line." + (let ((invis (save-excursion + (goto-char beg) + (forward-line -1) + (get-text-property + (point-at-bol) 'dired-filter-group-invisible-property)))) + (dired-utils-fillin-invisible-property beg end invis))) (defun dired-filter-group--apply (filter-group) "Apply FILTER-GROUP." @@ -700,12 +715,19 @@ by default." (push (cons name group) name-group-alist)))) (--each name-group-alist (-let (((name . group) it)) - (insert (dired-filter-group--make-header name) group))) + (dired-filter-group--insert-header name) + (let ((beg (point))) + (insert group) + (dired-filter-group--fillin-invisible-property beg (point))))) (when (and (text-property-any (save-excursion (dired-next-subdir 0)) (point-max) 'font-lock-face 'dired-filter-group-header) (save-excursion (backward-char 1) (dired-hacks-next-file))) - (insert (dired-filter-group--make-header "Default"))))) + (dired-filter-group--insert-header "Default") + (let ((beg (point))) + (while (dired-utils-get-filename) + (forward-line)) + (dired-filter-group--fillin-invisible-property beg (point)))))) (setq next (ignore-errors (dired-next-subdir 1)))))) (when (featurep 'dired-details) (dired-details-delete-overlays) @@ -715,32 +737,15 @@ by default." "Collapse or expand a filter group." (interactive) (let ((inhibit-read-only t) - (name (save-excursion - (beginning-of-line) - (get-text-property (point) 'dired-filter-group-header))) - (collapsed (save-excursion - (beginning-of-line) - (get-text-property (point) 'dired-filter-group-collapsed))) - (beg (save-excursion - (forward-line 1) - (point))) - (end (save-excursion - (end-of-line) - (min (or (next-single-property-change (point) 'dired-filter-group-header) - (point-max)) - (dired-subdir-max))))) + (name (get-text-property (point-at-bol) 'dired-filter-group-header)) + (collapsed (get-text-property (point-at-bol) 'dired-filter-group-collapsed)) + (invis-prop (get-text-property (point-at-bol) 'dired-filter-group-invisible-property))) (if collapsed - (alter-text-property - beg end 'invisible - (lambda (prop) - (delete 'dired-filter-group-toggle-header (-list prop)))) - (alter-text-property - beg end 'invisible - (lambda (prop) - (cons 'dired-filter-group-toggle-header (-list prop))))) + (remove-from-invisibility-spec invis-prop) + (add-to-invisibility-spec invis-prop)) (save-excursion (-let [(beg . end) (bounds-of-thing-at-point 'line)] (delete-region beg end)) - (insert (dired-filter-group--make-header name (not collapsed)))))) + (dired-filter-group--insert-header name (not collapsed))))) (defun dired-filter-group-forward-drawer (&optional count) "Move point forward by COUNT drawers." diff --git a/dired-hacks-utils.el b/dired-hacks-utils.el index cbed262..3fe8e85 100644 --- a/dired-hacks-utils.el +++ b/dired-hacks-utils.el @@ -44,6 +44,43 @@ :group 'dired :prefix "dired-hacks-") +(defun dired-utils-fillin-invisible-property (beg end symbol) + "Put SYMBOL as the invisible text property for the region between BEG and END. + +Respect the current value of the invisible property for text in +the region." + (let ((next (next-single-property-change beg 'invisible nil end)) + (invis nil)) + (while (/= beg end) + (setq invis (get-text-property beg 'invisible)) + (cond + ((null invis) + (put-text-property beg next 'invisible symbol)) + ((and (symbolp invis) (not (eq invis symbol))) + (put-text-property beg next 'invisible (list invis symbol))) + ((and (listp invis) (not (memq symbol invis))) + (put-text-property beg next 'invisible (cons symbol invis)))) + (setq beg next + next (next-single-property-change beg 'invisible nil end))))) + +(defun dired-utils-remove-invisible-property (beg end symbol) + "Remove SYMBOL from the invisible property for the region between BEG and END. + +Respect the value of the invisible property for text in the +region." + (let ((next (next-single-property-change beg 'invisible nil end)) + (invis nil)) + (while (/= beg end) + (setq invis (get-text-property beg 'invisible)) + (cond + ((null invis)) + ((and (symbolp invis) (eq invis symbol)) + (put-text-property beg next 'invisible nil)) + ((listp invis) + (put-text-property beg next 'invisible (delq symbol invis)))) + (setq beg next + next (next-single-property-change beg 'invisible nil end))))) + (defun dired-utils-get-filename (&optional localp) "Like `dired-get-filename' but never signal an error. @@ -161,7 +198,7 @@ line." (--dotimes arg (forward-line) (while (and (or (not (dired-utils-is-file-p)) - (get-text-property (point) 'invisible)) + (invisible-p (point))) (= (forward-line) 0)))) (if (not (= (point) (point-max))) (dired-move-to-filename) @@ -181,7 +218,7 @@ line." (--dotimes arg (forward-line -1) (while (and (or (not (dired-utils-is-file-p)) - (get-text-property (point) 'invisible)) + (invisible-p (point))) (= (forward-line -1) 0)))) (if (not (= (point) (point-min))) (dired-move-to-filename) From efbd12d4c48b03b77da38a1a036acc97d5537b2e Mon Sep 17 00:00:00 2001 From: Nathaniel Nicandro Date: Sun, 9 Sep 2018 12:14:44 -0500 Subject: [PATCH 2/8] [narrow] Better handling of invisible text property * Use `dired-utils-(fillin|remove)-invisible-property` when updating the narrowed state since these preserve any invisible text properties already present. This allows us to remove the call to `dired-insert-set-properties` --- dired-narrow.el | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/dired-narrow.el b/dired-narrow.el index 290650b..3bba4ce 100644 --- a/dired-narrow.el +++ b/dired-narrow.el @@ -161,10 +161,11 @@ when `dired-narrow-exit-when-one-left' and `dired-narrow-enable-blinking' are tr (if (funcall dired-narrow-filter-function filter) (progn (setq visible-files-cnt (1+ visible-files-cnt)) - (when (fboundp 'dired-insert-set-properties) - (dired-insert-set-properties (line-beginning-position) (1+ (line-end-position))))) + (dired-utils-remove-invisible-property + (line-beginning-position) (1+ (line-end-position)) :dired-narrow)) (put-text-property (line-beginning-position) (1+ (line-end-position)) :dired-narrow t) - (put-text-property (line-beginning-position) (1+ (line-end-position)) 'invisible :dired-narrow)))) + (dired-utils-fillin-invisible-property + (line-beginning-position) (1+ (line-end-position)) :dired-narrow)))) (unless (dired-hacks-next-file) (dired-hacks-previous-file)) (unless (dired-utils-get-filename) @@ -174,11 +175,8 @@ when `dired-narrow-exit-when-one-left' and `dired-narrow-enable-blinking' are tr (defun dired-narrow--restore () "Restore the invisible files of the current buffer." (let ((inhibit-read-only t)) - (remove-list-of-text-properties (point-min) (point-max) - '(invisible :dired-narrow)) - (when (fboundp 'dired-insert-set-properties) - (dired-insert-set-properties (point-min) (point-max))))) - + (dired-utils-remove-invisible-property + (point-min) (point-max) :dired-narrow))) (defun dired-narrow--blink-current-file () (let* ((beg (line-beginning-position)) From 7f078e452caacd08ea20b3dc2921a766680daac9 Mon Sep 17 00:00:00 2001 From: Nathaniel Nicandro Date: Sun, 23 Sep 2018 19:58:30 -0500 Subject: [PATCH 3/8] [filter] Revert back to `dired-filter-group--make-header` * `dired-filter-group--make-header` now takes an additional argument to specify the invisible property for collapsing and expanding the header. This property is added as the `dired-filter-group-invisible-property` of the returned header text. --- dired-filter.el | 79 ++++++++++++++++++++++--------------------------- 1 file changed, 35 insertions(+), 44 deletions(-) diff --git a/dired-filter.el b/dired-filter.el index aa820dc..3880a72 100644 --- a/dired-filter.el +++ b/dired-filter.el @@ -656,35 +656,23 @@ The matched lines are returned as a string." map) "Keymap used when over a group header.") -(defun dired-filter-group--insert-header (name &optional collapsed) - "Insert a group header named by NAME. - -Optional argument COLLAPSED specifies if the header is collapsed -by default." - (insert - (concat (propertize - (concat - " " - (propertize (format "[ %s%s ]" name (if collapsed " ..." "")) - 'font-lock-face 'dired-filter-group-header)) - 'keymap dired-filter-group-header-map - 'dired-filter-group-collapsed collapsed - 'dired-filter-group-header name - 'dired-filter-group-invisible-property - (intern (format "%s-%d" name (point)))) - "\n"))) - -(defun dired-filter-group--fillin-invisible-property (beg end) - "Fillin the invisible property for the group between BEG and END. -BEG and END are the region in which to update the invisible text -property. The line before BEG is assumed to be the group header -line." - (let ((invis (save-excursion - (goto-char beg) - (forward-line -1) - (get-text-property - (point-at-bol) 'dired-filter-group-invisible-property)))) - (dired-utils-fillin-invisible-property beg end invis))) +(defun dired-filter-group--make-header (name symbol &optional collapsed) + "Make a group header named by NAME. + +SYMBOL is the symbol that will be added/removed to the +`buffer-invisibility-spec' to collapse the header. Optional +argument COLLAPSED specifies if the header is collapsed by +default." + (concat (propertize + (concat + " " + (propertize (format "[ %s%s ]" name (if collapsed " ..." "")) + 'font-lock-face 'dired-filter-group-header)) + 'keymap dired-filter-group-header-map + 'dired-filter-group-collapsed collapsed + 'dired-filter-group-header name + 'dired-filter-group-invisible-property symbol) + "\n")) (defun dired-filter-group--apply (filter-group) "Apply FILTER-GROUP." @@ -714,20 +702,22 @@ line." (when (/= (length group) 0) (push (cons name group) name-group-alist)))) (--each name-group-alist - (-let (((name . group) it)) - (dired-filter-group--insert-header name) + (-let* (((name . group) it) + (invis (intern (format "%s-%s" name (point))))) + (insert (dired-filter-group--make-header name invis)) (let ((beg (point))) (insert group) - (dired-filter-group--fillin-invisible-property beg (point))))) + (dired-utils-fillin-invisible-property beg (point) invis)))) (when (and (text-property-any (save-excursion (dired-next-subdir 0)) (point-max) 'font-lock-face 'dired-filter-group-header) (save-excursion (backward-char 1) (dired-hacks-next-file))) - (dired-filter-group--insert-header "Default") - (let ((beg (point))) - (while (dired-utils-get-filename) - (forward-line)) - (dired-filter-group--fillin-invisible-property beg (point)))))) + (let ((invis (intern (format "Default-%s" (point))))) + (insert (dired-filter-group--make-header "Default" invis)) + (let ((beg (point))) + (while (dired-utils-get-filename) + (forward-line)) + (dired-utils-fillin-invisible-property beg (point) invis)))))) (setq next (ignore-errors (dired-next-subdir 1)))))) (when (featurep 'dired-details) (dired-details-delete-overlays) @@ -736,16 +726,17 @@ line." (defun dired-filter-group-toggle-header () "Collapse or expand a filter group." (interactive) - (let ((inhibit-read-only t) - (name (get-text-property (point-at-bol) 'dired-filter-group-header)) - (collapsed (get-text-property (point-at-bol) 'dired-filter-group-collapsed)) - (invis-prop (get-text-property (point-at-bol) 'dired-filter-group-invisible-property))) + (let* ((inhibit-read-only t) + (pos (line-beginning-position)) + (name (get-text-property pos 'dired-filter-group-header)) + (collapsed (get-text-property pos 'dired-filter-group-collapsed)) + (invis (get-text-property pos 'dired-filter-group-invisible-property))) (if collapsed - (remove-from-invisibility-spec invis-prop) - (add-to-invisibility-spec invis-prop)) + (remove-from-invisibility-spec invis) + (add-to-invisibility-spec invis)) (save-excursion (-let [(beg . end) (bounds-of-thing-at-point 'line)] (delete-region beg end)) - (dired-filter-group--insert-header name (not collapsed))))) + (insert (dired-filter-group--make-header name (not collapsed)))))) (defun dired-filter-group-forward-drawer (&optional count) "Move point forward by COUNT drawers." From 04b32c238627dcaf293f328f1f23906889ab0ed4 Mon Sep 17 00:00:00 2001 From: Nathaniel Nicandro Date: Mon, 24 Sep 2018 14:38:06 -0500 Subject: [PATCH 4/8] [collapse] Preserve invisible property when replacing file line * Ensure that invisible text properties are updated for the line when replacing it so that we integrate with filter groups. --- dired-collapse.el | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/dired-collapse.el b/dired-collapse.el index c77ed20..1ee3e03 100644 --- a/dired-collapse.el +++ b/dired-collapse.el @@ -92,14 +92,17 @@ (defun dired-collapse--replace-file (file) "Replace file on the current line with FILE." - (delete-region (line-beginning-position) (1+ (line-end-position))) - (insert " ") - (insert-directory file dired-listing-switches nil nil) - (forward-line -1) - (dired-align-file (line-beginning-position) (1+ (line-end-position))) - (when (file-remote-p (dired-utils-get-filename)) - (while (search-forward (dired-current-directory) (line-end-position) t) - (replace-match "")))) + (let ((invis (get-text-property (save-excursion (dired-move-to-filename)) 'invisible))) + (delete-region (line-beginning-position) (1+ (line-end-position))) + (insert " ") + (insert-directory file dired-listing-switches nil nil) + (forward-line -1) + (dired-align-file (line-beginning-position) (1+ (line-end-position))) + (dired-insert-set-properties (line-beginning-position) (line-end-position)) + (dired-utils-fillin-invisible-property (line-beginning-position) (1+ (line-end-position)) invis) + (when (file-remote-p (dired-utils-get-filename)) + (while (search-forward (dired-current-directory) (line-end-position) t) + (replace-match ""))))) (defun dired-collapse--create-ov (&optional to-eol) "Create the shadow overlay which marks the collapsed path. @@ -145,7 +148,6 @@ filename (for example when the final directory is empty)." (when (string-match-p "/" path) (let ((default-directory (dired-current-directory))) (dired-collapse--replace-file path)) - (dired-insert-set-properties (line-beginning-position) (line-end-position)) (dired-collapse--create-ov (= 0 (length files))))))) (forward-line 1))))) From 7db803a1f613769c8f4bf70f17afedfd947d141a Mon Sep 17 00:00:00 2001 From: Nathaniel Nicandro Date: Mon, 24 Sep 2018 14:56:59 -0500 Subject: [PATCH 5/8] [subtree] Add filter group invisible property to subtree --- dired-subtree.el | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/dired-subtree.el b/dired-subtree.el index 75a1709..56a9dce 100644 --- a/dired-subtree.el +++ b/dired-subtree.el @@ -262,8 +262,13 @@ If no SUBTREES are specified, use `dired-subtree-overlays'." "After inserting the subtree, setup dired-details/dired-hide-details-mode." (if (fboundp 'dired-insert-set-properties) (let ((inhibit-read-only t) - (ov (dired-subtree--get-ov))) - (dired-insert-set-properties (overlay-start ov) (overlay-end ov))) + (ov (dired-subtree--get-ov)) + (invis (when (bound-and-true-p dired-filter-group-mode) + (save-excursion + (dired-filter-group-backward-drawer 1) + (get-text-property (point) 'dired-filter-group-invisible-property))))) + (dired-insert-set-properties (overlay-start ov) (overlay-end ov)) + (dired-utils-fillin-invisible-property (1- (overlay-start ov)) (overlay-end ov) invis)) (when (featurep 'dired-details) (dired-details-delete-overlays) (dired-details-activate)))) From 138bb04409fb2c6371a300abc67de3b8a3eb109d Mon Sep 17 00:00:00 2001 From: Nathaniel Nicandro Date: Mon, 24 Sep 2018 15:12:17 -0500 Subject: [PATCH 6/8] [filter] Add `dired-filter-group--invisible-symbol` This function constructs the symbol associated to a filter group for expanding and collapsing the group. --- dired-filter.el | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/dired-filter.el b/dired-filter.el index 3880a72..da40c8b 100644 --- a/dired-filter.el +++ b/dired-filter.el @@ -674,6 +674,12 @@ default." 'dired-filter-group-invisible-property symbol) "\n")) +(defun dired-filter-group--invisible-symbol (name id) + "Return a symbol for the invisible property of filter group named NAME. +ID is a unique identifier for the group to distinguish multiple +groups with the same NAME in the buffer." + (intern (format "%s-%s" name id))) + (defun dired-filter-group--apply (filter-group) "Apply FILTER-GROUP." (when (and dired-filter-group-mode @@ -703,7 +709,7 @@ default." (push (cons name group) name-group-alist)))) (--each name-group-alist (-let* (((name . group) it) - (invis (intern (format "%s-%s" name (point))))) + (invis (dired-filter-group--invisible-symbol name (point)))) (insert (dired-filter-group--make-header name invis)) (let ((beg (point))) (insert group) @@ -712,7 +718,7 @@ default." (save-excursion (dired-next-subdir 0)) (point-max) 'font-lock-face 'dired-filter-group-header) (save-excursion (backward-char 1) (dired-hacks-next-file))) - (let ((invis (intern (format "Default-%s" (point))))) + (let ((invis (dired-filter-group--invisible-symbol "Default" (point)))) (insert (dired-filter-group--make-header "Default" invis)) (let ((beg (point))) (while (dired-utils-get-filename) From 12c886abab05f5f9261e6e13a7fbf71511dd4cbf Mon Sep 17 00:00:00 2001 From: Nathaniel Nicandro Date: Tue, 26 Mar 2019 21:47:32 -0500 Subject: [PATCH 7/8] [filter] More consistent naming in `dired-filter-group--make-header` --- dired-filter.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/dired-filter.el b/dired-filter.el index da40c8b..fdb8a37 100644 --- a/dired-filter.el +++ b/dired-filter.el @@ -656,10 +656,10 @@ The matched lines are returned as a string." map) "Keymap used when over a group header.") -(defun dired-filter-group--make-header (name symbol &optional collapsed) +(defun dired-filter-group--make-header (name invis &optional collapsed) "Make a group header named by NAME. -SYMBOL is the symbol that will be added/removed to the +INVIS is the symbol that will be added/removed to the `buffer-invisibility-spec' to collapse the header. Optional argument COLLAPSED specifies if the header is collapsed by default." @@ -671,7 +671,7 @@ default." 'keymap dired-filter-group-header-map 'dired-filter-group-collapsed collapsed 'dired-filter-group-header name - 'dired-filter-group-invisible-property symbol) + 'dired-filter-group-invisible-property invis) "\n")) (defun dired-filter-group--invisible-symbol (name id) From f482c90a5545bf725120664c20c5d954d1e65018 Mon Sep 17 00:00:00 2001 From: Nathaniel Nicandro Date: Wed, 27 Mar 2019 23:21:05 -0500 Subject: [PATCH 8/8] [filter] Add missing argument to function call --- dired-filter.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dired-filter.el b/dired-filter.el index fdb8a37..86cf1b7 100644 --- a/dired-filter.el +++ b/dired-filter.el @@ -742,7 +742,7 @@ groups with the same NAME in the buffer." (add-to-invisibility-spec invis)) (save-excursion (-let [(beg . end) (bounds-of-thing-at-point 'line)] (delete-region beg end)) - (insert (dired-filter-group--make-header name (not collapsed)))))) + (insert (dired-filter-group--make-header name invis (not collapsed)))))) (defun dired-filter-group-forward-drawer (&optional count) "Move point forward by COUNT drawers."