Commit | Line | Data |
---|---|---|
0fda9b75 | 1 | ;;; w32-win.el --- parse switches controlling interface with W32 window system -*- lexical-binding: t -*- |
2fe590dc | 2 | |
ba318903 | 3 | ;; Copyright (C) 1993-1994, 2001-2014 Free Software Foundation, Inc. |
ee78dc32 GV |
4 | |
5 | ;; Author: Kevin Gallo | |
6 | ;; Keywords: terminals | |
7 | ||
2fe590dc EN |
8 | ;; This file is part of GNU Emacs. |
9 | ||
1fecc8fe | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
2fe590dc | 11 | ;; it under the terms of the GNU General Public License as published by |
1fecc8fe GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
2fe590dc EN |
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 | |
1fecc8fe | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
ee78dc32 GV |
22 | |
23 | ;;; Commentary: | |
24 | ||
b63f9ba1 GV |
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. | |
ee78dc32 GV |
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 | ||
c60b74b4 JR |
68 | ;; (if (not (eq window-system 'w32)) |
69 | ;; (error "%s: Loading w32-win.el but not compiled for w32" (invocation-name))) | |
db95369b | 70 | |
efc3dd3c | 71 | (eval-when-compile (require 'cl-lib)) |
ee78dc32 GV |
72 | (require 'frame) |
73 | (require 'mouse) | |
74 | (require 'scroll-bar) | |
75 | (require 'faces) | |
76 | (require 'select) | |
77 | (require 'menu-bar) | |
6bc52abc | 78 | (require 'dnd) |
729f1525 | 79 | (require 'w32-vars) |
b0efcd2e | 80 | |
c6524989 JR |
81 | ;; Keep an obsolete alias for w32-focus-frame and w32-select-font in case |
82 | ;; they are used by code outside Emacs. | |
44fe0f65 | 83 | (define-obsolete-function-alias 'w32-focus-frame 'x-focus-frame "23.1") |
a70f4c6f GM |
84 | (declare-function x-select-font "w32font.c" |
85 | (&optional frame exclude-proportional)) | |
c6524989 | 86 | (define-obsolete-function-alias 'w32-select-font 'x-select-font "23.1") |
44fe0f65 | 87 | |
729f1525 | 88 | (defvar w32-color-map) ;; defined in w32fns.c |
5430d399 | 89 | (make-obsolete 'w32-default-color-map nil "24.1") |
b01f27a3 | 90 | |
73e6adaa | 91 | (declare-function w32-send-sys-command "w32fns.c") |
9a5f296f | 92 | (declare-function set-message-beep "w32fns.c") |
73e6adaa | 93 | |
6e9f7997 | 94 | (declare-function cygwin-convert-file-name-from-windows "cygw32.c" |
d7fe6352 | 95 | (path &optional absolute_p)) |
3804f7bc | 96 | |
b05f815e | 97 | ;; Conditional on new-fontset so bootstrapping works on non-GUI compiles |
64f41d64 JR |
98 | (if (fboundp 'new-fontset) |
99 | (require 'fontset)) | |
ee78dc32 | 100 | |
15f18b89 | 101 | ;; The following definition is used for debugging scroll bar events. |
fbd6baed | 102 | ;(defun w32-handle-scroll-bar-event (event) (interactive "e") (princ event)) |
af99aa46 | 103 | |
31358bee JR |
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)) | |
33b307f8 | 108 | |
0fda9b75 DC |
109 | (defun w32-handle-dropped-file (window file-name) |
110 | (let ((f (if (eq system-type 'cygwin) | |
6e9f7997 | 111 | (cygwin-convert-file-name-from-windows file-name t) |
0fda9b75 | 112 | (subst-char-in-string ?\\ ?/ file-name))) |
d45c9088 EZ |
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)))) | |
0fda9b75 DC |
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 | |
3804f7bc EZ |
127 | (concat |
128 | (if (eq system-type 'cygwin) | |
129 | "file://" | |
130 | "file:") | |
131 | file-name))) | |
0fda9b75 DC |
132 | |
133 | (defun w32-drag-n-drop (event &optional new-frame) | |
de0c7b5d | 134 | "Edit the files listed in the drag-n-drop EVENT. |
33b307f8 RS |
135 | Switch to a buffer editing the last file dropped." |
136 | (interactive "e") | |
c8316112 | 137 | (save-excursion |
35a8911d GM |
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)) | |
0fda9b75 DC |
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))))))) | |
33b307f8 RS |
155 | |
156 | (defun w32-drag-n-drop-other-frame (event) | |
de0c7b5d | 157 | "Edit the files listed in the drag-n-drop EVENT, in other frames. |
33b307f8 RS |
158 | May create new frames, or reuse existing ones. The frame editing |
159 | the last file dropped is selected." | |
160 | (interactive "e") | |
0fda9b75 | 161 | (w32-drag-n-drop event t)) |
33b307f8 RS |
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 | ||
a73c80a3 GV |
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 | ||
aa360da1 GM |
173 | (defvar x-resource-name) |
174 | ||
ee78dc32 | 175 | \f |
ee78dc32 GV |
176 | ;;;; Function keys |
177 | ||
7eb1e453 MB |
178 | ;;; make f10 activate the real menubar rather than the mini-buffer menu |
179 | ;;; navigation feature. | |
14f3467e | 180 | (defun w32-menu-bar-open (&optional frame) |
7eb1e453 | 181 | "Start key navigation of the menu bar in FRAME. |
b15c31c7 | 182 | |
14f3467e JR |
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. | |
b15c31c7 | 186 | |
14f3467e JR |
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'." | |
7eb1e453 | 190 | (interactive "i") |
14f3467e JR |
191 | (if menu-bar-mode |
192 | (w32-send-sys-command ?\xf100 frame) | |
193 | (with-selected-frame (or frame (selected-frame)) | |
194 | (tmm-menubar)))) | |
ee78dc32 | 195 | \f |
ee78dc32 | 196 | |
4664455c GV |
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 | |
e7a8ad1f | 200 | "-*-Courier New-normal-r-*-*-13-*-*-*-c-*-fontset-standard" |
de0c7b5d JR |
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\". | |
4664455c | 205 | |
885a56fe | 206 | See the documentation of `create-fontset-from-fontset-spec' for the format.") |
4664455c | 207 | |
ee78dc32 | 208 | (defun x-win-suspend-error () |
de0c7b5d JR |
209 | "Report an error when a suspend is attempted." |
210 | (error "Suspending an Emacs running under W32 makes no sense")) | |
ee78dc32 | 211 | |
2e288d54 | 212 | (defvar dynamic-library-alist) |
8d7b5b5b | 213 | (defvar libpng-version) ; image.c #ifdef HAVE_NTGUI |
aa360da1 | 214 | |
2e288d54 JB |
215 | ;;; Set default known names for external libraries |
216 | (setq dynamic-library-alist | |
5be1c984 EZ |
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) | |
ac1bf374 CB |
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))) | |
5be1c984 EZ |
233 | '(png "libpng12d.dll" "libpng12.dll" "libpng3.dll" "libpng.dll" |
234 | ;; these are libpng 1.2.8 from GTK+ | |
235 | "libpng13d.dll" "libpng13.dll")) | |
019c8218 | 236 | '(tiff "libtiff-5.dll" "libtiff3.dll" "libtiff.dll") |
d14c81ee CB |
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")) | |
a5dab159 EZ |
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")) | |
0898ca10 JB |
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") | |
9078ead6 | 264 | '(gnutls "libgnutls-28.dll" "libgnutls-26.dll") |
594a4307 EZ |
265 | '(libxml2 "libxml2-2.dll" "libxml2.dll") |
266 | '(zlib "zlib1.dll" "libz-1.dll"))) | |
fe347034 | 267 | |
eacf409f JR |
268 | ;;; multi-tty support |
269 | (defvar w32-initialized nil | |
270 | "Non-nil if the w32 window system has been initialized.") | |
271 | ||
aa360da1 GM |
272 | (declare-function x-open-connection "w32fns.c" |
273 | (display &optional xrm-string must-succeed)) | |
5fa89513 | 274 | (declare-function create-default-fontset "fontset" ()) |
aa360da1 GM |
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)) | |
f2d9c15f GM |
280 | (declare-function x-handle-args "common-win" (args)) |
281 | (declare-function x-parse-geometry "frame.c" (string)) | |
282 | (defvar x-command-line-resources) | |
aa360da1 | 283 | |
51646b62 | 284 | (defun w32-initialize-window-system (&optional _display) |
c60b74b4 | 285 | "Initialize Emacs for W32 GUI frames." |
efc3dd3c | 286 | (cl-assert (not w32-initialized)) |
00954c67 JR |
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 | ||
efc3dd3c | 300 | (x-open-connection "w32" x-command-line-resources |
eacf409f JR |
301 | ;; Exit with a fatal error if this fails and we |
302 | ;; are the initial display | |
303 | (eq initial-window-system 'w32)) | |
00954c67 | 304 | |
0311148f KH |
305 | ;; Create the default fontset. |
306 | (create-default-fontset) | |
00954c67 | 307 | ;; Create the standard fontset. |
0311148f KH |
308 | (condition-case err |
309 | (create-fontset-from-fontset-spec w32-standard-fontset-spec t) | |
b15c31c7 | 310 | (error (display-warning |
0311148f KH |
311 | 'initialization |
312 | (format "Creation of the standard fontset failed: %s" err) | |
313 | :error))) | |
00954c67 JR |
314 | ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1,...). |
315 | (create-fontset-from-x-resource) | |
00954c67 JR |
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. | |
aaa5e420 JR |
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))))))) | |
00954c67 | 343 | |
eacf409f JR |
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)) | |
aaa5e420 JR |
348 | (setq default-frame-alist |
349 | (cons '(reverse . t) default-frame-alist))))) | |
eacf409f | 350 | |
efc3dd3c | 351 | ;; Don't let Emacs suspend under Windows. |
00954c67 JR |
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 | ||
eacf409f JR |
358 | ;; W32 expects the menu bar cut and paste commands to use the clipboard. |
359 | (menu-bar-enable-clipboard) | |
360 | ||
00954c67 JR |
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) | |
15cd8efd | 366 | (x-apply-session-resources) |
eacf409f | 367 | (setq w32-initialized t)) |
c60b74b4 | 368 | |
efc3dd3c | 369 | (add-to-list 'display-format-alist '("\\`w32\\'" . w32)) |
c60b74b4 JR |
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) | |
fe347034 | 375 | |
b63f9ba1 | 376 | ;;; w32-win.el ends here |