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