changelog shortlog tags changeset files revisions annotate raw

w32shell.el

changeset 66: 5b737eefe5ea
author: kim.vanwyk
date: Wed Nov 10 15:19:03 2010 +0200 (18 months ago)
permissions: -rw-r--r--
description: Adding CSharp Mode and Google Weather 
     1;;; w32shell.el --- Helpers for inferior shells on w32

     2

     3;; Copyright (C) 2005, 2006 by Lennart Borgman

     4;;

     5;; Author: Lennart Borgman

     6;; Created: Tue Nov 22 01:07:13 2005

     7;; Version: 0.52

     8;; Last-Updated: Thu Dec 28 15:34:00 2006 (3600 +0100)

     9;; Keywords:

    10;; Compatibility: Emacs 22

    11;;

    12;;

    13;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    14;;

    15;;; Commentary:

    16;;

    17;; On w32 you sometimes need an inferior shell like GNU bash for

    18;; installations and other purposes. (Note: An "inferior" process in

    19;; Emacs is a subprocess.) You may also need to have the Emacs bin

    20;; directory in path at the same time. The main purpose of this

    21;; package is to make this easier. There are however also some helper

    22;; functions for manipulating paths on w32.

    23;;

    24;; To choose shell customize group the `w32shell'.

    25;;

    26;; To run interactive shells you can use `cygwin-shell', `msys-shell'

    27;; and `cmd-shell'.

    28;;

    29;; Notice that you can get the paths to cygwin and MSYS automatically

    30;; if you use EmacsW32. From the menu bar choose Options - Customize

    31;; EmacsW32... and then let Emacs search for those paths.

    32;;

    33;; Put this in your .emacs:

    34;;

    35;;     (require 'w32shell)

    36;;

    37;;

    38;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    39;;

    40;;; Change log:

    41;;

    42;; 2005-12-15 More careful check of shell exec.

    43;; 2005-12-21 (w32shell-delayed-customize): No dialog box.

    44;; 2005-12-22 (w32shell-set-shell): Call cygwin-mount-activate later.

    45;; 2006-12-13 Added support for gnuwin32 progs that comes with EmacsW32

    46;;

    47;;

    48;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    49;;

    50;;; Code:

    51

    52(eval-when-compile (require 'cl))

    53

    54;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    55;;; Helpers

    56(defun w32shell-in-exec-path(path)

    57  (let ((dc-exec-path (mapcar (lambda(elt)

    58                                (downcase elt))

    59                              exec-path)))

    60    (member (downcase path) dc-exec-path)))

    61

    62(defun w32shell-add-exec-path(path &optional append)

    63  (unless (w32shell-in-exec-path path)

    64    (add-to-list 'exec-path path append)))

    65

    66(defun w32shell-remove-exec-path(path)

    67  (let (inpath

    68        (dcpath (downcase path)))

    69    (mapc (lambda(elt)

    70            (when (equal dcpath (downcase elt))

    71              (setq inpath elt)))

    72          exec-path)

    73    (when inpath

    74      (setq exec-path (delete inpath exec-path)))))

    75

    76

    77(defun w32shell-in-envpath(path)

    78  (let ((envpath (replace-regexp-in-string "\\\\" "/" (getenv "PATH")))

    79        (norpath (replace-regexp-in-string "\\\\" "/" path))

    80        (case-fold-search t))

    81    (string-match (concat "\\(?:^\\|;\\)" (regexp-quote norpath) "\\($\\|;\\)") envpath)))

    82

    83(defun w32shell-add-envpath(path &optional append)

    84  (unless (w32shell-in-envpath path)

    85    (let ((bslash-path (replace-regexp-in-string "/" "\\\\" path)))

    86      (if append

    87          (setenv "PATH" (concat (getenv "PATH") ";" bslash-path))

    88        (setenv "PATH" (concat bslash-path ";" (getenv "PATH")))))))

    89

    90(defun w32shell-remove-envpath(path)

    91  (let ((envpath (replace-regexp-in-string "\\\\" "/" (getenv "PATH")))

    92        (pos (w32shell-in-envpath path))

    93        )

    94    (while pos

    95      (let* (

    96             (sub1 (if (= 0 pos) "" (substring envpath 0 pos)))

    97             (sub2 (substring envpath (+ pos 1 (length path))))

    98             (newenvpath (replace-regexp-in-string "/" "\\\\" (concat sub1 sub2))))

    99        (setenv "PATH" newenvpath))

   100      (setq envpath (replace-regexp-in-string "\\\\" "/" (getenv "PATH")))

   101      (setq pos (w32shell-in-envpath path))

   102      )))

   103

   104

   105

   106;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

   107;;; Emacs itself in path

   108;; FIx-me: is this needed?

   109;; (defun w32shell-emacs-path()

   110;;   (file-name-as-directory exec-directory))

   111;;   (if (string= "/" (substring exec-directory -1))

   112;;                         (setq emacs-path (substring exec-directory 0 -1))

   113;;                       exec-directory))

   114(defun w32shell-emacsw32-gnuwin32-bindir()

   115  ;;(lwarn '(w32shell-emacsw32-gnuwin32-bindir) :warning "exec-directory=%s" exec-directory)

   116  (let* ((top (directory-file-name

   117               (file-name-directory

   118                (directory-file-name

   119                 (file-name-directory

   120                  (directory-file-name

   121                   exec-directory))))))

   122         (emacsw32 (directory-file-name

   123                    (expand-file-name "EmacsW32" top)))

   124         (gnuwin32 (directory-file-name

   125                    (expand-file-name "gnuwin32" emacsw32)))

   126         (bin (expand-file-name  "bin" gnuwin32)))

   127    ;;(lwarn '(w32shell-emacsw32-gnuwin32-bindir) :warning "top=%s" top)

   128    ;;(lwarn '(w32shell-emacsw32-gnuwin32-bindir) :warning "emacsw32=%s" emacsw32)

   129    ;;(lwarn '(w32shell-emacsw32-gnuwin32-bindir) :warning "bin=%s" bin)

   130    (when (file-directory-p bin)

   131      (file-name-as-directory bin))))

   132

   133(defun w32shell-add-emacs(&optional append)

   134  "Add Emacs itself to the path of inferior shells."

   135  (interactive)

   136  (w32shell-add-envpath exec-directory)

   137  (w32shell-add-exec-path exec-directory))

   138(defun w32shell-remove-emacs()

   139  "Remove Emacs itself from the path of inferior shells."

   140  (interactive)

   141  (w32shell-remove-envpath exec-directory)

   142  (w32shell-remove-exec-path exec-directory))

   143

   144

   145;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

   146;;; Choosing a w32 shell for Emacs

   147

   148(defun w32shell-delayed-customize(msg symbol)

   149  (let ((use-dialog-box nil)

   150        (is-group (get symbol 'custom-group)))

   151    (when (y-or-n-p (format "%s. Do you want to customize %s now? " msg symbol))

   152      (if is-group

   153          (customize-group symbol)

   154        (customize-option symbol)))))

   155

   156(defun w32shell-verify-bindir(bin-sym shexe)

   157  "If BIN-SYM value is a sh bin directory name return it.

   158Otherwise offer the user at idle time to customize it.

   159

   160Helper for `w32shell-set-shell'."

   161  (let ((standard-value (car (get bin-sym 'standard-value)))

   162        (bindir (symbol-value bin-sym))

   163        errmsg exefile)

   164    (if (equal bindir standard-value)

   165        (setq errmsg (concat "You must set " (symbol-name bin-sym)))

   166      (if (file-directory-p bindir)

   167          (progn

   168            ;;(setq exefile (concat bindir "/" shexe))

   169            (setq exefile (expand-file-name shexe (file-name-as-directory bindir)))

   170            (unless (file-executable-p exefile)

   171              (setq errmsg (concat "Can't find file " exefile))))

   172        (setq errmsg (concat "Can't find directory " bindir))))

   173    (if errmsg

   174        (let ((use-dialog-box nil))

   175          (lwarn '(w32shell) :warning errmsg)

   176          (unless (eq major-mode 'custom-mode)

   177            (with-timeout (6 (progn

   178                               (lwarn '(w32shell) :warning "Ok, please customize w32shell later!")

   179                               (message "Time out, continuing")))

   180              (w32shell-delayed-customize errmsg 'w32shell)))

   181          nil)

   182      bindir)))

   183

   184(defvar w32shell-current-shell-path nil)

   185

   186(defcustom w32shell-wanted-progs

   187  '("grep" "find" "xargs" "cmp" "diff" "diff3" "cmp" "patch" "locate")

   188  "List of programs that are checked for availability.

   189This list of programs are searched for in your path by

   190`executable-find' when calling `w32shell-set-shell'.  If any of

   191them is not found a warning is given."

   192  :type '(repeat string)

   193  :group 'w32shell)

   194

   195;; Fix-me: write a function that checks consistency against this!

   196(defun w32shell-set-shell(shellname)

   197  "Set shell to use for inferior shells.

   198This sets `shell-file-name' and the environment variable SHELL.

   199

   200Accepted values for SHELLNAME are \"cmd\", \"cygwin\" and

   201\"msys\".

   202

   203If SHELLNAME is \"cygwin\" then it calls `cygwin-mount-activate'.

   204

   205If SHELLNAME is \"cygwin\" or \"msys\" then the corresponding bin

   206directory is added to path.

   207

   208This function checks if the programs in `w32shell-wanted-progs'

   209that may be used from the inferior shells are available.  If they

   210are not a warning will be given. It also checks if 'find' is the

   211unix style find or not.

   212

   213Returns non-nil if success."

   214  (interactive

   215   (list

   216    (let* ( (history '("cmd" "msys" "cygwin"))

   217            (history-length (length history)) )

   218      (completing-read "Choose shell: " '("cmd" "msys" "cygwin") nil t "cygwin" 'history))))

   219  ;;(lwarn '(w32shell) :warning "Calling w32shell-set-shell %s" shellname)

   220  (let (bin shell)

   221    (cond (  (equal shellname "cygwin")

   222             (setq bin (w32shell-verify-bindir 'w32shell-cygwin-bin "bash.exe"))

   223             (when bin

   224               (setq shell "bash")

   225               (setenv "PS1" "Cygwin \\w > "))

   226             )

   227          (  (equal shellname "msys")

   228             (setq bin (w32shell-verify-bindir 'w32shell-msys-bin "sh.exe"))

   229             (when bin

   230               (setq shell "sh")

   231               (setenv "PS1" "MSYS \\w > "))

   232             )

   233          (  (equal shellname "cmd")

   234             (setq bin (w32shell-emacsw32-gnuwin32-bindir))

   235             ;;(lwarn '(w32shell) :warning "cmd cond, bin=%s" bin)

   236             (setq shell (expand-file-name "cmdproxy.exe" exec-directory))

   237             )

   238          (  t

   239             (error "Unrecognized shell name: %s" shellname)))

   240    (when (or bin shell)

   241      (when bin

   242        (unless (file-directory-p bin)

   243          (error "Can't find directory %s" bin)))

   244      (when w32shell-current-shell-path

   245        (w32shell-remove-exec-path w32shell-current-shell-path)

   246        (w32shell-remove-envpath   w32shell-current-shell-path)

   247        (setq w32shell-current-shell-path nil))

   248      (cond ( (equal shellname "cmd")

   249              (setq process-coding-system-alist nil)

   250              (setq w32-process-args nil)

   251              (remove-hook 'comint-output-filter-functions

   252                           'comint-strip-ctrl-m)

   253              )

   254            ( (or (equal shellname "cygwin") (equal shellname "msys"))

   255              ;;(setq process-coding-system-alist '((shell-file-name . undecided-unix)))

   256              ;;(setq process-coding-system-alist (list (cons shell-file-name 'undecided-unix)))

   257              (setq w32-process-args ?\")

   258              ;; For Java?:

   259              (add-hook 'comint-output-filter-functions 'comint-strip-ctrl-m)

   260              )

   261            )

   262      (when shell

   263        ;;(lwarn '(w32shell) :warning "bin=%s, shell-name=%s" bin shellname)

   264        (when bin

   265          (w32shell-add-exec-path bin)

   266          (w32shell-add-envpath bin))

   267        (setq w32shell-current-shell-path bin)

   268        ;; Call cygwin-mount. After an idea by Ismael Valladolid Torres:

   269        (when (equal shellname "cygwin")

   270          (when (require 'cygwin-mount nil t)

   271            (cygwin-mount-activate)))

   272        (setq shell-file-name shell) ; Single shell

   273        ;;(setenv "SHELL" shell-file-name) ; Single shell

   274        ;;(setq explicit-shell-file-name shell-file-name)

   275        ;; Some sanity checks:

   276        (w32shell-check-wanted-progs)

   277        ))

   278    bin))

   279

   280(defun w32shell-get-missing-progs()

   281  (let ((missing))

   282    (dolist (prog w32shell-wanted-progs)

   283      (unless (executable-find prog)

   284        (add-to-list 'missing prog)))

   285    missing))

   286

   287(defun w32shell-find-is-unix-find()

   288  (let ((find-prog (executable-find "find"))

   289        (findstr-prog (executable-find "findstr")))

   290    (not (string= (file-name-directory find-prog)

   291                  (file-name-directory findstr-prog)))))

   292

   293(defun w32shell-check-wanted-progs()

   294  "Checks if `w32shell-wanted-progs' are available.

   295This depends on `w32shell'."

   296  (interactive)

   297  (dolist (prog (w32shell-get-missing-progs))

   298    (lwarn '(w32shell) :warning

   299           (concat "When using '" shellname "' program '" prog "' can't be found")))

   300  (unless (w32shell-find-is-unix-find)

   301    (lwarn '(w32shell) :warning

   302           (concat "When using '" shellname "' program 'find'"

   303                   " will be Windows' find, should be unix' find"))))

   304

   305(defun w32shell-quote-argument (argument)

   306  "Like `shell-quote-argument' but knows about w32shell."

   307  (unless (eq system-type 'windows-nt) (error "You can only use this on w32"))

   308  (let ((system-type (if (string= "cmd" shell-file-name)

   309                         system-type

   310                       'gnu/linux)))

   311      (shell-quote-argument argument)))

   312

   313

   314;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

   315;;; Custom

   316

   317(defgroup w32shell nil

   318  "Customization group for w32shell"

   319  :group 'w32)

   320

   321(defcustom w32shell-cygwin-bin ""

   322  "Path to Cygwin bin directory.

   323Note that you can set this automatically from the menus through

   324Options - Customize EmacsW32 if you are using EmacsW32."

   325  :type 'directory

   326  :group 'w32shell)

   327

   328(defcustom w32shell-msys-bin ""

   329  "Path to MSYS bin directory.

   330Note that you can set this automatically from the menus through

   331Options - Customize EmacsW32 if you are using EmacsW32."

   332  :type 'directory

   333  :group 'w32shell)

   334

   335(defvar w32shell-old nil)

   336(defcustom w32shell-shell nil

   337  "Shell to use for `shell' command.

   338Value should be 'cmd, 'cygwin or 'msys.  If it is cygwin or msys

   339those utilities bin path are put first in path.

   340

   341Setting is done with `w32shell-set-shell'."

   342  ;; Make sure emacsw32 is loaded:

   343  ;;:set-after '(emacsw32-style-frame-title)

   344  :type '(choice

   345          (const :tag "(unset)" nil)

   346          (const :tag "Windows cmd.exe - uses unix progs from EmacsW32" cmd)

   347          (const :tag "Cygwin" cygwin)

   348          (const :tag "MSYS" msys)

   349          )

   350  :set (lambda (symbol value)

   351         (set-default symbol value)

   352         (when value

   353           (unless (eq w32shell-old value)

   354             (setq w32shell-old value)

   355             (w32shell-set-shell (format "%s" value))

   356             ))

   357         t)

   358  :group 'w32shell)

   359

   360(defcustom w32shell-add-emacs-to-path t

   361  "Add Emacs bin directory to path when non-nil."

   362  :type 'boolean

   363  :set (lambda (symbol value)

   364         (set-default symbol value)

   365         (if value

   366             (unless (w32shell-in-exec-path exec-directory)

   367               (w32shell-add-emacs))

   368           (w32shell-remove-emacs)))

   369  :group 'w32shell)

   370

   371(defvar w32shell-with-shell-internal nil)

   372

   373(defmacro w32shell-with-shell (use-shell &rest body)

   374  "Execute the BODY forms with shell temporary set to USE-SHELL."

   375  (declare (indent 0) (debug t))

   376  `(let ((shell-file-name)

   377         (exec-path exec-path)

   378         (envpath (getenv "PATH")))

   379     (condition-case err

   380         (when (w32shell-set-shell ,use-shell)

   381           ,@body)

   382       (error (message "%s" (error-message-string err))))

   383     (setenv "PATH" envpath)))

   384

   385

   386(defun cygwin-shell()

   387  "Run `shell' with Cygwin as the shell.

   388Does not affect the setting of `w32shell-shell' but otherwise

   389works as if you had set this to 'cygwin.

   390

   391See also `msys-shell' and `cmd-shell'."

   392  "Run `shell' with MSYS as the shell.

   393Is otherwise similar to `cygwin-shell'."

   394  (interactive)

   395  (w32shell-with-shell "cygwin" (shell "*cygwin shell*")))

   396

   397(defun msys-shell()

   398  "Run `shell' with MSYS as the shell.

   399Is otherwise similar to `cygwin-shell'."

   400  (interactive)

   401  (w32shell-with-shell "msys" (shell "*msys shell*")))

   402

   403(defun cmd-shell()

   404  "Run `shell' with Windows Command Prompt as the shell.

   405File name completion with Tab/Shift-Tab is done in the style that

   406Windows Command Prompt does it.

   407

   408Is otherwise similar to `cygwin-shell'."

   409  (interactive)

   410  (w32shell-with-shell

   411    "cmd"

   412    (progn

   413      (shell "*cmd shell*")

   414      ;; fix-me: Temporary, until removed from viper

   415      (when (and (boundp 'viper-insert-basic-map)

   416                 (keymapp viper-insert-basic-map))

   417        (define-key viper-insert-basic-map

   418          (if viper-xemacs-p [(shift tab)] [S-tab]) nil))

   419      (local-set-key [tab] 'w32shell-dynamic-complete-filename-like-cmd-fw)

   420      (local-set-key [(shift tab)]

   421                     'w32shell-dynamic-complete-filename-like-cmd-bw))))

   422

   423

   424

   425;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

   426(defun w32shell-dynamic-complete-filename-like-cmd-fw ()

   427  "Tab style file name completion like cmd.exe.

   428Tries to do Tab style file name completion like cmd.exe on w32

   429does it.

   430

   431See also `w32shell-dynamic-complete-filename-like-cmd-bw'."

   432  (interactive)

   433  (w32shell-dynamic-complete-filename-like-cmd t))

   434

   435(defun w32shell-dynamic-complete-filename-like-cmd-bw ()

   436  "Shift-Tab style file name completion like cmd.exe.

   437Tries to do Shift-Tab style file name completion like cmd.exe on

   438w32 does it.

   439

   440See also `w32shell-dynamic-complete-filename-like-cmd-fw'."

   441  (interactive)

   442  (w32shell-dynamic-complete-filename-like-cmd nil))

   443

   444(defconst w32shell-dynamic-complete-state nil)

   445

   446(defcustom w32shell-dynamic-complete-sync-dirs t

   447  "Synchronize process directory and `default-directory' if non-nil.

   448If non-nil then `w32shell-dynamic-complete-filename-like-cmd-fw' (and

   449dito -bw) will send an invisible \"cd\" to the process running

   450cmd.exe to find out what directory the cmd.exe process

   451uses. `default-directory' is then set to this directory."

   452  :type 'boolean

   453  :group 'w32shell)

   454

   455(defcustom w32shell-dynamic-complete-only-dirs '("cd" "pushd")

   456  "Commands for which only directories should be shown.

   457When doing file name completion the commands in this list will

   458only get directory names.

   459

   460This is used in `w32shell-dynamic-complete-filename-like-cmd-fw' (and

   461dito -bw)."

   462  :type '(repeat string)

   463  :group 'w32shell)

   464

   465(defun w32shell-dynamic-complete-filename-like-cmd (forward)

   466  (let* ((proc (get-buffer-process (current-buffer)))

   467         (pmark (process-mark proc))

   468         (point (point))

   469         (cmdstr (buffer-substring-no-properties pmark point))

   470         (argv (w32shell-get-argv cmdstr))

   471         (first-arg (car argv))

   472         (last-arg (car (reverse argv)))

   473         (only-dirs (member (car first-arg) w32shell-dynamic-complete-only-dirs))

   474         (prev-cmdstr          (nth 0 w32shell-dynamic-complete-state))

   475         (prev-completion      (nth 1 w32shell-dynamic-complete-state))

   476         (prev-begin-filename  (nth 2 w32shell-dynamic-complete-state))

   477         (in-completion (string= cmdstr prev-cmdstr))

   478         (begin-filename prev-begin-filename)

   479         new-completion

   480         new-full-completion

   481         completion-dir

   482         completion-dir-given

   483         dir-files

   484         pick-next

   485         beginning-last

   486         )

   487    ;; Initialize

   488    (setq w32shell-dynamic-complete-state nil)

   489    (when last-arg

   490      (setq completion-dir-given (file-name-directory (car last-arg))))

   491    (if completion-dir-given

   492        (setq completion-dir-given

   493              (file-name-as-directory completion-dir-given))

   494      (setq completion-dir-given ""))

   495    ;; Not continuing completion set up for completion

   496    (unless in-completion

   497      (setq prev-completion nil)

   498      (if last-arg

   499          (setq begin-filename

   500                (concat "^" (file-name-nondirectory (car last-arg))))

   501        (setq begin-filename nil))

   502      ;; Sync process directory and default-directory

   503      (when w32shell-dynamic-complete-sync-dirs

   504        (let ((old-out-filter (process-filter proc)))

   505          (condition-case err

   506              (progn

   507                (set-process-filter

   508                 proc

   509                 (lambda(proc str)

   510                   (let ((lstr (split-string str "[\r\n]+")))

   511                     (setq default-directory

   512                           (file-name-as-directory (nth 1 lstr))))))

   513                (process-send-string proc "cd\n")

   514                (accept-process-output proc))

   515            (error (message "%s" (error-message-string err))))

   516          (set-process-filter proc old-out-filter))))

   517    ;; Find completion

   518    (setq completion-dir (expand-file-name completion-dir-given))

   519    (setq dir-files (directory-files completion-dir nil begin-filename))

   520    (unless forward

   521      (setq dir-files (reverse dir-files)))

   522    (dolist (f dir-files)

   523      (when (and (not (member f '("." "..")))

   524                 (or (not only-dirs)

   525                     (file-directory-p (expand-file-name f completion-dir))))

   526        (unless new-completion

   527          (setq new-completion f))

   528        (if (string= f prev-completion)

   529            (setq pick-next t)

   530          (when pick-next

   531            (setq pick-next nil)

   532            (setq new-completion f)))))

   533    (setq new-full-completion

   534          (convert-standard-filename

   535           (concat completion-dir-given new-completion)))

   536    ;; Replase last argument

   537    (setq beginning-last (nth 1 last-arg))

   538    (unless beginning-last

   539      (setq beginning-last 0))

   540    (goto-char (+ pmark beginning-last))

   541    (unless (eolp) (kill-line))

   542    ;; The code below should probably use shell-quote-argument, but

   543    ;; because of trouble with this function I am using a more

   544    ;; w32 specific quoting here at the moment.

   545    (if (not (memq ?\  (append new-full-completion nil)))

   546        (insert new-full-completion)

   547      (insert ?\")

   548      (insert new-full-completion)

   549      (insert ?\"))

   550    ;; Save completion state

   551    ;;

   552    ;; return non-nil to show completion has been done!

   553    (setq w32shell-dynamic-complete-state

   554          (list

   555           (buffer-substring-no-properties pmark (point))

   556           new-completion

   557           begin-filename))))

   558

   559(defun w32shell-get-argv(cmdline)

   560  "Split CMDLINE into args.

   561The splitting is done using the syntax used on MS Windows.

   562

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

   564

   565  \(arg arg-begin arg-end)

   566

   567where ARG is the argument stripped from any \". ARG-BEGIN and

   568ARG-END are the beginning and end of the argument in cmdline.

   569

   570If CMDLINE ends with a space or is \"\" a list consisting of

   571\(\"\" LEN nil) is added. LEN is the length of CMDLINE."

   572  (let ((lcmd (append cmdline nil))

   573        (len (length cmdline))

   574        argv

   575        state

   576        arg

   577        arg-begin

   578        arg-end

   579        c

   580        )

   581    (while lcmd

   582      (setq c (car lcmd))

   583      (setq lcmd (cdr lcmd))

   584      (cond

   585       (  (not state)

   586          (when arg (error "arg not nil"))

   587          (cond

   588           ( (= c ?\ ))

   589           ( (= c ?\")

   590             (setq arg-begin (- len 1 (length lcmd)))

   591             (setq state 'state-qarg))

   592           ( t

   593             (setq arg-begin (- len 1 (length lcmd)))

   594             (setq state 'state-arg)

   595             (setq arg (cons c arg)))))

   596       (  (eq state 'state-arg)

   597          (cond

   598           ( (= c ?\ )

   599             (setq state nil)

   600             (setq arg-end (- len 1 (length lcmd)))

   601             (setq argv (cons

   602                         (list (concat (nreverse arg))

   603                               arg-begin

   604                               arg-end)

   605                         argv))

   606             (setq arg nil))

   607           ( (= c ?\")

   608             (setq state 'state-arg-q))

   609           ( t

   610             (setq arg (cons c arg)))))

   611       (  (eq state 'state-arg-q)

   612          (cond

   613           ( (= c ?\")

   614             (setq state 'state-arg))

   615           ( t

   616             (setq arg (cons c arg)))))

   617       (  (eq state 'state-qarg)

   618          (cond

   619           ( (= c ?\")

   620             (setq state 'state-qarg-q))

   621           ( t

   622             (setq arg (cons c arg)))))

   623       (  (eq state 'state-qarg-q)

   624          (cond

   625           ( (= c ?\ )

   626             (setq state nil)

   627             (setq arg-end (- len 1 (length lcmd)))

   628             (setq argv (cons

   629                         (list (concat (nreverse arg))

   630                               arg-begin

   631                               arg-end)

   632                         argv))

   633             (setq arg nil))

   634           ( (= c ?\")

   635             (setq arg (cons c arg))

   636             (setq state 'state-qarg))

   637           ( t

   638             (setq arg (cons c arg)))))

   639       (  t

   640          (error "unknown state=%s" state))

   641       ))

   642    (if arg

   643        (progn

   644          (setq arg-end (- len 0 (length lcmd)))

   645          (setq argv (cons

   646                      (list

   647                       (concat (nreverse arg))

   648                       arg-begin

   649                       arg-end)

   650                      argv)))

   651      (when (or (not c) (= c ?\ ))

   652        (setq argv (cons (list "" (length cmdstr) nil) argv))))

   653    (reverse argv)))

   654

   655;; For testing:

   656(when nil

   657  (global-set-key [f9]         'w32shell-dynamic-complete-filename-like-cmd-fw)

   658  (global-set-key [(shift f9)] 'w32shell-dynamic-complete-filename-like-cmd-bw)

   659  )

   660

   661(when nil

   662  (let* ((cmd "cd \\\"hej\"\\du \"sista\"")

   663         (argv (w32shell-get-argv cmd)))

   664    (dolist (a argv)

   665      (message "%s %s %s (%s)"

   666               (nth 0 a)

   667               (nth 1 a)

   668               (nth 2 a)

   669               (substring cmd (nth 1 a) (nth 2 a)))))

   670  )

   671

   672(defun w32shell-explorer(dir)

   673  "Open Windows Explorer in directory DIR."

   674  (interactive "DStart in directory: ")

   675  (setq dir (expand-file-name dir))

   676  (w32shell-shell-execute nil dir))

   677

   678(defun w32shell-explorer-here()

   679  "Open Windows Explorer in current directory."

   680  (interactive)

   681  (w32shell-explorer default-directory))

   682

   683(defun w32shell-cmd(dir)

   684  "Open a Windows command prompt in directory DIR.

   685Emacs bin dir is added to path in the started command window."

   686  (interactive "DStart in directory: ")

   687  (let ((default-directory (expand-file-name dir))

   688        (old-path (getenv "PATH")))

   689    (w32shell-add-envpath exec-directory)

   690    ;;(w32shell-remove-envpath exec-directory)

   691    (condition-case err

   692        (progn

   693          ;;(call-process "cmd.exe" nil 0 nil "/c" "start" (concat '(?\") "hej4" '(?\")) "cmd.exe")

   694          ;; Bug in call-process quoting, use this instead

   695          (w32-shell-execute nil "cmd.exe" "/c start \"Command Prompt with Emacs in PATH\"")

   696          )

   697      (error (message "%s" (error-message-string err))))

   698    (setenv "PATH" old-path)))

   699

   700(defun w32shell-cmd-here()

   701  "Open a Windows command prompt in current directory.

   702Emacs bin dir is added to path in the started command window."

   703  (interactive)

   704  (w32shell-cmd default-directory))

   705

   706(provide 'w32shell)

   707

   708;;; w32shell.el ends here