diff options
Diffstat (limited to 'src/process.c')
| -rw-r--r-- | src/process.c | 91 |
1 files changed, 79 insertions, 12 deletions
diff --git a/src/process.c b/src/process.c index ecc810cc621..7f651e36700 100644 --- a/src/process.c +++ b/src/process.c | |||
| @@ -5660,6 +5660,83 @@ send_process (proc, buf, len, object) | |||
| 5660 | UNGCPRO; | 5660 | UNGCPRO; |
| 5661 | } | 5661 | } |
| 5662 | 5662 | ||
| 5663 | static Lisp_Object | ||
| 5664 | send_process_object_unwind (buf) | ||
| 5665 | Lisp_Object buf; | ||
| 5666 | { | ||
| 5667 | Lisp_Object tembuf; | ||
| 5668 | |||
| 5669 | if (XBUFFER (buf) == current_buffer) | ||
| 5670 | return Qnil; | ||
| 5671 | tembuf = Fcurrent_buffer (); | ||
| 5672 | Fset_buffer (buf); | ||
| 5673 | Fkill_buffer (tembuf); | ||
| 5674 | return Qnil; | ||
| 5675 | } | ||
| 5676 | |||
| 5677 | /* Send current contents of region between START and END to PROC. | ||
| 5678 | If START is a string, send it instead. | ||
| 5679 | This function can evaluate Lisp code and can garbage collect. */ | ||
| 5680 | |||
| 5681 | static void | ||
| 5682 | send_process_object (proc, start, end) | ||
| 5683 | Lisp_Object proc, start, end; | ||
| 5684 | { | ||
| 5685 | int count = SPECPDL_INDEX (); | ||
| 5686 | Lisp_Object object = STRINGP (start) ? start : Fcurrent_buffer (); | ||
| 5687 | struct buffer *given_buffer = current_buffer; | ||
| 5688 | unsigned char *buf; | ||
| 5689 | int len; | ||
| 5690 | |||
| 5691 | record_unwind_protect (send_process_object_unwind, Fcurrent_buffer ()); | ||
| 5692 | |||
| 5693 | if (STRINGP (object) ? STRING_MULTIBYTE (object) | ||
| 5694 | : ! NILP (XBUFFER (object)->enable_multibyte_characters)) | ||
| 5695 | { | ||
| 5696 | struct Lisp_Process *p = XPROCESS (proc); | ||
| 5697 | struct coding_system *coding = proc_encode_coding_system[XINT (p->outfd)]; | ||
| 5698 | |||
| 5699 | if (! EQ (coding->symbol, p->encode_coding_system)) | ||
| 5700 | /* The coding system for encoding was changed to raw-text | ||
| 5701 | because we sent a unibyte text previously. Now we are | ||
| 5702 | sending a multibyte text, thus we must encode it by the | ||
| 5703 | original coding system specified for the current process. */ | ||
| 5704 | setup_coding_system (p->encode_coding_system, coding); | ||
| 5705 | if (! NILP (coding->pre_write_conversion)) | ||
| 5706 | { | ||
| 5707 | struct gcpro gcpro1, gcpro2; | ||
| 5708 | |||
| 5709 | GCPRO2 (proc, object); | ||
| 5710 | call2 (coding->pre_write_conversion, start, end); | ||
| 5711 | UNGCPRO; | ||
| 5712 | if (given_buffer != current_buffer) | ||
| 5713 | { | ||
| 5714 | start = make_number (BEGV), end = make_number (ZV); | ||
| 5715 | object = Fcurrent_buffer (); | ||
| 5716 | } | ||
| 5717 | } | ||
| 5718 | } | ||
| 5719 | |||
| 5720 | if (BUFFERP (object)) | ||
| 5721 | { | ||
| 5722 | EMACS_INT start_byte; | ||
| 5723 | |||
| 5724 | if (XINT (start) < GPT && XINT (end) > GPT) | ||
| 5725 | move_gap (XINT (end)); | ||
| 5726 | start_byte = CHAR_TO_BYTE (XINT (start)); | ||
| 5727 | buf = BYTE_POS_ADDR (start_byte); | ||
| 5728 | len = CHAR_TO_BYTE (XINT (end)) - start_byte; | ||
| 5729 | } | ||
| 5730 | else | ||
| 5731 | { | ||
| 5732 | buf = SDATA (object); | ||
| 5733 | len = SBYTES (object); | ||
| 5734 | } | ||
| 5735 | send_process (proc, buf, len, object); | ||
| 5736 | |||
| 5737 | unbind_to (count, Qnil); | ||
| 5738 | } | ||
| 5739 | |||
| 5663 | DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region, | 5740 | DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region, |
| 5664 | 3, 3, 0, | 5741 | 3, 3, 0, |
| 5665 | doc: /* Send current contents of region as input to PROCESS. | 5742 | doc: /* Send current contents of region as input to PROCESS. |
| @@ -5673,19 +5750,10 @@ Output from processes can arrive in between bunches. */) | |||
| 5673 | Lisp_Object process, start, end; | 5750 | Lisp_Object process, start, end; |
| 5674 | { | 5751 | { |
| 5675 | Lisp_Object proc; | 5752 | Lisp_Object proc; |
| 5676 | int start1, end1; | ||
| 5677 | 5753 | ||
| 5678 | proc = get_process (process); | 5754 | proc = get_process (process); |
| 5679 | validate_region (&start, &end); | 5755 | validate_region (&start, &end); |
| 5680 | 5756 | send_process_object (proc, start, end); | |
| 5681 | if (XINT (start) < GPT && XINT (end) > GPT) | ||
| 5682 | move_gap (XINT (start)); | ||
| 5683 | |||
| 5684 | start1 = CHAR_TO_BYTE (XINT (start)); | ||
| 5685 | end1 = CHAR_TO_BYTE (XINT (end)); | ||
| 5686 | send_process (proc, BYTE_POS_ADDR (start1), end1 - start1, | ||
| 5687 | Fcurrent_buffer ()); | ||
| 5688 | |||
| 5689 | return Qnil; | 5757 | return Qnil; |
| 5690 | } | 5758 | } |
| 5691 | 5759 | ||
| @@ -5703,8 +5771,7 @@ Output from processes can arrive in between bunches. */) | |||
| 5703 | Lisp_Object proc; | 5771 | Lisp_Object proc; |
| 5704 | CHECK_STRING (string); | 5772 | CHECK_STRING (string); |
| 5705 | proc = get_process (process); | 5773 | proc = get_process (process); |
| 5706 | send_process (proc, SDATA (string), | 5774 | send_process_object (proc, string, Qnil); |
| 5707 | SBYTES (string), string); | ||
| 5708 | return Qnil; | 5775 | return Qnil; |
| 5709 | } | 5776 | } |
| 5710 | 5777 | ||