/* GNU Emacs case conversion functions.

Copyright (C) 1985, 1994, 1997-1999, 2001-2016 Free Software Foundation,
Inc.

This file is part of GNU Emacs.

GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */


#include <config.h>

#include "lisp.h"
#include "character.h"
#include "buffer.h"
#include "commands.h"
#include "syntax.h"
#include "composite.h"
#include "keymap.h"

struct casing_str_buf {
  unsigned char data[MAX_MULTIBYTE_LENGTH > 6 ? MAX_MULTIBYTE_LENGTH : 6];
  unsigned char len_chars;
  unsigned char len_bytes;
};

enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP,
		  /* Only for internal use: */ CASE_NO_ACTION};

#include "special-casing.h"

/* State for casing individual characters.  */
struct casing_context {
  /* A char-table with title-case character mappings or nil.  It being non-nil
     implies flag being CASE_CAPITALIZE or CASE_CAPITALIZE_UP (but the reverse
     is not true).  */
  Lisp_Object titlecase_char_table;
  /* User-requested action. */
  enum case_action flag;
  /* If true, function operates on a buffer as opposed to a string or character.
     When run on a buffer, syntax_prefix_flag_p is taken into account when
     determined inword flag. */
  bool inbuffer;
  /* Whether we are inside of a word. */
  bool inword;
  /* Whether to apply Azeri/Turkish rules for dotted and dotless i. */
  bool treat_turkic_i;

  /* Whether to use Lithuanian rules for i’s and j’s tittle. */
  unsigned char lithuanian_tittle;
#define LT_OFF 0  /* No */
#define LT_ON 1  /* Yes */
#define LT_DEL_DOT_ABOVE 2  /* Yes and look out for combining dot above to
			       delete. */
#define LT_INS_DOT_ABOVE 3  /* Yes and look out for diacritics combining above
			       because we may need to inject dot above before
			       them. */

  /* In Dutch, ‘ij’ is a digraph and when capitalised the whole thing is upper
     cased.  Unicode has ‘ij’ and ‘IJ’ (with proper casing mappings) but they
     aren’t always used so we cannot/should not rely on them.

     Note that rule for capitalising ‘ij’ as a single letter is not present in
     Unicode 9.0’s SpecialCasing.txt.  On the flip side, Firefox implements this
     as well so we’re not completely alone.

     There are words where ‘ij’ are two separate letters (such as bijectie or
     bijoux) in which case the capitalisation rules do not apply.  I (mina86)
     have googled this a little and couldn’t find a Dutch word which beings with
     ‘ij’ that is not a digraph so we should be in the clear since we only care
     about the initial. */

  /* Whether to apply Dutch rules for title-casing ij as IJ.  Non-zero
     value implies flag is CASE_CAPITALIZE or CASE_CAPITALIZE_UP. */
  unsigned char treat_dutch_ij;
#define NL_OFF 0  /* No */
#define NL_ON 1  /* Yes */
#define NL_UPCASE_J 2  /* Yes and the previous character was upcased ‘i’. */
};

/* Initialise CTX structure and prepares related global data for casing
   characters. */
static void
prepare_casing_context (struct casing_context *ctx,
			enum case_action flag, bool inbuffer)
{
  Lisp_Object lang, l, tr, az, lt, nl;

  ctx->flag = flag;
  ctx->inbuffer = inbuffer;
  ctx->inword = false;
  ctx->titlecase_char_table = (int)flag >= (int)CASE_CAPITALIZE
    ? uniprop_table (intern_c_string ("titlecase"))
    : Qnil;

  ctx->treat_turkic_i = false;
  ctx->lithuanian_tittle = LT_OFF;
  ctx->treat_dutch_ij = NL_OFF;

  /* If the case table is flagged as modified, rescan it.  */
  if (NILP (XCHAR_TABLE (BVAR (current_buffer, downcase_table))->extras[1]))
    Fset_case_table (BVAR (current_buffer, downcase_table));

  if (inbuffer && (int) flag >= (int) CASE_CAPITALIZE)
    SETUP_BUFFER_SYNTAX_TABLE ();	/* For syntax_prefix_flag_p.  */

