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

[Juri Linkov <juri@jurta.org>]

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 ****
  \f
  ;;; 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 ----
  \f
  ;;; 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/