[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH] Win32 Cywin/dos TAB completion support
|
From: |
Jari Aalto+mail.emacs |
|
Subject: |
[PATCH] Win32 Cywin/dos TAB completion support |
|
Date: |
Mon, 28 Jan 2002 02:12:28 +0200 |
|
User-agent: |
Gnus/5.090006 (Oort Gnus v0.06) Emacs/20.7 (i386-*-nt5.0.2195) (i386-*-nt5.0.2195) |
I've submitted this patch more than a year ago, and now when Emacs
21.1 is out, I re-evaluated it and made it even better.
Now it also supports completion in DOS shell, plus paths with
spaces. The completions shoudl work for Unix too, though I
haven't tested it there. Please send failing test cases and I'll
dig into the code further.
There is new function, which will make all cygwin users happy:
M-x w32-cygwin-bash
The cygwin completion support expects that the prompt is configured in
format:
ANYTHING [anything...] ABSOLUTE-PATH DELIMITER PROMPT
Which means that prompt like this, or similar, should be recognized.
The only requirement is that immediately to the left of the DELIMITER
is the path portion in prompt.
address@hidden /usr/src/cvs-source/emacs $ echo $PS1
| | |
ANYTHING ABSOLUTE-PATH DELIMITER
that is, something like this in ~/.bashrc will do:
export PS1='address@hidden \w \$ '
The recognized delimiters are:
% csh, tcsh
$ bash
> dos (some use it in unix too)
# Root shell
To use new dirtrack support:
Nothing is needed. It's now fallback if `dirtrack-list' fails.
The heuristics now can automatically track different shell.
To activate dirtrack and enjoy completion:
(autoload 'dirtrack "dirtrack")
(add-hook 'shell-mode-hook 'my-dirtrack-hook)
(defun my-dirtrack-hook ()
(pushnew 'dirtrack comint-preoutput-filter-functions :test 'equal))
Test with cases like below. Notice that completing for space-directorie
need double quote at the beginning
COMPLETING IN DOS:
M-x shell (in windows this opens cmdproxy)
This works partially, but it is not recommended. You should always
Use double quote in DOS completions if there are spaces in path
names:
C:\>cd c:
C:\>cd pro[TAB] => Program Files\
C:\>cd program files\Out[TAB] => [sorry, this cannot be handled]
Without initial quote, you have to step a directory at a time:
C:\>cd pro[TAB] => Program Files\
1. C:\Program Files>cd Out[TAB] => Outlook Express\
2. C:\Program Files\Outlook Express>
If you start the completion wiht INITIAL QUOTE, all works. The
initial quote is allowed under dos:
C:\>cd c:
C:\>cd "pro[TAB] => "Program Files\
C:\>cd "pro[TAB]\Out[TAB] => "Program Files\Outlook Express
COMPLETING IN CYGWIN BASH
Make sure you have $HOME/.bashrc set to
export PS1='address@hidden \w \$ '
Start bash with:
M-x w32-cygwin-bash
Now tey completing path names:
$ cd c:
$ cd Pro[TAB] => Program\ Files
$ cd /cygdrive/c/Pro[TAB] => /cygdrive/c/Program\ Files/
$ cd /cygdrive/c/Pro[TAB]Ou{TAB]=> /cygdrive/c/Program\ Files/Outlook\
Express/
I would suggest making adding dirtrack active at Emacs startup. It's
so essential to be able to complete filenames and directories:
(autoload 'dirtrack "dirtrack")
(add-hook 'shell-mode-hook 'my-dirtrack-hook)
(defun my-dirtrack-hook ()
(pushnew 'dirtrack comint-preoutput-filter-functions :test 'equal))
I would have generated the patch against the CVS lisp, but the
mingw compilation with latest Emacs is still not working
in my environment, so I didn't have a change to check how
it works with latest CVS Emacs.
The patch should apply cleanly to CVS sources accoding to
test below.
Jari
//address@hidden /usr/src/cvs-source/emacs/lisp $
patching file `comint.el'
Hunk #2 succeeded at 2598 (offset 81 lines).
Hunk #4 succeeded at 2868 (offset 81 lines).
Hunk #6 succeeded at 2900 (offset 81 lines).
patching file `dirtrack.el'
patching file `w32-fns.el'
Hunk #2 succeeded at 70 (offset -5 lines).
Hunk #3 succeeded at 317 (offset -3 lines).
2002-01-28 Jari Aalto <address@hidden>
* comint.el (comint-previous-char-quote-p): New function.
(comint-skip-chars-backward-until-quote): New Function.
(comint-previous-char-whitespcae-p): New function.
(comint-previous-char-slash-whitespcae-p): New Function.
(comint-word-read-quoted-space): New function.
2002-01-27 Jari Aalto <address@hidden>
* comint.el (comint-match-partial-filename): Rewritten.
Handle path names with spaces.
(comint-move-backward-quote): New function.
2002-01-16 Jari Aalto <address@hidden>
* comint.el (comint-directory-sep-char): New function.
Separate support for dos and cygwin path separators.
(comint-dynamic-complete-as-filename): New function.
Support Cygwin bash completion and well as DOS completion.
(comint-treat-path-name-for-shell): New function.
Treat paths with spaces differently depending on
`shell-file-name'.
(comint-dynamic-complete-as-filename-1): Added cygwin
path and DOS completion support.
(comint-process-command): New function.
* w32-fns.el (original-make-auto-save-file-name): Protected
from re-definition if w32-fns.el is loaded again. Without
this check, Emacs went into auto-save loop if w32-fns.el
was loaded again.
(w32-cygwin-path-p): New function.
(w32-dos-path-to-cygwin): New function.
(w32-cygwin-path-to-dos): New function.
(w32-cygwin-bash): New. Make Cygwin *shell-bash* buffer.
(w32-system-shell-like-p): New function. Include
cmdproxy.exe in `w32-system-shells' test.
* dirtrack.el (dirtrack): Rewrote function to be more
intelligent with paths. If `dirtrack-list' fails, then
additional heuristics kicks in and tries to determine
PATH from the command prompt itself. The only requirement
is that the command prompt is in format
'ANYTHING HERE ABSOLUTE-PATH-DISPLAY $'. The prompt delimiter
at the end can be $ % and #.
(dirtrack-guess-promt-dir): New function. Tries various
ways to get path (current location, previous prompt location).
(dirtrack-guess-promt-dir-examine): New function.
Parses the prompt to find suitable path.
diff -x *# -x *elc -x ChangeLog -bwc -F (def
/cygdrive/h/bin/emacs/gnu-emacs/emacs-21.1/lisp/comint.el
/cygdrive/h/bin/emacs/gnu-emacs/emacs-21.1/lisp-patched/comint.el
*** /cygdrive/h/bin/emacs/gnu-emacs/emacs-21.1/lisp/comint.el Wed Jan 16
10:37:40 2002
--- /cygdrive/h/bin/emacs/gnu-emacs/emacs-21.1/lisp-patched/comint.el Mon Jan
28 01:37:34 2002
***************
*** 147,152 ****
--- 147,157 ----
;; comint-completion-autolist boolean completion
behavior
;; comint-completion-recexact boolean ...
+ (eval-and-compile
+ (autoload 'w32-system-shell-p "w32-fns")
+ (autoload 'w32-cygwin-path-p "w32-fns")
+ (autoload 'w32-cygwin-path-to-dos "w32-fns"))
+
(defgroup comint nil
"General command interpreter in a window stuff."
:group 'processes)
*************** (defun comint-substitute-in-file-name (f
*** 2512,2537 ****
(setq name (replace-match env-var-val t t name))))))
name))
(defun comint-match-partial-filename ()
"Return the filename at point, or nil if non is found.
Environment variables are substituted. See `comint-word'."
! (let ((filename (comint-word comint-file-name-chars)))
! (and filename (comint-substitute-in-file-name
(comint-unquote-filename filename)))))
(defun comint-quote-filename (filename)
"Return FILENAME with magic characters quoted.
Magic characters are those in `comint-file-name-quote-list'."
! (if (null comint-file-name-quote-list)
! filename
(let ((regexp
(format "\\(^\\|[^\\]\\)\\([%s]\\)"
(mapconcat 'char-to-string comint-file-name-quote-list ""))))
(save-match-data
(while (string-match regexp filename)
! (setq filename (replace-match "\\1\\\\\\2" nil nil filename)))
! filename))))
(defun comint-unquote-filename (filename)
"Return FILENAME with quoted characters unquoted."
--- 2517,2668 ----
(setq name (replace-match env-var-val t t name))))))
name))
+
+ (defun comint-previous-char-quote-p ()
+ "Check if previous character is single or duoble quote.
+ Return quote character."
+ (let ((char (char-after (1- (point)))))
+ (car (member char '(?\' ?\")))))
+
+ (defun comint-previous-char-whitespcae-p ()
+ "Xheck if previous character is whitespcae."
+ (member (char-after (1- (point)))
+ '(?\ ?\t ?\r \?n)))
+
+ (defun comint-previous-char-slash-whitespcae-p ()
+ "Check if previous tqo characters are SLASH + space: \"\\ \"."
+ (and (comint-previous-char-whitespcae-p)
+ (let ((char (char-after (- (point) 2))))
+ (equal char ?\\))))
+
+
+ (defun comint-move-backward-quote ()
+ "Move backward if previous character is single or double quote.
+ Return quote character."
+ (let ((char (comint-previous-char-quote-p)))
+ (when char
+ (forward-char -1)
+ char)))
+
+
+ (defun comint-skip-chars-backward-until-quote ()
+ "Skip backward on line until quote, if cursor is next to non-whitespace.
+ Position point after quote character if skipped backward."
+ (unless (comint-previous-char-whitespcae-p)
+ ;; Suppose "directory path\"more<point>
+ (let ((point (point)))
+ (unless (zerop (skip-chars-backward "^'\"" (line-beginning-position)))
+ ;; point was moved
+ (if (comint-previous-char-quote-p)
+ (point)
+ ;; We didn't see quote at this point. Restore position.
+ (goto-char point)
+ nil)))))
+
+
+ (defun comint-word-read-quoted-space ()
+ "Read previous space quoted word.
+
+ temp\\test\\ di => temp\\test\\ di
+ temp\\test\\ dir\\here => temp\\test\\ dir\\here.
+
+ Return:
+
+ '(word (beg end))."
+ (let ((beg (point))
+ end)
+ (save-excursion
+ (while (and (not
+ (zerop
+ (skip-chars-backward
+ "^ \t\r\n" (line-beginning-position))))
+ (comint-previous-char-slash-whitespcae-p)
+ (progn (forward-char -2) t)
+ (not (bobp))))
+ (unless (eq (setq end (point)) beg)
+ (let ((string (buffer-substring beg end)))
+ ;; Convert slash-space "\ " into single SPACE
+ (setq string (replace-regexp-in-string "[\\] " " " string))
+ (list string (list beg end)))))))
+
+
+
+ (defun comint-word-read-quoted ()
+ "Read previous quoted word.
+ \"Directory na => Directory na
+ \"Directory name\" => Directory name\
+ \"Directory name\"and more => Directory name\and more.
+
+ Return list:
+
+ '(word (beg end char))
+
+ word = The word within quotes
+ char = quote character found
+ beg = begin position of word
+ end = end position of word."
+ (let ((line-beg (line-beginning-position))
+ (point (point))
+ skipped
+ beg
+ end
+ char)
+ (save-excursion
+ ;; Check if the previous character is non-whitespace,
+ ;; that is: cursor is next to "something".
+ (when (comint-skip-chars-backward-until-quote)
+ (setq skipped t)
+ (setq beg point))
+ (when (setq char (comint-move-backward-quote))
+ ;; "directory path"<point>
+ ;; Skip backward until starting delimiter is found.
+ (unless beg
+ (setq beg (point)))
+ (when (or (search-backward (char-to-string char) line-beg t)
+ skipped)
+ (setq end (1+ (point)))
+ (let ((string (buffer-substring beg end)))
+ ;; We have to clean out the extra Quote in between
+ ;;
+ ;; directory path\"more
+ ;; |
+ ;; remove this quote
+ (if (string-match "^\\([^\"']+\\)[\"']\\(.*\\)" string)
+ (setq string
+ (concat (match-string 1 string)
+ (or (match-string 2 string) ""))))
+ (list string (list beg end char))))))))
+
+
+
(defun comint-match-partial-filename ()
"Return the filename at point, or nil if non is found.
Environment variables are substituted. See `comint-word'."
! (let (quoted-data
! filename)
! (cond
! ((setq quoted-data (or (comint-word-read-quoted)
! (comint-word-read-quoted-space)))
! (setq filename (car quoted-data)))
! (t
! (setq filename (comint-word comint-file-name-chars))))
! (if filename
! (comint-substitute-in-file-name
(comint-unquote-filename filename)))))
(defun comint-quote-filename (filename)
"Return FILENAME with magic characters quoted.
Magic characters are those in `comint-file-name-quote-list'."
! (when comint-file-name-quote-list
(let ((regexp
(format "\\(^\\|[^\\]\\)\\([%s]\\)"
(mapconcat 'char-to-string comint-file-name-quote-list ""))))
(save-match-data
(while (string-match regexp filename)
! (setq filename (replace-match "\\1\\\\\\2" nil nil filename))))))
! (setq filename (comint-treat-path-name-for-shell filename))
! filename)
(defun comint-unquote-filename (filename)
"Return FILENAME with quoted characters unquoted."
*************** (defun comint-dynamic-complete-filename
*** 2574,2582 ****
(message "Completing file name..."))
(comint-dynamic-complete-as-filename)))
(defun comint-dynamic-complete-as-filename ()
"Dynamically complete at point as a filename.
! See `comint-dynamic-complete-filename'. Returns t if successful."
(let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt)))
(completion-ignored-extensions comint-completion-fignore)
;; If we bind this, it breaks remote directory tracking in rlogin.el.
--- 2705,2781 ----
(message "Completing file name..."))
(comint-dynamic-complete-as-filename)))
+ (defun comint-directory-sep-char ()
+ "Return appropriate `directory-sep-char' which see.
+ The value depends on the current value of `shell-file-name'.
+ If this is cmd.*exe, then suppose w32 type dos shell."
+ ;; The shel may also be Vygwin based bash.exe, but for
+ ;; cmd.exe, cmdproxy.exe and the like, the separatr must be \
+ (if (w32-system-shell-like-p (file-name-nondirectory shell-file-name))
+ ?\\
+ ?/))
+
+
(defun comint-dynamic-complete-as-filename ()
+ "Call `comint-dynamic-complete-as-filename-1'. Return t on success."
+ (if (not (fboundp 'dirtrack))
+ (comint-dynamic-complete-as-filename-1)
+ (let* ((point (point))
+ (path (buffer-substring
+ (save-excursion
+ (skip-chars-backward "^ \t\r\n")
+ (point))
+ point)))
+
+ ;; It is possible that user uses an shell alias that changes the
+ ;; the current directory and the dirtrack.el didn't have a chance
+ ;; to see the "cd ..." prompt to set correct directory.
+ ;;
+ ;; bashrc: alias goemacs='cd $EMACS_HOME'
+ ;;
+ ;; But after this command, the path hopefully shows the current
location
+ ;; and we can make a second guess abount completion.
+
+ (cond
+ ((not (string-match "^/" path))
+ ;; this is relative completion, calculate ROOT
+ (dirtrack (buffer-substring
+ (line-beginning-position)
+ (line-end-position)))))
+
+ ;; dirtrack set `default-directory', but user may be now requesting
+ ;; and absolute CD. The PATH-HERE was fixed by dirtrack for relative
+ ;; completions.
+ ;;
+ ;; promt PATH-HERE > cd //c/temp[TAB]
+
+ (comint-dynamic-complete-as-filename-1))))
+
+ (defun comint-process-command (&optional buffer)
+ "Return `process-command' for current buffer or BUFFER."
+ (process-command (get-buffer-process (or buffer (current-buffer)))))
+
+
+ (defun comint-treat-path-name-for-shell (path)
+ "In Cygwin and Unix like shells, the space characters must be quoted
+
+ bash$ cd c:
+ bash$ cd prog[TAB]
+ bash$ cd Program\ Files/."
+ (when (stringp path)
+ (let ((w32-p (w32-system-shell-like-p
+ (or (car-safe (comint-process-command)) "")))
+ (space-p (string-match " " path)))
+ (when (and space-p (not w32-p))
+ (setq path (replace-regexp-in-string " " "\\\\ " path)))))
+ path)
+
+
+
+
+ (defun comint-dynamic-complete-as-filename-1 ()
"Dynamically complete at point as a filename.
! See `comint-dynamic-complete-filename'. Return message string id succesful."
(let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt)))
(completion-ignored-extensions comint-completion-fignore)
;; If we bind this, it breaks remote directory tracking in rlogin.el.
*************** (defun comint-dynamic-complete-as-filena
*** 2588,2594 ****
(dirsuffix (cond ((not comint-completion-addsuffix)
"")
((not (consp comint-completion-addsuffix))
! (char-to-string directory-sep-char))
(t
(car comint-completion-addsuffix))))
(filesuffix (cond ((not comint-completion-addsuffix)
--- 2787,2793 ----
(dirsuffix (cond ((not comint-completion-addsuffix)
"")
((not (consp comint-completion-addsuffix))
! (char-to-string (comint-directory-sep-char)))
(t
(car comint-completion-addsuffix))))
(filesuffix (cond ((not comint-completion-addsuffix)
*************** (defun comint-dynamic-complete-as-filena
*** 2598,2605 ****
(t
(cdr comint-completion-addsuffix))))
(filename (or (comint-match-partial-filename) ""))
! (pathdir (file-name-directory filename))
! (pathnondir (file-name-nondirectory filename))
(directory (if pathdir (comint-directory pathdir) default-directory))
(completion (file-name-completion pathnondir directory)))
(cond ((null completion)
--- 2797,2812 ----
(t
(cdr comint-completion-addsuffix))))
(filename (or (comint-match-partial-filename) ""))
! (cygwin-p (and (memq system-type '(windows-nt ms-dos))
! (w32-cygwin-path-p filename)))
! (pathdir (file-name-directory
! (if cygwin-p
! (w32-cygwin-path-to-dos filename)
! filename)))
! (pathnondir (file-name-nondirectory
! (if cygwin-p
! (w32-cygwin-path-to-dos filename)
! filename)))
(directory (if pathdir (comint-directory pathdir) default-directory))
(completion (file-name-completion pathnondir directory)))
(cond ((null completion)
*************** (defun comint-dynamic-complete-as-filena
*** 2612,2621 ****
((string-equal completion "") ; Means completion on "directory/".
(comint-dynamic-list-filename-completions))
(t ; Completion string returned.
! (let ((file (concat (file-name-as-directory directory) completion)))
! (insert (comint-quote-filename
(substring (directory-file-name completion)
(length pathnondir))))
(cond ((symbolp (file-name-completion completion directory))
;; We inserted a unique completion.
(insert (if (file-directory-p file) dirsuffix filesuffix))
--- 2819,2848 ----
((string-equal completion "") ; Means completion on "directory/".
(comint-dynamic-list-filename-completions))
(t ; Completion string returned.
! (let ((file (concat (file-name-as-directory directory) completion))
! (w32-p (w32-system-shell-like-p
! (or (car-safe (comint-process-command)) "")))
! space-p
! insert)
!
! (setq insert (comint-quote-filename
(substring (directory-file-name completion)
(length pathnondir))))
+
+ (setq space-p (string-match " " insert))
+
+ ;; In dos, you must include double quotes around path
+ ;; with spaces to be on the safe side.
+ ;;
+ ;; cd c:
+ ;; cd "Program Files
+ ;;
+ ;; cd \
+ ;; dir "Program Files
+
+ (insert insert) ;; Complete
+
+
(cond ((symbolp (file-name-completion completion directory))
;; We inserted a unique completion.
(insert (if (file-directory-p file) dirsuffix filesuffix))
diff -x *# -x *elc -x ChangeLog -bwc -F (def
/cygdrive/h/bin/emacs/gnu-emacs/emacs-21.1/lisp/dirtrack.el
/cygdrive/h/bin/emacs/gnu-emacs/emacs-21.1/lisp-patched/dirtrack.el
*** /cygdrive/h/bin/emacs/gnu-emacs/emacs-21.1/lisp/dirtrack.el Wed Jan 16
10:37:40 2002
--- /cygdrive/h/bin/emacs/gnu-emacs/emacs-21.1/lisp-patched/dirtrack.el Wed Jan
16 15:45:32 2002
***************
*** 119,124 ****
--- 119,125 ----
;;; Code:
(eval-when-compile
+ (autoload 'w32-cygwin-path-to-dos "w32-fns")
(require 'comint)
(require 'shell))
*************** (defcustom dirtrack-list (list "^emacs \
*** 140,168 ****
:group 'dirtrack
:type '(sexp (regexp :tag "Prompt Expression")
(integer :tag "Regexp Group")
! (boolean :tag "Multiline Prompt")
! )
! )
(make-variable-buffer-local 'dirtrack-list)
(defcustom dirtrack-debug nil
"*If non-nil, the function `dirtrack' will report debugging info."
:group 'dirtrack
! :type 'boolean
! )
(defcustom dirtrack-debug-buffer "*Directory Tracking Log*"
"Buffer to write directory tracking debug information."
:group 'dirtrack
! :type 'string
! )
(defcustom dirtrackp t
"*If non-nil, directory tracking via `dirtrack' is enabled."
:group 'dirtrack
! :type 'boolean
! )
(make-variable-buffer-local 'dirtrackp)
--- 141,164 ----
:group 'dirtrack
:type '(sexp (regexp :tag "Prompt Expression")
(integer :tag "Regexp Group")
! (boolean :tag "Multiline Prompt")))
(make-variable-buffer-local 'dirtrack-list)
(defcustom dirtrack-debug nil
"*If non-nil, the function `dirtrack' will report debugging info."
:group 'dirtrack
! :type 'boolean)
(defcustom dirtrack-debug-buffer "*Directory Tracking Log*"
"Buffer to write directory tracking debug information."
:group 'dirtrack
! :type 'string)
(defcustom dirtrackp t
"*If non-nil, directory tracking via `dirtrack' is enabled."
:group 'dirtrack
! :type 'boolean)
(make-variable-buffer-local 'dirtrackp)
*************** (defcustom dirtrack-directory-function
*** 172,193 ****
'dirtrack-default-directory-function)
"*Function to apply to the prompt directory for comparison purposes."
:group 'dirtrack
! :type 'function
! )
(defcustom dirtrack-canonicalize-function
(if (memq system-type (list 'ms-dos 'windows-nt))
'downcase 'identity)
"*Function to apply to the default directory for comparison purposes."
:group 'dirtrack
! :type 'function
! )
(defcustom dirtrack-directory-change-hook nil
"Hook that is called when a directory change is made."
:group 'dirtrack
! :type 'hook
! )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
--- 168,186 ----
'dirtrack-default-directory-function)
"*Function to apply to the prompt directory for comparison purposes."
:group 'dirtrack
! :type 'function)
(defcustom dirtrack-canonicalize-function
(if (memq system-type (list 'ms-dos 'windows-nt))
'downcase 'identity)
"*Function to apply to the default directory for comparison purposes."
:group 'dirtrack
! :type 'function)
(defcustom dirtrack-directory-change-hook nil
"Hook that is called when a directory change is made."
:group 'dirtrack
! :type 'hook)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
*************** (defun dirtrack-replace-slash (string &o
*** 225,232 ****
(replace (if opposite
dirtrack-forward-slash
dirtrack-backward-slash))
! (newstring string)
! )
(while (string-match orig newstring)
(setq newstring (replace-match replace nil t newstring)))
newstring))
--- 218,224 ----
(replace (if opposite
dirtrack-forward-slash
dirtrack-backward-slash))
! (newstring string))
(while (string-match orig newstring)
(setq newstring (replace-match replace nil t newstring)))
newstring))
*************** (defun dirtrack-toggle ()
*** 236,260 ****
"Enable or disable Dirtrack directory tracking in a shell buffer."
(interactive)
(setq dirtrackp (not dirtrackp))
! (message "Directory tracking %s" (if dirtrackp "ON" "OFF")))
(defun dirtrack-debug-toggle ()
"Enable or disable Dirtrack debugging."
(interactive)
(setq dirtrack-debug (not dirtrack-debug))
! (message "Directory debugging %s" (if dirtrack-debug "ON" "OFF"))
(and dirtrack-debug
(display-buffer (get-buffer-create dirtrack-debug-buffer))))
(defun dirtrack-debug-message (string)
(let ((buf (current-buffer))
! (debug-buf (get-buffer-create dirtrack-debug-buffer))
! )
(set-buffer debug-buf)
(goto-char (point-max))
(insert (concat string "\n"))
! (set-buffer buf)
! ))
;;;###autoload
(defun dirtrack (input)
--- 228,352 ----
"Enable or disable Dirtrack directory tracking in a shell buffer."
(interactive)
(setq dirtrackp (not dirtrackp))
! (message "dirtrack: Directory tracking %s" (if dirtrackp "ON" "OFF")))
(defun dirtrack-debug-toggle ()
"Enable or disable Dirtrack debugging."
(interactive)
(setq dirtrack-debug (not dirtrack-debug))
! (message "dirtrack: Directory debugging %s" (if dirtrack-debug "ON" "OFF"))
(and dirtrack-debug
(display-buffer (get-buffer-create dirtrack-debug-buffer))))
(defun dirtrack-debug-message (string)
(let ((buf (current-buffer))
! (debug-buf (get-buffer-create dirtrack-debug-buffer)))
(set-buffer debug-buf)
(goto-char (point-max))
(insert (concat string "\n"))
! (set-buffer buf)))
!
! (defun dirtrack-guess-promt-dir-examine (&optional prompt)
! "Seek backward for previous comint prompt and try to read the directory.
! The directory is assumed to be available in the prompt itself. The
! prompr is expected to be in format:
!
! ANYTHING-YOU-LIKE<SPACE>PATH[SPACE]PROMPT-DELIMITER
!
! This means, that prompts like these are recognized:
!
! address@hidden ~/tmp $
! /tmp/dir%
!
! A special case is included for dos prompt in format:
!
! c:\direcrory>"
! (or prompt
! (setq prompt
! (save-excursion
! (comint-previous-prompt 1)
! (buffer-substring (line-beginning-position)
! ;; Point will be at the beginning of promt
! (point)))))
! (let (ret)
! (cond
! ;; Remember, windows path names can include spaces, that's
! ;; why [^\t\n\r]*
! ;;
! ((string-match "^\\([A-Za-z]:[\\][^\t\n\r]*\\)>" prompt)
! (setq ret (match-string 1 prompt)))
! ;;
! ;; Absolute prompt at the start, expect it to end to standard
! ;; shell delimiters [$%#>]
! ;;
! ;; Exclude double // in prompt like
! ;;
! ;; //address@hidden ~ $
! ;;
! ((and (not (string-match "^//" prompt))
! (string-match "^\\(/[^ \t\r\n$%#>]+\\)" prompt))
! (setq ret (match-string 1 prompt)))
! ;; Treat cygwin environment with care: expect spaces
! ((string-match "\\(/cygdrive.*[^ ]\\) *[$%#]" prompt)
! (setq ret (w32-cygwin-path-to-dos (match-string 1 prompt)))))
!
!
! ;; Now, assume that prompt is the last word - Err, space in path names
! ;; cannot be handled correctly.
! ;;
! ;; ANYTHING ANYTHING PROMPT>
!
! (unless ret
! (let ((words (split-string prompt)))
! (when (> (length words) 1)
! ;; start examing backwards
! (dolist (word (reverse words))
! (unless (string-match "[][$%><]" word)
! (return (setq ret word)))))))
!
! ret))
!
!
! (defun dirtrack-guess-promt-dir (input)
! "Examine promt dir for possible path in it."
! (let (prompt-path)
! (if dirtrack-debug
! (dirtrack-debug-message
! (format
! (concat
! "dirtrack: Trying heuristics, because `dirtrack-list' "
! " [%s] cannot find dir from promtp [%s]")
! dirtrack-regexp input)))
!
! ;; Try guessing
! (setq prompt-path (dirtrack-guess-promt-dir-examine input))
!
! ;; The INPUT did not contain root dir information.
! ;; read full prompt.
! (when (or (not (stringp prompt-path))
! (not (file-directory-p prompt-path)))
! (setq prompt-path
! (dirtrack-guess-promt-dir-examine
! (save-excursion
! (re-search-backward "[$%#>]" nil (line-beginning-position))
! (buffer-substring (line-beginning-position)
! (1+ (point)))))))
!
! ;; Still no luck, try previous prompt
! (when (or (not (stringp prompt-path))
! (not (file-directory-p prompt-path)))
! (setq prompt-path (dirtrack-guess-promt-dir-examine)))
!
! ;; Nope. Give up. Clear return value.
! (cond
! ((and (stringp prompt-path)
! (not (file-directory-p prompt-path)))
! (setq prompt-path nil))
! ((stringp prompt-path)
! (setq prompt-path (expand-file-name prompt-path))))
!
! prompt-path))
!
;;;###autoload
(defun dirtrack (input)
*************** (defun dirtrack (input)
*** 269,319 ****
You can enable directory tracking by adding this function to
`comint-output-filter-functions'.
"
! (if (null dirtrackp)
! nil
! (let (prompt-path
matched
(current-dir default-directory)
(dirtrack-regexp (nth 0 dirtrack-list))
(match-num (nth 1 dirtrack-list))
! (multi-line (nth 2 dirtrack-list))
! )
! ;; No output?
! (if (eq (point) (point-min))
! nil
(save-excursion
! (setq matched (string-match dirtrack-regexp input)))
! ;; No match
! (if (null matched)
! (and dirtrack-debug
(dirtrack-debug-message
(format
! "Input `%s' failed to match regexp: %s"
! input dirtrack-regexp)))
! (setq prompt-path
! (substring input
! (match-beginning match-num) (match-end match-num)))
! ;; Empty string
! (if (not (> (length prompt-path) 0))
! (and dirtrack-debug
! (dirtrack-debug-message "Match is empty string"))
;; Transform prompts into canonical forms
! (setq prompt-path (funcall dirtrack-directory-function
prompt-path))
(setq current-dir (funcall dirtrack-canonicalize-function
current-dir))
! (and dirtrack-debug
(dirtrack-debug-message
(format
! "Prompt is %s\nCurrent directory is %s"
! prompt-path current-dir)))
;; Compare them
(if (or (string= current-dir prompt-path)
(string= current-dir
(abbreviate-file-name prompt-path)))
! (and dirtrack-debug
(dirtrack-debug-message
! (format "Not changing directory")))
;; It's possible that Emacs will think the directory
;; won't exist (eg, rlogin buffers)
(if (file-accessible-directory-p prompt-path)
--- 361,424 ----
You can enable directory tracking by adding this function to
`comint-output-filter-functions'.
"
! (when (and dirtrackp
! (stringp input))
! (let (prompt-path1
! prompt-path
matched
(current-dir default-directory)
(dirtrack-regexp (nth 0 dirtrack-list))
(match-num (nth 1 dirtrack-list))
! (multi-line (nth 2 dirtrack-list)))
! (when (not (eq (point) (point-min))) ;; No output?
(save-excursion
!
! (cond
! ((string-match dirtrack-regexp input)
! (setq prompt-path
! (substring
! input
! (match-beginning match-num) (match-end match-num))))
! (t
! (setq prompt-path (dirtrack-guess-promt-dir input))))
!
!
! (cond
! ((null prompt-path) ;; No match
! (if dirtrack-debug
(dirtrack-debug-message
(format
! "dirtrack: Input `%s' failed to match regexp: %s"
! input dirtrack-regexp))))
! ((not (> (length prompt-path) 0)) ;; Empty string
! (if dirtrack-debug
! (dirtrack-debug-message "Match is empty string")))
! (t
!
;; Transform prompts into canonical forms
! (setq prompt-path1 (funcall dirtrack-directory-function
prompt-path))
+
+ (if (memq system-type '(windows-nt ms-dos))
+ (setq prompt-path (w32-cygwin-path-to-dos prompt-path1))
+ (setq prompt-path prompt-path1))
+
(setq current-dir (funcall dirtrack-canonicalize-function
current-dir))
!
! (if dirtrack-debug
(dirtrack-debug-message
(format
! "dirtrack: Prompt is %s -> %s\nCurrent directory is %s"
! prompt-path1 prompt-path current-dir)))
!
;; Compare them
(if (or (string= current-dir prompt-path)
(string= current-dir
(abbreviate-file-name prompt-path)))
! (if dirtrack-debug
(dirtrack-debug-message
! (format "dirtrack: Not changing directory")))
;; It's possible that Emacs will think the directory
;; won't exist (eg, rlogin buffers)
(if (file-accessible-directory-p prompt-path)
*************** (defun dirtrack (input)
*** 323,330 ****
dirtrack-debug
(dirtrack-debug-message
(format "Changing directory to %s" prompt-path)))
! (error "Directory %s does not exist" prompt-path)))
! )))))
input)
(provide 'dirtrack)
--- 428,434 ----
dirtrack-debug
(dirtrack-debug-message
(format "Changing directory to %s" prompt-path)))
! (error "dirtrack: Directory %s does not exist"
prompt-path)))))))))
input)
(provide 'dirtrack)
diff -x *# -x *elc -x ChangeLog -bwc -F (def
/cygdrive/h/bin/emacs/gnu-emacs/emacs-21.1/lisp/w32-fns.el
/cygdrive/h/bin/emacs/gnu-emacs/emacs-21.1/lisp-patched/w32-fns.el
*** /cygdrive/h/bin/emacs/gnu-emacs/emacs-21.1/lisp/w32-fns.el Wed Jan 16
10:37:48 2002
--- /cygdrive/h/bin/emacs/gnu-emacs/emacs-21.1/lisp-patched/w32-fns.el Wed Jan
16 17:54:06 2002
***************
*** 34,39 ****
--- 34,44 ----
;;; Code:
+ (eval-and-compile
+ (autoload 'shell "shell" "" t)
+ (autoload 'comint-check-proc "comint"))
+
+
;; Map delete and backspace
(define-key function-key-map [backspace] "\177")
(define-key function-key-map [delete] "\C-d")
*************** (defun w32-shell-name ()
*** 70,80 ****
--- 75,164 ----
(and (w32-using-nt) "cmd.exe")
"command.com"))
+
+ (defun w32-cygwin-path-p (path)
+ "Check PATH is like cygwin //c /cygdrive/c."
+ (and path
+ (string-match "^//[a-z]\\|^/cygdrive/" path)))
+
+ (defun w32-dos-path-to-cygwin (path)
+ "Convert dos PATH c:/temp to cygwin v1.1+ like /cygdrive/c/temp."
+ (and path
+ (if (not (string-match "^\\([a-z]\\):\\(.*\\)" path))
+ path
+ (setq path (format "/cygdrive/%s%s"
+ (match-string 1 path)
+ (match-string 2 path)))
+ (subst-char-in-string ?\\ ?/ path))))
+
+ (defun w32-cygwin-path-to-dos (path)
+ "Convert cygwin like //c/temp or /cygdrive/c/temp path to
+ dos notation c:/temp."
+ ;; NOTE for cygwin and bash shell prompt
+ ;; We can't require a slash after the drive letter, because
+ ;; //c and /cygdrive/c are all top level roots.
+ ;;
+ ;; The bash shell's PS1 setting \w (The current working directory)
+ ;; Does not add trailing slash.
+ (cond
+ ((or (string-match "^//\\([a-z]\\)/?$" path)
+ (string-match "^/cygdrive/\\([a-z]\\)/?$" path))
+ (concat (match-string 1 path) ":/"))
+ ((or (string-match "^//\\([a-z]\\)\\(/.*\\)" path)
+ (string-match "^/cygdrive/\\([a-z]\\)\\(/.*\\)" path))
+ (concat (match-string 1 path) ":" (match-string 2 path)))
+ ((string-match "^(/cygdrive/./\\|//" path)
+ ;; if previous regexps couldn't handle it, this is severe error.
+ (error "Invalid path format for cygwin %s" path))
+ (t
+ path)))
+
+
+ (defun w32-cygwin-bash ()
+ "Run Cygwin bash shell."
+ (interactive)
+ (if (comint-check-proc "*shell-bash*")
+ (pop-to-buffer "*shell-bash*")
+ (let* ((shell (and (get-buffer "*shell*")))
+ (shell-file-name "bash")
+ (explicit-shell-file-name shell-file-name)
+ (explicit-sh-args '("-login" "-i"))
+ (w32-quote-process-args ?\"));; Use Cygnus quoting rules.
+ ;; there is previous *shell* buffer, move it by
+ ;; renaming it temporarily.
+ (when shell
+ (with-current-buffer shell
+ (rename-uniquely)))
+ (shell)
+ ;; By default Emacs send "\r\n", but bash wants plain "\n"
+ (set-buffer-process-coding-system 'undecided-dos 'undecided-unix)
+ ;; This variable is not local to buffer, make it.
+ (make-local-variable 'comint-completion-addsuffix)
+ (setq comint-completion-addsuffix '("/" . ""))
+ ;; This variable is local to buffer
+ (setq comint-prompt-regexp "^[ \n\t]*[$] ?")
+ (rename-buffer (generate-new-buffer-name "*shell-bash*"))
+ ;; Restore original *shell* buffer
+ (when shell
+ (with-current-buffer shell
+ (rename-buffer "*shell*"))))))
+
+
+
(defun w32-system-shell-p (shell-name)
(and shell-name
(member (downcase (file-name-nondirectory shell-name))
w32-system-shells)))
+ (defun w32-system-shell-like-p (shell-name)
+ "Check if SHELL-NAME is native windows (dos) type shell."
+ (let((w32-system-shells (append ;; Include Eamcs dos-shell too.
+ (list
+ "cmdproxy.exe"
+ "cmdproxy")
+ w32-system-shells)))
+ (w32-system-shell-p shell-name)))
+
(defun w32-shell-dos-semantics ()
"Return t if the interactive shell being used expects msdos shell
semantics."
(or (w32-system-shell-p (w32-shell-name))
*************** (defun w32-init-info ()
*** 236,243 ****
; (expand-file-name ".." exec-directory)))))
;; Avoid creating auto-save file names containing invalid characters.
(fset 'original-make-auto-save-file-name
! (symbol-function 'make-auto-save-file-name))
(defun make-auto-save-file-name ()
"Return file name to use for auto-saves of current buffer.
--- 320,328 ----
; (expand-file-name ".." exec-directory)))))
;; Avoid creating auto-save file names containing invalid characters.
+ (if (not (fboundp 'original-make-auto-save-file-name))
(fset 'original-make-auto-save-file-name
! (symbol-function 'make-auto-save-file-name)))
(defun make-auto-save-file-name ()
"Return file name to use for auto-saves of current buffer.
- [PATCH] Win32 Cywin/dos TAB completion support,
Jari Aalto+mail.emacs <=