Dired patch for `i' - bounce between subdir line and its inserted
listing
Stephen J. Turnbull
stephen at xemacs.org
Sat Mar 8 22:57:11 EST 2008
This looks like a really good idea. If somebody would like to port it
to XEmacs, and coordinate with Drew Adams (to be polite, presumably he
has no objection) and Mike Sperber (the Dired package maintainer), I
would be much obliged.
I imagine it could amount to a bit of work as our dired package is
organized differently from Emacs's.
Steve
Drew Adams writes:
> Attached is a patch for Dired (dired.el and dired-aux.el).
> It extends `i', giving it behavior on a non-directory line
> and on subdir header lines, where it currently just raises a
> wrong-line error.
>
> This provides a handy go-back behavior, letting you bounce
> back and forth between a subdirectory line and its inserted
> listing. `i' on a non-directory file within a subdir
> listing acts the same as it does on the subdir's header
> line, so you need not be on the header line to bounce back:
> anywhere within the subdir listing will do.
>
> More precisely -
>
> Currently:
>
> * If you hit `i' on a directory line, it goes to the
> corresponding subdirectory listing header line. If the
> subdirectory listing has not yet been inserted, `i' first
> inserts it and then goes to it.
>
> * If you hit `i' anywhere else, it raises an error: either
> "No file on this line" (for a header line) or "Attempt to
> insert a non-directory: c:/foobar". This is not useful.
>
> With the patch:
>
> * `i' on a directory line does the same thing as before:
> insert and goto.
>
> * `i' on a non-directory line in the top-level directory
> also does the same thing as before: nothing.
>
> * (NEW) `i' on a subdir header line or a non-directory file
> in a subdir listing goes to the line for that subdir in
> the parent directory listing.
>
> Please try the patch. It should work in all contexts,
> including with hidden subdirs.
>
> The patch also fixes a bug that occurs in
> `dired-get-filename' if you use the `ls' switch `F', as in
> `ls -alF'. In that case, the test for a dot file `.' or
> `..' fails, because with switch `F' the names appear as `./'
> and `../'.
>
> BTW, I'm surprised that bug wasn't reported before. Don't
> you all use `F'? And shouldn't `ls -alF' be the default
> switches value?
>
diff -c -w dired-aux-CVS-2008-03-07.el dired-aux-patched-2008-03-07.el
*** dired-aux-CVS-2008-03-07.el Sat Mar 8 00:00:02 2008
--- dired-aux-patched-2008-03-07.el Sat Mar 8 00:07:24 2008
***************
*** 1858,1895 ****
;;;###begin dired-ins.el
;;;###autoload
! (defun dired-maybe-insert-subdir (dirname &optional
! switches no-error-if-not-dir-p)
! "Insert this subdirectory into the same dired buffer.
! If it is already present, just move to it (type \\[dired-do-redisplay] to refresh),
! else inserts it at its natural place (as `ls -lR' would have done).
! With a prefix arg, you may edit the ls switches used for this listing.
! You can add `R' to the switches to expand the whole tree starting at
! this subdirectory.
! This function takes some pains to conform to `ls -lR' output.
!
! Dired remembers switches specified with a prefix arg, so that reverting
! the buffer will not reset them. However, using `dired-undo' to re-insert
! or delete subdirectories can bypass this machinery. Hence, you sometimes
! may have to reset some subdirectory switches after a `dired-undo'.
! You can reset all subdirectory switches to the default using
! \\<dired-mode-map>\\[dired-reset-subdir-switches].
! See Info node `(emacs)Subdir switches' for more details."
! (interactive
! (list (dired-get-filename)
! (if current-prefix-arg
(read-string "Switches for listing: "
(or dired-subdir-switches dired-actual-switches)))))
! (let ((opoint (point)))
;; We don't need a marker for opoint as the subdir is always
;; inserted *after* opoint.
(setq dirname (file-name-as-directory dirname))
(or (and (not switches)
(dired-goto-subdir dirname))
(dired-insert-subdir dirname switches no-error-if-not-dir-p))
! ;; Push mark so that it's easy to find back. Do this after the
! ;; insert message so that the user sees the `Mark set' message.
! (push-mark opoint)))
;;;###autoload
(defun dired-insert-subdir (dirname &optional switches no-error-if-not-dir-p)
--- 1858,1928 ----
;;;###begin dired-ins.el
;;;###autoload
! (defun dired-maybe-insert-subdir (dirname &optional switches no-error-if-not-dir-p)
! "Move to Dired subdirectory line or subdirectory listing.
! This bounces you back and forth between a subdirectory line and its
! inserted listing header line. Using it on a non-directory line in a
! subdirectory listing acts the same as using it on the subdirectory
! header line.
!
! * If on a subdirectory line, then go to the subdirectory's listing,
! creating it if not yet present.
!
! * If on a subdirectory listing header line or a non-directory file in
! a subdirectory listing, then go to the line for the subdirectory in
! the parent directory listing.
!
! * If on a non-directory file in the top Dired directory listing, do
! nothing.
!
! Subdirectories are listed in the same position as for `ls -lR' output.
!
! With a prefix arg, you can edit the `ls' switches used for this
! listing. Add `R' to the switches to expand the directory tree under a
! subdirectory.
!
! Dired remembers the switches you specify with a prefix arg, so
! reverting the buffer does not reset them. However, you might
! sometimes need to reset some subdirectory switches after a
! `dired-undo'. You can reset all subdirectory switches to the
! default value using \\<dired-mode-map>\\[dired-reset-subdir-switches]. See \
! Info node
! `(emacs)Subdir switches' for more details."
! (interactive (list (dired-this-subdir)
! (and current-prefix-arg
(read-string "Switches for listing: "
(or dired-subdir-switches dired-actual-switches)))))
! (let ((opoint (point))
! (filename dirname))
! (if (consp filename) ; Subdir header line or non-directory file.
! (progn (setq filename (car filename))
! (if (assoc filename dired-subdir-alist)
! (dired-goto-file filename) ; Subdir header line.
! (dired-insert-subdir
! (substring (file-name-directory filename) 0 -1))))
;; We don't need a marker for opoint as the subdir is always
;; inserted *after* opoint.
(setq dirname (file-name-as-directory dirname))
(or (and (not switches)
(dired-goto-subdir dirname))
(dired-insert-subdir dirname switches no-error-if-not-dir-p))
! ;; Push mark so that it's easy to go back. Do this after the
! ;; insertion message so that the user sees the `Mark set' message.
! (push-mark opoint))))
!
! (defun dired-this-subdir ()
! "This line's filename, if directory, or `dired-current-directory' list.
! If on a directory line, then return the directory name.
! Else return a singleton list of a directory name, which is as follows:
! If on a subdirectory header line (either of the two lines), then use
! that subdirectory name. Else use the parent directory name."
! (or (let ((file (dired-get-filename nil t)))
! (and file (file-directory-p file)
! (not (member (file-relative-name file (file-name-directory
! (directory-file-name file)))
! '("." ".." "./" "../")))
! file))
! (list (dired-current-directory))))
;;;###autoload
(defun dired-insert-subdir (dirname &optional switches no-error-if-not-dir-p)
Diff finished. Sat Mar 08 00:15:25 2008
diff -c -w dired-CVS-2008-03-07.el dired-patched-2008-03-07.el
*** dired-CVS-2008-03-07.el Fri Mar 7 23:59:44 2008
--- dired-patched-2008-03-07.el Sat Mar 8 00:13:40 2008
***************
*** 1823,1837 ****
(if (setq p1 (dired-move-to-filename (not no-error-if-not-filep)))
(setq p2 (dired-move-to-end-of-filename no-error-if-not-filep))))
;; nil if no file on this line, but no-error-if-not-filep is t:
! (if (setq file (and p1 p2 (buffer-substring p1 p2)))
! (progn
;; Get rid of the mouse-face property that file names have.
(set-text-properties 0 (length file) nil file)
;; Unquote names quoted by ls or by dired-insert-directory.
;; Using read to unquote is much faster than substituting
;; \007 (4 chars) -> ^G (1 char) etc. in a lisp loop.
! (setq file
! (read
(concat "\""
;; Some ls -b don't escape quotes, argh!
;; This is not needed for GNU ls, though.
--- 1823,1835 ----
(if (setq p1 (dired-move-to-filename (not no-error-if-not-filep)))
(setq p2 (dired-move-to-end-of-filename no-error-if-not-filep))))
;; nil if no file on this line, but no-error-if-not-filep is t:
! (when (setq file (and p1 p2 (buffer-substring p1 p2)))
;; Get rid of the mouse-face property that file names have.
(set-text-properties 0 (length file) nil file)
;; Unquote names quoted by ls or by dired-insert-directory.
;; Using read to unquote is much faster than substituting
;; \007 (4 chars) -> ^G (1 char) etc. in a lisp loop.
! (setq file (read
(concat "\""
;; Some ls -b don't escape quotes, argh!
;; This is not needed for GNU ls, though.
***************
*** 1841,1861 ****
"\"")))
;; The above `read' will return a unibyte string if FILE
;; contains eight-bit-control/graphic characters.
! (if (and enable-multibyte-characters
(not (multibyte-string-p file)))
! (setq file (string-to-multibyte file)))))
(and file (file-name-absolute-p file)
;; A relative file name can start with ~.
;; Don't treat it as absolute in this context.
(not (eq (aref file 0) ?~))
(setq already-absolute t))
! (cond
! ((null file)
! nil)
! ((eq localp 'verbatim)
! file)
! ((and (not no-error-if-not-filep)
! (member file '("." "..")))
(error "Cannot operate on `.' or `..'"))
((and (eq localp 'no-dir) already-absolute)
(file-name-nondirectory file))
--- 1839,1855 ----
"\"")))
;; The above `read' will return a unibyte string if FILE
;; contains eight-bit-control/graphic characters.
! (when (and enable-multibyte-characters
(not (multibyte-string-p file)))
! (setq file (string-to-multibyte file))))
(and file (file-name-absolute-p file)
;; A relative file name can start with ~.
;; Don't treat it as absolute in this context.
(not (eq (aref file 0) ?~))
(setq already-absolute t))
! (cond ((null file) nil)
! ((eq localp 'verbatim) file)
! ((and (not no-error-if-not-filep) (member file '("." ".." "./" "../")))
(error "Cannot operate on `.' or `..'"))
((and (eq localp 'no-dir) already-absolute)
(file-name-nondirectory file))
***************
*** 1867,1874 ****
(if (and handler (not (get handler 'safe-magic)))
(concat "/:" file)
file)))
! ((eq localp 'no-dir)
! file)
((equal (dired-current-directory) "/")
(setq file (concat (dired-current-directory localp) file))
(let ((handler (find-file-name-handler file nil)))
--- 1861,1867 ----
(if (and handler (not (get handler 'safe-magic)))
(concat "/:" file)
file)))
! ((eq localp 'no-dir) file)
((equal (dired-current-directory) "/")
(setq file (concat (dired-current-directory localp) file))
(let ((handler (find-file-name-handler file nil)))
***************
*** 1878,1885 ****
(if (and handler (not (get handler 'safe-magic)))
(concat "/:" file)
file)))
! (t
! (concat (dired-current-directory localp) file)))))
(defun dired-string-replace-match (regexp string newtext
&optional literal global)
--- 1871,1877 ----
(if (and handler (not (get handler 'safe-magic)))
(concat "/:" file)
file)))
! (t (concat (dired-current-directory localp) file)))))
(defun dired-string-replace-match (regexp string newtext
&optional literal global)
***************
*** 2324,2333 ****
;; the search faster (e.g. for the filename "-"!).
(search-forward (concat " " search-string)
boundary 'move))
;; Match could have BASE just as initial substring or
;; or in permission bits or date or
;; not be a proper filename at all:
! (if (equal base (dired-get-filename 'no-dir t))
;; Must move to filename since an (actually
;; correct) match could have been elsewhere on the
;; ;; line (e.g. "-" would match somewhere in the
--- 2316,2326 ----
;; the search faster (e.g. for the filename "-"!).
(search-forward (concat " " search-string)
boundary 'move))
+ ;; Remove / from filename, then compare with BASE.
;; Match could have BASE just as initial substring or
;; or in permission bits or date or
;; not be a proper filename at all:
! (if (equal base (directory-file-name (dired-get-filename 'no-dir t)))
;; Must move to filename since an (actually
;; correct) match could have been elsewhere on the
;; ;; line (e.g. "-" would match somewhere in the
Diff finished. Sat Mar 08 00:14:02 2008
More information about the XEmacs-Beta
mailing list
