X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/3077d1f623039874558f0da4c8850990484504fb..a3dae87a1b5405d2bffde7c2d829a5dbfc7ff274:/lisp/w32-fns.el diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index 033333918f..cb21d4b08c 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -1,10 +1,10 @@ -;;; w32-fns.el --- Lisp routines for Windows NT +;;; w32-fns.el --- Lisp routines for 32-bit Windows -;; Copyright (C) 1994, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1994, 2001-2011 Free Software Foundation, Inc. ;; Author: Geoff Voelker ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. @@ -31,41 +31,6 @@ ;;;; Function keys -(defvar x-alternatives-map - (let ((map (make-sparse-keymap))) - ;; Map certain keypad keys into ASCII characters that people usually expect. - (define-key map [backspace] [127]) - (define-key map [delete] [127]) - (define-key map [tab] [?\t]) - (define-key map [linefeed] [?\n]) - (define-key map [clear] [?\C-l]) - (define-key map [return] [?\C-m]) - (define-key map [escape] [?\e]) - (define-key map [M-backspace] [?\M-\d]) - (define-key map [M-delete] [?\M-\d]) - (define-key map [M-tab] [?\M-\t]) - (define-key map [M-linefeed] [?\M-\n]) - (define-key map [M-clear] [?\M-\C-l]) - (define-key map [M-return] [?\M-\C-m]) - (define-key map [M-escape] [?\M-\e]) - (define-key map [iso-lefttab] [backtab]) - (define-key map [S-iso-lefttab] [backtab]) - (define-key map [S-tab] [backtab]) - map) - "Keymap of possible alternative meanings for some keys.") - -(defun x-setup-function-keys (frame) - "Set up `function-key-map' on the graphical frame FRAME." - ;; Don't do this twice on the same display, or it would break - ;; normal-erase-is-backspace-mode. - (unless (terminal-parameter frame 'x-setup-function-keys) - ;; Map certain keypad keys into ASCII characters that people usually expect. - (with-selected-frame frame - (let ((map (copy-keymap x-alternatives-map))) - (set-keymap-parent map (keymap-parent local-function-key-map)) - (set-keymap-parent local-function-key-map map))) - (set-terminal-parameter frame 'x-setup-function-keys t))) - (declare-function set-message-beep "w32console.c") (declare-function w32-get-clipboard-data "w32select.c") (declare-function w32-get-locale-info "w32proc.c") @@ -91,7 +56,7 @@ That includes all Windows systems except for 9X/Me." (defun w32-shell-name () "Return the name of the shell being used." - (or (bound-and-true-p explicit-shell-file-name) + (or (bound-and-true-p shell-file-name) (getenv "ESHELL") (getenv "SHELL") (and (w32-using-nt) "cmd.exe") @@ -170,26 +135,26 @@ You should set this to t when using a non-system shell.\n\n")))) (add-hook 'after-init-hook 'w32-check-shell-configuration) -;;; Override setting chosen at startup. +;; Override setting chosen at startup. (defun set-default-process-coding-system () ;; Most programs on Windows will accept Unix line endings on input ;; (and some programs ported from Unix require it) but most will ;; produce DOS line endings on output. (setq default-process-coding-system - (if default-enable-multibyte-characters + (if (default-value 'enable-multibyte-characters) '(undecided-dos . undecided-unix) '(raw-text-dos . raw-text-unix))) ;; Make cmdproxy default to using DOS line endings for input, ;; because some Windows programs (including command.com) require it. (add-to-list 'process-coding-system-alist `("[cC][mM][dD][pP][rR][oO][xX][yY]" - . ,(if default-enable-multibyte-characters + . ,(if (default-value 'enable-multibyte-characters) '(undecided-dos . undecided-dos) '(raw-text-dos . raw-text-dos)))) ;; plink needs DOS input when entering the password. (add-to-list 'process-coding-system-alist `("[pP][lL][iI][nN][kK]" - . ,(if default-enable-multibyte-characters + . ,(if (default-value 'enable-multibyte-characters) '(undecided-dos . undecided-dos) '(raw-text-dos . raw-text-dos))))) @@ -201,8 +166,8 @@ You should set this to t when using a non-system shell.\n\n")))) (defvar w32-valid-locales nil "List of locale ids known to be supported.") -;;; This is the brute-force version; an efficient version is now -;;; built-in though. +;; This is the brute-force version; an efficient version is now +;; built-in though. (if (not (fboundp 'w32-get-valid-locale-ids)) (defun w32-get-valid-locale-ids () "Return list of all valid Windows locale ids." @@ -227,11 +192,11 @@ You should set this to t when using a non-system shell.\n\n")))) (w32-get-locale-info locale) (w32-get-locale-info locale t)))))) -;;; Setup Info-default-directory-list to include the info directory -;;; near where Emacs executable was installed. We used to set INFOPATH, -;;; but when this is set Info-default-directory-list is ignored. We -;;; also cannot rely upon what is set in paths.el because they assume -;;; that configuration during build time is correct for runtime. +;; Setup Info-default-directory-list to include the info directory +;; near where Emacs executable was installed. We used to set INFOPATH, +;; but when this is set Info-default-directory-list is ignored. We +;; also cannot rely upon what is set in paths.el because they assume +;; that configuration during build time is correct for runtime. (defun w32-init-info () (let* ((instdir (file-name-directory invocation-directory)) (dir1 (expand-file-name "../info/" instdir)) @@ -245,30 +210,31 @@ You should set this to t when using a non-system shell.\n\n")))) (add-hook 'before-init-hook 'w32-init-info) -;;; The variable source-directory is used to initialize Info-directory-list. -;;; However, the common case is that Emacs is being used from a binary -;;; distribution, and the value of source-directory is meaningless in that -;;; case. Even worse, source-directory can refer to a directory on a drive -;;; on the build machine that happens to be a removable drive on the user's -;;; machine. When this happens, Emacs tries to access the removable drive -;;; and produces the abort/retry/ignore dialog. Since we do not use -;;; source-directory, set it to something that is a reasonable approximation -;;; on the user's machine. - -;(add-hook 'before-init-hook -; '(lambda () -; (setq source-directory (file-name-as-directory -; (expand-file-name ".." exec-directory))))) - -(defun convert-standard-filename (filename) - "Convert a standard file's name to something suitable for the current OS. +;; The variable source-directory is used to initialize Info-directory-list. +;; However, the common case is that Emacs is being used from a binary +;; distribution, and the value of source-directory is meaningless in that +;; case. Even worse, source-directory can refer to a directory on a drive +;; on the build machine that happens to be a removable drive on the user's +;; machine. When this happens, Emacs tries to access the removable drive +;; and produces the abort/retry/ignore dialog. Since we do not use +;; source-directory, set it to something that is a reasonable approximation +;; on the user's machine. + +;;(add-hook 'before-init-hook +;; (lambda () +;; (setq source-directory (file-name-as-directory +;; (expand-file-name ".." exec-directory))))) + +(defun w32-convert-standard-filename (filename) + "Convert a standard file's name to something suitable for MS-Windows. This means to guarantee valid names and perhaps to canonicalize certain patterns. -On Windows and DOS, replace invalid characters. On DOS, make -sure to obey the 8.3 limitations. On Windows, turn Cygwin names -into native names, and also turn slashes into backslashes if the -shell requires it (see `w32-shell-dos-semantics')." +This function is called by `convert-standard-filename'. + +Replace invalid characters and turn Cygwin names into native +names, and also turn slashes into backslashes if the shell +requires it (see `w32-shell-dos-semantics')." (save-match-data (let ((name (if (string-match "\\`/cygdrive/\\([a-zA-Z]\\)/" filename) @@ -294,7 +260,7 @@ shell requires it (see `w32-shell-dos-semantics')." ;;; Fix interface to (X-specific) mouse.el (defun x-set-selection (type data) - "Make an X Windows selection of type TYPE and value DATA. + "Make an X selection of type TYPE and value DATA. The argument TYPE (nil means `PRIMARY') says which selection, and DATA specifies the contents. TYPE must be a symbol. \(It can also be a string, which stands for the symbol with that name, but this @@ -319,7 +285,7 @@ Note that on MS-Windows, primary and secondary selections set by Emacs are not available to other programs." (put 'x-selections (or type 'PRIMARY) data)) -(defun x-get-selection (&optional type data-type) +(defun x-get-selection (&optional type _data-type) "Return the value of an X Windows selection. The argument TYPE (default `PRIMARY') says which selection, and the argument DATA-TYPE (default `STRING') says @@ -360,24 +326,16 @@ This function is provided for backward compatibility, since ;; w32-system-coding-system. Use that instead. (defvaralias 'w32-system-coding-system 'locale-coding-system) -;;; Set to a system sound if you want a fancy bell. +;; Set to a system sound if you want a fancy bell. (set-message-beep nil) -;;; The "Windows" keys on newer keyboards bring up the Start menu -;;; whether you want it or not - make Emacs ignore these keystrokes -;;; rather than beep. +;; The "Windows" keys on newer keyboards bring up the Start menu +;; whether you want it or not - make Emacs ignore these keystrokes +;; rather than beep. (global-set-key [lwindow] 'ignore) (global-set-key [rwindow] 'ignore) -;; These tell read-char how to convert -;; these special chars to ASCII. -(put 'tab 'ascii-character ?\t) -(put 'linefeed 'ascii-character ?\n) -(put 'clear 'ascii-character 12) -(put 'return 'ascii-character 13) -(put 'escape 'ascii-character ?\e) -(put 'backspace 'ascii-character 127) -(put 'delete 'ascii-character 127) +(defvar w32-charset-info-alist) ; w32font.c (defun w32-add-charset-info (xlfd-charset windows-charset codepage) "Function to add character sets to display with Windows fonts. @@ -440,40 +398,16 @@ bit output with no translation." 'w32-charset-info-alist "21.1") -;;;; Selections and cut buffers +;;;; Selections -;;; We keep track of the last text selected here, so we can check the -;;; current selection against it, and avoid passing back our own text -;;; from x-cut-buffer-or-selection-value. +;; We keep track of the last text selected here, so we can check the +;; current selection against it, and avoid passing back our own text +;; from x-selection-value. (defvar x-last-selected-text nil) -;;; It is said that overlarge strings are slow to put into the cut buffer. -;;; Note this value is overridden below. -(defvar x-cut-buffer-max 20000 - "Max number of characters to put in the cut buffer.") - -(defun x-select-text (text &optional push) - "Select TEXT, a string, according to the window system. - -On X, put TEXT in the primary X selection. For backward -compatibility with older X applications, set the value of X cut -buffer 0 as well, and if the optional argument PUSH is non-nil, -rotate the cut buffers. If `x-select-enable-clipboard' is -non-nil, copy the text to the X clipboard as well. - -On Windows, make TEXT the current selection. If -`x-select-enable-clipboard' is non-nil, copy the text to the -clipboard as well. The argument PUSH is ignored. - -On Nextstep, put TEXT in the pasteboard; PUSH is ignored." - (if x-select-enable-clipboard - (w32-set-clipboard-data text)) - (setq x-last-selected-text text)) - (defun x-get-selection-value () "Return the value of the current selection. -Consult the selection, then the cut buffer. Treat empty strings as if -they were unset." +Consult the selection. Treat empty strings as if they were unset." (if x-select-enable-clipboard (let (text) ;; Don't die if x-get-selection signals an error. @@ -491,14 +425,19 @@ they were unset." (t (setq x-last-selected-text text)))))) -(defalias 'x-cut-buffer-or-selection-value 'x-get-selection-value) +(defalias 'x-selection-value 'x-get-selection-value) -;;; Arrange for the kill and yank functions to set and check the clipboard. +;; Arrange for the kill and yank functions to set and check the clipboard. (setq interprogram-cut-function 'x-select-text) (setq interprogram-paste-function 'x-get-selection-value) ;;;; Support for build process + +;; From autoload.el +(defvar autoload-make-program) +(defvar generated-autoload-file) + (defun w32-batch-update-autoloads () "Like `batch-update-autoloads', but takes the name of the autoloads file from the command line. @@ -507,7 +446,9 @@ This is required because some Windows build environments, such as MSYS, munge command-line arguments that include file names to a horrible mess that Emacs is unable to cope with." (let ((generated-autoload-file - (expand-file-name (pop command-line-args-left)))) + (expand-file-name (pop command-line-args-left))) + ;; I can only assume the same considerations may apply here... + (autoload-make-program (pop command-line-args-left))) (batch-update-autoloads))) (defun w32-append-code-lines (orig extra) @@ -524,5 +465,4 @@ to include Sed, which is used by leim/Makefile.in to do the job." (delete-matching-lines "^$\\|^;") (save-buffers-kill-emacs t)) -;; arch-tag: c49b48cc-0f4f-454f-a274-c2dc34815e14 ;;; w32-fns.el ends here