lisp/w32-fns.el

   1 ;;; w32-fns.el --- Lisp routines for Windows NT.
   2
   3 ;; Copyright (C) 1994 Free Software Foundation, Inc.
   4
   5 ;; Author: Geoff Voelker <voelker@cs.washington.edu>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; (August 12, 1993)
  27 ;; Created.
  28
  29 ;; (November 21, 1994)
  30 ;; [C-M-backspace] defined.
  31 ;; mode-line-format defined to show buffer file type.
  32 ;; audio bell initialized.
  33
  34 ;;; Code:
  35
  36 ;; Map delete and backspace
  37 (define-key function-key-map [backspace] "\177")
  38 (define-key function-key-map [delete] "\C-d")
  39 (define-key function-key-map [M-backspace] [?\M-\177])
  40 (define-key function-key-map [C-M-backspace] [\C-\M-delete])
  41
  42 ;; Ignore case on file-name completion
  43 (setq completion-ignore-case t)
  44
  45 ;; Map all versions of a filename (8.3, longname, mixed case) to the
  46 ;; same buffer.
  47 (setq find-file-visit-truename t)
  48
  49 (defvar w32-system-shells '("cmd" "cmd.exe" "command" "command.com"
  50                             "4nt" "4nt.exe" "4dos" "4dos.exe"
  51                             "ndos" "ndos.exe")
  52   "List of strings recognized as Windows NT/9X system shells.")
  53
  54 (defun w32-using-nt ()
  55   "Return t if literally running on Windows NT (i.e., not Windows 9X)."
  56   (and (eq system-type 'windows-nt) (getenv "SystemRoot")))
  57
  58 (defun w32-shell-name ()
  59   "Return the name of the shell being used."
  60   (or (and (boundp 'explicit-shell-file-name) explicit-shell-file-name)
  61       (getenv "ESHELL")
  62       (getenv "SHELL")
  63       (and (w32-using-nt) "cmd.exe")
  64       "command.com"))
  65
  66 (defun w32-system-shell-p (shell-name)
  67   (and shell-name
  68        (member (downcase (file-name-nondirectory shell-name))
  69                w32-system-shells)))
  70
  71 (defvar w32-allow-system-shell nil
  72   "*Disable startup warning when using \"system\" shells.")
  73
  74 (defun w32-check-shell-configuration ()
  75   "Check the configuration of shell variables on Windows NT/9X.
  76 This function is invoked after loading the init files and processing
  77 the command line arguments.  It issues a warning if the user or site
  78 has configured the shell with inappropriate settings."
  79   (interactive)
  80   (let ((prev-buffer (current-buffer))
  81         (buffer (get-buffer-create "*Shell Configuration*"))
  82         (system-shell))
  83     (set-buffer buffer)
  84     (erase-buffer)
  85     (if (w32-system-shell-p (getenv "ESHELL"))
  86         (insert (format "Warning! The ESHELL environment variable uses %s.
  87 You probably want to change it so that it uses cmdproxy.exe instead.\n\n"
  88                         (getenv "ESHELL"))))
  89     (if (w32-system-shell-p (getenv "SHELL"))
  90         (insert (format "Warning! The SHELL environment variable uses %s.
  91 You probably want to change it so that it uses cmdproxy.exe instead.\n\n"
  92                         (getenv "SHELL"))))
  93     (if (w32-system-shell-p shell-file-name)
  94         (insert (format "Warning! shell-file-name uses %s.
  95 You probably want to change it so that it uses cmdproxy.exe instead.\n\n"
  96                         shell-file-name)))
  97     (if (and (boundp 'explicit-shell-file-name)
  98              (w32-system-shell-p explicit-shell-file-name))
  99         (insert (format "Warning! explicit-shell-file-name uses %s.
 100 You probably want to change it so that it uses cmdproxy.exe instead.\n\n"
 101                         explicit-shell-file-name)))
 102     (setq system-shell (> (buffer-size) 0))
 103
 104     ;; Allow user to specify that they really do want to use one of the
 105     ;; "system" shells, despite the drawbacks, but still warn if
 106     ;; shell-command-switch doesn't match.
 107     (if w32-allow-system-shell
 108         (erase-buffer))
 109
 110     (cond (system-shell
 111            ;; System shells.
 112            (if (string-equal "-c" shell-command-switch)
 113                (insert "Warning! shell-command-switch is \"-c\".
 114 You should set this to \"/c\" when using a system shell.\n\n"))
 115            (if w32-quote-process-args
 116                (insert "Warning! w32-quote-process-args is t.
 117 You should set this to nil when using a system shell.\n\n")))
 118           ;; Non-system shells.
 119           (t
 120            (if (string-equal "/c" shell-command-switch)
 121                (insert "Warning! shell-command-switch is \"/c\".
 122 You should set this to \"-c\" when using a non-system shell.\n\n"))
 123            (if (not w32-quote-process-args)
 124                (insert "Warning! w32-quote-process-args is nil.
 125 You should set this to t when using a non-system shell.\n\n"))))
 126     (if (> (buffer-size) 0)
 127         (display-buffer buffer)
 128       (kill-buffer buffer))
 129     (set-buffer prev-buffer)))
 130
 131 (add-hook 'after-init-hook 'w32-check-shell-configuration)
 132
 133
 134 ;;; Basic support functions for managing Emacs' locale setting
 135
 136 (defvar w32-valid-locales nil
 137   "List of locale ids known to be supported.")
 138
 139 ;;; This is the brute-force version; an efficient version is now
 140 ;;; built-in though.
 141 (if (not (fboundp 'w32-get-valid-locale-ids))
 142     (defun w32-get-valid-locale-ids ()
 143       "Return list of all valid Windows locale ids."
 144       (let ((i 65535)
 145             locales)
 146         (while (> i 0)
 147           (if (w32-get-locale-info i)
 148               (setq locales (cons i locales)))
 149           (setq i (1- i)))
 150         locales)))
 151
 152 (defun w32-list-locales ()
 153   "List the name and id of all locales supported by Windows."
 154   (interactive)
 155   (if (null w32-valid-locales)
 156       (setq w32-valid-locales (w32-get-valid-locale-ids)))
 157   (switch-to-buffer-other-window (get-buffer-create "*Supported Locales*"))
 158   (erase-buffer)
 159   (insert "LCID\tAbbrev\tFull name\n\n")
 160   (insert (mapconcat
 161            '(lambda (x)
 162               (format "%d\t%s\t%s"
 163                       x
 164                       (w32-get-locale-info x)
 165                       (w32-get-locale-info x t)))
 166            w32-valid-locales "\n"))
 167   (insert "\n")
 168   (goto-char (point-min)))
 169
 170
 171 ;;; Setup Info-default-directory-list to include the info directory
 172 ;;; near where Emacs executable was installed.  We used to set INFOPATH,
 173 ;;; but when this is set Info-default-directory-list is ignored.  We
 174 ;;; also cannot rely upon what is set in paths.el because they assume
 175 ;;; that configuration during build time is correct for runtime.
 176 (defun w32-init-info ()
 177   (let* ((instdir (file-name-directory invocation-directory))
 178          (dir1 (expand-file-name "../info/" instdir))
 179          (dir2 (expand-file-name "../../../info/" instdir)))
 180     (if (file-exists-p dir1)
 181         (setq Info-default-directory-list
 182               (append Info-default-directory-list (list dir1)))
 183       (if (file-exists-p dir2)
 184           (setq Info-default-directory-list
 185                 (append Info-default-directory-list (list dir2)))))))
 186
 187 (add-hook 'before-init-hook 'w32-init-info)
 188
 189 ;; Avoid creating auto-save file names containing invalid characters.
 190 (fset 'original-make-auto-save-file-name
 191       (symbol-function 'make-auto-save-file-name))
 192
 193 (defun make-auto-save-file-name ()
 194   "Return file name to use for auto-saves of current buffer.
 195 Does not consider `auto-save-visited-file-name' as that variable is checked
 196 before calling this function.  You can redefine this for customization.
 197 See also `auto-save-file-name-p'."
 198   (convert-standard-filename (original-make-auto-save-file-name)))
 199
 200 (defun convert-standard-filename (filename)
 201   "Convert a standard file's name to something suitable for the current OS.
 202 This function's standard definition is trivial; it just returns the argument.
 203 However, on some systems, the function is redefined
 204 with a definition that really does change some file names."
 205   (let ((name (copy-sequence filename))
 206         (start 0))
 207     ;; leave ':' if part of drive specifier
 208     (if (eq (aref name 1) ?:)
 209         (setq start 2))
 210     ;; destructively replace invalid filename characters with !
 211     (while (string-match "[?*:<>|\"\000-\037]" name start)
 212       (aset name (match-beginning 0) ?!)
 213       (setq start (match-end 0)))
 214     name))
 215
 216 ;;; Fix interface to (X-specific) mouse.el
 217 (defun x-set-selection (type data)
 218   (or type (setq type 'PRIMARY))
 219   (put 'x-selections type data))
 220
 221 (defun x-get-selection (&optional type data-type)
 222   (or type (setq type 'PRIMARY))
 223   (get 'x-selections type))
 224
 225 ;;; Set to a system sound if you want a fancy bell.
 226 (set-message-beep nil)
 227
 228 ;;; The "Windows" keys on newer keyboards bring up the Start menu
 229 ;;; whether you want it or not - make Emacs ignore these keystrokes
 230 ;;; rather than beep.
 231 (global-set-key [lwindow] 'ignore)
 232 (global-set-key [rwindow] 'ignore)
 233
 234 ;; Map certain keypad keys into ASCII characters
 235 ;; that people usually expect.
 236 (define-key function-key-map [tab] [?\t])
 237 (define-key function-key-map [linefeed] [?\n])
 238 (define-key function-key-map [clear] [11])
 239 (define-key function-key-map [return] [13])
 240 (define-key function-key-map [escape] [?\e])
 241 (define-key function-key-map [M-tab] [?\M-\t])
 242 (define-key function-key-map [M-linefeed] [?\M-\n])
 243 (define-key function-key-map [M-clear] [?\M-\013])
 244 (define-key function-key-map [M-return] [?\M-\015])
 245 (define-key function-key-map [M-escape] [?\M-\e])
 246
 247 ;; These don't do the right thing (voelker)
 248 ;(define-key function-key-map [backspace] [127])
 249 ;(define-key function-key-map [delete] [127])
 250 ;(define-key function-key-map [M-backspace] [?\M-\d])
 251 ;(define-key function-key-map [M-delete] [?\M-\d])
 252
 253 ;; These tell read-char how to convert
 254 ;; these special chars to ASCII.
 255 (put 'tab 'ascii-character ?\t)
 256 (put 'linefeed 'ascii-character ?\n)
 257 (put 'clear 'ascii-character 12)
 258 (put 'return 'ascii-character 13)
 259 (put 'escape 'ascii-character ?\e)
 260 (put 'backspace 'ascii-character 127)
 261 (put 'delete 'ascii-character 127)
 262
 263 ;;; w32-fns.el ends here