emacs: src/coding.c comparison

comparison src/coding.c @ 17119:2cfb31c15ced

(create_process, Fopen_network_stream): Typo in indexes of array proc_encode_coding_system fixed. Remove prefix "coding-system-" from coding system symbol names. (encode_coding) : Fix typo ("=" -> "=="). (detect_coding_iso2022): Detect coding-category-iso-8-2 more precisely. (ENCODE_RESET_PLANE_AND_REGISTER): Argument `eol' is deleted. Don't call ENCODE_DESIGNATION if nothing designated initially. (encode_designation_at_bol) New function. (encode_coding_iso2022): Handle CODING_FLAG_ISO_INIT_AT_BOL and CODING_FLAG_ISO_DESIGNATE_AT_BOL. (setup_coding_system): Now, flags of ISO2022 coding systems contains charsets instead of charset IDs. (detect_coding_iso2022, decode_coding_iso2022): Make the code robust against invalid SI and SO. (Ffind_coding_system, syms_of_coding): Escape newlines in docstring. (setup_coding_system): Correct setting coding->symbol and coding->eol_type. The performance improved.

author	Kenichi Handa <handa@m17n.org>
date	Thu, 27 Feb 1997 11:10:42 +0000
parents	70194012fb3a
children	bd8d38879c97

comparison

equal deleted inserted replaced

-:dcfb481ee914
+:2cfb31c15ced
 int
 detect_coding_iso2022 (src, src_end)
 unsigned char *src, *src_end;
 {
-unsigned char graphic_register[4];
+unsigned char c, g1 = 0;
-unsigned char c, esc_cntl;
 int mask = (CODING_CATEGORY_MASK_ISO_7
 	      | CODING_CATEGORY_MASK_ISO_8_1
 	      | CODING_CATEGORY_MASK_ISO_8_2);
-/* We may look ahead maximum 3 bytes.  */
+/* We may look ahead at most 4 bytes.  */
-unsigned char *adjusted_src_end = src_end - 3;
+unsigned char *adjusted_src_end = src_end - 4;
 int i;
-for (i = 0; i < 4; i++)
+while (src < src_end)
-graphic_register[i] = CHARSET_ASCII;
-while (src < adjusted_src_end)
 {
 c = *src++;
 switch (c)
 	{
 	case ISO_CODE_ESC:
-	  if (src >= adjusted_src_end)
+	  if (src >= src_end)
 	    break;
 	  c = *src++;
-	  if (c == '$')
+	  if (src + 2 >= src_end
+	      && ((c >= '(' && c <= '/')
+		  || c == '$' && ((*src >= '(' && *src <= '/')
+				  || (*src >= '@' && *src <= 'B'))))
 	    {
-	      /* Designation of 2-byte character set.  */
+	      /* Valid designation sequence.  */
-	      if (src >= adjusted_src_end)
+	      if (c == ')' || (c == '$' && *src == ')'))
-		break;
+		g1 = 1;
-	      c = *src++;
+	      src++;
+	      break;
 	    }
-	  if ((c >= ')' && c <= '+') || (c >= '-' && c <= '/'))
-	    /* Designation to graphic register 1, 2, or 3.  */
-	    mask &= ~CODING_CATEGORY_MASK_ISO_7;
 	  else if (c == 'N' || c == 'O' || c == 'n' || c == 'o')
 	    return CODING_CATEGORY_MASK_ISO_ELSE;
 	  break;
-	case ISO_CODE_SI:
 	case ISO_CODE_SO:
-	  return CODING_CATEGORY_MASK_ISO_ELSE;
+	  if (g1)
+	    return CODING_CATEGORY_MASK_ISO_ELSE;
+	  break;
 	case ISO_CODE_CSI:
 	case ISO_CODE_SS2:
 	case ISO_CODE_SS3:
 	  mask &= ~CODING_CATEGORY_MASK_ISO_7;
 	  break;
 	  else
 	    {
 	      int count = 1;
 	      mask &= ~CODING_CATEGORY_MASK_ISO_7;
-	      while (src < adjusted_src_end && *src >= 0xA0)
+	      while (src < src_end && *src >= 0xA0)
 		count++, src++;
-	      if (count & 1 && src < adjusted_src_end)
+	      if (count & 1 && src < src_end)
 		mask &= ~CODING_CATEGORY_MASK_ISO_8_2;
 	    }
 	  break;
 	}
 }
 	      *dst++ = c1;
 	    }
 	  break;
 	case ISO_shift_out:
+	  if (CODING_SPEC_ISO_DESIGNATION (coding, 1) < 0)
+	    goto label_invalid_escape_sequence;
 	  CODING_SPEC_ISO_INVOCATION (coding, 0) = 1;
 	  charset0 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 0);
 	  break;
 	case ISO_shift_in:
 	  switch (c1)
 	    {
 	    case '&':		/* revision of following character set */
 	      ONE_MORE_BYTE (c1);
 	      if (!(c1 >= '@' && c1 <= '~'))
-		{
+		goto label_invalid_escape_sequence;
-		  goto label_invalid_escape_sequence;
-		}
 	      ONE_MORE_BYTE (c1);
 	      if (c1 != ISO_CODE_ESC)
-		{
+		goto label_invalid_escape_sequence;
-		  goto label_invalid_escape_sequence;
-		}
 	      ONE_MORE_BYTE (c1);
 	      goto label_escape_sequence;
 	    case '$':		/* designation of 2-byte character set */
 	      ONE_MORE_BYTE (c1);
 		{	/* designation of DIMENSION2_CHARS96 character set */
 		  ONE_MORE_BYTE (c2);
 		  DECODE_DESIGNATION (c1 - 0x2C, 2, 96, c2);
 		}
 	      else
-		{
+		goto label_invalid_escape_sequence;
-		  goto label_invalid_escape_sequence;
-		}
 	      break;
 	    case 'n':		/* invocation of locking-shift-2 */
+	      if (CODING_SPEC_ISO_DESIGNATION (coding, 2) < 0)
+		goto label_invalid_escape_sequence;
 	      CODING_SPEC_ISO_INVOCATION (coding, 0) = 2;
+	      charset0 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 0);
 	      break;
 	    case 'o':		/* invocation of locking-shift-3 */
+	      if (CODING_SPEC_ISO_DESIGNATION (coding, 3) < 0)
+		goto label_invalid_escape_sequence;
 	      CODING_SPEC_ISO_INVOCATION (coding, 0) = 3;
+	      charset0 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 0);
 	      break;
 	    case 'N':		/* invocation of single-shift-2 */
+	      if (CODING_SPEC_ISO_DESIGNATION (coding, 2) < 0)
+		goto label_invalid_escape_sequence;
 	      ONE_MORE_BYTE (c1);
 	      charset = CODING_SPEC_ISO_DESIGNATION (coding, 2);
 	      DECODE_ISO_CHARACTER (charset, c1);
 	      break;
 	    case 'O':		/* invocation of single-shift-3 */
+	      if (CODING_SPEC_ISO_DESIGNATION (coding, 3) < 0)
+		goto label_invalid_escape_sequence;
 	      ONE_MORE_BYTE (c1);
 	      charset = CODING_SPEC_ISO_DESIGNATION (coding, 3);
 	      DECODE_ISO_CHARACTER (charset, c1);
 	      break;
 #define ENCODE_DIRECTION_L2R	\
 ENCODE_CONTROL_SEQUENCE_INTRODUCER, *dst++ = '0', *dst++ = ']'
 /* Produce codes for designation and invocation to reset the graphic
 planes and registers to initial state.  */
-#define ENCODE_RESET_PLANE_AND_REGISTER(eol)				      \
+#define ENCODE_RESET_PLANE_AND_REGISTER					    \
-do {									      \
+do {									    \
-int reg;								      \
+int reg;								    \
-if (CODING_SPEC_ISO_INVOCATION (coding, 0) != 0)			      \
+if (CODING_SPEC_ISO_INVOCATION (coding, 0) != 0)			    \
-ENCODE_SHIFT_IN;							      \
+ENCODE_SHIFT_IN;							    \
-for (reg = 0; reg < 4; reg++)					      \
+for (reg = 0; reg < 4; reg++)					    \
-{									      \
+if (CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, reg) >= 0	    \
-	if (CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, reg) < 0)	      \
+	  && (CODING_SPEC_ISO_DESIGNATION (coding, reg)			    \
-	  {								      \
+	      != CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, reg)))	    \
-	    if (eol) CODING_SPEC_ISO_DESIGNATION (coding, reg) = -1;	      \
+	ENCODE_DESIGNATION						    \
-	  }								      \
+	  (CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, reg), reg, coding); \
-	else if (CODING_SPEC_ISO_DESIGNATION (coding, reg)		      \
-		 != CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, reg))	      \
-	  ENCODE_DESIGNATION						      \
-	    (CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, reg), reg, coding); \
-}									      \
 } while (0)
+int
+encode_designation_at_bol (coding, src, src_end, dstp)
+struct coding_system *coding;
+unsigned char *src, *src_end, **dstp;
+{
+int charset, reg, r[4];
+unsigned char *dst = *dstp, c;
+for (reg = 0; reg < 4; reg++) r[reg] = -1;
+while (src < src_end && (c = *src++) != '\n')
+{
+switch (emacs_code_class[c])
+	{
+	case EMACS_ascii_code:
+	  charset = CHARSET_ASCII;
+	  break;
+	case EMACS_leading_code_2:
+	  if (++src >= src_end) continue;
+	  charset = c;
+	  break;
+	case EMACS_leading_code_3:
+	  if ((src += 2) >= src_end) continue;
+	  charset =  (c < LEADING_CODE_PRIVATE_11 ? c : *(src - 2));
+	  break;
+	case EMACS_leading_code_4:
+	  if ((src += 3) >= src_end) continue;
+	  charset = *(src - 3);
+	  break;
+	default:
+	  continue;
+	}
+reg = CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset);
+if (r[reg] < 0
+	  && CODING_SPEC_ISO_DESIGNATION (coding, reg) != charset)
+	r[reg] = charset;
+}
+if (c != '\n' && !coding->last_block)
+return -1;
+for (reg = 0; reg < 4; reg++)
+if (r[reg] >= 0)
+ENCODE_DESIGNATION (r[reg], reg, coding);
+*dstp = dst;
+return 0;
+}
 /* See the above "GENERAL NOTES on `encode_coding_XXX ()' functions".  */
 int
 encode_coding_iso2022 (coding, source, destination,
 {
 unsigned char *src = source;
 unsigned char *src_end = source + src_bytes;
 unsigned char *dst = destination;
 unsigned char *dst_end = destination + dst_bytes;
-/* Since the maximum bytes produced by each loop is 6, we subtract 5
+/* Since the maximum bytes produced by each loop is 20, we subtract 19
 from DST_END to assure overflow checking is necessary only at the
 head of loop.  */
-unsigned char *adjusted_dst_end = dst_end - 5;
+unsigned char *adjusted_dst_end = dst_end - 19;
 while (src < src_end && dst < adjusted_dst_end)
 {
 /* SRC_BASE remembers the start position in source in each loop.
 	 The loop will be exited when there's not enough source text
 	 to analyze multi-byte codes (within macros ONE_MORE_BYTE,
 	 TWO_MORE_BYTES, and THREE_MORE_BYTES).  In that case, SRC is
 	 reset to SRC_BASE before exiting.  */
 unsigned char *src_base = src;
-unsigned char c1 = *src++, c2, c3, c4;
+unsigned char c1, c2, c3, c4;
 int charset;
+if (coding->flags & CODING_FLAG_ISO_DESIGNATE_AT_BOL
+	  && CODING_SPEC_ISO_BOL (coding))
+	{
+	  /* We have to produce destination sequences now.  */
+	  if (encode_designation_at_bol (coding, src, src_end, &dst) < 0)
+	    /* We can't find end of line in the current block.  Let's
+	     repeat encoding starting from the current position
+	     pointed by SRC.  */
+	    break;
+	  CODING_SPEC_ISO_BOL (coding) = 0;
+	}
+c1 = *src++;
 /* If we are seeing a component of a composite character, we are
 	 seeing a leading-code specially encoded for composition, or a
 	 composition rule if composing with rule.  We must set C1
 	 to a normal leading-code or an ASCII code.  If we are not at
 	 a composed character, we must reset the composition state.  */
 	  ENCODE_ISO_CHARACTER_DIMENSION1 (CHARSET_ASCII, c1);
 	  break;
 	case EMACS_control_code:
 	  if (coding->flags & CODING_FLAG_ISO_RESET_AT_CNTL)
-	    ENCODE_RESET_PLANE_AND_REGISTER (0);
+	    ENCODE_RESET_PLANE_AND_REGISTER;
 	  *dst++ = c1;
 	  break;
 	case EMACS_carriage_return_code:
 	  if (!coding->selective)
 	    {
 	      if (coding->flags & CODING_FLAG_ISO_RESET_AT_CNTL)
-		ENCODE_RESET_PLANE_AND_REGISTER (0);
+		ENCODE_RESET_PLANE_AND_REGISTER;
 	      *dst++ = c1;
 	      break;
 	    }
 	  /* fall down to treat '\r' as '\n' ...  */
 	case EMACS_linefeed_code:
 	  if (coding->flags & CODING_FLAG_ISO_RESET_AT_EOL)
-	    ENCODE_RESET_PLANE_AND_REGISTER (1);
+	    ENCODE_RESET_PLANE_AND_REGISTER;
+	  if (coding->flags & CODING_FLAG_ISO_INIT_AT_BOL)
+	    bcopy (coding->spec.iso2022.initial_designation,
+		   coding->spec.iso2022.current_designation,
+		   sizeof coding->spec.iso2022.initial_designation);
 	  if (coding->eol_type == CODING_EOL_LF
 	      || coding->eol_type == CODING_EOL_AUTOMATIC)
 	    *dst++ = ISO_CODE_LF;
 	  else if (coding->eol_type == CODING_EOL_CRLF)
 	    *dst++ = ISO_CODE_CR, *dst++ = ISO_CODE_LF;
 	  else
 	    *dst++ = ISO_CODE_CR;
+	  CODING_SPEC_ISO_BOL (coding) = 1;
 	  break;
 	case EMACS_leading_code_2:
 	  ONE_MORE_BYTE (c2);
 	  ENCODE_ISO_CHARACTER_DIMENSION1 (c1, c2);
 reset the state of graphic planes and registers to initial one.
 In addition, we had better just flush out all remaining codes in
 the text although they are not valid characters.  */
 if (coding->last_block)
 {
-ENCODE_RESET_PLANE_AND_REGISTER (1);
+ENCODE_RESET_PLANE_AND_REGISTER;
 bcopy(src, dst, src_end - src);
 dst += (src_end - src);
 src = src_end;
 }
 *consumed = src - source;
 and set it in CODING.  If CODING_SYSTEM_SYMBOL is invalid, CODING
 is setup so that no conversion is necessary and return -1, else
 return 0.  */
 int
-setup_coding_system (coding_system_symbol, coding)
+setup_coding_system (coding_system, coding)
-Lisp_Object coding_system_symbol;
+Lisp_Object coding_system;
 struct coding_system *coding;
 {
-Lisp_Object coding_system_vector = Qnil;
 Lisp_Object type, eol_type;
 /* At first, set several fields default values.  */
 coding->require_flushing = 0;
 coding->last_block = 0;
 coding->selective = 0;
 coding->composing = 0;
 coding->direction = 0;
 coding->carryover_size = 0;
-coding->symbol = Qnil;
 coding->post_read_conversion = coding->pre_write_conversion = Qnil;
-/* Get value of property `coding-system'.  If it is a Lisp symbol
+Vlast_coding_system_used = coding->symbol = coding_system;
-pointing another coding system, fetch its property until we get a
+eol_type = Qnil;
-vector.  */
+/* Get value of property `coding-system' until we get a vector.
-while (!NILP (coding_system_symbol))
+While doing that, also get values of properties
+`post-read-conversion', `pre-write-conversion', and `eol-type'.  */
+while (!NILP (coding_system) && SYMBOLP (coding_system))
 {
-coding->symbol = coding_system_symbol;
 if (NILP (coding->post_read_conversion))
-	coding->post_read_conversion = Fget (coding_system_symbol,
+	coding->post_read_conversion = Fget (coding_system,
 					     Qpost_read_conversion);
 if (NILP (coding->pre_write_conversion))
-	coding->pre_write_conversion = Fget (coding_system_symbol,
+	coding->pre_write_conversion = Fget (coding_system,
 					     Qpre_write_conversion);
+if (NILP (eol_type))
-coding_system_vector = Fget (coding_system_symbol, Qcoding_system);
+	eol_type = Fget (coding_system, Qeol_type);
-if (VECTORP (coding_system_vector))
+coding_system = Fget (coding_system, Qcoding_system);
-	break;
-coding_system_symbol = coding_system_vector;
 }
-Vlast_coding_system_used = coding->symbol;
+if (!VECTORP (coding_system)
+|| XVECTOR (coding_system)->size != 5)
-if (!VECTORP (coding_system_vector)
-|| XVECTOR (coding_system_vector)->size != 5)
 goto label_invalid_coding_system;
-/* Get value of property `eol-type' by searching from the root
-coding-system.  */
-coding_system_symbol = coding->symbol;
-eol_type = Qnil;
-while (SYMBOLP (coding_system_symbol) && !NILP (coding_system_symbol))
-{
-eol_type = Fget (coding_system_symbol, Qeol_type);
-if (!NILP (eol_type))
-	break;
-coding_system_symbol = Fget (coding_system_symbol, Qcoding_system);
-}
 if (VECTORP (eol_type))
 coding->eol_type = CODING_EOL_AUTOMATIC;
 else if (XFASTINT (eol_type) == 1)
 coding->eol_type = CODING_EOL_CRLF;
 else if (XFASTINT (eol_type) == 2)
 coding->eol_type = CODING_EOL_CR;
 else
 coding->eol_type = CODING_EOL_LF;
-type = XVECTOR (coding_system_vector)->contents[0];
+type = XVECTOR (coding_system)->contents[0];
 switch (XFASTINT (type))
 {
 case 0:
 coding->type = coding_type_internal;
 break;
 break;
 case 2:
 coding->type = coding_type_iso2022;
 {
-	Lisp_Object val = XVECTOR (coding_system_vector)->contents[4];
+	Lisp_Object val = XVECTOR (coding_system)->contents[4];
 	Lisp_Object *flags;
 	int i, charset, default_reg_bits = 0;
 	if (!VECTORP (val) || XVECTOR (val)->size != 32)
 	  goto label_invalid_coding_system;
 	     | (NILP (flags[7]) ? 0 : CODING_FLAG_ISO_SEVEN_BITS)
 	     | (NILP (flags[8]) ? 0 : CODING_FLAG_ISO_LOCKING_SHIFT)
 	     | (NILP (flags[9]) ? 0 : CODING_FLAG_ISO_SINGLE_SHIFT)
 	     | (NILP (flags[10]) ? 0 : CODING_FLAG_ISO_USE_ROMAN)
 	     | (NILP (flags[11]) ? 0 : CODING_FLAG_ISO_USE_OLDJIS)
-	     | (NILP (flags[12]) ? 0 : CODING_FLAG_ISO_NO_DIRECTION));
+	     | (NILP (flags[12]) ? 0 : CODING_FLAG_ISO_NO_DIRECTION)
+	     | (NILP (flags[13]) ? 0 : CODING_FLAG_ISO_INIT_AT_BOL)
+	     | (NILP (flags[14]) ? 0 : CODING_FLAG_ISO_DESIGNATE_AT_BOL));
 	/* Invoke graphic register 0 to plane 0.  */
 	CODING_SPEC_ISO_INVOCATION (coding, 0) = 0;
 	/* Invoke graphic register 1 to plane 1 if we can use full 8-bit.  */
 	CODING_SPEC_ISO_INVOCATION (coding, 1)
 	  = (coding->flags & CODING_FLAG_ISO_SEVEN_BITS ? -1 : 1);
 	/* Not single shifting at first.  */
 	CODING_SPEC_ISO_SINGLE_SHIFTING(coding) = 0;
+	/* Beginning of buffer should also be regarded as bol. */
+	CODING_SPEC_ISO_BOL(coding) = 1;
 	/* Checks FLAGS[REG] (REG = 0, 1, 2 3) and decide designations.
 	   FLAGS[REG] can be one of below:
 		integer CHARSET: CHARSET occupies register I,
 		t: designate nothing to REG initially, but can be used
 	for (charset = 0; charset < MAX_CHARSET; charset++)
 	  CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset) = -1;
 	for (i = 0; i < 4; i++)
 	  {
 	    if (INTEGERP (flags[i])
-		&& (charset = XINT (flags[i]), CHARSET_VALID_P (charset)))
+		&& (charset = XINT (flags[i]), CHARSET_VALID_P (charset))
+		|| (charset = get_charset_id (flags[i])) >= 0)
 	      {
 		CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, i) = charset;
 		CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset) = i;
 	      }
 	    else if (EQ (flags[i], Qt))
 	      {
 		Lisp_Object tail = flags[i];
 		if (INTEGERP (XCONS (tail)->car)
 		    && (charset = XINT (XCONS (tail)->car),
-			CHARSET_VALID_P (charset)))
+			CHARSET_VALID_P (charset))
+		    || (charset = get_charset_id (XCONS (tail)->car)) >= 0)
 		  {
 		    CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, i) = charset;
 		    CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset) =i;
 		  }
 		else
 		tail = XCONS (tail)->cdr;
 		while (CONSP (tail))
 		  {
 		    if (INTEGERP (XCONS (tail)->car)
 			&& (charset = XINT (XCONS (tail)->car),
-			    CHARSET_VALID_P (charset)))
+			    CHARSET_VALID_P (charset))
+			|| (charset = get_charset_id (XCONS (tail)->car)) >= 0)
 		      CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset)
 			= i;
 		    else if (EQ (XCONS (tail)->car, Qt))
 		      default_reg_bits |= 1 << i;
 		    tail = XCONS (tail)->cdr;
 break;
 case 3:
 coding->type = coding_type_big5;
 coding->flags
-	= (NILP (XVECTOR (coding_system_vector)->contents[4])
+	= (NILP (XVECTOR (coding_system)->contents[4])
 	   ? CODING_FLAG_BIG5_HKU
 	   : CODING_FLAG_BIG5_ETEN);
 break;
 case 4:
 coding->type = coding_type_ccl;
 {
-	Lisp_Object val = XVECTOR (coding_system_vector)->contents[4];
+	Lisp_Object val = XVECTOR (coding_system)->contents[4];
 	if (CONSP  (val)
 	    && VECTORP (XCONS (val)->car)
 	    && VECTORP (XCONS (val)->cdr))
 	  {
 	    setup_ccl_program (&(coding->spec.ccl.decoder), XCONS (val)->car);
 }
 return 0;
 label_invalid_coding_system:
 coding->type = coding_type_no_conversion;
+coding->symbol = coding->pre_write_conversion = coding->post_read_conversion
+= Qnil;
 return -1;
 }
 /* Emacs has a mechanism to automatically detect a coding system if it
 is one of Emacs' internal format, ISO2022, SJIS, and BIG5.  But,
 o coding-category-internal
 	The category for a coding system which has the same code range
 	as Emacs' internal format.  Assigned the coding-system (Lisp
-	symbol) `coding-system-internal' by default.
+	symbol) `internal' by default.
 o coding-category-sjis
 	The category for a coding system which has the same code range
 	as SJIS.  Assigned the coding-system (Lisp
-	symbol) `coding-system-sjis' by default.
+	symbol) `shift-jis' by default.
 o coding-category-iso-7
 	The category for a coding system which has the same code range
 	as ISO2022 of 7-bit environment.  Assigned the coding-system
-	(Lisp symbol) `coding-system-junet' by default.
+	(Lisp symbol) `iso-2022-7' by default.
 o coding-category-iso-8-1
 	The category for a coding system which has the same code range
 	as ISO2022 of 8-bit environment and graphic plane 1 used only
 	for DIMENSION1 charset.  Assigned the coding-system (Lisp
-	symbol) `coding-system-ctext' by default.
+	symbol) `iso-8859-1' by default.
 o coding-category-iso-8-2
 	The category for a coding system which has the same code range
 	as ISO2022 of 8-bit environment and graphic plane 1 used only
 	for DIMENSION2 charset.  Assigned the coding-system (Lisp
-	symbol) `coding-system-euc-japan' by default.
+	symbol) `euc-japan' by default.
 o coding-category-iso-else
 	The category for a coding system which has the same code range
 	as ISO2022 but not belongs to any of the above three
 	categories.  Assigned the coding-system (Lisp symbol)
-	`coding-system-iso-2022-ss2-7' by default.
+	`iso-2022-ss2-7' by default.
 o coding-category-big5
 	The category for a coding system which has the same code range
 	as BIG5.  Assigned the coding-system (Lisp symbol)
-	`coding-system-big5' by default.
+	`cn-big5' by default.
 o coding-category-binary
 	The category for a coding system not categorized in any of the
 	above.  Assigned the coding-system (Lisp symbol)
-	`coding-system-noconv' by default.
+	`no-conversion' by default.
 Each of them is a Lisp symbol and the value is an actual
 `coding-system's (this is also a Lisp symbol) assigned by a user.
 What Emacs does actually is to detect a category of coding system.
 Then, it uses a `coding-system' assigned to it.  If Emacs can't
 	  bcopy (source, destination, produced);
 	  if (coding->selective)
 	    {
 	      unsigned char *p = destination, *pend = destination + produced;
 	      while (p < pend)
-		if (*p++ = '\015') p[-1] = '\n';
+		if (*p++ == '\015') p[-1] = '\n';
 	    }
 	}
 *consumed = produced;
 break;
 return ((NILP (obj) || !NILP (Fcoding_system_vector (obj))) ? Qt : Qnil);
 }
 DEFUN ("read-non-nil-coding-system",
 Fread_non_nil_coding_system, Sread_non_nil_coding_system, 1, 1, 0,
-"Read a coding-system from the minibuffer, prompting with string PROMPT.")
+"Read a coding system from the minibuffer, prompting with string PROMPT.")
 (prompt)
 Lisp_Object prompt;
 {
-return Fintern (Fcompleting_read (prompt, Vobarray, Qcoding_system_vector,
+Lisp_Object val;
-				    Qt, Qnil, Qnil),
+do {
-		  Qnil);
+val = Fcompleting_read (prompt, Vobarray, Qcoding_system_vector,
+			    Qt, Qnil, Qnil);
+} while (XSTRING (val)->size == 0);
+return (Fintern (val, Qnil));
 }
 DEFUN ("read-coding-system", Fread_coding_system, Sread_coding_system, 1, 1, 0,
-"Read a coding-system or nil from the minibuffer, prompting with string PROMPT.")
+"Read a coding system or nil from the minibuffer, prompting with string PROMPT.")
 (prompt)
 Lisp_Object prompt;
 {
-return Fintern (Fcompleting_read (prompt, Vobarray, Qcoding_system_p,
+Lisp_Object val = Fcompleting_read (prompt, Vobarray, Qcoding_system_p,
-				    Qt, Qnil, Qnil),
+				      Qt, Qnil, Qnil);
-		  Qnil);
+return (XSTRING (val)->size == 0 ? Qnil : Fintern (val, Qnil));
 }
 DEFUN ("check-coding-system", Fcheck_coding_system, Scheck_coding_system,
 1, 1, 0,
 "Check validity of CODING-SYSTEM.\n\
 DEFUN ("detect-coding-region", Fdetect_coding_region, Sdetect_coding_region,
 2, 2, 0,
 "Detect coding-system of the text in the region between START and END.\n\
 Return a list of possible coding-systems ordered by priority.\n\
-If only ASCII characters are found, it returns `coding-system-automatic'\n\
+If only ASCII characters are found, it returns `automatic-conversion'\n\
 or its subsidiary coding-system according to a detected end-of-line format.")
 (b, e)
 Lisp_Object b, e;
 {
 int coding_mask, eol_type;
 coding_mask = detect_coding_mask (POS_ADDR (beg), end - beg);
 eol_type  = detect_eol_type (POS_ADDR (beg), end - beg);
 if (coding_mask == CODING_CATEGORY_MASK_ANY)
 {
-val = intern ("coding-system-automatic");
+val = intern ("automatic-conversion");
 if (eol_type != CODING_EOL_AUTOMATIC)
 	{
 	  Lisp_Object val2 = Fget (val, Qeol_type);
 	  if (VECTORP (val2))
 	    val = XVECTOR (val2)->contents[eol_type];
 	  *begp = *endp;
 	  return;
 	case coding_type_ccl:
 	  /* We can't skip any data.  */
 	  return;
+	case coding_type_iso2022:
+	  if (coding->flags & CODING_FLAG_ISO_DESIGNATE_AT_BOL)
+	    {
+	      unsigned char *bol = beg_addr;
+	      while (beg_addr < end_addr && *beg_addr < 0x80)
+		{
+		  beg_addr++;
+		  if (*(beg_addr - 1) == '\n')
+		    bol = beg_addr;
+		}
+	      beg_addr = bol;
+	      goto label_skip_tail;
+	    }
+	  /* fall down ... */
 	default:
 	  /* We can skip all ASCII characters at the head and tail.  */
 	  while (beg_addr < end_addr && *beg_addr < 0x80) beg_addr++;
+	label_skip_tail:
 	  while (beg_addr < end_addr && *(end_addr - 1) < 0x80) end_addr--;
 	  break;
 	}
 }
 else				/* for decoding */
 return make_number (len);
 }
 Lisp_Object
-code_convert_string (str, coding, encodep)
+code_convert_string (str, coding, encodep, nocopy)
-Lisp_Object str;
+Lisp_Object str, nocopy;
 struct coding_system *coding;
 int encodep;
 {
 int len, consumed, produced;
 char *buf;
 endp = begp + XSTRING (str)->size;
 shrink_conversion_area (&begp, &endp, coding, encodep);
 if (begp == endp)
 /* We need no conversion.  */
-return str;
+return (NILP (nocopy) ? Fcopy_sequence (str) : str);
 head_skip = begp - XSTRING (str)->data;
 tail_skip = XSTRING (str)->size - head_skip - (endp - begp);
 GCPRO1 (str);
 return make_string (buf, head_skip + produced + tail_skip);
 }
 DEFUN ("decode-coding-region", Fdecode_coding_region, Sdecode_coding_region,
-3, 3, 0,
+3, 3, "r\nzCoding system: ",
-"Decode the text between START and END which is encoded in CODING-SYSTEM.\n\
+"Decode current region by specified coding system.\n\
+When called from a program, takes three arguments:\n\
+START, END, and CODING-SYSTEM.  START END are buffer positions.\n\
 Return length of decoded text.")
 (b, e, coding_system)
 Lisp_Object b, e, coding_system;
 {
 struct coding_system coding;
 CHECK_NUMBER_COERCE_MARKER (b, 0);
 CHECK_NUMBER_COERCE_MARKER (e, 1);
 CHECK_SYMBOL (coding_system, 2);
+if (NILP (coding_system))
+return make_number (XFASTINT (e) - XFASTINT (b));
 if (setup_coding_system (Fcheck_coding_system (coding_system), &coding) < 0)
 error ("Invalid coding-system: %s", XSYMBOL (coding_system)->name->data);
 return code_convert_region (b, e, &coding, 0);
 }
 DEFUN ("encode-coding-region", Fencode_coding_region, Sencode_coding_region,
-3, 3, 0,
+3, 3, "r\nzCoding system: ",
-"Encode the text between START and END to CODING-SYSTEM.\n\
+"Encode current region by specified coding system.\n\
+When called from a program, takes three arguments:\n\
+START, END, and CODING-SYSTEM.  START END are buffer positions.\n\
 Return length of encoded text.")
 (b, e, coding_system)
 Lisp_Object b, e, coding_system;
 {
 struct coding_system coding;
 CHECK_NUMBER_COERCE_MARKER (b, 0);
 CHECK_NUMBER_COERCE_MARKER (e, 1);
 CHECK_SYMBOL (coding_system, 2);
+if (NILP (coding_system))
+return make_number (XFASTINT (e) - XFASTINT (b));
 if (setup_coding_system (Fcheck_coding_system (coding_system), &coding) < 0)
 error ("Invalid coding-system: %s", XSYMBOL (coding_system)->name->data);
 return code_convert_region (b, e, &coding, 1);
 }
 DEFUN ("decode-coding-string", Fdecode_coding_string, Sdecode_coding_string,
-2, 2, 0,
+2, 3, 0,
-"Decode STRING which is encoded in CODING-SYSTEM, and return the result.")
+"Decode STRING which is encoded in CODING-SYSTEM, and return the result.\n\
-(string, coding_system)
+Optional arg NOCOPY non-nil means return STRING itself if there's no need\n\
-Lisp_Object string, coding_system;
+of decoding.")
+(string, coding_system, nocopy)
+Lisp_Object string, coding_system, nocopy;
 {
 struct coding_system coding;
 CHECK_STRING (string, 0);
 CHECK_SYMBOL (coding_system, 1);
+if (NILP (coding_system))
+return (NILP (nocopy) ? Fcopy_sequence (string) : string);
 if (setup_coding_system (Fcheck_coding_system (coding_system), &coding) < 0)
 error ("Invalid coding-system: %s", XSYMBOL (coding_system)->name->data);
-return code_convert_string (string, &coding, 0);
+return code_convert_string (string, &coding, 0, nocopy);
 }
 DEFUN ("encode-coding-string", Fencode_coding_string, Sencode_coding_string,
-2, 2, 0,
+2, 3, 0,
-"Encode STRING to CODING-SYSTEM, and return the result.")
+"Encode STRING to CODING-SYSTEM, and return the result.\n\
-(string, coding_system)
+Optional arg NOCOPY non-nil means return STRING itself if there's no need\n\
-Lisp_Object string, coding_system;
+of encoding.")
+(string, coding_system, nocopy)
+Lisp_Object string, coding_system, nocopy;
 {
 struct coding_system coding;
 CHECK_STRING (string, 0);
 CHECK_SYMBOL (coding_system, 1);
+if (NILP (coding_system))
+return (NILP (nocopy) ? Fcopy_sequence (string) : string);
 if (setup_coding_system (Fcheck_coding_system (coding_system), &coding) < 0)
 error ("Invalid coding-system: %s", XSYMBOL (coding_system)->name->data);
-return code_convert_string (string, &coding, 1);
+return code_convert_string (string, &coding, 1, nocopy);
 }
 DEFUN ("decode-sjis-char", Fdecode_sjis_char, Sdecode_sjis_char, 1, 1, 0,
-"Decode a JISX0208 character of SJIS coding-system-sjis.\n\
+"Decode a JISX0208 character of shift-jis encoding.\n\
 CODE is the character code in SJIS.\n\
 Return the corresponding character.")
 (code)
 Lisp_Object code;
 {
 For process I/O, TARGET is a process name.\n\
 For network I/O, TARGET is a service name or a port number\n\
 \n\
 The return value is a cons of coding systems for decoding and encoding\n\
 registered in nested alist `coding-system-alist' (which see) at a slot\n\
-corresponding to OPERATION and TARGET.
+corresponding to OPERATION and TARGET.\n\
 If a function symbol is at the slot, return a result of the function call.\n\
 The function is called with one argument, a list of all the arguments.")
 (nargs, args)
 int nargs;
 Lisp_Object *args;
 iso_code_class[ISO_CODE_ESC] = ISO_escape;
 iso_code_class[ISO_CODE_SS2] = ISO_single_shift_2;
 iso_code_class[ISO_CODE_SS3] = ISO_single_shift_3;
 iso_code_class[ISO_CODE_CSI] = ISO_control_sequence_introducer;
+conversion_buffer_size = MINIMUM_CONVERSION_BUFFER_SIZE;
+conversion_buffer = (char *) xmalloc (MINIMUM_CONVERSION_BUFFER_SIZE);
+setup_coding_system (Qnil, &keyboard_coding);
+setup_coding_system (Qnil, &terminal_coding);
+}
+#ifdef emacs
+syms_of_coding ()
+{
+Qtarget_idx = intern ("target-idx");
+staticpro (&Qtarget_idx);
+Fput (Qinsert_file_contents, Qtarget_idx, make_number (0));
+Fput (Qwrite_region, Qtarget_idx, make_number (2));
+Qcall_process = intern ("call-process");
+staticpro (&Qcall_process);
+Fput (Qcall_process, Qtarget_idx, make_number (0));
+Qcall_process_region = intern ("call-process-region");
+staticpro (&Qcall_process_region);
+Fput (Qcall_process_region, Qtarget_idx, make_number (2));
+Qstart_process = intern ("start-process");
+staticpro (&Qstart_process);
+Fput (Qstart_process, Qtarget_idx, make_number (2));
+Qopen_network_stream = intern ("open-network-stream");
+staticpro (&Qopen_network_stream);
+Fput (Qopen_network_stream, Qtarget_idx, make_number (3));
 Qcoding_system = intern ("coding-system");
 staticpro (&Qcoding_system);
 Qeol_type = intern ("eol-type");
 staticpro (&Qeol_type);
 	staticpro (&coding_category_table[i]);
 	Fput (coding_category_table[i], Qcoding_category_index,
 	      make_number (i));
 }
 }
-conversion_buffer_size = MINIMUM_CONVERSION_BUFFER_SIZE;
-conversion_buffer = (char *) xmalloc (MINIMUM_CONVERSION_BUFFER_SIZE);
-setup_coding_system (Qnil, &keyboard_coding);
-setup_coding_system (Qnil, &terminal_coding);
-}
-#ifdef emacs
-syms_of_coding ()
-{
-Qtarget_idx = intern ("target-idx");
-staticpro (&Qtarget_idx);
-Fput (Qinsert_file_contents, Qtarget_idx, make_number (0));
-Fput (Qwrite_region, Qtarget_idx, make_number (2));
-Qcall_process = intern ("call-process");
-staticpro (&Qcall_process);
-Fput (Qcall_process, Qtarget_idx, make_number (0));
-Qcall_process_region = intern ("call-process-region");
-staticpro (&Qcall_process_region);
-Fput (Qcall_process_region, Qtarget_idx, make_number (2));
-Qstart_process = intern ("start-process");
-staticpro (&Qstart_process);
-Fput (Qstart_process, Qtarget_idx, make_number (2));
-Qopen_network_stream = intern ("open-network-stream");
-staticpro (&Qopen_network_stream);
-Fput (Qopen_network_stream, Qtarget_idx, make_number (3));
 defsubr (&Scoding_system_vector);
 defsubr (&Scoding_system_p);
 defsubr (&Sread_coding_system);
 defsubr (&Sread_non_nil_coding_system);
 Vlast_coding_system_used = Qnil;
 DEFVAR_LISP ("coding-system-alist", &Vcoding_system_alist,
 "Nested alist to decide a coding system for a specific I/O operation.\n\
 The format is ((OPERATION . ((REGEXP . CODING-SYSTEMS) ...)) ...).\n\
+\n\
 OPERATION is one of the following Emacs I/O primitives:\n\
 For file I/O, insert-file-contents and write-region.\n\
 For process I/O, call-process, call-process-region, and start-process.\n\
 For network I/O, open-network-stream.\n\
 In addition, for process I/O, `process-argument' can be specified for\n\

Mercurial > emacs

comparison src/coding.c @ 17119:2cfb31c15ced