X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/d7f413b893012eb5c9c93cd724008c2c1faae56f..1dd4f26ab6c1f14628d9fcf03b0cca7e54d52302:/lisp/dired-x.el diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 25c6f8b69a..053b3cb973 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -1,6 +1,7 @@ ;;; dired-x.el --- extra Dired functionality -*- lexical-binding:t -*- -;; Copyright (C) 1993-1994, 1997, 2001-2014 Free Software Foundation, Inc. +;; Copyright (C) 1993-1994, 1997, 2001-2016 Free Software Foundation, +;; Inc. ;; Author: Sebastian Kremer ;; Lawrence R. Dodd @@ -148,7 +149,7 @@ regexp `dired-omit-files', nor files ending with extensions in To enable omitting in every Dired buffer, you can put this in your init file: - (add-hook 'dired-mode-hook (lambda () (dired-omit-mode))) + (add-hook \\='dired-mode-hook (lambda () (dired-omit-mode))) See Info node `(dired-x) Omitting Variables' for more information." :group 'dired-x @@ -401,6 +402,7 @@ See variables `dired-texinfo-unclean-extensions', dired-tex-unclean-extensions (list ".dvi")))) +(defvar tar-superior-buffer) ;;; JUMP. ;;;###autoload @@ -415,30 +417,32 @@ Interactively with prefix argument, read FILE-NAME and move to its line in dired." (interactive (list nil (and current-prefix-arg - (read-file-name "Jump to Dired file: ")))) - (let* ((file (or file-name buffer-file-name)) - (dir (if file (file-name-directory file) default-directory))) - (if (and (eq major-mode 'dired-mode) (null file-name)) - (progn - (setq dir (dired-current-directory)) - (dired-up-directory other-window) - (unless (dired-goto-file dir) - ;; refresh and try again - (dired-insert-subdir (file-name-directory dir)) - (dired-goto-file dir))) - (if other-window - (dired-other-window dir) - (dired dir)) - (if file - (or (dired-goto-file file) + (read-file-name "Jump to Dired file: ")))) + (if (bound-and-true-p tar-subfile-mode) + (switch-to-buffer tar-superior-buffer) + (let* ((file (or file-name buffer-file-name)) + (dir (if file (file-name-directory file) default-directory))) + (if (and (eq major-mode 'dired-mode) (null file-name)) + (progn + (setq dir (dired-current-directory)) + (dired-up-directory other-window) + (unless (dired-goto-file dir) ;; refresh and try again - (progn - (dired-insert-subdir (file-name-directory file)) - (dired-goto-file file)) - ;; Toggle omitting, if it is on, and try again. - (when dired-omit-mode - (dired-omit-mode) - (dired-goto-file file))))))) + (dired-insert-subdir (file-name-directory dir)) + (dired-goto-file dir))) + (if other-window + (dired-other-window dir) + (dired dir)) + (if file + (or (dired-goto-file file) + ;; refresh and try again + (progn + (dired-insert-subdir (file-name-directory file)) + (dired-goto-file file)) + ;; Toggle omitting, if it is on, and try again. + (when dired-omit-mode + (dired-omit-mode) + (dired-goto-file file)))))))) ;;;###autoload (defun dired-jump-other-window (&optional file-name) @@ -686,8 +690,8 @@ to put saved Dired buffers automatically into Virtual Dired mode. Also useful for `auto-mode-alist' like this: - (add-to-list 'auto-mode-alist - '(\"[^/]\\\\.dired\\\\'\" . dired-virtual-mode))" + (add-to-list \\='auto-mode-alist + \\='(\"[^/]\\\\.dired\\\\\\='\" . dired-virtual-mode))" (interactive) (dired-virtual (dired-virtual-guess-dir))) @@ -1352,12 +1356,12 @@ otherwise." (interactive) (let ((file (dired-get-filename t))) (if dired-bind-vm - (if (y-or-n-p (concat "Visit `" file - "' as a mail folder with VM?")) + (if (y-or-n-p (format-message + "Visit `%s' as a mail folder with VM?" file)) (dired-vm)) ;; Read mail folder using rmail. - (if (y-or-n-p (concat "Visit `" file - "' as a mailbox with RMAIL?")) + (if (y-or-n-p (format-message + "Visit `%s' as a mailbox with RMAIL?" file)) (dired-rmail))))) @@ -1395,6 +1399,22 @@ Considers buffers closer to the car of `buffer-list' to be more recent." ;; result)) +;; Needed if ls -lh is supported and also for GNU ls -ls. +(defun dired-x--string-to-number (str) + "Like `string-to-number' but recognize a trailing unit prefix. +For example, 2K is expanded to 2048.0. The caller should make +sure that a trailing letter in STR is one of BKkMGTPEZY." + (let* ((val (string-to-number str)) + (u (unless (zerop val) + (aref str (1- (length str)))))) + (when (and u (> u ?9)) + (when (= u ?k) + (setq u ?K)) + (let ((units '(?B ?K ?M ?G ?T ?P ?E ?Z ?Y))) + (while (and units (/= (pop units) u)) + (setq val (* 1024.0 val))))) + val)) + ;; Does anyone use this? - lrd 6/29/93. ;; Apparently people do use it. - lrd 12/22/97. @@ -1421,7 +1441,19 @@ For example, use (equal 0 size) -to mark all zero length files." +to mark all zero length files. + +There's an ambiguity when a single integer not followed by a unit +prefix precedes the file mode: It is then parsed as inode number +and not as block size (this always works for GNU coreutils ls). + +Another limitation is that the uid field is needed for the +function to work correctly. In particular, the field is not +present for some values of `ls-lisp-emulation'. + +This function operates only on the buffer content and does not +refer at all to the underlying file system. Contrast this with +`find-dired', which might be preferable for the task at hand." ;; Using sym="" instead of nil avoids the trap of ;; (string-match "foo" sym) into which a user would soon fall. ;; Give `equal' instead of `=' in the example, as this works on @@ -1441,23 +1473,23 @@ to mark all zero length files." ;; to nil or the appropriate value, so they need not be initialized. ;; Moves point within the current line. (dired-move-to-filename) - (let (pos - (mode-len 10) ; length of mode string - ;; like in dired.el, but with subexpressions \1=inode, \2=s: - (dired-re-inode-size "\\s *\\([0-9]*\\)\\s *\\([0-9]*\\) ?")) - (beginning-of-line) - (forward-char 2) - (if (looking-at dired-re-inode-size) - (progn - (goto-char (match-end 0)) - (setq inode (string-to-number - (buffer-substring (match-beginning 1) - (match-end 1))) - s (string-to-number - (buffer-substring (match-beginning 2) - (match-end 2))))) - (setq inode nil - s nil)) + (let ((mode-len 10) ; length of mode string + ;; like in dired.el, but with subexpressions \1=inode, \2=s: + ;; GNU ls -hs suffixes the block count with a unit and + ;; prints it as a float, FreeBSD does neither. + (dired-re-inode-size "\\=\\s *\\([0-9]+\\s +\\)?\ +\\(?:\\([0-9]+\\(?:\\.[0-9]*\\)?[BkKMGTPEZY]?\\)? ?\\)")) + (beginning-of-line) + (forward-char 2) + (search-forward-regexp dired-re-inode-size nil t) + ;; XXX Might be a size not followed by a unit prefix. + ;; We could set s to inode if it were otherwise nil, + ;; with a similar reasoning as below for setting gid to uid, + ;; but it would be even more whimsical. + (setq inode (when (match-string 1) + (string-to-number (match-string 1)))) + (setq s (when (match-string 2) + (dired-x--string-to-number (match-string 2)))) (setq mode (buffer-substring (point) (+ mode-len (point)))) (forward-char mode-len) ;; Skip any extended attributes marker ("." or "+"). @@ -1465,33 +1497,60 @@ to mark all zero length files." (forward-char 1)) (setq nlink (read (current-buffer))) ;; Karsten Wenger fixed uid. - (setq uid (buffer-substring (1+ (point)) - (progn (forward-word 1) (point)))) - (re-search-forward directory-listing-before-filename-regexp) - (goto-char (match-beginning 1)) - (forward-char -1) - (setq size (string-to-number - (buffer-substring (save-excursion - (backward-word 1) - (setq pos (point))) + ;; Another issue is that GNU ls -n right-justifies numerical + ;; UIDs and GIDs, while FreeBSD left-justifies them, so + ;; don't rely on a specific whitespace layout. Both of them + ;; right-justify all other numbers, though. + ;; XXX Return a number if the uid or gid seems to be + ;; numerical? + (setq uid (buffer-substring (progn + (skip-chars-forward " \t") + (point)) + (progn + (skip-chars-forward "^ \t") (point)))) - (goto-char pos) - (backward-word 1) - ;; if no gid is displayed, gid will be set to uid - ;; but user will then not reference it anyway in PREDICATE. - (setq gid (buffer-substring (save-excursion - (forward-word 1) (point)) + (dired-move-to-filename) + (save-excursion + (setq time + ;; The regexp below tries to match from the last + ;; digit of the size field through a space after the + ;; date. Also, dates may have different formats + ;; depending on file age, so the date column need + ;; not be aligned to the right. + (buffer-substring (save-excursion + (skip-chars-backward " \t") (point)) - time (buffer-substring (match-beginning 1) - (1- (dired-move-to-filename))) - name (buffer-substring (point) - (or - (dired-move-to-end-of-filename t) - (point))) - sym (if (looking-at-p " -> ") - (buffer-substring (progn (forward-char 4) (point)) - (line-end-position)) - "")) + (progn + (re-search-backward + directory-listing-before-filename-regexp) + (skip-chars-forward "^ \t") + (1+ (point)))) + size (dired-x--string-to-number + ;; We know that there's some kind of number + ;; before point because the regexp search + ;; above succeeded. I don't think it's worth + ;; doing an extra check for leading garbage. + (buffer-substring (point) + (progn + (skip-chars-backward "^ \t") + (point)))) + ;; If no gid is displayed, gid will be set to uid + ;; but the user will then not reference it anyway in + ;; PREDICATE. + gid (buffer-substring (progn + (skip-chars-backward " \t") + (point)) + (progn + (skip-chars-backward "^ \t") + (point))))) + (setq name (buffer-substring (point) + (or + (dired-move-to-end-of-filename t) + (point))) + sym (if (looking-at " -> ") + (buffer-substring (progn (forward-char 4) (point)) + (line-end-position)) + "")) t) (eval predicate `((inode . ,inode) @@ -1610,7 +1669,7 @@ If `current-prefix-arg' is non-nil, uses name at point as guess." ;; Local Variables: ;; byte-compile-dynamic: t -;; generated-autoload-file: "dired.el" +;; generated-autoload-file: "dired-loaddefs.el" ;; End: ;;; dired-x.el ends here