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