From b0512a1d7926fc8d5a1d9deb06050e354268989c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 7 May 2011 18:44:19 +0300 Subject: [PATCH] Fix bug #8597 with setting frame background mode on w32 console. src/w32console.c (Fset_screen_color): Doc fix. (Fget_screen_color): New function. (syms_of_ntterm): Defsubr it. lisp/term/w32console.el (terminal-init-w32console): Call get-screen-color and use its output to set the frame background-mode. --- lisp/ChangeLog | 6 ++++++ lisp/term/w32console.el | 13 +++++++++++++ src/ChangeLog | 4 ++++ src/w32console.c | 17 ++++++++++++++++- 4 files changed, 39 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3cf8e13614..62a11b31e5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2011-05-07 Eli Zaretskii + + * term/w32console.el (terminal-init-w32console): Call + get-screen-color and use its output to set the frame + background-mode. (Bug#8597) + 2011-05-07 Stefan Monnier Make bytecomp.el understand that defmethod defines funs (bug#8631). diff --git a/lisp/term/w32console.el b/lisp/term/w32console.el index 6072613841..8bfde0bae1 100644 --- a/lisp/term/w32console.el +++ b/lisp/term/w32console.el @@ -59,6 +59,19 @@ (setq colors (cdr colors) color (car colors)))) (clear-face-cache) + ;; Figure out what are the colors of the console window, and set up + ;; the background-mode correspondingly. + (let* ((screen-color (get-screen-color)) + (bg (cadr screen-color)) + (descr (tty-color-by-index bg)) + r g b bg-mode) + (setq r (nth 2 descr) + g (nth 3 descr) + b (nth 4 descr)) + (if (< (+ r g b) (* .6 (+ 65535 65535 65535))) + (setq bg-mode 'dark) + (setq bg-mode 'light)) + (set-terminal-parameter nil 'background-mode bg-mode)) (tty-set-up-initial-frame-faces) (run-hooks 'terminal-init-w32-hook)) diff --git a/src/ChangeLog b/src/ChangeLog index 394b7a172f..10ca2e250d 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,9 @@ 2011-05-07 Eli Zaretskii + * w32console.c (Fset_screen_color): Doc fix. + (Fget_screen_color): New function. + (syms_of_ntterm): Defsubr it. + * callproc.c (call_process_cleanup): Don't close and unlink the temporary file if Fcall_process didn't create it in the first place. diff --git a/src/w32console.c b/src/w32console.c index 3c200405cb..49bf56ddee 100644 --- a/src/w32console.c +++ b/src/w32console.c @@ -705,7 +705,9 @@ initialize_w32_display (struct terminal *term) DEFUN ("set-screen-color", Fset_screen_color, Sset_screen_color, 2, 2, 0, - doc: /* Set screen colors. */) + doc: /* Set screen foreground and background colors. + +Arguments should be indices between 0 and 15, see w32console.el. */) (Lisp_Object foreground, Lisp_Object background) { char_attr_normal = XFASTINT (foreground) + (XFASTINT (background) << 4); @@ -714,6 +716,18 @@ DEFUN ("set-screen-color", Fset_screen_color, Sset_screen_color, 2, 2, 0, return Qt; } +DEFUN ("get-screen-color", Fget_screen_color, Sget_screen_color, 0, 0, 0, + doc: /* Get color indices of the current screen foreground and background. + +The colors are returned as a list of 2 indices (FOREGROUND BACKGROUND). +See w32console.el and `tty-defined-color-alist' for mapping of indices +to colors. */) + (void) +{ + return Fcons (make_number (char_attr_normal & 0x000f), + Fcons (make_number ((char_attr_normal >> 4) & 0x000f), Qnil)); +} + DEFUN ("set-cursor-size", Fset_cursor_size, Sset_cursor_size, 1, 1, 0, doc: /* Set cursor size. */) (Lisp_Object size) @@ -739,6 +753,7 @@ scroll-back buffer. */); w32_use_full_screen_buffer = 0; defsubr (&Sset_screen_color); + defsubr (&Sget_screen_color); defsubr (&Sset_cursor_size); defsubr (&Sset_message_beep); } -- 2.20.1