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