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 (defvar w32-system-shells '("cmd" "cmd.exe" "command" "command.com")
  46   "List of strings recognized as Windows NT/95 system shells.")
  47
  48 (defun w32-using-nt ()
  49   "Return t if running on Windows NT (as oppposed to, e.g., Windows 95)."
  50   (and (eq system-type 'windows-nt) (getenv "SystemRoot")))
  51
  52 (defun w32-shell-name ()
  53   "Return the name of the shell being used on Windows NT/95."
  54   (or (and (boundp 'explicit-shell-file-name) explicit-shell-file-name)
  55       (getenv "ESHELL")
  56       (getenv "SHELL")
  57       (and (w32-using-nt) "cmd.exe")
  58       "command.com"))
  59
  60 (defun w32-using-system-shell-p ()
  61   "Return t if using a Windows NT/95 system shell (cmd.exe or command.com)."
  62   (member (downcase (file-name-nondirectory (w32-shell-name)))
  63           w32-system-shells))
  64
  65 (defun w32-startup ()
  66   "Configure Emacs during startup for running on Windows NT/95.
  67 This function is invoked after loading the init files and processing
  68 the command line, and is intended to initialize anything important
  69 not initialized by the user or site."
  70   ;; Configure shell mode if using a system shell.
  71   (cond ((w32-using-system-shell-p)
  72          (let ((shell (file-name-nondirectory (w32-shell-name))))
  73            ;; "/c" is used for executing command line arguments.
  74            (setq shell-command-switch "/c")
  75            ;; Complete directories using a backslash.
  76            (setq comint-completion-addsuffix '("\\" . " "))
  77            ;; Initialize the explicit-"shell"-args variable.
  78            (cond ((member (downcase shell) '("cmd" "cmd.exe"))
  79                   (let* ((args-sym-name (format "explicit-%s-args" shell))
  80                          (args-sym (intern-soft args-sym-name)))
  81                     (cond ((not args-sym)
  82                            (setq args-sym (intern args-sym-name))
  83                            ;; The "/q" prevents cmd.exe from echoing commands.
  84                            (set args-sym '("/q")))))))))))
  85
  86 (add-hook 'emacs-startup-hook 'w32-startup)
  87
  88 ;; Avoid creating auto-save file names containing invalid characters.
  89 (fset 'original-make-auto-save-file-name
  90       (symbol-function 'make-auto-save-file-name))
  91
  92 (defun make-auto-save-file-name ()
  93   "Return file name to use for auto-saves of current buffer.
  94 Does not consider `auto-save-visited-file-name' as that variable is checked
  95 before calling this function.  You can redefine this for customization.
  96 See also `auto-save-file-name-p'."
  97   (let ((name (original-make-auto-save-file-name))
  98         (start 0))
  99     ;; Skip drive letter if present.
 100     (if (string-match "^[\/]?[a-zA-`]:" name)
 101         (setq start (- (match-end 0) (match-beginning 0))))
 102     ;; Destructively replace occurrences of *?"<>|: with $
 103     (while (string-match "[?*\"<>|:]" name start)
 104       (aset name (match-beginning 0) ?$)
 105       (setq start (1+ (match-end 0))))
 106     name))
 107
 108 ;;; Fix interface to (X-specific) mouse.el
 109 (defun x-set-selection (type data)
 110   (or type (setq type 'PRIMARY))
 111   (put 'x-selections type data))
 112
 113 (defun x-get-selection (&optional type data-type)
 114   (or type (setq type 'PRIMARY))
 115   (get 'x-selections type))
 116
 117 (fmakunbound 'font-menu-add-default)
 118 (global-unset-key [C-down-mouse-1])
 119 (global-unset-key [C-down-mouse-2])
 120 (global-unset-key [C-down-mouse-3])
 121
 122 ;;; Set to a system sound if you want a fancy bell.
 123 (set-message-beep nil)
 124
 125 ;;; w32-fns.el ends here