  /* FIXME: Is current-iso639-language the best source of that information? */
  lang = Vcurrent_iso639_language;
  tr = intern_c_string ("tr");
  az = intern_c_string ("az");
  lt = intern_c_string ("lt");
  nl = intern_c_string ("nl");
  if (SYMBOLP (lang))
    {
      l = lang;
      goto check_language;
    }
  while (CONSP (lang))
    {
      l = XCAR (lang);
      lang = XCDR (lang);
    check_language:
      if (EQ (l, tr) || EQ (l, az))
	ctx->treat_turkic_i = true;
      else if (EQ (l, lt))
	ctx->lithuanian_tittle = LT_ON;
      else if (EQ (l, nl))
	ctx->treat_dutch_ij = (int) flag >= (int) CASE_CAPITALIZE;
    }
}

/* Normalise CFG->flag and return CASE_UP, CASE_DOWN, CASE_CAPITALIZE or
   CASE_NO_ACTION.  The latter if CFG->flag is CASE_CAPITALIZE_UP and we are
   inside of a word. */
static enum case_action
normalise_flag (struct casing_context *ctx)
{
  /* Normalise flag so its one of CASE_UP, CASE_DOWN or CASE_CAPITALIZE. */
  switch (ctx->flag) {
  case CASE_CAPITALIZE:
    return (enum case_action)((int)ctx->flag - ctx->inword);
  case CASE_CAPITALIZE_UP:
    return ctx->inword ? CASE_NO_ACTION : CASE_CAPITALIZE;
  default:
    return ctx->flag;
  }
}

/* Based on CTX and FLAG, case character CH.  If BUF is NULL, return cased
   character.  Otherwise, if BUF is non-NULL, save result in it and return 0 if
   the character changed or -1 if it didn’t.

   FLAG may be one of CASE_UP, CASE_DOWN, CASE_CAPITALIZE (title-case if
   possible, upper-aces otherwise) or CASE_NO_ACTION.  CTX->inword is not taken
   into account when interpreting FLAG (it may be taken into account for other
   decisions though).

   Since meaning of return value depends on arguments, it’s more convenient to
   use case_single_character or case_characters instead. */
static int
case_character_impl (struct casing_str_buf *buf,
		     struct casing_context *ctx, enum case_action flag, int ch)
{
  Lisp_Object prop;
  int cased;

  /* Update inword state */
  ctx->inword = SYNTAX (ch) == Sword &&
    (!ctx->inbuffer || ctx->inword || !syntax_prefix_flag_p (ch));

  /* Handle dutch ij.  We need to do it here before the flag == CASE_NO_ACTION
     check.  Note that non-zero treat_dutch_ij implies ctx->flag being ≥
     CASE_CAPITALIZE. */
  switch (__builtin_expect(ctx->treat_dutch_ij, NL_OFF)) {
  case NL_ON:
    if (ch == 'i' && flag == CASE_CAPITALIZE)
      {
	ctx->treat_dutch_ij = NL_UPCASE_J;
	cased = 'I';
	goto done;
      }
    break;
  case NL_UPCASE_J:
    ctx->treat_dutch_ij = NL_ON;
    if (ch == 'j')
      {
	cased = 'J';
	goto done;
      }
  }

  /* We are inside of a word and capitalising initials only. */
  if (flag == CASE_NO_ACTION)
    {
      cased = ch;
      goto done;
    }

  /* Look through the special casing entries. */
  if (buf)
    {
      const special_casing_char_t *it;
      for (it = special_casing_code_points; *it && *it <= ch; ++it)
	if (*it == ch)
	  {
	    const struct casing_str_buf *entry = special_casing_entries +
	      ((it - special_casing_code_points) * 3 + (int)flag);
	    memcpy (buf, entry, sizeof *buf);
	    buf->len_chars &= ~SPECIAL_CASING_NO_CHANGE_BIT;
	    return entry->len_chars & SPECIAL_CASING_NO_CHANGE_BIT ? -1 : 0;
	  }
    }

  /* Handle simple, one-to-one case. */
  if (flag == CASE_DOWN)
    cased = downcase (ch);
  else if (!NILP (ctx->titlecase_char_table) &&
	   CHARACTERP (prop = CHAR_TABLE_REF (ctx->titlecase_char_table, ch)))
    cased = XFASTINT (prop);
  else
    cased = upcase(ch);

