diff options
| author | Eli Zaretskii | 2013-05-16 12:58:56 +0300 |
|---|---|---|
| committer | Eli Zaretskii | 2013-05-16 12:58:56 +0300 |
| commit | a9519e2685d19b13ce4e3e1ba13f97569013627e (patch) | |
| tree | 6a9e0e35514c400749f23c891e9a95577fb9bfc1 /src | |
| parent | 3946d31b7bcf2a7dceacb86598823360f457cd19 (diff) | |
| parent | 2d4bf34b5b83b3728b2fb18a72536f3e14afcf34 (diff) | |
| download | emacs-a9519e2685d19b13ce4e3e1ba13f97569013627e.tar.gz emacs-a9519e2685d19b13ce4e3e1ba13f97569013627e.zip | |
Merge from trunk.
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 28 | ||||
| -rw-r--r-- | src/Makefile.in | 2 | ||||
| -rw-r--r-- | src/doc.c | 4 | ||||
| -rw-r--r-- | src/lisp.h | 6 | ||||
| -rw-r--r-- | src/lread.c | 2 | ||||
| -rw-r--r-- | src/makefile.w32-in | 2 | ||||
| -rw-r--r-- | src/process.c | 454 |
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 @@ | |||
| 1 | 2013-05-15 Stefan Monnier <monnier@iro.umontreal.ca> | 1 | 2013-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 | |||
| 29 | 2013-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 | ||
| 5 | 2013-05-14 Eli Zaretskii <eliz@gnu.org> | 33 | 2013-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. |
| 557 | bootstrap-clean: clean | 557 | bootstrap-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; \ |
| @@ -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 | 588 | struct Lisp_Process; | |
| 589 | LISP_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 | |||
| 41 | TLASTLIB = $(BLD)/lastfile.$(A) | 41 | TLASTLIB = $(BLD)/lastfile.$(A) |
| 42 | GNULIB = ../lib/$(BLD)/libgnu.$(A) | 42 | GNULIB = ../lib/$(BLD)/libgnu.$(A) |
| 43 | 43 | ||
| 44 | DOC = $(OBJDIR)/etc/DOC-X | 44 | DOC = $(OBJDIR)/etc/DOC |
| 45 | 45 | ||
| 46 | FULL_LINK_FLAGS = $(LINK_FLAGS) $(TEMACS_EXTRA_LINK) | 46 | FULL_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; | |||
| 174 | static Lisp_Object QCserver, QCnowait, QCnoquery, QCstop; | 174 | static Lisp_Object QCserver, QCnowait, QCnoquery, QCstop; |
| 175 | static Lisp_Object QCsentinel, QClog, QCoptions, QCplist; | 175 | static Lisp_Object QCsentinel, QClog, QCoptions, QCplist; |
| 176 | static Lisp_Object Qlast_nonmenu_event; | 176 | static Lisp_Object Qlast_nonmenu_event; |
| 177 | static Lisp_Object Qinternal_default_process_sentinel; | ||
| 178 | static 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) | |||
| 359 | static void | 361 | static void |
| 360 | pset_filter (struct Lisp_Process *p, Lisp_Object val) | 362 | pset_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 | } |
| 364 | static void | 366 | static void |
| 365 | pset_log (struct Lisp_Process *p, Lisp_Object val) | 367 | pset_log (struct Lisp_Process *p, Lisp_Object val) |
| @@ -384,7 +386,7 @@ pset_plist (struct Lisp_Process *p, Lisp_Object val) | |||
| 384 | static void | 386 | static void |
| 385 | pset_sentinel (struct Lisp_Process *p, Lisp_Object val) | 387 | pset_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 | } |
| 389 | static void | 391 | static void |
| 390 | pset_status (struct Lisp_Process *p, Lisp_Object val) | 392 | pset_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 | ||
| 980 | DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter, | 984 | DEFUN ("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. |
| 983 | A value of t means stop accepting output from the process. | 987 | A value of t means stop accepting output from the process. |
| 984 | 988 | ||
| 985 | When a process has a filter, its buffer is not used for output. | 989 | When a process has a non-default filter, its buffer is not used for output. |
| 986 | Instead, each time it does output, the entire string of output is | 990 | Instead, each time it does output, the entire string of output is |
| 987 | passed to the filter. | 991 | passed 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 | ||
| 1034 | DEFUN ("process-filter", Fprocess_filter, Sprocess_filter, | 1041 | DEFUN ("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. |
| 1037 | See `set-process-filter' for more info on filter functions. */) | 1044 | See `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 | ||
| 1044 | DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel, | 1051 | DEFUN ("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. |
| 1047 | The sentinel is called as a function when the process changes state. | 1054 | The sentinel is called as a function when the process changes state. |
| 1048 | It gets two arguments: the process, and a string describing the change. */) | 1055 | It 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 | ||
| 1062 | DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel, | 1072 | DEFUN ("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. |
| 1065 | See `set-process-sentinel' for more info on sentinels. */) | 1075 | See `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 | ||
| 4920 | static void | ||
| 4921 | read_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 | |||
| 5038 | static void | ||
| 5039 | read_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 | |||
| 5148 | DEFUN ("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 | ||
| 6190 | static Lisp_Object | 6195 | static Lisp_Object |
| 6191 | exec_sentinel_unwind (Lisp_Object data) | ||
| 6192 | { | ||
| 6193 | pset_sentinel (XPROCESS (XCAR (data)), XCDR (data)); | ||
| 6194 | return Qnil; | ||
| 6195 | } | ||
| 6196 | |||
| 6197 | static Lisp_Object | ||
| 6198 | exec_sentinel_error_handler (Lisp_Object error_val) | 6196 | exec_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) | |||
| 6295 | static void | 6287 | static void |
| 6296 | status_notify (struct Lisp_Process *deleting_process) | 6288 | status_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 | ||
| 6360 | DEFUN ("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 | ||
| 6419 | DEFUN ("set-process-coding-system", Fset_process_coding_system, | 6426 | DEFUN ("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 | ||
| 6917 | DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, | 6923 | DEFUN ("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. |
| 6920 | This is intended for use by asynchronous process output filters and sentinels. */) | 6926 | This 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); |