all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: TSUCHIYA Masatoshi <tsuchiya@namazu.org>
To: Juri Linkov <juri@jurta.org>,
	Michael Albinus <michael.albinus@gmx.de>,
	Stefan Monnier <monnier@iro.umontreal.ca>,
	emacs-devel@gnu.org
Subject: Re: Feature request : Tab-completion for 'shell-comand'
Date: Wed, 12 Mar 2008 10:31:37 +0900	[thread overview]
Message-ID: <87skywrame.fsf@tsuchiya.vaj.namazu.org> (raw)
In-Reply-To: 87lk4r74gt.fsf@jurta.org

[-- Attachment #1: Type: text/plain, Size: 1355 bytes --]

Dear Emacs developers,

>> On Mon, 10 Mar 2008 03:29:02 +0200
>> juri@jurta.org (Juri Linkov) said as follows:

>> I think that the above code still have a problem: the above code
>> moves a cursor to the end of line temporarily.  I think that such
>> temoporal movement will confuse users.

>Yes, it would be too bad to move the cursor to the end of the line.
>But `minibuffer-message' doesn't do this: it leaves the cursor before
>the additional message appended to the minibuffer.

Thanks.  This is my first time to notice `minibuffer-message' because
the first version of shell-command.el was created when I used Mule-2.3
based on Emacs-19.34.

I have just prepared the minimized patch to support tab-completion
features for `shell-command' etc.  It is attached at the end of this
message.  Because several users do not want to see the current
directory, the default values of prompt options do not contain
%-sequences.

>However, I still don't see a solution for the problem how to display
>the message (such as "[Completing command name...]") without a delay,
>and leave it visible to the user persistently without interfering with
>the user input.

Persistently?  It may be quite difficult to realize, because
a completion function must know when it will disappear its temporal
message based on only user actions.

Regards,

-- 
TSUCHIYA Masatoshi

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: shell-command.diff --]
[-- Type: text/x-diff, Size: 10804 bytes --]

diff -ur emacs-22.1.orig/lisp/progmodes/compile.el emacs-22.1/lisp/progmodes/compile.el
--- emacs-22.1.orig/lisp/progmodes/compile.el	2007-05-25 21:43:33.000000000 +0900
+++ emacs-22.1/lisp/progmodes/compile.el	2008-03-12 10:18:31.641415258 +0900
@@ -490,6 +490,14 @@
 ;;;###autoload(put 'compile-command 'safe-local-variable 'stringp)
 
 ;;;###autoload
+(defcustom compile-prompt "Compile command: "
+  "*Prompt string of `compile' when tab-completion is enabled.
+Some %-sequences are available to customize this variable.  For more
+detail, see the document of `make-shell-prompt-string'."
+  :type 'string
+  :group 'compilation)
+
+;;;###autoload
 (defcustom compilation-disable-input nil
   "*If non-nil, send end-of-file as compilation process input.
 This only affects platforms that support asynchronous processes (see
@@ -901,11 +909,11 @@
    (list
     (let ((command (eval compile-command)))
       (if (or compilation-read-command current-prefix-arg)
-	  (read-from-minibuffer "Compile command: "
-				command nil nil
-				(if (equal (car compile-history) command)
-				    '(compile-history . 1)
-				  'compile-history))
+	  (read-shell-commmand (make-shell-prompt-string compile-prompt)
+			       command nil nil
+			       (if (equal (car compile-history) command)
+				   '(compile-history . 1)
+				 'compile-history))
 	command))
     (consp current-prefix-arg)))
   (unless (equal command (eval compile-command))
diff -ur emacs-22.1.orig/lisp/progmodes/grep.el emacs-22.1/lisp/progmodes/grep.el
--- emacs-22.1.orig/lisp/progmodes/grep.el	2007-04-08 11:08:48.000000000 +0900
+++ emacs-22.1/lisp/progmodes/grep.el	2008-03-12 10:16:13.785931321 +0900
@@ -91,6 +91,14 @@
 		 (const :tag "Not Set" nil))
   :group 'grep)
 
+;;;###autoload
+(defcustom grep-prompt "Run grep (like this): "
+  "*Prompt string of `grep' when tab-completion is enabled.
+Some %-sequences are available to customize this variable.  For more
+detail, see the document of `make-shell-prompt-string'."
+  :type 'string
+  :group 'grep)
+
 (defcustom grep-template nil
   "The default command to run for \\[lgrep].
 The default value of this variable is set up by `grep-compute-defaults';
@@ -127,6 +135,14 @@
 		 (const :tag "Not Set" nil))
   :group 'grep)
 