  /* And we’re done. */
 done:
  if (!buf)
    return cased;
  buf->len_chars = 1;
  buf->len_bytes = CHAR_STRING (cased, buf->data);
  return cased == ch ? -1 : 0;
}
\f
/* In Greek, lower case sigma has two forms: one when used in the middle and one
   when used at the end of a word.  Below is to help handle those cases when
   casing.

   The rule does not conflict with any other casing rules so while it is
   a conditional one, it is independent on language. */

#define CAPITAL_SIGMA     0x03A3
#define SMALL_SIGMA       0x03C3
#define SMALL_FINAL_SIGMA 0x03C2

/* Azeri and Turkish have dotless and dotted i.  An upper case of i is
   İ while lower case of I is ı. */

#define CAPITAL_DOTTED_I    0x130
#define SMALL_DOTLESS_I     0x131
#define COMBINING_DOT_ABOVE 0x307

/* Lithuanian retains tittle in lower case i and j when there are more
   accents above those letters. */

#define CAPITAL_I_WITH_GRAVE  0x0CC
#define CAPITAL_I_WITH_ACUTE  0x0CD
#define CAPITAL_I_WITH_TILDE  0x128
#define CAPITAL_I_WITH_OGONEK 0x12E
#define SMALL_I_WITH_OGONEK   0x12F
#define COMBINING_GRAVE_ABOVE 0x300
#define COMBINING_ACUTE_ABOVE 0x301
#define COMBINING_TILDE_ABOVE 0x303
#define COMBINING_OGONEK      0x328

/* Attempt to case CH using rules for Lithuanian i and j.  Return true if
   character has been cased (in which case it’s saved in BUF), false otherwise.
   If CTX->lithuanian_tittle is LT_OFF, return false. */
static bool
case_lithuanian (struct casing_str_buf *buf, struct casing_context *ctx,
		 enum case_action flag, int ch)
{
  switch (__builtin_expect(ctx->lithuanian_tittle, LT_OFF)) {
  case LT_OFF:
    return false;

  case LT_DEL_DOT_ABOVE:
    /* When upper-casing i or j, a combining dot above that follows it must be
       removed.  This is true even if there’s a combining ogonek in between.
       But, if there’s another character combining above in between, combining
       dot needs to stay (since the dot will be rendered above the other
       diacritic). */
    switch (ch) {
    case COMBINING_DOT_ABOVE:
      buf->len_chars = buf->len_bytes = 0;
      ctx->lithuanian_tittle = LT_ON;
      return true;
    case COMBINING_GRAVE_ABOVE:
    case COMBINING_ACUTE_ABOVE:
    case COMBINING_TILDE_ABOVE:
      ctx->lithuanian_tittle = LT_ON;
      return false;
    case COMBINING_OGONEK:
      return false;
    default:
      ctx->lithuanian_tittle = LT_ON;
    }
    break;

  case LT_INS_DOT_ABOVE:
    /* When lower-casing I or J, if the letter has any accents above,
       a combining dot above must be added before them.  If we are here, it
       means that we have lower cased I or J and we’re now on the lookout for
       accents combining above. */
    switch (ch) {
    case COMBINING_GRAVE_ABOVE:
    case COMBINING_ACUTE_ABOVE:
    case COMBINING_TILDE_ABOVE:
      buf->len_chars = 2;
      buf->len_bytes = CHAR_STRING (COMBINING_DOT_ABOVE, buf->data);
      buf->len_bytes += CHAR_STRING (ch, buf->data + buf->len_bytes);
      ctx->lithuanian_tittle = LT_ON;
      return true;
    case COMBINING_OGONEK:
      return false;
    default:
      ctx->lithuanian_tittle = LT_ON;
    }
    break;
  }

