* File name completion in w32 *Shell*
@ 2006-12-27 0:33 Lennart Borgman (gmail)
2006-12-27 14:44 ` Lennart Borgman (gmail)
0 siblings, 1 reply; 2+ messages in thread
From: Lennart Borgman (gmail) @ 2006-12-27 0:33 UTC (permalink / raw)
[-- Attachment #1: Type: text/plain, Size: 234 bytes --]
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.
[-- Attachment #2: w32compl-temp.el --]
[-- Type: text/plain, Size: 8226 bytes --]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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)
)
[-- Attachment #3: Type: text/plain, Size: 142 bytes --]
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 2+ messages in thread
* Re: File name completion in w32 *Shell*
2006-12-27 0:33 File name completion in w32 *Shell* Lennart Borgman (gmail)
@ 2006-12-27 14:44 ` Lennart Borgman (gmail)
0 siblings, 0 replies; 2+ messages in thread
From: Lennart Borgman (gmail) @ 2006-12-27 14:44 UTC (permalink / raw)
Lennart Borgman (gmail) wrote:
> 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.
>
Sorry for the double sending with two slightly different subjects. Mail
problems.
The attachment is exactly the same as in the message with subject "File
name completion in *Shell* on w32" sent about 15 minutes earlier.
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2006-12-27 14:44 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2006-12-27 0:33 File name completion in w32 *Shell* Lennart Borgman (gmail)
2006-12-27 14:44 ` Lennart Borgman (gmail)
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.