+;;;###autoload
+(defcustom grep-find-prompt "Run find (like this): "
+  "*Prompt string of `grep-find' when tab-completion is enabled.
+Some %-sequences are available to customize this variable.  For more
+detail, see the document of `make-shell-prompt-string'."
+  :type 'string
+  :group 'grep)
+
 (defcustom grep-find-template nil
   "The default command to run for \\[rgrep].
 The default value of this variable is set up by `grep-compute-defaults';
@@ -538,11 +554,11 @@
    (progn
      (grep-compute-defaults)
      (let ((default (grep-default-command)))
-       (list (read-from-minibuffer "Run grep (like this): "
-				   (if current-prefix-arg
-				       default grep-command)
-				   nil nil 'grep-history
-				   (if current-prefix-arg nil default))))))
+       (list (read-shell-commmand (make-shell-prompt-string grep-prompt)
+				  (if current-prefix-arg
+				      default grep-command)
+				  nil nil 'grep-history
+				  (if current-prefix-arg nil default))))))
 
   ;; Setting process-setup-function makes exit-message-function work
   ;; even when async processes aren't supported.
@@ -565,9 +581,9 @@
    (progn
      (grep-compute-defaults)
      (if grep-find-command
-	 (list (read-from-minibuffer "Run find (like this): "
-				     grep-find-command nil nil
-                                     'grep-find-history))
+	 (list (read-shell-commmand (make-shell-prompt-string grep-find-prompt)
+				    grep-find-command nil nil
+				    'grep-find-history))
        ;; No default was set
        (read-string
         "compile.el: No `grep-find-command' command available. Press RET.")
diff -ur emacs-22.1.orig/lisp/simple.el emacs-22.1/lisp/simple.el
--- emacs-22.1.orig/lisp/simple.el	2007-05-27 23:35:51.000000000 +0900
+++ emacs-22.1/lisp/simple.el	2008-03-12 10:22:27.999957912 +0900
@@ -1758,6 +1758,48 @@
 is run interactively.  A value of nil means that output to stderr and
 stdout will be intermixed in the output stream.")
 
+(defcustom shell-command-complete-functions
+  '(shell-dynamic-complete-environment-variable
+    shell-dynamic-complete-command
+    shell-replace-by-expanded-directory
+    comint-dynamic-complete-filename)
+  "*Function list to complete shell commands."
+  :type 'hook
+  :group 'shell)
+
+(defun read-shell-commmand (prompt &optional initial-contents keymap read
+				   hist default-value inherit-input-method)
+  "Read a command string in the minibuffer, with completion
+specified by `shell-command-complete-functions'."
+  (let ((new-keymap (make-sparse-keymap)))
+    (set-keymap-parent new-keymap (or keymap minibuffer-local-map))
+    (define-key new-keymap "\t"
+      (lambda ()
+	(interactive)
+	(let ((orig-function (symbol-function 'message)))
+	  (unwind-protect
+	      (progn
+		(defun message (string &rest arguments)
+		  (let ((minibuffer-message-timeout 2)
+			(s (apply (function format) string arguments)))
+		    (minibuffer-message (concat " [" s "]"))
+		    s))
+		(require 'shell)
+		(require 'comint)
+		(run-hook-with-args-until-success
+		 'shell-command-complete-functions))
+	    (fset 'message orig-function)))))
+    (read-from-minibuffer prompt initial-contents new-keymap read
+			  hist default-value inherit-input-method)))
+
+(defcustom shell-command-prompt
+  "Shell command: "
+  "*The prompt string for `shell-command' when tab-completion is enabled.
+Some %-sequences are available to customize this variable.  For more
+detail, see the document of `make-shell-prompt-string'."
+  :type 'string
+  :group 'shell)
+
 (defun shell-command (command &optional output-buffer error-buffer)
   "Execute string COMMAND in inferior shell; display output, if any.
 With prefix argument, insert the COMMAND's output at point.
@@ -1808,10 +1850,12 @@
 In an interactive call, the variable `shell-command-default-error-buffer'
 specifies the value of ERROR-BUFFER."
 
-  (interactive (list (read-from-minibuffer "Shell command: "
-					   nil nil nil 'shell-command-history)
-		     current-prefix-arg
-		     shell-command-default-error-buffer))
+  (interactive
+   (list (read-shell-commmand (make-shell-prompt-string shell-command-prompt
+							current-directory)
+			      nil nil nil 'shell-command-history)
+	 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)
@@ -1892,6 +1936,80 @@
 	    (shell-command-on-region (point) (point) command
 				     output-buffer nil error-buffer)))))))
 
+(defun make-shell-prompt-string (format-string &optional current-directory)
+  "Function to generate prompt string like shell
+
+Use FORMAT-STRING to generate prompt string at the directory
+CURRENT-DIRECTORY.  The following `%' escapes are available for use in
+FORMAT-STRING:
+
+%d     the date in \"Weekday Month Date\" format \(e.g., \"Tue May 26\"\)
+%h     the hostname up to the first `.'
+%H     the hostname
+%t     the current time in 24-hour HH:MM:SS format
+%T     the current time in 12-hour HH:MM:SS format
+%@     the current time in 12-hour am/pm format
+%u     the username of the current user
+%w     the current working directory
+%W     the basename of the current working directory
+%$     if the effective UID is 0, a #, otherwise a $
+%%     Insert a literal `%'.
+"
+  (unless current-directory
+    (setq current-directory default-directory))
+  (let ((case-fold-search nil)
+	start buf
+	(list (list format-string))
+	(alist (let ((system-name (system-name))
+		     host-name
+		     fqdn-name
+		     (time (current-time))
+		     (dir (directory-file-name
+			   (abbreviate-file-name current-directory))))
+		 (if (string-match "^\\([^.]+\\)\\.[^.]" system-name)
+		     (setq fqdn-name system-name
+			   host-name (match-string 1 system-name))
+		   (setq host-name system-name
+			 fqdn-name
+			 (cond
+			  ((and (boundp 'mail-host-address)
+				(stringp mail-host-address)
+				(string-match "\\." mail-host-address))
+			   mail-host-address)
+			  ((and user-mail-address
+				(string-match "\\." user-mail-address)
+				(string-match "@\\(.*\\)\\'"
+					      user-mail-address))
+			   (match-string 1 user-mail-address))
+			  (t system-name))))
+		 `(("%%" . "%")
+		   ("%d" . ,(format-time-string "%a %b %e" time))
+		   ("%h" . ,host-name)
+		   ("%H" . ,fqdn-name)
+		   ("%t" . ,(format-time-string "%H:%M:%S" time))
+		   ("%T" . ,(format-time-string "%I:%M:%S" time))
+		   ("%@" . ,(format-time-string "%I:%M%p" time))
+		   ("%u" . ,(user-login-name))
+		   ("%w" . ,dir)
+		   ("%W" . ,(file-name-nondirectory
+			     (directory-file-name current-directory)))
+		   ("%\\$" . ,(if (= (user-uid) 0) "#" "$"))))))
+    (while alist
+      (setq buf nil)
+      (while list
+	(setq start 0)
+	(while (string-match (car (car alist)) (car list) start)
+	  (setq buf (cons (cdr (car alist))
+			  (cons (substring (car list) start
+					   (match-beginning 0))
+				buf))
+		start (match-end 0)))
+	(setq buf (cons (substring (car list) start) buf)
+	      list (cdr list)))
+      (setq list (nreverse buf)
+	    alist (cdr alist)))
+    (apply 'concat list)))
+
 (defun display-message-or-buffer (message
 				  &optional buffer-name not-this-window frame)
   "Display MESSAGE in the echo area if possible, otherwise in a pop-up buffer.
@@ -1969,6 +2087,14 @@
 	       (car (cdr (cdr (process-command process))))
 	       (substring signal 0 -1))))
 
+(defcustom shell-command-on-region-prompt
+  "Shell command on region: "
+  "*Prompt string of `shell-command-on-region' when tab-completion is enabled.
+Some %-sequences are available to customize this variable.  For more
+detail, see the document of `make-shell-prompt-string'."
+  :type 'string
+  :group 'shell)
+
 (defun shell-command-on-region (start end command
 				      &optional output-buffer replace
 				      error-buffer display-error-buffer)
@@ -2027,9 +2153,11 @@
 		 ;; Do this before calling region-beginning
 		 ;; and region-end, in case subprocess output
 		 ;; relocates them while we are in the minibuffer.
-		 (setq string (read-from-minibuffer "Shell command on region: "
-						    nil nil nil
-						    'shell-command-history))
+		 (setq string
+		       (read-shell-commmand (make-shell-prompt-string
+					     shell-command-on-region-prompt)
+					    nil nil nil
+					    'shell-command-history))
 		 ;; call-interactively recognizes region-beginning and
 		 ;; region-end specially, leaving them in the history.
 		 (list (region-beginning) (region-end)

  parent reply	other threads:[~2008-03-12  1:31 UTC|newest]

Thread overview: 72+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2008-03-04 16:42 Feature request : Tab-completion for 'shell-comand' paul r
2008-03-04 21:54 ` Michael Albinus
2008-03-04 23:17   ` Juri Linkov
2008-03-05  1:55     ` Stefan Monnier
2008-03-06  8:40   ` TSUCHIYA Masatoshi
2008-03-06 10:04     ` Juri Linkov
2008-03-06 16:04       ` Stefan Monnier
2008-03-06 16:14         ` Drew Adams
2008-03-06 17:31         ` Miles Bader
2008-03-06 17:46           ` Drew Adams
2008-03-06 18:21           ` Stefan Monnier
2008-03-07  2:14             ` Miles Bader
2008-03-06 23:48           ` Juri Linkov
2008-03-06 17:48         ` Juri Linkov
2008-03-06 23:45           ` Juri Linkov
2008-03-06 23:47         ` Juri Linkov
2008-03-08 17:39         ` Richard Stallman
2008-03-08 22:21           ` Juri Linkov
2008-03-08 22:38             ` Lennart Borgman (gmail)
2008-03-08 22:57               ` Juri Linkov
2008-03-09  0:21                 ` Lennart Borgman (gmail)
2008-03-08 23:27               ` Stefan Monnier
2008-03-09 16:39             ` Richard Stallman
2008-03-09 17:45               ` Juri Linkov
2008-03-10  6:12                 ` Richard Stallman
2008-03-10 14:44                   ` Cannot build the trunk since unicode (was: Feature request : Tab-completion for 'shell-comand') Stefan Monnier
2008-03-11  9:24                     ` Richard Stallman
2008-03-11  9:40                       ` Andreas Schwab
2008-03-10 22:35                   ` Feature request : Tab-completion for 'shell-comand' Juri Linkov
2008-03-11 20:24                     ` Richard Stallman
2008-03-12  0:31                       ` Juri Linkov
2008-03-12 23:13                         ` Johan Bockgård
2008-03-12 23:19                           ` David Kastrup
2008-03-12 23:36                             ` Johan Bockgård
2008-03-13  2:14                           ` Juri Linkov
2008-03-13  9:28                             ` Johan Bockgård
2008-03-13 14:54                               ` Stefan Monnier
2008-03-13 19:02                                 ` martin rudalics
2008-03-14  2:54                                   ` Richard Stallman
2008-03-14  7:46                                     ` martin rudalics
2008-03-14 15:07                                       ` Stefan Monnier
2008-03-15  3:23                                       ` Richard Stallman
2008-03-15  3:24                                       ` Richard Stallman
2008-03-14  3:21                                   ` Stefan Monnier
2008-03-14  7:47                                     ` martin rudalics
2008-03-14 15:05                                       ` Stefan Monnier
2008-03-14 18:33                                         ` martin rudalics
2008-03-14 19:20                                           ` Stefan Monnier
2008-03-14 22:31                                             ` martin rudalics
2008-03-15  0:59                                               ` Stefan Monnier
2008-03-16 14:24                                             ` martin rudalics
2008-03-16 18:28                                               ` Stefan Monnier
2008-03-17  7:36                                                 ` martin rudalics
2008-03-17 15:00                                                   ` Stefan Monnier
2008-03-14  1:04                           ` Juri Linkov
2008-03-09 14:01       ` TSUCHIYA Masatoshi
2008-03-09 17:48         ` Juri Linkov
2008-03-10  0:08           ` TSUCHIYA Masatoshi
2008-03-10  0:57             ` Drew Adams
2008-03-10  1:29             ` Juri Linkov
2008-03-10  2:20               ` Johan Bockgård
2008-03-10  2:37                 ` Lennart Borgman (gmail)
2008-03-10 22:31                   ` Juri Linkov
2008-03-12  1:31               ` TSUCHIYA Masatoshi [this message]
2008-03-12  2:12                 ` Stefan Monnier
2008-03-12 10:42                   ` Juri Linkov
2008-03-15  8:29                   ` TSUCHIYA Masatoshi
2008-03-15 10:24                     ` paul r
2008-03-15 21:35                     ` Juri Linkov
2008-03-20 19:58                     ` Stefan Monnier
2008-03-20 20:55                       ` Juri Linkov
2008-03-21 17:17                         ` Stefan Monnier

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87skywrame.fsf@tsuchiya.vaj.namazu.org \
    --to=tsuchiya@namazu.org \
    --cc=emacs-devel@gnu.org \
    --cc=juri@jurta.org \
    --cc=michael.albinus@gmx.de \
    --cc=monnier@iro.umontreal.ca \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.