* bug#21973: 24.5; feature proposal: make dired header clickable
@ 2015-11-21 20:03 William Xu
2021-10-23 0:00 ` Stefan Kangas
0 siblings, 1 reply; 9+ messages in thread
From: William Xu @ 2015-11-21 20:03 UTC (permalink / raw)
To: 21973
[-- Attachment #1: Type: text/plain, Size: 2318 bytes --]
Sometimes when we are in some deep directory, it would be really
convenient to be able to jump to an arbitrary parent directory shown by
dired header. e.g., a dired header line may be:
/this/is/a/really/long/project/dir/curr:
If i want to open dired with `/this/is/a/really', i could simply click
at `really', without having to `^' a few times carefully.
I have something like below in my config file. But it should be easy to
integrate it with `dired-insert-directory' in dired.el.
---------------------------------8<-------------------------------------
(defun xwl-dired-jump-to-parent (event)
(interactive "e")
(let (window pos file)
(save-excursion
(setq window (posn-window (event-end event))
pos (posn-point (event-end event)))
(with-current-buffer (window-buffer window)
(goto-char pos)
(when (search-forward "/" (line-end-position) t 1)
(let ((beg 3)
(end (point)))
(dired (buffer-substring beg end))))))))
(defun xwl-dired-make-header-jumpable ()
"Click on dired header will jump to that directory directly."
(let ((inhibit-read-only t))
(save-excursion
(goto-char (point-min))
(let ((bound (line-end-position))
start end)
(when (search-forward "/" bound t 1)
(setq start (point))
(while (search-forward "/" bound t 1)
(setq end (1- (point)))
(add-text-properties start end
`(mouse-face
highlight
help-echo "mouse-1: goto here"
keymap ,(let ((map (make-sparse-keymap)))
(define-key map [down-mouse-1]
'xwl-dired-jump-to-parent)
map)))
(setq start (point))))))))
(add-hook 'dired-after-readin-hook 'xwl-dired-make-header-jumpable)
---------------------------------8<-------------------------------------
In GNU Emacs 24.5.2 (x86_64-apple-darwin14.5.0, Carbon Version 157 AppKit
1404.13)
of 2015-11-08 on ULMMAC029
Repository revision: 232183c1fbb3665a51cfb1e9dbd380127bb4a971
Windowing system distributor `Apple Inc.', version 10.11.1
Configured using:
`configure --with-mac'
- William
[-- Attachment #2: Type: text/html, Size: 3278 bytes --]
^ permalink raw reply [flat|nested] 9+ messages in thread* bug#21973: 24.5; feature proposal: make dired header clickable
2015-11-21 20:03 bug#21973: 24.5; feature proposal: make dired header clickable William Xu
@ 2021-10-23 0:00 ` Stefan Kangas
2021-10-23 15:45 ` William Xu
0 siblings, 1 reply; 9+ messages in thread
From: Stefan Kangas @ 2021-10-23 0:00 UTC (permalink / raw)
To: William Xu; +Cc: 21973
William Xu <william.xwl@gmail.com> writes:
> Sometimes when we are in some deep directory, it would be really
> convenient to be able to jump to an arbitrary parent directory shown by
> dired header. e.g., a dired header line may be:
>
> /this/is/a/really/long/project/dir/curr:
>
> If i want to open dired with `/this/is/a/really', i could simply click
> at `really', without having to `^' a few times carefully.
>
> I have something like below in my config file. But it should be easy to
> integrate it with `dired-insert-directory' in dired.el.
I didn't read your patch in detail, but the feature sounds like a good
idea. Could you perhaps write it up as a patch?
> ---------------------------------8<-------------------------------------
> (defun xwl-dired-jump-to-parent (event)
> (interactive "e")
> (let (window pos file)
> (save-excursion
> (setq window (posn-window (event-end event))
> pos (posn-point (event-end event)))
> (with-current-buffer (window-buffer window)
> (goto-char pos)
> (when (search-forward "/" (line-end-position) t 1)
> (let ((beg 3)
> (end (point)))
> (dired (buffer-substring beg end))))))))
>
> (defun xwl-dired-make-header-jumpable ()
> "Click on dired header will jump to that directory directly."
> (let ((inhibit-read-only t))
> (save-excursion
> (goto-char (point-min))
> (let ((bound (line-end-position))
> start end)
> (when (search-forward "/" bound t 1)
> (setq start (point))
> (while (search-forward "/" bound t 1)
> (setq end (1- (point)))
> (add-text-properties start end
> `(mouse-face
> highlight
> help-echo "mouse-1: goto here"
> keymap ,(let ((map (make-sparse-keymap)))
> (define-key map [down-mouse-1] 'xwl-dired-jump-to-parent)
> map)))
> (setq start (point))))))))
>
> (add-hook 'dired-after-readin-hook 'xwl-dired-make-header-jumpable)
> ---------------------------------8<-------------------------------------
^ permalink raw reply [flat|nested] 9+ messages in thread
* bug#21973: 24.5; feature proposal: make dired header clickable
2021-10-23 0:00 ` Stefan Kangas
@ 2021-10-23 15:45 ` William Xu
2021-10-23 16:37 ` bug#21973: [External] : " Drew Adams
0 siblings, 1 reply; 9+ messages in thread
From: William Xu @ 2021-10-23 15:45 UTC (permalink / raw)
To: 21973
[-- Attachment #1: Type: text/plain, Size: 188 bytes --]
Stefan Kangas <stefan@marxist.se> writes:
> I didn't read your patch in detail, but the feature sounds like a good
> idea. Could you perhaps write it up as a patch?
Done.
--
William
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Make-Dired-path-segments-jumpable-by-mouse-click-bug.patch --]
[-- Type: text/x-diff, Size: 2909 bytes --]
From 7a6ddf62541b65876cbc210fe7e49197ab8908a3 Mon Sep 17 00:00:00 2001
From: William Xu <william.xwl@gmail.com>
Date: Sat, 23 Oct 2021 17:07:21 +0200
Subject: [PATCH] Make Dired path segments jumpable by mouse click (bug#21973)
* lisp/dired.el (dired-readin): Call dired-make-path-jumpable.
(dired-make-path-jumpable, dired-jump-to-path-segment): New functions.
---
lisp/dired.el | 40 +++++++++++++++++++++++++++++++++++++++-
1 file changed, 39 insertions(+), 1 deletion(-)
diff --git a/lisp/dired.el b/lisp/dired.el
index 4652589122..ba9fa21f89 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1317,10 +1317,11 @@ dired-readin
(erase-buffer)
(dired-readin-insert))
(goto-char (point-min))
- ;; Must first make alist buffer local and set it to nil because
+ ;; Must first make alist buffer local and set it to nil because
;; dired-build-subdir-alist will call dired-clear-alist first
(setq-local dired-subdir-alist nil)
(dired-build-subdir-alist))
+ (dired-make-path-jumpable)
(let ((attributes (file-attributes dirname)))
(if (eq (car attributes) t)
(set-visited-file-modtime (file-attribute-modification-time
@@ -1643,6 +1644,43 @@ dired-insert-set-properties
'invisible 'dired-hide-details-link))))
(forward-line 1))))
+(defun dired-make-path-jumpable ()
+ "Make dired path line at top jumpable."
+ (let ((inhibit-read-only t))
+ (save-excursion
+ (goto-char (point-min))
+ (let ((bound (line-end-position))
+ segment-start segment-end)
+ (when (search-forward "/" bound t 1)
+ (setq segment-start (point))
+ (while (search-forward "/" bound t 1)
+ (setq segment-end (1- (point)))
+ (add-text-properties segment-start segment-end
+ `(mouse-face
+ highlight
+ help-echo "mouse-1: goto here"
+ keymap ,(let ((map (make-sparse-keymap)))
+ (define-key map [down-mouse-1] 'dired-jump-to-path-segment)
+ map)))
+ (setq segment-start (point))))))))
+
+(defun dired-jump-to-path-segment (event)
+ "Jump to the directory from a segment of the dired path."
+ (interactive "e")
+ (let* ((ev (event-end event))
+ (window (posn-window ev))
+ (pos (posn-point ev)))
+ (with-current-buffer (window-buffer window)
+ (save-excursion
+ (goto-char pos)
+ (when (search-forward "/" (line-end-position) t 1)
+ (let ((end (point))
+ beg)
+ (while (search-backward "/" (line-beginning-position) t 1)
+ (setq beg (point)))
+ (when beg
+ (dired (buffer-substring-no-properties beg end)))))))))
+
\f
;;; Reverting a dired buffer
--
2.25.1
^ permalink raw reply related [flat|nested] 9+ messages in thread* bug#21973: [External] : bug#21973: 24.5; feature proposal: make dired header clickable
2021-10-23 15:45 ` William Xu
@ 2021-10-23 16:37 ` Drew Adams
2021-10-24 11:09 ` William Xu
0 siblings, 1 reply; 9+ messages in thread
From: Drew Adams @ 2021-10-23 16:37 UTC (permalink / raw)
To: William Xu, 21973@debbugs.gnu.org
Looked at this only quickly.
+1. It's a good idea to make dir-listing headers
into, essentially, clickable/RETable breadcrumbs.
I can't speak to whether the patch sent is the
best/right way to do it - don't have time now to
look into it.
But this should be done (maybe optionally, i.e.,
under user control) for each dir header in the
buffer. That is, do it for inserted subdir
headers, as well as for the first (top-level)
dir header.
^ permalink raw reply [flat|nested] 9+ messages in thread
* bug#21973: [External] : bug#21973: 24.5; feature proposal: make dired header clickable
2021-10-23 16:37 ` bug#21973: [External] : " Drew Adams
@ 2021-10-24 11:09 ` William Xu
2021-10-24 14:07 ` Lars Ingebrigtsen
2021-10-24 21:31 ` Drew Adams
0 siblings, 2 replies; 9+ messages in thread
From: William Xu @ 2021-10-24 11:09 UTC (permalink / raw)
To: 21973
[-- Attachment #1: Type: text/plain, Size: 624 bytes --]
Drew Adams <drew.adams@oracle.com> writes:
> Looked at this only quickly.
>
> +1. It's a good idea to make dir-listing headers
> into, essentially, clickable/RETable breadcrumbs.
>
> I can't speak to whether the patch sent is the
> best/right way to do it - don't have time now to
> look into it.
>
> But this should be done (maybe optionally, i.e.,
> under user control) for each dir header in the
> buffer. That is, do it for inserted subdir
> headers, as well as for the first (top-level)
> dir header.
I've revised the patch to support also subdir headers in the buffer,
using dired-after-readin-hook.
--
William
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Make-Dired-path-segments-jumpable-by-mouse-click-bug.patch --]
[-- Type: text/x-diff, Size: 2832 bytes --]
From cdae3738782a356dda632d1b78d5f5b45bdc89a0 Mon Sep 17 00:00:00 2001
From: William Xu <william.xwl@gmail.com>
Date: Sun, 24 Oct 2021 13:03:54 +0200
Subject: [PATCH] Make Dired path segments jumpable by mouse click (bug#21973)
* lisp/dired.el (dired-readin): Call dired-make-path-jumpable.
(dired-make-path-jumpable, dired-jump-to-path-segment): New functions.
---
lisp/dired.el | 42 +++++++++++++++++++++++++++++++++++++++++-
1 file changed, 41 insertions(+), 1 deletion(-)
diff --git a/lisp/dired.el b/lisp/dired.el
index 4652589122..216c082e7b 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -272,7 +272,7 @@ dired-before-readin-hook
:group 'dired
:type 'hook)
-(defcustom dired-after-readin-hook nil
+(defcustom dired-after-readin-hook '(dired-make-path-jumpable)
"Hook run after each time a file or directory is read by Dired.
After each listing of a file or directory, this hook is run
with the buffer narrowed to the listing."
@@ -1643,6 +1643,46 @@ dired-insert-set-properties
'invisible 'dired-hide-details-link))))
(forward-line 1))))
+(defun dired-make-path-jumpable ()
+ "Make dired path line at top jumpable."
+ (let ((inhibit-read-only t))
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "^ /" nil t 1)
+ (let ((bound (line-end-position))
+ (segment-start (point))
+ segment-end)
+ (while (search-forward "/" bound t 1)
+ (setq segment-end (1- (point)))
+ (add-text-properties segment-start segment-end
+ `(mouse-face
+ highlight
+ help-echo "mouse-1: goto here"
+ keymap ,(let ((map (make-sparse-keymap)))
+ (define-key map [down-mouse-1] 'dired-jump-to-path-segment)
+ map)))
+ (setq segment-start (point))))))))
+
+(defun dired-jump-to-path-segment (event)
+ "Jump to the directory from a segment of the dired path."
+ (interactive "e")
+ (let* ((ev (event-end event))
+ (window (posn-window ev))
+ (pos (posn-point ev)))
+ (with-current-buffer (window-buffer window)
+ (let (beg end)
+ (save-excursion
+ (goto-char pos)
+ (when (search-forward "/" (line-end-position) t 1)
+ (setq end (point))
+ (while (search-backward "/" (line-beginning-position) t 1)
+ (setq beg (point)))))
+ (when beg
+ (let ((dir (buffer-substring-no-properties beg end)))
+ (if (member dir (mapcar 'car dired-subdir-alist))
+ (dired-goto-subdir dir)
+ (dired dir))))))))
+
\f
;;; Reverting a dired buffer
--
2.25.1
^ permalink raw reply related [flat|nested] 9+ messages in thread* bug#21973: [External] : bug#21973: 24.5; feature proposal: make dired header clickable
2021-10-24 11:09 ` William Xu
@ 2021-10-24 14:07 ` Lars Ingebrigtsen
2021-10-24 19:05 ` Juri Linkov
2021-10-24 21:31 ` Drew Adams
1 sibling, 1 reply; 9+ messages in thread
From: Lars Ingebrigtsen @ 2021-10-24 14:07 UTC (permalink / raw)
To: William Xu; +Cc: 21973
William Xu <william.xwl@gmail.com> writes:
> I've revised the patch to support also subdir headers in the buffer,
> using dired-after-readin-hook.
Thanks; looks good to me. I've now applied this to Emacs 29, but I
rewrote it somewhat so that it works hitting RET on the segments, too.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 9+ messages in thread
* bug#21973: [External] : bug#21973: 24.5; feature proposal: make dired header clickable
2021-10-24 14:07 ` Lars Ingebrigtsen
@ 2021-10-24 19:05 ` Juri Linkov
2021-10-24 19:20 ` Lars Ingebrigtsen
0 siblings, 1 reply; 9+ messages in thread
From: Juri Linkov @ 2021-10-24 19:05 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: William Xu, 21973
>> I've revised the patch to support also subdir headers in the buffer,
>> using dired-after-readin-hook.
>
> Thanks; looks good to me. I've now applied this to Emacs 29, but I
> rewrote it somewhat so that it works hitting RET on the segments, too.
I tried this out and see that it would be much better to bind it
to [mouse-1] instead of [down-mouse-1] because with [down-mouse-1]
releasing the mouse button moves point to wrong place in the new buffer.
^ permalink raw reply [flat|nested] 9+ messages in thread
* bug#21973: [External] : bug#21973: 24.5; feature proposal: make dired header clickable
2021-10-24 19:05 ` Juri Linkov
@ 2021-10-24 19:20 ` Lars Ingebrigtsen
0 siblings, 0 replies; 9+ messages in thread
From: Lars Ingebrigtsen @ 2021-10-24 19:20 UTC (permalink / raw)
To: Juri Linkov; +Cc: William Xu, 21973
Juri Linkov <juri@linkov.net> writes:
> I tried this out and see that it would be much better to bind it
> to [mouse-1] instead of [down-mouse-1] because with [down-mouse-1]
> releasing the mouse button moves point to wrong place in the new buffer.
Yeah, it should probably be the mysterious incantation
[mouse-2] click
[follow-link] 'mouse-face
to make it work as it's supposed to for a clickable thing. I've now
adjusted this.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 9+ messages in thread
* bug#21973: [External] : bug#21973: 24.5; feature proposal: make dired header clickable
2021-10-24 11:09 ` William Xu
2021-10-24 14:07 ` Lars Ingebrigtsen
@ 2021-10-24 21:31 ` Drew Adams
1 sibling, 0 replies; 9+ messages in thread
From: Drew Adams @ 2021-10-24 21:31 UTC (permalink / raw)
To: William Xu, 21973@debbugs.gnu.org
> > Looked at this only quickly.
> >
> > +1. It's a good idea to make dir-listing headers
> > into, essentially, clickable/RETable breadcrumbs.
> >
> > I can't speak to whether the patch sent is the
> > best/right way to do it - don't have time now to
> > look into it.
> >
> > But this should be done (maybe optionally, i.e.,
> > under user control) for each dir header in the
> > buffer. That is, do it for inserted subdir
> > headers, as well as for the first (top-level)
> > dir header.
>
> I've revised the patch to support also subdir headers
> in the buffer, using dired-after-readin-hook.
Sounds good.
^ permalink raw reply [flat|nested] 9+ messages in thread
end of thread, other threads:[~2021-10-24 21:31 UTC | newest]
Thread overview: 9+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2015-11-21 20:03 bug#21973: 24.5; feature proposal: make dired header clickable William Xu
2021-10-23 0:00 ` Stefan Kangas
2021-10-23 15:45 ` William Xu
2021-10-23 16:37 ` bug#21973: [External] : " Drew Adams
2021-10-24 11:09 ` William Xu
2021-10-24 14:07 ` Lars Ingebrigtsen
2021-10-24 19:05 ` Juri Linkov
2021-10-24 19:20 ` Lars Ingebrigtsen
2021-10-24 21:31 ` Drew Adams
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).