aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorEli Zaretskii2013-05-16 12:58:56 +0300
committerEli Zaretskii2013-05-16 12:58:56 +0300
commita9519e2685d19b13ce4e3e1ba13f97569013627e (patch)
tree6a9e0e35514c400749f23c891e9a95577fb9bfc1 /src
parent3946d31b7bcf2a7dceacb86598823360f457cd19 (diff)
parent2d4bf34b5b83b3728b2fb18a72536f3e14afcf34 (diff)
downloademacs-a9519e2685d19b13ce4e3e1ba13f97569013627e.tar.gz
emacs-a9519e2685d19b13ce4e3e1ba13f97569013627e.zip
Merge from trunk.
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog28
-rw-r--r--src/Makefile.in2
-rw-r--r--src/doc.c4
-rw-r--r--src/lisp.h6
-rw-r--r--src/lread.c2
-rw-r--r--src/makefile.w32-in2
-rw-r--r--src/process.c454
7 files changed, 270 insertions, 228 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 0b4ccb0708a..c45ec824919 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,33 @@
12013-05-15 Stefan Monnier <monnier@iro.umontreal.ca> 12013-05-15 Stefan Monnier <monnier@iro.umontreal.ca>
2 2
3 * makefile.w32-in (DOC): Use just "DOC".
4
5 * Makefile.in (bootstrap-clean): DOC-* doesn't exist any more.
6
7 * process.c: Export default filters and sentinels to Elisp.
8 (Qinternal_default_process_sentinel, Qinternal_default_process_filter):
9 New constants.
10 (pset_filter, pset_sentinel, make_process, Fset_process_filter)
11 (Fset_process_sentinel, Fformat_network_address):
12 Default to them instead of nil.
13 (server_accept_connection): Sentinels can't be nil any more.
14 (read_and_dispose_of_process_output): New function, extracted from
15 read_process_output.
16 (read_process_output): Use it; filters can't be nil.
17 (Finternal_default_process_filter): New function, extracted from
18 read_process_output.
19 (exec_sentinel_unwind): Remove function.
20 (exec_sentinel): Don't zilch sentinel while running.
21 (status_notify): Sentinels can't be nil.
22 (Finternal_default_process_sentinel): New function extracted from
23 status_notify.
24 (setup_process_coding_systems): Default filter is not nil any more.
25 (syms_of_process): Export new Elisp functions and initialize
26 new constants.
27 * lisp.h (make_lisp_proc): New function.
28
292013-05-15 Stefan Monnier <monnier@iro.umontreal.ca>
30
3 * regex.c (regex_compile) [\=, \>, \<]: Don't forget to set laststart. 31 * regex.c (regex_compile) [\=, \>, \<]: Don't forget to set laststart.
4 32
52013-05-14 Eli Zaretskii <eliz@gnu.org> 332013-05-14 Eli Zaretskii <eliz@gnu.org>
diff --git a/src/Makefile.in b/src/Makefile.in
index 2e1764723ec..c7a18363a5a 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -555,7 +555,7 @@ clean: mostlyclean
555## It should remove all files generated during a compilation/bootstrap, 555## It should remove all files generated during a compilation/bootstrap,
556## but not things like config.status or TAGS. 556## but not things like config.status or TAGS.
557bootstrap-clean: clean 557bootstrap-clean: clean
558 rm -f epaths.h config.h config.stamp stamp-h1 stamp-oldxmenu ../etc/DOC-* 558 rm -f epaths.h config.h config.stamp stamp-h1 stamp-oldxmenu
559 if test -f ./.gdbinit; then \ 559 if test -f ./.gdbinit; then \
560 mv ./.gdbinit ./.gdbinit.save; \ 560 mv ./.gdbinit ./.gdbinit.save; \
561 if test -f "$(srcdir)/.gdbinit"; then rm -f ./.gdbinit.save; \ 561 if test -f "$(srcdir)/.gdbinit"; then rm -f ./.gdbinit.save; \
diff --git a/src/doc.c b/src/doc.c
index 770cb1eb646..e45481944f0 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -58,7 +58,7 @@ read_bytecode_char (bool unreadflag)
58} 58}
59 59
60/* Extract a doc string from a file. FILEPOS says where to get it. 60/* Extract a doc string from a file. FILEPOS says where to get it.
61 If it is an integer, use that position in the standard DOC-... file. 61 If it is an integer, use that position in the standard DOC file.
62 If it is (FILE . INTEGER), use FILE as the file name 62 If it is (FILE . INTEGER), use FILE as the file name
63 and INTEGER as the position in that file. 63 and INTEGER as the position in that file.
64 But if INTEGER is negative, make it positive. 64 But if INTEGER is negative, make it positive.
@@ -608,7 +608,7 @@ the same file name is found in the `doc-directory'. */)
608 while (*beg && c_isspace (*beg)) ++beg; 608 while (*beg && c_isspace (*beg)) ++beg;
609 609
610 for (end = beg; *end && ! c_isspace (*end); ++end) 610 for (end = beg; *end && ! c_isspace (*end); ++end)
611 if (*end == '/') beg = end+1; /* skip directory part */ 611 if (*end == '/') beg = end + 1; /* Skip directory part. */
612 612
613 len = end - beg; 613 len = end - beg;
614 if (len > 4 && end[-4] == '.' && end[-3] == 'o') 614 if (len > 4 && end[-4] == '.' && end[-3] == 'o')
diff --git a/src/lisp.h b/src/lisp.h
index e2c24eed352..79d32c90f73 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -585,10 +585,12 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper)
585 (eassert (KBOARD_OBJFWDP (a)), &((a)->u_kboard_objfwd)) 585 (eassert (KBOARD_OBJFWDP (a)), &((a)->u_kboard_objfwd))
586 586
587/* Pseudovector types. */ 587/* Pseudovector types. */
588 588struct Lisp_Process;
589LISP_INLINE Lisp_Object make_lisp_proc (struct Lisp_Process *p)
590{ return make_lisp_ptr (p, Lisp_Vectorlike); }
589#define XPROCESS(a) (eassert (PROCESSP (a)), \ 591#define XPROCESS(a) (eassert (PROCESSP (a)), \
590 (struct Lisp_Process *) XUNTAG (a, Lisp_Vectorlike)) 592 (struct Lisp_Process *) XUNTAG (a, Lisp_Vectorlike))
591#define XWINDOW(a) (eassert (WINDOWP (a)), \ 593#define XWINDOW(a) (eassert (WINDOWP (a)), \
592 (struct window *) XUNTAG (a, Lisp_Vectorlike)) 594 (struct window *) XUNTAG (a, Lisp_Vectorlike))
593#define XTERMINAL(a) (eassert (TERMINALP (a)), \ 595#define XTERMINAL(a) (eassert (TERMINALP (a)), \
594 (struct terminal *) XUNTAG (a, Lisp_Vectorlike)) 596 (struct terminal *) XUNTAG (a, Lisp_Vectorlike))
diff --git a/src/lread.c b/src/lread.c
index 15821662fc8..3ca644bb45b 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -3557,7 +3557,7 @@ read_list (bool flag, Lisp_Object readcharfun)
3557 { 3557 {
3558 if (NILP (Vdoc_file_name)) 3558 if (NILP (Vdoc_file_name))
3559 /* We have not yet called Snarf-documentation, so assume 3559 /* We have not yet called Snarf-documentation, so assume
3560 this file is described in the DOC-MM.NN file 3560 this file is described in the DOC file
3561 and Snarf-documentation will fill in the right value later. 3561 and Snarf-documentation will fill in the right value later.
3562 For now, replace the whole list with 0. */ 3562 For now, replace the whole list with 0. */
3563 doc_reference = 1; 3563 doc_reference = 1;
diff --git a/src/makefile.w32-in b/src/makefile.w32-in
index 3484d6c70c8..272b053ed12 100644
--- a/src/makefile.w32-in
+++ b/src/makefile.w32-in
@@ -41,7 +41,7 @@ TRES = $(BLD)/emacs.res
41TLASTLIB = $(BLD)/lastfile.$(A) 41TLASTLIB = $(BLD)/lastfile.$(A)
42GNULIB = ../lib/$(BLD)/libgnu.$(A) 42GNULIB = ../lib/$(BLD)/libgnu.$(A)
43 43
44DOC = $(OBJDIR)/etc/DOC-X 44DOC = $(OBJDIR)/etc/DOC
45 45
46FULL_LINK_FLAGS = $(LINK_FLAGS) $(TEMACS_EXTRA_LINK) 46FULL_LINK_FLAGS = $(LINK_FLAGS) $(TEMACS_EXTRA_LINK)
47 47
diff --git a/src/process.c b/src/process.c
index 911a30bc808..46385fa096b 100644
--- a/src/process.c
+++ b/src/process.c
@@ -174,6 +174,8 @@ static Lisp_Object QClocal, QCremote, QCcoding;
174static Lisp_Object QCserver, QCnowait, QCnoquery, QCstop; 174static Lisp_Object QCserver, QCnowait, QCnoquery, QCstop;
175static Lisp_Object QCsentinel, QClog, QCoptions, QCplist; 175static Lisp_Object QCsentinel, QClog, QCoptions, QCplist;
176static Lisp_Object Qlast_nonmenu_event; 176static Lisp_Object Qlast_nonmenu_event;
177static Lisp_Object Qinternal_default_process_sentinel;
178static Lisp_Object Qinternal_default_process_filter;
177 179
178#define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork)) 180#define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
179#define NETCONN1_P(p) (EQ (p->type, Qnetwork)) 181#define NETCONN1_P(p) (EQ (p->type, Qnetwork))
@@ -359,7 +361,7 @@ pset_encoding_buf (struct Lisp_Process *p, Lisp_Object val)
359static void 361static void
360pset_filter (struct Lisp_Process *p, Lisp_Object val) 362pset_filter (struct Lisp_Process *p, Lisp_Object val)
361{ 363{
362 p->filter = val; 364 p->filter = NILP (val) ? Qinternal_default_process_filter : val;
363} 365}
364static void 366static void
365pset_log (struct Lisp_Process *p, Lisp_Object val) 367pset_log (struct Lisp_Process *p, Lisp_Object val)
@@ -384,7 +386,7 @@ pset_plist (struct Lisp_Process *p, Lisp_Object val)
384static void 386static void
385pset_sentinel (struct Lisp_Process *p, Lisp_Object val) 387pset_sentinel (struct Lisp_Process *p, Lisp_Object val)
386{ 388{
387 p->sentinel = val; 389 p->sentinel = NILP (val) ? Qinternal_default_process_sentinel : val;
388} 390}
389static void 391static void
390pset_status (struct Lisp_Process *p, Lisp_Object val) 392pset_status (struct Lisp_Process *p, Lisp_Object val)
@@ -700,6 +702,8 @@ make_process (Lisp_Object name)
700 } 702 }
701 name = name1; 703 name = name1;
702 pset_name (p, name); 704 pset_name (p, name);
705 pset_sentinel (p, Qinternal_default_process_sentinel);
706 pset_filter (p, Qinternal_default_process_filter);
703 XSETPROCESS (val, p); 707 XSETPROCESS (val, p);
704 Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist); 708 Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
705 return val; 709 return val;
@@ -979,10 +983,10 @@ DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
979 983
980DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter, 984DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
981 2, 2, 0, 985 2, 2, 0,
982 doc: /* Give PROCESS the filter function FILTER; nil means no filter. 986 doc: /* Give PROCESS the filter function FILTER; nil means default.
983A value of t means stop accepting output from the process. 987A value of t means stop accepting output from the process.
984 988
985When a process has a filter, its buffer is not used for output. 989When a process has a non-default filter, its buffer is not used for output.
986Instead, each time it does output, the entire string of output is 990Instead, each time it does output, the entire string of output is
987passed to the filter. 991passed to the filter.
988 992
@@ -1008,6 +1012,9 @@ The string argument is normally a multibyte string, except:
1008 (debug) 1012 (debug)
1009 (set-process-filter process ...) */ 1013 (set-process-filter process ...) */
1010 1014
1015 if (NILP (filter))
1016 filter = Qinternal_default_process_filter;
1017
1011 if (p->infd >= 0) 1018 if (p->infd >= 0)
1012 { 1019 {
1013 if (EQ (filter, Qt) && !EQ (p->status, Qlisten)) 1020 if (EQ (filter, Qt) && !EQ (p->status, Qlisten))
@@ -1033,7 +1040,7 @@ The string argument is normally a multibyte string, except:
1033 1040
1034DEFUN ("process-filter", Fprocess_filter, Sprocess_filter, 1041DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
1035 1, 1, 0, 1042 1, 1, 0,
1036 doc: /* Returns the filter function of PROCESS; nil if none. 1043 doc: /* Return the filter function of PROCESS.
1037See `set-process-filter' for more info on filter functions. */) 1044See `set-process-filter' for more info on filter functions. */)
1038 (register Lisp_Object process) 1045 (register Lisp_Object process)
1039{ 1046{
@@ -1043,7 +1050,7 @@ See `set-process-filter' for more info on filter functions. */)
1043 1050
1044DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel, 1051DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
1045 2, 2, 0, 1052 2, 2, 0,
1046 doc: /* Give PROCESS the sentinel SENTINEL; nil for none. 1053 doc: /* Give PROCESS the sentinel SENTINEL; nil for default.
1047The sentinel is called as a function when the process changes state. 1054The sentinel is called as a function when the process changes state.
1048It gets two arguments: the process, and a string describing the change. */) 1055It gets two arguments: the process, and a string describing the change. */)
1049 (register Lisp_Object process, Lisp_Object sentinel) 1056 (register Lisp_Object process, Lisp_Object sentinel)
@@ -1053,6 +1060,9 @@ It gets two arguments: the process, and a string describing the change. */)
1053 CHECK_PROCESS (process); 1060 CHECK_PROCESS (process);
1054 p = XPROCESS (process); 1061 p = XPROCESS (process);
1055 1062
1063 if (NILP (sentinel))
1064 sentinel = Qinternal_default_process_sentinel;
1065
1056 pset_sentinel (p, sentinel); 1066 pset_sentinel (p, sentinel);
1057 if (NETCONN1_P (p) || SERIALCONN1_P (p)) 1067 if (NETCONN1_P (p) || SERIALCONN1_P (p))
1058 pset_childp (p, Fplist_put (p->childp, QCsentinel, sentinel)); 1068 pset_childp (p, Fplist_put (p->childp, QCsentinel, sentinel));
@@ -1061,7 +1071,7 @@ It gets two arguments: the process, and a string describing the change. */)
1061 1071
1062DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel, 1072DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
1063 1, 1, 0, 1073 1, 1, 0,
1064 doc: /* Return the sentinel of PROCESS; nil if none. 1074 doc: /* Return the sentinel of PROCESS.
1065See `set-process-sentinel' for more info on sentinels. */) 1075See `set-process-sentinel' for more info on sentinels. */)
1066 (register Lisp_Object process) 1076 (register Lisp_Object process)
1067{ 1077{
@@ -1378,8 +1388,8 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1378 pset_plist (XPROCESS (proc), Qnil); 1388 pset_plist (XPROCESS (proc), Qnil);
1379 pset_type (XPROCESS (proc), Qreal); 1389 pset_type (XPROCESS (proc), Qreal);
1380 pset_buffer (XPROCESS (proc), buffer); 1390 pset_buffer (XPROCESS (proc), buffer);
1381 pset_sentinel (XPROCESS (proc), Qnil); 1391 pset_sentinel (XPROCESS (proc), Qinternal_default_process_sentinel);
1382 pset_filter (XPROCESS (proc), Qnil); 1392 pset_filter (XPROCESS (proc), Qinternal_default_process_filter);
1383 pset_command (XPROCESS (proc), Flist (nargs - 2, args + 2)); 1393 pset_command (XPROCESS (proc), Flist (nargs - 2, args + 2));
1384 1394
1385#ifdef HAVE_GNUTLS 1395#ifdef HAVE_GNUTLS
@@ -4039,7 +4049,8 @@ server_accept_connection (Lisp_Object server, int channel)
4039 process name of the server process concatenated with the caller 4049 process name of the server process concatenated with the caller
4040 identification. */ 4050 identification. */
4041 4051
4042 if (!NILP (ps->filter) && !EQ (ps->filter, Qt)) 4052 if (!(EQ (ps->filter, Qinternal_default_process_filter)
4053 || EQ (ps->filter, Qt)))
4043 buffer = Qnil; 4054 buffer = Qnil;
4044 else 4055 else
4045 { 4056 {
@@ -4108,7 +4119,7 @@ server_accept_connection (Lisp_Object server, int channel)
4108 /* Setup coding system for new process based on server process. 4119 /* Setup coding system for new process based on server process.
4109 This seems to be the proper thing to do, as the coding system 4120 This seems to be the proper thing to do, as the coding system
4110 of the new process should reflect the settings at the time the 4121 of the new process should reflect the settings at the time the
4111 server socket was opened; not the current settings. */ 4122 server socket was opened; not the current settings. */
4112 4123
4113 pset_decode_coding_system (p, ps->decode_coding_system); 4124 pset_decode_coding_system (p, ps->decode_coding_system);
4114 pset_encode_coding_system (p, ps->encode_coding_system); 4125 pset_encode_coding_system (p, ps->encode_coding_system);
@@ -4127,11 +4138,10 @@ server_accept_connection (Lisp_Object server, int channel)
4127 (STRINGP (host) ? host : build_string ("-")), 4138 (STRINGP (host) ? host : build_string ("-")),
4128 build_string ("\n"))); 4139 build_string ("\n")));
4129 4140
4130 if (!NILP (p->sentinel)) 4141 exec_sentinel (proc,
4131 exec_sentinel (proc, 4142 concat3 (build_string ("open from "),
4132 concat3 (build_string ("open from "), 4143 (STRINGP (host) ? host : build_string ("-")),
4133 (STRINGP (host) ? host : build_string ("-")), 4144 build_string ("\n")));
4134 build_string ("\n")));
4135} 4145}
4136 4146
4137/* This variable is different from waiting_for_input in keyboard.c. 4147/* This variable is different from waiting_for_input in keyboard.c.
@@ -4263,8 +4273,8 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
4263 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) 4273 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
4264 break; 4274 break;
4265 4275
4266 /* Compute time from now till when time limit is up */ 4276 /* Compute time from now till when time limit is up. */
4267 /* Exit if already run out */ 4277 /* Exit if already run out. */
4268 if (nsecs < 0) 4278 if (nsecs < 0)
4269 { 4279 {
4270 /* A negative timeout means 4280 /* A negative timeout means
@@ -4871,8 +4881,8 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
4871 } 4881 }
4872 } 4882 }
4873#endif /* NON_BLOCKING_CONNECT */ 4883#endif /* NON_BLOCKING_CONNECT */
4874 } /* end for each file descriptor */ 4884 } /* End for each file descriptor. */
4875 } /* end while exit conditions not met */ 4885 } /* End while exit conditions not met. */
4876 4886
4877 unbind_to (count, Qnil); 4887 unbind_to (count, Qnil);
4878 4888
@@ -4907,6 +4917,11 @@ read_process_output_error_handler (Lisp_Object error_val)
4907 return Qt; 4917 return Qt;
4908} 4918}
4909 4919
4920static void
4921read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
4922 ssize_t nbytes,
4923 struct coding_system *coding);
4924
4910/* Read pending output from the process channel, 4925/* Read pending output from the process channel,
4911 starting with our buffered-ahead character if we have one. 4926 starting with our buffered-ahead character if we have one.
4912 Yield number of decoded characters read. 4927 Yield number of decoded characters read.
@@ -4923,9 +4938,7 @@ read_process_output (Lisp_Object proc, register int channel)
4923{ 4938{
4924 register ssize_t nbytes; 4939 register ssize_t nbytes;
4925 char *chars; 4940 char *chars;
4926 register Lisp_Object outstream;
4927 register struct Lisp_Process *p = XPROCESS (proc); 4941 register struct Lisp_Process *p = XPROCESS (proc);
4928 register ptrdiff_t opoint;
4929 struct coding_system *coding = proc_decode_coding_system[channel]; 4942 struct coding_system *coding = proc_decode_coding_system[channel];
4930 int carryover = p->decoding_carryover; 4943 int carryover = p->decoding_carryover;
4931 int readmax = 4096; 4944 int readmax = 4096;
@@ -5013,122 +5026,144 @@ read_process_output (Lisp_Object proc, register int channel)
5013 friends don't expect current-buffer to be changed from under them. */ 5026 friends don't expect current-buffer to be changed from under them. */
5014 record_unwind_current_buffer (); 5027 record_unwind_current_buffer ();
5015 5028
5016 /* Read and dispose of the process output. */ 5029 read_and_dispose_of_process_output (p, chars, nbytes, coding);
5017 outstream = p->filter; 5030
5018 if (!NILP (outstream)) 5031 /* Handling the process output should not deactivate the mark. */
5019 { 5032 Vdeactivate_mark = odeactivate;
5020 Lisp_Object text; 5033
5021 bool outer_running_asynch_code = running_asynch_code; 5034 unbind_to (count, Qnil);
5022 int waiting = waiting_for_user_input_p; 5035 return nbytes;
5036}
5037
5038static void
5039read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
5040 ssize_t nbytes,
5041 struct coding_system *coding)
5042{
5043 Lisp_Object outstream = p->filter;
5044 Lisp_Object text;
5045 bool outer_running_asynch_code = running_asynch_code;
5046 int waiting = waiting_for_user_input_p;
5023 5047
5024 /* No need to gcpro these, because all we do with them later 5048 /* No need to gcpro these, because all we do with them later
5025 is test them for EQness, and none of them should be a string. */ 5049 is test them for EQness, and none of them should be a string. */
5026#if 0 5050#if 0
5027 Lisp_Object obuffer, okeymap; 5051 Lisp_Object obuffer, okeymap;
5028 XSETBUFFER (obuffer, current_buffer); 5052 XSETBUFFER (obuffer, current_buffer);
5029 okeymap = BVAR (current_buffer, keymap); 5053 okeymap = BVAR (current_buffer, keymap);
5030#endif 5054#endif
5031 5055
5032 /* We inhibit quit here instead of just catching it so that 5056 /* We inhibit quit here instead of just catching it so that
5033 hitting ^G when a filter happens to be running won't screw 5057 hitting ^G when a filter happens to be running won't screw
5034 it up. */ 5058 it up. */
5035 specbind (Qinhibit_quit, Qt); 5059 specbind (Qinhibit_quit, Qt);
5036 specbind (Qlast_nonmenu_event, Qt); 5060 specbind (Qlast_nonmenu_event, Qt);
5037
5038 /* In case we get recursively called,
5039 and we already saved the match data nonrecursively,
5040 save the same match data in safely recursive fashion. */
5041 if (outer_running_asynch_code)
5042 {
5043 Lisp_Object tem;
5044 /* Don't clobber the CURRENT match data, either! */
5045 tem = Fmatch_data (Qnil, Qnil, Qnil);
5046 restore_search_regs ();
5047 record_unwind_save_match_data ();
5048 Fset_match_data (tem, Qt);
5049 }
5050 5061
5051 /* For speed, if a search happens within this code, 5062 /* In case we get recursively called,
5052 save the match data in a special nonrecursive fashion. */ 5063 and we already saved the match data nonrecursively,
5053 running_asynch_code = 1; 5064 save the same match data in safely recursive fashion. */
5065 if (outer_running_asynch_code)
5066 {
5067 Lisp_Object tem;
5068 /* Don't clobber the CURRENT match data, either! */
5069 tem = Fmatch_data (Qnil, Qnil, Qnil);
5070 restore_search_regs ();
5071 record_unwind_save_match_data ();
5072 Fset_match_data (tem, Qt);
5073 }
5054 5074
5055 decode_coding_c_string (coding, (unsigned char *) chars, nbytes, Qt); 5075 /* For speed, if a search happens within this code,
5056 text = coding->dst_object; 5076 save the match data in a special nonrecursive fashion. */
5057 Vlast_coding_system_used = CODING_ID_NAME (coding->id); 5077 running_asynch_code = 1;
5058 /* A new coding system might be found. */
5059 if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
5060 {
5061 pset_decode_coding_system (p, Vlast_coding_system_used);
5062 5078
5063 /* Don't call setup_coding_system for 5079 decode_coding_c_string (coding, (unsigned char *) chars, nbytes, Qt);
5064 proc_decode_coding_system[channel] here. It is done in 5080 text = coding->dst_object;
5065 detect_coding called via decode_coding above. */ 5081 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
5082 /* A new coding system might be found. */
5083 if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
5084 {
5085 pset_decode_coding_system (p, Vlast_coding_system_used);
5066 5086
5067 /* If a coding system for encoding is not yet decided, we set 5087 /* Don't call setup_coding_system for
5068 it as the same as coding-system for decoding. 5088 proc_decode_coding_system[channel] here. It is done in
5089 detect_coding called via decode_coding above. */
5069 5090
5070 But, before doing that we must check if 5091 /* If a coding system for encoding is not yet decided, we set
5071 proc_encode_coding_system[p->outfd] surely points to a 5092 it as the same as coding-system for decoding.
5072 valid memory because p->outfd will be changed once EOF is
5073 sent to the process. */
5074 if (NILP (p->encode_coding_system)
5075 && proc_encode_coding_system[p->outfd])
5076 {
5077 pset_encode_coding_system
5078 (p, coding_inherit_eol_type (Vlast_coding_system_used, Qnil));
5079 setup_coding_system (p->encode_coding_system,
5080 proc_encode_coding_system[p->outfd]);
5081 }
5082 }
5083 5093
5084 if (coding->carryover_bytes > 0) 5094 But, before doing that we must check if
5095 proc_encode_coding_system[p->outfd] surely points to a
5096 valid memory because p->outfd will be changed once EOF is
5097 sent to the process. */
5098 if (NILP (p->encode_coding_system)
5099 && proc_encode_coding_system[p->outfd])
5085 { 5100 {
5086 if (SCHARS (p->decoding_buf) < coding->carryover_bytes) 5101 pset_encode_coding_system
5087 pset_decoding_buf (p, make_uninit_string (coding->carryover_bytes)); 5102 (p, coding_inherit_eol_type (Vlast_coding_system_used, Qnil));
5088 memcpy (SDATA (p->decoding_buf), coding->carryover, 5103 setup_coding_system (p->encode_coding_system,
5089 coding->carryover_bytes); 5104 proc_encode_coding_system[p->outfd]);
5090 p->decoding_carryover = coding->carryover_bytes;
5091 } 5105 }
5092 if (SBYTES (text) > 0) 5106 }
5093 /* FIXME: It's wrong to wrap or not based on debug-on-error, and
5094 sometimes it's simply wrong to wrap (e.g. when called from
5095 accept-process-output). */
5096 internal_condition_case_1 (read_process_output_call,
5097 Fcons (outstream,
5098 Fcons (proc, Fcons (text, Qnil))),
5099 !NILP (Vdebug_on_error) ? Qnil : Qerror,
5100 read_process_output_error_handler);
5101
5102 /* If we saved the match data nonrecursively, restore it now. */
5103 restore_search_regs ();
5104 running_asynch_code = outer_running_asynch_code;
5105 5107
5106 /* Restore waiting_for_user_input_p as it was 5108 if (coding->carryover_bytes > 0)
5107 when we were called, in case the filter clobbered it. */ 5109 {
5108 waiting_for_user_input_p = waiting; 5110 if (SCHARS (p->decoding_buf) < coding->carryover_bytes)
5111 pset_decoding_buf (p, make_uninit_string (coding->carryover_bytes));
5112 memcpy (SDATA (p->decoding_buf), coding->carryover,
5113 coding->carryover_bytes);
5114 p->decoding_carryover = coding->carryover_bytes;
5115 }
5116 if (SBYTES (text) > 0)
5117 /* FIXME: It's wrong to wrap or not based on debug-on-error, and
5118 sometimes it's simply wrong to wrap (e.g. when called from
5119 accept-process-output). */
5120 internal_condition_case_1 (read_process_output_call,
5121 Fcons (outstream,
5122 Fcons (make_lisp_proc (p),
5123 Fcons (text, Qnil))),
5124 !NILP (Vdebug_on_error) ? Qnil : Qerror,
5125 read_process_output_error_handler);
5126
5127 /* If we saved the match data nonrecursively, restore it now. */
5128 restore_search_regs ();
5129 running_asynch_code = outer_running_asynch_code;
5130
5131 /* Restore waiting_for_user_input_p as it was
5132 when we were called, in case the filter clobbered it. */
5133 waiting_for_user_input_p = waiting;
5109 5134
5110#if 0 /* Call record_asynch_buffer_change unconditionally, 5135#if 0 /* Call record_asynch_buffer_change unconditionally,
5111 because we might have changed minor modes or other things 5136 because we might have changed minor modes or other things
5112 that affect key bindings. */ 5137 that affect key bindings. */
5113 if (! EQ (Fcurrent_buffer (), obuffer) 5138 if (! EQ (Fcurrent_buffer (), obuffer)
5114 || ! EQ (current_buffer->keymap, okeymap)) 5139 || ! EQ (current_buffer->keymap, okeymap))
5115#endif 5140#endif
5116 /* But do it only if the caller is actually going to read events. 5141 /* But do it only if the caller is actually going to read events.
5117 Otherwise there's no need to make him wake up, and it could 5142 Otherwise there's no need to make him wake up, and it could
5118 cause trouble (for example it would make sit_for return). */ 5143 cause trouble (for example it would make sit_for return). */
5119 if (waiting_for_user_input_p == -1) 5144 if (waiting_for_user_input_p == -1)
5120 record_asynch_buffer_change (); 5145 record_asynch_buffer_change ();
5121 } 5146}
5147
5148DEFUN ("internal-default-process-filter", Finternal_default_process_filter,
5149 Sinternal_default_process_filter, 2, 2, 0,
5150 doc: /* Function used as default process filter. */)
5151 (Lisp_Object proc, Lisp_Object text)
5152{
5153 struct Lisp_Process *p;
5154 ptrdiff_t opoint;
5122 5155
5123 /* If no filter, write into buffer if it isn't dead. */ 5156 CHECK_PROCESS (proc);
5124 else if (!NILP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer))) 5157 p = XPROCESS (proc);
5158 CHECK_STRING (text);
5159
5160 if (!NILP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer)))
5125 { 5161 {
5126 Lisp_Object old_read_only; 5162 Lisp_Object old_read_only;
5127 ptrdiff_t old_begv, old_zv; 5163 ptrdiff_t old_begv, old_zv;
5128 ptrdiff_t old_begv_byte, old_zv_byte; 5164 ptrdiff_t old_begv_byte, old_zv_byte;
5129 ptrdiff_t before, before_byte; 5165 ptrdiff_t before, before_byte;
5130 ptrdiff_t opoint_byte; 5166 ptrdiff_t opoint_byte;
5131 Lisp_Object text;
5132 struct buffer *b; 5167 struct buffer *b;
5133 5168
5134 Fset_buffer (p->buffer); 5169 Fset_buffer (p->buffer);
@@ -5161,31 +5196,6 @@ read_process_output (Lisp_Object proc, register int channel)
5161 if (! (BEGV <= PT && PT <= ZV)) 5196 if (! (BEGV <= PT && PT <= ZV))
5162 Fwiden (); 5197 Fwiden ();
5163 5198
5164 decode_coding_c_string (coding, (unsigned char *) chars, nbytes, Qt);
5165 text = coding->dst_object;
5166 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
5167 /* A new coding system might be found. See the comment in the
5168 similar code in the previous `if' block. */
5169 if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
5170 {
5171 pset_decode_coding_system (p, Vlast_coding_system_used);
5172 if (NILP (p->encode_coding_system)
5173 && proc_encode_coding_system[p->outfd])
5174 {
5175 pset_encode_coding_system
5176 (p, coding_inherit_eol_type (Vlast_coding_system_used, Qnil));
5177 setup_coding_system (p->encode_coding_system,
5178 proc_encode_coding_system[p->outfd]);
5179 }
5180 }
5181 if (coding->carryover_bytes > 0)
5182 {
5183 if (SCHARS (p->decoding_buf) < coding->carryover_bytes)
5184 pset_decoding_buf (p, make_uninit_string (coding->carryover_bytes));
5185 memcpy (SDATA (p->decoding_buf), coding->carryover,
5186 coding->carryover_bytes);
5187 p->decoding_carryover = coding->carryover_bytes;
5188 }
5189 /* Adjust the multibyteness of TEXT to that of the buffer. */ 5199 /* Adjust the multibyteness of TEXT to that of the buffer. */
5190 if (NILP (BVAR (current_buffer, enable_multibyte_characters)) 5200 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
5191 != ! STRING_MULTIBYTE (text)) 5201 != ! STRING_MULTIBYTE (text))
@@ -5230,18 +5240,13 @@ read_process_output (Lisp_Object proc, register int channel)
5230 if (old_begv != BEGV || old_zv != ZV) 5240 if (old_begv != BEGV || old_zv != ZV)
5231 Fnarrow_to_region (make_number (old_begv), make_number (old_zv)); 5241 Fnarrow_to_region (make_number (old_begv), make_number (old_zv));
5232 5242
5233
5234 bset_read_only (current_buffer, old_read_only); 5243 bset_read_only (current_buffer, old_read_only);
5235 SET_PT_BOTH (opoint, opoint_byte); 5244 SET_PT_BOTH (opoint, opoint_byte);
5236 } 5245 }
5237 /* Handling the process output should not deactivate the mark. */ 5246 return Qnil;
5238 Vdeactivate_mark = odeactivate;
5239
5240 unbind_to (count, Qnil);
5241 return nbytes;
5242} 5247}
5243 5248
5244/* Sending data to subprocess */ 5249/* Sending data to subprocess. */
5245 5250
5246/* In send_process, when a write fails temporarily, 5251/* In send_process, when a write fails temporarily,
5247 wait_reading_process_output is called. It may execute user code, 5252 wait_reading_process_output is called. It may execute user code,
@@ -6188,13 +6193,6 @@ deliver_child_signal (int sig)
6188 6193
6189 6194
6190static Lisp_Object 6195static Lisp_Object
6191exec_sentinel_unwind (Lisp_Object data)
6192{
6193 pset_sentinel (XPROCESS (XCAR (data)), XCDR (data));
6194 return Qnil;
6195}
6196
6197static Lisp_Object
6198exec_sentinel_error_handler (Lisp_Object error_val) 6196exec_sentinel_error_handler (Lisp_Object error_val)
6199{ 6197{
6200 cmd_error_internal (error_val, "error in process sentinel: "); 6198 cmd_error_internal (error_val, "error in process sentinel: ");
@@ -6231,13 +6229,7 @@ exec_sentinel (Lisp_Object proc, Lisp_Object reason)
6231 record_unwind_current_buffer (); 6229 record_unwind_current_buffer ();
6232 6230
6233 sentinel = p->sentinel; 6231 sentinel = p->sentinel;
6234 if (NILP (sentinel))
6235 return;
6236 6232
6237 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6238 assure that it gets restored no matter how the sentinel exits. */
6239 pset_sentinel (p, Qnil);
6240 record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel));
6241 /* Inhibit quit so that random quits don't screw up a running filter. */ 6233 /* Inhibit quit so that random quits don't screw up a running filter. */
6242 specbind (Qinhibit_quit, Qt); 6234 specbind (Qinhibit_quit, Qt);
6243 specbind (Qlast_nonmenu_event, Qt); /* Why? --Stef */ 6235 specbind (Qlast_nonmenu_event, Qt); /* Why? --Stef */
@@ -6295,7 +6287,7 @@ exec_sentinel (Lisp_Object proc, Lisp_Object reason)
6295static void 6287static void
6296status_notify (struct Lisp_Process *deleting_process) 6288status_notify (struct Lisp_Process *deleting_process)
6297{ 6289{
6298 register Lisp_Object proc, buffer; 6290 register Lisp_Object proc;
6299 Lisp_Object tail, msg; 6291 Lisp_Object tail, msg;
6300 struct gcpro gcpro1, gcpro2; 6292 struct gcpro gcpro1, gcpro2;
6301 6293
@@ -6333,8 +6325,6 @@ status_notify (struct Lisp_Process *deleting_process)
6333 && p != deleting_process 6325 && p != deleting_process
6334 && read_process_output (proc, p->infd) > 0); 6326 && read_process_output (proc, p->infd) > 0);
6335 6327
6336 buffer = p->buffer;
6337
6338 /* Get the text to use for the message. */ 6328 /* Get the text to use for the message. */
6339 if (p->raw_status_new) 6329 if (p->raw_status_new)
6340 update_status (p); 6330 update_status (p);
@@ -6355,66 +6345,83 @@ status_notify (struct Lisp_Process *deleting_process)
6355 } 6345 }
6356 6346
6357 /* The actions above may have further incremented p->tick. 6347 /* The actions above may have further incremented p->tick.
6358 So set p->update_tick again 6348 So set p->update_tick again so that an error in the sentinel will
6359 so that an error in the sentinel will not cause 6349 not cause this code to be run again. */
6360 this code to be run again. */
6361 p->update_tick = p->tick; 6350 p->update_tick = p->tick;
6362 /* Now output the message suitably. */ 6351 /* Now output the message suitably. */
6363 if (!NILP (p->sentinel)) 6352 exec_sentinel (proc, msg);
6364 exec_sentinel (proc, msg);
6365 /* Don't bother with a message in the buffer
6366 when a process becomes runnable. */
6367 else if (!EQ (symbol, Qrun) && !NILP (buffer))
6368 {
6369 Lisp_Object tem;
6370 struct buffer *old = current_buffer;
6371 ptrdiff_t opoint, opoint_byte;
6372 ptrdiff_t before, before_byte;
6373
6374 /* Avoid error if buffer is deleted
6375 (probably that's why the process is dead, too) */
6376 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
6377 continue;
6378 Fset_buffer (buffer);
6379
6380 opoint = PT;
6381 opoint_byte = PT_BYTE;
6382 /* Insert new output into buffer
6383 at the current end-of-output marker,
6384 thus preserving logical ordering of input and output. */
6385 if (XMARKER (p->mark)->buffer)
6386 Fgoto_char (p->mark);
6387 else
6388 SET_PT_BOTH (ZV, ZV_BYTE);
6389
6390 before = PT;
6391 before_byte = PT_BYTE;
6392
6393 tem = BVAR (current_buffer, read_only);
6394 bset_read_only (current_buffer, Qnil);
6395 insert_string ("\nProcess ");
6396 { /* FIXME: temporary kludge */
6397 Lisp_Object tem2 = p->name; Finsert (1, &tem2); }
6398 insert_string (" ");
6399 Finsert (1, &msg);
6400 bset_read_only (current_buffer, tem);
6401 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
6402
6403 if (opoint >= before)
6404 SET_PT_BOTH (opoint + (PT - before),
6405 opoint_byte + (PT_BYTE - before_byte));
6406 else
6407 SET_PT_BOTH (opoint, opoint_byte);
6408
6409 set_buffer_internal (old);
6410 }
6411 } 6353 }
6412 } /* end for */ 6354 } /* end for */
6413 6355
6414 update_mode_lines++; /* in case buffers use %s in mode-line-format */ 6356 update_mode_lines++; /* In case buffers use %s in mode-line-format. */
6415 UNGCPRO; 6357 UNGCPRO;
6416} 6358}
6417 6359
6360DEFUN ("internal-default-process-sentinel", Finternal_default_process_sentinel,
6361 Sinternal_default_process_sentinel, 2, 2, 0,
6362 doc: /* Function used as default sentinel for processes. */)
6363 (Lisp_Object proc, Lisp_Object msg)
6364{
6365 Lisp_Object buffer, symbol;
6366 struct Lisp_Process *p;
6367 CHECK_PROCESS (proc);
6368 p = XPROCESS (proc);
6369 buffer = p->buffer;
6370 symbol = p->status;
6371 if (CONSP (symbol))
6372 symbol = XCAR (symbol);
6373
6374 if (!EQ (symbol, Qrun) && !NILP (buffer))
6375 {
6376 Lisp_Object tem;
6377 struct buffer *old = current_buffer;
6378 ptrdiff_t opoint, opoint_byte;
6379 ptrdiff_t before, before_byte;
6380
6381 /* Avoid error if buffer is deleted
6382 (probably that's why the process is dead, too). */
6383 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
6384 return Qnil;
6385 Fset_buffer (buffer);
6386
6387 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
6388 msg = (code_convert_string_norecord
6389 (msg, Vlocale_coding_system, 1));
6390
6391 opoint = PT;
6392 opoint_byte = PT_BYTE;
6393 /* Insert new output into buffer
6394 at the current end-of-output marker,
6395 thus preserving logical ordering of input and output. */
6396 if (XMARKER (p->mark)->buffer)
6397 Fgoto_char (p->mark);
6398 else
6399 SET_PT_BOTH (ZV, ZV_BYTE);
6400
6401 before = PT;
6402 before_byte = PT_BYTE;
6403
6404 tem = BVAR (current_buffer, read_only);
6405 bset_read_only (current_buffer, Qnil);
6406 insert_string ("\nProcess ");
6407 { /* FIXME: temporary kludge. */
6408 Lisp_Object tem2 = p->name; Finsert (1, &tem2); }
6409 insert_string (" ");
6410 Finsert (1, &msg);
6411 bset_read_only (current_buffer, tem);
6412 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
6413
6414 if (opoint >= before)
6415 SET_PT_BOTH (opoint + (PT - before),
6416 opoint_byte + (PT_BYTE - before_byte));
6417 else
6418 SET_PT_BOTH (opoint, opoint_byte);
6419
6420 set_buffer_internal (old);
6421 }
6422 return Qnil;
6423}
6424
6418 6425
6419DEFUN ("set-process-coding-system", Fset_process_coding_system, 6426DEFUN ("set-process-coding-system", Fset_process_coding_system,
6420 Sset_process_coding_system, 1, 3, 0, 6427 Sset_process_coding_system, 1, 3, 0,
@@ -6606,13 +6613,13 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
6606 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) 6613 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
6607 break; 6614 break;
6608 6615
6609 /* Compute time from now till when time limit is up */ 6616 /* Compute time from now till when time limit is up. */
6610 /* Exit if already run out */ 6617 /* Exit if already run out. */
6611 if (nsecs < 0) 6618 if (nsecs < 0)
6612 { 6619 {
6613 /* A negative timeout means 6620 /* A negative timeout means
6614 gobble output available now 6621 gobble output available now
6615 but don't wait at all. */ 6622 but don't wait at all. */
6616 6623
6617 timeout = make_emacs_time (0, 0); 6624 timeout = make_emacs_time (0, 0);
6618 } 6625 }
@@ -6805,9 +6812,8 @@ setup_process_coding_systems (Lisp_Object process)
6805 if (!proc_decode_coding_system[inch]) 6812 if (!proc_decode_coding_system[inch])
6806 proc_decode_coding_system[inch] = xmalloc (sizeof (struct coding_system)); 6813 proc_decode_coding_system[inch] = xmalloc (sizeof (struct coding_system));
6807 coding_system = p->decode_coding_system; 6814 coding_system = p->decode_coding_system;
6808 if (! NILP (p->filter)) 6815 if (EQ (p->filter, Qinternal_default_process_filter)
6809 ; 6816 && BUFFERP (p->buffer))
6810 else if (BUFFERP (p->buffer))
6811 { 6817 {
6812 if (NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters))) 6818 if (NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)))
6813 coding_system = raw_text_coding_system (coding_system); 6819 coding_system = raw_text_coding_system (coding_system);
@@ -6916,7 +6922,7 @@ kill_buffer_processes (Lisp_Object buffer)
6916 6922
6917DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, 6923DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p,
6918 Swaiting_for_user_input_p, 0, 0, 0, 6924 Swaiting_for_user_input_p, 0, 0, 0,
6919 doc: /* Returns non-nil if Emacs is waiting for input from the user. 6925 doc: /* Return non-nil if Emacs is waiting for input from the user.
6920This is intended for use by asynchronous process output filters and sentinels. */) 6926This is intended for use by asynchronous process output filters and sentinels. */)
6921 (void) 6927 (void)
6922{ 6928{
@@ -7222,6 +7228,10 @@ syms_of_process (void)
7222 DEFSYM (Qcutime, "cutime"); 7228 DEFSYM (Qcutime, "cutime");
7223 DEFSYM (Qcstime, "cstime"); 7229 DEFSYM (Qcstime, "cstime");
7224 DEFSYM (Qctime, "ctime"); 7230 DEFSYM (Qctime, "ctime");
7231 DEFSYM (Qinternal_default_process_sentinel,
7232 "internal-default-process-sentinel");
7233 DEFSYM (Qinternal_default_process_filter,
7234 "internal-default-process-filter");
7225 DEFSYM (Qpri, "pri"); 7235 DEFSYM (Qpri, "pri");
7226 DEFSYM (Qnice, "nice"); 7236 DEFSYM (Qnice, "nice");
7227 DEFSYM (Qthcount, "thcount"); 7237 DEFSYM (Qthcount, "thcount");
@@ -7317,6 +7327,8 @@ The variable takes effect when `start-process' is called. */);
7317 defsubr (&Ssignal_process); 7327 defsubr (&Ssignal_process);
7318 defsubr (&Swaiting_for_user_input_p); 7328 defsubr (&Swaiting_for_user_input_p);
7319 defsubr (&Sprocess_type); 7329 defsubr (&Sprocess_type);
7330 defsubr (&Sinternal_default_process_sentinel);
7331 defsubr (&Sinternal_default_process_filter);
7320 defsubr (&Sset_process_coding_system); 7332 defsubr (&Sset_process_coding_system);
7321 defsubr (&Sprocess_coding_system); 7333 defsubr (&Sprocess_coding_system);
7322 defsubr (&Sset_process_filter_multibyte); 7334 defsubr (&Sset_process_filter_multibyte);