| 1 | ;;; w32-win.el --- parse switches controlling interface with W32 window system |
| 2 | |
| 3 | ;; Copyright (C) 1993-1994, 2001-2012 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Kevin Gallo |
| 6 | ;; Keywords: terminals |
| 7 | |
| 8 | ;; This file is part of GNU Emacs. |
| 9 | |
| 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
| 11 | ;; it under the terms of the GNU General Public License as published by |
| 12 | ;; the Free Software Foundation, either version 3 of the License, or |
| 13 | ;; (at your option) any later version. |
| 14 | |
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 18 | ;; GNU General Public License for more details. |
| 19 | |
| 20 | ;; You should have received a copy of the GNU General Public License |
| 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 22 | |
| 23 | ;;; Commentary: |
| 24 | |
| 25 | ;; w32-win.el: this file is loaded from ../lisp/startup.el when it recognizes |
| 26 | ;; that W32 windows are to be used. Command line switches are parsed and those |
| 27 | ;; pertaining to W32 are processed and removed from the command line. The |
| 28 | ;; W32 display is opened and hooks are set for popping up the initial window. |
| 29 | |
| 30 | ;; startup.el will then examine startup files, and eventually call the hooks |
| 31 | ;; which create the first window (s). |
| 32 | |
| 33 | ;;; Code: |
| 34 | \f |
| 35 | |
| 36 | ;; These are the standard X switches from the Xt Initialize.c file of |
| 37 | ;; Release 4. |
| 38 | |
| 39 | ;; Command line Resource Manager string |
| 40 | |
| 41 | ;; +rv *reverseVideo |
| 42 | ;; +synchronous *synchronous |
| 43 | ;; -background *background |
| 44 | ;; -bd *borderColor |
| 45 | ;; -bg *background |
| 46 | ;; -bordercolor *borderColor |
| 47 | ;; -borderwidth .borderWidth |
| 48 | ;; -bw .borderWidth |
| 49 | ;; -display .display |
| 50 | ;; -fg *foreground |
| 51 | ;; -fn *font |
| 52 | ;; -font *font |
| 53 | ;; -foreground *foreground |
| 54 | ;; -geometry .geometry |
| 55 | ;; -i .iconType |
| 56 | ;; -itype .iconType |
| 57 | ;; -iconic .iconic |
| 58 | ;; -name .name |
| 59 | ;; -reverse *reverseVideo |
| 60 | ;; -rv *reverseVideo |
| 61 | ;; -selectionTimeout .selectionTimeout |
| 62 | ;; -synchronous *synchronous |
| 63 | ;; -xrm |
| 64 | |
| 65 | ;; An alist of X options and the function which handles them. See |
| 66 | ;; ../startup.el. |
| 67 | |
| 68 | ;; (if (not (eq window-system 'w32)) |
| 69 | ;; (error "%s: Loading w32-win.el but not compiled for w32" (invocation-name))) |
| 70 | |
| 71 | (require 'frame) |
| 72 | (require 'mouse) |
| 73 | (require 'scroll-bar) |
| 74 | (require 'faces) |
| 75 | (require 'select) |
| 76 | (require 'menu-bar) |
| 77 | (require 'dnd) |
| 78 | (require 'w32-vars) |
| 79 | |
| 80 | ;; Keep an obsolete alias for w32-focus-frame and w32-select-font in case |
| 81 | ;; they are used by code outside Emacs. |
| 82 | (define-obsolete-function-alias 'w32-focus-frame 'x-focus-frame "23.1") |
| 83 | (declare-function x-select-font "w32font.c" |
| 84 | (&optional frame exclude-proportional)) |
| 85 | (define-obsolete-function-alias 'w32-select-font 'x-select-font "23.1") |
| 86 | |
| 87 | (defvar w32-color-map) ;; defined in w32fns.c |
| 88 | (make-obsolete 'w32-default-color-map nil "24.1") |
| 89 | |
| 90 | (declare-function w32-send-sys-command "w32fns.c") |
| 91 | (declare-function set-message-beep "w32console.c") |
| 92 | |
| 93 | ;; Conditional on new-fontset so bootstrapping works on non-GUI compiles |
| 94 | (if (fboundp 'new-fontset) |
| 95 | (require 'fontset)) |
| 96 | |
| 97 | ;; The following definition is used for debugging scroll bar events. |
| 98 | ;(defun w32-handle-scroll-bar-event (event) (interactive "e") (princ event)) |
| 99 | |
| 100 | ;; (defun w32-drag-n-drop-debug (event) |
| 101 | ;; "Print the drag-n-drop EVENT in a readable form." |
| 102 | ;; (interactive "e") |
| 103 | ;; (princ event)) |
| 104 | |
| 105 | (defun w32-drag-n-drop (event) |
| 106 | "Edit the files listed in the drag-n-drop EVENT. |
| 107 | Switch to a buffer editing the last file dropped." |
| 108 | (interactive "e") |
| 109 | (save-excursion |
| 110 | ;; Make sure the drop target has positive co-ords |
| 111 | ;; before setting the selected frame - otherwise it |
| 112 | ;; won't work. <skx@tardis.ed.ac.uk> |
| 113 | (let* ((window (posn-window (event-start event))) |
| 114 | (coords (posn-x-y (event-start event))) |
| 115 | (x (car coords)) |
| 116 | (y (cdr coords))) |
| 117 | (if (and (> x 0) (> y 0)) |
| 118 | (set-frame-selected-window nil window)) |
| 119 | (mapc (lambda (file-name) |
| 120 | (let ((f (subst-char-in-string ?\\ ?/ file-name)) |
| 121 | (coding (or file-name-coding-system |
| 122 | default-file-name-coding-system))) |
| 123 | (setq file-name |
| 124 | (mapconcat 'url-hexify-string |
| 125 | (split-string (encode-coding-string f coding) |
| 126 | "/") |
| 127 | "/"))) |
| 128 | (dnd-handle-one-url window 'private |
| 129 | (concat "file:" file-name))) |
| 130 | (car (cdr (cdr event))))) |
| 131 | (raise-frame))) |
| 132 | |
| 133 | (defun w32-drag-n-drop-other-frame (event) |
| 134 | "Edit the files listed in the drag-n-drop EVENT, in other frames. |
| 135 | May create new frames, or reuse existing ones. The frame editing |
| 136 | the last file dropped is selected." |
| 137 | (interactive "e") |
| 138 | (mapcar 'find-file-other-frame (car (cdr (cdr event))))) |
| 139 | |
| 140 | ;; Bind the drag-n-drop event. |
| 141 | (global-set-key [drag-n-drop] 'w32-drag-n-drop) |
| 142 | (global-set-key [C-drag-n-drop] 'w32-drag-n-drop-other-frame) |
| 143 | |
| 144 | ;; Keyboard layout/language change events |
| 145 | ;; For now ignore language-change events; in the future |
| 146 | ;; we should switch the Emacs Input Method to match the |
| 147 | ;; new layout/language selected by the user. |
| 148 | (global-set-key [language-change] 'ignore) |
| 149 | |
| 150 | (defvar x-resource-name) |
| 151 | |
| 152 | \f |
| 153 | ;;;; Function keys |
| 154 | |
| 155 | ;;; make f10 activate the real menubar rather than the mini-buffer menu |
| 156 | ;;; navigation feature. |
| 157 | (defun w32-menu-bar-open (&optional frame) |
| 158 | "Start key navigation of the menu bar in FRAME. |
| 159 | |
| 160 | This initially activates the first menu-bar item, and you can then navigate |
| 161 | with the arrow keys, select a menu entry with the Return key or cancel with |
| 162 | the Escape key. If FRAME has no menu bar, this function does nothing. |
| 163 | |
| 164 | If FRAME is nil or not given, use the selected frame. |
| 165 | If FRAME does not have the menu bar enabled, display a text menu using |
| 166 | `tmm-menubar'." |
| 167 | (interactive "i") |
| 168 | (if menu-bar-mode |
| 169 | (w32-send-sys-command ?\xf100 frame) |
| 170 | (with-selected-frame (or frame (selected-frame)) |
| 171 | (tmm-menubar)))) |
| 172 | \f |
| 173 | |
| 174 | ;; W32 systems have different fonts than commonly found on X, so |
| 175 | ;; we define our own standard fontset here. |
| 176 | (defvar w32-standard-fontset-spec |
| 177 | "-*-Courier New-normal-r-*-*-13-*-*-*-c-*-fontset-standard" |
| 178 | "String of fontset spec of the standard fontset. |
| 179 | This defines a fontset consisting of the Courier New variations for |
| 180 | European languages which are distributed with Windows as |
| 181 | \"Multilanguage Support\". |
| 182 | |
| 183 | See the documentation of `create-fontset-from-fontset-spec' for the format.") |
| 184 | |
| 185 | (defun x-win-suspend-error () |
| 186 | "Report an error when a suspend is attempted." |
| 187 | (error "Suspending an Emacs running under W32 makes no sense")) |
| 188 | |
| 189 | (defvar dynamic-library-alist) |
| 190 | (defvar libpng-version) ; image.c #ifdef HAVE_NTGUI |
| 191 | |
| 192 | ;;; Set default known names for external libraries |
| 193 | (setq dynamic-library-alist |
| 194 | (list |
| 195 | '(xpm "libxpm.dll" "xpm4.dll" "libXpm-nox4.dll") |
| 196 | ;; Versions of libpng 1.4.x and later are incompatible with |
| 197 | ;; earlier versions. Set up the list of libraries according to |
| 198 | ;; the version we were compiled against. (If we were compiled |
| 199 | ;; without PNG support, libpng-version's value is -1.) |
| 200 | (if (>= libpng-version 10400) |
| 201 | ;; libpng14-14.dll is libpng 1.4.3 from GTK+ |
| 202 | '(png "libpng14-14.dll" "libpng14.dll") |
| 203 | '(png "libpng12d.dll" "libpng12.dll" "libpng3.dll" "libpng.dll" |
| 204 | ;; these are libpng 1.2.8 from GTK+ |
| 205 | "libpng13d.dll" "libpng13.dll")) |
| 206 | '(jpeg "jpeg62.dll" "libjpeg.dll" "jpeg-62.dll" "jpeg.dll") |
| 207 | '(tiff "libtiff3.dll" "libtiff.dll") |
| 208 | '(gif "giflib4.dll" "libungif4.dll" "libungif.dll") |
| 209 | '(svg "librsvg-2-2.dll") |
| 210 | '(gdk-pixbuf "libgdk_pixbuf-2.0-0.dll") |
| 211 | '(glib "libglib-2.0-0.dll") |
| 212 | '(gobject "libgobject-2.0-0.dll") |
| 213 | '(gnutls "libgnutls-28.dll" "libgnutls-26.dll") |
| 214 | '(libxml2 "libxml2-2.dll" "libxml2.dll"))) |
| 215 | |
| 216 | ;;; multi-tty support |
| 217 | (defvar w32-initialized nil |
| 218 | "Non-nil if the w32 window system has been initialized.") |
| 219 | |
| 220 | (declare-function x-open-connection "w32fns.c" |
| 221 | (display &optional xrm-string must-succeed)) |
| 222 | (declare-function create-fontset-from-fontset-spec "fontset" |
| 223 | (fontset-spec &optional style-variant noerror)) |
| 224 | (declare-function create-fontset-from-x-resource "fontset" ()) |
| 225 | (declare-function x-get-resource "frame.c" |
| 226 | (attribute class &optional component subclass)) |
| 227 | (declare-function x-handle-args "common-win" (args)) |
| 228 | (declare-function x-parse-geometry "frame.c" (string)) |
| 229 | (defvar x-command-line-resources) |
| 230 | |
| 231 | (defun w32-initialize-window-system () |
| 232 | "Initialize Emacs for W32 GUI frames." |
| 233 | |
| 234 | ;; Do the actual Windows setup here; the above code just defines |
| 235 | ;; functions and variables that we use now. |
| 236 | |
| 237 | (setq command-line-args (x-handle-args command-line-args)) |
| 238 | |
| 239 | ;; Make sure we have a valid resource name. |
| 240 | (or (stringp x-resource-name) |
| 241 | (setq x-resource-name |
| 242 | ;; Change any . or * characters in x-resource-name to hyphens, |
| 243 | ;; so as not to choke when we use it in X resource queries. |
| 244 | (replace-regexp-in-string "[.*]" "-" (invocation-name)))) |
| 245 | |
| 246 | (x-open-connection "" x-command-line-resources |
| 247 | ;; Exit with a fatal error if this fails and we |
| 248 | ;; are the initial display |
| 249 | (eq initial-window-system 'w32)) |
| 250 | |
| 251 | ;; Create the default fontset. |
| 252 | (create-default-fontset) |
| 253 | ;; Create the standard fontset. |
| 254 | (condition-case err |
| 255 | (create-fontset-from-fontset-spec w32-standard-fontset-spec t) |
| 256 | (error (display-warning |
| 257 | 'initialization |
| 258 | (format "Creation of the standard fontset failed: %s" err) |
| 259 | :error))) |
| 260 | ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1,...). |
| 261 | (create-fontset-from-x-resource) |
| 262 | |
| 263 | ;; Apply a geometry resource to the initial frame. Put it at the end |
| 264 | ;; of the alist, so that anything specified on the command line takes |
| 265 | ;; precedence. |
| 266 | (let* ((res-geometry (x-get-resource "geometry" "Geometry")) |
| 267 | parsed) |
| 268 | (if res-geometry |
| 269 | (progn |
| 270 | (setq parsed (x-parse-geometry res-geometry)) |
| 271 | ;; If the resource specifies a position, |
| 272 | ;; call the position and size "user-specified". |
| 273 | (if (or (assq 'top parsed) (assq 'left parsed)) |
| 274 | (setq parsed (cons '(user-position . t) |
| 275 | (cons '(user-size . t) parsed)))) |
| 276 | ;; All geometry parms apply to the initial frame. |
| 277 | (setq initial-frame-alist (append initial-frame-alist parsed)) |
| 278 | ;; The size parms apply to all frames. |
| 279 | (if (and (assq 'height parsed) |
| 280 | (not (assq 'height default-frame-alist))) |
| 281 | (setq default-frame-alist |
| 282 | (cons (cons 'height (cdr (assq 'height parsed))) |
| 283 | default-frame-alist)) |
| 284 | (if (and (assq 'width parsed) |
| 285 | (not (assq 'width default-frame-alist))) |
| 286 | (setq default-frame-alist |
| 287 | (cons (cons 'width (cdr (assq 'width parsed))) |
| 288 | default-frame-alist))))))) |
| 289 | |
| 290 | ;; Check the reverseVideo resource. |
| 291 | (let ((case-fold-search t)) |
| 292 | (let ((rv (x-get-resource "reverseVideo" "ReverseVideo"))) |
| 293 | (if (and rv (string-match "^\\(true\\|yes\\|on\\)$" rv)) |
| 294 | (setq default-frame-alist |
| 295 | (cons '(reverse . t) default-frame-alist))))) |
| 296 | |
| 297 | ;; Don't let Emacs suspend under w32 gui |
| 298 | (add-hook 'suspend-hook 'x-win-suspend-error) |
| 299 | |
| 300 | ;; Turn off window-splitting optimization; w32 is usually fast enough |
| 301 | ;; that this is only annoying. |
| 302 | (setq split-window-keep-point t) |
| 303 | |
| 304 | ;; W32 expects the menu bar cut and paste commands to use the clipboard. |
| 305 | (menu-bar-enable-clipboard) |
| 306 | |
| 307 | ;; Don't show the frame name; that's redundant. |
| 308 | (setq-default mode-line-frame-identification " ") |
| 309 | |
| 310 | ;; Set to a system sound if you want a fancy bell. |
| 311 | (set-message-beep 'ok) |
| 312 | (x-apply-session-resources) |
| 313 | (setq w32-initialized t)) |
| 314 | |
| 315 | (add-to-list 'handle-args-function-alist '(w32 . x-handle-args)) |
| 316 | (add-to-list 'frame-creation-function-alist '(w32 . x-create-frame-with-faces)) |
| 317 | (add-to-list 'window-system-initialization-alist '(w32 . w32-initialize-window-system)) |
| 318 | |
| 319 | (provide 'w32-win) |
| 320 | |
| 321 | ;;; w32-win.el ends here |