  switch (flag) {
  case CASE_UP:
  case CASE_CAPITALIZE:
    if (ch == 'i' || ch == 'j')
      {
	buf->data[0] = ch ^ ('i' ^ 'I');
	buf->len_bytes = 1;
      }
    else if (ch == SMALL_I_WITH_OGONEK)
      buf->len_bytes = CHAR_STRING (CAPITAL_I_WITH_OGONEK, buf->data);
    else
      break;
    buf->len_chars = 1;
    /* Change the state so we’re on the lookout for combining dot above. */
    ctx->lithuanian_tittle = LT_DEL_DOT_ABOVE;
    return true;

  case CASE_DOWN:
    /* Turning I or J to lower case requires combining dot above to be included
       IF there are any other characters combining above present.  This is so
       that the tittle is preserved. */
    switch (ch) {
    case CAPITAL_I_WITH_GRAVE:
      ch = 0x80;  /* U+300, "\xCC\x80", combining grave accent */
      goto has_accent;
    case CAPITAL_I_WITH_ACUTE:
      ch = 0x81;  /* U+301, "\xCC \x81", combining acute accent */
      goto has_accent;
    case CAPITAL_I_WITH_TILDE:
      ch = 0x83;  /* U+303, "\xCC\x83", combining tilde */
    has_accent:
      memcpy (buf->data, "i\xCC\x87\xCC", 4);
      buf->data[4] = ch;
      buf->len_chars = 3;
      buf->len_bytes = 5;
      return true;

    case 'I':
    case 'J':
      buf->data[0] = ch ^ ('i' ^ 'I');
      buf->len_bytes = 1;
      if (false)
    case CAPITAL_I_WITH_OGONEK:
	buf->len_bytes = CHAR_STRING (SMALL_I_WITH_OGONEK, buf->data);
      buf->len_chars = 1;
      /* Change the state so we’re on the lookout for diacritics combining
	 above.  If one is found, we need to add combining dot above. */
      ctx->lithuanian_tittle = LT_INS_DOT_ABOVE;
      return true;
    }
    break;
  }

  return false;
}
\f
/* Based on CTX, case character CH accordingly.  Update CTX as necessary.
   Return cased character.

   Special casing rules (such as upcase(fi) = FI) are not handled.  For
   characters whose casing results in multiple code points, the character is
   returned unchanged. */
static inline int
case_single_character (struct casing_context *ctx, int ch)
{
  enum case_action flag = normalise_flag (ctx);
  return case_character_impl (NULL, ctx, flag, ch);
}

/* Save in BUF result of casing character CH.

   If not-NULL, NEXT points to the next character in the cased string.  If NULL,
   it is assumed current character is the last one being cased.  This is used to
   apply some rules which depend on proceeding state.

   Return:
   - -1 if character has not been changed,
   - 0 if the character has changed or
   - a positive number if the character CH and the one following it (pointed by
     NEXT) map to character saved in BUF.  Returned value is the length in bytes
     of the next character.

   This is like case_single_character but also handles one-to-many as well as
   many-to-one and many-to-many casing rules. */
