comparison src/coding.c @ 18180:5f4c4da24e75

(Vcoding_system_alist): Deleted. (Qcoding_system_spec): Renamed from Qcoding_system_vector. (Vdefault_process_coding_system, Vfile_coding_system_alist, Vprocess_coding_system_alist, Vnetwork_coding_system_alist): New variables. (Ffind_coding_system): Adjusted for the above change. (syms_of_coding): Declare them as lisp variables. (Fcheck_coding_system): Pass list as DATA argument to Fsignal.

18179:371736608f2f

   decided.  */
int eol_mnemonic_undecided;

#ifdef emacs

Lisp_Object Qcoding_system_vector, Qcoding_system_p, Qcoding_system_error;

/* Coding-systems are handed between Emacs Lisp programs and C internal
   routines by the following three variables.  */
/* Coding-system for reading files and receiving data from process.  */
Lisp_Object Vcoding_system_for_read;

struct coding_system terminal_coding;

/* Coding-system of what is sent from terminal keyboard.  */
struct coding_system keyboard_coding;

Lisp_Object Vcoding_system_alist;

#endif /* emacs */

Lisp_Object Qcoding_category_index;

Lisp_Object Qcharacter_unification_table;

/* Alist of charsets vs revision number.  */
Lisp_Object Vcharset_revision_alist;


/*** 2. Emacs internal format (emacs-mule) handlers ***/

/* Emacs' internal format for encoding multiple character sets is a


#ifdef emacs
/*** 7. Emacs Lisp library functions ***/

