comparison lisp/w32-fns.el @ 19692:4b8ff0021dcb

Don't unset C-mouse-down bindings. Ignore "Windows" keys by default. Move keypad key definitions from term/w32-win.el. (convert-standard-file-name): New function. (make-auto-save-file-name): Use convert-standard-file-name. Update doc strings. (w32-startup): Deleted function. (w32-check-shell-configuration, w32-init-info): New functions. (w32-system-shell-p): Renamed from w32-using-system-shell-p. Added shell name argument.
author Geoff Voelker <voelker@cs.washington.edu>
date Tue, 02 Sep 1997 23:54:07 +0000
parents f57de209f01b
children cbd9e55a6cdc
comparison
equal deleted inserted replaced
19691:a96c6fa10e92 19692:4b8ff0021dcb
40 (define-key function-key-map [C-M-backspace] [\C-\M-delete]) 40 (define-key function-key-map [C-M-backspace] [\C-\M-delete])
41 41
42 ;; Ignore case on file-name completion 42 ;; Ignore case on file-name completion
43 (setq completion-ignore-case t) 43 (setq completion-ignore-case t)
44 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
45 (defvar w32-system-shells '("cmd" "cmd.exe" "command" "command.com") 49 (defvar w32-system-shells '("cmd" "cmd.exe" "command" "command.com")
46 "List of strings recognized as Windows NT/95 system shells.") 50 "List of strings recognized as Windows NT/9X system shells.")
47 51
48 (defun w32-using-nt () 52 (defun w32-using-nt ()
49 "Return t if running on Windows NT (as oppposed to, e.g., Windows 95)." 53 "Return t if literally running on Windows NT (i.e., not Windows 9X)."
50 (and (eq system-type 'windows-nt) (getenv "SystemRoot"))) 54 (and (eq system-type 'windows-nt) (getenv "SystemRoot")))
51 55
52 (defun w32-shell-name () 56 (defun w32-shell-name ()
53 "Return the name of the shell being used on Windows NT/95." 57 "Return the name of the shell being used."
54 (or (and (boundp 'explicit-shell-file-name) explicit-shell-file-name) 58 (or (and (boundp 'explicit-shell-file-name) explicit-shell-file-name)
55 (getenv "ESHELL") 59 (getenv "ESHELL")
56 (getenv "SHELL") 60 (getenv "SHELL")
57 (and (w32-using-nt) "cmd.exe") 61 (and (w32-using-nt) "cmd.exe")
58 "command.com")) 62 "command.com"))
59 63
60 (defun w32-using-system-shell-p () 64 (defun w32-system-shell-p (shell-name)
61 "Return t if using a Windows NT/95 system shell (cmd.exe or command.com)." 65 (and shell-name
62 (member (downcase (file-name-nondirectory (w32-shell-name))) 66 (member (downcase (file-name-nondirectory shell-name))
63 w32-system-shells)) 67 w32-system-shells)))
64 68
65 (defun w32-startup () 69 (defun w32-check-shell-configuration ()
66 "Configure Emacs during startup for running on Windows NT/95. 70 "Check the configuration of shell variables on Windows NT/9X.
67 This function is invoked after loading the init files and processing 71 This function is invoked after loading the init files and processing
68 the command line, and is intended to initialize anything important 72 the command line arguments. It issues a warning if the user or site
69 not initialized by the user or site." 73 has configured the shell with inappropriate settings."
70 ;; Configure shell mode if using a system shell. 74 (let ((prev-buffer (current-buffer))
71 (cond ((w32-using-system-shell-p) 75 (buffer (get-buffer-create "*Shell Configuration*"))
72 (let ((shell (file-name-nondirectory (w32-shell-name)))) 76 (system-shell))
73 ;; "/c" is used for executing command line arguments. 77 (set-buffer buffer)
74 (setq shell-command-switch "/c") 78 (erase-buffer)
75 ;; Complete directories using a backslash. 79 (if (w32-system-shell-p (getenv "ESHELL"))
76 (setq comint-completion-addsuffix '("\\" . " ")) 80 (insert (format "Warning! The ESHELL environment variable uses %s.
77 ;; Initialize the explicit-"shell"-args variable. 81 You probably want to change it so that it uses cmdproxy.exe instead.\n\n"
78 (cond ((member (downcase shell) '("cmd" "cmd.exe")) 82 (getenv "ESHELL"))))
79 (let* ((args-sym-name (format "explicit-%s-args" shell)) 83 (if (w32-system-shell-p (getenv "SHELL"))
80 (args-sym (intern-soft args-sym-name))) 84 (insert (format "Warning! The SHELL environment variable uses %s.
81 (cond ((not args-sym) 85 You probably want to change it so that it uses cmdproxy.exe instead.\n\n"
82 (setq args-sym (intern args-sym-name)) 86 (getenv "SHELL"))))
83 ;; The "/q" prevents cmd.exe from echoing commands. 87 (if (w32-system-shell-p shell-file-name)
84 (set args-sym '("/q"))))))))))) 88 (insert (format "Warning! shell-file-name uses %s.
85 89 You probably want to change it so that it uses cmdproxy.exe instead.\n\n"
86 (add-hook 'emacs-startup-hook 'w32-startup) 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)
87 137
88 ;; Avoid creating auto-save file names containing invalid characters. 138 ;; Avoid creating auto-save file names containing invalid characters.
89 (fset 'original-make-auto-save-file-name 139 (fset 'original-make-auto-save-file-name
90 (symbol-function 'make-auto-save-file-name)) 140 (symbol-function 'make-auto-save-file-name))
91 141
92 (defun make-auto-save-file-name () 142 (defun make-auto-save-file-name ()
93 "Return file name to use for auto-saves of current buffer. 143 "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 144 Does not consider `auto-save-visited-file-name' as that variable is checked
95 before calling this function. You can redefine this for customization. 145 before calling this function. You can redefine this for customization.
96 See also `auto-save-file-name-p'." 146 See also `auto-save-file-name-p'."
97 (let ((name (original-make-auto-save-file-name)) 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))
98 (start 0)) 155 (start 0))
99 ;; Skip drive letter if present. 156 ;; leave ':' if part of drive specifier
100 (if (string-match "^[\/]?[a-zA-`]:" name) 157 (if (eq (aref name 1) ?:)
101 (setq start (- (match-end 0) (match-beginning 0)))) 158 (setq start 2))
102 ;; Destructively replace occurrences of *?"<>|: with $ 159 ;; destructively replace invalid filename characters with !
103 (while (string-match "[?*\"<>|:]" name start) 160 (while (string-match "[?*:<>|\"\000-\037]" name start)
104 (aset name (match-beginning 0) ?$) 161 (aset name (match-beginning 0) ?!)
105 (setq start (1+ (match-end 0)))) 162 (setq start (match-end 0)))
106 name)) 163 name))
107 164
108 ;;; Fix interface to (X-specific) mouse.el 165 ;;; Fix interface to (X-specific) mouse.el
109 (defun x-set-selection (type data) 166 (defun x-set-selection (type data)
110 (or type (setq type 'PRIMARY)) 167 (or type (setq type 'PRIMARY))
112 169
113 (defun x-get-selection (&optional type data-type) 170 (defun x-get-selection (&optional type data-type)
114 (or type (setq type 'PRIMARY)) 171 (or type (setq type 'PRIMARY))
115 (get 'x-selections type)) 172 (get 'x-selections type))
116 173
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. 174 ;;; Set to a system sound if you want a fancy bell.
123 (set-message-beep nil) 175 (set-message-beep nil)
124 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
125 ;;; w32-fns.el ends here 212 ;;; w32-fns.el ends here