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

   1 /* Simple built-in editing commands.
   2    Copyright (C) 1985, 1992, 1993, 1994, 1995 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: Mule 2.0, FSF 19.30. */
  21
  22 #include <config.h>
  23 #include "lisp.h"
  24 #include "commands.h"
  25 #include "buffer.h"
  26 #include "syntax.h"
  27 #include "ui/insdel.h"
  28
  29 Lisp_Object Qkill_forward_chars;
  30 Lisp_Object Qself_insert_command;
  31 Lisp_Object Qno_self_insert;
  32
  33 Lisp_Object Vblink_paren_function;
  34
  35 /* A possible value for a buffer's overwrite-mode variable.  */
  36 Lisp_Object Qoverwrite_mode_binary;
  37
  38 /* Non-nil means put this face on the next self-inserting character.  */
  39 Lisp_Object Vself_insert_face;
  40
  41 /* This is the command that set up Vself_insert_face.  */
  42 Lisp_Object Vself_insert_face_command;
  43
  44 /* A char-table for characters which may invoke auto-filling.  */
  45 Lisp_Object Vauto_fill_chars;
  46 \f
  47 DEFUN("forward-char", Fforward_char, 0, 2, "_p",        /*
  48 Move point right COUNT characters (left if COUNT is negative).
  49 On attempt to pass end of buffer, stop and signal `end-of-buffer'.
  50 On attempt to pass beginning of buffer, stop and signal `beginning-of-buffer'.
  51 On reaching end of buffer, stop and signal error.
  52
  53 The characters that are moved over may be added to the current selection
  54 \(i.e. active region) if the Shift key is held down, a motion key is used
  55 to invoke this command, and `shifted-motion-keys-select-region' is t; see
  56 the documentation for this variable for more details.
  57 */
  58       (count, buffer))
  59 {
  60         struct buffer *buf = decode_buffer(buffer, 1);
  61         EMACS_INT n;
  62
  63         if (NILP(count))
  64                 n = 1;
  65         else {
  66                 CHECK_INT(count);
  67                 n = XINT(count);
  68         }
  69
  70         /* This used to just set point to point + XINT (count), and then check
  71            to see if it was within boundaries.  But now that SET_PT can
  72            potentially do a lot of stuff (calling entering and exiting
  73            hooks, etcetera), that's not a good approach.  So we validate the
  74            proposed position, then set point.  */
  75         {
  76                 Bufpos new_point = BUF_PT(buf) + n;
  77
  78                 if (new_point < BUF_BEGV(buf)) {
  79                         BUF_SET_PT(buf, BUF_BEGV(buf));
  80                         Fsignal(Qbeginning_of_buffer, Qnil);
  81                         return Qnil;
  82                 }
  83                 if (new_point > BUF_ZV(buf)) {
  84                         BUF_SET_PT(buf, BUF_ZV(buf));
  85                         Fsignal(Qend_of_buffer, Qnil);
  86                         return Qnil;
  87                 }
  88
  89                 BUF_SET_PT(buf, new_point);
  90         }
  91
  92         return Qnil;
  93 }
  94
  95 DEFUN("backward-char", Fbackward_char, 0, 2, "_p",      /*
  96 Move point left COUNT characters (right if COUNT is negative).
  97 On attempt to pass end of buffer, stop and signal `end-of-buffer'.
  98 On attempt to pass beginning of buffer, stop and signal `beginning-of-buffer'.
  99
 100 The characters that are moved over may be added to the current selection
 101 \(i.e. active region) if the Shift key is held down, a motion key is used
 102 to invoke this command, and `shifted-motion-keys-select-region' is t; see
 103 the documentation for this variable for more details.
 104 */
 105       (count, buffer))
 106 {
 107         if (NILP(count))
 108                 count = make_int(-1);
 109         else {
 110                 CHECK_INT(count);
 111                 count = make_int(-XINT(count));
 112         }
 113         return Fforward_char(count, buffer);
 114 }
 115
 116 DEFUN("forward-line", Fforward_line, 0, 2, "_p",        /*
 117 Move COUNT lines forward (backward if COUNT is negative).
 118 Precisely, if point is on line I, move to the start of line I + COUNT.
 119 If there isn't room, go as far as possible (no error).
 120 Returns the count of lines left to move.  If moving forward,
 121 that is COUNT - number of lines moved; if backward, COUNT + number moved.
 122 With positive COUNT, a non-empty line at the end counts as one line
 123 successfully moved (for the return value).
 124 If BUFFER is nil, the current buffer is assumed.
 125
 126 The characters that are moved over may be added to the current selection
 127 \(i.e. active region) if the Shift key is held down, a motion key is used
 128 to invoke this command, and `shifted-motion-keys-select-region' is t; see
 129 the documentation for this variable for more details.
 130 */
 131       (count, buffer))
 132 {
 133         struct buffer *buf = decode_buffer(buffer, 1);
 134         Bufpos pos2 = BUF_PT(buf);
 135         Bufpos pos;
 136         EMACS_INT n, shortage, negp;
 137
 138         if (NILP(count))
 139                 n = 1;
 140         else {
 141                 CHECK_INT(count);
 142                 n = XINT(count);
 143         }
 144
 145         negp = n <= 0;
 146         pos = scan_buffer(buf, '\n', pos2, 0, n - negp, &shortage, 1);
 147         if (shortage > 0 && (negp || (BUF_ZV(buf) > BUF_BEGV(buf)
 148                                       && pos != pos2
 149                                       && BUF_FETCH_CHAR(buf, pos - 1) != '\n')))
 150                 shortage--;
 151         BUF_SET_PT(buf, pos);
 152         return make_int(negp ? -shortage : shortage);
 153 }
 154
 155 DEFUN("point-at-bol", Fpoint_at_bol, 0, 2, 0,   /*
 156 Return the character position of the first character on the current line.
 157 With argument COUNT not nil or 1, move forward COUNT - 1 lines first.
 158 If scan reaches end of buffer, return that position.
 159 This function does not move point.
 160 */
 161       (count, buffer))
 162 {
 163         struct buffer *b = decode_buffer(buffer, 1);
 164         REGISTER int orig, end;
 165
 166         XSETBUFFER(buffer, b);
 167         if (NILP(count))
 168                 count = make_int(0);
 169         else {
 170                 CHECK_INT(count);
 171                 count = make_int(XINT(count) - 1);
 172         }
 173
 174         orig = BUF_PT(b);
 175         Fforward_line(count, buffer);
 176         end = BUF_PT(b);
 177         BUF_SET_PT(b, orig);
 178
 179         return make_int(end);
 180 }
 181
 182 DEFUN("beginning-of-line", Fbeginning_of_line, 0, 2, "_p",      /*
 183 Move point to beginning of current line.
 184 With argument COUNT not nil or 1, move forward COUNT - 1 lines first.
 185 If scan reaches end of buffer, stop there without error.
 186 If BUFFER is nil, the current buffer is assumed.
 187
 188 The characters that are moved over may be added to the current selection
 189 \(i.e. active region) if the Shift key is held down, a motion key is used
 190 to invoke this command, and `shifted-motion-keys-select-region' is t; see
 191 the documentation for this variable for more details.
 192 */
 193       (count, buffer))
 194 {
 195         struct buffer *b = decode_buffer(buffer, 1);
 196
 197         BUF_SET_PT(b, XINT(Fpoint_at_bol(count, buffer)));
 198         return Qnil;
 199 }
 200
 201 DEFUN("point-at-eol", Fpoint_at_eol, 0, 2, 0,   /*
 202 Return the character position of the last character on the current line.
 203 With argument COUNT not nil or 1, move forward COUNT - 1 lines first.
 204 If scan reaches end of buffer, return that position.
 205 This function does not move point.
 206 */
 207       (count, buffer))
 208 {
 209         struct buffer *buf = decode_buffer(buffer, 1);
 210         EMACS_INT n;
 211
 212         if (NILP(count))
 213                 n = 1;
 214         else {
 215                 CHECK_INT(count);
 216                 n = XINT(count);
 217         }
 218
 219         return make_int(find_before_next_newline(buf, BUF_PT(buf), 0,
 220                                                  n - (n <= 0)));
 221 }
 222
 223 DEFUN("end-of-line", Fend_of_line, 0, 2, "_p",  /*
 224 Move point to end of current line.
 225 With argument COUNT not nil or 1, move forward COUNT - 1 lines first.
 226 If scan reaches end of buffer, stop there without error.
 227 If BUFFER is nil, the current buffer is assumed.
 228
 229 The characters that are moved over may be added to the current selection
 230 \(i.e. active region) if the Shift key is held down, a motion key is used
 231 to invoke this command, and `shifted-motion-keys-select-region' is t; see
 232 the documentation for this variable for more details.
 233 */
 234       (count, buffer))
 235 {
 236         struct buffer *b = decode_buffer(buffer, 1);
 237
 238         BUF_SET_PT(b, XINT(Fpoint_at_eol(count, buffer)));
 239         return Qnil;
 240 }
 241
 242 DEFUN("delete-char", Fdelete_char, 0, 2, "*p\nP",       /*
 243 Delete the following COUNT characters (previous, with negative COUNT).
 244 Optional second arg KILLP non-nil means kill instead (save in kill ring).
 245 Interactively, COUNT is the prefix arg, and KILLP is set if
 246 COUNT was explicitly specified.
 247 */
 248       (count, killp))
 249 {
 250         /* This function can GC */
 251         Bufpos pos;
 252         struct buffer *buf = current_buffer;
 253         EMACS_INT n;
 254
 255         if (NILP(count))
 256                 n = 1;
 257         else {
 258                 CHECK_INT(count);
 259                 n = XINT(count);
 260         }
 261
 262         pos = BUF_PT(buf) + n;
 263         if (NILP(killp)) {
 264                 if (n < 0) {
 265                         if (pos < BUF_BEGV(buf))
 266                                 signal_error(Qbeginning_of_buffer, Qnil);
 267                         else
 268                                 buffer_delete_range(buf, pos, BUF_PT(buf), 0);
 269                 } else {
 270                         if (pos > BUF_ZV(buf))
 271                                 signal_error(Qend_of_buffer, Qnil);
 272                         else
 273                                 buffer_delete_range(buf, BUF_PT(buf), pos, 0);
 274                 }
 275         } else {
 276                 call1(Qkill_forward_chars, count);
 277         }
 278         return Qnil;
 279 }
 280
 281 DEFUN("delete-backward-char", Fdelete_backward_char, 0, 2, "*p\nP",     /*
 282 Delete the previous COUNT characters (following, with negative COUNT).
 283 Optional second arg KILLP non-nil means kill instead (save in kill ring).
 284 Interactively, COUNT is the prefix arg, and KILLP is set if
 285 COUNT was explicitly specified.
 286 */
 287       (count, killp))
 288 {
 289         /* This function can GC */
 290         EMACS_INT n;
 291
 292         if (NILP(count))
 293                 n = 1;
 294         else {
 295                 CHECK_INT(count);
 296                 n = XINT(count);
 297         }
 298
 299         return Fdelete_char(make_int(-n), killp);
 300 }
 301
 302 static void internal_self_insert(Emchar ch, int noautofill);
 303
 304 DEFUN("self-insert-command", Fself_insert_command, 1, 1, "*p",  /*
 305 Insert the character you type.
 306 Whichever character you type to run this command is inserted.
 307 If a prefix arg COUNT is specified, the character is inserted COUNT times.
 308 */
 309       (count))
 310 {
 311         /* This function can GC */
 312         Emchar ch;
 313         Lisp_Object c;
 314         EMACS_INT n;
 315
 316         CHECK_NATNUM(count);
 317         n = XINT(count);
 318
 319         if (CHAR_OR_CHAR_INTP(Vlast_command_char))
 320                 c = Vlast_command_char;
 321         else
 322                 c = Fevent_to_character(Vlast_command_event, Qnil, Qnil, Qt);
 323
 324         if (NILP(c))
 325                 signal_simple_error
 326                     ("Last typed character has no ASCII equivalent",
 327                      Fcopy_event(Vlast_command_event, Qnil));
 328
 329         CHECK_CHAR_COERCE_INT(c);
 330
 331         ch = XCHAR(c);
 332
 333         while (n--)
 334                 internal_self_insert(ch, (n != 0));
 335
 336         return Qnil;
 337 }
 338
 339 /* Insert character C1.  If NOAUTOFILL is nonzero, don't do autofill
 340    even if it is enabled.
 341
 342    FSF:
 343
 344    If this insertion is suitable for direct output (completely simple),
 345    return 0.  A value of 1 indicates this *might* not have been simple.
 346    A value of 2 means this did things that call for an undo boundary.  */
 347
 348 static void internal_self_insert(Emchar c1, int noautofill)
 349 {
 350         /* This function can GC */
 351         /* int hairy = 0; -- unused */
 352         REGISTER enum syntaxcode synt;
 353         REGISTER Emchar c2;
 354         Lisp_Object overwrite;
 355         Lisp_Char_Table *syntax_table;
 356         struct buffer *buf = current_buffer;
 357         int tab_width;
 358
 359         overwrite = buf->overwrite_mode;
 360         syntax_table = XCHAR_TABLE(buf->mirror_syntax_table);
 361
 362 #if 0
 363         /* No, this is very bad, it makes undo *always* undo a character at a time
 364            instead of grouping consecutive self-inserts together.  Nasty nasty.
 365          */
 366         if (!NILP(Vbefore_change_functions) || !NILP(Vafter_change_functions)
 367             || !NILP(Vbefore_change_function) || !NILP(Vafter_change_function))
 368                 hairy = 1;
 369 #endif
 370
 371         if (!NILP(overwrite)
 372             && BUF_PT(buf) < BUF_ZV(buf)
 373             && (EQ(overwrite, Qoverwrite_mode_binary)
 374                 || (c1 != '\n' && BUF_FETCH_CHAR(buf, BUF_PT(buf)) != '\n'))
 375             && (EQ(overwrite, Qoverwrite_mode_binary)
 376                 || BUF_FETCH_CHAR(buf, BUF_PT(buf)) != '\t'
 377                 || ((tab_width = XINT(buf->tab_width), tab_width <= 0)
 378                     || tab_width > 20
 379                     || !((current_column(buf) + 1) % tab_width)))) {
 380                 buffer_delete_range(buf, BUF_PT(buf), BUF_PT(buf) + 1, 0);
 381                 /* hairy = 2; */
 382         }
 383
 384         if (!NILP(buf->abbrev_mode)
 385             && !WORD_SYNTAX_P(syntax_table, c1)
 386             && NILP(buf->read_only)
 387             && BUF_PT(buf) > BUF_BEGV(buf)) {
 388                 c2 = BUF_FETCH_CHAR(buf, BUF_PT(buf) - 1);
 389
 390                 if (WORD_SYNTAX_P(syntax_table, c2)) {
 391 #if 1
 392                         Fexpand_abbrev();
 393 #else                           /* FSFmacs */
 394                         Lisp_Object sym = Fexpand_abbrev();
 395
 396                         /* I think this is too bogus to add.  The function should
 397                            have a way of examining the character to be inserted, so
 398                            it can decide whether to insert it or not.  We should
 399                            design it better than that.  */
 400
 401                         /* Here FSFmacs remembers MODIFF, compares it after
 402                            Fexpand_abbrev() finishes, and updates HAIRY.  */
 403
 404                         /* NOTE: we cannot simply check for Vlast_abbrev, because
 405                            Fexpand_abbrev() can bail out before setting it to
 406                            anything meaningful, leaving us stuck with an old value.
 407                            Thus Fexpand_abbrev() was extended to return the actual
 408                            abbrev symbol.  */
 409                         if (!NILP(sym)
 410                             && !NILP(symbol_function(XSYMBOL(sym)))
 411                             && SYMBOLP(symbol_function(XSYMBOL(sym)))) {
 412                                 Lisp_Object prop =
 413                                     Fget(symbol_function(XSYMBOL(sym)),
 414                                          Qno_self_insert, Qnil);
 415                                 if (!NILP(prop))
 416                                         return;
 417                         }
 418 #endif                          /* FSFmacs */
 419                 }
 420         }
 421         if ((CHAR_TABLEP(Vauto_fill_chars)
 422              ? !NILP(XCHAR_TABLE_VALUE_UNSAFE(Vauto_fill_chars, c1))
 423              : (c1 == ' ' || c1 == '\n'))
 424             && !noautofill && !NILP(buf->auto_fill_function)) {
 425                 buffer_insert_emacs_char(buf, c1);
 426                 if (c1 == '\n')
 427                         /* After inserting a newline, move to previous line and fill */
 428                         /* that.  Must have the newline in place already so filling and */
 429                         /* justification, if any, know where the end is going to be. */
 430                         BUF_SET_PT(buf, BUF_PT(buf) - 1);
 431                 call0(buf->auto_fill_function);
 432                 if (c1 == '\n')
 433                         BUF_SET_PT(buf, BUF_PT(buf) + 1);
 434                 /* hairy = 2; */
 435         } else
 436                 buffer_insert_emacs_char(buf, c1);
 437
 438         /* If previous command specified a face to use, use it.  */
 439         if (!NILP(Vself_insert_face)
 440             && EQ(Vlast_command, Vself_insert_face_command)) {
 441                 Lisp_Object before = make_int(BUF_PT(buf) - 1);
 442                 Lisp_Object after = make_int(BUF_PT(buf));
 443                 Fput_text_property(before, after, Qface, Vself_insert_face,
 444                                    Qnil);
 445                 Fput_text_property(before, after, Qstart_open, Qt, Qnil);
 446                 Fput_text_property(before, after, Qend_open, Qnil, Qnil);
 447                 /* #### FSFmacs properties are normally closed ("sticky") on the
 448                    end but not the beginning.  It's the opposite for us. */
 449                 Vself_insert_face = Qnil;
 450         }
 451         synt = SYNTAX(syntax_table, c1);
 452         if ((synt == Sclose || synt == Smath)
 453             && !NILP(Vblink_paren_function) && INTERACTIVE && !noautofill) {
 454                 call0(Vblink_paren_function);
 455                 /* hairy = 2; */
 456         }
 457
 458         /* return hairy; */
 459 }
 460
 461 /* (this comes from Mule but is a generally good idea) */
 462
 463 DEFUN("self-insert-internal", Fself_insert_internal, 1, 1, 0,   /*
 464 Invoke `self-insert-command' as if CHARACTER is entered from keyboard.
 465 */
 466       (character))
 467 {
 468         /* This function can GC */
 469         CHECK_CHAR_COERCE_INT(character);
 470         internal_self_insert(XCHAR(character), 0);
 471         return Qnil;
 472 }
 473 \f
 474 /* module initialization */
 475
 476 void syms_of_cmds(void)
 477 {
 478         defsymbol(&Qkill_forward_chars, "kill-forward-chars");
 479         defsymbol(&Qself_insert_command, "self-insert-command");
 480         defsymbol(&Qoverwrite_mode_binary, "overwrite-mode-binary");
 481         defsymbol(&Qno_self_insert, "no-self-insert");
 482
 483         DEFSUBR(Fforward_char);
 484         DEFSUBR(Fbackward_char);
 485         DEFSUBR(Fforward_line);
 486         DEFSUBR(Fbeginning_of_line);
 487         DEFSUBR(Fend_of_line);
 488
 489         DEFSUBR(Fpoint_at_bol);
 490         DEFSUBR(Fpoint_at_eol);
 491
 492         DEFSUBR(Fdelete_char);
 493         DEFSUBR(Fdelete_backward_char);
 494
 495         DEFSUBR(Fself_insert_command);
 496         DEFSUBR(Fself_insert_internal);
 497 }
 498
 499 void vars_of_cmds(void)
 500 {
 501         DEFVAR_LISP("self-insert-face", &Vself_insert_face      /*
 502 If non-nil, set the face of the next self-inserting character to this.
 503 See also `self-insert-face-command'.
 504                                                                  */ );
 505         Vself_insert_face = Qnil;
 506
 507         DEFVAR_LISP("self-insert-face-command", &Vself_insert_face_command      /*
 508 This is the command that set up `self-insert-face'.
 509 If `last-command' does not equal this value, we ignore `self-insert-face'.
 510                                                                                  */ );
 511         Vself_insert_face_command = Qnil;
 512
 513         DEFVAR_LISP("blink-paren-function", &Vblink_paren_function      /*
 514 Function called, if non-nil, whenever a close parenthesis is inserted.
 515 More precisely, a char with closeparen syntax is self-inserted.
 516                                                                          */ );
 517         Vblink_paren_function = Qnil;
 518
 519         DEFVAR_LISP("auto-fill-chars", &Vauto_fill_chars        /*
 520 A char-table for characters which invoke auto-filling.
 521 Such characters have value t in this table.
 522                                                                  */ );
 523         Vauto_fill_chars = Fmake_char_table(Qgeneric);
 524         XCHAR_TABLE(Vauto_fill_chars)->ascii[' '] = Qt;
 525         XCHAR_TABLE(Vauto_fill_chars)->ascii['\n'] = Qt;
 526 }