lisp/w32-fns.el

   1 ;;; winnt.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 ;; Show file type (text or binary) on modeline
  43 (setq-default mode-line-format
  44   (list (purecopy "")
  45    'mode-line-modified
  46    'mode-line-buffer-identification
  47    (purecopy "   ")
  48    'global-mode-string
  49    (purecopy "   %[(")
  50    (purecopy "%t:")
  51    'mode-name 'mode-line-process 'minor-mode-alist
  52    (purecopy "%n")
  53    (purecopy ")%]--")
  54    (purecopy '(line-number-mode "L%l--"))
  55    (purecopy '(column-number-mode "C%c--"))
  56    (purecopy '(-3 . "%p"))
  57    (purecopy "-%-")))
  58
  59 ;; Ignore case on file-name completion
  60 (setq completion-ignore-case t)
  61
  62 ;; The cmd.exe shell uses the "/c" switch instead of the "-c" switch
  63 ;; for executing its command line argument (from simple.el).
  64 (setq shell-command-switch "/c")
  65
  66 ;; For appending suffixes to directories and files in shell completions.
  67 (add-hook 'shell-mode-hook
  68           '(lambda () (setq comint-completion-addsuffix '("\\" . " "))))
  69
  70 ;; Use ";" instead of ":" as a path separator (from files.el).
  71 (setq path-separator ";")
  72
  73 ;; Set the null device (for compile.el).
  74 (setq grep-null-device "NUL")
  75
  76 ;; Set the grep regexp to match entries with drive letters.
  77 (setq grep-regexp-alist
  78   '(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3)))
  79
  80 ;; Taken from dos-fn.el ... don't want all that's in the file, maybe
  81 ;; separate it out someday.
  82
  83 (defvar file-name-buffer-file-type-alist
  84   '(
  85     ("[:/].*config.sys$" . nil)         ; config.sys text
  86     ("\\.elc$" . t)                     ; emacs stuff
  87     ("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|chk\\|out\\|bin\\|ico\\|pif\\)$" . t)
  88                                         ; MS-Dos stuff
  89     ("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" . t)
  90                                         ; Packers
  91     ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\)$" . t)
  92                                         ; Unix stuff
  93     ("\\.tp[ulpw]$" . t)
  94                                         ; Borland Pascal stuff
  95     ("[:/]tags$" . t)
  96                                         ; Emacs TAGS file
  97     )
  98   "*Alist for distinguishing text files from binary files.
  99 Each element has the form (REGEXP . TYPE), where REGEXP is matched
 100 against the file name, and TYPE is nil for text, t for binary.")
 101
 102 (defun find-buffer-file-type (filename)
 103   (let ((alist file-name-buffer-file-type-alist)
 104         (found nil)
 105         (code nil))
 106     (let ((case-fold-search t))
 107       (setq filename (file-name-sans-versions filename))
 108       (while (and (not found) alist)
 109         (if (string-match (car (car alist)) filename)
 110             (setq code (cdr (car alist))
 111                   found t))
 112         (setq alist (cdr alist))))
 113     (if found
 114         (cond((memq code '(nil t)) code)
 115              ((and (symbolp code) (fboundp code))
 116               (funcall code filename)))
 117       default-buffer-file-type)))
 118
 119 (defun find-file-binary (filename)
 120   "Visit file FILENAME and treat it as binary."
 121   (interactive "FFind file binary: ")
 122   (let ((file-name-buffer-file-type-alist '(("" . t))))
 123     (find-file filename)))
 124
 125 (defun find-file-text (filename)
 126   "Visit file FILENAME and treat it as a text file."
 127   (interactive "FFind file text: ")
 128   (let ((file-name-buffer-file-type-alist '(("" . nil))))
 129     (find-file filename)))
 130
 131 (defun find-file-not-found-set-buffer-file-type ()
 132   (save-excursion
 133     (set-buffer (current-buffer))
 134     (setq buffer-file-type (find-buffer-file-type (buffer-file-name))))
 135   nil)
 136
 137 ;;; To set the default file type on new files.
 138 (add-hook 'find-file-not-found-hooks 'find-file-not-found-set-buffer-file-type)
 139
 140 ;;; For using attached Unix filesystems.
 141 (defun save-to-unix-hook ()
 142   (save-excursion
 143     (setq buffer-file-type t))
 144   nil)
 145
 146 (defun revert-from-unix-hook ()
 147   (save-excursion
 148     (setq buffer-file-type (find-buffer-file-type (buffer-file-name))))
 149   nil)
 150
 151 ;; Really should provide this capability at the drive letter granularity.
 152 (defun using-unix-filesystems (flag)
 153   "Read and write files without CR/LF translation, if FLAG is non-nil.
 154 This is in effect assuming the files are on a remote Unix file system.
 155 If FLAG is nil, resume using CR/LF translation as usual."
 156   (if flag
 157       (progn
 158         (add-hook 'write-file-hooks 'save-to-unix-hook)
 159         (add-hook 'after-save-hook 'revert-from-unix-hook))
 160     (progn
 161       (remove-hook 'write-file-hooks 'save-to-unix-hook)
 162       (remove-hook 'after-save-hook 'revert-from-unix-hook))))
 163
 164 ;;; Avoid creating auto-save file names containing invalid characters
 165 ;;; (primarily "*", eg. for the *mail* buffer).
 166 (fset 'original-make-auto-save-file-name
 167       (symbol-function 'make-auto-save-file-name))
 168
 169 (defun make-auto-save-file-name ()
 170   "Return file name to use for auto-saves of current buffer.
 171 Does not consider `auto-save-visited-file-name' as that variable is checked
 172 before calling this function.  You can redefine this for customization.
 173 See also `auto-save-file-name-p'."
 174   (let ((name (original-make-auto-save-file-name))
 175         (start 0))
 176     ;; destructively replace occurences of * or ? with $
 177     (while (string-match "[?*]" name start)
 178       (aset name (match-beginning 0) ?$)
 179       (setq start (1+ (match-end 0))))
 180     name))
 181
 182 ;;; Fix interface to (X-specific) mouse.el
 183 (defun x-set-selection (type data)
 184   (or type (setq type 'PRIMARY))
 185   (put 'x-selections type data))
 186
 187 (defun x-get-selection (&optional type data-type)
 188   (or type (setq type 'PRIMARY))
 189   (get 'x-selections type))
 190
 191 (fmakunbound 'font-menu-add-default)
 192 (global-unset-key [C-down-mouse-1])
 193 (global-unset-key [C-down-mouse-2])
 194 (global-unset-key [C-down-mouse-3])
 195
 196 ;;; Set to a system sound if you want a fancy bell.
 197 (set-message-beep nil)
 198
 199 ;;; winnt.el ends here