From: Lennart Borgman <lennart.borgman.073@student.lu.se>
Subject: File name completion in *Shell* on w32
Date: Wed, 27 Dec 2006 01:16:42 +0100 [thread overview]
Message-ID: <4591BB6A.1070402@student.lu.se> (raw)
[-- Attachment #1: Type: text/plain, Size: 410 bytes --]
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.
[-- 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
reply other threads:[~2006-12-27 0:16 UTC|newest]
Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
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
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=4591BB6A.1070402@student.lu.se \
--to=lennart.borgman.073@student.lu.se \
/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 public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).