/* GNU Emacs case conversion functions.

Copyright (C) 1985, 1994, 1997-1999, 2001-2017 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"

/* Order must match order in unidata-gen-table-special-casing. */
enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP,
		  /* Only for internal use: */ CASE_NO_ACTION};

/* 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;
  /* The special-casing Unicode properties case table with unconditional special
     casing rules defined by Unicode. */
  Lisp_Object specialcase_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;

  /* Determines which special casing rules need to be applied as well as tracks
     state for some of the transformations.*/
  enum {
    /* No special casing rules need to be applied. */
    SPECIAL_NONE,

    /* 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. */
    /* Apply Dutch rules for capitalising ‘ij’. */
    SPECIAL_NL,
    /* As above and the previous character was upcased ‘i’ so if we now see ‘j’
       it needs to be upcased as well. */
    SPECIAL_NL_UPCASE_J,

    /* Handle Azerbaijani and Turkish dotted and dotless i. */
    SPECIAL_TR,

    /* Apply Lithuanian rules for i’s and j’s tittle. */
    SPECIAL_LT,
    /* As above plus look out for combining dot above to delete. */
    SPECIAL_LT_DEL_DOT_ABOVE,
    /* As above plus look out for diacritics combining above because
       we may need to inject dot above before them. */
    SPECIAL_LT_INS_DOT_ABOVE,
  } special;
};

/* 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;

  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->specialcase_char_table =
    uniprop_table (intern_c_string ("special-casing"));
  ctx->special = SPECIAL_NONE;

  /* 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.  */

  lang = BVAR(current_buffer, language);
  if (STRINGP (lang) && SCHARS (lang) >= 2)
    switch ((SREF(lang, 0) << 8) | SREF(lang, 1) | 0x2020u) {
    case ('n' << 8) | 'l':  /* Dutch */
      if ((int) flag >= (int) CASE_CAPITALIZE)
	ctx->special = SPECIAL_NL;
      break;
    case ('t' << 8) | 'r':  /* Turkish */
    case ('a' << 8) | 'z':  /* Azerbaijani */
      ctx->special = SPECIAL_TR;
      break;
    case ('l' << 8) | 't':  /* Lithuania */
      ctx->special = SPECIAL_LT;
    }
}

