1 ;; pc-win.el -- setup support for `PC windows' (whatever that is).
3 ;; Copyright (C) 1994, 1996 Free Software Foundation, Inc.
5 ;; Author: Morten Welinder <terra@diku.dk>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
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.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
27 (load "term/internal" nil t
)
29 ;; Color translation -- doesn't really need to be fast.
30 ;; Colors listed here do not include the "light-",
31 ;; "medium-" and "dark-" prefixes that are accounted for
32 ;; by `msdos-color-translate', which see below).
34 (defvar msdos-color-aliases
36 ("ghost white" .
"white")
37 ("ghostwhite" .
"white")
38 ("white smoke" .
"white")
39 ("whitesmoke" .
"white")
40 ("gainsboro" .
"white")
41 ("floral white" .
"white")
42 ("floralwhite" .
"white")
43 ("old lace" .
"white")
46 ("antique white" .
"white")
47 ("antiquewhite" .
"white")
48 ("papaya whip" .
"white")
49 ("papayawhip" .
"white")
50 ("blanched almond" .
"white")
51 ("blanchedalmond" .
"white")
53 ("peach puff" .
"lightred")
54 ("peachpuff" .
"lightred")
55 ("navajo white" .
"lightred")
56 ("navajowhite" .
"lightred")
57 ("moccasin" .
"lightred")
58 ("cornsilk" .
"white")
60 ("lemon chiffon" .
"yellow")
61 ("lemonchiffon" .
"yellow")
62 ("seashell" .
"white")
63 ("honeydew" .
"white")
64 ("mint cream" .
"white")
65 ("mintcream" .
"white")
66 ("azure" .
"lightcyan")
67 ("alice blue" .
"lightcyan")
68 ("aliceblue" .
"lightcyan")
69 ("lavender" .
"lightcyan")
70 ("lavender blush" .
"lightcyan")
71 ("lavenderblush" .
"lightcyan")
72 ("misty rose" .
"lightred")
73 ("mistyrose" .
"lightred")
74 ("aquamarine" .
"blue")
75 ("cadet blue" .
"blue")
76 ("cadetblue" .
"blue")
77 ("cornflower blue" .
"lightblue")
78 ("cornflowerblue" .
"lightblue")
79 ("midnight blue" .
"blue")
80 ("midnightblue" .
"blue")
81 ("navy blue" .
"cyan")
84 ("sky blue" .
"lightblue")
85 ("skyblue" .
"lightblue")
86 ("dodger blue" .
"blue")
87 ("dodgerblue" .
"blue")
88 ("powder blue" .
"lightblue")
89 ("powderblue" .
"lightblue")
90 ("slate blue" .
"cyan")
91 ("slateblue" .
"cyan")
92 ("steel blue" .
"blue")
93 ("steelblue" .
"blue")
94 ("coral" .
"lightred")
97 ("goldenrod" .
"yellow")
98 ("pale goldenrod" .
"yellow")
99 ("palegoldenrod" .
"yellow")
100 ("olive green" .
"lightgreen")
101 ("olivegreen" .
"lightgreen")
102 ("olive drab" .
"green")
103 ("olivedrab" .
"green")
104 ("forest green" .
"green")
105 ("forestgreen" .
"green")
106 ("lime green" .
"lightgreen")
107 ("limegreen" .
"lightgreen")
108 ("sea green" .
"lightcyan")
109 ("seagreen" .
"lightcyan")
110 ("spring green" .
"green")
111 ("springgreen" .
"green")
112 ("pale green" .
"lightgreen")
113 ("palegreen" .
"lightgreen")
114 ("lawn green" .
"lightgreen")
115 ("lawngreen" .
"lightgreen")
116 ("chartreuse" .
"yellow")
117 ("yellow green" .
"lightgreen")
118 ("yellowgreen" .
"lightgreen")
119 ("green yellow" .
"lightgreen")
120 ("greenyellow" .
"lightgreen")
121 ("slate grey" .
"lightgray")
122 ("slategrey" .
"lightgray")
123 ("slate gray" .
"lightgray")
124 ("slategray" .
"lightgray")
125 ("dim grey" .
"darkgray")
126 ("dimgrey" .
"darkgray")
127 ("dim gray" .
"darkgray")
128 ("dimgray" .
"darkgray")
129 ("light grey" .
"lightgray")
130 ("lightgrey" .
"lightgray")
131 ("light gray" .
"lightgray")
132 ("gray" .
"darkgray")
133 ("grey" .
"darkgray")
134 ("gray80" .
"darkgray")
136 ("gray90" .
"darkgray")
141 ("saddle brown" .
"red")
142 ("saddlebrown" .
"red")
145 ("pink" .
"lightred")
147 ("indian red" .
"red")
148 ("indianred" .
"red")
149 ("violet red" .
"magenta")
150 ("violetred" .
"magenta")
151 ("orange red" .
"red")
152 ("orangered" .
"red")
153 ("salmon" .
"lightred")
154 ("sienna" .
"lightred")
156 ("thistle" .
"magenta")
157 ("turquoise" .
"lightgreen")
158 ("pale turquoise" .
"cyan")
159 ("paleturquoise" .
"cyan")
160 ("violet" .
"magenta")
161 ("blue violet" .
"lightmagenta")
162 ("blueviolet" .
"lightmagenta")
164 ("green yellow" .
"yellow")
165 ("greenyellow" .
"yellow")
166 ("purple" .
"magenta")
167 ("royalblue" .
"blue")
168 ("grey40" .
"darkgray")
169 ("rosybrown" .
"brown")
170 ("rosy brown" .
"brown")
172 "List of alternate names for colors.")
174 (defun msdos-color-translate (name)
175 (setq name
(downcase name
))
176 (let* ((len (length name
))
177 (val (- (length x-colors
)
178 (length (member name x-colors
))))
180 (if (or (< val
0) (>= val
(length x-colors
))) (setq val nil
))
182 (and (setq try
(cdr (assoc name msdos-color-aliases
)))
183 (msdos-color-translate try
))
185 (string= "light" (substring name
0 5))
186 (setq try
(msdos-color-translate (substring name
5)))
189 (string= "light " (substring name
0 6))
190 (setq try
(msdos-color-translate (substring name
6)))
193 (string= "medium" (substring name
0 6))
194 (msdos-color-translate (substring name
6)))
196 (string= "medium " (substring name
0 7))
197 (msdos-color-translate (substring name
7)))
199 (string= "dark" (substring name
0 4))
200 (msdos-color-translate (substring name
4)))
202 (string= "dark " (substring name
0 5))
203 (msdos-color-translate (substring name
5))))))
204 ;; ---------------------------------------------------------------------------
205 ;; We want to delay setting frame parameters until the faces are setup
206 (defvar default-frame-alist nil
)
207 (modify-frame-parameters terminal-frame default-frame-alist
)
209 (defun msdos-face-setup ()
210 (modify-frame-parameters terminal-frame default-frame-alist
)
212 (set-face-foreground 'bold
"yellow" terminal-frame
)
213 (set-face-foreground 'italic
"red" terminal-frame
)
214 (set-face-foreground 'bold-italic
"lightred" terminal-frame
)
215 (set-face-foreground 'underline
"white" terminal-frame
)
216 (set-face-background 'region
"green" terminal-frame
)
218 (make-face 'msdos-menu-active-face
)
219 (make-face 'msdos-menu-passive-face
)
220 (make-face 'msdos-menu-select-face
)
221 (set-face-foreground 'msdos-menu-active-face
"white" terminal-frame
)
222 (set-face-foreground 'msdos-menu-passive-face
"lightgray" terminal-frame
)
223 (set-face-background 'msdos-menu-active-face
"blue" terminal-frame
)
224 (set-face-background 'msdos-menu-passive-face
"blue" terminal-frame
)
225 (set-face-background 'msdos-menu-select-face
"red" terminal-frame
))
227 ;; We have only one font, so...
228 (add-hook 'before-init-hook
'msdos-face-setup
)
230 ;; We create frames as if we were a terminal, but with a twist.
231 (defun make-msdos-frame (&optional parameters
)
233 (append initial-frame-alist default-frame-alist parameters nil
)))
234 (make-terminal-frame parms
)))
236 (setq frame-creation-function
'make-msdos-frame
)
238 ;; ---------------------------------------------------------------------------
239 ;; More or less useful imitations of certain X-functions. A lot of the
240 ;; values returned are questionable, but usually only the form of the
241 ;; returned value matters. Also, by the way, recall that `ignore' is
242 ;; a useful function for returning 'nil regardless of argument.
245 (defun x-display-color-p (&optional display
) 't
)
246 (defun x-list-fonts (pattern &optional face frame
) (list "default"))
247 (defun x-color-defined-p (color) (numberp (msdos-color-translate color
)))
248 (defun x-display-pixel-width (&optional frame
) (frame-width frame
))
249 (defun x-display-pixel-height (&optional frame
) (frame-height frame
))
250 (defun x-display-planes (&optional frame
) 4) ; 3 for background, actually
251 (defun x-display-color-cells (&optional frame
) 16) ; ???
252 (defun x-server-max-request-size (&optional frame
) 1000000) ; ???
253 (defun x-server-vendor (&optional frame
) t
"GNU")
254 (defun x-server-version (&optional frame
) '(1 0 0))
255 (defun x-display-screens (&optional frame
) 1)
256 (defun x-display-mm-height (&optional frame
) 200) ; Guess the size of my
257 (defun x-display-mm-width (&optional frame
) 253) ; monitor, MW...
258 (defun x-display-backing-store (&optional frame
) 'not-useful
)
259 (defun x-display-visual-class (&optional frame
) 'static-color
)
260 (fset 'x-display-save-under
'ignore
)
261 (fset 'x-get-resource
'ignore
)
263 ;; From lisp/term/x-win.el
264 (setq x-display-name
"pc")
265 (setq split-window-keep-point t
)
266 (defvar x-colors
'("black"
282 "The list of colors available on a PC display under MS-DOS.")
283 (defun x-defined-colors (&optional frame
)
284 "Return a list of colors supported for a particular frame.
285 The argument FRAME specifies which frame to try.
286 The value may be different for frames on different X displays."
289 ;; From lisp/select.el
290 (defun x-get-selection (&rest rest
) "")
291 (fset 'x-set-selection
'ignore
)
293 ;; From lisp/faces.el: we only have one font, so always return
294 ;; it, no matter which variety they've asked for.
295 (defun x-frob-font-slant (font which
)
298 ;; From lisp/frame.el
299 (fset 'set-default-font
'ignore
)
300 (fset 'set-mouse-color
'ignore
) ; We cannot, I think.
301 (fset 'set-cursor-color
'ignore
) ; Hardware determined by char under.
302 (fset 'set-border-color
'ignore
) ; Not useful.
303 ;; ---------------------------------------------------------------------------
304 ;; Handle the X-like command line parameters "-fg" and "-bg"
305 (defun msdos-handle-args (args)
308 (let ((this (car args
)))
309 (setq args
(cdr args
))
310 (cond ((or (string= this
"-fg") (string= this
"-foreground"))
312 (setq default-frame-alist
313 (cons (cons 'foreground-color
(car args
))
316 ((or (string= this
"-bg") (string= this
"-background"))
318 (setq default-frame-alist
319 (cons (cons 'background-color
(car args
))
322 (t (setq rest
(cons this rest
))))))
325 (setq command-line-args
(msdos-handle-args command-line-args
))
326 ;; ---------------------------------------------------------------------------