cgit.sxemacs.org Git - sxemacs/blob - src/casefiddle.c

   1 /* SXEmacs case conversion functions.
   2    Copyright (C) 1985, 1992, 1993, 1994, 1997, 1998 Free Software Foundation, Inc.
   3
   4 This file is part of SXEmacs
   5
   6 SXEmacs is free software: you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation, either version 3 of the License, or
   9 (at your option) any later version.
  10
  11 SXEmacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
  18
  19
  20 /* Synched up with: FSF 19.34, but substantially rewritten by Martin. */
  21
  22 #include <config.h>
  23 #include "lisp.h"
  24
  25 #include "buffer.h"
  26 #include "ui/insdel.h"
  27 #include "syntax.h"
  28
  29 enum case_action { CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP };
  30 \f
  31 static Lisp_Object
  32 casify_object(enum case_action flag, Lisp_Object string_or_char,
  33               Lisp_Object buffer)
  34 {
  35         struct buffer *buf = decode_buffer(buffer, 0);
  36
  37       retry:
  38
  39         if (CHAR_OR_CHAR_INTP(string_or_char)) {
  40                 Emchar c;
  41                 CHECK_CHAR_COERCE_INT(string_or_char);
  42                 c = XCHAR(string_or_char);
  43                 c = (flag == CASE_DOWN) ? DOWNCASE(buf, c) : UPCASE(buf, c);
  44                 return make_char(c);
  45         }
  46
  47         if (STRINGP(string_or_char)) {
  48                 Lisp_Char_Table *syntax_table =
  49                     XCHAR_TABLE(buf->mirror_syntax_table);
  50                 Bufbyte *storage =
  51                     alloca_array(Bufbyte,
  52                                  XSTRING_LENGTH(string_or_char) *
  53                                  MAX_EMCHAR_LEN);
  54                 Bufbyte *newp = storage;
  55                 Bufbyte *oldp = XSTRING_DATA(string_or_char);
  56                 int wordp = 0, wordp_prev;
  57
  58                 while (*oldp) {
  59                         Emchar c = charptr_emchar(oldp);
  60                         switch (flag) {
  61                         case CASE_UP:
  62                                 c = UPCASE(buf, c);
  63                                 break;
  64                         case CASE_DOWN:
  65                                 c = DOWNCASE(buf, c);
  66                                 break;
  67                         case CASE_CAPITALIZE:
  68                         case CASE_CAPITALIZE_UP:
  69                                 wordp_prev = wordp;
  70                                 wordp = WORD_SYNTAX_P(syntax_table, c);
  71                                 if (!wordp)
  72                                         break;
  73                                 if (wordp_prev) {
  74                                         if (flag == CASE_CAPITALIZE)
  75                                                 c = DOWNCASE(buf, c);
  76                                 } else
  77                                         c = UPCASE(buf, c);
  78                                 break;
  79
  80                                 /* can't happen */
  81                         default:
  82                                 /* abort()? */
  83                                 break;
  84                         }
  85
  86                         newp += set_charptr_emchar(newp, c);
  87                         INC_CHARPTR(oldp);
  88                 }
  89
  90                 return make_string(storage, newp - storage);
  91         }
  92
  93         string_or_char = wrong_type_argument(Qchar_or_string_p, string_or_char);
  94         goto retry;
  95 }
  96
  97 DEFUN("upcase", Fupcase, 1, 2, 0,       /*
  98 Convert STRING-OR-CHAR to upper case and return that.
  99 STRING-OR-CHAR may be a character or string.  The result has the same type.
 100 STRING-OR-CHAR is not altered--the value is a copy.
 101 See also `capitalize', `downcase' and `upcase-initials'.
 102 Optional second arg BUFFER specifies which buffer's case tables to use,
 103 and defaults to the current buffer.
 104 */
 105       (string_or_char, buffer))
 106 {
 107         return casify_object(CASE_UP, string_or_char, buffer);
 108 }
 109
 110 DEFUN("downcase", Fdowncase, 1, 2, 0,   /*
 111 Convert STRING-OR-CHAR to lower case and return that.
 112 STRING-OR-CHAR may be a character or string.  The result has the same type.
 113 STRING-OR-CHAR is not altered--the value is a copy.
 114 Optional second arg BUFFER specifies which buffer's case tables to use,
 115 and defaults to the current buffer.
 116 */
 117       (string_or_char, buffer))
 118 {
 119         return casify_object(CASE_DOWN, string_or_char, buffer);
 120 }
 121
 122 DEFUN("capitalize", Fcapitalize, 1, 2, 0,       /*
 123 Convert STRING-OR-CHAR to capitalized form and return that.
 124 This means that each word's first character is upper case
 125 and the rest is lower case.
 126 STRING-OR-CHAR may be a character or string.  The result has the same type.
 127 STRING-OR-CHAR is not altered--the value is a copy.
 128 Optional second arg BUFFER specifies which buffer's case tables to use,
 129 and defaults to the current buffer.
 130 */
 131       (string_or_char, buffer))
 132 {
 133         return casify_object(CASE_CAPITALIZE, string_or_char, buffer);
 134 }
 135
 136 /* Like Fcapitalize but change only the initial characters.  */
 137
 138 DEFUN("upcase-initials", Fupcase_initials, 1, 2, 0,     /*
 139 Convert the initial of each word in STRING-OR-CHAR to upper case.
 140 Do not change the other letters of each word.
 141 STRING-OR-CHAR may be a character or string.  The result has the same type.
 142 STRING-OR-CHAR is not altered--the value is a copy.
 143 Optional second arg BUFFER specifies which buffer's case tables to use,
 144 and defaults to the current buffer.
 145 */
 146       (string_or_char, buffer))
 147 {
 148         return casify_object(CASE_CAPITALIZE_UP, string_or_char, buffer);
 149 }
 150 \f
 151 /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.
 152    START and END specify range of buffer to operate on. */
 153
 154 static void
 155 casify_region_internal(enum case_action flag, Lisp_Object start,
 156                        Lisp_Object end, struct buffer *buf)
 157 {
 158         /* This function can GC */
 159         Bufpos pos, s, e;
 160         Lisp_Char_Table *syntax_table = XCHAR_TABLE(buf->mirror_syntax_table);
 161         int mccount;
 162         int wordp = 0, wordp_prev;
 163
 164         if (EQ(start, end))
 165                 /* Not modifying because nothing marked */
 166                 return;
 167
 168         get_buffer_range_char(buf, start, end, &s, &e, 0);
 169
 170         mccount = begin_multiple_change(buf, s, e);
 171         record_change(buf, s, e - s);
 172
 173         for (pos = s; pos < e; pos++) {
 174                 Emchar oldc = BUF_FETCH_CHAR(buf, pos);
 175                 Emchar c = oldc;
 176
 177                 switch (flag) {
 178                 case CASE_UP:
 179                         c = UPCASE(buf, oldc);
 180                         break;
 181                 case CASE_DOWN:
 182                         c = DOWNCASE(buf, oldc);
 183                         break;
 184                 case CASE_CAPITALIZE:
 185                 case CASE_CAPITALIZE_UP:
 186                         /* !!#### need to revalidate the start and end pointers in case
 187                            the buffer was changed */
 188                         wordp_prev = wordp;
 189                         wordp = WORD_SYNTAX_P(syntax_table, c);
 190                         if (!wordp)
 191                                 continue;
 192                         if (wordp_prev) {
 193                                 if (flag == CASE_CAPITALIZE)
 194                                         c = DOWNCASE(buf, c);
 195                         } else
 196                                 c = UPCASE(buf, c);
 197                         break;
 198
 199                         /* can't happen */
 200                 default:
 201                         /* abort()? */
 202                         break;
 203                 }
 204
 205                 if (oldc == c)
 206                         continue;
 207                 buffer_replace_char(buf, pos, c, 1, (pos == s));
 208                 BUF_MODIFF(buf)++;
 209         }
 210
 211         end_multiple_change(buf, mccount);
 212 }
 213
 214 static Lisp_Object
 215 casify_region(enum case_action flag, Lisp_Object start, Lisp_Object end,
 216               Lisp_Object buffer)
 217 {
 218         casify_region_internal(flag, start, end, decode_buffer(buffer, 1));
 219         return Qnil;
 220 }
 221
 222 DEFUN("upcase-region", Fupcase_region, 2, 3, "r",       /*
 223 Convert the region to upper case.  In programs, wants two arguments.
 224 These arguments specify the starting and ending character numbers of
 225 the region to operate on.  When used as a command, the text between
 226 point and the mark is operated on.
 227 See also `capitalize-region'.
 228 Optional third arg BUFFER defaults to the current buffer.
 229 */
 230       (start, end, buffer))
 231 {
 232         /* This function can GC */
 233         return casify_region(CASE_UP, start, end, buffer);
 234 }
 235
 236 DEFUN("downcase-region", Fdowncase_region, 2, 3, "r",   /*
 237 Convert the region to lower case.  In programs, wants two arguments.
 238 These arguments specify the starting and ending character numbers of
 239 the region to operate on.  When used as a command, the text between
 240 point and the mark is operated on.
 241 Optional third arg BUFFER defaults to the current buffer.
 242 */
 243       (start, end, buffer))
 244 {
 245         /* This function can GC */
 246         return casify_region(CASE_DOWN, start, end, buffer);
 247 }
 248
 249 DEFUN("capitalize-region", Fcapitalize_region, 2, 3, "r",       /*
 250 Convert the region to capitalized form.
 251 Capitalized form means each word's first character is upper case
 252 and the rest of it is lower case.
 253 In programs, give two arguments, the starting and ending
 254 character positions to operate on.
 255 Optional third arg BUFFER defaults to the current buffer.
 256 */
 257       (start, end, buffer))
 258 {
 259         /* This function can GC */
 260         return casify_region(CASE_CAPITALIZE, start, end, buffer);
 261 }
 262
 263 /* Like Fcapitalize_region but change only the initials.  */
 264
 265 DEFUN("upcase-initials-region", Fupcase_initials_region, 2, 3, "r",     /*
 266 Upcase the initial of each word in the region.
 267 Subsequent letters of each word are not changed.
 268 In programs, give two arguments, the starting and ending
 269 character positions to operate on.
 270 Optional third arg BUFFER defaults to the current buffer.
 271 */
 272       (start, end, buffer))
 273 {
 274         return casify_region(CASE_CAPITALIZE_UP, start, end, buffer);
 275 }
 276 \f
 277 static Lisp_Object
 278 casify_word(enum case_action flag, Lisp_Object arg, Lisp_Object buffer)
 279 {
 280         Bufpos farend;
 281         struct buffer *buf = decode_buffer(buffer, 1);
 282
 283         CHECK_INT(arg);
 284
 285         farend = scan_words(buf, BUF_PT(buf), XINT(arg));
 286         if (!farend)
 287                 farend = XINT(arg) > 0 ? BUF_ZV(buf) : BUF_BEGV(buf);
 288
 289         casify_region_internal(flag, make_int(BUF_PT(buf)), make_int(farend),
 290                                buf);
 291         BUF_SET_PT(buf, max(BUF_PT(buf), farend));
 292         return Qnil;
 293 }
 294
 295 DEFUN("upcase-word", Fupcase_word, 1, 2, "p",   /*
 296 Convert following word (or COUNT words) to upper case, moving over.
 297 With negative argument, convert previous words but do not move.
 298 See also `capitalize-word'.
 299 Optional second arg BUFFER defaults to the current buffer.
 300 */
 301       (count, buffer))
 302 {
 303         /* This function can GC */
 304         return casify_word(CASE_UP, count, buffer);
 305 }
 306
 307 DEFUN("downcase-word", Fdowncase_word, 1, 2, "p",       /*
 308 Convert following word (or COUNT words) to lower case, moving over.
 309 With negative argument, convert previous words but do not move.
 310 Optional second arg BUFFER defaults to the current buffer.
 311 */
 312       (count, buffer))
 313 {
 314         /* This function can GC */
 315         return casify_word(CASE_DOWN, count, buffer);
 316 }
 317
 318 DEFUN("capitalize-word", Fcapitalize_word, 1, 2, "p",   /*
 319 Capitalize the following word (or COUNT words), moving over.
 320 This gives the word(s) a first character in upper case
 321 and the rest lower case.
 322 With negative argument, capitalize previous words but do not move.
 323 Optional second arg BUFFER defaults to the current buffer.
 324 */
 325       (count, buffer))
 326 {
 327         /* This function can GC */
 328         return casify_word(CASE_CAPITALIZE, count, buffer);
 329 }
 330 \f
 331 void syms_of_casefiddle(void)
 332 {
 333         DEFSUBR(Fupcase);
 334         DEFSUBR(Fdowncase);
 335         DEFSUBR(Fcapitalize);
 336         DEFSUBR(Fupcase_initials);
 337         DEFSUBR(Fupcase_region);
 338         DEFSUBR(Fdowncase_region);
 339         DEFSUBR(Fcapitalize_region);
 340         DEFSUBR(Fupcase_initials_region);
 341         DEFSUBR(Fupcase_word);
 342         DEFSUBR(Fdowncase_word);
 343         DEFSUBR(Fcapitalize_word);
 344 }