diff options
| author | Eli Zaretskii | 2008-08-23 17:01:46 +0000 |
|---|---|---|
| committer | Eli Zaretskii | 2008-08-23 17:01:46 +0000 |
| commit | cbcc5ad47d6a1498e3588cb626fba4a4d7ee90de (patch) | |
| tree | 065aceb53dd5acd52d42aa491b6a0546717e1830 | |
| parent | d8dbc0d041e73f55c0a36bfc72a3ce5b9d5249b3 (diff) | |
| download | emacs-cbcc5ad47d6a1498e3588cb626fba4a4d7ee90de.tar.gz emacs-cbcc5ad47d6a1498e3588cb626fba4a4d7ee90de.zip | |
(msdos-create-frame-with-faces): Renamed from make-msdos-frame.
(terminal-init-internal): New function, errors out if called.
(msdos-initialize-window-system): New function.
(msdos-create-frame-with-faces): Set the terminal's `terminal-initted' (sic!)
parameter.
(frame-creation-function-alist): Add msdos-create-frame-with-faces.
(window-system-initialization-alist): Add msdos-initialize-window-system.
(handle-args-function-alist): Use tty-handle-args for `pc' ``window system''
as well.
(pc-win): Provide.
| -rw-r--r-- | lisp/term/pc-win.el | 125 |
1 files changed, 106 insertions, 19 deletions
diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el index c04815ef8e2..3fcada3c973 100644 --- a/lisp/term/pc-win.el +++ b/lisp/term/pc-win.el | |||
| @@ -23,15 +23,30 @@ | |||
| 23 | 23 | ||
| 24 | ;;; Commentary: | 24 | ;;; Commentary: |
| 25 | 25 | ||
| 26 | ;; This file is preloaded into Emacs by loadup.el. The functions in | ||
| 27 | ;; this file are then called during startup from startup.el. This | ||
| 28 | ;; means that just loading this file should not have any side effects | ||
| 29 | ;; besides defining functions and variables, and in particular should | ||
| 30 | ;; NOT initialize any window systems. | ||
| 31 | |||
| 32 | ;; The main entry points to this file's features are msdos-handle-args, | ||
| 33 | ;; msdos-create-frame-with-faces, msdos-initialize-window-system, | ||
| 34 | ;; terminal-init-internal. The last one is not supposed to be called, | ||
| 35 | ;; so it just errors out. | ||
| 36 | |||
| 26 | ;;; Code: | 37 | ;;; Code: |
| 27 | 38 | ||
| 39 | (if (not (fboundp 'msdos-remember-default-colors)) | ||
| 40 | (error "%s: Loading pc-win.el but not compiled for MS-DOS" | ||
| 41 | (invocation-name))) | ||
| 42 | |||
| 28 | (load "term/internal" nil t) | 43 | (load "term/internal" nil t) |
| 29 | 44 | ||
| 30 | (declare-function msdos-remember-default-colors "msdos.c") | 45 | (declare-function msdos-remember-default-colors "msdos.c") |
| 31 | (declare-function w16-set-clipboard-data "w16select.c") | 46 | (declare-function w16-set-clipboard-data "w16select.c") |
| 32 | (declare-function w16-get-clipboard-data "w16select.c") | 47 | (declare-function w16-get-clipboard-data "w16select.c") |
| 33 | 48 | ||
| 34 | ;;; This is copied from etc/rgb.txt, except that some values were changed | 49 | ;;; This was copied from etc/rgb.txt, except that some values were changed |
| 35 | ;;; a bit to make them consistent with DOS console colors, and the RGB | 50 | ;;; a bit to make them consistent with DOS console colors, and the RGB |
| 36 | ;;; values were scaled up to 16 bits, as `tty-define-color' requires. | 51 | ;;; values were scaled up to 16 bits, as `tty-define-color' requires. |
| 37 | ;;; | 52 | ;;; |
| @@ -67,10 +82,10 @@ | |||
| 67 | ;; --------------------------------------------------------------------------- | 82 | ;; --------------------------------------------------------------------------- |
| 68 | ;; We want to delay setting frame parameters until the faces are setup | 83 | ;; We want to delay setting frame parameters until the faces are setup |
| 69 | (defvar default-frame-alist nil) | 84 | (defvar default-frame-alist nil) |
| 70 | (modify-frame-parameters terminal-frame default-frame-alist) | 85 | ;(modify-frame-parameters terminal-frame default-frame-alist) |
| 71 | (tty-color-clear) | ||
| 72 | 86 | ||
| 73 | (defun msdos-face-setup () | 87 | (defun msdos-face-setup () |
| 88 | "Set up initial faces for the MS-DOS display." | ||
| 74 | (set-face-foreground 'bold "yellow" terminal-frame) | 89 | (set-face-foreground 'bold "yellow" terminal-frame) |
| 75 | (set-face-foreground 'italic "red" terminal-frame) | 90 | (set-face-foreground 'italic "red" terminal-frame) |
| 76 | (set-face-foreground 'bold-italic "lightred" terminal-frame) | 91 | (set-face-foreground 'bold-italic "lightred" terminal-frame) |
| @@ -85,8 +100,6 @@ | |||
| 85 | (set-face-background 'msdos-menu-passive-face "blue" terminal-frame) | 100 | (set-face-background 'msdos-menu-passive-face "blue" terminal-frame) |
| 86 | (set-face-background 'msdos-menu-select-face "red" terminal-frame)) | 101 | (set-face-background 'msdos-menu-select-face "red" terminal-frame)) |
| 87 | 102 | ||
| 88 | (add-hook 'before-init-hook 'msdos-face-setup) | ||
| 89 | |||
| 90 | (defun msdos-handle-reverse-video (frame parameters) | 103 | (defun msdos-handle-reverse-video (frame parameters) |
| 91 | "Handle the reverse-video frame parameter on MS-DOS frames." | 104 | "Handle the reverse-video frame parameter on MS-DOS frames." |
| 92 | (when (cdr (or (assq 'reverse parameters) | 105 | (when (cdr (or (assq 'reverse parameters) |
| @@ -103,8 +116,7 @@ | |||
| 103 | 116 | ||
| 104 | ;; This must run after all the default colors are inserted into | 117 | ;; This must run after all the default colors are inserted into |
| 105 | ;; tty-color-alist, since msdos-handle-reverse-video needs to know the | 118 | ;; tty-color-alist, since msdos-handle-reverse-video needs to know the |
| 106 | ;; actual frame colors. tty-color-alist is set up by startup.el, but | 119 | ;; actual frame colors. |
| 107 | ;; only after it runs before-init-hook and after-init-hook. | ||
| 108 | (defun msdos-setup-initial-frame () | 120 | (defun msdos-setup-initial-frame () |
| 109 | (modify-frame-parameters terminal-frame default-frame-alist) | 121 | (modify-frame-parameters terminal-frame default-frame-alist) |
| 110 | ;; This remembers the screen colors after applying default-frame-alist, | 122 | ;; This remembers the screen colors after applying default-frame-alist, |
| @@ -117,23 +129,29 @@ | |||
| 117 | (frame-set-background-mode terminal-frame) | 129 | (frame-set-background-mode terminal-frame) |
| 118 | (face-set-after-frame-default terminal-frame)) | 130 | (face-set-after-frame-default terminal-frame)) |
| 119 | 131 | ||
| 120 | (add-hook 'term-setup-hook 'msdos-setup-initial-frame) | 132 | ;; We create frames as if we were a terminal, but without invoking the |
| 121 | 133 | ;; terminal-initialization function. Also, our handling of reverse | |
| 122 | ;; We create frames as if we were a terminal, but with a twist. | 134 | ;; video is slightly different. |
| 123 | (defun make-msdos-frame (&optional parameters) | 135 | (defun msdos-create-frame-with-faces (&optional parameters) |
| 136 | "Create an frame on MS-DOS display. | ||
| 137 | Optional frame parameters PARAMETERS specify the frame parameters. | ||
| 138 | Parameters not specified by PARAMETERS are taken from | ||
| 139 | `default-frame-alist'. If either PARAMETERS or `default-frame-alist' | ||
| 140 | contains a `reverse' parameter, handle that. Value is the new frame | ||
| 141 | created." | ||
| 124 | (let ((frame (make-terminal-frame parameters)) | 142 | (let ((frame (make-terminal-frame parameters)) |
| 125 | success) | 143 | success) |
| 126 | (unwind-protect | 144 | (unwind-protect |
| 127 | (progn | 145 | (with-selected-frame frame |
| 128 | (msdos-handle-reverse-video frame (frame-parameters frame)) | 146 | (msdos-handle-reverse-video frame (frame-parameters frame)) |
| 147 | (unless (terminal-parameter frame 'terminal-initted) | ||
| 148 | (set-terminal-parameter frame 'terminal-initted t)) | ||
| 129 | (frame-set-background-mode frame) | 149 | (frame-set-background-mode frame) |
| 130 | (face-set-after-frame-default frame) | 150 | (face-set-after-frame-default frame) |
| 131 | (setq success t)) | 151 | (setq success t)) |
| 132 | (unless success (delete-frame frame))) | 152 | (unless success (delete-frame frame))) |
| 133 | frame)) | 153 | frame)) |
| 134 | 154 | ||
| 135 | (add-to-list 'frame-creation-function-alist '(pc . make-msdos-frame)) | ||
| 136 | |||
| 137 | ;; --------------------------------------------------------------------------- | 155 | ;; --------------------------------------------------------------------------- |
| 138 | ;; More or less useful imitations of certain X-functions. A lot of the | 156 | ;; More or less useful imitations of certain X-functions. A lot of the |
| 139 | ;; values returned are questionable, but usually only the form of the | 157 | ;; values returned are questionable, but usually only the form of the |
| @@ -163,7 +181,6 @@ | |||
| 163 | ;; From lisp/term/x-win.el | 181 | ;; From lisp/term/x-win.el |
| 164 | (defvar x-display-name "pc" | 182 | (defvar x-display-name "pc" |
| 165 | "The display name specifying the MS-DOS display and frame type.") | 183 | "The display name specifying the MS-DOS display and frame type.") |
| 166 | (setq split-window-keep-point t) | ||
| 167 | (defvar x-colors (mapcar 'car msdos-color-values) | 184 | (defvar x-colors (mapcar 'car msdos-color-values) |
| 168 | "The list of colors available on a PC display under MS-DOS.") | 185 | "The list of colors available on a PC display under MS-DOS.") |
| 169 | 186 | ||
| @@ -209,10 +226,6 @@ support other types of selections." | |||
| 209 | (t | 226 | (t |
| 210 | (setq x-last-selected-text text)))))) | 227 | (setq x-last-selected-text text)))))) |
| 211 | 228 | ||
| 212 | ;;; Arrange for the kill and yank functions to set and check the clipboard. | ||
| 213 | (setq interprogram-cut-function 'x-select-text) | ||
| 214 | (setq interprogram-paste-function 'x-get-selection-value) | ||
| 215 | |||
| 216 | ;; From lisp/faces.el: we only have one font, so always return | 229 | ;; From lisp/faces.el: we only have one font, so always return |
| 217 | ;; it, no matter which variety they've asked for. | 230 | ;; it, no matter which variety they've asked for. |
| 218 | (defun x-frob-font-slant (font which) | 231 | (defun x-frob-font-slant (font which) |
| @@ -241,7 +254,81 @@ are fixed-pitch." | |||
| 241 | (fset 'set-cursor-color 'ignore) ; Hardware determined by char under. | 254 | (fset 'set-cursor-color 'ignore) ; Hardware determined by char under. |
| 242 | (fset 'set-border-color 'ignore) ; Not useful. | 255 | (fset 'set-border-color 'ignore) ; Not useful. |
| 243 | 256 | ||
| 257 | ;; Initialization. | ||
| 244 | ;; --------------------------------------------------------------------------- | 258 | ;; --------------------------------------------------------------------------- |
| 259 | ;; This function is run, by faces.el:tty-create-frame-with-faces, only | ||
| 260 | ;; for the initial frame (on each terminal, but we have only one). | ||
| 261 | ;; This works by setting the `terminal-initted' terminal parameter to | ||
| 262 | ;; this function, the first time `tty-create-frame-with-faces' is | ||
| 263 | ;; called on that terminal. `tty-create-frame-with-faces' is called | ||
| 264 | ;; directly from startup.el and also by `make-frame' through | ||
| 265 | ;; `frame-creation-function-alist'. `make-frame' will call this | ||
| 266 | ;; function if `msdos-create-frame-with-faces' (see below) is not | ||
| 267 | ;; found in `frame-creation-function-alist', which means something is | ||
| 268 | ;; _very_ wrong, because "internal" terminal emulator should not be | ||
| 269 | ;; turned on if our window-system is not `pc'. Therefore, the only | ||
| 270 | ;; Right Thing for us to do here is scream bloody murder. | ||
| 271 | (defun terminal-init-internal () | ||
| 272 | "Terminal initialization function for the MS-DOS \"internal\" terminal. | ||
| 273 | Errors out because it is not supposed to be called, ever." | ||
| 274 | (error "terminal-init-internal called for window-system `%s'" | ||
| 275 | (window-system))) | ||
| 276 | |||
| 277 | (defun msdos-initialize-window-system () | ||
| 278 | "Initialization function for the `pc' \"window system\"." | ||
| 279 | (or (eq (window-system) 'pc) | ||
| 280 | (error | ||
| 281 | "`msdos-initialize-window-system' called, but window-system is `%s'" | ||
| 282 | (window-system))) | ||
| 283 | ;; First, the keyboard. | ||
| 284 | (msdos-setup-keyboard terminal-frame) ; see internal.el | ||
| 285 | ;; Next, register the default colors. | ||
| 286 | (let* ((colors msdos-color-values) | ||
| 287 | (color (car colors))) | ||
| 288 | (tty-color-clear) | ||
| 289 | (while colors | ||
| 290 | (tty-color-define (car color) (cadr color) (cddr color)) | ||
| 291 | (setq colors (cdr colors) color (car colors)))) | ||
| 292 | ;; Modifying color mappings means realized faces don't | ||
| 293 | ;; use the right colors, so clear them. | ||
| 294 | (clear-face-cache) | ||
| 295 | ;; Now set up some additional faces. | ||
| 296 | (msdos-face-setup) | ||
| 297 | ;; Set up the initial frame. | ||
| 298 | (msdos-setup-initial-frame) | ||
| 299 | ;; We want to delay the codepage-related setup until after user's | ||
| 300 | ;; .emacs is processed, because people might define their | ||
| 301 | ;; `dos-codepage-setup-hook' there. | ||
| 302 | (add-hook 'after-init-hook 'dos-codepage-setup) | ||
| 303 | ;; In multibyte mode, we want unibyte buffers to be displayed | ||
| 304 | ;; using the terminal coding system, so that they display | ||
| 305 | ;; correctly on the DOS terminal; in unibyte mode we want to see | ||
| 306 | ;; all 8-bit characters verbatim. In both cases, we want the | ||
| 307 | ;; entire range of 8-bit characters to arrive at our display code | ||
| 308 | ;; verbatim. | ||
| 309 | (standard-display-8bit 127 255) | ||
| 310 | ;; We are fast enough to make this optimization unnecessary. | ||
| 311 | (setq split-window-keep-point t) | ||
| 312 | ;; Arrange for the kill and yank functions to set and check the | ||
| 313 | ;; clipboard. | ||
| 314 | (setq interprogram-cut-function 'x-select-text) | ||
| 315 | (setq interprogram-paste-function 'x-get-selection-value) | ||
| 316 | (menu-bar-enable-clipboard) | ||
| 317 | (run-hooks 'terminal-init-msdos-hook)) | ||
| 318 | |||
| 319 | ;; frame-creation-function-alist is examined by frame.el:make-frame. | ||
| 320 | (add-to-list 'frame-creation-function-alist | ||
| 321 | '(pc . msdos-create-frame-with-faces)) | ||
| 322 | ;; window-system-initialization-alist is examined by startup.el:command-line. | ||
| 323 | (add-to-list 'window-system-initialization-alist | ||
| 324 | '(pc . msdos-initialize-window-system)) | ||
| 325 | ;; We don't need anything beyond tty-handle-args for handling | ||
| 326 | ;; command-line argument; see startup.el. | ||
| 327 | (add-to-list 'handle-args-function-alist '(pc . tty-handle-args)) | ||
| 328 | |||
| 329 | ;; --------------------------------------------------------------------------- | ||
| 330 | |||
| 331 | (provide 'pc-win) | ||
| 245 | 332 | ||
| 246 | ;; arch-tag: 5cbdb455-b495-427b-95d0-e417d77d00b4 | 333 | ;; arch-tag: 5cbdb455-b495-427b-95d0-e417d77d00b4 |
| 247 | ;;; pc-win.el ends here | 334 | ;;; pc-win.el ends here |