--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/win32-native.el	Mon Aug 13 11:35:02 2007 +0200
@@ -0,0 +1,280 @@
+;;; win32-native.el --- Lisp routines for MS Windows.
+
+;; Copyright (C) 1994 Free Software Foundation, Inc.
+;; Copyright (C) 2000 Ben Wing.
+
+;; Maintainer: XEmacs Development Team
+;; Keywords: mouse, dumped
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Synched up with: Not synched with FSF.  Almost completely divergent.
+;;; (FSF has stuff in w32-fns.el and term/w32-win.el.)
+
+;;; Commentary:
+
+;; This file is dumped with XEmacs for MS Windows (without cygwin).
+
+;; Based on NT Emacs version by Geoff Voelker (voelker@cs.washington.edu)
+;; Ported to XEmacs by Marc Paquette <marcpa@cam.org>
+;; Largely modified by Kirill M. Katsnelson <kkm@kis.ru>
+
+;;; Code:
+
+;; The cmd.exe shell uses the "/c" switch instead of the "-c" switch
+;; for executing its command line argument (from simple.el).
+;; #### Oh if we had an alist of shells and their command switches.
+(setq shell-command-switch "/c")
+
+;; For appending suffixes to directories and files in shell
+;; completions.  This screws up cygwin users so we leave it out for
+;; now. Uncomment this if you only ever want to use cmd.
+
+;(defun nt-shell-mode-hook ()
+;  (setq comint-completion-addsuffix '("\\" . " ")
+;	comint-process-echoes t))
+;(add-hook 'shell-mode-hook 'nt-shell-mode-hook)
+
+;; Use ";" instead of ":" as a path separator (from files.el).
+(setq path-separator ";")
+
+;; Set the null device (for compile.el).
+;; #### There should be such a global thingy as null-device - kkm
+(setq grep-null-device "NUL")
+
+;; Set the grep regexp to match entries with drive letters.
+(setq grep-regexp-alist
+  '(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3)))
+
+;;----------------------------------------------------------------------
+;; Autosave hack
+;;--------------------
+
+;; Avoid creating auto-save file names containing invalid characters
+;; (primarily "*", eg. for the *mail* buffer).
+;; Avoid "doc lost for function" warning
+(defun original-make-auto-save-file-name (&optional junk)
+  "You do not want to call this."
+  )
+(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.
+Does not consider `auto-save-visited-file-name' as that variable is checked
+before calling this function.  You can redefine this for customization.
+See also `auto-save-file-name-p'."
+  (let ((name (original-make-auto-save-file-name))
+	(start 0))
+    ;; destructively replace occurrences of * or ? with $
+    (while (string-match "[?*]" name start)
+      (aset name (match-beginning 0) ?$)
+      (setq start (1+ (match-end 0))))
+    name))
+
+;;----------------------------------------------------------------------
+;; Quoting process args
+;;--------------------
+
+(defvar debug-mswindows-process-command-lines nil
+  "If non-nil, output debug information about the command lines constructed.
+This can be useful if you are getting process errors where the arguments
+to the process appear to be getting passed incorrectly.")
+
+;; properly quotify one arg for the vc runtime argv constructor.
+(defun mswindows-quote-one-vc-runtime-arg (arg &optional quote-shell)
+  ;; we mess with any arg with whitespace, quotes, or globbing chars in it.
+  ;; we also include shell metachars if asked.
+  ;; note that \ is NOT included!  it's perfectly OK to include an
+  ;; arg like c:\ or c:\foo.
+  (if (string-match (if quote-shell "[ \t\n\r\f*?\"<>|&^%]" "[ \t\n\r\f*?\"]")
+		    arg)
+      (progn
+	;; handle nested quotes, possibly preceded by backslashes
+	(setq arg (replace-in-string arg "\\([\\]*\\)\"" "\\1\\1\\\\\""))
+	;; handle trailing backslashes
+	(setq arg (replace-in-string arg "\\([\\]+\\)$" "\\1\\1"))
+	(concat "\"" arg "\""))
+    arg))
+
+(defun mswindows-quote-one-simple-arg (arg &optional quote-shell)
+  ;; just put double quotes around args with spaces (and maybe shell
+  ;; metachars).
+  (if (string-match (if quote-shell "[ \t\n\r\f*?\"<>|&^%]" "[ \t\n\r\f*?]")
+		    arg)
+      (concat "\"" arg "\"")
+    arg))
+
+(defun mswindows-quote-one-command-arg (arg)
+  ;; quote an arg to get it past COMMAND.COM/CMD.EXE: need to quote shell
+  ;; metachars with ^.
+  (replace-in-string "[<>|&^%]" "^\\1" arg))
+
+(defun mswindows-construct-verbatim-command-line (program args)
+  (mapconcat #'identity args " "))
+
+;; for use with either standard VC++ compiled programs or Cygwin programs,
+;; which emulate the same behavior.
+(defun mswindows-construct-vc-runtime-command-line (program args)
+  (mapconcat #'mswindows-quote-one-vc-runtime-arg args " "))
+
+;; note: for pulling apart an arg:
+;; each arg consists of either
+
+;; something surrounded by single quotes
+
+;; or
+
+;; one or more of
+
+;; 1. a non-ws, non-" char
+;; 2. a section of double-quoted text
+;; 3. a section of double-quoted text with end-of-string instead of the final
+;; quote.
+
+;; 2 and 3 get handled together.
+
+;; quoted text is one of
+;;
+;; 1. quote + even number of backslashes + quote, or
+;; 2. quote + non-greedy anything + non-backslash + even number of
+;;    backslashes + quote.
+
+;; we need to separate the two because we unfortunately have no non-greedy
+;; ? operator. (urk! we actually do, but it wasn't documented.) --ben
+
+;; if you want to mess around, keep this test case in mind:
+
+;; this string
+
+;; " as'f 'FOO BAR' '' \"\" \"asdf \\ \\\" \\\\\\\" asdfasdf\\\\\" foo\" "
+
+;; should tokenize into this:
+
+;; (" " "as'f" " " "'FOO BAR' " "'' " "\"\"" " " "\"asdf \\ \\\" \\\\\\\" asdfasdf\\\\\"" " " "foo" "\" ")
+
+;; this regexp actually separates the arg into individual args, like a
+;; shell (such as sh) does, but using vc-runtime rules.  it's easy to
+;; derive the tokenizing regexp from it, and that's exactly what i did.
+;; but oh was it hard to get this first regexp right. --ben
+;(defvar mswindows-match-one-cmd-exe-arg-regexp
+;  (concat
+;   "^\\("
+;   "'\\([\\]*\\)\\2'" "\\|"
+;   "'.*?[^\\]\\(\\([\\]*\\)\\4'\\)" "\\|"
+;   "\\("
+;   "[^ \t\n\r\f\v\"]" "\\|"
+;   "\"\\([\\]*\\)\\6\"" "\\|"
+;   "\".*?[^\\]\\(\\([\\]*\\)\\8\"\\|$\\)"
+;   "\\)+"
+;   "\\)"
+;   "\\([ \t\n\r\f\v]+\\|$\\)"))
+
+(defvar mswindows-match-one-cmd-exe-token-regexp
+  (concat
+   "^\\("
+   "[ \t\n\r\f\v]+" "\\|"
+   "'\\([\\]*\\)\\2'" "\\([ \t\n\r\f\v]+\\|$\\)" "\\|"
+   "'.*?[^\\]\\(\\([\\]*\\)\\5'\\)" "\\([ \t\n\r\f\v]+\\|$\\)" "\\|"
+   "[^ \t\n\r\f\v\"]+" "\\|"
+   "\"\\([\\]*\\)\\7\"" "\\|"
+   "\".*?[^\\]\\(\\([\\]*\\)\\9\"\\|$\\)"
+   "\\)"))
+
+(defun mswindows-construct-command-command-line (program args)
+  ;; for use with COMMAND.COM and CMD.EXE:
+  ;; for each arg, tokenize it into quoted and non-quoted sections;
+  ;; then quote all the shell meta-chars with ^; then put everything
+  ;; back together.  the truly hard part is the tokenizing -- typically
+  ;; we get a single argument (the command to execute) and we have to
+  ;; worry about quotes that are backslash-quoted and such.
+  (mapconcat
+   #'(lambda (arg)
+       (mapconcat
+	#'(lambda (part)
+	    (if (string-match "^'" part)
+		(replace-in-string part "\\([<>|^&%]\\)" "^\\1")
+	      part))
+	(let (parts)
+	  (while (and (> (length arg) 0)
+		      (string-match
+		       mswindows-match-one-cmd-exe-token-regexp
+		       arg))
+	    (push (match-string 0 arg) parts)
+	    (setq arg (substring arg (match-end 0))))
+	  (if (> (length arg) 0)
+	      (push arg parts))
+	  (nreverse parts))
+	""))
+   args " "))
+
+(defvar mswindows-construct-process-command-line-alist
+  '(("[\\/].?.?sh\\." . mswindows-construct-verbatim-command-line)
+    ("[\\/]command\\.com$" . mswindows-construct-command-command-line)
+    ("[\\/]cmd\\.exe$" . mswindows-construct-command-command-line)
+    ("" . mswindows-construct-vc-runtime-command-line))
+  "An alist for determining proper argument quoting given executable
+file name.  Car of each cons should be a string, a regexp against
+which the file name is matched.  Matching is case-insensitive but does
+include the directory, so you should begin your regexp with [\\\\/] if
+you don't want the directory to matter.  Alternatively, the car can be
+a function of one arg, which is called with the executable's name and
+should return t if this entry should be processed.  Cdr is a function
+symbol, which is called with two args, the executable name and a list
+of the args passed to it.  It should return a string, which includes
+the executable's args (but not the executable name itself) properly
+quoted and pasted together.  The list is matched in order, and the
+first matching entry specifies how the processing will happen.")
+
+(defun mswindows-construct-process-command-line (args)
+  ;;Properly quote process ARGS for executing (car ARGS).
+  ;;Called from the C code.
+  (let ((fname (car args))
+	(alist mswindows-construct-process-command-line-alist)
+	(case-fold-search t)
+	(return-me nil)
+	(assoc nil))
+    (while (and alist
+		(null return-me))
+      (setq assoc (pop alist))
+      (if (if (stringp (car assoc))
+	      (string-match (car assoc) fname)
+	    (funcall (car assoc) fname))
+	  (setq return-me (cdr assoc))))
+    (let* ((called-fun (or return-me
+			    #'mswindows-construct-vc-runtime-command-line))
+	   (retval
+	    (let ((str (funcall called-fun fname (cdr args)))
+		  (quoted-fname (mswindows-quote-one-simple-arg fname)))
+	      (if (and str (> (length str) 0))
+		  (concat quoted-fname " " str)
+		quoted-fname))))
+      (when debug-mswindows-process-command-lines
+	(debug-print "mswindows-construct-process-command-line called:\n")
+	(debug-print "received args: \n%s"
+		     (let ((n -1))
+		       (mapconcat #'(lambda (arg)
+				      (incf n)
+				      (format "  %d %s\n" n arg))
+				  args
+				  "")))
+	(debug-print "called fun %s\n" called-fun)
+	(debug-print "resulting command line: %s\n" retval))
+      retval)))
+
+;;; win32-native.el ends here