git.chise.org Git - chise/xemacs-chise.git.1/blob - lisp/win32-native.el

   1 ;;; win32-native.el --- Lisp routines for MS Windows.
   2
   3 ;; Copyright (C) 1994 Free Software Foundation, Inc.
   4 ;; Copyright (C) 2000 Ben Wing.
   5
   6 ;; Maintainer: XEmacs Development Team
   7 ;; Keywords: mouse, dumped
   8
   9 ;; This file is part of XEmacs.
  10
  11 ;; XEmacs is free software; you can redistribute it and/or modify it
  12 ;; under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; XEmacs is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with XEmacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Synched up with: Not synched with FSF.  Almost completely divergent.
  27 ;;; (FSF has stuff in w32-fns.el and term/w32-win.el.)
  28
  29 ;;; Commentary:
  30
  31 ;; This file is dumped with XEmacs for MS Windows (without cygwin).
  32
  33 ;; Based on NT Emacs version by Geoff Voelker (voelker@cs.washington.edu)
  34 ;; Ported to XEmacs by Marc Paquette <marcpa@cam.org>
  35 ;; Largely modified by Kirill M. Katsnelson <kkm@kis.ru>
  36
  37 ;;; Code:
  38
  39 ;; The cmd.exe shell uses the "/c" switch instead of the "-c" switch
  40 ;; for executing its command line argument (from simple.el).
  41 ;; #### Oh if we had an alist of shells and their command switches.
  42 (setq shell-command-switch "/c")
  43
  44 ;; For appending suffixes to directories and files in shell
  45 ;; completions.  This screws up cygwin users so we leave it out for
  46 ;; now. Uncomment this if you only ever want to use cmd.
  47
  48 ;(defun nt-shell-mode-hook ()
  49 ;  (setq comint-completion-addsuffix '("\\" . " ")
  50 ;       comint-process-echoes t))
  51 ;(add-hook 'shell-mode-hook 'nt-shell-mode-hook)
  52
  53 ;; Use ";" instead of ":" as a path separator (from files.el).
  54 (setq path-separator ";")
  55
  56 ;; Set the null device (for compile.el).
  57 ;; #### There should be such a global thingy as null-device - kkm
  58 (setq grep-null-device "NUL")
  59
  60 ;; Set the grep regexp to match entries with drive letters.
  61 (setq grep-regexp-alist
  62   '(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3)))
  63
  64 ;;----------------------------------------------------------------------
  65 ;; Autosave hack
  66 ;;--------------------
  67
  68 ;; Avoid creating auto-save file names containing invalid characters
  69 ;; (primarily "*", eg. for the *mail* buffer).
  70 ;; Avoid "doc lost for function" warning
  71 (defun original-make-auto-save-file-name (&optional junk)
  72   "You do not want to call this."
  73   )
  74 (fset 'original-make-auto-save-file-name
  75       (symbol-function 'make-auto-save-file-name))
  76
  77 (defun make-auto-save-file-name ()
  78   "Return file name to use for auto-saves of current buffer.
  79 Does not consider `auto-save-visited-file-name' as that variable is checked
  80 before calling this function.  You can redefine this for customization.
  81 See also `auto-save-file-name-p'."
  82   (let ((name (original-make-auto-save-file-name))
  83         (start 0))
  84     ;; destructively replace occurrences of * or ? with $
  85     (while (string-match "[?*]" name start)
  86       (aset name (match-beginning 0) ?$)
  87       (setq start (1+ (match-end 0))))
  88     name))
  89
  90 ;;----------------------------------------------------------------------
  91 ;; Quoting process args
  92 ;;--------------------
  93
  94 (defvar debug-mswindows-process-command-lines nil
  95   "If non-nil, output debug information about the command lines constructed.
  96 This can be useful if you are getting process errors where the arguments
  97 to the process appear to be getting passed incorrectly.")
  98
  99 ;; properly quotify one arg for the vc runtime argv constructor.
 100 (defun mswindows-quote-one-vc-runtime-arg (arg &optional quote-shell)
 101   ;; we mess with any arg with whitespace, quotes, or globbing chars in it.
 102   ;; we also include shell metachars if asked.
 103   ;; note that \ is NOT included!  it's perfectly OK to include an
 104   ;; arg like c:\ or c:\foo.
 105   (if (string-match (if quote-shell "[ \t\n\r\f*?\"<>|&^%]" "[ \t\n\r\f*?\"]")
 106                     arg)
 107       (progn
 108         ;; handle nested quotes, possibly preceded by backslashes
 109         (setq arg (replace-in-string arg "\\([\\]*\\)\"" "\\1\\1\\\\\""))
 110         ;; handle trailing backslashes
 111         (setq arg (replace-in-string arg "\\([\\]+\\)$" "\\1\\1"))
 112         (concat "\"" arg "\""))
 113     arg))
 114
 115 (defun mswindows-quote-one-simple-arg (arg &optional quote-shell)
 116   ;; just put double quotes around args with spaces (and maybe shell
 117   ;; metachars).
 118   (if (string-match (if quote-shell "[ \t\n\r\f*?\"<>|&^%]" "[ \t\n\r\f*?]")
 119                     arg)
 120       (concat "\"" arg "\"")
 121     arg))
 122
 123 (defun mswindows-quote-one-command-arg (arg)
 124   ;; quote an arg to get it past COMMAND.COM/CMD.EXE: need to quote shell
 125   ;; metachars with ^.
 126   (replace-in-string "[<>|&^%]" "^\\1" arg))
 127
 128 (defun mswindows-construct-verbatim-command-line (program args)
 129   (mapconcat #'identity args " "))
 130
 131 ;; for use with either standard VC++ compiled programs or Cygwin programs,
 132 ;; which emulate the same behavior.
 133 (defun mswindows-construct-vc-runtime-command-line (program args)
 134   (mapconcat #'mswindows-quote-one-vc-runtime-arg args " "))
 135
 136 ;; note: for pulling apart an arg:
 137 ;; each arg consists of either
 138
 139 ;; something surrounded by single quotes
 140
 141 ;; or
 142
 143 ;; one or more of
 144
 145 ;; 1. a non-ws, non-" char
 146 ;; 2. a section of double-quoted text
 147 ;; 3. a section of double-quoted text with end-of-string instead of the final
 148 ;; quote.
 149
 150 ;; 2 and 3 get handled together.
 151
 152 ;; quoted text is one of
 153 ;;
 154 ;; 1. quote + even number of backslashes + quote, or
 155 ;; 2. quote + non-greedy anything + non-backslash + even number of
 156 ;;    backslashes + quote.
 157
 158 ;; we need to separate the two because we unfortunately have no non-greedy
 159 ;; ? operator. (urk! we actually do, but it wasn't documented.) --ben
 160
 161 ;; if you want to mess around, keep this test case in mind:
 162
 163 ;; this string
 164
 165 ;; " as'f 'FOO BAR' '' \"\" \"asdf \\ \\\" \\\\\\\" asdfasdf\\\\\" foo\" "
 166
 167 ;; should tokenize into this:
 168
 169 ;; (" " "as'f" " " "'FOO BAR' " "'' " "\"\"" " " "\"asdf \\ \\\" \\\\\\\" asdfasdf\\\\\"" " " "foo" "\" ")
 170
 171 ;; this regexp actually separates the arg into individual args, like a
 172 ;; shell (such as sh) does, but using vc-runtime rules.  it's easy to
 173 ;; derive the tokenizing regexp from it, and that's exactly what i did.
 174 ;; but oh was it hard to get this first regexp right. --ben
 175 ;(defvar mswindows-match-one-cmd-exe-arg-regexp
 176 ;  (concat
 177 ;   "^\\("
 178 ;   "'\\([\\]*\\)\\2'" "\\|"
 179 ;   "'.*?[^\\]\\(\\([\\]*\\)\\4'\\)" "\\|"
 180 ;   "\\("
 181 ;   "[^ \t\n\r\f\v\"]" "\\|"
 182 ;   "\"\\([\\]*\\)\\6\"" "\\|"
 183 ;   "\".*?[^\\]\\(\\([\\]*\\)\\8\"\\|$\\)"
 184 ;   "\\)+"
 185 ;   "\\)"
 186 ;   "\\([ \t\n\r\f\v]+\\|$\\)"))
 187
 188 (defvar mswindows-match-one-cmd-exe-token-regexp
 189   (concat
 190    "^\\("
 191    "[ \t\n\r\f\v]+" "\\|"
 192    "'\\([\\]*\\)\\2'" "\\([ \t\n\r\f\v]+\\|$\\)" "\\|"
 193    "'.*?[^\\]\\(\\([\\]*\\)\\5'\\)" "\\([ \t\n\r\f\v]+\\|$\\)" "\\|"
 194    "[^ \t\n\r\f\v\"]+" "\\|"
 195    "\"\\([\\]*\\)\\7\"" "\\|"
 196    "\".*?[^\\]\\(\\([\\]*\\)\\9\"\\|$\\)"
 197    "\\)"))
 198
 199 (defun mswindows-construct-command-command-line (program args)
 200   ;; for use with COMMAND.COM and CMD.EXE:
 201   ;; for each arg, tokenize it into quoted and non-quoted sections;
 202   ;; then quote all the shell meta-chars with ^; then put everything
 203   ;; back together.  the truly hard part is the tokenizing -- typically
 204   ;; we get a single argument (the command to execute) and we have to
 205   ;; worry about quotes that are backslash-quoted and such.
 206   (mapconcat
 207    #'(lambda (arg)
 208        (mapconcat
 209         #'(lambda (part)
 210             (if (string-match "^'" part)
 211                 (replace-in-string part "\\([<>|^&%]\\)" "^\\1")
 212               part))
 213         (let (parts)
 214           (while (and (> (length arg) 0)
 215                       (string-match
 216                        mswindows-match-one-cmd-exe-token-regexp
 217                        arg))
 218             (push (match-string 0 arg) parts)
 219             (setq arg (substring arg (match-end 0))))
 220           (if (> (length arg) 0)
 221               (push arg parts))
 222           (nreverse parts))
 223         ""))
 224    args " "))
 225
 226 (defvar mswindows-construct-process-command-line-alist
 227   '(("[\\/].?.?sh\\." . mswindows-construct-verbatim-command-line)
 228     ("[\\/]command\\.com$" . mswindows-construct-command-command-line)
 229     ("[\\/]cmd\\.exe$" . mswindows-construct-command-command-line)
 230     ("" . mswindows-construct-vc-runtime-command-line))
 231   "An alist for determining proper argument quoting given executable
 232 file name.  Car of each cons should be a string, a regexp against
 233 which the file name is matched.  Matching is case-insensitive but does
 234 include the directory, so you should begin your regexp with [\\\\/] if
 235 you don't want the directory to matter.  Alternatively, the car can be
 236 a function of one arg, which is called with the executable's name and
 237 should return t if this entry should be processed.  Cdr is a function
 238 symbol, which is called with two args, the executable name and a list
 239 of the args passed to it.  It should return a string, which includes
 240 the executable's args (but not the executable name itself) properly
 241 quoted and pasted together.  The list is matched in order, and the
 242 first matching entry specifies how the processing will happen.")
 243
 244 (defun mswindows-construct-process-command-line (args)
 245   ;;Properly quote process ARGS for executing (car ARGS).
 246   ;;Called from the C code.
 247   (let ((fname (car args))
 248         (alist mswindows-construct-process-command-line-alist)
 249         (case-fold-search t)
 250         (return-me nil)
 251         (assoc nil))
 252     (while (and alist
 253                 (null return-me))
 254       (setq assoc (pop alist))
 255       (if (if (stringp (car assoc))
 256               (string-match (car assoc) fname)
 257             (funcall (car assoc) fname))
 258           (setq return-me (cdr assoc))))
 259     (let* ((called-fun (or return-me
 260                             #'mswindows-construct-vc-runtime-command-line))
 261            (retval
 262             (let ((str (funcall called-fun fname (cdr args)))
 263                   (quoted-fname (mswindows-quote-one-simple-arg fname)))
 264               (if (and str (> (length str) 0))
 265                   (concat quoted-fname " " str)
 266                 quoted-fname))))
 267       (when debug-mswindows-process-command-lines
 268         (debug-print "mswindows-construct-process-command-line called:\n")
 269         (debug-print "received args: \n%s"
 270                      (let ((n -1))
 271                        (mapconcat #'(lambda (arg)
 272                                       (incf n)
 273                                       (format "  %d %s\n" n arg))
 274                                   args
 275                                   "")))
 276         (debug-print "called fun %s\n" called-fun)
 277         (debug-print "resulting command line: %s\n" retval))
 278       retval)))
 279
 280 ;;; win32-native.el ends here