diff options
| -rw-r--r-- | lisp/dired-aux.el | 78 |
1 files changed, 22 insertions, 56 deletions
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index c030e381174..8b5da77efce 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el | |||
| @@ -464,67 +464,33 @@ with a prefix argument." | |||
| 464 | 464 | ||
| 465 | ;;; Shell commands | 465 | ;;; Shell commands |
| 466 | 466 | ||
| 467 | (declare-function mailcap-parse-mailcaps "mailcap" (&optional path force)) | 467 | (declare-function mailcap-file-default-commands "mailcap" (files)) |
| 468 | (declare-function mailcap-parse-mimetypes "mailcap" (&optional path force)) | 468 | |
| 469 | (declare-function mailcap-extension-to-mime "mailcap" (extn)) | 469 | (defun minibuffer-default-add-dired-shell-commands () |
| 470 | (declare-function mailcap-mime-info "mailcap" | 470 | "Return a list of all commands associted with current dired files. |
| 471 | (string &optional request no-decode)) | 471 | This function is used to add all related commands retieved by `mailcap' |
| 472 | 472 | to the end of the list of defaults just after the default value." | |
| 473 | (defun dired-read-shell-command-default (files) | 473 | (interactive) |
| 474 | "Return a list of default commands for `dired-read-shell-command'." | 474 | (let ((commands (and (boundp 'files) (require 'mailcap nil t) |
| 475 | (require 'mailcap) | 475 | (mailcap-file-default-commands files)))) |
| 476 | (mailcap-parse-mailcaps) | 476 | (if (listp minibuffer-default) |
| 477 | (mailcap-parse-mimetypes) | 477 | (append minibuffer-default commands) |
| 478 | (let* ((all-mime-type | 478 | (cons minibuffer-default commands)))) |
| 479 | ;; All unique MIME types from file extensions | ||
| 480 | (delete-dups (mapcar (lambda (file) | ||
| 481 | (mailcap-extension-to-mime | ||
| 482 | (file-name-extension file t))) | ||
| 483 | files))) | ||
| 484 | (all-mime-info | ||
| 485 | ;; All MIME info lists | ||
| 486 | (delete-dups (mapcar (lambda (mime-type) | ||
| 487 | (mailcap-mime-info mime-type 'all)) | ||
| 488 | all-mime-type))) | ||
| 489 | (common-mime-info | ||
| 490 | ;; Intersection of mime-infos from different mime-types; | ||
| 491 | ;; or just the first MIME info for a single MIME type | ||
| 492 | (if (cdr all-mime-info) | ||
| 493 | (delq nil (mapcar (lambda (mi1) | ||
| 494 | (unless (memq nil (mapcar | ||
| 495 | (lambda (mi2) | ||
| 496 | (member mi1 mi2)) | ||
| 497 | (cdr all-mime-info))) | ||
| 498 | mi1)) | ||
| 499 | (car all-mime-info))) | ||
| 500 | (car all-mime-info))) | ||
| 501 | (commands | ||
| 502 | ;; Command strings from `viewer' field of the MIME info | ||
| 503 | (delq nil (mapcar (lambda (mime-info) | ||
| 504 | (let ((command (cdr (assoc 'viewer mime-info)))) | ||
| 505 | (if (stringp command) | ||
| 506 | (replace-regexp-in-string | ||
| 507 | ;; Replace mailcap's `%s' placeholder | ||
| 508 | ;; with dired's `?' placeholder | ||
| 509 | "%s" "?" | ||
| 510 | (replace-regexp-in-string | ||
| 511 | ;; Remove the final filename placeholder | ||
| 512 | "\s*\\('\\)?%s\\1?\s*\\'" "" command nil t) | ||
| 513 | nil t)))) | ||
| 514 | common-mime-info)))) | ||
| 515 | commands)) | ||
| 516 | 479 | ||
| 517 | ;; This is an extra function so that you can redefine it, e.g., to use gmhist. | 480 | ;; This is an extra function so that you can redefine it, e.g., to use gmhist. |
| 518 | (defun dired-read-shell-command (prompt arg files) | 481 | (defun dired-read-shell-command (prompt arg files) |
| 519 | "Read a dired shell command prompting with PROMPT (using read-string). | 482 | "Read a dired shell command prompting with PROMPT (using read-shell-command). |
| 520 | ARG is the prefix arg and may be used to indicate in the prompt which | 483 | ARG is the prefix arg and may be used to indicate in the prompt which |
| 521 | FILES are affected." | 484 | FILES are affected." |
| 522 | (dired-mark-pop-up | 485 | (minibuffer-with-setup-hook |
| 523 | nil 'shell files | 486 | (lambda () |
| 524 | #'read-shell-command | 487 | (set (make-local-variable 'minibuffer-default-add-function) |
| 525 | (format prompt (dired-mark-prompt arg files)) | 488 | 'minibuffer-default-add-dired-shell-commands)) |
| 526 | nil nil | 489 | (dired-mark-pop-up |
| 527 | (dired-read-shell-command-default files))) | 490 | nil 'shell files |
| 491 | #'read-shell-command | ||
| 492 | (format prompt (dired-mark-prompt arg files)) | ||
| 493 | nil nil))) | ||
| 528 | 494 | ||
| 529 | ;; The in-background argument is only needed in Emacs 18 where | 495 | ;; The in-background argument is only needed in Emacs 18 where |
| 530 | ;; shell-command doesn't understand an appended ampersand `&'. | 496 | ;; shell-command doesn't understand an appended ampersand `&'. |