File name completion in w32 *Shell*

[Lennart Borgman (gmail)]

We noticed before that file name completion is broken in *Shell* on w32 
using cmd.exe for the shell process. The attached file contains code 
that can be used to fix this.

It does file name completion in the same style as cmd.exe.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w32-dynamic-complete-filename-like-cmd-fw ()
  "Tab style file name completion like cmd.exe.
Tries to do Tab style file name completion like cmd.exe on w32
does it.

See also `w32-dynamic-complete-filename-like-cmd-bw'."
  (interactive)
  (w32-dynamic-complete-filename-like-cmd t))

(defun w32-dynamic-complete-filename-like-cmd-bw ()
  "Shift-Tab style file name completion like cmd.exe.
Tries to do Shift-Tab style file name completion like cmd.exe on
w32 does it.

See also `w32-dynamic-complete-filename-like-cmd-fw'."
  (interactive)
  (w32-dynamic-complete-filename-like-cmd nil))

(defconst w32-dynamic-complete-state nil)

(defcustom w32-dynamic-complete-sync-dirs t
  "Synchronize process directory and `default-directory' if non-nil.
If non-nil then `w32-dynamic-complete-filename-like-cmd-fw' (and
dito -bw) will send an invisible \"cd\" to the process running
cmd.exe to find out what directory the cmd.exe process
uses. `default-directory' is then set to this directory."
  :type 'boolean
  :group 'w32)

(defcustom w32-dynamic-complete-only-dirs '("cd" "pushd")
  "Commands for which only directories should be shown.
When doing file name completion the commands in this list will
only get directory names.

This is used in `w32-dynamic-complete-filename-like-cmd-fw' (and
dito -bw)."
  :type '(repeat string)
  :group 'w32)

(defun w32-dynamic-complete-filename-like-cmd (forward)
  (let* ((proc (get-buffer-process (current-buffer)))
         (pmark (process-mark proc))
         (point (point))
         (cmdstr (buffer-substring-no-properties pmark point))
         (argv (w32-get-argv cmdstr))
         (first-arg (car argv))
         (last-arg (car (reverse argv)))
         (only-dirs (member (car first-arg) w32-dynamic-complete-only-dirs))
         (prev-cmdstr          (nth 0 w32-dynamic-complete-state))
         (prev-completion      (nth 1 w32-dynamic-complete-state))
         (prev-begin-filename  (nth 2 w32-dynamic-complete-state))
         (in-completion (string= cmdstr prev-cmdstr))
         (begin-filename prev-begin-filename)
         new-completion
         new-full-completion
         completion-dir
         completion-dir-given
         dir-files
         pick-next
         beginning-last
         )
    ;; Initialize
    (setq w32-dynamic-complete-state nil)
    (when last-arg
      (setq completion-dir-given (file-name-directory (car last-arg))))
    (if completion-dir-given
        (setq completion-dir-given
              (file-name-as-directory completion-dir-given))
      (setq completion-dir-given ""))
    ;; Not continuing completion set up for completion
    (unless in-completion
      (setq prev-completion nil)
      (if last-arg
          (setq begin-filename
                (concat "^" (file-name-nondirectory (car last-arg))))
        (setq begin-filename nil))
      ;; Sync process directory and default-directory
      (when w32-dynamic-complete-sync-dirs
        (let ((old-out-filter (process-filter proc)))
          (condition-case err
              (progn
                (set-process-filter
                 proc
                 (lambda(proc str)
                   (let ((lstr (split-string str "[\r\n]+")))
                     (setq default-directory
                           (file-name-as-directory (nth 1 lstr))))))
                (process-send-string proc "cd\n")
                (accept-process-output proc))
            (error (message "%s" (error-message-string err))))
          (set-process-filter proc old-out-filter))))
    ;; Find completion
    (setq completion-dir (expand-file-name completion-dir-given))
    (setq dir-files (directory-files completion-dir nil begin-filename))
    (unless forward
      (setq dir-files (reverse dir-files)))
    (dolist (f dir-files)
      (when (and (not (member f '("." "..")))
                 (or (not only-dirs)
                     (file-directory-p (expand-file-name f completion-dir))))
        (unless new-completion
          (setq new-completion f))
        (if (string= f prev-completion)
            (setq pick-next t)
          (when pick-next
            (setq pick-next nil)
            (setq new-completion f)))))
    (setq new-full-completion
          (convert-standard-filename
           (concat completion-dir-given new-completion)))
    ;; Replase last argument
    (setq beginning-last (nth 1 last-arg))
    (unless beginning-last
      (setq beginning-last 0))
    (goto-char (+ pmark beginning-last))
    (unless (eolp) (kill-line))
    ;; The code below should probably use shell-quote-argument, but
    ;; because of trouble with this function I am using a more
    ;; w32 specific quoting here at the moment.
    (if (not (memq ?\  (append new-full-completion nil)))
        (insert new-full-completion)
      (insert ?\")
      (insert new-full-completion)
      (insert ?\"))
    ;; Save completion state
    ;;
    ;; return non-nil to show completion has been done!
    (setq w32-dynamic-complete-state
          (list
           (buffer-substring-no-properties pmark (point))
           new-completion
           begin-filename))))

(defun w32-get-argv(cmdline)
  "Split CMDLINE into args.
The splitting is done using the syntax used on MS Windows.

Return a list where each element is a list in the form

  \(arg arg-begin arg-end)

where ARG is the argument stripped from any \". ARG-BEGIN and
ARG-END are the beginning and end of the argument in cmdline.

If CMDLINE ends with a space or is \"\" a list consisting of
\(\"\" LEN nil) is added. LEN is the length of CMDLINE."
  (let ((lcmd (append cmdline nil))
        (len (length cmdline))
        argv
        state
        arg
        arg-begin
        arg-end
        c
        )
    (while lcmd
      (setq c (car lcmd))
      (setq lcmd (cdr lcmd))
      (cond
       (  (not state)
          (when arg (error "arg not nil"))
          (cond
           ( (= c ?\ ))
           ( (= c ?\")
             (setq arg-begin (- len 1 (length lcmd)))
             (setq state 'state-qarg))
           ( t
             (setq arg-begin (- len 1 (length lcmd)))
             (setq state 'state-arg)
             (setq arg (cons c arg)))))
       (  (eq state 'state-arg)
          (cond
           ( (= c ?\ )
             (setq state nil)
             (setq arg-end (- len 1 (length lcmd)))
             (setq argv (cons
                         (list (concat (nreverse arg))
                               arg-begin
                               arg-end)
                         argv))
             (setq arg nil))
           ( (= c ?\")
             (setq state 'state-arg-q))
           ( t
             (setq arg (cons c arg)))))
       (  (eq state 'state-arg-q)
          (cond
           ( (= c ?\")
             (setq state 'state-arg))
           ( t
             (setq arg (cons c arg)))))
       (  (eq state 'state-qarg)
          (cond
           ( (= c ?\")
             (setq state 'state-qarg-q))
           ( t
             (setq arg (cons c arg)))))
       (  (eq state 'state-qarg-q)
          (cond
           ( (= c ?\ )
             (setq state nil)
             (setq arg-end (- len 1 (length lcmd)))
             (setq argv (cons
                         (list (concat (nreverse arg))
                               arg-begin
                               arg-end)
                         argv))
             (setq arg nil))
           ( (= c ?\")
             (setq arg (cons c arg))
             (setq state 'state-qarg))
           ( t
             (setq arg (cons c arg)))))
       (  t
          (error "unknown state=%s" state))
       ))
    (if arg
        (progn
          (setq arg-end (- len 0 (length lcmd)))
          (setq argv (cons
                      (list
                       (concat (nreverse arg))
                       arg-begin
                       arg-end)
                      argv)))
      (when (or (not c) (= c ?\ ))
        (setq argv (cons (list "" (length cmdstr) nil) argv))))
    (reverse argv)))

;; For testing:
(when nil
  (global-set-key [f9]         'w32-dynamic-complete-filename-like-cmd-fw)
  (global-set-key [(shift f9)] 'w32-dynamic-complete-filename-like-cmd-bw)
  )