minibuffer-default-add-shell-commands (was: C-r and C-s in minibuffer should search completion)

[Juri Linkov]

Since minibuffer-default-add-function is now in CVS, it is possible
to install a feature approved by Richard in
http://lists.gnu.org/archive/html/emacs-devel/2007-12/msg00179.html

It adds commands from mailcap to the list of defaults of M-!.  I renamed
`dired-read-shell-command-default' to `mailcap-file-default-commands' as
Richard suggested, and moved it to mailcap.el (a question of moving the
file mailcap.el out of the gnus subdirectory should be decided by Gnus
maintainers).

Index: lisp/simple.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/simple.el,v
retrieving revision 1.913
diff -c -r1.913 simple.el
*** lisp/simple.el      29 Mar 2008 22:56:17 -0000      1.913
--- lisp/simple.el      30 Mar 2008 00:44:01 -0000
***************
*** 1960,1965 ****
--- 1990,2014 ----
  is run interactively.  A value of nil means that output to stderr and
  stdout will be intermixed in the output stream.")
  
+ (declare-function mailcap-file-default-commands "mailcap" (files))
+ 
+ (defun minibuffer-default-add-shell-commands ()
+   "Return a list of all commands associted with the current file.
+ This function is used to add all related commands retieved by `mailcap'
+ to the end of the list of defaults just after the default value."
+   (interactive)
+   (let* ((filename (if (listp minibuffer-default)
+                      (car minibuffer-default)
+                    minibuffer-default))
+        (commands (and filename (require 'mailcap nil t)
+                       (mailcap-file-default-commands (list filename)))))
+     (setq commands (mapcar (lambda (command)
+                            (concat command " " filename))
+                          commands))
+     (if (listp minibuffer-default)
+       (append minibuffer-default commands)
+       (cons minibuffer-default commands))))
+ 
  (defun minibuffer-complete-shell-command ()
    "Dynamically complete shell command at point."
    (interactive)
***************
*** 2034,2042 ****
  In an interactive call, the variable `shell-command-default-error-buffer'
  specifies the value of ERROR-BUFFER."
  
!   (interactive (list (read-shell-command "Shell command: ")
!                    current-prefix-arg
!                    shell-command-default-error-buffer))
    ;; Look for a handler in case default-directory is a remote file name.
    (let ((handler
         (find-file-name-handler (directory-file-name default-directory)
--- 2083,2096 ----
  In an interactive call, the variable `shell-command-default-error-buffer'
  specifies the value of ERROR-BUFFER."
  
!   (interactive
!    (let ((minibuffer-default-add-function
!         'minibuffer-default-add-shell-commands))
!      (list (read-shell-command "Shell command: " nil nil
!                              (and buffer-file-name
!                                   (file-relative-name buffer-file-name)))
!          current-prefix-arg
!          shell-command-default-error-buffer)))
    ;; Look for a handler in case default-directory is a remote file name.
    (let ((handler
         (find-file-name-handler (directory-file-name default-directory)

Index: lisp/dired-aux.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/dired-aux.el,v
retrieving revision 1.164
diff -c -r1.164 dired-aux.el
*** lisp/dired-aux.el   26 Mar 2008 03:34:06 -0000      1.164
--- lisp/dired-aux.el   30 Mar 2008 00:44:16 -0000
***************
*** 464,530 ****
  
  ;;; 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
  ;;  files are affected.
  ;;This is an extra function so that you can redefine it, e.g., to use gmhist."
!   (dired-mark-pop-up
!    nil 'shell files
!    (function read-string)
!    (format prompt (dired-mark-prompt arg files))
!    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 `&'.
--- 464,494 ----
  
  ;;; Shell commands
  
! (declare-function mailcap-file-default-commands "mailcap" (files))
! 
! (defun minibuffer-default-add-dired-shell-commands ()
!   "Return a list of all commands associted with current dired files.
! This function is used to add all related commands retieved by `mailcap'
! to the end of the list of defaults just after the default value."
!   (interactive)
!   (let ((commands (and (boundp 'files) (require 'mailcap nil t)
!                      (mailcap-file-default-commands files))))
!     (if (listp minibuffer-default)
!       (append minibuffer-default commands)
!       (cons minibuffer-default 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
  ;;  files are affected.
  ;;This is an extra function so that you can redefine it, e.g., to use gmhist."
!   (let ((minibuffer-default-add-function
!        'minibuffer-default-add-dired-shell-commands))
!     (dired-mark-pop-up
!      nil 'shell files
!      (function read-string)
!      (format prompt (dired-mark-prompt arg files))
!      nil 'shell-command-history)))
  
  ;; The in-background argument is only needed in Emacs 18 where
  ;; shell-command doesn't understand an appended ampersand `&'.

Index: lisp/gnus/mailcap.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/gnus/mailcap.el,v
retrieving revision 1.21
diff -c -r1.21 mailcap.el
*** lisp/gnus/mailcap.el        8 Jan 2008 20:45:19 -0000       1.21
--- lisp/gnus/mailcap.el        30 Mar 2008 00:44:07 -0000
***************
*** 1007,1012 ****
--- 1007,1059 ----
               (cdr l))))
        mailcap-mime-data)))))
  
+ ;;;
+ ;;; Useful functions
+ ;;;
+ 
+ (defun mailcap-file-default-commands (files)
+   "Return a list of default commands for FILES."
+   (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))
+ 
  (provide 'mailcap)
  
  ;;; arch-tag: 1fd4f9c9-c305-4d2e-9747-3a4d45baa0bd

-- 
Juri Linkov
http://www.jurta.org/emacs/