static int
case_characters (struct casing_str_buf *buf, struct casing_context *ctx,
		 int ch, const unsigned char *next)
{
  enum case_action flag = normalise_flag (ctx);

  if (case_lithuanian (buf, ctx, flag, ch))
    return 0;

  if (flag != CASE_NO_ACTION && __builtin_expect(ctx->treat_turkic_i, false))
    {
      bool dot_above = false;
      int cased = ch;

      switch (ch) {
      case 'I':
	if (flag == CASE_DOWN)
	  {
	    dot_above = next && STRING_CHAR (next) == COMBINING_DOT_ABOVE;
	    cased = dot_above ? 'i' : SMALL_DOTLESS_I;
	  }
	break;

      case 'i':
	if (flag == CASE_UP || flag == CASE_CAPITALIZE)
	  cased = CAPITAL_DOTTED_I;
	break;

      case CAPITAL_DOTTED_I:
	if (flag == CASE_DOWN)
	  cased = 'i';
	break;

      case SMALL_DOTLESS_I:
	if (flag == CASE_UP || flag == CASE_CAPITALIZE)
	  cased = 'I';
	break;

      default:
	goto not_turkic_i;
      }

      ctx->inword = true;
      buf->len_chars = 1;
      buf->len_bytes = CHAR_STRING (cased, buf->data);
      if (dot_above)
	return CHAR_BYTES (COMBINING_DOT_ABOVE);
      else
	return ch == cased ? -1 : 0;
    }

 not_turkic_i:
  /* Capital sigma down-cases differently based on whether it’s last
     letter of a word or not. */
  if (flag == CASE_DOWN && ch == CAPITAL_SIGMA)
    {
      ch = (ctx->inword && (!next || SYNTAX (STRING_CHAR (next)) != Sword))
	? SMALL_FINAL_SIGMA : SMALL_SIGMA;
      buf->len_bytes = CHAR_STRING (ch, buf->data);
      buf->len_chars = 1;
      ctx->inword = true;
      return 0;
    }

  /* Do the casing. */
  return case_character_impl (buf, ctx, flag, ch);
}
\f
static Lisp_Object
do_casify_integer (struct casing_context *ctx, Lisp_Object obj)
{
  int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
		  | CHAR_SHIFT | CHAR_CTL | CHAR_META);
  int flags, ch = XFASTINT (obj), cased;
  bool multibyte;

  /* If the character has higher bits set above the flags, return it unchanged.
     It is not a real character.  */
  if (UNSIGNED_CMP (ch, >, flagbits))
    return obj;

  flags = ch & flagbits;
  ch = ch & ~flagbits;

  /* FIXME: Even if enable-multibyte-characters is nil, we may manipulate
     multibyte chars.  This means we have a bug for latin-1 chars since when we
     receive an int 128-255 we can't tell whether it's an eight-bit byte or
     a latin-1 char.  */
  multibyte = (ch >= 256 ||
	       !NILP (BVAR (current_buffer, enable_multibyte_characters)));
  if (! multibyte)
    MAKE_CHAR_MULTIBYTE (ch);
  cased = case_single_character (ctx, ch);
  if (cased == ch)
    return obj;

  if (! multibyte)
    MAKE_CHAR_UNIBYTE (cased);
  XSETFASTINT (obj, cased | flags);
  return obj;
}

static Lisp_Object
do_casify_multibyte_string (struct casing_context *ctx, Lisp_Object obj)
{
  /* We assume data is the first member of casing_str_buf structure so that if
     we cast a (char *) into (struct casing_str_buf *) the representation of the
     character is at the beginning of the buffer.  This is why we don’t need
     separate struct casing_str_buf object but rather write directly to o. */
  typedef char static_assertion[offsetof(struct casing_str_buf, data) ? -1 : 1];

  ptrdiff_t size = SCHARS (obj), n;
  int ch, len_bytes;
  USE_SAFE_ALLOCA;
  if (INT_MULTIPLY_WRAPV (size, MAX_MULTIBYTE_LENGTH, &n) ||
      INT_ADD_WRAPV (n, sizeof(struct casing_str_buf), &n))
    n = PTRDIFF_MAX;
  unsigned char *const dst = SAFE_ALLOCA (n), *const dst_end = dst + n;
  unsigned char *o = dst;

  const unsigned char *src = SDATA (obj);

  n = 0;
  while (size)
    {
      if (dst_end - o < sizeof(struct casing_str_buf))
	string_overflow ();
      ch = STRING_CHAR_ADVANCE (src);
      len_bytes = case_characters ((void *)o, ctx, ch, size > 1 ? src : NULL);
      if (len_bytes > 0)
	src += len_bytes;
      size -= len_bytes > 0 ? 2 : 1;
      n += ((struct casing_str_buf *)o)->len_chars;
      o += ((struct casing_str_buf *)o)->len_bytes;
    }
  eassert (o <= dst_end);
  obj = make_multibyte_string ((char *) dst, n, o - dst);
  SAFE_FREE ();
  return obj;
}

static Lisp_Object
do_casify_unibyte_string (struct casing_context *ctx, Lisp_Object obj)
{
  ptrdiff_t i, size = SCHARS (obj);
  int ch, cased;

  obj = Fcopy_sequence (obj);
  for (i = 0; i < size; i++)
    {
      ch = SREF (obj, i);
      MAKE_CHAR_MULTIBYTE (ch);
      cased = case_single_character (ctx, ch);
      if (ch == cased)
	continue;
      MAKE_CHAR_UNIBYTE (cased);
      /* If the char can't be converted to a valid byte, just don't change it */
      if (cased >= 0 && cased < 256)
	SSET (obj, i, cased);
    }
  return obj;
}

