From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Juri Linkov Newsgroups: gmane.emacs.devel Subject: minibuffer-default-add-shell-commands (was: C-r and C-s in minibuffer should search completion) Date: Sun, 30 Mar 2008 02:44:35 +0200 Organization: JURTA Message-ID: <8763v5axxc.fsf_-_@jurta.org> References: <87prtiik0l.fsf@jurta.org> <87iqz969fh.fsf@jurta.org> <87od9181m7.fsf@jurta.org> <87lk440z31.fsf@jurta.org> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: ger.gmane.org 1206839137 792 80.91.229.12 (30 Mar 2008 01:05:37 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sun, 30 Mar 2008 01:05:37 +0000 (UTC) Cc: emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sun Mar 30 03:06:08 2008 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1JflzP-00028e-Fu for ged-emacs-devel@m.gmane.org; Sun, 30 Mar 2008 03:05:49 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Jflyn-0004tm-Nq for ged-emacs-devel@m.gmane.org; Sat, 29 Mar 2008 21:05:01 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1Jflyj-0004sv-Gq for emacs-devel@gnu.org; Sat, 29 Mar 2008 21:04:57 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1Jflyf-0004rg-TN for emacs-devel@gnu.org; Sat, 29 Mar 2008 21:04:57 -0400 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Jflyf-0004rU-Pk for emacs-devel@gnu.org; Sat, 29 Mar 2008 21:04:53 -0400 Original-Received: from relay02.kiev.sovam.com ([62.64.120.197]) by monty-python.gnu.org with esmtps (TLS-1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.60) (envelope-from ) id 1Jflyf-0002El-3c for emacs-devel@gnu.org; Sat, 29 Mar 2008 21:04:53 -0400 Original-Received: from [83.170.232.243] (helo=smtp.svitonline.com) by relay02.kiev.sovam.com with esmtp (Exim 4.67) (envelope-from ) id 1Jflya-000GzD-K9; Sun, 30 Mar 2008 04:04:51 +0300 In-Reply-To: (Stefan Monnier's message of "Sat, 29 Mar 2008 00:03:42 -0400") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/23.0.60 (x86_64-pc-linux-gnu) X-Scanner-Signature: a314f5107568365df05be581a1a61003 X-DrWeb-checked: yes X-SpamTest-Envelope-From: juri@jurta.org X-SpamTest-Group-ID: 00000000 X-SpamTest-Header: Not Detected X-SpamTest-Info: Profiles 2516 [Mar 28 2008] X-SpamTest-Info: helo_type=3 X-SpamTest-Info: {HEADERS: header Content-Type found without required header Content-Transfer-Encoding} X-SpamTest-Info: {TO: local part of email appears in body} X-SpamTest-Method: none X-SpamTest-Rate: 15 X-SpamTest-Status: Not detected X-SpamTest-Status-Extended: not_detected X-SpamTest-Version: SMTP-Filter Version 3.0.0 [0278], KAS30/Release X-detected-kernel: by monty-python.gnu.org: FreeBSD 6.x (1) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:93851 Archived-At: 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/