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   "List of strings recognized as Windows NT/9X system shells.")
  51
  52 (defun w32-using-nt ()
  53   "Return t if literally running on Windows NT (i.e., not Windows 9X)."
  54   (and (eq system-type 'windows-nt) (getenv "SystemRoot")))
  55
  56 (defun w32-shell-name ()
  57   "Return the name of the shell being used."
  58   (or (and (boundp 'explicit-shell-file-name) explicit-shell-file-name)
  59       (getenv "ESHELL")
  60       (getenv "SHELL")
  61       (and (w32-using-nt) "cmd.exe")
  62       "command.com"))
  63
  64 (defun w32-system-shell-p (shell-name)
  65   (and shell-name
  66        (member (downcase (file-name-nondirectory shell-name))
  67                w32-system-shells)))
  68
  69 (defun w32-check-shell-configuration ()
  70   "Check the configuration of shell variables on Windows NT/9X.
  71 This function is invoked after loading the init files and processing
  72 the command line arguments.  It issues a warning if the user or site
  73 has configured the shell with inappropriate settings."
  74   (let ((prev-buffer (current-buffer))
  75         (buffer (get-buffer-create "*Shell Configuration*"))
  76         (system-shell))
  77     (set-buffer buffer)
  78     (erase-buffer)
  79     (if (w32-system-shell-p (getenv "ESHELL"))
  80         (insert (format "Warning! The ESHELL environment variable uses %s.
  81 You probably want to change it so that it uses cmdproxy.exe instead.\n\n"
  82                         (getenv "ESHELL"))))
  83     (if (w32-system-shell-p (getenv "SHELL"))
  84         (insert (format "Warning! The SHELL environment variable uses %s.
  85 You probably want to change it so that it uses cmdproxy.exe instead.\n\n"
  86                         (getenv "SHELL"))))
  87     (if (w32-system-shell-p shell-file-name)
  88         (insert (format "Warning! shell-file-name uses %s.
  89 You probably want to change it so that it uses cmdproxy.exe instead.\n\n"
  90                         shell-file-name)))
  91     (if (and (boundp 'explicit-shell-file-name)
  92              (w32-system-shell-p explicit-shell-file-name))
  93         (insert (format "Warning! explicit-shell-file-name uses %s.
  94 You probably want to change it so that it uses cmdproxy.exe instead.\n\n"
  95                         explicit-shell-file-name)))
  96     (setq system-shell (> (buffer-size) 0))
  97     (cond (system-shell
  98            ;; System shells.
  99            (if (string-equal "-c" shell-command-switch)
 100                (insert "Warning! shell-command-switch is \"-c\".
 101 You should set this to \"/c\" when using a system shell.\n\n"))
 102            (if w32-quote-process-args
 103                (insert "Warning! w32-quote-process-args is t.
 104 You should set this to nil when using a system shell.\n\n")))
 105           ;; Non-system shells.
 106           (t
 107            (if (string-equal "/c" shell-command-switch)
 108                (insert "Warning! shell-command-switch is \"/c\".
 109 You should set this to \"-c\" when using a non-system shell.\n\n"))
 110            (if (not w32-quote-process-args)
 111                (insert "Warning! w32-quote-process-args is nil.
 112 You should set this to t when using a non-system shell.\n\n"))))
 113     (if (> (buffer-size) 0)
 114         (display-buffer buffer)
 115       (kill-buffer buffer))
 116     (set-buffer prev-buffer)))
 117
 118 (add-hook 'after-init-hook 'w32-check-shell-configuration)
 119
 120 ;;; Setup Info-default-directory-list to include the info directory
 121 ;;; near where Emacs executable was installed.  We used to set INFOPATH,
 122 ;;; but when this is set Info-default-directory-list is ignored.  We
 123 ;;; also cannot rely upon what is set in paths.el because they assume
 124 ;;; that configuration during build time is correct for runtime.
 125 (defun w32-init-info ()
 126   (let* ((instdir (file-name-directory invocation-directory))
 127          (dir1 (expand-file-name "info/" instdir))
 128          (dir2 (expand-file-name "../../../info/" instdir)))
 129     (if (file-exists-p dir1)
 130         (setq Info-default-directory-list
 131               (append Info-default-directory-list (list dir1)))
 132       (if (file-exists-p dir2)
 133           (setq Info-default-directory-list
 134                 (append Info-default-directory-list (list dir2)))))))
 135
 136 (add-hook 'before-init-hook 'w32-init-info)
 137
 138 ;; Avoid creating auto-save file names containing invalid characters.
 139 (fset 'original-make-auto-save-file-name
 140       (symbol-function 'make-auto-save-file-name))
 141
 142 (defun make-auto-save-file-name ()
 143   "Return file name to use for auto-saves of current buffer.
 144 Does not consider `auto-save-visited-file-name' as that variable is checked
 145 before calling this function.  You can redefine this for customization.
 146 See also `auto-save-file-name-p'."
 147   (convert-standard-filename (original-make-auto-save-file-name)))
 148
 149 (defun convert-standard-filename (filename)
 150   "Convert a standard file's name to something suitable for the current OS.
 151 This function's standard definition is trivial; it just returns the argument.
 152 However, on some systems, the function is redefined
 153 with a definition that really does change some file names."
 154   (let ((name (copy-sequence filename))
 155         (start 0))
 156     ;; leave ':' if part of drive specifier
 157     (if (eq (aref name 1) ?:)
 158         (setq start 2))
 159     ;; destructively replace invalid filename characters with !
 160     (while (string-match "[?*:<>|\"\000-\037]" name start)
 161       (aset name (match-beginning 0) ?!)
 162       (setq start (match-end 0)))
 163     name))
 164
 165 ;;; Fix interface to (X-specific) mouse.el
 166 (defun x-set-selection (type data)
 167   (or type (setq type 'PRIMARY))
 168   (put 'x-selections type data))
 169
 170 (defun x-get-selection (&optional type data-type)
 171   (or type (setq type 'PRIMARY))
 172   (get 'x-selections type))
 173
 174 ;;; Set to a system sound if you want a fancy bell.
 175 (set-message-beep nil)
 176
 177 ;;; The "Windows" keys on newer keyboards bring up the Start menu
 178 ;;; whether you want it or not - make Emacs ignore these keystrokes
 179 ;;; rather than beep.
 180 (global-set-key [lwindow] 'ignore)
 181 (global-set-key [rwindow] 'ignore)
 182
 183 ;; Map certain keypad keys into ASCII characters
 184 ;; that people usually expect.
 185 (define-key function-key-map [tab] [?\t])
 186 (define-key function-key-map [linefeed] [?\n])
 187 (define-key function-key-map [clear] [11])
 188 (define-key function-key-map [return] [13])
 189 (define-key function-key-map [escape] [?\e])
 190 (define-key function-key-map [M-tab] [?\M-\t])
 191 (define-key function-key-map [M-linefeed] [?\M-\n])
 192 (define-key function-key-map [M-clear] [?\M-\013])
 193 (define-key function-key-map [M-return] [?\M-\015])
 194 (define-key function-key-map [M-escape] [?\M-\e])
 195
 196 ;; These don't do the right thing (voelker)
 197 ;(define-key function-key-map [backspace] [127])
 198 ;(define-key function-key-map [delete] [127])
 199 ;(define-key function-key-map [M-backspace] [?\M-\d])
 200 ;(define-key function-key-map [M-delete] [?\M-\d])
 201
 202 ;; These tell read-char how to convert
 203 ;; these special chars to ASCII.
 204 (put 'tab 'ascii-character ?\t)
 205 (put 'linefeed 'ascii-character ?\n)
 206 (put 'clear 'ascii-character 12)
 207 (put 'return 'ascii-character 13)
 208 (put 'escape 'ascii-character ?\e)
 209 (put 'backspace 'ascii-character 127)
 210 (put 'delete 'ascii-character 127)
 211
 212 ;;; w32-fns.el ends here