lisp/w32-fns.el

   1 ;; winnt.el --- Lisp routines for Windows NT.
   2 ;; Copyright (C) 1994 Free Software Foundation, Inc.
   3
   4 ;; Author: Geoff Voelker (voelker@cs.washington.edu)
   5
   6 ;; This file is part of GNU Emacs.
   7
   8 ;; GNU Emacs is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 2, or (at your option)
  11 ;; any later version.
  12
  13 ;; GNU Emacs is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  20 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  21
  22 ;;; Commentary:
  23
  24 ;; (August 12, 1993)
  25 ;; Created.
  26
  27 ;; (November 21, 1994)
  28 ;; [C-M-backspace] defined.
  29 ;; mode-line-format defined to show buffer file type.
  30 ;; audio bell initialized.
  31
  32 ;;; Code:
  33
  34 ;; Map delete and backspace
  35 (define-key function-key-map [backspace] "\177")
  36 (define-key function-key-map [delete] "\C-d")
  37 (define-key function-key-map [M-backspace] [?\M-\177])
  38 (define-key function-key-map [C-M-backspace] [\C-\M-delete])
  39
  40 ;; Show file type (text or binary) on modeline
  41 (setq-default mode-line-format
  42   (list (purecopy "")
  43    'mode-line-modified
  44    'mode-line-buffer-identification
  45    (purecopy "   ")
  46    'global-mode-string
  47    (purecopy "   %[(")
  48    (purecopy "%t:")
  49    'mode-name 'mode-line-process 'minor-mode-alist
  50    (purecopy "%n")
  51    (purecopy ")%]--")
  52    (purecopy '(line-number-mode "L%l--"))
  53    (purecopy '(-3 . "%p"))
  54    (purecopy "-%-")))
  55
  56 ;; Ignore case on file-name completion
  57 (setq completion-ignore-case t)
  58
  59 ;; The cmd.exe shell uses the "/c" switch instead of the "-c" switch
  60 ;; for executing its command line argument (from simple.el).
  61 (setq shell-command-switch "/c")
  62
  63 ;; Use ";" instead of ":" as a path separator (from files.el).
  64 (setq path-separator ";")
  65
  66 ;; Set the null device (for compile.el).
  67 (setq grep-null-device "NUL")
  68
  69 ;; Set the grep regexp to match entries with drive letters.
  70 (setq grep-regexp-alist
  71   '(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3)))
  72
  73 ;; Taken from dos-fn.el ... don't want all that's in the file, maybe
  74 ;; separate it out someday.
  75
  76 (defvar file-name-buffer-file-type-alist
  77   '(
  78     ("[:/].*config.sys$" . nil)         ; config.sys text
  79     ("\\.elc$" . t)                     ; emacs stuff
  80     ("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|chk\\|out\\|bin\\|ico\\|pif\\)$" . t)
  81                                         ; MS-Dos stuff
  82     ("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" . t)
  83                                         ; Packers
  84     ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\)$" . t)
  85                                         ; Unix stuff
  86     ("\\.tp[ulpw]$" . t)
  87                                         ; Borland Pascal stuff
  88     ("[:/]tags$" . t)
  89                                         ; Emacs TAGS file
  90     )
  91   "*Alist for distinguishing text files from binary files.
  92 Each element has the form (REGEXP . TYPE), where REGEXP is matched
  93 against the file name, and TYPE is nil for text, t for binary.")
  94
  95 (defun find-buffer-file-type (filename)
  96   (let ((alist file-name-buffer-file-type-alist)
  97         (found nil)
  98         (code nil))
  99     (let ((case-fold-search t))
 100       (setq filename (file-name-sans-versions filename))
 101       (while (and (not found) alist)
 102         (if (string-match (car (car alist)) filename)
 103             (setq code (cdr (car alist))
 104                   found t))
 105         (setq alist (cdr alist))))
 106     (if found
 107         (cond((memq code '(nil t)) code)
 108              ((and (symbolp code) (fboundp code))
 109               (funcall code filename)))
 110       default-buffer-file-type)))
 111
 112 (defun find-file-binary (filename)
 113   "Visit file FILENAME and treat it as binary."
 114   (interactive "FFind file binary: ")
 115   (let ((file-name-buffer-file-type-alist '(("" . t))))
 116     (find-file filename)))
 117
 118 (defun find-file-text (filename)
 119   "Visit file FILENAME and treat it as a text file."
 120   (interactive "FFind file text: ")
 121   (let ((file-name-buffer-file-type-alist '(("" . nil))))
 122     (find-file filename)))
 123
 124 (defun find-file-not-found-set-buffer-file-type ()
 125   (save-excursion
 126     (set-buffer (current-buffer))
 127     (setq buffer-file-type (find-buffer-file-type (buffer-file-name))))
 128   nil)
 129
 130 ;;; To set the default file type on new files.
 131 (add-hook 'find-file-not-found-hooks 'find-file-not-found-set-buffer-file-type)
 132
 133 ;;; For using attached Unix filesystems.
 134 (defun save-to-unix-hook ()
 135   (save-excursion
 136     (setq buffer-file-type t))
 137   nil)
 138
 139 (defun revert-from-unix-hook ()
 140   (save-excursion
 141     (setq buffer-file-type (find-buffer-file-type (buffer-file-name))))
 142   nil)
 143
 144 ;; Really should provide this capability at the drive letter granularity.
 145 (defun using-unix-filesystems (flag)
 146   (if flag
 147       (progn
 148         (add-hook 'write-file-hooks 'save-to-unix-hook)
 149         (add-hook 'write-contents-hooks 'save-to-unix-hook)
 150         (add-hook 'after-save-hook 'revert-from-unix-hook))
 151     (progn
 152       (remove-hook 'write-file-hooks 'save-to-unix-hook)
 153       (remove-hook 'write-contents-hooks 'save-to-unix-hook)
 154       (remove-hook 'after-save-hook 'revert-from-unix-hook))))
 155
 156 ;;; Fix interface to (X-specific) mouse.el
 157 (defalias 'x-set-selection 'ignore)
 158 (fset 'x-get-selection '(lambda (&rest rest) ""))
 159 (fmakunbound 'font-menu-add-default)
 160 (global-unset-key [C-down-mouse-1])
 161 (global-unset-key [C-down-mouse-2])
 162 (global-unset-key [C-down-mouse-3])
 163
 164 ;;; Set to a system sound if you want a fancy bell.
 165 (set-message-beep nil)
 166
 167 ;;; winnt.el ends here