Mercurial > hg > xemacs-beta
annotate src/cmds.c @ 5366:f00192e1cd49
Examining the result of #'length: `eql', not `=', it's better style & cheaper
2011-03-08 Aidan Kehoe <kehoea@parhasard.net>
* buff-menu.el (list-buffers-noselect):
* byte-optimize.el (byte-optimize-identity):
* byte-optimize.el (byte-optimize-if):
* byte-optimize.el (byte-optimize-nth):
* byte-optimize.el (byte-optimize-nthcdr):
* bytecomp.el (byte-compile-warn-wrong-args):
* bytecomp.el (byte-compile-two-args-19->20):
* bytecomp.el (byte-compile-list):
* bytecomp.el (byte-compile-beginning-of-line):
* bytecomp.el (byte-compile-set):
* bytecomp.el (byte-compile-set-default):
* bytecomp.el (byte-compile-values):
* bytecomp.el (byte-compile-values-list):
* bytecomp.el (byte-compile-integerp):
* bytecomp.el (byte-compile-multiple-value-list-internal):
* bytecomp.el (byte-compile-throw):
* cl-macs.el (cl-do-arglist):
* cl-macs.el (cl-parse-loop-clause):
* cl-macs.el (multiple-value-bind):
* cl-macs.el (multiple-value-setq):
* cl-macs.el (get-setf-method):
* cmdloop.el (command-error):
* cmdloop.el (y-or-n-p-minibuf):
* cmdloop.el (yes-or-no-p-minibuf):
* coding.el (unencodable-char-position):
* cus-edit.el (custom-face-prompt):
* cus-edit.el (custom-buffer-create-internal):
* cus-edit.el (widget-face-action):
* cus-edit.el (custom-group-value-create):
* descr-text.el (describe-char-unicode-data):
* dialog-gtk.el (popup-builtin-question-dialog):
* dragdrop.el (experimental-dragdrop-drop-log-function):
* dragdrop.el (experimental-dragdrop-drop-mime-default):
* easymenu.el (easy-menu-add):
* easymenu.el (easy-menu-remove):
* faces.el (read-face-name):
* faces.el (set-face-stipple):
* files.el (file-name-non-special):
* font.el (font-combine-fonts):
* font.el (font-set-face-font):
* font.el (font-parse-rgb-components):
* font.el (font-rgb-color-p):
* font.el (font-color-rgb-components):
* gnuserv.el (gnuserv-edit-files):
* help.el (key-or-menu-binding):
* help.el (function-documentation-1):
* help.el (function-documentation):
* info.el (info):
* isearch-mode.el (isearch-exit):
* isearch-mode.el (isearch-edit-string):
* isearch-mode.el (isearch-*-char):
* isearch-mode.el (isearch-complete1):
* ldap.el (ldap-encode-country-string):
* ldap.el (ldap-decode-string):
* minibuf.el (read-file-name-internal-1):
* minibuf.el (read-non-nil-coding-system):
* minibuf.el (get-user-response):
* mouse.el (drag-window-divider):
* mule/ccl.el:
* mule/ccl.el (ccl-compile-if):
* mule/ccl.el (ccl-compile-break):
* mule/ccl.el (ccl-compile-repeat):
* mule/ccl.el (ccl-compile-write-repeat):
* mule/ccl.el (ccl-compile-call):
* mule/ccl.el (ccl-compile-end):
* mule/ccl.el (ccl-compile-read-multibyte-character):
* mule/ccl.el (ccl-compile-write-multibyte-character):
* mule/ccl.el (ccl-compile-translate-character):
* mule/ccl.el (ccl-compile-mule-to-unicode):
* mule/ccl.el (ccl-compile-unicode-to-mule):
* mule/ccl.el (ccl-compile-lookup-integer):
* mule/ccl.el (ccl-compile-lookup-character):
* mule/ccl.el (ccl-compile-map-multiple):
* mule/ccl.el (ccl-compile-map-single):
* mule/devan-util.el (devanagari-compose-to-one-glyph):
* mule/devan-util.el (devanagari-composition-component):
* mule/mule-cmds.el (finish-set-language-environment):
* mule/viet-util.el:
* mule/viet-util.el (viet-encode-viscii-char):
* multicast.el (open-multicast-group):
* newcomment.el (comment-quote-nested):
* newcomment.el (comment-region):
* newcomment.el (comment-dwim):
* regexp-opt.el (regexp-opt-group):
* replace.el (map-query-replace-regexp):
* specifier.el (derive-device-type-from-tag-set):
* subr.el (skip-chars-quote):
* test-harness.el (test-harness-from-buffer):
* test-harness.el (batch-test-emacs):
* wid-edit.el (widget-choice-action):
* wid-edit.el (widget-symbol-prompt-internal):
* wid-edit.el (widget-color-action):
* window-xemacs.el (push-window-configuration):
* window-xemacs.el (pop-window-configuration):
* window.el (quit-window):
* x-compose.el (electric-diacritic):
It's better style, and cheaper (often one assembler instruction
vs. a C funcall in the byte code), to use `eql' instead of `='
when it's clear what numerical type a given result will be. Change
much of our code to do this, with the help of a byte-compiler
change (not comitted) that looked for calls to #'length (which
always returns an integer) in its args.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Tue, 08 Mar 2011 23:41:52 +0000 |
| parents | c096d8051f89 |
| children | 8d29f1c4bb98 |
| rev | line source |
|---|---|
| 428 | 1 /* Simple built-in editing commands. |
| 2 Copyright (C) 1985, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. | |
| 826 | 3 Copyright (C) 2002 Ben Wing. |
| 428 | 4 |
| 5 This file is part of XEmacs. | |
| 6 | |
| 7 XEmacs is free software; you can redistribute it and/or modify it | |
| 8 under the terms of the GNU General Public License as published by the | |
| 9 Free Software Foundation; either version 2, or (at your option) any | |
| 10 later version. | |
| 11 | |
| 12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 15 for more details. | |
| 16 | |
| 17 You should have received a copy of the GNU General Public License | |
| 18 along with XEmacs; see the file COPYING. If not, write to | |
| 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 20 Boston, MA 02111-1307, USA. */ | |
| 21 | |
| 22 /* Synched up with: Mule 2.0, FSF 19.30. */ | |
| 23 | |
| 24 #include <config.h> | |
| 25 #include "lisp.h" | |
| 26 #include "commands.h" | |
| 27 #include "buffer.h" | |
| 872 | 28 #include "extents.h" |
| 428 | 29 #include "syntax.h" |
| 30 #include "insdel.h" | |
| 31 | |
| 32 Lisp_Object Qkill_forward_chars; | |
| 33 Lisp_Object Qself_insert_command; | |
| 34 Lisp_Object Qno_self_insert; | |
| 35 | |
| 36 Lisp_Object Vblink_paren_function; | |
| 37 | |
| 38 /* A possible value for a buffer's overwrite-mode variable. */ | |
| 39 Lisp_Object Qoverwrite_mode_binary; | |
| 40 | |
| 41 /* Non-nil means put this face on the next self-inserting character. */ | |
| 42 Lisp_Object Vself_insert_face; | |
| 43 | |
| 44 /* This is the command that set up Vself_insert_face. */ | |
| 45 Lisp_Object Vself_insert_face_command; | |
| 442 | 46 |
| 47 /* A char-table for characters which may invoke auto-filling. */ | |
| 48 Lisp_Object Vauto_fill_chars; | |
| 428 | 49 |
| 50 DEFUN ("forward-char", Fforward_char, 0, 2, "_p", /* | |
| 444 | 51 Move point right COUNT characters (left if COUNT is negative). |
| 428 | 52 On attempt to pass end of buffer, stop and signal `end-of-buffer'. |
| 53 On attempt to pass beginning of buffer, stop and signal `beginning-of-buffer'. | |
| 54 On reaching end of buffer, stop and signal error. | |
| 462 | 55 |
| 56 The characters that are moved over may be added to the current selection | |
| 57 \(i.e. active region) if the Shift key is held down, a motion key is used | |
| 58 to invoke this command, and `shifted-motion-keys-select-region' is t; see | |
| 59 the documentation for this variable for more details. | |
| 428 | 60 */ |
| 444 | 61 (count, buffer)) |
| 428 | 62 { |
| 63 struct buffer *buf = decode_buffer (buffer, 1); | |
| 444 | 64 EMACS_INT n; |
| 428 | 65 |
| 444 | 66 if (NILP (count)) |
| 67 n = 1; | |
| 428 | 68 else |
| 69 { | |
| 444 | 70 CHECK_INT (count); |
| 71 n = XINT (count); | |
| 428 | 72 } |
| 73 | |
| 444 | 74 /* This used to just set point to point + XINT (count), and then check |
| 428 | 75 to see if it was within boundaries. But now that SET_PT can |
| 76 potentially do a lot of stuff (calling entering and exiting | |
| 77 hooks, etcetera), that's not a good approach. So we validate the | |
| 78 proposed position, then set point. */ | |
| 79 { | |
| 665 | 80 Charbpos new_point = BUF_PT (buf) + n; |
| 428 | 81 |
| 82 if (new_point < BUF_BEGV (buf)) | |
| 83 { | |
| 84 BUF_SET_PT (buf, BUF_BEGV (buf)); | |
| 85 Fsignal (Qbeginning_of_buffer, Qnil); | |
| 86 return Qnil; | |
| 87 } | |
| 88 if (new_point > BUF_ZV (buf)) | |
| 89 { | |
| 90 BUF_SET_PT (buf, BUF_ZV (buf)); | |
| 91 Fsignal (Qend_of_buffer, Qnil); | |
| 92 return Qnil; | |
| 93 } | |
| 94 | |
| 95 BUF_SET_PT (buf, new_point); | |
| 96 } | |
| 97 | |
| 98 return Qnil; | |
| 99 } | |
| 100 | |
| 101 DEFUN ("backward-char", Fbackward_char, 0, 2, "_p", /* | |
| 444 | 102 Move point left COUNT characters (right if COUNT is negative). |
| 428 | 103 On attempt to pass end of buffer, stop and signal `end-of-buffer'. |
| 104 On attempt to pass beginning of buffer, stop and signal `beginning-of-buffer'. | |
| 462 | 105 |
| 106 The characters that are moved over may be added to the current selection | |
| 107 \(i.e. active region) if the Shift key is held down, a motion key is used | |
| 108 to invoke this command, and `shifted-motion-keys-select-region' is t; see | |
| 109 the documentation for this variable for more details. | |
| 428 | 110 */ |
| 444 | 111 (count, buffer)) |
| 428 | 112 { |
| 444 | 113 if (NILP (count)) |
| 114 count = make_int (-1); | |
| 428 | 115 else |
| 116 { | |
| 444 | 117 CHECK_INT (count); |
| 118 count = make_int (- XINT (count)); | |
| 428 | 119 } |
| 444 | 120 return Fforward_char (count, buffer); |
| 428 | 121 } |
| 122 | |
| 123 DEFUN ("forward-line", Fforward_line, 0, 2, "_p", /* | |
| 444 | 124 Move COUNT lines forward (backward if COUNT is negative). |
| 125 Precisely, if point is on line I, move to the start of line I + COUNT. | |
| 428 | 126 If there isn't room, go as far as possible (no error). |
| 127 Returns the count of lines left to move. If moving forward, | |
| 444 | 128 that is COUNT - number of lines moved; if backward, COUNT + number moved. |
| 3577 | 129 \(Note that if COUNT is negative, the return will be non-positive.) |
| 444 | 130 With positive COUNT, a non-empty line at the end counts as one line |
| 428 | 131 successfully moved (for the return value). |
| 132 If BUFFER is nil, the current buffer is assumed. | |
| 462 | 133 |
| 134 The characters that are moved over may be added to the current selection | |
| 135 \(i.e. active region) if the Shift key is held down, a motion key is used | |
| 136 to invoke this command, and `shifted-motion-keys-select-region' is t; see | |
| 137 the documentation for this variable for more details. | |
| 428 | 138 */ |
| 444 | 139 (count, buffer)) |
| 428 | 140 { |
| 141 struct buffer *buf = decode_buffer (buffer, 1); | |
| 665 | 142 Charbpos pos2 = BUF_PT (buf); |
| 143 Charbpos pos; | |
| 444 | 144 EMACS_INT n, shortage, negp; |
| 428 | 145 |
| 444 | 146 if (NILP (count)) |
| 147 n = 1; | |
| 428 | 148 else |
| 149 { | |
| 444 | 150 CHECK_INT (count); |
| 151 n = XINT (count); | |
| 428 | 152 } |
| 153 | |
| 444 | 154 negp = n <= 0; |
| 155 pos = scan_buffer (buf, '\n', pos2, 0, n - negp, &shortage, 1); | |
| 428 | 156 if (shortage > 0 |
| 157 && (negp | |
| 158 || (BUF_ZV (buf) > BUF_BEGV (buf) | |
| 159 && pos != pos2 | |
| 160 && BUF_FETCH_CHAR (buf, pos - 1) != '\n'))) | |
| 161 shortage--; | |
| 162 BUF_SET_PT (buf, pos); | |
| 163 return make_int (negp ? - shortage : shortage); | |
| 164 } | |
| 165 | |
| 166 DEFUN ("point-at-bol", Fpoint_at_bol, 0, 2, 0, /* | |
| 167 Return the character position of the first character on the current line. | |
| 444 | 168 With argument COUNT not nil or 1, move forward COUNT - 1 lines first. |
| 428 | 169 If scan reaches end of buffer, return that position. |
| 170 This function does not move point. | |
| 171 */ | |
| 444 | 172 (count, buffer)) |
| 428 | 173 { |
| 174 struct buffer *b = decode_buffer (buffer, 1); | |
| 175 REGISTER int orig, end; | |
| 176 | |
| 793 | 177 buffer = wrap_buffer (b); |
| 444 | 178 if (NILP (count)) |
| 179 count = make_int (0); | |
| 428 | 180 else |
| 181 { | |
| 444 | 182 CHECK_INT (count); |
| 183 count = make_int (XINT (count) - 1); | |
| 428 | 184 } |
| 185 | |
| 186 orig = BUF_PT (b); | |
| 444 | 187 Fforward_line (count, buffer); |
| 428 | 188 end = BUF_PT (b); |
| 189 BUF_SET_PT (b, orig); | |
| 190 | |
| 191 return make_int (end); | |
| 192 } | |
| 193 | |
| 194 DEFUN ("beginning-of-line", Fbeginning_of_line, 0, 2, "_p", /* | |
| 195 Move point to beginning of current line. | |
| 444 | 196 With argument COUNT not nil or 1, move forward COUNT - 1 lines first. |
| 428 | 197 If scan reaches end of buffer, stop there without error. |
| 198 If BUFFER is nil, the current buffer is assumed. | |
| 462 | 199 |
| 200 The characters that are moved over may be added to the current selection | |
| 201 \(i.e. active region) if the Shift key is held down, a motion key is used | |
| 202 to invoke this command, and `shifted-motion-keys-select-region' is t; see | |
| 203 the documentation for this variable for more details. | |
| 428 | 204 */ |
| 444 | 205 (count, buffer)) |
| 428 | 206 { |
| 207 struct buffer *b = decode_buffer (buffer, 1); | |
| 208 | |
| 444 | 209 BUF_SET_PT (b, XINT (Fpoint_at_bol (count, buffer))); |
| 428 | 210 return Qnil; |
| 211 } | |
| 212 | |
| 213 DEFUN ("point-at-eol", Fpoint_at_eol, 0, 2, 0, /* | |
| 214 Return the character position of the last character on the current line. | |
| 444 | 215 With argument COUNT not nil or 1, move forward COUNT - 1 lines first. |
| 428 | 216 If scan reaches end of buffer, return that position. |
| 217 This function does not move point. | |
| 218 */ | |
| 444 | 219 (count, buffer)) |
| 428 | 220 { |
| 221 struct buffer *buf = decode_buffer (buffer, 1); | |
| 446 | 222 EMACS_INT n; |
| 428 | 223 |
| 444 | 224 if (NILP (count)) |
| 225 n = 1; | |
| 428 | 226 else |
| 227 { | |
| 444 | 228 CHECK_INT (count); |
| 229 n = XINT (count); | |
| 428 | 230 } |
| 231 | |
| 232 return make_int (find_before_next_newline (buf, BUF_PT (buf), 0, | |
| 444 | 233 n - (n <= 0))); |
| 428 | 234 } |
| 235 | |
| 236 DEFUN ("end-of-line", Fend_of_line, 0, 2, "_p", /* | |
| 237 Move point to end of current line. | |
| 444 | 238 With argument COUNT not nil or 1, move forward COUNT - 1 lines first. |
| 428 | 239 If scan reaches end of buffer, stop there without error. |
| 240 If BUFFER is nil, the current buffer is assumed. | |
| 462 | 241 |
| 242 The characters that are moved over may be added to the current selection | |
| 243 \(i.e. active region) if the Shift key is held down, a motion key is used | |
| 244 to invoke this command, and `shifted-motion-keys-select-region' is t; see | |
| 245 the documentation for this variable for more details. | |
| 428 | 246 */ |
| 444 | 247 (count, buffer)) |
| 428 | 248 { |
| 249 struct buffer *b = decode_buffer (buffer, 1); | |
| 250 | |
| 444 | 251 BUF_SET_PT (b, XINT (Fpoint_at_eol (count, buffer))); |
| 428 | 252 return Qnil; |
| 253 } | |
| 254 | |
| 446 | 255 DEFUN ("delete-char", Fdelete_char, 0, 2, "*p\nP", /* |
| 444 | 256 Delete the following COUNT characters (previous, with negative COUNT). |
| 257 Optional second arg KILLP non-nil means kill instead (save in kill ring). | |
| 258 Interactively, COUNT is the prefix arg, and KILLP is set if | |
| 259 COUNT was explicitly specified. | |
| 428 | 260 */ |
| 444 | 261 (count, killp)) |
| 428 | 262 { |
| 263 /* This function can GC */ | |
| 665 | 264 Charbpos pos; |
| 428 | 265 struct buffer *buf = current_buffer; |
| 446 | 266 EMACS_INT n; |
| 428 | 267 |
| 446 | 268 if (NILP (count)) |
| 269 n = 1; | |
| 270 else | |
| 271 { | |
| 272 CHECK_INT (count); | |
| 273 n = XINT (count); | |
| 274 } | |
| 428 | 275 |
| 444 | 276 pos = BUF_PT (buf) + n; |
| 277 if (NILP (killp)) | |
| 428 | 278 { |
| 444 | 279 if (n < 0) |
| 428 | 280 { |
| 281 if (pos < BUF_BEGV (buf)) | |
| 563 | 282 signal_error (Qbeginning_of_buffer, 0, Qunbound); |
| 428 | 283 else |
| 284 buffer_delete_range (buf, pos, BUF_PT (buf), 0); | |
| 285 } | |
| 286 else | |
| 287 { | |
| 288 if (pos > BUF_ZV (buf)) | |
| 563 | 289 signal_error (Qend_of_buffer, 0, Qunbound); |
| 428 | 290 else |
| 291 buffer_delete_range (buf, BUF_PT (buf), pos, 0); | |
| 292 } | |
| 293 } | |
| 294 else | |
| 295 { | |
| 444 | 296 call1 (Qkill_forward_chars, count); |
| 428 | 297 } |
| 298 return Qnil; | |
| 299 } | |
| 300 | |
| 446 | 301 DEFUN ("delete-backward-char", Fdelete_backward_char, 0, 2, "*p\nP", /* |
| 444 | 302 Delete the previous COUNT characters (following, with negative COUNT). |
| 303 Optional second arg KILLP non-nil means kill instead (save in kill ring). | |
| 304 Interactively, COUNT is the prefix arg, and KILLP is set if | |
| 305 COUNT was explicitly specified. | |
| 428 | 306 */ |
| 444 | 307 (count, killp)) |
| 428 | 308 { |
| 309 /* This function can GC */ | |
| 446 | 310 EMACS_INT n; |
| 311 | |
| 312 if (NILP (count)) | |
| 313 n = 1; | |
| 314 else | |
| 315 { | |
| 316 CHECK_INT (count); | |
| 317 n = XINT (count); | |
| 318 } | |
| 319 | |
| 320 return Fdelete_char (make_int (- n), killp); | |
| 428 | 321 } |
| 322 | |
| 867 | 323 static void internal_self_insert (Ichar ch, int noautofill); |
| 428 | 324 |
| 325 DEFUN ("self-insert-command", Fself_insert_command, 1, 1, "*p", /* | |
| 326 Insert the character you type. | |
| 327 Whichever character you type to run this command is inserted. | |
| 444 | 328 If a prefix arg COUNT is specified, the character is inserted COUNT times. |
| 428 | 329 */ |
| 444 | 330 (count)) |
| 428 | 331 { |
| 332 /* This function can GC */ | |
| 867 | 333 Ichar ch; |
| 428 | 334 Lisp_Object c; |
| 446 | 335 EMACS_INT n; |
| 428 | 336 |
|
5307
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3577
diff
changeset
|
337 /* Can't insert more than most-positive-fixnum characters, the buffer |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3577
diff
changeset
|
338 won't hold that many. */ |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3577
diff
changeset
|
339 check_integer_range (count, Qzero, make_int (EMACS_INT_MAX)); |
| 444 | 340 n = XINT (count); |
| 428 | 341 |
| 342 if (CHAR_OR_CHAR_INTP (Vlast_command_char)) | |
| 343 c = Vlast_command_char; | |
| 344 else | |
| 2862 | 345 c = Fevent_to_character (Vlast_command_event, Qnil, Qnil, Qnil); |
| 428 | 346 |
| 347 if (NILP (c)) | |
| 2828 | 348 invalid_operation ( |
| 349 "Last typed key has no character equivalent (that we know of)", | |
| 350 Fcopy_event (Vlast_command_event, Qnil)); | |
| 428 | 351 |
| 352 CHECK_CHAR_COERCE_INT (c); | |
| 353 | |
| 354 ch = XCHAR (c); | |
| 355 | |
| 444 | 356 while (n--) |
| 357 internal_self_insert (ch, (n != 0)); | |
| 428 | 358 |
| 359 return Qnil; | |
| 360 } | |
| 361 | |
| 362 /* Insert character C1. If NOAUTOFILL is nonzero, don't do autofill | |
| 363 even if it is enabled. | |
| 364 | |
| 365 FSF: | |
| 366 | |
| 367 If this insertion is suitable for direct output (completely simple), | |
| 368 return 0. A value of 1 indicates this *might* not have been simple. | |
| 369 A value of 2 means this did things that call for an undo boundary. */ | |
| 370 | |
| 371 static void | |
| 867 | 372 internal_self_insert (Ichar c1, int noautofill) |
| 428 | 373 { |
| 374 /* This function can GC */ | |
| 375 /* int hairy = 0; -- unused */ | |
| 376 REGISTER enum syntaxcode synt; | |
| 867 | 377 REGISTER Ichar c2; |
| 428 | 378 Lisp_Object overwrite; |
| 826 | 379 Lisp_Object syntax_table; |
| 428 | 380 struct buffer *buf = current_buffer; |
| 381 int tab_width; | |
| 382 | |
| 383 overwrite = buf->overwrite_mode; | |
| 826 | 384 syntax_table = buf->mirror_syntax_table; |
| 428 | 385 |
| 386 #if 0 | |
| 387 /* No, this is very bad, it makes undo *always* undo a character at a time | |
| 388 instead of grouping consecutive self-inserts together. Nasty nasty. | |
| 389 */ | |
| 390 if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions) | |
| 391 || !NILP (Vbefore_change_function) || !NILP (Vafter_change_function)) | |
| 392 hairy = 1; | |
| 393 #endif | |
| 394 | |
| 395 if (!NILP (overwrite) | |
| 396 && BUF_PT (buf) < BUF_ZV (buf) | |
| 397 && (EQ (overwrite, Qoverwrite_mode_binary) | |
| 398 || (c1 != '\n' && BUF_FETCH_CHAR (buf, BUF_PT (buf)) != '\n')) | |
| 399 && (EQ (overwrite, Qoverwrite_mode_binary) | |
| 400 || BUF_FETCH_CHAR (buf, BUF_PT (buf)) != '\t' | |
| 401 || ((tab_width = XINT (buf->tab_width), tab_width <= 0) | |
| 402 || tab_width > 20 | |
| 403 || !((current_column (buf) + 1) % tab_width)))) | |
| 404 { | |
| 405 buffer_delete_range (buf, BUF_PT (buf), BUF_PT (buf) + 1, 0); | |
| 406 /* hairy = 2; */ | |
| 407 } | |
| 408 | |
| 409 if (!NILP (buf->abbrev_mode) | |
| 410 && !WORD_SYNTAX_P (syntax_table, c1) | |
| 411 && NILP (buf->read_only) | |
| 412 && BUF_PT (buf) > BUF_BEGV (buf)) | |
| 413 { | |
| 414 c2 = BUF_FETCH_CHAR (buf, BUF_PT (buf) - 1); | |
| 415 | |
| 416 if (WORD_SYNTAX_P (syntax_table, c2)) | |
| 417 { | |
| 418 #if 1 | |
| 419 Fexpand_abbrev (); | |
| 420 #else /* FSFmacs */ | |
| 421 Lisp_Object sym = Fexpand_abbrev (); | |
| 422 | |
| 423 /* I think this is too bogus to add. The function should | |
| 424 have a way of examining the character to be inserted, so | |
| 425 it can decide whether to insert it or not. We should | |
| 426 design it better than that. */ | |
| 427 | |
| 428 /* Here FSFmacs remembers MODIFF, compares it after | |
| 429 Fexpand_abbrev() finishes, and updates HAIRY. */ | |
| 430 | |
| 431 /* NOTE: we cannot simply check for Vlast_abbrev, because | |
| 432 Fexpand_abbrev() can bail out before setting it to | |
| 433 anything meaningful, leaving us stuck with an old value. | |
| 434 Thus Fexpand_abbrev() was extended to return the actual | |
| 435 abbrev symbol. */ | |
| 436 if (!NILP (sym) | |
| 437 && !NILP (symbol_function (XSYMBOL (sym))) | |
| 438 && SYMBOLP (symbol_function (XSYMBOL (sym)))) | |
| 439 { | |
| 440 Lisp_Object prop = Fget (symbol_function (XSYMBOL (sym)), | |
| 441 Qno_self_insert, Qnil); | |
| 442 if (!NILP (prop)) | |
| 443 return; | |
| 444 } | |
| 445 #endif /* FSFmacs */ | |
| 446 } | |
| 447 } | |
| 442 | 448 if ((CHAR_TABLEP (Vauto_fill_chars) |
| 826 | 449 ? !NILP (get_char_table (c1, Vauto_fill_chars)) |
| 442 | 450 : (c1 == ' ' || c1 == '\n')) |
| 428 | 451 && !noautofill |
| 452 && !NILP (buf->auto_fill_function)) | |
| 453 { | |
| 454 buffer_insert_emacs_char (buf, c1); | |
| 455 if (c1 == '\n') | |
| 456 /* After inserting a newline, move to previous line and fill */ | |
| 457 /* that. Must have the newline in place already so filling and */ | |
| 458 /* justification, if any, know where the end is going to be. */ | |
| 459 BUF_SET_PT (buf, BUF_PT (buf) - 1); | |
| 460 call0 (buf->auto_fill_function); | |
| 461 if (c1 == '\n') | |
| 462 BUF_SET_PT (buf, BUF_PT (buf) + 1); | |
| 463 /* hairy = 2; */ | |
| 464 } | |
| 465 else | |
| 466 buffer_insert_emacs_char (buf, c1); | |
| 467 | |
| 468 /* If previous command specified a face to use, use it. */ | |
| 469 if (!NILP (Vself_insert_face) | |
| 470 && EQ (Vlast_command, Vself_insert_face_command)) | |
| 471 { | |
| 472 Lisp_Object before = make_int (BUF_PT (buf) - 1); | |
| 473 Lisp_Object after = make_int (BUF_PT (buf)); | |
| 474 Fput_text_property (before, after, Qface, Vself_insert_face, Qnil); | |
| 475 Fput_text_property (before, after, Qstart_open, Qt, Qnil); | |
| 476 Fput_text_property (before, after, Qend_open, Qnil, Qnil); | |
| 477 /* #### FSFmacs properties are normally closed ("sticky") on the | |
| 478 end but not the beginning. It's the opposite for us. */ | |
| 479 Vself_insert_face = Qnil; | |
| 480 } | |
| 481 synt = SYNTAX (syntax_table, c1); | |
| 482 if ((synt == Sclose || synt == Smath) | |
| 483 && !NILP (Vblink_paren_function) && INTERACTIVE | |
| 484 && !noautofill) | |
| 485 { | |
| 486 call0 (Vblink_paren_function); | |
| 487 /* hairy = 2; */ | |
| 488 } | |
| 489 | |
| 490 /* return hairy; */ | |
| 491 } | |
| 492 | |
| 493 /* (this comes from Mule but is a generally good idea) */ | |
| 494 | |
| 495 DEFUN ("self-insert-internal", Fself_insert_internal, 1, 1, 0, /* | |
| 444 | 496 Invoke `self-insert-command' as if CHARACTER is entered from keyboard. |
| 428 | 497 */ |
| 444 | 498 (character)) |
| 428 | 499 { |
| 500 /* This function can GC */ | |
| 444 | 501 CHECK_CHAR_COERCE_INT (character); |
| 502 internal_self_insert (XCHAR (character), 0); | |
| 428 | 503 return Qnil; |
| 504 } | |
| 505 | |
| 506 /* module initialization */ | |
| 507 | |
| 508 void | |
| 509 syms_of_cmds (void) | |
| 510 { | |
| 563 | 511 DEFSYMBOL (Qkill_forward_chars); |
| 512 DEFSYMBOL (Qself_insert_command); | |
| 513 DEFSYMBOL (Qoverwrite_mode_binary); | |
| 514 DEFSYMBOL (Qno_self_insert); | |
| 428 | 515 |
| 516 DEFSUBR (Fforward_char); | |
| 517 DEFSUBR (Fbackward_char); | |
| 518 DEFSUBR (Fforward_line); | |
| 519 DEFSUBR (Fbeginning_of_line); | |
| 520 DEFSUBR (Fend_of_line); | |
| 521 | |
| 522 DEFSUBR (Fpoint_at_bol); | |
| 523 DEFSUBR (Fpoint_at_eol); | |
| 524 | |
| 525 DEFSUBR (Fdelete_char); | |
| 526 DEFSUBR (Fdelete_backward_char); | |
| 527 | |
| 528 DEFSUBR (Fself_insert_command); | |
| 529 DEFSUBR (Fself_insert_internal); | |
| 530 } | |
| 531 | |
| 532 void | |
| 533 vars_of_cmds (void) | |
| 534 { | |
| 535 DEFVAR_LISP ("self-insert-face", &Vself_insert_face /* | |
| 536 If non-nil, set the face of the next self-inserting character to this. | |
| 537 See also `self-insert-face-command'. | |
| 538 */ ); | |
| 539 Vself_insert_face = Qnil; | |
| 540 | |
| 541 DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command /* | |
| 542 This is the command that set up `self-insert-face'. | |
| 543 If `last-command' does not equal this value, we ignore `self-insert-face'. | |
| 544 */ ); | |
| 545 Vself_insert_face_command = Qnil; | |
| 546 | |
| 547 DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function /* | |
| 548 Function called, if non-nil, whenever a close parenthesis is inserted. | |
| 549 More precisely, a char with closeparen syntax is self-inserted. | |
| 550 */ ); | |
| 551 Vblink_paren_function = Qnil; | |
| 442 | 552 |
| 553 DEFVAR_LISP ("auto-fill-chars", &Vauto_fill_chars /* | |
| 554 A char-table for characters which invoke auto-filling. | |
| 444 | 555 Such characters have value t in this table. |
| 442 | 556 */); |
| 557 Vauto_fill_chars = Fmake_char_table (Qgeneric); | |
| 558 XCHAR_TABLE (Vauto_fill_chars)->ascii[' '] = Qt; | |
| 559 XCHAR_TABLE (Vauto_fill_chars)->ascii['\n'] = Qt; | |
| 428 | 560 } |