static Lisp_Object
casify_object (enum case_action flag, Lisp_Object obj)
{
  struct casing_context ctx;
  prepare_casing_context (&ctx, flag, false);

  if (INTEGERP (obj))
    return do_casify_integer (&ctx, obj);
  else if (!STRINGP (obj))
    wrong_type_argument (Qchar_or_string_p, obj);
  else if (!SCHARS (obj))
    return obj;
  else if (STRING_MULTIBYTE (obj))
    return do_casify_multibyte_string (&ctx, obj);
  else
    return do_casify_unibyte_string (&ctx, obj);
}

DEFUN ("upcase", Fupcase, Supcase, 1, 1, 0,
       doc: /* Convert argument to upper case and return that.
The argument may be a character or string.  The result has the same type.
The argument object is not altered--the value is a copy.  If argument
is a character, characters which map to multiple code points when
cased, e.g. fi, are returned unchanged.
See also `capitalize', `downcase' and `upcase-initials'.  */)
  (Lisp_Object obj)
{
  return casify_object (CASE_UP, obj);
}

DEFUN ("downcase", Fdowncase, Sdowncase, 1, 1, 0,
       doc: /* Convert argument to lower case and return that.
The argument may be a character or string.  The result has the same type.
The argument object is not altered--the value is a copy.  */)
  (Lisp_Object obj)
{
  return casify_object (CASE_DOWN, obj);
}

DEFUN ("capitalize", Fcapitalize, Scapitalize, 1, 1, 0,
       doc: /* Convert argument to capitalized form and return that.
This means that each word's first character is upper case (more
precisely, if available, title case) and the rest is lower case.
The argument may be a character or string.  The result has the same type.
The argument object is not altered--the value is a copy.  If argument
is a character, characters which map to multiple code points when
cased, e.g. fi, are returned unchanged.  */)
  (Lisp_Object obj)
{
  return casify_object (CASE_CAPITALIZE, obj);
}

/* Like Fcapitalize but change only the initials.  */

DEFUN ("upcase-initials", Fupcase_initials, Supcase_initials, 1, 1, 0,
       doc: /* Convert the initial of each word in the argument to upper case.
(More precisely, if available, initial of each word is converted to
title-case).  Do not change the other letters of each word.
The argument may be a character or string.  The result has the same type.
The argument object is not altered--the value is a copy.  If argument
is a character, characters which map to multiple code points when
cased, e.g. fi, are returned unchanged.  */)
  (Lisp_Object obj)
{
  return casify_object (CASE_CAPITALIZE_UP, obj);
}
\f
/* Based on CTX, case region in a multibyte buffer from POS to *ENDP.  Return
   first position that has changed and save last position in *ENDP.  If no
   characters were changed, return -1 and *ENDP is unspecified. */
static ptrdiff_t
do_casify_unibyte_region (struct casing_context *ctx,
			  ptrdiff_t pos, ptrdiff_t *endp)
{
  ptrdiff_t first = -1, last = -1;  /* Position of first and last changes. */
  ptrdiff_t end = *endp;
  int ch, cased;

  for (; pos < end; ++pos)
    {
      ch = FETCH_BYTE (pos);
      MAKE_CHAR_MULTIBYTE (ch);

      cased = case_single_character (ctx, ch);
      if (cased == ch)
	continue;

      last = pos;
      if (first < 0)
	first = pos;

      MAKE_CHAR_UNIBYTE (cased);
      FETCH_BYTE (pos) = cased;
    }

  *endp = last + 1;
  return first;
}

/* Based on CTX, case region in a unibyte buffer from POS to *ENDP.  Return
   first position that has changed and save last position in *ENDP.  If no
   characters were changed, return -1 and *ENDP is unspecified. */
