emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

File name completion in *Shell* on w32


From: Lennart Borgman
Subject: File name completion in *Shell* on w32
Date: Wed, 27 Dec 2006 01:16:42 +0100
User-agent: Thunderbird 1.5.0.9 (Windows/20061207)

File name completion in a *Shell* on w32 using cmd.exe for the shell process currently does not work. The attached file contains code that can be used to fix this bug.

It does not use the Emacs completion style but instead the completion style used by cmd.exe. Maybe it should do both?

I proposed before to sync the directory of the shell process with default-directory. This code also adds such a sync.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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)
  )


reply via email to

[Prev in Thread] Current Thread [Next in Thread]