DEFUN ("coding-system-vector", Fcoding_system_vector, Scoding_system_vector,
       1, 1, 0,
  "Return coding-vector of CODING-SYSTEM.\n\
If CODING-SYSTEM is not a valid coding-system, return nil.")
  (obj)
     Lisp_Object obj;
{
  while (SYMBOLP (obj) && !NILP (obj))

  "Return t if OBJECT is nil or a coding-system.\n\
See document of make-coding-system for coding-system object.")
  (obj)
     Lisp_Object obj;
{
  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.")

     Lisp_Object prompt;
{
  Lisp_Object val;
  do
    {
      val = Fcompleting_read (prompt, Vobarray, Qcoding_system_vector,
			      Qt, Qnil, Qnil, Qnil);
    }
  while (XSTRING (val)->size == 0);
  return (Fintern (val, Qnil));
}

{
  CHECK_SYMBOL (coding_system, 0);
  if (!NILP (Fcoding_system_p (coding_system)))
    return coding_system;
  while (1)
    Fsignal (Qcoding_system_error, coding_system);
}

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\

TARGET has a meaning which depends on OPERATION:\n\
  For file I/O, TARGET is a file name.\n\
  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\
This function looks up what `coding-system-alist' specifies for\n\
OPERATION and TARGET.  It may specify a cons cell which represents\n\
a particular coding system or it may have a function to call.\n\
In the latter case, we call the function with one argument,\n\
which is a list of all the arguments given to `find-coding-system'.")
  (nargs, args)
     int nargs;
     Lisp_Object *args;
{

  target = args[XINT (target_idx) + 1];
  if (!(STRINGP (target)
	|| (EQ (operation, Qopen_network_stream) && INTEGERP (target))))
    error ("Invalid %dth argument", XINT (target_idx) + 1);

  chain = Fassq (operation, Vcoding_system_alist);
  if (NILP (chain))
    return Qnil;

  for (chain = XCONS (chain)->cdr; CONSP (chain); chain = XCONS (chain)->cdr)
    {
      Lisp_Object elt = XCONS (chain)->car;

      if (CONSP (elt)
	  && ((STRINGP (target)
	       && STRINGP (XCONS (elt)->car)
	       && fast_string_match (XCONS (elt)->car, target) >= 0)
	      || (INTEGERP (target) && EQ (target, XCONS (elt)->car))))
	return (val = XCONS (elt)->cdr, CONSP (val)
		? val
		: ((SYMBOLP (val) && !NILP (Fboundp (val))
		    ? call2 (val, Flist (nargs, args))
		    : Qnil)));
    }
  return Qnil;
}

#endif /* emacs */

  staticpro (&Qpost_read_conversion);

  Qpre_write_conversion = intern ("pre-write-conversion");
  staticpro (&Qpre_write_conversion);

  Qcoding_system_vector = intern ("coding-system-vector");
  staticpro (&Qcoding_system_vector);

  Qcoding_system_p = intern ("coding-system-p");
  staticpro (&Qcoding_system_p);

  Qcoding_system_error = intern ("coding-system-error");

  Qcharacter_unification_table = intern ("character-unification-table");
  staticpro (&Qcharacter_unification_table);
  Fput (Qcharacter_unification_table, Qchar_table_extra_slots,
	make_number (0));

  defsubr (&Scoding_system_vector);
  defsubr (&Scoding_system_p);
  defsubr (&Sread_coding_system);
  defsubr (&Sread_non_nil_coding_system);
  defsubr (&Scheck_coding_system);
  defsubr (&Sdetect_coding_region);

  DEFVAR_LISP ("last-coding-system-used", &Vlast_coding_system_used,
    "Coding-system used in the latest file or process I/O.");
  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\
encoding arguments of the process.\n\
\n\
REGEXP is a regular expression matching a target of OPERATION, where\n\
target is a file name for file I/O operations, a process name for\n\
process I/O operations, or a service name for network I/O\n\
operations.  REGEXP might be a port number for network I/O operation.\n\
\n\
CODING-SYSTEMS is a cons of coding systems to encode and decode\n\
character code on OPERATION, or a function symbol returning the cons.\n\
See the documentation of `find-coding-system' for more detail.");
  Vcoding_system_alist = Qnil;

  DEFVAR_INT ("eol-mnemonic-unix", &eol_mnemonic_unix,
    "Mnemonic character indicating UNIX-like end-of-line format (i.e. LF) .");
  eol_mnemonic_unix = '.';

  DEFVAR_LISP ("charset-revision-table", &Vcharset_revision_alist,
    "Alist of charsets vs revision numbers.\n\
While encoding, if a charset (car part of an element) is found,\n\
designate it with the escape sequence identifing revision (cdr part of the element).");
  Vcharset_revision_alist = Qnil;
}

#endif /* emacs */

18180:5f4c4da24e75

   decided.  */
int eol_mnemonic_undecided;

#ifdef emacs

Lisp_Object Qcoding_system_spec, Qcoding_system_p, Qcoding_system_error;

/* Coding-systems are handed between Emacs Lisp programs and C internal
   routines by the following three variables.  */
/* Coding-system for reading files and receiving data from process.  */
Lisp_Object Vcoding_system_for_read;

struct coding_system terminal_coding;

/* Coding-system of what is sent from terminal keyboard.  */
struct coding_system keyboard_coding;

Lisp_Object Vfile_coding_system_alist;
Lisp_Object Vprocess_coding_system_alist;
Lisp_Object Vnetwork_coding_system_alist;

#endif /* emacs */

Lisp_Object Qcoding_category_index;

Lisp_Object Qcharacter_unification_table;

/* Alist of charsets vs revision number.  */
Lisp_Object Vcharset_revision_alist;

/* Default coding systems used for process I/O.  */
Lisp_Object Vdefault_process_coding_system;


/*** 2. Emacs internal format (emacs-mule) handlers ***/

/* Emacs' internal format for encoding multiple character sets is a


#ifdef emacs
/*** 7. Emacs Lisp library functions ***/

DEFUN ("coding-system-spec", Fcoding_system_spec, Scoding_system_spec,
       1, 1, 0,
  "Return coding-spec of CODING-SYSTEM.\n\
If CODING-SYSTEM is not a valid coding-system, return nil.")
  (obj)
     Lisp_Object obj;
{
  while (SYMBOLP (obj) && !NILP (obj))

  "Return t if OBJECT is nil or a coding-system.\n\
See document of make-coding-system for coding-system object.")
  (obj)
     Lisp_Object obj;
{
  return ((NILP (obj) || !NILP (Fcoding_system_spec (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.")

     Lisp_Object prompt;
{
  Lisp_Object val;
  do
    {
      val = Fcompleting_read (prompt, Vobarray, Qcoding_system_spec,
			      Qt, Qnil, Qnil, Qnil);
    }
  while (XSTRING (val)->size == 0);
  return (Fintern (val, Qnil));
}

{
  CHECK_SYMBOL (coding_system, 0);
  if (!NILP (Fcoding_system_p (coding_system)))
    return coding_system;
  while (1)
    Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil));
}

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\

TARGET has a meaning which depends on OPERATION:\n\
  For file I/O, TARGET is a file name.\n\
  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\
This function looks up what specified for TARGET in,\n\
`file-coding-system-alist', `process-coding-system-alist',\n\
or `network-coding-system-alist' depending on OPERATION.\n\
They may specify a coding system, a cons of coding systems,\n\
or a function symbol to call.\n\
In the last case, we call the function with one argument,\n\
which is a list of all the arguments given to `find-coding-system'.")
  (nargs, args)
     int nargs;
     Lisp_Object *args;
{

  target = args[XINT (target_idx) + 1];
  if (!(STRINGP (target)
	|| (EQ (operation, Qopen_network_stream) && INTEGERP (target))))
    error ("Invalid %dth argument", XINT (target_idx) + 1);

  chain = (operation == Qinsert_file_contents || operation == Qwrite_region
	   ? Vfile_coding_system_alist
	   : (operation == Qopen_network_stream
	      ? Vnetwork_coding_system_alist
	      : Vprocess_coding_system_alist));
  if (NILP (chain))
    return Qnil;

  for (; CONSP (chain); chain = XCONS (chain)->cdr)
    {
      Lisp_Object elt = XCONS (chain)->car;

      if (CONSP (elt)
	  && ((STRINGP (target)
	       && STRINGP (XCONS (elt)->car)
	       && fast_string_match (XCONS (elt)->car, target) >= 0)
	      || (INTEGERP (target) && EQ (target, XCONS (elt)->car))))
	{
	  val = XCONS (elt)->cdr;
	  if (CONSP (val))
	    return val;
	  if (! SYMBOLP (val))
	    return Qnil;
	  if (! NILP (Fcoding_system_p (val)))
	    return Fcons (val, val);
	  if (!NILP (Fboundp (val)))
	    return call2 (val, Flist (nargs, args));
	  return Qnil;
	}
    }
  return Qnil;
}

#endif /* emacs */

  staticpro (&Qpost_read_conversion);

  Qpre_write_conversion = intern ("pre-write-conversion");
  staticpro (&Qpre_write_conversion);

  Qcoding_system_spec = intern ("coding-system-spec");
  staticpro (&Qcoding_system_spec);

  Qcoding_system_p = intern ("coding-system-p");
  staticpro (&Qcoding_system_p);

  Qcoding_system_error = intern ("coding-system-error");

  Qcharacter_unification_table = intern ("character-unification-table");
  staticpro (&Qcharacter_unification_table);
  Fput (Qcharacter_unification_table, Qchar_table_extra_slots,
	make_number (0));

  defsubr (&Scoding_system_spec);
  defsubr (&Scoding_system_p);
  defsubr (&Sread_coding_system);
  defsubr (&Sread_non_nil_coding_system);
  defsubr (&Scheck_coding_system);
  defsubr (&Sdetect_coding_region);

  DEFVAR_LISP ("last-coding-system-used", &Vlast_coding_system_used,
    "Coding-system used in the latest file or process I/O.");
  Vlast_coding_system_used = Qnil;

  DEFVAR_LISP ("file-coding-system-alist", &Vfile_coding_system_alist,
    "Alist to decide a coding system to use for a file I/O operation.\n\
The format is ((PATTERN . VAL) ...),\n\
where PATTERN is a regular expression matching a file name,\n\
VAL is a coding system, a cons of coding systems, or a function symbol.\n\
If VAL is a coding system, it is used for both decoding and encoding\n\
the file contents.\n\
If VAL is a cons of coding systems, the car part is used for decoding,\n\
and the cdr part is used for encoding.\n\
If VAL is a function symbol, the function must return a coding system\n\
or a cons of coding systems which are used as above.\n\
\n\
See also the function `find-coding-system'.");
  Vfile_coding_system_alist = Qnil;

  DEFVAR_LISP ("process-coding-system-alist", &Vprocess_coding_system_alist,
    "Alist to decide a coding system to use for a process I/O operation.\n\
The format is ((PATTERN . VAL) ...),\n\
where PATTERN is a regular expression matching a program name,\n\
VAL is a coding system, a cons of coding systems, or a function symbol.\n\
If VAL is a coding system, it is used for both decoding what received\n\
from the program and encoding what sent to the program.\n\
If VAL is a cons of coding systems, the car part is used for decoding,\n\
and the cdr part is used for encoding.\n\
If VAL is a function symbol, the function must return a coding system\n\
or a cons of coding systems which are used as above.\n\
\n\
See also the function `find-coding-system'.");
  Vprocess_coding_system_alist = Qnil;

  DEFVAR_LISP ("network-coding-system-alist", &Vnetwork_coding_system_alist,
    "Alist to decide a coding system to use for a network I/O operation.\n\
The format is ((PATTERN . VAL) ...),\n\
where PATTERN is a regular expression matching a network service name\n\
or is a port number to connect to,\n\
VAL is a coding system, a cons of coding systems, or a function symbol.\n\
If VAL is a coding system, it is used for both decoding what received\n\
from the network stream and encoding what sent to the network stream.\n\
If VAL is a cons of coding systems, the car part is used for decoding,\n\
and the cdr part is used for encoding.\n\
If VAL is a function symbol, the function must return a coding system\n\
or a cons of coding systems which are used as above.\n\
\n\
See also the function `find-coding-system'.");
  Vnetwork_coding_system_alist = Qnil;

  DEFVAR_INT ("eol-mnemonic-unix", &eol_mnemonic_unix,
    "Mnemonic character indicating UNIX-like end-of-line format (i.e. LF) .");
  eol_mnemonic_unix = '.';

  DEFVAR_LISP ("charset-revision-table", &Vcharset_revision_alist,
    "Alist of charsets vs revision numbers.\n\
While encoding, if a charset (car part of an element) is found,\n\
designate it with the escape sequence identifing revision (cdr part of the element).");
  Vcharset_revision_alist = Qnil;

  DEFVAR_LISP ("default-process-coding-system",
	       &Vdefault_process_coding_system,
    "Cons of coding systems used for process I/O by default.\n\
The car part is used for decoding a process output,\n\
the cdr part is used for encoding a text to be sent to a process.");
  Vdefault_process_coding_system = Qnil;
}

#endif /* emacs */