Commit | Line | Data |
---|---|---|
0fda9b75 | 1 | ;;; w32-win.el --- parse switches controlling interface with W32 window system -*- lexical-binding: t -*- |
2fe590dc | 2 | |
ab422c4d | 3 | ;; Copyright (C) 1993-1994, 2001-2013 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 DC |
112 | (subst-char-in-string ?\\ ?/ file-name))) |
113 | (coding (or file-name-coding-system | |
114 | default-file-name-coding-system))) | |
115 | ||
116 | (setq file-name | |
117 | (mapconcat 'url-hexify-string | |
118 | (split-string (encode-coding-string f coding) | |
119 | "/") | |
120 | "/"))) | |
121 | (dnd-handle-one-url window 'private | |
3804f7bc EZ |
122 | (concat |
123 | (if (eq system-type 'cygwin) | |
124 | "file://" | |
125 | "file:") | |
126 | file-name))) | |
0fda9b75 DC |
127 | |
128 | (defun w32-drag-n-drop (event &optional new-frame) | |
de0c7b5d | 129 | "Edit the files listed in the drag-n-drop EVENT. |
33b307f8 RS |
130 | Switch to a buffer editing the last file dropped." |
131 | (interactive "e") | |
c8316112 | 132 | (save-excursion |
35a8911d GM |
133 | ;; Make sure the drop target has positive co-ords |
134 | ;; before setting the selected frame - otherwise it | |
135 | ;; won't work. <skx@tardis.ed.ac.uk> | |
136 | (let* ((window (posn-window (event-start event))) | |
137 | (coords (posn-x-y (event-start event))) | |
138 | (x (car coords)) | |
139 | (y (cdr coords))) | |
140 | (if (and (> x 0) (> y 0)) | |
141 | (set-frame-selected-window nil window)) | |
0fda9b75 DC |
142 | |
143 | (when new-frame | |
144 | (select-frame (make-frame))) | |
145 | (raise-frame) | |
146 | (setq window (selected-window)) | |
147 | ||
148 | (mapc (apply-partially #'w32-handle-dropped-file window) | |
149 | (car (cdr (cdr event))))))) | |
33b307f8 RS |
150 | |
151 | (defun w32-drag-n-drop-other-frame (event) | |
de0c7b5d | 152 | "Edit the files listed in the drag-n-drop EVENT, in other frames. |
33b307f8 RS |
153 | May create new frames, or reuse existing ones. The frame editing |
154 | the last file dropped is selected." | |
155 | (interactive "e") | |
0fda9b75 | 156 | (w32-drag-n-drop event t)) |
33b307f8 RS |
157 | |
158 | ;; Bind the drag-n-drop event. | |
159 | (global-set-key [drag-n-drop] 'w32-drag-n-drop) | |
160 | (global-set-key [C-drag-n-drop] 'w32-drag-n-drop-other-frame) | |
161 | ||
a73c80a3 GV |
162 | ;; Keyboard layout/language change events |
163 | ;; For now ignore language-change events; in the future | |
164 | ;; we should switch the Emacs Input Method to match the | |
165 | ;; new layout/language selected by the user. | |
166 | (global-set-key [language-change] 'ignore) | |
167 | ||
aa360da1 GM |
168 | (defvar x-resource-name) |
169 | ||
ee78dc32 | 170 | \f |
ee78dc32 GV |
171 | ;;;; Function keys |
172 | ||
7eb1e453 MB |
173 | ;;; make f10 activate the real menubar rather than the mini-buffer menu |
174 | ;;; navigation feature. | |
14f3467e | 175 | (defun w32-menu-bar-open (&optional frame) |
7eb1e453 | 176 | "Start key navigation of the menu bar in FRAME. |
b15c31c7 | 177 | |
14f3467e JR |
178 | This initially activates the first menu-bar item, and you can then navigate |
179 | with the arrow keys, select a menu entry with the Return key or cancel with | |
180 | the Escape key. If FRAME has no menu bar, this function does nothing. | |
b15c31c7 | 181 | |
14f3467e JR |
182 | If FRAME is nil or not given, use the selected frame. |
183 | If FRAME does not have the menu bar enabled, display a text menu using | |
184 | `tmm-menubar'." | |
7eb1e453 | 185 | (interactive "i") |
14f3467e JR |
186 | (if menu-bar-mode |
187 | (w32-send-sys-command ?\xf100 frame) | |
188 | (with-selected-frame (or frame (selected-frame)) | |
189 | (tmm-menubar)))) | |
ee78dc32 | 190 | \f |
ee78dc32 | 191 | |
4664455c GV |
192 | ;; W32 systems have different fonts than commonly found on X, so |
193 | ;; we define our own standard fontset here. | |
194 | (defvar w32-standard-fontset-spec | |
e7a8ad1f | 195 | "-*-Courier New-normal-r-*-*-13-*-*-*-c-*-fontset-standard" |
de0c7b5d JR |
196 | "String of fontset spec of the standard fontset. |
197 | This defines a fontset consisting of the Courier New variations for | |
198 | European languages which are distributed with Windows as | |
199 | \"Multilanguage Support\". | |
4664455c | 200 | |
885a56fe | 201 | See the documentation of `create-fontset-from-fontset-spec' for the format.") |
4664455c | 202 | |
ee78dc32 | 203 | (defun x-win-suspend-error () |
de0c7b5d JR |
204 | "Report an error when a suspend is attempted." |
205 | (error "Suspending an Emacs running under W32 makes no sense")) | |
ee78dc32 | 206 | |
2e288d54 | 207 | (defvar dynamic-library-alist) |
8d7b5b5b | 208 | (defvar libpng-version) ; image.c #ifdef HAVE_NTGUI |
aa360da1 | 209 | |
2e288d54 JB |
210 | ;;; Set default known names for external libraries |
211 | (setq dynamic-library-alist | |
5be1c984 EZ |
212 | (list |
213 | '(xpm "libxpm.dll" "xpm4.dll" "libXpm-nox4.dll") | |
214 | ;; Versions of libpng 1.4.x and later are incompatible with | |
215 | ;; earlier versions. Set up the list of libraries according to | |
216 | ;; the version we were compiled against. (If we were compiled | |
217 | ;; without PNG support, libpng-version's value is -1.) | |
218 | (if (>= libpng-version 10400) | |
219 | ;; libpng14-14.dll is libpng 1.4.3 from GTK+ | |
220 | '(png "libpng14-14.dll" "libpng14.dll") | |
221 | '(png "libpng12d.dll" "libpng12.dll" "libpng3.dll" "libpng.dll" | |
222 | ;; these are libpng 1.2.8 from GTK+ | |
223 | "libpng13d.dll" "libpng13.dll")) | |
0898ca10 JB |
224 | '(jpeg "jpeg62.dll" "libjpeg.dll" "jpeg-62.dll" "jpeg.dll") |
225 | '(tiff "libtiff3.dll" "libtiff.dll") | |
226 | '(gif "giflib4.dll" "libungif4.dll" "libungif.dll") | |
227 | '(svg "librsvg-2-2.dll") | |
228 | '(gdk-pixbuf "libgdk_pixbuf-2.0-0.dll") | |
229 | '(glib "libglib-2.0-0.dll") | |
230 | '(gobject "libgobject-2.0-0.dll") | |
9078ead6 EZ |
231 | '(gnutls "libgnutls-28.dll" "libgnutls-26.dll") |
232 | '(libxml2 "libxml2-2.dll" "libxml2.dll"))) | |
fe347034 | 233 | |
eacf409f JR |
234 | ;;; multi-tty support |
235 | (defvar w32-initialized nil | |
236 | "Non-nil if the w32 window system has been initialized.") | |
237 | ||
aa360da1 GM |
238 | (declare-function x-open-connection "w32fns.c" |
239 | (display &optional xrm-string must-succeed)) | |
aa360da1 GM |
240 | (declare-function create-fontset-from-fontset-spec "fontset" |
241 | (fontset-spec &optional style-variant noerror)) | |
242 | (declare-function create-fontset-from-x-resource "fontset" ()) | |
243 | (declare-function x-get-resource "frame.c" | |
244 | (attribute class &optional component subclass)) | |
f2d9c15f GM |
245 | (declare-function x-handle-args "common-win" (args)) |
246 | (declare-function x-parse-geometry "frame.c" (string)) | |
247 | (defvar x-command-line-resources) | |
aa360da1 | 248 | |
51646b62 | 249 | (defun w32-initialize-window-system (&optional _display) |
c60b74b4 | 250 | "Initialize Emacs for W32 GUI frames." |
efc3dd3c | 251 | (cl-assert (not w32-initialized)) |
00954c67 JR |
252 | |
253 | ;; Do the actual Windows setup here; the above code just defines | |
254 | ;; functions and variables that we use now. | |
255 | ||
256 | (setq command-line-args (x-handle-args command-line-args)) | |
257 | ||
258 | ;; Make sure we have a valid resource name. | |
259 | (or (stringp x-resource-name) | |
260 | (setq x-resource-name | |
261 | ;; Change any . or * characters in x-resource-name to hyphens, | |
262 | ;; so as not to choke when we use it in X resource queries. | |
263 | (replace-regexp-in-string "[.*]" "-" (invocation-name)))) | |
264 | ||
efc3dd3c | 265 | (x-open-connection "w32" x-command-line-resources |
eacf409f JR |
266 | ;; Exit with a fatal error if this fails and we |
267 | ;; are the initial display | |
268 | (eq initial-window-system 'w32)) | |
00954c67 | 269 | |
0311148f KH |
270 | ;; Create the default fontset. |
271 | (create-default-fontset) | |
00954c67 | 272 | ;; Create the standard fontset. |
0311148f KH |
273 | (condition-case err |
274 | (create-fontset-from-fontset-spec w32-standard-fontset-spec t) | |
b15c31c7 | 275 | (error (display-warning |
0311148f KH |
276 | 'initialization |
277 | (format "Creation of the standard fontset failed: %s" err) | |
278 | :error))) | |
00954c67 JR |
279 | ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1,...). |
280 | (create-fontset-from-x-resource) | |
00954c67 JR |
281 | |
282 | ;; Apply a geometry resource to the initial frame. Put it at the end | |
283 | ;; of the alist, so that anything specified on the command line takes | |
284 | ;; precedence. | |
285 | (let* ((res-geometry (x-get-resource "geometry" "Geometry")) | |
286 | parsed) | |
287 | (if res-geometry | |
288 | (progn | |
289 | (setq parsed (x-parse-geometry res-geometry)) | |
290 | ;; If the resource specifies a position, | |
291 | ;; call the position and size "user-specified". | |
292 | (if (or (assq 'top parsed) (assq 'left parsed)) | |
293 | (setq parsed (cons '(user-position . t) | |
294 | (cons '(user-size . t) parsed)))) | |
295 | ;; All geometry parms apply to the initial frame. | |
296 | (setq initial-frame-alist (append initial-frame-alist parsed)) | |
297 | ;; The size parms apply to all frames. | |
aaa5e420 JR |
298 | (if (and (assq 'height parsed) |
299 | (not (assq 'height default-frame-alist))) | |
300 | (setq default-frame-alist | |
301 | (cons (cons 'height (cdr (assq 'height parsed))) | |
302 | default-frame-alist)) | |
303 | (if (and (assq 'width parsed) | |
304 | (not (assq 'width default-frame-alist))) | |
305 | (setq default-frame-alist | |
306 | (cons (cons 'width (cdr (assq 'width parsed))) | |
307 | default-frame-alist))))))) | |
00954c67 | 308 | |
eacf409f JR |
309 | ;; Check the reverseVideo resource. |
310 | (let ((case-fold-search t)) | |
311 | (let ((rv (x-get-resource "reverseVideo" "ReverseVideo"))) | |
312 | (if (and rv (string-match "^\\(true\\|yes\\|on\\)$" rv)) | |
aaa5e420 JR |
313 | (setq default-frame-alist |
314 | (cons '(reverse . t) default-frame-alist))))) | |
eacf409f | 315 | |
efc3dd3c | 316 | ;; Don't let Emacs suspend under Windows. |
00954c67 JR |
317 | (add-hook 'suspend-hook 'x-win-suspend-error) |
318 | ||
319 | ;; Turn off window-splitting optimization; w32 is usually fast enough | |
320 | ;; that this is only annoying. | |
321 | (setq split-window-keep-point t) | |
322 | ||
eacf409f JR |
323 | ;; W32 expects the menu bar cut and paste commands to use the clipboard. |
324 | (menu-bar-enable-clipboard) | |
325 | ||
00954c67 JR |
326 | ;; Don't show the frame name; that's redundant. |
327 | (setq-default mode-line-frame-identification " ") | |
328 | ||
329 | ;; Set to a system sound if you want a fancy bell. | |
330 | (set-message-beep 'ok) | |
15cd8efd | 331 | (x-apply-session-resources) |
eacf409f | 332 | (setq w32-initialized t)) |
c60b74b4 | 333 | |
efc3dd3c | 334 | (add-to-list 'display-format-alist '("\\`w32\\'" . w32)) |
c60b74b4 JR |
335 | (add-to-list 'handle-args-function-alist '(w32 . x-handle-args)) |
336 | (add-to-list 'frame-creation-function-alist '(w32 . x-create-frame-with-faces)) | |
337 | (add-to-list 'window-system-initialization-alist '(w32 . w32-initialize-window-system)) | |
338 | ||
339 | (provide 'w32-win) | |
fe347034 | 340 | |
b63f9ba1 | 341 | ;;; w32-win.el ends here |