Mercurial > hg > xemacs-beta

comparison src/console.c @ 272:c5d627a313b1 r21-0b34

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents 727739f917cb
children c42ec1d1cded
comparison
equal deleted inserted replaced
271:c7b7086b0a39 272:c5d627a313b1
47 47
48 /* This structure holds the default values of the console-local 48 /* This structure holds the default values of the console-local
49 variables defined with DEFVAR_CONSOLE_LOCAL, that have special 49 variables defined with DEFVAR_CONSOLE_LOCAL, that have special
50 slots in each console. The default value occupies the same slot 50 slots in each console. The default value occupies the same slot
51 in this structure as an individual console's value occupies in 51 in this structure as an individual console's value occupies in
52 that console. Setting the default value also goes through the alist 52 that console. Setting the default value also goes through the
53 of consoles and stores into each console that does not say it has a 53 list of consoles and stores into each console that does not say
54 local value. */ 54 it has a local value. */
55 Lisp_Object Vconsole_defaults; 55 Lisp_Object Vconsole_defaults;
56 56
57 /* This structure marks which slots in a console have corresponding 57 /* This structure marks which slots in a console have corresponding
58 default values in console_defaults. 58 default values in console_defaults.
59 Each such slot has a nonzero value in this structure. 59 Each such slot has a nonzero value in this structure.
90 90
91 DEFINE_CONSOLE_TYPE (dead); 91 DEFINE_CONSOLE_TYPE (dead);
92 92
93 Lisp_Object Vconsole_type_list; 93 Lisp_Object Vconsole_type_list;
94 94
95 MAC_DEFINE (struct console *, MTconsole_data)
96 MAC_DEFINE (struct console_methods *, MTcontype_meth_or_given)
97
98 console_type_entry_dynarr *the_console_type_entry_dynarr; 95 console_type_entry_dynarr *the_console_type_entry_dynarr;
99 96
100 97
101 static Lisp_Object mark_console (Lisp_Object, void (*) (Lisp_Object));
102 static void print_console (Lisp_Object, Lisp_Object, int);
103 DEFINE_LRECORD_IMPLEMENTATION ("console", console,
104 mark_console, print_console, 0, 0, 0,
105 struct console);
106
107 static Lisp_Object 98 static Lisp_Object
108 mark_console (Lisp_Object obj, void (*markobj) (Lisp_Object)) 99 mark_console (Lisp_Object obj, void (*markobj) (Lisp_Object))
109 { 100 {
110 struct console *con = XCONSOLE (obj); 101 struct console *con = XCONSOLE (obj);
111 102
143 } 134 }
144 sprintf (buf, " 0x%x>", con->header.uid); 135 sprintf (buf, " 0x%x>", con->header.uid);
145 write_c_string (buf, printcharfun); 136 write_c_string (buf, printcharfun);
146 } 137 }
147 138
139 DEFINE_LRECORD_IMPLEMENTATION ("console", console,
140 mark_console, print_console, 0, 0, 0,
141 struct console);
148 142
149 static struct console * 143 static struct console *
150 allocate_console (void) 144 allocate_console (void)
151 { 145 {
152 Lisp_Object console = Qnil; 146 Lisp_Object console;
153 struct console *con = alloc_lcrecord_type (struct console, lrecord_console); 147 struct console *con = alloc_lcrecord_type (struct console, lrecord_console);
154 struct gcpro gcpro1; 148 struct gcpro gcpro1;
155 149
156 copy_lcrecord (con, XCONSOLE (Vconsole_defaults)); 150 copy_lcrecord (con, XCONSOLE (Vconsole_defaults));
157 151
183 decode_console_type (Lisp_Object type, Error_behavior errb) 177 decode_console_type (Lisp_Object type, Error_behavior errb)
184 { 178 {
185 int i; 179 int i;
186 180
187 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++) 181 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++)
188 { 182 if (EQ (type, Dynarr_at (the_console_type_entry_dynarr, i).symbol))
189 if (EQ (type, Dynarr_at (the_console_type_entry_dynarr, i).symbol)) 183 return Dynarr_at (the_console_type_entry_dynarr, i).meths;
190 return Dynarr_at (the_console_type_entry_dynarr, i).meths;
191 }
192 184
193 maybe_signal_simple_error ("Invalid console type", type, Qconsole, errb); 185 maybe_signal_simple_error ("Invalid console type", type, Qconsole, errb);
194 186
195 return 0; 187 return 0;
196 } 188 }
197 189
198 int 190 int
199 valid_console_type_p (Lisp_Object type) 191 valid_console_type_p (Lisp_Object type)
200 { 192 {
201 if (decode_console_type (type, ERROR_ME_NOT)) 193 return decode_console_type (type, ERROR_ME_NOT) != 0;
202 return 1;
203 return 0;
204 } 194 }
205 195
206 DEFUN ("valid-console-type-p", Fvalid_console_type_p, 1, 1, 0, /* 196 DEFUN ("valid-console-type-p", Fvalid_console_type_p, 1, 1, 0, /*
207 Given a CONSOLE-TYPE, return t if it is valid. 197 Given a CONSOLE-TYPE, return t if it is valid.
208 Valid types are 'x, 'tty, and 'stream. 198 Valid types are 'x, 'tty, and 'stream.
209 */ 199 */
210 (console_type)) 200 (console_type))
211 { 201 {
212 if (valid_console_type_p (console_type)) 202 return valid_console_type_p (console_type) ? Qt : Qnil;
213 return Qt;
214 else
215 return Qnil;
216 } 203 }
217 204
218 DEFUN ("console-type-list", Fconsole_type_list, 0, 0, 0, /* 205 DEFUN ("console-type-list", Fconsole_type_list, 0, 0, 0, /*
219 Return a list of valid console types. 206 Return a list of valid console types.
220 */ 207 */
304 DEFUN ("consolep", Fconsolep, 1, 1, 0, /* 291 DEFUN ("consolep", Fconsolep, 1, 1, 0, /*
305 Return non-nil if OBJECT is a console. 292 Return non-nil if OBJECT is a console.
306 */ 293 */
307 (object)) 294 (object))
308 { 295 {
309 if (!CONSOLEP (object)) 296 return CONSOLEP (object) ? Qt : Qnil;
310 return Qnil;
311 return Qt;
312 } 297 }
313 298
314 DEFUN ("console-live-p", Fconsole_live_p, 1, 1, 0, /* 299 DEFUN ("console-live-p", Fconsole_live_p, 1, 1, 0, /*
315 Return non-nil if OBJECT is a console that has not been deleted. 300 Return non-nil if OBJECT is a console that has not been deleted.
316 */ 301 */
317 (object)) 302 (object))
318 { 303 {
319 if (!CONSOLEP (object) || !CONSOLE_LIVE_P (XCONSOLE (object))) 304 return CONSOLEP (object) && CONSOLE_LIVE_P (XCONSOLE (object)) ? Qt : Qnil;
320 return Qnil;
321 return Qt;
322 } 305 }
323 306
324 DEFUN ("console-type", Fconsole_type, 0, 1, 0, /* 307 DEFUN ("console-type", Fconsole_type, 0, 1, 0, /*
325 Return the type of the specified console (e.g. `x' or `tty'). 308 Return the type of the specified console (e.g. `x' or `tty').
326 Value is `tty' for a tty console (a character-only terminal), 309 Value is `tty' for a tty console (a character-only terminal),
357 { 340 {
358 return CONSOLE_CONNECTION (decode_console (console)); 341 return CONSOLE_CONNECTION (decode_console (console));
359 } 342 }
360 343
361 Lisp_Object 344 Lisp_Object
362 make_console (struct console *c) 345 make_console (struct console *con)
363 { 346 {
364 Lisp_Object console = Qnil; 347 Lisp_Object console;
365 XSETCONSOLE (console, c); 348 XSETCONSOLE (console, con);
366 return console; 349 return console;
367 } 350 }
368 351
369 static Lisp_Object 352 static Lisp_Object
370 semi_canonicalize_console_connection (struct console_methods *meths, 353 semi_canonicalize_console_connection (struct console_methods *meths,
416 399
417 GCPRO1 (canon); 400 GCPRO1 (canon);
418 401
419 if (!NILP (type)) 402 if (!NILP (type))
420 { 403 {
421 struct console_methods *conmeths = decode_console_type (type, 404 struct console_methods *conmeths = decode_console_type (type, ERROR_ME);
422 ERROR_ME);
423 canon = canonicalize_console_connection (conmeths, connection, 405 canon = canonicalize_console_connection (conmeths, connection,
424 ERROR_ME_NOT); 406 ERROR_ME_NOT);
425 if (UNBOUNDP (canon)) 407 if (UNBOUNDP (canon))
426 RETURN_UNGCPRO (Qnil); 408 RETURN_UNGCPRO (Qnil);
427 409
475 create_console (Lisp_Object name, Lisp_Object type, Lisp_Object connection, 457 create_console (Lisp_Object name, Lisp_Object type, Lisp_Object connection,
476 Lisp_Object props) 458 Lisp_Object props)
477 { 459 {
478 /* This function can GC */ 460 /* This function can GC */
479 struct console *con; 461 struct console *con;
480 Lisp_Object console = Qnil; 462 Lisp_Object console;
481 struct gcpro gcpro1; 463 struct gcpro gcpro1;
482
483 GCPRO1 (console);
484 464
485 console = Ffind_console (connection, type); 465 console = Ffind_console (connection, type);
486 if (!NILP (console)) 466 if (!NILP (console))
487 RETURN_UNGCPRO (console); 467 return console;
488 468
489 con = allocate_console (); 469 con = allocate_console ();
490 XSETCONSOLE (console, con); 470 XSETCONSOLE (console, con);
471
472 GCPRO1 (console);
491 473
492 con->conmeths = decode_console_type (type, ERROR_ME); 474 con->conmeths = decode_console_type (type, ERROR_ME);
493 475
494 CONSOLE_NAME (con) = name; 476 CONSOLE_NAME (con) = name;
495 CONSOLE_CONNECTION (con) = 477 CONSOLE_CONNECTION (con) =
599 void 581 void
600 delete_console_internal (struct console *con, int force, 582 delete_console_internal (struct console *con, int force,
601 int called_from_kill_emacs, int from_io_error) 583 int called_from_kill_emacs, int from_io_error)
602 { 584 {
603 /* This function can GC */ 585 /* This function can GC */
604 Lisp_Object console = Qnil; 586 Lisp_Object console;
605 struct gcpro gcpro1; 587 struct gcpro gcpro1;
606 588
607 /* OK to delete an already-deleted console. */ 589 /* OK to delete an already-deleted console. */
608 if (!CONSOLE_LIVE_P (con)) 590 if (!CONSOLE_LIVE_P (con))
609 return; 591 return;
792 This generally means that there is support for the mouse, the menubar, 774 This generally means that there is support for the mouse, the menubar,
793 the toolbar, glyphs, etc. 775 the toolbar, glyphs, etc.
794 */ 776 */
795 (console)) 777 (console))
796 { 778 {
797 struct console *con = decode_console (console); 779 Lisp_Object type = CONSOLE_TYPE (decode_console (console));
798 780
799 if (EQ (CONSOLE_TYPE (con), Qtty) || EQ (CONSOLE_TYPE (con), Qstream)) 781 return !EQ (type, Qtty) && !EQ (type, Qstream) ? Qt : Qnil;
800 return Qnil;
801 return Qt;
802 } 782 }
803 783
804 784
805 785
806 /**********************************************************************/ 786 /**********************************************************************/
810 static Lisp_Object 790 static Lisp_Object
811 unwind_init_sys_modes (Lisp_Object console) 791 unwind_init_sys_modes (Lisp_Object console)
812 { 792 {
813 reinit_initial_console (); 793 reinit_initial_console ();
814 794
815 if (!no_redraw_on_reenter) 795 if (!no_redraw_on_reenter &&
816 { 796 CONSOLEP (console) &&
817 if (CONSOLEP (console) && CONSOLE_LIVE_P (XCONSOLE (console))) 797 CONSOLE_LIVE_P (XCONSOLE (console)))
818 MARK_FRAME_CHANGED 798 {
819 (XFRAME (DEVICE_SELECTED_FRAME 799 struct frame *f =
820 (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (console)))))); 800 XFRAME (DEVICE_SELECTED_FRAME
801 (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (console)))));
802 MARK_FRAME_CHANGED (f);
821 } 803 }
822 return Qnil; 804 return Qnil;
823 } 805 }
824 806
825 DEFUN ("suspend-emacs", Fsuspend_emacs, 0, 1, "", /* 807 DEFUN ("suspend-emacs", Fsuspend_emacs, 0, 1, "", /*
908 stuff_char (XCONSOLE (Vcontrolling_terminal), *kbd_fetch_ptr++); 890 stuff_char (XCONSOLE (Vcontrolling_terminal), *kbd_fetch_ptr++);
909 } 891 }
910 # endif 892 # endif
911 #endif /* BSD */ 893 #endif /* BSD */
912 } 894 }
913 #ifdef HAVE_TTY
914 extern Lisp_Object Fconsole_tty_controlling_process(Lisp_Object console);
915 #endif
916 895
917 DEFUN ("suspend-console", Fsuspend_console, 0, 1, "", /* 896 DEFUN ("suspend-console", Fsuspend_console, 0, 1, "", /*
918 Suspend a console. For tty consoles, it sends a signal to suspend 897 Suspend a console. For tty consoles, it sends a signal to suspend
919 the process in charge of the tty, and removes the devices and 898 the process in charge of the tty, and removes the devices and
920 frames of that console from the display. 899 frames of that console from the display.
926 On such systems, who knows what will happen. 905 On such systems, who knows what will happen.
927 */ 906 */
928 (console)) 907 (console))
929 { 908 {
930 #ifdef HAVE_TTY 909 #ifdef HAVE_TTY
931 struct console *c; 910 struct console *con = decode_console (console);
932 911
933 c = decode_console (console); 912 if (CONSOLE_TTY_P (con))
934 913 {
935 if (CONSOLE_TTY_P (c)) 914 /*
936 { 915 * hide all the unhidden frames so the display code won't update
937 /* 916 * them while the console is suspended.
938 * hide all the unhidden frames so the display code won't update 917 */
939 * them while the console is suspended. 918 Lisp_Object device = CONSOLE_SELECTED_DEVICE (con);
940 */ 919 if (!NILP (device))
941 Lisp_Object device = CONSOLE_SELECTED_DEVICE (c); 920 {
942 if (!NILP (device)) 921 struct device *d = XDEVICE (device);
943 { 922 Lisp_Object frame_list = DEVICE_FRAME_LIST (d);
944 struct device *d = XDEVICE (device); 923 while (CONSP (frame_list))
945 Lisp_Object frame_list = DEVICE_FRAME_LIST (d); 924 {
946 while (CONSP (frame_list)) 925 struct frame *f = XFRAME (XCAR (frame_list));
947 { 926 if (FRAME_REPAINT_P (f))
948 struct frame *f = XFRAME (XCAR (frame_list)); 927 f->visible = -1;
949 if (FRAME_REPAINT_P (f)) 928 frame_list = XCDR (frame_list);
950 f->visible = -1; 929 }
951 frame_list = XCDR (frame_list); 930 }
952 } 931 reset_one_console (con);
953 } 932 event_stream_unselect_console (con);
954 reset_one_console (c); 933 sys_suspend_process (XINT (Fconsole_tty_controlling_process (console)));
955 event_stream_unselect_console (c); 934 }
956 sys_suspend_process(XINT(Fconsole_tty_controlling_process(console))); 935 #endif /* HAVE_TTY */
957 } 936
958 937 return Qnil;
938 }
939
940 DEFUN ("resume-console", Fresume_console, 1, 1, "", /*
941 Re-initialize a previously suspended console.
942 For tty consoles, do stuff to the tty to make it sane again.
943 */
944 (console))
945 {
946 #ifdef HAVE_TTY
947 struct console *con = decode_console (console);
948
949 if (CONSOLE_TTY_P (con))
950 {
951 /* raise the selected frame */
952 Lisp_Object device = CONSOLE_SELECTED_DEVICE (con);
953 if (!NILP (device))
954 {
955 struct device *d = XDEVICE (device);
956 Lisp_Object frame = DEVICE_SELECTED_FRAME (d);
957 if (!NILP (frame))
958 {
959 /* force the frame to be cleared */
960 SET_FRAME_CLEAR (XFRAME (frame));
961 Fraise_frame (frame);
962 }
963 }
964 init_one_console (con);
965 event_stream_select_console (con);
966 #ifdef SIGWINCH
967 /* The same as in Fsuspend_emacs: it is possible that a size
968 change occurred while we were suspended. Assume one did just
969 to be safe. It won't hurt anything if one didn't. */
970 asynch_device_change_pending++;
959 #endif 971 #endif
960 return Qnil; 972 }
961 } 973 #endif /* HAVE_TTY */
962 974
963 DEFUN ("resume-console", Fresume_console, 1, 1, "", /*
964 Re-initialize a previously suspended console. For tty consoles,
965 do stuff to the tty to make it sane again.
966 */
967 (console))
968 {
969 #ifdef HAVE_TTY
970 struct console *c;
971
972 c = decode_console (console);
973
974 if (CONSOLE_TTY_P (c))
975 {
976 /* raise the selected frame */
977 Lisp_Object device = CONSOLE_SELECTED_DEVICE (c);
978 if (!NILP (device))
979 {
980 struct device *d = XDEVICE (device);
981 Lisp_Object frame = DEVICE_SELECTED_FRAME (d);
982 if (!NILP (frame))
983 {
984 /* force the frame to be cleared */
985 SET_FRAME_CLEAR (XFRAME (frame));
986 Fraise_frame (frame);
987 }
988 }
989 init_one_console (c);
990 event_stream_select_console (c);
991 #ifdef SIGWINCH
992 /* The same as in Fsuspend_emacs: it is possible that a size
993 change occurred while we were suspended. Assume one did just
994 to be safe. It won't hurt anything if one didn't. */
995 asynch_device_change_pending++;
996 #endif
997 }
998
999 #endif
1000 return Qnil; 975 return Qnil;
1001 } 976 }
1002 977
1003 DEFUN ("set-input-mode", Fset_input_mode, 3, 5, 0, /* 978 DEFUN ("set-input-mode", Fset_input_mode, 3, 5, 0, /*
1004 Set mode of reading keyboard input. 979 Set mode of reading keyboard input.
1015 See also `current-input-mode'. 990 See also `current-input-mode'.
1016 */ 991 */
1017 (ignored, flow, meta, quit, console)) 992 (ignored, flow, meta, quit, console))
1018 { 993 {
1019 struct console *con = decode_console (console); 994 struct console *con = decode_console (console);
1020 int meta_key = 1; 995 int meta_key = (!CONSOLE_TTY_P (con) ? 1 :
1021 996 EQ (meta, Qnil) ? 0 :
1022 if (CONSOLE_TTY_P (con)) 997 EQ (meta, Qt) ? 1 :
1023 { 998 2);
1024 if (NILP (meta))
1025 meta_key = 0;
1026 else if (EQ (meta, Qt))
1027 meta_key = 1;
1028 else
1029 meta_key = 2;
1030 }
1031 999
1032 if (!NILP (quit)) 1000 if (!NILP (quit))
1033 { 1001 {
1034 CHECK_CHAR_COERCE_INT (quit); 1002 CHECK_CHAR_COERCE_INT (quit);
1035 CONSOLE_QUIT_CHAR (con) = 1003 CONSOLE_QUIT_CHAR (con) =
1036 ((unsigned int) XCHAR (quit)) & (meta_key ? 0377 : 0177); 1004 ((unsigned int) XCHAR (quit)) & (meta_key ? 0377 : 0177);
1037 } 1005 }
1038 1006
1007 #ifdef HAVE_TTY
1039 if (CONSOLE_TTY_P (con)) 1008 if (CONSOLE_TTY_P (con))
1040 { 1009 {
1041 reset_one_console (con); 1010 reset_one_console (con);
1042 TTY_FLAGS (con).flow_control = !NILP (flow); 1011 TTY_FLAGS (con).flow_control = !NILP (flow);
1043 TTY_FLAGS (con).meta_key = meta_key; 1012 TTY_FLAGS (con).meta_key = meta_key;
1044 init_one_console (con); 1013 init_one_console (con);
1045 } 1014 }
1015 #endif
1046 1016
1047 return Qnil; 1017 return Qnil;
1048 } 1018 }
1049 1019
1050 DEFUN ("current-input-mode", Fcurrent_input_mode, 0, 1, 0, /* 1020 DEFUN ("current-input-mode", Fcurrent_input_mode, 0, 1, 0, /*
1063 The elements of this list correspond to the arguments of 1033 The elements of this list correspond to the arguments of
1064 `set-input-mode'. 1034 `set-input-mode'.
1065 */ 1035 */
1066 (console)) 1036 (console))
1067 { 1037 {
1068 Lisp_Object val[4];
1069 struct console *con = decode_console (console); 1038 struct console *con = decode_console (console);
1070 1039 Lisp_Object flow, meta, quit;
1071 val[0] = Qnil; 1040
1072 val[1] = CONSOLE_TTY_P (con) && TTY_FLAGS (con).flow_control ? Qt : Qnil; 1041 #ifdef HAVE_TTY
1073 val[2] = (!CONSOLE_TTY_P (con) || TTY_FLAGS (con).meta_key == 1) ? 1042 flow = CONSOLE_TTY_P (con) && TTY_FLAGS (con).flow_control ? Qt : Qnil;
1074 Qt : TTY_FLAGS (con).meta_key == 2 ? Qzero : Qnil; 1043 meta = (!CONSOLE_TTY_P (con) ? Qt :
1075 val[3] = make_char (CONSOLE_QUIT_CHAR (con)); 1044 TTY_FLAGS (con).meta_key == 1 ? Qt :
1076 1045 TTY_FLAGS (con).meta_key == 2 ? Qzero :
1077 return Flist (sizeof (val) / sizeof (val[0]), val); 1046 Qnil);
1047 #else
1048 flow = Qnil;
1049 meta = Qt;
1050 #endif
1051 quit = make_char (CONSOLE_QUIT_CHAR (con));
1052
1053 return list4 (Qnil, flow, meta, quit);
1078 } 1054 }
1079 1055
1080 1056
1081 /************************************************************************/ 1057 /************************************************************************/
1082 /* initialization */ 1058 /* initialization */
1197 #define DEFVAR_CONST_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun) do { \ 1173 #define DEFVAR_CONST_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun) do { \
1198 static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ 1174 static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \
1199 = { { { symbol_value_forward_lheader_initializer, \ 1175 = { { { symbol_value_forward_lheader_initializer, \
1200 (struct lcrecord_header *) &(console_local_flags.field_name), 69 }, \ 1176 (struct lcrecord_header *) &(console_local_flags.field_name), 69 }, \
1201 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD }, magicfun }; \ 1177 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD }, magicfun }; \
1202 defvar_console_local ((lname), &I_hate_C); \ 1178 defvar_console_local ((lname), &I_hate_C); \
1203 } while (0) 1179 } while (0)
1204 1180
1205 #define DEFVAR_CONSOLE_DEFAULTS(lname, field_name) do { \ 1181 #define DEFVAR_CONSOLE_DEFAULTS(lname, field_name) do { \
1206 static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ 1182 static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \
1207 = { { { symbol_value_forward_lheader_initializer, \ 1183 = { { { symbol_value_forward_lheader_initializer, \