static ptrdiff_t
do_casify_multibyte_region (struct casing_context *ctx,
			    ptrdiff_t *startp, ptrdiff_t *endp)
{
  ptrdiff_t first = -1, last = -1;  /* Position of first and last changes. */
  ptrdiff_t pos = *startp, pos_byte = CHAR_TO_BYTE (pos), size = *endp - pos;
  ptrdiff_t opoint = PT, added;
  struct casing_str_buf buf;
  int ch, len_bytes, len_chars, ret;

  while (size)
    {
      ch = STRING_CHAR_AND_LENGTH (BYTE_POS_ADDR (pos_byte), len_bytes);
      ret = case_characters (
	  &buf, ctx, ch,
	  size > 1 ? BYTE_POS_ADDR (pos_byte + len_bytes) : NULL);
      len_chars = 1;

      switch (ret) {
      default:
	len_chars += 1;
	/* FALL THROUGH */

      case 0:
	len_bytes += ret;
	len_chars = ret ? 2 : 1;

	last = pos + buf.len_chars;
	if (first < 0)
	  first = pos;

	if (ret == 0 && buf.len_chars == 1 && buf.len_bytes == len_bytes)
	  memcpy (BYTE_POS_ADDR (pos_byte), buf.data, len_bytes);
	else
	  {
	    /* Replace one character with the other(s), keeping text
	       properties the same.  */
	    replace_range_2 (pos, pos_byte, pos + len_chars, pos_byte + len_bytes,
			     (const char *) buf.data, buf.len_chars,
			     buf.len_bytes,
			     0);
	    added += buf.len_chars - len_chars;
	    if (opoint > pos)
	      opoint += buf.len_chars - len_chars;
	  }

	/* FALL THOUGH */
      case -1:
	size -= len_chars;
	pos += buf.len_chars;
	pos_byte += buf.len_bytes;
      }
    }

  if (PT != opoint)
    TEMP_SET_PT_BOTH (opoint, CHAR_TO_BYTE (opoint));

  *startp = first;
  *endp = last;
  return added;
}

/* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.
   b and e specify range of buffer to operate on. */
static void
casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e)
{
  ptrdiff_t start, end, added;
  struct casing_context ctx;

  if (EQ (b, e))
    /* Not modifying because nothing marked */
    return;

  validate_region (&b, &e);
  start = XFASTINT (b);
  end = XFASTINT (e);
  modify_text (start, end);
  record_change (start, end - start);
  prepare_casing_context (&ctx, flag, true);

  if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
    start = do_casify_unibyte_region (&ctx, start, &end);
  else
    added = do_casify_multibyte_region (&ctx, &start, &end);

  if (start >= 0)
    {
      signal_after_change (start, end - start - added, end - start);
      update_compositions (start, end, CHECK_ALL);
    }
}

DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 3,
       "(list (region-beginning) (region-end) (region-noncontiguous-p))",
       doc: /* Convert the region to upper case.  In programs, wants two arguments.
These arguments specify the starting and ending character numbers of
the region to operate on.  When used as a command, the text between
point and the mark is operated on.
See also `capitalize-region'.  */)
  (Lisp_Object beg, Lisp_Object end, Lisp_Object region_noncontiguous_p)
{
  Lisp_Object bounds = Qnil;

  if (!NILP (region_noncontiguous_p))
    {
      bounds = call1 (Fsymbol_value (intern ("region-extract-function")),
		      intern ("bounds"));

      while (CONSP (bounds))
	{
	  casify_region (CASE_UP, XCAR (XCAR (bounds)), XCDR (XCAR (bounds)));
	  bounds = XCDR (bounds);
	}
    }
  else
    casify_region (CASE_UP, beg, end);

  return Qnil;
}

DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 3,
       "(list (region-beginning) (region-end) (region-noncontiguous-p))",
       doc: /* Convert the region to lower case.  In programs, wants two arguments.
These arguments specify the starting and ending character numbers of
the region to operate on.  When used as a command, the text between
point and the mark is operated on.  */)
  (Lisp_Object beg, Lisp_Object end, Lisp_Object region_noncontiguous_p)
{
  Lisp_Object bounds = Qnil;

  if (!NILP (region_noncontiguous_p))
    {
      bounds = call1 (Fsymbol_value (intern ("region-extract-function")),
		      intern ("bounds"));

      while (CONSP (bounds))
	{
	  casify_region (CASE_DOWN, XCAR (XCAR (bounds)), XCDR (XCAR (bounds)));
	  bounds = XCDR (bounds);
	}
    }
  else
    casify_region (CASE_DOWN, beg, end);

  return Qnil;
}

