diff options
Diffstat (limited to 'lisp/dired-x.el')
-rw-r--r-- | lisp/dired-x.el | 181 |
1 files changed, 89 insertions, 92 deletions
diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 5a52eccbbe3..380e47786fc 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -44,7 +44,8 @@ ;; but maybe not if a dired-x function is being autoloaded. (require 'dired) -;;; User-defined variables. + +;;; User-defined variables (defgroup dired-x nil "Extended directory editing (dired-x)." @@ -217,7 +218,9 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used." :type 'boolean :group 'dired-x) -;;; KEY BINDINGS. + +;;; Key bindings + (when (keymapp (lookup-key dired-mode-map "*")) (define-key dired-mode-map "*(" 'dired-mark-sexp) (define-key dired-mode-map "*O" 'dired-mark-omitted) @@ -234,9 +237,8 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used." (define-key dired-mode-map "Y" 'dired-do-relsymlink) (define-key dired-mode-map "V" 'dired-do-run-mail) -;;; MENU BINDINGS - -(require 'easymenu) + +;;; Menu bindings (when-let ((menu (lookup-key dired-mode-map [menu-bar]))) (easy-menu-add-item menu '("Operate") @@ -276,7 +278,7 @@ files"] "Refresh")) -;; Install into appropriate hooks. +;;; Install into appropriate hooks (add-hook 'dired-mode-hook 'dired-extra-startup) (add-hook 'dired-after-readin-hook 'dired-omit-expunge) @@ -305,7 +307,7 @@ See also the functions: (dired-omit-startup)) -;;; EXTENSION MARKING FUNCTIONS. +;;; Extension marking functions (defun dired--mark-suffix-interactive-spec () (let* ((default @@ -434,7 +436,7 @@ See variables `dired-texinfo-unclean-extensions', (list ".dvi")))) -;;; OMITTING. +;;; Omitting ;; Enhanced omitting of lines from directory listings. ;; Marked files are never omitted. @@ -447,7 +449,7 @@ If it is `no-dir', omitting is much faster, but you can only match against the non-directory part of the file name. Set it to nil if you need to match the entire file name.") -;; \017=^O for Omit - other packages can chose other control characters. +;; \017=^O for Omit - other packages can choose other control characters. (defvar dired-omit-marker-char ?\017 "Temporary marker used by Dired-Omit. Should never be used as marker by the user or other packages.") @@ -572,13 +574,13 @@ files in the active region if `dired-mark-region' is non-nil." msg))) -;;; VIRTUAL DIRED MODE. +;;; Virtual dired mode ;; For browsing `ls -lR' listings in a dired-like fashion. (defalias 'virtual-dired 'dired-virtual) (defun dired-virtual (dirname &optional switches) - "Put this buffer into Virtual Dired mode. + "Put this Dired buffer into Virtual Dired mode. In Virtual Dired mode, all commands that do not actually consult the filesystem will work. @@ -610,7 +612,8 @@ you can relist single subdirs using \\[dired-do-redisplay]." ;; hand if you want them. (interactive - (list (read-string "Virtual Dired directory: " (dired-virtual-guess-dir)))) + (list (read-directory-name "Virtual Dired directory: " + nil (dired-virtual-guess-dir)))) (goto-char (point-min)) (or (looking-at-p " ") ;; if not already indented, do it now: @@ -624,7 +627,7 @@ you can relist single subdirs using \\[dired-do-redisplay]." (and (looking-at "^ wildcard ") (buffer-substring (match-end 0) (line-end-position)))))) - (if wildcard + (if wildcard (setq dirname (expand-file-name wildcard default-directory)))) ;; If raw ls listing (not a saved old dired buffer), give it a ;; decent subdir headerline: @@ -694,7 +697,7 @@ Also useful for `auto-mode-alist' like this: (dired-virtual (dired-virtual-guess-dir))) -;;; SMART SHELL. +;;; Smart shell ;; An Emacs buffer can have but one working directory, stored in the ;; buffer-local variable `default-directory'. A Dired buffer may have @@ -721,30 +724,30 @@ Also useful for `auto-mode-alist' like this: (shell-command command output-buffer error-buffer))) -;;; GUESS SHELL COMMAND. +;;; Guess shell command ;; Brief Description: -;;; +;; ;; * `dired-do-shell-command' is bound to `!' by dired.el. -;;; +;; ;; * `dired-guess-shell-command' provides smarter defaults for -;;; dired-aux.el's `dired-read-shell-command'. -;;; +;; dired-aux.el's `dired-read-shell-command'. +;; ;; * `dired-guess-shell-command' calls `dired-guess-default' with list of -;;; marked files. -;;; +;; marked files. +;; ;; * Parse `dired-guess-shell-alist-user' and -;;; `dired-guess-shell-alist-default' (in that order) for the first REGEXP -;;; that matches the first file in the file list. -;;; +;; `dired-guess-shell-alist-default' (in that order) for the first REGEXP +;; that matches the first file in the file list. +;; ;; * If the REGEXP matches all the entries of the file list then evaluate -;;; COMMAND, which is either a string or a Lisp expression returning a -;;; string. COMMAND may be a list of commands. -;;; +;; COMMAND, which is either a string or a Lisp expression returning a +;; string. COMMAND may be a list of commands. +;; ;; * Return this command to `dired-guess-shell-command' which prompts user -;;; with it. The list of commands is put into the list of default values. -;;; If a command is used successfully then it is stored permanently in -;;; `dired-shell-command-history'. +;; with it. The list of commands is put into the list of default values. +;; If a command is used successfully then it is stored permanently in +;; `dired-shell-command-history'. ;; Guess what shell command to apply to a file. (defvar dired-shell-command-history nil @@ -942,10 +945,15 @@ Each element of this list looks like (REGEXP COMMAND...) -where each COMMAND can either be a string or a Lisp expression that evaluates +COMMAND will be used if REGEXP matches the file to be processed. +If several files are to be processed, REGEXP has to match all the +files. + +Each COMMAND can either be a string or a Lisp expression that evaluates to a string. If this expression needs to consult the name of the file for which the shell commands are being requested, it can access that file name as the variable `file'. + If several COMMANDs are given, the first one will be the default and the rest will be added temporarily to the history and can be retrieved with \\[previous-history-element] (M-p) . @@ -964,38 +972,26 @@ REGEXP is matched case-sensitively." (defun dired-guess-default (files) "Return a shell command, or a list of commands, appropriate for FILES. See `dired-guess-shell-alist-user'." - (let* ((case-fold-search dired-guess-shell-case-fold-search) - ;; Prepend the user's alist to the default alist. - (alist (append dired-guess-shell-alist-user - dired-guess-shell-alist-default)) - (file (car files)) - (flist (cdr files)) - elt regexp cmds) - - ;; Find the first match in the alist for first file in FILES. - (while alist - (setq elt (car alist) - regexp (car elt) - alist (cdr alist)) - (if (string-match-p regexp file) - (setq cmds (cdr elt) - alist nil))) - - ;; If more than one file, see if all of FILES match regular expression. - (while (and flist - (string-match-p regexp (car flist))) - (setq flist (cdr flist))) - - ;; If flist is still non-nil, then do not guess since this means that not - ;; all the files in FILES were matched by the regexp. - (setq cmds (and (not flist) cmds)) - - ;; Return commands or nil if flist is still non-nil. - ;; Evaluate the commands in order that any logical testing will be done. - (if (cdr cmds) - (delete-dups (mapcar (lambda (cmd) (eval cmd `((file . ,file)))) cmds)) - (eval (car cmds) `((file . ,file)))))) ; single command + (programs + (delete-dups + (mapcar + (lambda (command) + (eval command `((file . ,(car files))))) + (seq-reduce + #'append + (mapcar #'cdr + (seq-filter (lambda (elem) + (seq-every-p + (lambda (file) + (string-match-p (car elem) file)) + files)) + (append dired-guess-shell-alist-user + dired-guess-shell-alist-default))) + nil))))) + (if (length= programs 1) + (car programs) + programs))) (defun dired-guess-shell-command (prompt files) "Ask user with PROMPT for a shell command, guessing a default from FILES." @@ -1024,7 +1020,7 @@ See `dired-guess-shell-alist-user'." (if (equal val "") default val)))) -;;; RELATIVE SYMBOLIC LINKS. +;;; Relative symbolic links (declare-function make-symbolic-link "fileio.c") @@ -1048,11 +1044,11 @@ results in len2 (length file2)) ;; Find common initial file name components: (let (next) - (while (and (setq next (string-match "/" file1 index)) + (while (and (setq next (string-search "/" file1 index)) (< (setq next (1+ next)) (min len1 len2)) ;; For the comparison, both substrings must end in ;; `/', so NEXT is *one plus* the result of the - ;; string-match. + ;; string-search. ;; E.g., consider the case of linking "/tmp/a/abc" ;; to "/tmp/abc" erroneously giving "/tmp/a" instead ;; of "/tmp/" as common initial component @@ -1070,7 +1066,7 @@ results in (start 0) (count 0)) ;; Count number of slashes we must compensate for ... - (while (setq start (string-match "/" tem start)) + (while (setq start (string-search "/" tem start)) (setq count (1+ count) start (1+ start))) ;; ... and prepend a "../" for each slash found: @@ -1085,7 +1081,7 @@ results in ;;;###autoload (defun dired-do-relsymlink (&optional arg) - "Relative symlink all marked (or next ARG) files into a directory. + "Relative symlink all marked (or next ARG) files into a directory. Otherwise make a relative symbolic link to the current file. This creates relative symbolic links like @@ -1098,7 +1094,7 @@ not absolute ones like For absolute symlinks, use \\[dired-do-symlink]." (interactive "P") (dired-do-create-files 'relsymlink #'dired-make-relative-symlink - "RelSymLink" arg dired-keep-marker-relsymlink)) + "RelSymLink" arg dired-keep-marker-relsymlink)) (autoload 'dired-mark-read-regexp "dired-aux") (autoload 'dired-do-create-files-regexp "dired-aux") @@ -1113,30 +1109,30 @@ for more info." "RelSymLink" arg regexp newname whole-name dired-keep-marker-relsymlink)) -;;; VISIT ALL MARKED FILES SIMULTANEOUSLY. +;;; Visit all marked files simultaneously ;; Brief Description: -;;; +;; ;; `dired-do-find-marked-files' is bound to `F' by dired-x.el. -;;; +;; ;; * Use `dired-get-marked-files' to collect the marked files in the current -;;; Dired Buffer into a list of filenames `FILE-LIST'. -;;; +;; Dired Buffer into a list of filenames `FILE-LIST'. +;; ;; * Pass FILE-LIST to `dired-simultaneous-find-file' all with -;;; `dired-do-find-marked-files''s prefix argument NOSELECT. -;;; +;; `dired-do-find-marked-files''s prefix argument NOSELECT. +;; ;; * `dired-simultaneous-find-file' runs through FILE-LIST decrementing the -;;; list each time. -;;; +;; list each time. +;; ;; * If NOSELECT is non-nil then just run `find-file-noselect' on each -;;; element of FILE-LIST. -;;; +;; element of FILE-LIST. +;; ;; * If NOSELECT is nil then calculate the `size' of the window for each file -;;; by dividing the `window-height' by length of FILE-LIST. Thus, `size' is -;;; cognizant of the window-configuration. -;;; +;; by dividing the `window-height' by length of FILE-LIST. Thus, `size' is +;; cognizant of the window-configuration. +;; ;; * If `size' is too small abort, otherwise run `find-file' on each element -;;; of FILE-LIST giving each a window of height `size'. +;; of FILE-LIST giving each a window of height `size'. (defun dired-do-find-marked-files (&optional noselect) "Find all marked files displaying all of them simultaneously. @@ -1182,7 +1178,7 @@ NOSELECT the files are merely found but not selected." (find-file file))))) -;;; MISCELLANEOUS COMMANDS. +;;; Miscellaneous commands ;; Run man on files. @@ -1192,12 +1188,12 @@ NOSELECT the files are merely found but not selected." (defun dired-man () "Run `man' on this file." -;; Used also to say: "Display old buffer if buffer name matches filename." -;; but I have no idea what that means. + ;; Used also to say: "Display old buffer if buffer name matches filename." + ;; but I have no idea what that means. (interactive) (require 'man) (let* ((file (dired-get-filename)) - (manual-program (replace-regexp-in-string "\\*" "%s" + (manual-program (string-replace "*" "%s" (dired-guess-shell-command "Man command: " (list file))))) (Man-getpage-in-background file))) @@ -1250,7 +1246,7 @@ otherwise." (dired-rmail))))) -;;; MISCELLANEOUS INTERNAL FUNCTIONS. +;;; Miscellaneous internal functions ;; This should be a builtin (defun dired-buffer-more-recently-used-p (buffer1 buffer2) @@ -1260,7 +1256,6 @@ Considers buffers closer to the car of `buffer-list' to be more recent." (memq buffer1 (buffer-list)) (not (memq buffer1 (memq buffer2 (buffer-list)))))) - ;; 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. @@ -1433,7 +1428,7 @@ only in the active region if `dired-mark-region' is non-nil." (format "'%s file" predicate)))) -;;; FIND FILE AT POINT. +;;; Find file at point (defcustom dired-x-hands-off-my-keys t "Non-nil means don't remap `find-file' to `dired-x-find-file'. @@ -1480,7 +1475,8 @@ a prefix argument, when it offers the filename near point as a default." (interactive (list (dired-x-read-filename-at-point "Find file: "))) (find-file-other-window filename)) -;;; Internal functions. + +;;; Internal functions ;; Fixme: This should probably use `thing-at-point'. -- fx (define-obsolete-function-alias 'dired-filename-at-point @@ -1528,8 +1524,9 @@ If `current-prefix-arg' is non-nil, uses name at point as guess." (define-obsolete-function-alias 'read-filename-at-point 'dired-x-read-filename-at-point "24.1") ; is this even needed? + -;;; BUG REPORTS +;;; Epilog (define-obsolete-function-alias 'dired-x-submit-report 'report-emacs-bug "24.1") |