/* 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 ctx->inword ? CASE_DOWN : CASE_CAPITALIZE;
  case CASE_CAPITALIZE_UP:
    return ctx->inword ? CASE_NO_ACTION : CASE_CAPITALIZE;
  default:
    return ctx->flag;
  }
}

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

#define RES_NOT_TOUCHED -2
#define RES_NO_CHANGE   -1
#define RES_CHANGED      0

/* 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
   RES_CHANGED if the character changed or RES_NO_CHANGE 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;

  /* Handle Dutch ij.  Note that SPECIAL_NL and SPECIAL_NL_UPCASE_J implies that
     ctx->flag ≥ CASE_CAPITALIZE.  This has to be handled prior to flag ==
     CASE_NO_ACTION check or otherwise we won’t handle ctx->flag ==
     CASE_CAPITALIZE_UP correctly. */
  if (ctx->special == SPECIAL_NL && ch == 'i' && !ctx->inword)
    {
      ctx->special = SPECIAL_NL_UPCASE_J;
      ctx->inword = true;
      cased = 'I';
      goto done;
    }
  else if (ctx->special == SPECIAL_NL_UPCASE_J)
    {
      ctx->special = SPECIAL_NL;
      if (ch == 'j')
	{
	  cased = 'J';
	  goto done;
	}
    }

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

  if (flag == CASE_NO_ACTION)
    {
      cased = ch;
      goto done;
    }

  /* Look through the special casing entries. */
  if (buf && !NILP(ctx->specialcase_char_table))
    {
      prop = CHAR_TABLE_REF(ctx->specialcase_char_table, ch);
      switch (flag) {
      case CASE_CAPITALIZE:
      case CASE_CAPITALIZE_UP:
        if (!CONSP(prop))
          break;
        prop = XCDR(prop);
        /* FALL THROUGH */
      case CASE_DOWN:
        if (!CONSP(prop))
          break;
        prop = XCDR(prop);
        /* FALL THROUGH */
      default:
        if (!CONSP(prop))
          break;
        prop = XCAR(prop);
        if (INTEGERP(prop)) {
          cased = XINT(prop);
          if (0 <= cased && cased <= MAX_CHAR)
            goto done;
        } else if (STRINGP(prop)) {
          struct Lisp_String *str = XSTRING(prop);
          if (STRING_BYTES(str) <= sizeof buf->data) {
            buf->len_chars = str->size;
            buf->len_bytes = STRING_BYTES(str);
            memcpy(buf->data, str->data, buf->len_bytes);
            return 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;
}

/* 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);
}
\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

/* Save in BUF result of casing character CH if Greek casing rules apply.

   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.

   FLAG is a normalised flag (as returned by normalise_flag function).

   Return -2 (RES_NOT_TOUCHED) if Greek rules did not apply, no changes were
   made and other casing rules should be tried.  Otherwise, meaning of return
   values is the same as in case_characters function. */
static int
maybe_case_greek (struct casing_str_buf *buf, struct casing_context *ctx,
		  enum case_action flag, int ch, const char *next) {
  if (flag != CASE_DOWN || ch != CAPITAL_SIGMA)
    return RES_NOT_TOUCHED;

  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 RES_CHANGED;
}
\f
/* Azerbaijani 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

/* Save in BUF result of casing character CH if Turkic casing rules apply.

   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.

   FLAG is a normalised flag (as returned by normalise_flag function).

   Return -2 (RES_NOT_TOUCHED) if Turkic rules did not apply, no changes were
   made and other casing rules should be tried.  Otherwise, meaning of return
   values is the same as in case_characters function. */
static int
maybe_case_turkic (struct casing_str_buf *buf, struct casing_context *ctx,
		   enum case_action flag, int ch, const char *next) {
  bool dot_above = false;
  int cased = ch;

  if (flag == CASE_NO_ACTION || ctx->special != SPECIAL_TR)
    return RES_NOT_TOUCHED;

  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:
    return RES_NOT_TOUCHED;
  }

  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 ? RES_NO_CHANGE : RES_CHANGED;
}
\f
/* 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

/* Save in BUF result of casing character CH if Lithuanian casing rules apply.

   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.

   FLAG is a normalised flag (as returned by normalise_flag function).

   Return -2 (RES_NOT_TOUCHED) if Lithuanian rules did not apply, no changes
   were made and other casing rules should be tried.  Otherwise, meaning of
   return values is the same as in case_characters function. */
static int
maybe_case_lithuanian (struct casing_str_buf *buf, struct casing_context *ctx,
		       enum case_action flag, int ch)
{
  switch (ctx->special) {
  case SPECIAL_LT:
    break;

  case SPECIAL_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->special = SPECIAL_LT;
      return RES_CHANGED;
    case COMBINING_GRAVE_ABOVE:
    case COMBINING_ACUTE_ABOVE:
    case COMBINING_TILDE_ABOVE:
      ctx->special = SPECIAL_LT;
      return RES_NOT_TOUCHED;
    case COMBINING_OGONEK:
      return RES_NOT_TOUCHED;
    default:
      ctx->special = SPECIAL_LT;
    }
    break;

  case SPECIAL_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->special = SPECIAL_LT;
      return RES_CHANGED;
    case COMBINING_OGONEK:
      return RES_NOT_TOUCHED;
    default:
      ctx->special = SPECIAL_LT;
    }
    break;

  default:
    return RES_NOT_TOUCHED;
  }

  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->special = SPECIAL_LT_DEL_DOT_ABOVE;
    return RES_CHANGED;

  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 RES_CHANGED;

    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->special = SPECIAL_LT_INS_DOT_ABOVE;
      return RES_CHANGED;
    }
    break;
  }

  return RES_NOT_TOUCHED;
}
\f
/* 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 (RES_NO_CHANGE) if character has not been changed,
   • 0 (RES_CHANGED) 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 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);
  int ret = RES_NOT_TOUCHED;

  switch (ctx->special) {
  case SPECIAL_NONE:
    break;

  case SPECIAL_TR:
    ret = maybe_case_turkic (buf, ctx, flag, ch, next);
    break;

  default:
  /* case SPECIAL_LT: */
  /* case SPECIAL_LT_DEL_DOT_ABOVE: */
  /* case SPECIAL_LT_INS_DOT_ABOVE: */
    ret = maybe_case_lithuanian (buf, ctx, flag, ch);
  }

  if (ret == RES_NOT_TOUCHED)
    ret = maybe_case_greek (buf, ctx, flag, ch, next);

  if (ret == RES_NOT_TOUCHED)
    ret = case_character_impl (buf, ctx, flag, ch);

  return ret;
}
\f
static Lisp_Object
do_casify_natnum (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;
  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)
    {
      int ch, ret;
      if (dst_end - o < sizeof(struct casing_str_buf))
	string_overflow ();
      ch = STRING_CHAR_ADVANCE (src);
      ret = case_characters ((void *)o, ctx, ch, size > 1 ? src : NULL);
      if (ret > RES_CHANGED)
	src += ret;
      size -= ret > RES_CHANGED ? 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 (NATNUMP (obj))
    return do_casify_natnum (&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 unibyte buffer from *STARTP to *ENDP.

   Save first and last positions that has changed in *STARTP and *ENDP
   respectively.  If no characters were changed, save -1 to *STARTP and leave
   *ENDP unspecified.

   Always return 0.  This is so that interface of this function is the same as
   do_casify_multibyte_region. */
static ptrdiff_t
do_casify_unibyte_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, 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 + 1;
      if (first < 0)
	first = pos;

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

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

/* Based on CTX, case region in a multibyte buffer from *STARTP to *ENDP.

   Return number of added characters (may be negative if more characters were
   deleted then inserted), save first and last positions that has changed in
   *STARTP and *ENDP respectively.  If no characters were changed, return 0,
   save -1 to *STARTP and leave *ENDP 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 = 0;
  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 RES_CHANGED:
	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 RES_NO_CHANGE:
	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.  Return character position of the
   end of the region after changes.  */
static ptrdiff_t
casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e)
{
  ptrdiff_t start, end, orig_end, added;
  struct casing_context ctx;

  validate_region (&b, &e);
  start = XFASTINT (b);
  end = XFASTINT (e);
  if (start == end)
    /* Not modifying because nothing marked */
    return end;
  modify_text (start, end);
  prepare_casing_context (&ctx, flag, true);

  orig_end = end;
  record_delete (start, make_buffer_string (start, end, true), false);
  if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
    {
      record_insert (start, end - start);
      added = do_casify_unibyte_region (&ctx, &start, &end);
    }
  else
    {
      ptrdiff_t len = end - start, ostart = start;
      added = do_casify_multibyte_region (&ctx, &start, &end);
      record_insert (ostart, len + added);
    }

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

  return orig_end + added;
}

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;
  SET_PT (casify_region (flag, make_number (PT), make_number (farend)));
  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");
}