Re: Feature request : Tab-completion for 'shell-comand'

[TSUCHIYA Masatoshi]

Dear Emacs developers,

>> On Mon, 10 Mar 2008 03:29:02 +0200
>> address@hidden (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

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)