| 1 | ;;; w32-win.el --- parse switches controlling interface with W32 window system -*- lexical-binding: t -*- |
| 2 | |
| 3 | ;; Copyright (C) 1993-1994, 2001-2014 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 | (eval-when-compile (require 'cl-lib)) |
| 72 | (require 'frame) |
| 73 | (require 'mouse) |
| 74 | (require 'scroll-bar) |
| 75 | (require 'faces) |
| 76 | (require 'select) |
| 77 | (require 'menu-bar) |
| 78 | (require 'dnd) |
| 79 | (require 'w32-vars) |
| 80 | |
| 81 | ;; Keep an obsolete alias for w32-focus-frame and w32-select-font in case |
| 82 | ;; they are used by code outside Emacs. |
| 83 | (define-obsolete-function-alias 'w32-focus-frame 'x-focus-frame "23.1") |
| 84 | (declare-function x-select-font "w32font.c" |
| 85 | (&optional frame exclude-proportional)) |
| 86 | (define-obsolete-function-alias 'w32-select-font 'x-select-font "23.1") |
| 87 | |
| 88 | (defvar w32-color-map) ;; defined in w32fns.c |
| 89 | (make-obsolete 'w32-default-color-map nil "24.1") |
| 90 | |
| 91 | (declare-function w32-send-sys-command "w32fns.c") |
| 92 | (declare-function set-message-beep "w32fns.c") |
| 93 | |
| 94 | (declare-function cygwin-convert-file-name-from-windows "cygw32.c" |
| 95 | (path &optional absolute_p)) |
| 96 | |
| 97 | ;; Conditional on new-fontset so bootstrapping works on non-GUI compiles |
| 98 | (if (fboundp 'new-fontset) |
| 99 | (require 'fontset)) |
| 100 | |
| 101 | ;; The following definition is used for debugging scroll bar events. |
| 102 | ;(defun w32-handle-scroll-bar-event (event) (interactive "e") (princ event)) |
| 103 | |
| 104 | ;; (defun w32-drag-n-drop-debug (event) |
| 105 | ;; "Print the drag-n-drop EVENT in a readable form." |
| 106 | ;; (interactive "e") |
| 107 | ;; (princ event)) |
| 108 | |
| 109 | (defun w32-handle-dropped-file (window file-name) |
| 110 | (let ((f (if (eq system-type 'cygwin) |
| 111 | (cygwin-convert-file-name-from-windows file-name t) |
| 112 | (subst-char-in-string ?\\ ?/ file-name))) |
| 113 | (coding (if (eq system-type 'windows-nt) |
| 114 | ;; Native w32 build pretends that its file names |
| 115 | ;; are encoded in UTF-8, and converts to the |
| 116 | ;; appropriate encoding internally. |
| 117 | 'utf-8 |
| 118 | (or file-name-coding-system |
| 119 | default-file-name-coding-system)))) |
| 120 | |
| 121 | (setq file-name |
| 122 | (mapconcat 'url-hexify-string |
| 123 | (split-string (encode-coding-string f coding) |
| 124 | "/") |
| 125 | "/"))) |
| 126 | (dnd-handle-one-url window 'private |
| 127 | (concat |
| 128 | (if (eq system-type 'cygwin) |
| 129 | "file://" |
| 130 | "file:") |
| 131 | file-name))) |
| 132 | |
| 133 | (defun w32-drag-n-drop (event &optional new-frame) |
| 134 | "Edit the files listed in the drag-n-drop EVENT. |
| 135 | Switch to a buffer editing the last file dropped." |
| 136 | (interactive "e") |
| 137 | (save-excursion |
| 138 | ;; Make sure the drop target has positive co-ords |
| 139 | ;; before setting the selected frame - otherwise it |
| 140 | ;; won't work. <skx@tardis.ed.ac.uk> |
| 141 | (let* ((window (posn-window (event-start event))) |
| 142 | (coords (posn-x-y (event-start event))) |
| 143 | (x (car coords)) |
| 144 | (y (cdr coords))) |
| 145 | (if (and (> x 0) (> y 0)) |
| 146 | (set-frame-selected-window nil window)) |
| 147 | |
| 148 | (when new-frame |
| 149 | (select-frame (make-frame))) |
| 150 | (raise-frame) |
| 151 | (setq window (selected-window)) |
| 152 | |
| 153 | (mapc (apply-partially #'w32-handle-dropped-file window) |
| 154 | (car (cdr (cdr event))))))) |
| 155 | |
| 156 | (defun w32-drag-n-drop-other-frame (event) |
| 157 | "Edit the files listed in the drag-n-drop EVENT, in other frames. |
| 158 | May create new frames, or reuse existing ones. The frame editing |
| 159 | the last file dropped is selected." |
| 160 | (interactive "e") |
| 161 | (w32-drag-n-drop event t)) |
| 162 | |
| 163 | ;; Bind the drag-n-drop event. |
| 164 | (global-set-key [drag-n-drop] 'w32-drag-n-drop) |
| 165 | (global-set-key [C-drag-n-drop] 'w32-drag-n-drop-other-frame) |
| 166 | |
| 167 | ;; Keyboard layout/language change events |
| 168 | ;; For now ignore language-change events; in the future |
| 169 | ;; we should switch the Emacs Input Method to match the |
| 170 | ;; new layout/language selected by the user. |
| 171 | (global-set-key [language-change] 'ignore) |
| 172 | |
| 173 | (defvar x-resource-name) |
| 174 | |
| 175 | \f |
| 176 | ;;;; Function keys |
| 177 | |
| 178 | ;;; make f10 activate the real menubar rather than the mini-buffer menu |
| 179 | ;;; navigation feature. |
| 180 | (defun w32-menu-bar-open (&optional frame) |
| 181 | "Start key navigation of the menu bar in FRAME. |
| 182 | |
| 183 | This initially activates the first menu-bar item, and you can then navigate |
| 184 | with the arrow keys, select a menu entry with the Return key or cancel with |
| 185 | the Escape key. If FRAME has no menu bar, this function does nothing. |
| 186 | |
| 187 | If FRAME is nil or not given, use the selected frame. |
| 188 | If FRAME does not have the menu bar enabled, display a text menu using |
| 189 | `tmm-menubar'." |
| 190 | (interactive "i") |
| 191 | (if menu-bar-mode |
| 192 | (w32-send-sys-command ?\xf100 frame) |
| 193 | (with-selected-frame (or frame (selected-frame)) |
| 194 | (tmm-menubar)))) |
| 195 | \f |
| 196 | |
| 197 | ;; W32 systems have different fonts than commonly found on X, so |
| 198 | ;; we define our own standard fontset here. |
| 199 | (defvar w32-standard-fontset-spec |
| 200 | "-*-Courier New-normal-r-*-*-13-*-*-*-c-*-fontset-standard" |
| 201 | "String of fontset spec of the standard fontset. |
| 202 | This defines a fontset consisting of the Courier New variations for |
| 203 | European languages which are distributed with Windows as |
| 204 | \"Multilanguage Support\". |
| 205 | |
| 206 | See the documentation of `create-fontset-from-fontset-spec' for the format.") |
| 207 | |
| 208 | (defun x-win-suspend-error () |
| 209 | "Report an error when a suspend is attempted." |
| 210 | (error "Suspending an Emacs running under W32 makes no sense")) |
| 211 | |
| 212 | (defvar dynamic-library-alist) |
| 213 | (defvar libpng-version) ; image.c #ifdef HAVE_NTGUI |
| 214 | |
| 215 | ;;; Set default known names for external libraries |
| 216 | (setq dynamic-library-alist |
| 217 | (list |
| 218 | '(xpm "libxpm.dll" "xpm4.dll" "libXpm-nox4.dll") |
| 219 | ;; Versions of libpng 1.4.x and later are incompatible with |
| 220 | ;; earlier versions. Set up the list of libraries according to |
| 221 | ;; the version we were compiled against. (If we were compiled |
| 222 | ;; without PNG support, libpng-version's value is -1.) |
| 223 | (if (>= libpng-version 10400) |
| 224 | (let ((major (/ libpng-version 10000)) |
| 225 | (minor (mod (/ libpng-version 100) 10))) |
| 226 | (list 'png |
| 227 | ;; libpngXY.dll is the default name when building |
| 228 | ;; with CMake or from a lpngXYY tarball on w32, |
| 229 | ;; libpngXY-XY.dll is the DLL name when building |
| 230 | ;; with libtool / autotools |
| 231 | (format "libpng%d%d.dll" major minor) |
| 232 | (format "libpng%d%d-%d%d.dll" major minor major minor))) |
| 233 | '(png "libpng12d.dll" "libpng12.dll" "libpng3.dll" "libpng.dll" |
| 234 | ;; these are libpng 1.2.8 from GTK+ |
| 235 | "libpng13d.dll" "libpng13.dll")) |
| 236 | '(tiff "libtiff-5.dll" "libtiff3.dll" "libtiff.dll") |
| 237 | (if (> libjpeg-version 62) |
| 238 | ;; Versions of libjpeg after 6b are incompatible with |
| 239 | ;; earlier versions, and each of versions 7, 8, and 9 is |
| 240 | ;; also incompatible with the preceding ones (the core data |
| 241 | ;; structures used for communications with the library |
| 242 | ;; gained additional members with each new version). So we |
| 243 | ;; must use only the version of the library which Emacs was |
| 244 | ;; compiled against. |
| 245 | (list 'jpeg (format "libjpeg-%d.dll" (/ libjpeg-version 10))) |
| 246 | '(jpeg "jpeg62.dll" "libjpeg.dll" "jpeg-62.dll" "jpeg.dll")) |
| 247 | ;; Versions of giflib 5.0.0 and later changed signatures of |
| 248 | ;; several functions used by Emacs, which makes those versions |
| 249 | ;; incompatible with previous ones. We select the correct |
| 250 | ;; libraries according to the version of giflib we were |
| 251 | ;; compiled against. (If we were compiled without GIF support, |
| 252 | ;; libgif-version's value is -1.) |
| 253 | (if (>= libgif-version 50000) |
| 254 | ;; Yes, giflib 5.x uses 6 as the major version of the API, |
| 255 | ;; thus "libgif-6.dll" below (giflib 4.x used 5 as the |
| 256 | ;; major API version). |
| 257 | ;; giflib5.dll is from the lua-files project. |
| 258 | '(gif "libgif-6.dll" "giflib5.dll") |
| 259 | '(gif "libgif-5.dll" "giflib4.dll" "libungif4.dll" "libungif.dll")) |
| 260 | '(svg "librsvg-2-2.dll") |
| 261 | '(gdk-pixbuf "libgdk_pixbuf-2.0-0.dll") |
| 262 | '(glib "libglib-2.0-0.dll") |
| 263 | '(gobject "libgobject-2.0-0.dll") |
| 264 | '(gnutls "libgnutls-28.dll" "libgnutls-26.dll") |
| 265 | '(libxml2 "libxml2-2.dll" "libxml2.dll") |
| 266 | '(zlib "zlib1.dll" "libz-1.dll"))) |
| 267 | |
| 268 | ;;; multi-tty support |
| 269 | (defvar w32-initialized nil |
| 270 | "Non-nil if the w32 window system has been initialized.") |
| 271 | |
| 272 | (declare-function x-open-connection "w32fns.c" |
| 273 | (display &optional xrm-string must-succeed)) |
| 274 | (declare-function create-default-fontset "fontset" ()) |
| 275 | (declare-function create-fontset-from-fontset-spec "fontset" |
| 276 | (fontset-spec &optional style-variant noerror)) |
| 277 | (declare-function create-fontset-from-x-resource "fontset" ()) |
| 278 | (declare-function x-get-resource "frame.c" |
| 279 | (attribute class &optional component subclass)) |
| 280 | (declare-function x-handle-args "common-win" (args)) |
| 281 | (declare-function x-parse-geometry "frame.c" (string)) |
| 282 | (defvar x-command-line-resources) |
| 283 | |
| 284 | (defun w32-initialize-window-system (&optional _display) |
| 285 | "Initialize Emacs for W32 GUI frames." |
| 286 | (cl-assert (not w32-initialized)) |
| 287 | |
| 288 | ;; Do the actual Windows setup here; the above code just defines |
| 289 | ;; functions and variables that we use now. |
| 290 | |
| 291 | (setq command-line-args (x-handle-args command-line-args)) |
| 292 | |
| 293 | ;; Make sure we have a valid resource name. |
| 294 | (or (stringp x-resource-name) |
| 295 | (setq x-resource-name |
| 296 | ;; Change any . or * characters in x-resource-name to hyphens, |
| 297 | ;; so as not to choke when we use it in X resource queries. |
| 298 | (replace-regexp-in-string "[.*]" "-" (invocation-name)))) |
| 299 | |
| 300 | (x-open-connection "w32" x-command-line-resources |
| 301 | ;; Exit with a fatal error if this fails and we |
| 302 | ;; are the initial display |
| 303 | (eq initial-window-system 'w32)) |
| 304 | |
| 305 | ;; Create the default fontset. |
| 306 | (create-default-fontset) |
| 307 | ;; Create the standard fontset. |
| 308 | (condition-case err |
| 309 | (create-fontset-from-fontset-spec w32-standard-fontset-spec t) |
| 310 | (error (display-warning |
| 311 | 'initialization |
| 312 | (format "Creation of the standard fontset failed: %s" err) |
| 313 | :error))) |
| 314 | ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1,...). |
| 315 | (create-fontset-from-x-resource) |
| 316 | |
| 317 | ;; Apply a geometry resource to the initial frame. Put it at the end |
| 318 | ;; of the alist, so that anything specified on the command line takes |
| 319 | ;; precedence. |
| 320 | (let* ((res-geometry (x-get-resource "geometry" "Geometry")) |
| 321 | parsed) |
| 322 | (if res-geometry |
| 323 | (progn |
| 324 | (setq parsed (x-parse-geometry res-geometry)) |
| 325 | ;; If the resource specifies a position, |
| 326 | ;; call the position and size "user-specified". |
| 327 | (if (or (assq 'top parsed) (assq 'left parsed)) |
| 328 | (setq parsed (cons '(user-position . t) |
| 329 | (cons '(user-size . t) parsed)))) |
| 330 | ;; All geometry parms apply to the initial frame. |
| 331 | (setq initial-frame-alist (append initial-frame-alist parsed)) |
| 332 | ;; The size parms apply to all frames. |
| 333 | (if (and (assq 'height parsed) |
| 334 | (not (assq 'height default-frame-alist))) |
| 335 | (setq default-frame-alist |
| 336 | (cons (cons 'height (cdr (assq 'height parsed))) |
| 337 | default-frame-alist)) |
| 338 | (if (and (assq 'width parsed) |
| 339 | (not (assq 'width default-frame-alist))) |
| 340 | (setq default-frame-alist |
| 341 | (cons (cons 'width (cdr (assq 'width parsed))) |
| 342 | default-frame-alist))))))) |
| 343 | |
| 344 | ;; Check the reverseVideo resource. |
| 345 | (let ((case-fold-search t)) |
| 346 | (let ((rv (x-get-resource "reverseVideo" "ReverseVideo"))) |
| 347 | (if (and rv (string-match "^\\(true\\|yes\\|on\\)$" rv)) |
| 348 | (setq default-frame-alist |
| 349 | (cons '(reverse . t) default-frame-alist))))) |
| 350 | |
| 351 | ;; Don't let Emacs suspend under Windows. |
| 352 | (add-hook 'suspend-hook 'x-win-suspend-error) |
| 353 | |
| 354 | ;; Turn off window-splitting optimization; w32 is usually fast enough |
| 355 | ;; that this is only annoying. |
| 356 | (setq split-window-keep-point t) |
| 357 | |
| 358 | ;; W32 expects the menu bar cut and paste commands to use the clipboard. |
| 359 | (menu-bar-enable-clipboard) |
| 360 | |
| 361 | ;; Don't show the frame name; that's redundant. |
| 362 | (setq-default mode-line-frame-identification " ") |
| 363 | |
| 364 | ;; Set to a system sound if you want a fancy bell. |
| 365 | (set-message-beep 'ok) |
| 366 | (x-apply-session-resources) |
| 367 | (setq w32-initialized t)) |
| 368 | |
| 369 | (add-to-list 'display-format-alist '("\\`w32\\'" . w32)) |
| 370 | (add-to-list 'handle-args-function-alist '(w32 . x-handle-args)) |
| 371 | (add-to-list 'frame-creation-function-alist '(w32 . x-create-frame-with-faces)) |
| 372 | (add-to-list 'window-system-initialization-alist '(w32 . w32-initialize-window-system)) |
| 373 | |
| 374 | (provide 'w32-win) |
| 375 | |
| 376 | ;;; w32-win.el ends here |