DEFUN ("capitalize-region", Fcapitalize_region, Scapitalize_region, 2, 2, "r",
       doc: /* Convert the region to capitalized form.
Capitalized form means each word's first character is upper case (more
precisely, if available, title case) and the rest of it is lower case.
In programs, give two arguments, the starting and ending
character positions to operate on.  */)
  (Lisp_Object beg, Lisp_Object end)
{
  casify_region (CASE_CAPITALIZE, beg, end);
  return Qnil;
}

/* Like Fcapitalize_region but change only the initials.  */

DEFUN ("upcase-initials-region", Fupcase_initials_region,
       Supcase_initials_region, 2, 2, "r",
       doc: /* Upcase the initial of each word in the region.
(More precisely, if available, initial of each word is converted to
title-case).  Subsequent letters of each word are not changed.
In programs, give two arguments, the starting and ending
character positions to operate on.  */)
  (Lisp_Object beg, Lisp_Object end)
{
  casify_region (CASE_CAPITALIZE_UP, beg, end);
  return Qnil;
}
\f
static Lisp_Object
casify_word (enum case_action flag, Lisp_Object arg)
{
  CHECK_NUMBER (arg);
  ptrdiff_t farend = scan_words (PT, XINT (arg));
  if (!farend)
    farend = XINT (arg) <= 0 ? BEGV : ZV;
  ptrdiff_t newpoint = max (PT, farend);
  casify_region (flag, make_number (PT), make_number (farend));
  SET_PT (newpoint);
  return Qnil;
}

DEFUN ("upcase-word", Fupcase_word, Supcase_word, 1, 1, "p",
       doc: /* Convert to upper case from point to end of word, moving over.

If point is in the middle of a word, the part of that word before point
is ignored when moving forward.

With negative argument, convert previous words but do not move.
See also `capitalize-word'.  */)
  (Lisp_Object arg)
{
  return casify_word (CASE_UP, arg);
}

DEFUN ("downcase-word", Fdowncase_word, Sdowncase_word, 1, 1, "p",
       doc: /* Convert to lower case from point to end of word, moving over.

If point is in the middle of a word, the part of that word before point
is ignored when moving forward.

With negative argument, convert previous words but do not move.  */)
  (Lisp_Object arg)
{
  return casify_word (CASE_DOWN, arg);
}

DEFUN ("capitalize-word", Fcapitalize_word, Scapitalize_word, 1, 1, "p",
       doc: /* Capitalize from point to the end of word, moving over.
With numerical argument ARG, capitalize the next ARG-1 words as well.
This gives the word(s) a first character in upper case
and the rest lower case.

If point is in the middle of a word, the part of that word before point
is ignored when moving forward.

With negative argument, capitalize previous words but do not move.  */)
  (Lisp_Object arg)
{
  return casify_word (CASE_CAPITALIZE, arg);
}
\f
void
syms_of_casefiddle (void)
{
  DEFSYM (Qidentity, "identity");
  defsubr (&Supcase);
  defsubr (&Sdowncase);
  defsubr (&Scapitalize);
  defsubr (&Supcase_initials);
  defsubr (&Supcase_region);
  defsubr (&Sdowncase_region);
  defsubr (&Scapitalize_region);
  defsubr (&Supcase_initials_region);
  defsubr (&Supcase_word);
  defsubr (&Sdowncase_word);
  defsubr (&Scapitalize_word);
}

void
keys_of_casefiddle (void)
{
  initial_define_key (control_x_map, Ctl ('U'), "upcase-region");
  Fput (intern ("upcase-region"), Qdisabled, Qt);
  initial_define_key (control_x_map, Ctl ('L'), "downcase-region");
  Fput (intern ("downcase-region"), Qdisabled, Qt);

  initial_define_key (meta_map, 'u', "upcase-word");
  initial_define_key (meta_map, 'l', "downcase-word");
  initial_define_key (meta_map, 'c', "capitalize-word");
}