diff options
Diffstat (limited to 'lisp/dired-aux.el')
-rw-r--r-- | lisp/dired-aux.el | 104 |
1 files changed, 81 insertions, 23 deletions
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 8908e5ba425..11cf1e184d8 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -36,7 +36,8 @@ ;;; Code: -;; We need macros in dired.el to compile properly. +;; We need macros in dired.el to compile properly, +;; and we call subroutines in it too. (require 'dired) (defvar dired-create-files-failures nil @@ -253,9 +254,20 @@ List has a form of (file-name full-file-name (attribute-list))" ;;;###autoload (defun dired-do-chmod (&optional arg) "Change the mode of the marked (or next ARG) files. -This calls chmod, thus symbolic modes like `g+w' are allowed." +Symbolic modes like `g+w' are allowed." (interactive "P") - (dired-do-chxxx "Mode" dired-chmod-program 'chmod arg)) + (let* ((files (dired-get-marked-files t arg)) + (modes (dired-mark-read-string + "Change mode of %s to: " nil + 'chmod arg files)) + (num-modes (if (string-match "^[0-7]+" modes) + (string-to-number modes 8)))) + (dolist (file files) + (set-file-modes + file + (if num-modes num-modes + (file-modes-symbolic-to-number modes (file-modes file))))) + (dired-do-redisplay arg))) ;;;###autoload (defun dired-do-chgrp (&optional arg) @@ -452,6 +464,56 @@ with a prefix argument." ;;; Shell commands +(declare-function mailcap-parse-mailcaps "mailcap" (&optional path force)) +(declare-function mailcap-parse-mimetypes "mailcap" (&optional path force)) +(declare-function mailcap-extension-to-mime "mailcap" (extn)) +(declare-function mailcap-mime-info "mailcap" + (string &optional request no-decode)) + +(defun dired-read-shell-command-default (files) + "Return a list of default commands for `dired-read-shell-command'." + (require 'mailcap) + (mailcap-parse-mailcaps) + (mailcap-parse-mimetypes) + (let* ((all-mime-type + ;; All unique MIME types from file extensions + (delete-dups (mapcar (lambda (file) + (mailcap-extension-to-mime + (file-name-extension file t))) + files))) + (all-mime-info + ;; All MIME info lists + (delete-dups (mapcar (lambda (mime-type) + (mailcap-mime-info mime-type 'all)) + all-mime-type))) + (common-mime-info + ;; Intersection of mime-infos from different mime-types; + ;; or just the first MIME info for a single MIME type + (if (cdr all-mime-info) + (delq nil (mapcar (lambda (mi1) + (unless (memq nil (mapcar + (lambda (mi2) + (member mi1 mi2)) + (cdr all-mime-info))) + mi1)) + (car all-mime-info))) + (car all-mime-info))) + (commands + ;; Command strings from `viewer' field of the MIME info + (delq nil (mapcar (lambda (mime-info) + (let ((command (cdr (assoc 'viewer mime-info)))) + (if (stringp command) + (replace-regexp-in-string + ;; Replace mailcap's `%s' placeholder + ;; with dired's `?' placeholder + "%s" "?" + (replace-regexp-in-string + ;; Remove the final filename placeholder + "\s*\\('\\)?%s\\1?\s*\\'" "" command nil t) + nil t)))) + common-mime-info)))) + commands)) + (defun dired-read-shell-command (prompt arg files) ;; "Read a dired shell command prompting with PROMPT (using read-string). ;;ARG is the prefix arg and may be used to indicate in the prompt which @@ -461,7 +523,8 @@ with a prefix argument." nil 'shell files (function read-string) (format prompt (dired-mark-prompt arg files)) - nil 'shell-command-history)) + nil 'shell-command-history + (dired-read-shell-command-default files))) ;; The in-background argument is only needed in Emacs 18 where ;; shell-command doesn't understand an appended ampersand `&'. @@ -582,18 +645,6 @@ can be produced by `dired-get-marked-files', for example." ;; Return nil for sake of nconc in dired-bunch-files. nil) -;; In Emacs 19 this will return program's exit status. -;; This is a separate function so that ange-ftp can redefine it. -(defun dired-call-process (program discard &rest arguments) -; "Run PROGRAM with output to current buffer unless DISCARD is t. -;Remaining arguments are strings passed as command arguments to PROGRAM." - ;; Look for a handler for default-directory in case it is a remote file name. - (let ((handler - (find-file-name-handler (directory-file-name default-directory) - 'dired-call-process))) - (if handler (apply handler 'dired-call-process - program discard arguments) - (apply 'call-process program nil (not discard) nil arguments)))) (defun dired-check-process (msg program &rest arguments) ; "Display MSG while running PROGRAM, and check for output. @@ -610,8 +661,7 @@ can be produced by `dired-get-marked-files', for example." (set-buffer err-buffer) (erase-buffer) (setq default-directory dir ; caller's default-directory - err (not (eq 0 - (apply (function dired-call-process) program nil arguments)))) + err (not (eq 0 (apply 'process-file program nil t nil arguments)))) (if err (progn (dired-log (concat program " " (prin1-to-string arguments) "\n")) @@ -1153,6 +1203,8 @@ Special value `always' suppresses confirmation." (dired-copy-file-recursive from to ok-flag dired-copy-preserve-time t dired-recursive-copies)) +(declare-function make-symbolic-link "fileio.c") + (defun dired-copy-file-recursive (from to ok-flag &optional preserve-time top recursive) (let ((attrs (file-attributes from)) @@ -1337,7 +1389,7 @@ Special value `always' suppresses confirmation." skipped (success-count 0) (total (length fn-list))) (let (to overwrite-query overwrite-backup-query) ; for dired-handle-overwrite - (mapcar + (mapc (function (lambda (from) (setq to (funcall name-constructor from)) @@ -1535,10 +1587,16 @@ Optional arg HOW-TO is used to set the value of the into-dir variable "Create a directory called DIRECTORY." (interactive (list (read-file-name "Create directory: " (dired-current-directory)))) - (let ((expanded (directory-file-name (expand-file-name directory)))) - (make-directory expanded) - (dired-add-file expanded) - (dired-move-to-filename))) + (let* ((expanded (directory-file-name (expand-file-name directory))) + (try expanded) new) + ;; Find the topmost nonexistent parent dir (variable `new') + (while (and try (not (file-exists-p try)) (not (equal new try))) + (setq new try + try (directory-file-name (file-name-directory try)))) + (make-directory expanded t) + (when new + (dired-add-file new) + (dired-move-to-filename)))) (defun dired-into-dir-with-symlinks (target) (and (file-directory-p target) |