|
|
1.1 ! root 1: /* Primitives for word-abbrev mode. ! 2: Copyright (C) 1985, 1986 Free Software Foundation, Inc. ! 3: ! 4: This file is part of GNU Emacs. ! 5: ! 6: GNU Emacs 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 1, or (at your option) ! 9: any later version. ! 10: ! 11: GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to ! 18: the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ ! 19: ! 20: ! 21: #include "config.h" ! 22: #include <stdio.h> ! 23: #undef NULL ! 24: #include "lisp.h" ! 25: #include "commands.h" ! 26: #include "buffer.h" ! 27: #include "window.h" ! 28: ! 29: /* An abbrev table is an obarray. ! 30: Each defined abbrev is represented by a symbol in that obarray ! 31: whose print name is the abbreviation. ! 32: The symbol's value is a string which is the expansion. ! 33: If its function definition is non-nil, it is called ! 34: after the expansion is done. ! 35: The plist slot of the abbrev symbol is its usage count. */ ! 36: ! 37: /* List of all abbrev-table name symbols: ! 38: symbols whose values are abbrev tables. */ ! 39: ! 40: Lisp_Object Vabbrev_table_name_list; ! 41: ! 42: /* The table of global abbrevs. These are in effect ! 43: in any buffer in which abbrev mode is turned on. */ ! 44: ! 45: Lisp_Object Vglobal_abbrev_table; ! 46: ! 47: /* The local abbrev table used by default (in Fundamental Mode buffers) */ ! 48: ! 49: Lisp_Object Vfundamental_mode_abbrev_table; ! 50: ! 51: /* Set nonzero when an abbrev definition is changed */ ! 52: ! 53: int abbrevs_changed; ! 54: ! 55: int abbrev_all_caps; ! 56: ! 57: /* Non-nil => use this location as the start of abbrev to expand ! 58: (rather than taking the word before point as the abbrev) */ ! 59: ! 60: Lisp_Object Vabbrev_start_location; ! 61: ! 62: /* Buffer that Vabbrev_start_location applies to */ ! 63: Lisp_Object Vabbrev_start_location_buffer; ! 64: ! 65: /* The symbol representing the abbrev most recently expanded */ ! 66: ! 67: Lisp_Object Vlast_abbrev; ! 68: ! 69: /* A string for the actual text of the abbrev most recently expanded. ! 70: This has more info than Vlast_abbrev since case is significant. */ ! 71: ! 72: Lisp_Object Vlast_abbrev_text; ! 73: ! 74: /* Character address of start of last abbrev expanded */ ! 75: ! 76: int last_abbrev_point; ! 77: ! 78: extern Lisp_Object oblookup (); ! 79: ! 80: DEFUN ("make-abbrev-table", Fmake_abbrev_table, Smake_abbrev_table, 0, 0, 0, ! 81: "Create a new, empty abbrev table object.") ! 82: () ! 83: { ! 84: return Fmake_vector (make_number (59), make_number (0)); ! 85: } ! 86: ! 87: DEFUN ("clear-abbrev-table", Fclear_abbrev_table, Sclear_abbrev_table, 1, 1, 0, ! 88: "Undefine all abbrevs in abbrev table TABLE, leaving it empty.") ! 89: (table) ! 90: Lisp_Object table; ! 91: { ! 92: int i, size; ! 93: ! 94: CHECK_VECTOR (table, 0); ! 95: size = XVECTOR (table)->size; ! 96: abbrevs_changed = 1; ! 97: for (i = 0; i < size; i++) ! 98: XVECTOR (table)->contents[i] = make_number (0); ! 99: return Qnil; ! 100: } ! 101: ! 102: DEFUN ("define-abbrev", Fdefine_abbrev, Sdefine_abbrev, 3, 5, 0, ! 103: "Define an abbrev in TABLE named NAME, to expand to EXPANSION or call HOOK.\n\ ! 104: NAME and EXPANSION are strings. HOOK is a function or nil.\n\ ! 105: To undefine an abbrev, define it with EXPANSION = nil") ! 106: (table, name, expansion, hook, count) ! 107: Lisp_Object table, name, expansion, hook, count; ! 108: { ! 109: Lisp_Object sym, oexp, ohook, tem; ! 110: CHECK_VECTOR (table, 0); ! 111: CHECK_STRING (name, 1); ! 112: if (! NULL (expansion)) ! 113: CHECK_STRING (expansion, 2); ! 114: if (NULL (count)) ! 115: count = make_number (0); ! 116: else ! 117: CHECK_NUMBER (count, 0); ! 118: ! 119: sym = Fintern (name, table); ! 120: ! 121: oexp = XSYMBOL (sym)->value; ! 122: ohook = XSYMBOL (sym)->function; ! 123: if (!((EQ (oexp, expansion) ! 124: || (XTYPE (oexp) == Lisp_String && XTYPE (expansion) == Lisp_String ! 125: && (tem = Fstring_equal (oexp, expansion), !NULL (tem)))) ! 126: && ! 127: (EQ (ohook, hook) ! 128: || (tem = Fequal (ohook, hook), !NULL (tem))))) ! 129: abbrevs_changed = 1; ! 130: ! 131: Fset (sym, expansion); ! 132: Ffset (sym, hook); ! 133: Fsetplist (sym, count); ! 134: ! 135: return name; ! 136: } ! 137: ! 138: DEFUN ("define-global-abbrev", Fdefine_global_abbrev, Sdefine_global_abbrev, 2, 2, ! 139: "sDefine global abbrev: \nsExpansion for %s: ", ! 140: "Define ABBREV as a global abbreviation for EXPANSION.") ! 141: (name, expansion) ! 142: Lisp_Object name, expansion; ! 143: { ! 144: Fdefine_abbrev (Vglobal_abbrev_table, Fdowncase (name), ! 145: expansion, Qnil, make_number (0)); ! 146: return name; ! 147: } ! 148: ! 149: DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev, Sdefine_mode_abbrev, 2, 2, ! 150: "sDefine mode abbrev: \nsExpansion for %s: ", ! 151: "Define ABBREV as a mode-specific abbreviation for EXPANSION.") ! 152: (name, expansion) ! 153: Lisp_Object name, expansion; ! 154: { ! 155: if (NULL (current_buffer->abbrev_table)) ! 156: error ("Major mode has no abbrev table"); ! 157: ! 158: Fdefine_abbrev (current_buffer->abbrev_table, Fdowncase (name), ! 159: expansion, Qnil, make_number (0)); ! 160: return name; ! 161: } ! 162: ! 163: DEFUN ("abbrev-symbol", Fabbrev_symbol, Sabbrev_symbol, 1, 2, 0, ! 164: "Return the symbol representing abbrev named ABBREV.\n\ ! 165: Value is nil if that abbrev is not defined.\n\ ! 166: Optional second arg TABLE is abbrev table to look it up in.\n\ ! 167: Default is try buffer's mode-specific abbrev table, then global table.") ! 168: (abbrev, table) ! 169: Lisp_Object abbrev, table; ! 170: { ! 171: Lisp_Object sym; ! 172: CHECK_STRING (abbrev, 0); ! 173: if (!NULL (table)) ! 174: sym = Fintern_soft (abbrev, table); ! 175: else ! 176: { ! 177: sym = Qnil; ! 178: if (!NULL (current_buffer->abbrev_table)) ! 179: sym = Fintern_soft (abbrev, current_buffer->abbrev_table); ! 180: if (NULL (XSYMBOL (sym)->value)) ! 181: sym = Qnil; ! 182: if (NULL (sym)) ! 183: sym = Fintern_soft (abbrev, Vglobal_abbrev_table); ! 184: } ! 185: if (NULL (XSYMBOL (sym)->value)) return Qnil; ! 186: return sym; ! 187: } ! 188: ! 189: DEFUN ("abbrev-expansion", Fabbrev_expansion, Sabbrev_expansion, 1, 2, 0, ! 190: "Return the string that ABBREV expands into in the current buffer.\n\ ! 191: Optionally specify an abbrev table; then ABBREV is looked up in that table only.") ! 192: (abbrev, table) ! 193: Lisp_Object abbrev, table; ! 194: { ! 195: Lisp_Object sym; ! 196: sym = Fabbrev_symbol (abbrev, table); ! 197: if (NULL (sym)) return sym; ! 198: return Fsymbol_value (sym); ! 199: } ! 200: ! 201: /* Expand the word before point, if it is an abbrev. ! 202: Returns 1 if an expansion is done. */ ! 203: ! 204: DEFUN ("expand-abbrev", Fexpand_abbrev, Sexpand_abbrev, 0, 0, "", ! 205: "Expand the abbrev before point, if it is an abbrev.\n\ ! 206: Effective when explicitly called even when abbrev-mode is not enabled.\n\ ! 207: Returns t if expansion took place.") ! 208: () ! 209: { ! 210: char buffer[200]; ! 211: register char *p = buffer; ! 212: register int wordstart, idx; ! 213: int uccount = 0, lccount = 0; ! 214: register Lisp_Object sym; ! 215: Lisp_Object expansion, hook, tem; ! 216: ! 217: if (XBUFFER (Vabbrev_start_location_buffer) != current_buffer) ! 218: Vabbrev_start_location = Qnil; ! 219: if (!NULL (Vabbrev_start_location)) ! 220: { ! 221: tem = Vabbrev_start_location; ! 222: CHECK_NUMBER_COERCE_MARKER (tem, 0); ! 223: wordstart = XINT (tem); ! 224: Vabbrev_start_location = Qnil; ! 225: if (FETCH_CHAR (wordstart) == '-') ! 226: del_range (wordstart, wordstart + 1); ! 227: } ! 228: else ! 229: wordstart = scan_words (point, -1); ! 230: ! 231: if (!wordstart || point - wordstart >= sizeof buffer || point <= wordstart) ! 232: return Qnil; ! 233: ! 234: for (idx = wordstart; idx < point; idx++) ! 235: { ! 236: register int c = FETCH_CHAR (idx); ! 237: if (UPPERCASEP (c)) ! 238: c = DOWNCASE (c), uccount++; ! 239: else if (! NOCASEP (c)) ! 240: lccount++; ! 241: *p++ = c; ! 242: } ! 243: ! 244: if (XTYPE (current_buffer->abbrev_table) == Lisp_Vector) ! 245: sym = oblookup (current_buffer->abbrev_table, buffer, p - buffer); ! 246: else ! 247: XFASTINT (sym) = 0; ! 248: if (XTYPE (sym) == Lisp_Int || ! 249: NULL (XSYMBOL (sym)->value)) ! 250: sym = oblookup (Vglobal_abbrev_table, buffer, p - buffer); ! 251: if (XTYPE (sym) == Lisp_Int || ! 252: NULL (XSYMBOL (sym)->value)) ! 253: return Qnil; ! 254: ! 255: if (FROM_KBD && !EQ (minibuf_window, selected_window)) ! 256: { ! 257: SET_PT (wordstart + p - buffer); ! 258: Fundo_boundary (); ! 259: } ! 260: SET_PT (wordstart); ! 261: Vlast_abbrev_text ! 262: = Fbuffer_substring (make_number (point), ! 263: make_number (point + (p - buffer))); ! 264: del_range (point, point + (p - buffer)); ! 265: ! 266: /* Now sym is the abbrev symbol. */ ! 267: Vlast_abbrev = sym; ! 268: last_abbrev_point = point; ! 269: ! 270: if (XTYPE (XSYMBOL (sym)->plist) == Lisp_Int) ! 271: XSETINT (XSYMBOL (sym)->plist, ! 272: XINT (XSYMBOL (sym)->plist) + 1); /* Increment use count */ ! 273: ! 274: expansion = XSYMBOL (sym)->value; ! 275: insert (XSTRING (expansion)->data, XSTRING (expansion)->size); ! 276: ! 277: if (uccount && !lccount) ! 278: { ! 279: /* Abbrev was all caps */ ! 280: /* If expansion is multiple words, normally capitalize each word */ ! 281: /* This used to be if (!... && ... >= ...) Fcapitalize; else Fupcase ! 282: but Megatest 68000 compiler can't handle that */ ! 283: if (!abbrev_all_caps) ! 284: if (scan_words (point, -1) > scan_words (wordstart, 1)) ! 285: { ! 286: upcase_initials_region (make_number (wordstart), ! 287: make_number (point)); ! 288: goto caped; ! 289: } ! 290: /* If expansion is one word, or if user says so, upcase it all. */ ! 291: Fupcase_region (make_number (wordstart), make_number (point)); ! 292: caped: ; ! 293: } ! 294: else if (uccount) ! 295: { ! 296: /* Abbrev included some caps. Cap first initial of expansion */ ! 297: int old_zv = ZV; ! 298: idx = point; ! 299: /* Don't let Fcapitalize_word operate on text after point. */ ! 300: ZV = point; ! 301: SET_PT (wordstart); ! 302: Fcapitalize_word (make_number (1)); ! 303: SET_PT (idx); ! 304: ZV = old_zv; ! 305: } ! 306: ! 307: hook = XSYMBOL (sym)->function; ! 308: if (!NULL (hook)) ! 309: call0 (hook); ! 310: ! 311: return Qt; ! 312: } ! 313: ! 314: DEFUN ("unexpand-abbrev", Funexpand_abbrev, Sunexpand_abbrev, 0, 0, "", ! 315: "Undo the expansion of the last abbrev that expanded.") ! 316: () ! 317: { ! 318: int opoint = point; ! 319: int adjust = 0; ! 320: if (last_abbrev_point < BEGV ! 321: || last_abbrev_point >= ZV) ! 322: return Qnil; ! 323: SET_PT (last_abbrev_point); ! 324: if (XTYPE (Vlast_abbrev_text) == Lisp_String) ! 325: { ! 326: /* This isn't correct if Vlast_abbrev->function was used ! 327: to do the expansion */ ! 328: Lisp_Object val; ! 329: XSET (val, Lisp_String, XSYMBOL (Vlast_abbrev)->value); ! 330: adjust = XSTRING (val)->size; ! 331: del_range (point, point + adjust); ! 332: insert (XSTRING (Vlast_abbrev_text)->data, ! 333: XSTRING (Vlast_abbrev_text)->size); ! 334: adjust -= XSTRING (Vlast_abbrev_text)->size; ! 335: Vlast_abbrev_text = Qnil; ! 336: } ! 337: SET_PT (last_abbrev_point < opoint ? opoint - adjust : opoint); ! 338: return Qnil; ! 339: } ! 340: ! 341: static ! 342: write_abbrev (sym, stream) ! 343: Lisp_Object sym, stream; ! 344: { ! 345: Lisp_Object name; ! 346: if (NULL (XSYMBOL (sym)->value)) ! 347: return; ! 348: insert (" (", 5); ! 349: XSET (name, Lisp_String, XSYMBOL (sym)->name); ! 350: Fprin1 (name, stream); ! 351: insert (" ", 1); ! 352: Fprin1 (XSYMBOL (sym)->value, stream); ! 353: insert (" ", 1); ! 354: Fprin1 (XSYMBOL (sym)->function, stream); ! 355: insert (" ", 1); ! 356: Fprin1 (XSYMBOL (sym)->plist, stream); ! 357: insert (")\n", 2); ! 358: } ! 359: ! 360: static ! 361: describe_abbrev (sym, stream) ! 362: Lisp_Object sym, stream; ! 363: { ! 364: Lisp_Object one; ! 365: ! 366: if (NULL (XSYMBOL (sym)->value)) ! 367: return; ! 368: one = make_number (1); ! 369: Fprin1 (Fsymbol_name (sym), stream); ! 370: Findent_to (make_number (15), one); ! 371: Fprin1 (XSYMBOL (sym)->plist, stream); ! 372: Findent_to (make_number (20), one); ! 373: Fprin1 (XSYMBOL (sym)->value, stream); ! 374: if (!NULL (XSYMBOL (sym)->function)) ! 375: { ! 376: Findent_to (make_number (45), one); ! 377: Fprin1 (XSYMBOL (sym)->function, stream); ! 378: } ! 379: Fterpri (stream); ! 380: } ! 381: ! 382: DEFUN ("insert-abbrev-table-description", ! 383: Finsert_abbrev_table_description, Sinsert_abbrev_table_description, ! 384: 2, 2, 0, ! 385: "Insert before point a description of abbrev table named NAME.\n\ ! 386: NAME is a symbol whose value is an abbrev table.\n\ ! 387: If 2nd arg READABLE is non-nil, a readable description is inserted.\n\ ! 388: Otherwise description is an expression,\n\ ! 389: a call to define-abbrev-table which would\n\ ! 390: define NAME exactly as it is currently defined.") ! 391: (name, readable) ! 392: Lisp_Object name, readable; ! 393: { ! 394: Lisp_Object table; ! 395: Lisp_Object stream; ! 396: ! 397: CHECK_SYMBOL (name, 0); ! 398: table = Fsymbol_value (name); ! 399: CHECK_VECTOR (table, 0); ! 400: ! 401: XSET (stream, Lisp_Buffer, current_buffer); ! 402: ! 403: if (!NULL (readable)) ! 404: { ! 405: InsStr ("("); ! 406: Fprin1 (name, stream); ! 407: InsStr (")\n\n"); ! 408: map_obarray (table, describe_abbrev, stream); ! 409: InsStr ("\n\n"); ! 410: } ! 411: else ! 412: { ! 413: InsStr ("(define-abbrev-table '"); ! 414: Fprin1 (name, stream); ! 415: InsStr (" '(\n"); ! 416: map_obarray (table, write_abbrev, stream); ! 417: InsStr (" ))\n\n"); ! 418: } ! 419: ! 420: return Qnil; ! 421: } ! 422: ! 423: DEFUN ("define-abbrev-table", Fdefine_abbrev_table, Sdefine_abbrev_table, ! 424: 2, 2, 0, ! 425: "Define TABNAME (a symbol) as an abbrev table name.\n\ ! 426: Define abbrevs in it according to DEFINITIONS, a list of elements\n\ ! 427: of the form (ABBREVNAME EXPANSION HOOK USECOUNT).") ! 428: (tabname, defns) ! 429: Lisp_Object tabname, defns; ! 430: { ! 431: Lisp_Object name, exp, hook, count; ! 432: Lisp_Object table, elt; ! 433: ! 434: CHECK_SYMBOL (tabname, 0); ! 435: table = Fboundp (tabname); ! 436: if (NULL (table) || (table = Fsymbol_value (tabname), NULL (table))) ! 437: { ! 438: table = Fmake_abbrev_table (); ! 439: Fset (tabname, table); ! 440: Vabbrev_table_name_list = ! 441: Fcons (tabname, Vabbrev_table_name_list); ! 442: } ! 443: CHECK_VECTOR (table, 0); ! 444: ! 445: for (;!NULL (defns); defns = Fcdr (defns)) ! 446: { ! 447: elt = Fcar (defns); ! 448: name = Fcar (elt); ! 449: elt = Fcdr (elt); ! 450: exp = Fcar (elt); ! 451: elt = Fcdr (elt); ! 452: hook = Fcar (elt); ! 453: elt = Fcdr (elt); ! 454: count = Fcar (elt); ! 455: Fdefine_abbrev (table, name, exp, hook, count); ! 456: } ! 457: return Qnil; ! 458: } ! 459: ! 460: syms_of_abbrev () ! 461: { ! 462: DEFVAR_LISP ("abbrev-table-name-list", &Vabbrev_table_name_list, ! 463: "List of symbols whose values are abbrev tables."); ! 464: Vabbrev_table_name_list = Fcons (intern ("fundamental-mode-abbrev-table"), ! 465: Fcons (intern ("global-abbrev-table"), ! 466: Qnil)); ! 467: ! 468: DEFVAR_LISP ("global-abbrev-table", &Vglobal_abbrev_table, ! 469: "The abbrev table whose abbrevs affect all buffers.\n\ ! 470: Each buffer may also have a local abbrev table.\n\ ! 471: If it does, the local table overrides the global one\n\ ! 472: for any particular abbrev defined in both."); ! 473: Vglobal_abbrev_table = Fmake_abbrev_table (); ! 474: ! 475: DEFVAR_LISP ("fundamental-mode-abbrev-table", &Vfundamental_mode_abbrev_table, ! 476: "The abbrev table of mode-specific abbrevs for Fundamental Mode."); ! 477: Vfundamental_mode_abbrev_table = Fmake_abbrev_table (); ! 478: current_buffer->abbrev_table = Vfundamental_mode_abbrev_table; ! 479: ! 480: DEFVAR_LISP ("last-abbrev", &Vlast_abbrev, ! 481: "The abbrev-symbol of the last abbrev expanded."); ! 482: ! 483: DEFVAR_LISP ("last-abbrev-text", &Vlast_abbrev_text, ! 484: "The exact text of the last abbrev expanded.\n\ ! 485: nil if the abbrev has already been unexpanded."); ! 486: ! 487: DEFVAR_INT ("last-abbrev-location", &last_abbrev_point, ! 488: "The location of the last abbrev expanded."); ! 489: ! 490: Vlast_abbrev = Qnil; ! 491: Vlast_abbrev_text = Qnil; ! 492: last_abbrev_point = 0; ! 493: ! 494: DEFVAR_LISP ("abbrev-start-location", &Vabbrev_start_location, ! 495: "Buffer position for expand-abbrev to use as the start of the abbrev.\n\ ! 496: nil means use the word before point as the abbrev.\n\ ! 497: Set to nil each time expand-abbrev is called."); ! 498: Vabbrev_start_location = Qnil; ! 499: ! 500: DEFVAR_LISP ("abbrev-start-location-buffer", &Vabbrev_start_location_buffer, ! 501: "Buffer that abbrev-start-location has been set for.\n\ ! 502: Trying to expand an abbrev in any other buffer clears abbrev-start-location."); ! 503: Vabbrev_start_location_buffer = Qnil; ! 504: ! 505: DEFVAR_PER_BUFFER ("local-abbrev-table", ¤t_buffer->abbrev_table, ! 506: "Local (mode-specific) abbrev table of current buffer."); ! 507: ! 508: DEFVAR_BOOL ("abbrevs-changed", &abbrevs_changed, ! 509: "Set non-nil by defining or altering any word abbrevs."); ! 510: abbrevs_changed = 0; ! 511: ! 512: DEFVAR_BOOL ("abbrev-all-caps", &abbrev_all_caps, ! 513: "*Set non-nil means expand multi-word abbrevs all caps if abbrev was so."); ! 514: abbrev_all_caps = 0; ! 515: ! 516: defsubr (&Smake_abbrev_table); ! 517: defsubr (&Sclear_abbrev_table); ! 518: defsubr (&Sdefine_abbrev); ! 519: defsubr (&Sdefine_global_abbrev); ! 520: defsubr (&Sdefine_mode_abbrev); ! 521: defsubr (&Sabbrev_expansion); ! 522: defsubr (&Sabbrev_symbol); ! 523: defsubr (&Sexpand_abbrev); ! 524: defsubr (&Sunexpand_abbrev); ! 525: defsubr (&Sinsert_abbrev_table_description); ! 526: defsubr (&Sdefine_abbrev_table); ! 527: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.