lisp/term/pc-win.el

   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 the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Code:
  26
  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")
  42     ("dark gray"      . "darkgray")
  43     ("light gray"     . "lightgray")
  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"))
  57   "List of alternate names for colors.")
  58
  59 (defun msdos-color-translate (name)
  60   (setq name (downcase name))
  61   (let* ((len (length name))
  62          (val (- (length x-colors)
  63                  (length (member name x-colors))))
  64          (try))
  65     (if (or (< val 0) (>= val (length x-colors))) (setq val nil))
  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
  90   (set-face-foreground 'bold "yellow")
  91   (set-face-foreground 'italic "red")
  92   (set-face-foreground 'bold-italic "lightred")
  93   (set-face-foreground 'underline "white")
  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 ;; ---------------------------------------------------------------------------
 108 ;; More or less useful imitations of certain X-functions.  A lot of the
 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
 114 (defun x-display-color-p (&optional display) 't)
 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)
 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 ;
 160 ;; From lisp/select.el
 161 (defun x-get-selection (&rest rest) "")
 162 (fset 'x-set-selection 'ignore)
 163
 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
 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)))