[bpt/emacs.git] / lisp / w32-fns.el

;;; winnt.el --- Lisp routines for Windows NT.

;; Copyright (C) 1994 Free Software Foundation, Inc.

;; Author: Geoff Voelker (voelker@cs.washington.edu)

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; (August 12, 1993)
;; Created.

;; (November 21, 1994)
;; [C-M-backspace] defined.
;; mode-line-format defined to show buffer file type.
;; audio bell initialized.

;;; Code:

;; Map delete and backspace
(define-key function-key-map [backspace] "\177")
(define-key function-key-map [delete] "\C-d")
(define-key function-key-map [M-backspace] [?\M-\177])
(define-key function-key-map [C-M-backspace] [\C-\M-delete])

;; Show file type (text or binary) on modeline
(setq-default mode-line-format
  (list (purecopy "")
   'mode-line-modified
   'mode-line-buffer-identification
   (purecopy "   ")
   'global-mode-string
   (purecopy "   %[(")
   (purecopy "%t:")
   'mode-name 'mode-line-process 'minor-mode-alist
   (purecopy "%n")
   (purecopy ")%]--")
   (purecopy '(line-number-mode "L%l--"))
   (purecopy '(column-number-mode "C%c--"))
   (purecopy '(-3 . "%p"))
   (purecopy "-%-")))

;; Ignore case on file-name completion
(setq completion-ignore-case t)

;; The cmd.exe shell uses the "/c" switch instead of the "-c" switch
;; for executing its command line argument (from simple.el).
(setq shell-command-switch "/c")

;; Use ";" instead of ":" as a path separator (from files.el).
(setq path-separator ";")

;; Set the null device (for compile.el).
(setq grep-null-device "NUL")

;; Set the grep regexp to match entries with drive letters.
(setq grep-regexp-alist
  '(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3)))

;; Taken from dos-fn.el ... don't want all that's in the file, maybe
;; separate it out someday.

(defvar file-name-buffer-file-type-alist
  '(
    ("[:/].*config.sys$" . nil)		; config.sys text
    ("\\.elc$" . t)			; emacs stuff
    ("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|chk\\|out\\|bin\\|ico\\|pif\\)$" . t)
					; MS-Dos stuff
    ("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" . t)
					; Packers
    ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\)$" . t)
					; Unix stuff
    ("\\.tp[ulpw]$" . t)
					; Borland Pascal stuff
    ("[:/]tags$" . t)
					; Emacs TAGS file
    )
  "*Alist for distinguishing text files from binary files.
Each element has the form (REGEXP . TYPE), where REGEXP is matched
against the file name, and TYPE is nil for text, t for binary.")

(defun find-buffer-file-type (filename)
  (let ((alist file-name-buffer-file-type-alist)
	(found nil)
	(code nil))
    (let ((case-fold-search t))
      (setq filename (file-name-sans-versions filename))
      (while (and (not found) alist)
	(if (string-match (car (car alist)) filename)
	    (setq code (cdr (car alist))
		  found t))
	(setq alist (cdr alist))))
    (if found
	(cond((memq code '(nil t)) code)
	     ((and (symbolp code) (fboundp code))
	      (funcall code filename)))
      default-buffer-file-type)))

(defun find-file-binary (filename) 
  "Visit file FILENAME and treat it as binary."
  (interactive "FFind file binary: ")
  (let ((file-name-buffer-file-type-alist '(("" . t))))
    (find-file filename)))

(defun find-file-text (filename) 
  "Visit file FILENAME and treat it as a text file."
  (interactive "FFind file text: ")
  (let ((file-name-buffer-file-type-alist '(("" . nil))))
    (find-file filename)))

(defun find-file-not-found-set-buffer-file-type ()
  (save-excursion
    (set-buffer (current-buffer))
    (setq buffer-file-type (find-buffer-file-type (buffer-file-name))))
  nil)

;;; To set the default file type on new files.
(add-hook 'find-file-not-found-hooks 'find-file-not-found-set-buffer-file-type)

;;; For using attached Unix filesystems.
(defun save-to-unix-hook ()
  (save-excursion
    (setq buffer-file-type t))
  nil)

(defun revert-from-unix-hook ()
  (save-excursion
    (setq buffer-file-type (find-buffer-file-type (buffer-file-name))))
  nil)

;; Really should provide this capability at the drive letter granularity.
(defun using-unix-filesystems (flag)
  (if flag
      (progn
	(add-hook 'write-file-hooks 'save-to-unix-hook)
	(add-hook 'after-save-hook 'revert-from-unix-hook))
    (progn
      (remove-hook 'write-file-hooks 'save-to-unix-hook)
      (remove-hook 'after-save-hook 'revert-from-unix-hook))))

;;; Fix interface to (X-specific) mouse.el
(defalias 'x-set-selection 'ignore)
(fset 'x-get-selection '(lambda (&rest rest) ""))
(fmakunbound 'font-menu-add-default)
(global-unset-key [C-down-mouse-1])
(global-unset-key [C-down-mouse-2])
(global-unset-key [C-down-mouse-3])

;;; Set to a system sound if you want a fancy bell.
(set-message-beep nil)

;;; winnt.el ends here
Commit	Line	Data
edabc323	1	;;; winnt.el --- Lisp routines for Windows NT.
b578f267	2
95ed0025 RS	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
b578f267 EN	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.
95ed0025 RS	23
	24	;;; Commentary:
	25
	26	;; (August 12, 1993)
81b38822	27	;; Created.
95ed0025	28
81b38822 KH	29	;; (November 21, 1994)
	30	;; [C-M-backspace] defined.
	31	;; mode-line-format defined to show buffer file type.
	32	;; audio bell initialized.
95ed0025 RS	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])
81b38822 KH	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--"))
66188e40	55	(purecopy '(column-number-mode "C%c--"))
81b38822 KH	56	(purecopy '(-3 . "%p"))
81b38822 KH	57	(purecopy "-%-")))
95ed0025 RS	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
98b17af9 RS	66	;; Use ";" instead of ":" as a path separator (from files.el).
	67	(setq path-separator ";")
	68
d99671d7 RS	69	;; Set the null device (for compile.el).
	70	(setq grep-null-device "NUL")
	71
	72	;; Set the grep regexp to match entries with drive letters.
	73	(setq grep-regexp-alist
	74	'(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3)))
	75
95ed0025 RS	76	;; Taken from dos-fn.el ... don't want all that's in the file, maybe
	77	;; separate it out someday.
	78
	79	(defvar file-name-buffer-file-type-alist
	80	'(
	81	("[:/].*config.sys$" . nil) ; config.sys text
	82	("\\.elc$" . t) ; emacs stuff
	83	("\\.\\(obj\\\|exe\\\|com\\\|lib\\\|sys\\\|chk\\\|out\\\|bin\\\|ico\\\|pif\\)$" . t)
	84	; MS-Dos stuff
	85	("\\.\\(arc\\\|zip\\\|pak\\\|lzh\\\|zoo\\)$" . t)
	86	; Packers
	87	("\\.\\(a\\\|o\\\|tar\\\|z\\\|gz\\\|taz\\)$" . t)
	88	; Unix stuff
	89	("\\.tp[ulpw]$" . t)
	90	; Borland Pascal stuff
	91	("[:/]tags$" . t)
	92	; Emacs TAGS file
	93	)
	94	"*Alist for distinguishing text files from binary files.
	95	Each element has the form (REGEXP . TYPE), where REGEXP is matched
	96	against the file name, and TYPE is nil for text, t for binary.")
	97
	98	(defun find-buffer-file-type (filename)
	99	(let ((alist file-name-buffer-file-type-alist)
	100	(found nil)
	101	(code nil))
	102	(let ((case-fold-search t))
	103	(setq filename (file-name-sans-versions filename))
	104	(while (and (not found) alist)
	105	(if (string-match (car (car alist)) filename)
	106	(setq code (cdr (car alist))
	107	found t))
	108	(setq alist (cdr alist))))
	109	(if found
	110	(cond((memq code '(nil t)) code)
	111	((and (symbolp code) (fboundp code))
	112	(funcall code filename)))
	113	default-buffer-file-type)))
	114
	115	(defun find-file-binary (filename)
	116	"Visit file FILENAME and treat it as binary."
	117	(interactive "FFind file binary: ")
	118	(let ((file-name-buffer-file-type-alist '(("" . t))))
	119	(find-file filename)))
	120
	121	(defun find-file-text (filename)
	122	"Visit file FILENAME and treat it as a text file."
	123	(interactive "FFind file text: ")
	124	(let ((file-name-buffer-file-type-alist '(("" . nil))))
	125	(find-file filename)))
	126
	127	(defun find-file-not-found-set-buffer-file-type ()
	128	(save-excursion
	129	(set-buffer (current-buffer))
	130	(setq buffer-file-type (find-buffer-file-type (buffer-file-name))))
	131	nil)
	132
	133	;;; To set the default file type on new files.
	134	(add-hook 'find-file-not-found-hooks 'find-file-not-found-set-buffer-file-type)
	135
d99671d7 RS	136	;;; For using attached Unix filesystems.
	137	(defun save-to-unix-hook ()
	138	(save-excursion
	139	(setq buffer-file-type t))
	140	nil)
	141
	142	(defun revert-from-unix-hook ()
	143	(save-excursion
	144	(setq buffer-file-type (find-buffer-file-type (buffer-file-name))))
	145	nil)
	146
	147	;; Really should provide this capability at the drive letter granularity.
	148	(defun using-unix-filesystems (flag)
	149	(if flag
	150	(progn
	151	(add-hook 'write-file-hooks 'save-to-unix-hook)
d99671d7 RS	152	(add-hook 'after-save-hook 'revert-from-unix-hook))
	153	(progn
	154	(remove-hook 'write-file-hooks 'save-to-unix-hook)
d99671d7 RS	155	(remove-hook 'after-save-hook 'revert-from-unix-hook))))
d99671d7 RS	156
95ed0025	157	;;; Fix interface to (X-specific) mouse.el
95ed0025 RS	158	(defalias 'x-set-selection 'ignore)
	159	(fset 'x-get-selection '(lambda (&rest rest) ""))
	160	(fmakunbound 'font-menu-add-default)
	161	(global-unset-key [C-down-mouse-1])
	162	(global-unset-key [C-down-mouse-2])
	163	(global-unset-key [C-down-mouse-3])
	164
81b38822 KH	165	;;; Set to a system sound if you want a fancy bell.
	166	(set-message-beep nil)
	167
95ed0025	168	;;; winnt.el ends here