Commit | Line | Data |
---|---|---|
ef88bd2d MW |
1 | ;; pc-win.el -- setup support for `PC windows' (whatever that is). |
2 | ||
3 | ;; Copyright (C) 1994 Free Software Foundation, Inc. | |
4 | ||
5 | ;; Author: Morten Welinder <terra@diku.dk> | |
6 | ;; Version: 1,00 | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
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) | |
13 | ;; any later version. | |
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 | |
2fe590dc EN |
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. | |
24 | ||
25 | ;;; Code: | |
26 | ||
ef88bd2d MW |
27 | (load "term/internal" nil t) |
28 | ||
29 | ;; Color translation -- doesn't really need to be fast | |
30 | ||
31 | (defvar msdos-color-aliases | |
32 | '(("purple" . "magenta") | |
33 | ("firebrick" . "red") ; ? | |
34 | ("pink" . "lightred") | |
35 | ("royalblue" . "blue") | |
36 | ("cadetblue" . "blue") | |
37 | ("forestgreen" . "green") | |
38 | ("darkolivegreen" . "green") | |
39 | ("darkgoldenrod" . "brown") | |
40 | ("goldenrod" . "yellow") | |
41 | ("grey40" . "darkgray") | |
bb3a4574 RS |
42 | ("dark gray" . "darkgray") |
43 | ("light gray" . "lightgray") | |
ea6401d7 RS |
44 | ("rosybrown" . "brown") |
45 | ("blue" . "lightblue") ;; from here: for Enriched Text | |
46 | ("darkslategray" . "darkgray") | |
47 | ("orange" . "brown") | |
48 | ("light blue" . "lightblue") ;; from here: for cpp-highlight | |
49 | ("light cyan" . "lightcyan") | |
50 | ("light yellow" . "yellow") | |
51 | ("light pink" . "lightred") | |
52 | ("pale green" . "lightgreen") | |
53 | ("beige" . "brown") | |
54 | ("medium purple" . "magenta") | |
55 | ("turquoise" . "lightgreen") | |
56 | ("violet" . "magenta")) | |
ef88bd2d MW |
57 | "List of alternate names for colors.") |
58 | ||
59 | (defun msdos-color-translate (name) | |
60 | (setq name (downcase name)) | |
61 | (let* ((len (length name)) | |
bb3a4574 RS |
62 | (val (- (length x-colors) |
63 | (length (member name x-colors)))) | |
ef88bd2d | 64 | (try)) |
bb3a4574 | 65 | (if (or (< val 0) (>= val (length x-colors))) (setq val nil)) |
ef88bd2d MW |
66 | (or val |
67 | (and (setq try (cdr (assoc name msdos-color-aliases))) | |
68 | (msdos-color-translate try)) | |
69 | (and (> len 5) | |
70 | (string= "light" (substring name 0 4)) | |
71 | (setq try (msdos-color-translate (substring name 5))) | |
72 | (logior try 8)) | |
73 | (and (> len 6) | |
74 | (string= "light " (substring name 0 5)) | |
75 | (setq try (msdos-color-translate (substring name 6))) | |
76 | (logior try 8)) | |
77 | (and (> len 4) | |
78 | (string= "dark" (substring name 0 3)) | |
79 | (msdos-color-translate (substring name 4))) | |
80 | (and (> len 5) | |
81 | (string= "dark " (substring name 0 4)) | |
82 | (msdos-color-translate (substring name 5)))))) | |
83 | ;; --------------------------------------------------------------------------- | |
84 | ;; We want to delay setting frame parameters until the faces are setup | |
85 | (defvar default-frame-alist nil) | |
86 | ||
87 | (defun msdos-face-setup () | |
88 | (modify-frame-parameters (selected-frame) default-frame-alist) | |
89 | ||
ea6401d7 | 90 | (set-face-foreground 'bold "yellow") |
ef88bd2d | 91 | (set-face-foreground 'italic "red") |
ea6401d7 RS |
92 | (set-face-foreground 'bold-italic "lightred") |
93 | (set-face-foreground 'underline "white") | |
ef88bd2d MW |
94 | (set-face-background 'region "green") |
95 | ||
96 | (make-face 'msdos-menu-active-face) | |
97 | (make-face 'msdos-menu-passive-face) | |
98 | (make-face 'msdos-menu-select-face) | |
99 | (set-face-foreground 'msdos-menu-active-face "white") | |
100 | (set-face-foreground 'msdos-menu-passive-face "lightgray") | |
101 | (set-face-background 'msdos-menu-active-face "blue") | |
102 | (set-face-background 'msdos-menu-passive-face "blue") | |
103 | (set-face-background 'msdos-menu-select-face "red")) | |
104 | ||
105 | ;; We have only one font, so... | |
106 | (add-hook 'before-init-hook 'msdos-face-setup) | |
107 | ;; --------------------------------------------------------------------------- | |
a7acbbe4 | 108 | ;; More or less useful imitations of certain X-functions. A lot of the |
ef88bd2d MW |
109 | ;; values returned are questionable, but usually only the form of the |
110 | ;; returned value matters. Also, by the way, recall that `ignore' is | |
111 | ;; a useful function for returning 'nil regardless of argument. | |
112 | ||
113 | ;; From src/xfns.c | |
beb4ba68 | 114 | (defun x-display-color-p (&optional display) 't) |
ef88bd2d MW |
115 | (fset 'focus-frame 'ignore) |
116 | (fset 'unfocus-frame 'ignore) | |
117 | (defun x-list-fonts (pattern &optional face frame) (list "default")) | |
118 | (defun x-color-defined-p (color) (numberp (msdos-color-translate color))) | |
119 | (defun x-display-pixel-width (&optional frame) (* 8 (frame-width frame))) | |
120 | (defun x-display-pixel-height (&optional frame) (* 8 (frame-height frame))) | |
121 | (defun x-display-planes (&optional frame) 4) ; 3 for background, actually | |
122 | (defun x-display-color-cells (&optional frame) 16) ; ??? | |
123 | (defun x-server-max-request-size (&optional frame) 1000000) ; ??? | |
124 | (defun x-server-vendor (&optional frame) t "GNU") | |
125 | (defun x-server-version (&optional frame) '(1 0 0)) | |
126 | (defun x-display-screens (&optional frame) 1) | |
127 | (defun x-display-mm-height (&optional frame) 200) ; Guess the size of my | |
128 | (defun x-display-mm-width (&optional frame) 253) ; monitor, MW... | |
129 | (defun x-display-backing-store (&optional frame) 'not-useful) | |
130 | (defun x-display-visual-class (&optional frame) 'static-color) | |
131 | (fset 'x-display-save-under 'ignore) | |
132 | (fset 'x-get-resource 'ignore) | |
133 | ||
134 | ;; From lisp/term/x-win.el | |
135 | (setq x-display-name "pc") | |
136 | (setq split-window-keep-point t) | |
bb3a4574 RS |
137 | (defvar x-colors '("black" |
138 | "blue" | |
139 | "green" | |
140 | "cyan" | |
141 | "red" | |
142 | "magenta" | |
143 | "brown" | |
144 | "lightgray" | |
145 | "darkgray" | |
146 | "lightblue" | |
147 | "lightgreen" | |
148 | "lightcyan" | |
149 | "lightred" | |
150 | "lightmagenta" | |
151 | "yellow" | |
152 | "white") | |
153 | "The list of colors available on a PC display under MS-DOS.") | |
154 | (defun x-defined-colors (&optional frame) | |
155 | "Return a list of colors supported for a particular frame. | |
156 | The argument FRAME specifies which frame to try. | |
157 | The value may be different for frames on different X displays." | |
158 | x-colors) | |
159 | ; | |
ef88bd2d MW |
160 | ;; From lisp/select.el |
161 | (defun x-get-selection (&rest rest) "") | |
162 | (fset 'x-set-selection 'ignore) | |
163 | ||
ea6401d7 RS |
164 | ;; From lisp/faces.el: we only have one font, so always return |
165 | ;; it, no matter which variety they've asked for. | |
166 | (defun x-frob-font-slant (font which) | |
167 | font) | |
168 | ||
ef88bd2d MW |
169 | ;; From lisp/frame.el |
170 | (fset 'set-default-font 'ignore) | |
171 | (fset 'set-mouse-color 'ignore) ; We cannot, I think. | |
172 | (fset 'set-cursor-color 'ignore) ; Hardware determined by char under. | |
173 | (fset 'set-border-color 'ignore) ; Not useful. | |
174 | (fset 'auto-raise-mode 'ignore) | |
175 | (fset 'auto-lower-mode 'ignore) | |
176 | (defun set-background-color (color-name) | |
177 | "Set the background color of the selected frame to COLOR. | |
178 | When called interactively, prompt for the name of the color to use." | |
179 | (interactive "sColor: ") | |
180 | (modify-frame-parameters (selected-frame) | |
181 | (list (cons 'background-color color-name)))) | |
182 | (defun set-foreground-color (color-name) | |
183 | "Set the foreground color of the selected frame to COLOR. | |
184 | When called interactively, prompt for the name of the color to use." | |
185 | (interactive "sColor: ") | |
186 | (modify-frame-parameters (selected-frame) | |
187 | (list (cons 'foreground-color color-name)))) | |
188 | ;; --------------------------------------------------------------------------- | |
189 | ;; Handle the X-like command line parameters "-fg" and "-bg" | |
190 | (defun msdos-handle-args (args) | |
191 | (let ((rest nil)) | |
192 | (while args | |
193 | (let ((this (car args))) | |
194 | (setq args (cdr args)) | |
195 | (cond ((or (string= this "-fg") (string= this "-foreground")) | |
196 | (if args | |
197 | (setq default-frame-alist | |
198 | (cons (cons 'foreground-color (car args)) | |
199 | default-frame-alist) | |
200 | args (cdr args)))) | |
201 | ((or (string= this "-bg") (string= this "-background")) | |
202 | (if args | |
203 | (setq default-frame-alist | |
204 | (cons (cons 'background-color (car args)) | |
205 | default-frame-alist) | |
206 | args (cdr args)))) | |
207 | (t (setq rest (cons this rest)))))) | |
208 | (nreverse rest))) | |
209 | ||
210 | (setq command-line-args (msdos-handle-args command-line-args)) | |
211 | ;; --------------------------------------------------------------------------- | |
212 | (require 'faces) | |
213 | (if (msdos-mouse-p) | |
214 | (progn | |
215 | (require 'menu-bar) | |
216 | (menu-bar-mode t))) |