Commit | Line | Data |
---|---|---|
6a05d05f | 1 | ;;; w32-win.el --- parse switches controlling interface with W32 window system |
2fe590dc | 2 | |
73b0cd50 | 3 | ;; Copyright (C) 1993-1994, 2001-2011 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 | |
ee78dc32 GV |
71 | (require 'frame) |
72 | (require 'mouse) | |
73 | (require 'scroll-bar) | |
74 | (require 'faces) | |
75 | (require 'select) | |
76 | (require 'menu-bar) | |
6bc52abc | 77 | (require 'dnd) |
729f1525 | 78 | (require 'w32-vars) |
b0efcd2e | 79 | |
c6524989 JR |
80 | ;; Keep an obsolete alias for w32-focus-frame and w32-select-font in case |
81 | ;; they are used by code outside Emacs. | |
44fe0f65 | 82 | (define-obsolete-function-alias 'w32-focus-frame 'x-focus-frame "23.1") |
a70f4c6f GM |
83 | (declare-function x-select-font "w32font.c" |
84 | (&optional frame exclude-proportional)) | |
c6524989 | 85 | (define-obsolete-function-alias 'w32-select-font 'x-select-font "23.1") |
44fe0f65 | 86 | |
729f1525 | 87 | (defvar w32-color-map) ;; defined in w32fns.c |
5430d399 | 88 | (make-obsolete 'w32-default-color-map nil "24.1") |
b01f27a3 | 89 | |
73e6adaa | 90 | (declare-function w32-send-sys-command "w32fns.c") |
73e6adaa DN |
91 | (declare-function set-message-beep "w32console.c") |
92 | ||
b05f815e | 93 | ;; Conditional on new-fontset so bootstrapping works on non-GUI compiles |
64f41d64 JR |
94 | (if (fboundp 'new-fontset) |
95 | (require 'fontset)) | |
ee78dc32 | 96 | |
15f18b89 | 97 | ;; The following definition is used for debugging scroll bar events. |
fbd6baed | 98 | ;(defun w32-handle-scroll-bar-event (event) (interactive "e") (princ event)) |
af99aa46 | 99 | |
31358bee JR |
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)) | |
33b307f8 RS |
104 | |
105 | (defun w32-drag-n-drop (event) | |
de0c7b5d | 106 | "Edit the files listed in the drag-n-drop EVENT. |
33b307f8 RS |
107 | Switch to a buffer editing the last file dropped." |
108 | (interactive "e") | |
c8316112 | 109 | (save-excursion |
35a8911d GM |
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)) | |
f7ba2ff4 | 119 | (mapc (lambda (file-name) |
0cd80dfa YM |
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 | "/"))) | |
5fd6d89f | 128 | (dnd-handle-one-url window 'private |
6bc52abc | 129 | (concat "file:" file-name))) |
1e8b532f | 130 | (car (cdr (cdr event))))) |
35a8911d | 131 | (raise-frame))) |
33b307f8 RS |
132 | |
133 | (defun w32-drag-n-drop-other-frame (event) | |
de0c7b5d | 134 | "Edit the files listed in the drag-n-drop EVENT, in other frames. |
33b307f8 RS |
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 | ||
a73c80a3 GV |
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 | ||
aa360da1 GM |
150 | (defvar x-resource-name) |
151 | ||
ee78dc32 | 152 | \f |
ee78dc32 GV |
153 | ;;;; Function keys |
154 | ||
7eb1e453 MB |
155 | ;;; make f10 activate the real menubar rather than the mini-buffer menu |
156 | ;;; navigation feature. | |
14f3467e | 157 | (defun w32-menu-bar-open (&optional frame) |
7eb1e453 | 158 | "Start key navigation of the menu bar in FRAME. |
b15c31c7 | 159 | |
14f3467e JR |
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. | |
b15c31c7 | 163 | |
14f3467e JR |
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'." | |
7eb1e453 | 167 | (interactive "i") |
14f3467e JR |
168 | (if menu-bar-mode |
169 | (w32-send-sys-command ?\xf100 frame) | |
170 | (with-selected-frame (or frame (selected-frame)) | |
171 | (tmm-menubar)))) | |
ee78dc32 | 172 | \f |
ee78dc32 | 173 | |
4664455c GV |
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 | |
e7a8ad1f | 177 | "-*-Courier New-normal-r-*-*-13-*-*-*-c-*-fontset-standard" |
de0c7b5d JR |
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\". | |
4664455c | 182 | |
885a56fe | 183 | See the documentation of `create-fontset-from-fontset-spec' for the format.") |
4664455c | 184 | |
ee78dc32 | 185 | (defun x-win-suspend-error () |
de0c7b5d JR |
186 | "Report an error when a suspend is attempted." |
187 | (error "Suspending an Emacs running under W32 makes no sense")) | |
ee78dc32 | 188 | |
2e288d54 | 189 | (defvar dynamic-library-alist) |
8d7b5b5b | 190 | (defvar libpng-version) ; image.c #ifdef HAVE_NTGUI |
aa360da1 | 191 | |
2e288d54 JB |
192 | ;;; Set default known names for external libraries |
193 | (setq dynamic-library-alist | |
5be1c984 EZ |
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")) | |
0898ca10 JB |
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-26.dll"))) | |
fe347034 | 214 | |
eacf409f JR |
215 | ;;; multi-tty support |
216 | (defvar w32-initialized nil | |
217 | "Non-nil if the w32 window system has been initialized.") | |
218 | ||
aa360da1 GM |
219 | (declare-function x-open-connection "w32fns.c" |
220 | (display &optional xrm-string must-succeed)) | |
aa360da1 GM |
221 | (declare-function create-fontset-from-fontset-spec "fontset" |
222 | (fontset-spec &optional style-variant noerror)) | |
223 | (declare-function create-fontset-from-x-resource "fontset" ()) | |
224 | (declare-function x-get-resource "frame.c" | |
225 | (attribute class &optional component subclass)) | |
f2d9c15f GM |
226 | (declare-function x-handle-args "common-win" (args)) |
227 | (declare-function x-parse-geometry "frame.c" (string)) | |
228 | (defvar x-command-line-resources) | |
aa360da1 | 229 | |
c60b74b4 JR |
230 | (defun w32-initialize-window-system () |
231 | "Initialize Emacs for W32 GUI frames." | |
00954c67 JR |
232 | |
233 | ;; Do the actual Windows setup here; the above code just defines | |
234 | ;; functions and variables that we use now. | |
235 | ||
236 | (setq command-line-args (x-handle-args command-line-args)) | |
237 | ||
238 | ;; Make sure we have a valid resource name. | |
239 | (or (stringp x-resource-name) | |
240 | (setq x-resource-name | |
241 | ;; Change any . or * characters in x-resource-name to hyphens, | |
242 | ;; so as not to choke when we use it in X resource queries. | |
243 | (replace-regexp-in-string "[.*]" "-" (invocation-name)))) | |
244 | ||
eacf409f JR |
245 | (x-open-connection "" x-command-line-resources |
246 | ;; Exit with a fatal error if this fails and we | |
247 | ;; are the initial display | |
248 | (eq initial-window-system 'w32)) | |
00954c67 | 249 | |
0311148f KH |
250 | ;; Create the default fontset. |
251 | (create-default-fontset) | |
00954c67 | 252 | ;; Create the standard fontset. |
0311148f KH |
253 | (condition-case err |
254 | (create-fontset-from-fontset-spec w32-standard-fontset-spec t) | |
b15c31c7 | 255 | (error (display-warning |
0311148f KH |
256 | 'initialization |
257 | (format "Creation of the standard fontset failed: %s" err) | |
258 | :error))) | |
00954c67 JR |
259 | ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1,...). |
260 | (create-fontset-from-x-resource) | |
00954c67 JR |
261 | |
262 | ;; Apply a geometry resource to the initial frame. Put it at the end | |
263 | ;; of the alist, so that anything specified on the command line takes | |
264 | ;; precedence. | |
265 | (let* ((res-geometry (x-get-resource "geometry" "Geometry")) | |
266 | parsed) | |
267 | (if res-geometry | |
268 | (progn | |
269 | (setq parsed (x-parse-geometry res-geometry)) | |
270 | ;; If the resource specifies a position, | |
271 | ;; call the position and size "user-specified". | |
272 | (if (or (assq 'top parsed) (assq 'left parsed)) | |
273 | (setq parsed (cons '(user-position . t) | |
274 | (cons '(user-size . t) parsed)))) | |
275 | ;; All geometry parms apply to the initial frame. | |
276 | (setq initial-frame-alist (append initial-frame-alist parsed)) | |
277 | ;; The size parms apply to all frames. | |
aaa5e420 JR |
278 | (if (and (assq 'height parsed) |
279 | (not (assq 'height default-frame-alist))) | |
280 | (setq default-frame-alist | |
281 | (cons (cons 'height (cdr (assq 'height parsed))) | |
282 | default-frame-alist)) | |
283 | (if (and (assq 'width parsed) | |
284 | (not (assq 'width default-frame-alist))) | |
285 | (setq default-frame-alist | |
286 | (cons (cons 'width (cdr (assq 'width parsed))) | |
287 | default-frame-alist))))))) | |
00954c67 | 288 | |
eacf409f JR |
289 | ;; Check the reverseVideo resource. |
290 | (let ((case-fold-search t)) | |
291 | (let ((rv (x-get-resource "reverseVideo" "ReverseVideo"))) | |
292 | (if (and rv (string-match "^\\(true\\|yes\\|on\\)$" rv)) | |
aaa5e420 JR |
293 | (setq default-frame-alist |
294 | (cons '(reverse . t) default-frame-alist))))) | |
eacf409f JR |
295 | |
296 | ;; Don't let Emacs suspend under w32 gui | |
00954c67 JR |
297 | (add-hook 'suspend-hook 'x-win-suspend-error) |
298 | ||
299 | ;; Turn off window-splitting optimization; w32 is usually fast enough | |
300 | ;; that this is only annoying. | |
301 | (setq split-window-keep-point t) | |
302 | ||
eacf409f JR |
303 | ;; W32 expects the menu bar cut and paste commands to use the clipboard. |
304 | (menu-bar-enable-clipboard) | |
305 | ||
00954c67 JR |
306 | ;; Don't show the frame name; that's redundant. |
307 | (setq-default mode-line-frame-identification " ") | |
308 | ||
309 | ;; Set to a system sound if you want a fancy bell. | |
310 | (set-message-beep 'ok) | |
eacf409f | 311 | (setq w32-initialized t)) |
c60b74b4 JR |
312 | |
313 | (add-to-list 'handle-args-function-alist '(w32 . x-handle-args)) | |
314 | (add-to-list 'frame-creation-function-alist '(w32 . x-create-frame-with-faces)) | |
315 | (add-to-list 'window-system-initialization-alist '(w32 . w32-initialize-window-system)) | |
316 | ||
317 | (provide 'w32-win) | |
fe347034 | 318 | |
b63f9ba1 | 319 | ;;; w32-win.el ends here |