| 1 | ;;; w32-fns.el --- Lisp routines for 32-bit Windows |
| 2 | |
| 3 | ;; Copyright (C) 1994, 2001-2014 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Geoff Voelker <voelker@cs.washington.edu> |
| 6 | ;; Keywords: internal |
| 7 | ;; Package: emacs |
| 8 | |
| 9 | ;; This file is part of GNU Emacs. |
| 10 | |
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
| 12 | ;; it under the terms of the GNU General Public License as published by |
| 13 | ;; the Free Software Foundation, either version 3 of the License, or |
| 14 | ;; (at your option) any later version. |
| 15 | |
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 19 | ;; GNU General Public License for more details. |
| 20 | |
| 21 | ;; You should have received a copy of the GNU General Public License |
| 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 23 | |
| 24 | ;;; Commentary: |
| 25 | |
| 26 | |
| 27 | ;;; Code: |
| 28 | (require 'w32-vars) |
| 29 | (require 'w32-common-fns) |
| 30 | |
| 31 | (defvar explicit-shell-file-name) |
| 32 | |
| 33 | ;;;; Function keys |
| 34 | |
| 35 | (declare-function set-message-beep "w32fns.c") |
| 36 | (declare-function w32-get-locale-info "w32proc.c") |
| 37 | (declare-function w32-get-valid-locale-ids "w32proc.c") |
| 38 | |
| 39 | ;; Map all versions of a filename (8.3, longname, mixed case) to the |
| 40 | ;; same buffer. |
| 41 | (setq find-file-visit-truename t) |
| 42 | |
| 43 | (defun w32-shell-name () |
| 44 | "Return the name of the shell being used." |
| 45 | (or (bound-and-true-p shell-file-name) |
| 46 | (getenv "ESHELL") |
| 47 | (getenv "SHELL") |
| 48 | (and (w32-using-nt) "cmd.exe") |
| 49 | "command.com")) |
| 50 | |
| 51 | (defun w32-system-shell-p (shell-name) |
| 52 | (and shell-name |
| 53 | (member (downcase (file-name-nondirectory shell-name)) |
| 54 | w32-system-shells))) |
| 55 | |
| 56 | (defun w32-shell-dos-semantics () |
| 57 | "Return non-nil if the interactive shell being used expects MS-DOS shell semantics." |
| 58 | (or (w32-system-shell-p (w32-shell-name)) |
| 59 | (and (member (downcase (file-name-nondirectory (w32-shell-name))) |
| 60 | '("cmdproxy" "cmdproxy.exe")) |
| 61 | (w32-system-shell-p (getenv "COMSPEC"))))) |
| 62 | |
| 63 | (defvar w32-quote-process-args) ;; defined in w32proc.c |
| 64 | |
| 65 | (defun w32-check-shell-configuration () |
| 66 | "Check the configuration of shell variables on Windows. |
| 67 | This function is invoked after loading the init files and processing |
| 68 | the command line arguments. It issues a warning if the user or site |
| 69 | has configured the shell with inappropriate settings." |
| 70 | (interactive) |
| 71 | (let ((prev-buffer (current-buffer)) |
| 72 | (buffer (get-buffer-create "*Shell Configuration*")) |
| 73 | (system-shell)) |
| 74 | (set-buffer buffer) |
| 75 | (erase-buffer) |
| 76 | (if (w32-system-shell-p (getenv "ESHELL")) |
| 77 | (insert (format "Warning! The ESHELL environment variable uses %s. |
| 78 | You probably want to change it so that it uses cmdproxy.exe instead.\n\n" |
| 79 | (getenv "ESHELL")))) |
| 80 | (if (w32-system-shell-p (getenv "SHELL")) |
| 81 | (insert (format "Warning! The SHELL environment variable uses %s. |
| 82 | You probably want to change it so that it uses cmdproxy.exe instead.\n\n" |
| 83 | (getenv "SHELL")))) |
| 84 | (if (w32-system-shell-p shell-file-name) |
| 85 | (insert (format "Warning! shell-file-name uses %s. |
| 86 | You probably want to change it so that it uses cmdproxy.exe instead.\n\n" |
| 87 | shell-file-name))) |
| 88 | (if (and (boundp 'explicit-shell-file-name) |
| 89 | (w32-system-shell-p explicit-shell-file-name)) |
| 90 | (insert (format "Warning! explicit-shell-file-name uses %s. |
| 91 | You probably want to change it so that it uses cmdproxy.exe instead.\n\n" |
| 92 | explicit-shell-file-name))) |
| 93 | (setq system-shell (> (buffer-size) 0)) |
| 94 | |
| 95 | ;; Allow user to specify that they really do want to use one of the |
| 96 | ;; "system" shells, despite the drawbacks, but still warn if |
| 97 | ;; shell-command-switch doesn't match. |
| 98 | (if w32-allow-system-shell |
| 99 | (erase-buffer)) |
| 100 | |
| 101 | (cond (system-shell |
| 102 | ;; System shells. |
| 103 | (if (string-equal "-c" shell-command-switch) |
| 104 | (insert "Warning! shell-command-switch is \"-c\". |
| 105 | You should set this to \"/c\" when using a system shell.\n\n")) |
| 106 | (if w32-quote-process-args |
| 107 | (insert "Warning! w32-quote-process-args is t. |
| 108 | You should set this to nil when using a system shell.\n\n"))) |
| 109 | ;; Non-system shells. |
| 110 | (t |
| 111 | (if (string-equal "/c" shell-command-switch) |
| 112 | (insert "Warning! shell-command-switch is \"/c\". |
| 113 | You should set this to \"-c\" when using a non-system shell.\n\n")) |
| 114 | (if (not w32-quote-process-args) |
| 115 | (insert "Warning! w32-quote-process-args is nil. |
| 116 | You should set this to t when using a non-system shell.\n\n")))) |
| 117 | (if (> (buffer-size) 0) |
| 118 | (display-buffer buffer) |
| 119 | (kill-buffer buffer)) |
| 120 | (set-buffer prev-buffer))) |
| 121 | |
| 122 | (add-hook 'after-init-hook 'w32-check-shell-configuration) |
| 123 | |
| 124 | ;; Override setting chosen at startup. |
| 125 | (defun set-default-process-coding-system () |
| 126 | ;; Most programs on Windows will accept Unix line endings on input |
| 127 | ;; (and some programs ported from Unix require it) but most will |
| 128 | ;; produce DOS line endings on output. |
| 129 | (setq default-process-coding-system |
| 130 | (if (default-value 'enable-multibyte-characters) |
| 131 | '(undecided-dos . undecided-unix) |
| 132 | '(raw-text-dos . raw-text-unix))) |
| 133 | ;; Make cmdproxy default to using DOS line endings for input, |
| 134 | ;; because some Windows programs (including command.com) require it. |
| 135 | (add-to-list 'process-coding-system-alist |
| 136 | `("[cC][mM][dD][pP][rR][oO][xX][yY]" |
| 137 | . ,(if (default-value 'enable-multibyte-characters) |
| 138 | '(undecided-dos . undecided-dos) |
| 139 | '(raw-text-dos . raw-text-dos)))) |
| 140 | ;; plink needs DOS input when entering the password. |
| 141 | (add-to-list 'process-coding-system-alist |
| 142 | `("[pP][lL][iI][nN][kK]" |
| 143 | . ,(if (default-value 'enable-multibyte-characters) |
| 144 | '(undecided-dos . undecided-dos) |
| 145 | '(raw-text-dos . raw-text-dos))))) |
| 146 | |
| 147 | (add-hook 'before-init-hook 'set-default-process-coding-system) |
| 148 | |
| 149 | |
| 150 | ;;; Basic support functions for managing Emacs's locale setting |
| 151 | |
| 152 | (defvar w32-valid-locales nil |
| 153 | "List of locale ids known to be supported.") |
| 154 | |
| 155 | ;; This is the brute-force version; an efficient version is now |
| 156 | ;; built-in though. |
| 157 | (if (not (fboundp 'w32-get-valid-locale-ids)) |
| 158 | (defun w32-get-valid-locale-ids () |
| 159 | "Return list of all valid Windows locale ids." |
| 160 | (let ((i 65535) |
| 161 | locales) |
| 162 | (while (> i 0) |
| 163 | (if (w32-get-locale-info i) |
| 164 | (setq locales (cons i locales))) |
| 165 | (setq i (1- i))) |
| 166 | locales))) |
| 167 | |
| 168 | (defun w32-list-locales () |
| 169 | "List the name and id of all locales supported by Windows." |
| 170 | (interactive) |
| 171 | (when (null w32-valid-locales) |
| 172 | (setq w32-valid-locales (sort (w32-get-valid-locale-ids) #'<))) |
| 173 | (with-output-to-temp-buffer "*Supported Locales*" |
| 174 | (princ "LCID\tAbbrev\tFull name\n\n") |
| 175 | (dolist (locale w32-valid-locales) |
| 176 | (princ (format "%d\t%s\t%s\n" |
| 177 | locale |
| 178 | (w32-get-locale-info locale) |
| 179 | (w32-get-locale-info locale t)))))) |
| 180 | |
| 181 | ;; The variable source-directory is used to initialize Info-directory-list. |
| 182 | ;; However, the common case is that Emacs is being used from a binary |
| 183 | ;; distribution, and the value of source-directory is meaningless in that |
| 184 | ;; case. Even worse, source-directory can refer to a directory on a drive |
| 185 | ;; on the build machine that happens to be a removable drive on the user's |
| 186 | ;; machine. When this happens, Emacs tries to access the removable drive |
| 187 | ;; and produces the abort/retry/ignore dialog. Since we do not use |
| 188 | ;; source-directory, set it to something that is a reasonable approximation |
| 189 | ;; on the user's machine. |
| 190 | |
| 191 | ;;(add-hook 'before-init-hook |
| 192 | ;; (lambda () |
| 193 | ;; (setq source-directory (file-name-as-directory |
| 194 | ;; (expand-file-name ".." exec-directory))))) |
| 195 | |
| 196 | (defun w32-convert-standard-filename (filename) |
| 197 | "Convert a standard file's name to something suitable for MS-Windows. |
| 198 | This means to guarantee valid names and perhaps to canonicalize |
| 199 | certain patterns. |
| 200 | |
| 201 | This function is called by `convert-standard-filename'. |
| 202 | |
| 203 | Replace invalid characters and turn Cygwin names into native |
| 204 | names, and also turn slashes into backslashes if the shell |
| 205 | requires it (see `w32-shell-dos-semantics')." |
| 206 | (save-match-data |
| 207 | (let ((name |
| 208 | (if (string-match "\\`/cygdrive/\\([a-zA-Z]\\)/" filename) |
| 209 | (replace-match "\\1:/" t nil filename) |
| 210 | (copy-sequence filename))) |
| 211 | (start 0)) |
| 212 | ;; leave ':' if part of drive specifier |
| 213 | (if (and (> (length name) 1) |
| 214 | (eq (aref name 1) ?:)) |
| 215 | (setq start 2)) |
| 216 | ;; destructively replace invalid filename characters with ! |
| 217 | (while (string-match "[?*:<>|\"\000-\037]" name start) |
| 218 | (aset name (match-beginning 0) ?!) |
| 219 | (setq start (match-end 0))) |
| 220 | ;; convert directory separators to Windows format |
| 221 | ;; (but only if the shell in use requires it) |
| 222 | (when (w32-shell-dos-semantics) |
| 223 | (setq start 0) |
| 224 | (while (string-match "/" name start) |
| 225 | (aset name (match-beginning 0) ?\\) |
| 226 | (setq start (match-end 0)))) |
| 227 | name))) |
| 228 | |
| 229 | (defun set-w32-system-coding-system (coding-system) |
| 230 | "Set the coding system used by the Windows system to CODING-SYSTEM. |
| 231 | This is used for things like passing font names with non-ASCII |
| 232 | characters in them to the system. For a list of possible values of |
| 233 | CODING-SYSTEM, use \\[list-coding-systems]. |
| 234 | |
| 235 | This function is provided for backward compatibility, since |
| 236 | `w32-system-coding-system' is now an alias for `locale-coding-system'." |
| 237 | (interactive |
| 238 | (list (let ((default locale-coding-system)) |
| 239 | (read-coding-system |
| 240 | (format "Coding system for system calls (default %s): " |
| 241 | default) |
| 242 | default)))) |
| 243 | (check-coding-system coding-system) |
| 244 | (setq locale-coding-system coding-system)) |
| 245 | |
| 246 | ;; locale-coding-system was introduced to do the same thing as |
| 247 | ;; w32-system-coding-system. Use that instead. |
| 248 | (defvaralias 'w32-system-coding-system 'locale-coding-system) |
| 249 | |
| 250 | ;; Set to a system sound if you want a fancy bell. |
| 251 | (set-message-beep nil) |
| 252 | |
| 253 | (defvar w32-charset-info-alist) ; w32font.c |
| 254 | |
| 255 | (defun w32-add-charset-info (xlfd-charset windows-charset codepage) |
| 256 | "Function to add character sets to display with Windows fonts. |
| 257 | Creates entries in `w32-charset-info-alist'. |
| 258 | XLFD-CHARSET is a string which will appear in the XLFD font name to |
| 259 | identify the character set. WINDOWS-CHARSET is a symbol identifying |
| 260 | the Windows character set this maps to. For the list of possible |
| 261 | values, see the documentation for `w32-charset-info-alist'. CODEPAGE |
| 262 | can be a numeric codepage that Windows uses to display the character |
| 263 | set, t for Unicode output with no codepage translation or nil for 8 |
| 264 | bit output with no translation." |
| 265 | (add-to-list 'w32-charset-info-alist |
| 266 | (cons xlfd-charset (cons windows-charset codepage)))) |
| 267 | |
| 268 | ;; The last charset we add becomes the "preferred" charset for the return |
| 269 | ;; value from w32-select-font etc, so list the most important charsets last. |
| 270 | (w32-add-charset-info "iso8859-14" 'w32-charset-ansi 28604) |
| 271 | (w32-add-charset-info "iso8859-15" 'w32-charset-ansi 28605) |
| 272 | ;; The following two are included for pattern matching. |
| 273 | (w32-add-charset-info "jisx0201" 'w32-charset-shiftjis 932) |
| 274 | (w32-add-charset-info "jisx0208" 'w32-charset-shiftjis 932) |
| 275 | (w32-add-charset-info "jisx0201-latin" 'w32-charset-shiftjis 932) |
| 276 | (w32-add-charset-info "jisx0201-katakana" 'w32-charset-shiftjis 932) |
| 277 | (w32-add-charset-info "ksc5601.1989" 'w32-charset-hangeul 949) |
| 278 | (w32-add-charset-info "big5" 'w32-charset-chinesebig5 950) |
| 279 | (w32-add-charset-info "gb2312.1980" 'w32-charset-gb2312 936) |
| 280 | (w32-add-charset-info "ms-symbol" 'w32-charset-symbol nil) |
| 281 | (w32-add-charset-info "ms-oem" 'w32-charset-oem 437) |
| 282 | (w32-add-charset-info "ms-oemlatin" 'w32-charset-oem 850) |
| 283 | (w32-add-charset-info "iso8859-2" 'w32-charset-easteurope 28592) |
| 284 | (w32-add-charset-info "iso8859-3" 'w32-charset-turkish 28593) |
| 285 | (w32-add-charset-info "iso8859-4" 'w32-charset-baltic 28594) |
| 286 | (w32-add-charset-info "iso8859-6" 'w32-charset-arabic 28596) |
| 287 | (w32-add-charset-info "iso8859-7" 'w32-charset-greek 28597) |
| 288 | (w32-add-charset-info "iso8859-8" 'w32-charset-hebrew 1255) |
| 289 | (w32-add-charset-info "iso8859-9" 'w32-charset-turkish 1254) |
| 290 | (w32-add-charset-info "iso8859-13" 'w32-charset-baltic 1257) |
| 291 | (w32-add-charset-info "koi8-r" 'w32-charset-russian 20866) |
| 292 | (w32-add-charset-info "iso8859-5" 'w32-charset-russian 28595) |
| 293 | (w32-add-charset-info "tis620-2533" 'w32-charset-thai 874) |
| 294 | (w32-add-charset-info "windows-1258" 'w32-charset-vietnamese 1258) |
| 295 | (w32-add-charset-info "ksc5601.1992" 'w32-charset-johab 1361) |
| 296 | (w32-add-charset-info "mac-roman" 'w32-charset-mac 10000) |
| 297 | (w32-add-charset-info "iso10646-1" 'w32-charset-default t) |
| 298 | |
| 299 | ;; ;; If Unicode Windows charset is not defined, use ansi fonts. |
| 300 | ;; (w32-add-charset-info "iso10646-1" 'w32-charset-ansi t)) |
| 301 | |
| 302 | ;; Preferred names |
| 303 | (w32-add-charset-info "big5-0" 'w32-charset-chinesebig5 950) |
| 304 | (w32-add-charset-info "gb2312.1980-0" 'w32-charset-gb2312 936) |
| 305 | (w32-add-charset-info "jisx0208-sjis" 'w32-charset-shiftjis 932) |
| 306 | (w32-add-charset-info "ksc5601.1987-0" 'w32-charset-hangeul 949) |
| 307 | (w32-add-charset-info "tis620-0" 'w32-charset-thai 874) |
| 308 | (w32-add-charset-info "iso8859-1" 'w32-charset-ansi 1252) |
| 309 | |
| 310 | \f |
| 311 | ;;;; Support for build process |
| 312 | |
| 313 | ;; From autoload.el |
| 314 | (defvar autoload-make-program) |
| 315 | (defvar generated-autoload-file) |
| 316 | |
| 317 | (defun w32-batch-update-autoloads () |
| 318 | "Like `batch-update-autoloads', but takes the name of the autoloads file |
| 319 | from the command line. |
| 320 | |
| 321 | This is required because some Windows build environments, such as MSYS, |
| 322 | munge command-line arguments that include file names to a horrible mess |
| 323 | that Emacs is unable to cope with." |
| 324 | (let ((generated-autoload-file |
| 325 | (expand-file-name (pop command-line-args-left))) |
| 326 | ;; I can only assume the same considerations may apply here... |
| 327 | (autoload-make-program (pop command-line-args-left))) |
| 328 | (batch-update-autoloads))) |
| 329 | |
| 330 | (defun w32-append-code-lines (orig extra) |
| 331 | "Append non-empty non-comment lines in the file EXTRA to the file ORIG. |
| 332 | |
| 333 | This function saves all buffers and kills the Emacs session, without asking |
| 334 | for any permissions. |
| 335 | |
| 336 | This is required because the Windows build environment is not required |
| 337 | to include Sed, which is used by leim/Makefile.in to do the job." |
| 338 | (find-file orig) |
| 339 | (goto-char (point-max)) |
| 340 | (insert-file-contents extra) |
| 341 | (delete-matching-lines "^$\\|^;") |
| 342 | (save-buffers-kill-emacs t)) |
| 343 | |
| 344 | ;;; w32-fns.el ends here |