1 ;;; pc-win.el --- setup support for `PC windows' (whatever that is)
3 ;; Copyright (C) 1994, 1996-1997, 1999, 2001-2015 Free Software
6 ;; Author: Morten Welinder <terra@diku.dk>
7 ;; Maintainer: emacs-devel@gnu.org
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;; This file is preloaded into Emacs by loadup.el. The functions in
27 ;; this file are then called during startup from startup.el. This
28 ;; means that just loading this file should not have any side effects
29 ;; besides defining functions and variables, and in particular should
30 ;; NOT initialize any window systems.
32 ;; The main entry points to this file's features are msdos-handle-args,
33 ;; msdos-create-frame-with-faces, msdos-initialize-window-system,
34 ;; terminal-init-internal. The last one is not supposed to be called,
35 ;; so it just errors out.
39 (if (not (fboundp 'msdos-remember-default-colors
))
40 (error "%s: Loading pc-win.el but not compiled for MS-DOS"
43 (declare-function msdos-remember-default-colors
"msdos.c")
44 (declare-function w16-set-clipboard-data
"w16select.c")
45 (declare-function w16-get-clipboard-data
"w16select.c")
46 (declare-function msdos-setup-keyboard
"internal" (frame))
48 ;;; This was copied from etc/rgb.txt, except that some values were changed
49 ;;; a bit to make them consistent with DOS console colors, and the RGB
50 ;;; values were scaled up to 16 bits, as `tty-define-color' requires.
52 ;;; The mapping between the 16 standard EGA/VGA colors and X color names
53 ;;; was done by running a Unix version of Emacs inside an X client and a
54 ;;; DJGPP-compiled Emacs on the same PC. The names of X colors used to
55 ;;; define the pixel values are shown as comments to each color below.
57 ;;; If you want to change the RGB values, keep in mind that various pieces
58 ;;; of Emacs think that a color whose RGB values add up to less than 0.6 of
59 ;;; the values for WHITE (i.e. less than 117963) are ``dark'', otherwise the
60 ;;; color is ``light''; see `frame-set-background-mode' in lisp/faces.el for
62 (defvar msdos-color-values
64 ("blue" 1 0 0 52480) ; MediumBlue
65 ("green" 2 8704 35584 8704) ; ForestGreen
66 ("cyan" 3 0 52736 53504) ; DarkTurquoise
67 ("red" 4 45568 8704 8704) ; FireBrick
68 ("magenta" 5 35584 0 35584) ; DarkMagenta
69 ("brown" 6 40960 20992 11520) ; Sienna
70 ("lightgray" 7 48640 48640 48640) ; Gray
71 ("darkgray" 8 26112 26112 26112) ; Gray40
72 ("lightblue" 9 0 0 65535) ; Blue
73 ("lightgreen" 10 0 65535 0) ; Green
74 ("lightcyan" 11 0 65535 65535) ; Cyan
75 ("lightred" 12 65535 0 0) ; Red
76 ("lightmagenta" 13 65535 0 65535) ; Magenta
77 ("yellow" 14 65535 65535 0) ; Yellow
78 ("white" 15 65535 65535 65535))
79 "A list of MS-DOS console colors, their indices and 16-bit RGB values.")
81 ;; ---------------------------------------------------------------------------
82 ;; We want to delay setting frame parameters until the faces are setup
83 (defvar default-frame-alist nil
)
84 ;(modify-frame-parameters terminal-frame default-frame-alist)
86 (defun msdos-face-setup ()
87 "Initial setup of faces for the MS-DOS display."
88 (set-face-foreground 'bold
"yellow")
89 (set-face-foreground 'italic
"red")
90 (set-face-foreground 'bold-italic
"lightred")
91 (set-face-foreground 'underline
"white")
93 (make-face 'msdos-menu-active-face
)
94 (make-face 'msdos-menu-passive-face
)
95 (make-face 'msdos-menu-select-face
)
96 (set-face-foreground 'msdos-menu-active-face
"white")
97 (set-face-foreground 'msdos-menu-passive-face
"lightgray")
98 (set-face-background 'msdos-menu-active-face
"blue")
99 (set-face-background 'msdos-menu-passive-face
"blue")
100 (set-face-background 'msdos-menu-select-face
"red"))
102 (defun msdos-handle-reverse-video (frame parameters
)
103 "Handle the reverse-video frame parameter on MS-DOS frames."
104 (when (cdr (or (assq 'reverse parameters
)
105 (assq 'reverse default-frame-alist
)))
106 (let* ((params (frame-parameters frame
))
107 (fg (cdr (assq 'foreground-color params
)))
108 (bg (cdr (assq 'background-color params
))))
109 (if (equal fg
(cdr (assq 'mouse-color params
)))
110 (modify-frame-parameters frame
111 (list (cons 'mouse-color bg
))))
112 (if (equal fg
(cdr (assq 'cursor-color params
)))
113 (modify-frame-parameters frame
114 (list (cons 'cursor-color bg
)))))))
116 ;; This must run after all the default colors are inserted into
117 ;; tty-color-alist, since msdos-handle-reverse-video needs to know the
118 ;; actual frame colors.
119 (defun msdos-setup-initial-frame ()
120 (modify-frame-parameters terminal-frame default-frame-alist
)
121 ;; This remembers the screen colors after applying default-frame-alist,
122 ;; so that all subsequent frames could begin with those colors.
123 (msdos-remember-default-colors terminal-frame
)
124 (modify-frame-parameters terminal-frame initial-frame-alist
)
125 (msdos-handle-reverse-video terminal-frame
126 (frame-parameters terminal-frame
))
128 (frame-set-background-mode terminal-frame
)
129 (face-set-after-frame-default terminal-frame
))
131 ;; We create frames as if we were a terminal, but without invoking the
132 ;; terminal-initialization function. Also, our handling of reverse
133 ;; video is slightly different.
134 (defun msdos-create-frame-with-faces (&optional parameters
)
135 "Create a frame on MS-DOS display.
136 Optional frame parameters PARAMETERS specify the frame parameters.
137 Parameters not specified by PARAMETERS are taken from
138 `default-frame-alist'. If either PARAMETERS or `default-frame-alist'
139 contains a `reverse' parameter, handle that. Value is the new frame
141 (let ((frame (make-terminal-frame parameters
))
144 (with-selected-frame frame
145 (msdos-handle-reverse-video frame
(frame-parameters frame
))
146 (unless (terminal-parameter frame
'terminal-initted
)
147 (set-terminal-parameter frame
'terminal-initted t
))
148 (frame-set-background-mode frame
)
149 (face-set-after-frame-default frame
)
151 (unless success
(delete-frame frame
)))
154 ;; ---------------------------------------------------------------------------
155 ;; More or less useful imitations of certain X-functions. A lot of the
156 ;; values returned are questionable, but usually only the form of the
157 ;; returned value matters. Also, by the way, recall that `ignore' is
158 ;; a useful function for returning 'nil regardless of argument.
160 ;; Note: Any re-definition in this file of a function that is defined
161 ;; in C on other platforms, should either have no doc-string, or one
162 ;; that is identical to the C version, but with the arglist signature
163 ;; at the end. Otherwise help-split-fundoc gets confused on other
164 ;; platforms. (Bug#10783)
167 (defun x-list-fonts (_pattern &optional _face _frame _maximum width
)
168 "Return a list of the names of available fonts matching PATTERN.
169 If optional arguments FACE and FRAME are specified, return only fonts
170 the same size as FACE on FRAME.
172 PATTERN should be a string containing a font name in the XLFD,
173 Fontconfig, or GTK format. A font name given in the XLFD format may
174 contain wildcard characters:
175 the * character matches any substring, and
176 the ? character matches any single character.
177 PATTERN is case-insensitive.
179 The return value is a list of strings, suitable as arguments to
182 Fonts Emacs can't use may or may not be excluded
183 even if they match PATTERN and FACE.
184 The optional fourth argument MAXIMUM sets a limit on how many
185 fonts to match. The first MAXIMUM fonts are reported.
186 The optional fifth argument WIDTH, if specified, is a number of columns
187 occupied by a character of a font. In that case, return only fonts
188 the WIDTH times as wide as FACE on FRAME."
189 (if (or (null width
) (and (numberp width
) (= width
1)))
191 (list "no-such-font")))
192 (defun x-display-pixel-width (&optional frame
) (frame-width frame
))
193 (defun x-display-pixel-height (&optional frame
) (frame-height frame
))
194 (defun x-display-planes (&optional _frame
) 4) ;bg switched to 16 colors as well
195 (defun x-display-color-cells (&optional _frame
) 16)
196 (defun x-server-max-request-size (&optional _frame
) 1000000) ; ???
197 (defun x-server-vendor (&optional _frame
) t
"GNU")
198 (defun x-server-version (&optional _frame
) '(1 0 0))
199 (defun x-display-screens (&optional _frame
) 1)
200 (defun x-display-mm-height (&optional _frame
) 245) ; Guess the size of my
201 (defun x-display-mm-width (&optional _frame
) 322) ; monitor, EZ...
202 (defun x-display-backing-store (&optional _frame
) 'not-useful
)
203 (defun x-display-visual-class (&optional _frame
) 'static-color
)
204 (fset 'x-display-save-under
'ignore
)
205 (fset 'x-get-resource
'ignore
)
207 ;; From lisp/term/x-win.el
208 (defvar x-display-name
"pc"
209 "The name of the window display on which Emacs was started.
210 On X, the display name of individual X frames is recorded in the
211 `display' frame parameter.")
212 (defvar x-colors
(mapcar 'car msdos-color-values
)
213 "List of basic colors available on color displays.
214 For X, the list comes from the `rgb.txt' file,v 10.41 94/02/20.
215 For Nextstep, this is a list of non-PANTONE colors returned by
216 the operating system.")
218 ;; From lisp/term/w32-win.el
222 ;;; We keep track of the last text selected here, so we can check the
223 ;;; current selection against it, and avoid passing back our own text
224 ;;; from x-selection-value.
225 (defvar x-last-selected-text nil
)
227 (defcustom x-select-enable-clipboard t
228 "Non-nil means cutting and pasting uses the clipboard.
229 This is in addition to, but in preference to, the primary selection.
231 Note that MS-Windows does not support selection types other than the
232 clipboard. (The primary selection that is set by Emacs is not
233 accessible to other programs on MS-Windows.)
235 This variable is not used by the Nextstep port."
239 (defun x-select-text (text)
240 "Select TEXT, a string, according to the window system.
242 On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the
243 clipboard. If `x-select-enable-primary' is non-nil, put TEXT in
244 the primary selection.
246 On MS-Windows, make TEXT the current selection. If
247 `x-select-enable-clipboard' is non-nil, copy the text to the
250 On Nextstep, put TEXT in the pasteboard (`x-select-enable-clipboard'
252 (if x-select-enable-clipboard
253 (w16-set-clipboard-data text
))
254 (setq x-last-selected-text text
))
256 (defun x-get-selection-value ()
257 "Return the value of the current selection.
258 Consult the selection. Treat empty strings as if they were unset."
259 (if x-select-enable-clipboard
261 ;; Don't die if x-get-selection signals an error.
262 (with-demoted-errors "w16-get-clipboard-data:%s"
263 (setq text
(w16-get-clipboard-data)))
264 (if (string= text
"") (setq text nil
))
267 ((eq text x-last-selected-text
) nil
)
268 ((string= text x-last-selected-text
)
269 ;; Record the newer string, so subsequent calls can use the 'eq' test.
270 (setq x-last-selected-text text
)
273 (setq x-last-selected-text text
))))))
275 ;; x-selection-owner-p is used in simple.el.
276 (defun x-selection-owner-p (&optional _selection _terminal
)
277 "Whether the current Emacs process owns the given X Selection.
278 The arg should be the name of the selection in question, typically one of
279 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
280 \(Those are literal upper-case symbol names, since that's what X expects.)
281 For convenience, the symbol nil is the same as `PRIMARY',
282 and t is the same as `SECONDARY'.
284 TERMINAL should be a terminal object or a frame specifying the X
285 server to query. If omitted or nil, that stands for the selected
286 frame's display, or the first available X display.
288 On Nextstep, TERMINAL is unused.
290 \(fn &optional SELECTION TERMINAL)"
291 (if x-select-enable-clipboard
293 ;; Don't die if w16-get-clipboard-data signals an error.
295 (setq text
(w16-get-clipboard-data)))
296 ;; We consider ourselves the owner of the selection if it does
297 ;; not exist, or exists and compares equal with the last text
298 ;; we've put into the Windows clipboard.
301 ((or (eq text x-last-selected-text
)
302 (string= text x-last-selected-text
))
306 ;; x-own-selection-internal and x-disown-selection-internal are used
307 ;; in select.el:x-set-selection.
308 (defun x-own-selection-internal (_selection value
&optional _frame
)
309 "Assert an X selection of the type SELECTION with and value VALUE.
310 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
311 \(Those are literal upper-case symbol names, since that's what X expects.)
312 VALUE is typically a string, or a cons of two markers, but may be
313 anything that the functions on `selection-converter-alist' know about.
315 FRAME should be a frame that should own the selection. If omitted or
316 nil, it defaults to the selected frame.
318 On Nextstep, FRAME is unused.
320 \(fn SELECTION VALUE &optional FRAME)"
322 (x-select-text value
))
325 (defun x-disown-selection-internal (selection &optional _time-object _terminal
)
326 "If we own the selection SELECTION, disown it.
327 Disowning it means there is no such selection.
329 Sets the last-change time for the selection to TIME-OBJECT (by default
330 the time of the last event).
332 TERMINAL should be a terminal object or a frame specifying the X
333 server to query. If omitted or nil, that stands for the selected
334 frame's display, or the first available X display.
336 On Nextstep, the TIME-OBJECT and TERMINAL arguments are unused.
337 On MS-DOS, all this does is return non-nil if we own the selection.
339 \(fn SELECTION &optional TIME-OBJECT TERMINAL)"
340 (if (x-selection-owner-p selection
)
343 ;; x-get-selection-internal is used in select.el
344 (defun x-get-selection-internal (_selection-symbol _target-type
345 &optional _time-stamp _terminal
)
346 "Return text selected from some X window.
347 SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
348 \(Those are literal upper-case symbol names, since that's what X expects.)
349 TARGET-TYPE is the type of data desired, typically `STRING'.
351 TIME-STAMP is the time to use in the XConvertSelection call for foreign
352 selections. If omitted, defaults to the time for the last event.
354 TERMINAL should be a terminal object or a frame specifying the X
355 server to query. If omitted or nil, that stands for the selected
356 frame's display, or the first available X display.
358 On Nextstep, TIME-STAMP and TERMINAL are unused.
360 \(fn SELECTION-SYMBOL TARGET-TYPE &optional TIME-STAMP TERMINAL)"
361 (x-get-selection-value))
363 ;; From src/fontset.c:
364 (fset 'query-fontset
'ignore
)
366 ;; From lisp/term/x-win.el: make iconify-or-deiconify-frame a no-op.
367 (fset 'iconify-or-deiconify-frame
'ignore
)
369 ;; From lisp/frame.el
370 (fset 'set-default-font
'ignore
)
371 (fset 'set-mouse-color
'ignore
) ; We cannot, I think.
372 (fset 'set-cursor-color
'ignore
) ; Hardware determined by char under.
373 (fset 'set-border-color
'ignore
) ; Not useful.
375 (defvar msdos-last-help-message nil
376 "The last help message received via `show-help-function'.
377 This is used by `msdos-show-help'.")
379 (defvar msdos-previous-message nil
380 "The content of the echo area before help echo was displayed.")
382 (defun msdos-show-help (help)
383 "Function installed as `show-help-function' on MS-DOS frames."
384 (when (and (not (window-minibuffer-p)) ;Don't overwrite minibuffer contents.
385 (not cursor-in-echo-area
)) ;Don't overwrite a prompt.
388 (setq help
(replace-regexp-in-string "\n" ", " help
))
389 (unless (or msdos-previous-message
390 (string-equal help
(current-message))
391 (and (stringp msdos-last-help-message
)
392 (string-equal msdos-last-help-message
394 (setq msdos-previous-message
(current-message)))
395 (setq msdos-last-help-message help
)
396 (let ((message-truncate-lines nil
)
397 (message-log-max nil
))
398 (message "%s" help
)))
399 ((stringp msdos-previous-message
)
400 (let ((message-log-max nil
))
401 (message "%s" msdos-previous-message
)
402 (setq msdos-previous-message nil
)))
408 ;; ---------------------------------------------------------------------------
409 ;; This function is run, by faces.el:tty-create-frame-with-faces, only
410 ;; for the initial frame (on each terminal, but we have only one).
411 ;; This works by setting the `terminal-initted' terminal parameter to
412 ;; this function, the first time `tty-create-frame-with-faces' is
413 ;; called on that terminal. `tty-create-frame-with-faces' is called
414 ;; directly from startup.el and also by `make-frame' through
415 ;; `frame-creation-function-alist'. `make-frame' will call this
416 ;; function if `msdos-create-frame-with-faces' (see below) is not
417 ;; found in `frame-creation-function-alist', which means something is
418 ;; _very_ wrong, because "internal" terminal emulator should not be
419 ;; turned on if our window-system is not `pc'. Therefore, the only
420 ;; Right Thing for us to do here is scream bloody murder.
421 (defun terminal-init-internal ()
422 "Terminal initialization function for the MS-DOS \"internal\" terminal.
423 Errors out because it is not supposed to be called, ever."
424 (error "terminal-init-internal called for window-system `%s'"
427 (defun msdos-initialize-window-system (&optional _display
)
428 "Initialization function for the `pc' \"window system\"."
429 (or (eq (window-system) 'pc
)
431 "`msdos-initialize-window-system' called, but window-system is `%s'"
433 ;; First, the keyboard.
434 (msdos-setup-keyboard terminal-frame
) ; see internal.el
435 ;; Next, register the default colors.
436 (let* ((colors msdos-color-values
)
437 (color (car colors
)))
440 (tty-color-define (car color
) (cadr color
) (cddr color
))
441 (setq colors
(cdr colors
) color
(car colors
))))
442 ;; Modifying color mappings means realized faces don't
443 ;; use the right colors, so clear them.
445 ;; Now set up some additional faces.
447 ;; Set up the initial frame.
448 (msdos-setup-initial-frame)
449 ;; Help echo is displayed in the echo area.
450 (setq show-help-function
'msdos-show-help
)
451 ;; We want to delay the codepage-related setup until after user's
452 ;; .emacs is processed, because people might define their
453 ;; `dos-codepage-setup-hook' there.
454 (add-hook 'after-init-hook
'dos-codepage-setup
)
455 ;; In multibyte mode, we want unibyte buffers to be displayed
456 ;; using the terminal coding system, so that they display
457 ;; correctly on the DOS terminal; in unibyte mode we want to see
458 ;; all 8-bit characters verbatim. In both cases, we want the
459 ;; entire range of 8-bit characters to arrive at our display code
461 (standard-display-8bit 127 255)
462 ;; We are fast enough to make this optimization unnecessary.
463 (setq split-window-keep-point t
)
464 ;; Arrange for the kill and yank functions to set and check the
466 (setq interprogram-cut-function
'x-select-text
)
467 (setq interprogram-paste-function
'x-get-selection-value
)
468 (menu-bar-enable-clipboard)
469 (run-hooks 'terminal-init-msdos-hook
))
471 ;; frame-creation-function-alist is examined by frame.el:make-frame.
472 (add-to-list 'frame-creation-function-alist
473 '(pc . msdos-create-frame-with-faces
))
474 ;; window-system-initialization-alist is examined by startup.el:command-line.
475 (add-to-list 'window-system-initialization-alist
476 '(pc . msdos-initialize-window-system
))
477 ;; We don't need anything beyond tty-handle-args for handling
478 ;; command-line argument; see startup.el.
479 (add-to-list 'handle-args-function-alist
'(pc . tty-handle-args
))
481 ;; ---------------------------------------------------------------------------
485 ;;; pc-win.el ends here