![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to keymap.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / src|
Return to keymap.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / src |
1.1 ! root 1: /* Manipulation of keymaps ! 2: Copyright (C) 1985 Richard M. Stallman. ! 3: ! 4: This file is part of GNU Emacs. ! 5: ! 6: GNU Emacs is distributed in the hope that it will be useful, ! 7: but WITHOUT ANY WARRANTY. No author or distributor ! 8: accepts responsibility to anyone for the consequences of using it ! 9: or for whether it serves any particular purpose or works at all, ! 10: unless he says so in writing. Refer to the GNU Emacs General Public ! 11: License for full details. ! 12: ! 13: Everyone is granted permission to copy, modify and redistribute ! 14: GNU Emacs, but only under the conditions described in the ! 15: GNU Emacs General Public License. A copy of this license is ! 16: supposed to have been given to you along with GNU Emacs so you ! 17: can know your rights and responsibilities. It should be in a ! 18: file named COPYING. Among other things, the copyright notice ! 19: and this notice must be preserved on all copies. */ ! 20: ! 21: ! 22: #include "config.h" ! 23: #include <stdio.h> ! 24: #undef NULL ! 25: #include "lisp.h" ! 26: #include "commands.h" ! 27: #include "buffer.h" ! 28: ! 29: /* Actually allocate storage for these variables */ ! 30: ! 31: #ifdef HAVE_X_WINDOWS ! 32: struct Lisp_Vector *MouseMap; /* Keymap for mouse commands */ ! 33: #endif /* HAVE_X_WINDOWS */ ! 34: ! 35: struct Lisp_Vector *CurrentGlobalMap; /* Current global keymap */ ! 36: ! 37: struct Lisp_Vector *GlobalMap; /* default global key bindings */ ! 38: ! 39: struct Lisp_Vector *ESCmap; /* The keymap used for globally ! 40: bound ESC-prefixed default ! 41: commands */ ! 42: ! 43: struct Lisp_Vector *CtlXmap; /* The keymap used for globally ! 44: bound C-x-prefixed default ! 45: commands */ ! 46: ! 47: /* was MinibufLocalMap */ ! 48: Lisp_Object Vminibuffer_local_map; ! 49: /* The keymap used by the minibuf for local ! 50: bindings when spaces are allowed in the ! 51: minibuf */ ! 52: ! 53: /* was MinibufLocalNSMap */ ! 54: Lisp_Object Vminibuffer_local_ns_map; ! 55: /* The keymap used by the minibuf for local ! 56: bindings when spaces are not encouraged ! 57: in the minibuf */ ! 58: ! 59: /* keymap used for minibuffers when doing completion */ ! 60: /* was MinibufLocalCompletionMap */ ! 61: Lisp_Object Vminibuffer_local_completion_map; ! 62: ! 63: /* keymap used for minibuffers when doing completion and require a match */ ! 64: /* was MinibufLocalMustMatchMap */ ! 65: Lisp_Object Vminibuffer_local_must_match_map; ! 66: ! 67: Lisp_Object Qkeymapp, Qkeymap; ! 68: ! 69: DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 0, 0, ! 70: "Construct and return a new keymap, a vector of length 128.\n\ ! 71: All entries in it are nil, meaning \"command undefined\".") ! 72: () ! 73: { ! 74: Lisp_Object val; ! 75: XFASTINT (val) = 0200; ! 76: return Fmake_vector (val, Qnil); ! 77: } ! 78: ! 79: DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 0, 0, ! 80: "Construct and return a new sparse-keymap list.\n\ ! 81: Its car is 'keymap and its cdr is an alist of (CHAR . DEFINITION).\n\ ! 82: Initially the alist is nil.") ! 83: () ! 84: { ! 85: return Fcons (Qkeymap, Qnil); ! 86: } ! 87: ! 88: /* This is used for installing the standard key bindings at initialization time. ! 89: For example, defkey (CtlXmap, Ctl('X'), "exchange-point-and-mark"); */ ! 90: ! 91: void ! 92: defkey (keymap, key, defname) ! 93: struct Lisp_Vector *keymap; ! 94: int key; ! 95: char *defname; ! 96: { ! 97: keymap->contents[key] = intern (defname); ! 98: } ! 99: ! 100: void ! 101: ndefkey (keymap, key, defname) ! 102: Lisp_Object keymap; ! 103: int key; ! 104: char *defname; ! 105: { ! 106: store_in_keymap (keymap, key, intern (defname)); ! 107: } ! 108: ! 109: /* Define character fromchar in map frommap as an alias for character tochar in map tomap. ! 110: Subsequent redefinitions of the latter WILL affect the former. */ ! 111: ! 112: #ifdef NOTDEF ! 113: void ! 114: synkey (frommap, fromchar, tomap, tochar) ! 115: struct Lisp_Vector *frommap, *tomap; ! 116: int fromchar, tochar; ! 117: { ! 118: Lisp_Object v, c; ! 119: XSET (v, Lisp_Vector, tomap); ! 120: XFASTINT (c) = tochar; ! 121: frommap->contents[fromchar] = Fcons (v, c); ! 122: } ! 123: #endif /* NOTDEF */ ! 124: ! 125: DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0, ! 126: "Return t if ARG is a keymap.\n\ ! 127: A keymap is a vector of length 128, or a list (keymap . ALIST),\n\ ! 128: where alist elements look like (CHAR . DEFN).") ! 129: (object) ! 130: Lisp_Object object; ! 131: { ! 132: Lisp_Object tem; ! 133: tem = object; ! 134: while (XTYPE (tem) == Lisp_Symbol) ! 135: { ! 136: tem = XSYMBOL (tem)->function; ! 137: if (EQ (tem, Qunbound)) ! 138: return Qnil; ! 139: } ! 140: ! 141: if ((XTYPE (tem) == Lisp_Vector && XVECTOR (tem)->size == 0200) ! 142: || (LISTP (tem) && EQ (XCONS (tem)->car, Qkeymap))) ! 143: return Qt; ! 144: return Qnil; ! 145: } ! 146: ! 147: Lisp_Object ! 148: get_keymap (object, argnumber) ! 149: Lisp_Object object; ! 150: int argnumber; ! 151: { ! 152: Lisp_Object tem; ! 153: ! 154: while (1) ! 155: { ! 156: tem = object; ! 157: while (XTYPE (tem) == Lisp_Symbol && !EQ (tem, Qunbound)) ! 158: tem = XSYMBOL (tem)->function; ! 159: ! 160: if ((XTYPE (tem) == Lisp_Vector && XVECTOR (tem)->size == 0200) ! 161: || (LISTP (tem) && EQ (XCONS (tem)->car, Qkeymap))) ! 162: return tem; ! 163: if (argnumber >= 0) ! 164: object = wrong_type_argument (Qkeymapp, object); ! 165: else return Qnil; ! 166: } ! 167: } ! 168: ! 169: Lisp_Object ! 170: get_keyelt (object) ! 171: Lisp_Object object; ! 172: { ! 173: Lisp_Object map, tem; ! 174: ! 175: while (map = get_keymap (Fcar_safe (object), -1), ! 176: tem = Fkeymapp (map), ! 177: !NULL (tem)) ! 178: /*(XTYPE (object) == Lisp_Cons && !EQ (XCONS (object)->car, Qkeymap))*/ ! 179: { ! 180: object = Fcdr (object); ! 181: if (LISTP (map)) ! 182: object = Fcdr (Fassq (object, Fcdr (map))); ! 183: else ! 184: object = Faref (map, object); ! 185: } ! 186: return object; ! 187: } ! 188: ! 189: Lisp_Object ! 190: access_keymap (map, idx) ! 191: Lisp_Object map; ! 192: register int idx; ! 193: { ! 194: register Lisp_Object val; ! 195: if (idx < 0 || idx >= 0200) ! 196: error ("Command key out of range 0-127"); ! 197: ! 198: /* Get definition for character `idx' proper. */ ! 199: if (LISTP (map)) ! 200: val = Fcdr (Fassq (make_number (idx), Fcdr (map))); ! 201: else ! 202: val = XVECTOR (map)->contents[idx]; ! 203: ! 204: /* If nothing there, and `idx' is upper case, ! 205: look under corresponding lower case character. */ ! 206: ! 207: if (NULL (val) && idx >= 'A' && idx <= 'Z') ! 208: { ! 209: if (LISTP (map)) ! 210: val = Fcdr (Fassq (make_number (idx + 'a' - 'A'), Fcdr (map))); ! 211: else ! 212: val = XVECTOR (map)->contents[idx + 'a' - 'A']; ! 213: } ! 214: return val; ! 215: } ! 216: ! 217: Lisp_Object ! 218: store_in_keymap (keymap, idx, def) ! 219: Lisp_Object keymap; ! 220: int idx; ! 221: Lisp_Object def; ! 222: { ! 223: Lisp_Object tem; ! 224: ! 225: if (idx < 0 || idx >= 0200) ! 226: error ("Command key out of range 0-127"); ! 227: ! 228: if (LISTP (keymap)) ! 229: { ! 230: tem = Fassq (make_number (idx), Fcdr (keymap)); ! 231: if (!NULL (tem)) ! 232: Fsetcdr (tem, def); ! 233: else ! 234: Fsetcdr (keymap, Fcons (Fcons (make_number (idx), def), ! 235: Fcdr (keymap))); ! 236: } ! 237: else ! 238: XVECTOR (keymap)->contents[idx] = def; ! 239: ! 240: return def; ! 241: } ! 242: ! 243: DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0, ! 244: "Args KEYMAP, KEYS, DEF. Define key sequence KEYS, in KEYMAP, as DEF.\n\ ! 245: KEYMAP is a keymap. KEYS is a string meaning a sequence of keystrokes.\n\ ! 246: DEF is usually a symbol with a function definition, suitable for use as a command.") ! 247: (keymap, keys, def) ! 248: Lisp_Object keymap; ! 249: Lisp_Object keys; ! 250: Lisp_Object def; ! 251: { ! 252: unsigned char *p; ! 253: int level; ! 254: Lisp_Object tem; ! 255: Lisp_Object cmd; ! 256: ! 257: keymap = get_keymap (keymap, 0); ! 258: ! 259: CHECK_STRING (keys, 1); ! 260: p = XSTRING (keys)->data; ! 261: level = XSTRING (keys)->size; ! 262: ! 263: while (1) ! 264: { ! 265: level--; ! 266: ! 267: if (!level) ! 268: return store_in_keymap (keymap, *p, def); ! 269: ! 270: cmd = get_keyelt (access_keymap (keymap, *p)); ! 271: if (NULL (cmd)) ! 272: { ! 273: cmd = Fmake_sparse_keymap (); ! 274: store_in_keymap (keymap, *p, cmd); ! 275: } ! 276: tem = Fkeymapp (cmd); ! 277: if (NULL (tem)) ! 278: error ("Key sequence %s uses invalid prefix characters", ! 279: XSTRING (keys)->data); ! 280: ! 281: keymap = get_keymap (cmd, 0); ! 282: p++; ! 283: } ! 284: } ! 285: ! 286: /* Value is T if `keys' is too long; NIL if valid but has no definition. */ ! 287: ! 288: DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 2, 0, ! 289: "In keymap KEYMAP, look up key sequence KEYS. Return the definition.\n\ ! 290: nil means undefined.\n\ ! 291: Number as value means KEYS is \"too long\";\n\ ! 292: that is, characters in it except for the last one\n\ ! 293: fail to be a valid sequence of prefix characters in KEYMAP.\n\ ! 294: The number is how many characters at the front of KEYS\n\ ! 295: it takes to reach a non-prefix command.") ! 296: (keymap, keys) ! 297: Lisp_Object keymap; ! 298: Lisp_Object keys; ! 299: { ! 300: unsigned char *p; ! 301: int level; ! 302: Lisp_Object tem; ! 303: Lisp_Object cmd; ! 304: ! 305: keymap = get_keymap (keymap, 0); ! 306: ! 307: CHECK_STRING (keys, 1); ! 308: p = XSTRING (keys)->data; ! 309: level = XSTRING (keys)->size; ! 310: ! 311: while (1) ! 312: { ! 313: level--; ! 314: cmd = get_keyelt (access_keymap (keymap, *p++)); ! 315: if (!level) ! 316: return cmd; ! 317: ! 318: tem = Fkeymapp (cmd); ! 319: if (NULL (tem)) ! 320: return make_number (XSTRING (keys)->size - level); ! 321: ! 322: keymap = get_keymap (cmd, 0); ! 323: } ! 324: } ! 325: ! 326: DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 1, 0, ! 327: "Return the definition for command KEYS in current keymaps.\n\ ! 328: KEYS is a string, a sequence of keystrokes.\n\ ! 329: The definition is probably a symbol with a function definition.") ! 330: (keys) ! 331: Lisp_Object keys; ! 332: { ! 333: Lisp_Object map, value, value1; ! 334: map = bf_cur->keymap; ! 335: if (!NULL (map)) ! 336: { ! 337: value = Flookup_key (map, keys); ! 338: if (NULL (value)) ! 339: { ! 340: XSET (map, Lisp_Vector, CurrentGlobalMap); ! 341: value1 = Flookup_key (map, keys); ! 342: if (XTYPE (value1) == Lisp_Int) ! 343: return Qnil; ! 344: return value1; ! 345: } ! 346: else if (XTYPE (value) != Lisp_Int) ! 347: return value; ! 348: } ! 349: XSET (map, Lisp_Vector, CurrentGlobalMap); ! 350: return Flookup_key (map, keys); ! 351: } ! 352: ! 353: DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 1, 0, ! 354: "Return the definition for command KEYS in current local keymap only.\n\ ! 355: KEYS is a string, a sequence of keystrokes.\n\ ! 356: The definition is probably a symbol with a function definition.") ! 357: (keys) ! 358: Lisp_Object keys; ! 359: { ! 360: Lisp_Object map; ! 361: map = bf_cur->keymap; ! 362: if (NULL (map)) ! 363: return Qnil; ! 364: return Flookup_key (map, keys); ! 365: } ! 366: ! 367: DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 1, 0, ! 368: "Return the definition for command KEYS in current global keymap only.\n\ ! 369: KEYS is a string, a sequence of keystrokes.\n\ ! 370: The definition is probably a symbol with a function definition.") ! 371: (keys) ! 372: Lisp_Object keys; ! 373: { ! 374: Lisp_Object map; ! 375: XSET (map, Lisp_Vector, CurrentGlobalMap); ! 376: return Flookup_key (map, keys); ! 377: } ! 378: ! 379: DEFUN ("global-set-key", Fglobal_set_key, Sglobal_set_key, 2, 2, ! 380: "kSet key globally: \nCSet key %s to command: ", ! 381: "Give KEY a definition of COMMAND.\n\ ! 382: COMMAND is a symbol naming an interactively-callable function.\n\ ! 383: KEY is a string representing a sequence of keystrokes.\n\ ! 384: Note that if KEY has a local definition in the current buffer\n\ ! 385: that local definition will continue to shadow any global definition.") ! 386: (keys, function) ! 387: Lisp_Object keys, function; ! 388: { ! 389: Lisp_Object map; ! 390: XSET (map, Lisp_Vector, CurrentGlobalMap); ! 391: CHECK_STRING (keys, 1); ! 392: Fdefine_key (map, keys, function); ! 393: return Qnil; ! 394: } ! 395: ! 396: DEFUN ("local-set-key", Flocal_set_key, Slocal_set_key, 2, 2, ! 397: "kSet key locally: \nCSet key %s locally to command: ", ! 398: "Give KEY a local definition of COMMAND.\n\ ! 399: COMMAND is a symbol naming an interactively-callable function.\n\ ! 400: KEY is a string representing a sequence of keystrokes.\n\ ! 401: The definition goes in the current buffer's local map,\n\ ! 402: which is shared with other buffers in the same major mode.") ! 403: (keys, function) ! 404: Lisp_Object keys, function; ! 405: { ! 406: Lisp_Object map; ! 407: map = bf_cur->keymap; ! 408: if (NULL (map)) ! 409: { ! 410: map = Fmake_sparse_keymap (); ! 411: bf_cur->keymap = map; ! 412: } ! 413: ! 414: CHECK_STRING (keys, 1); ! 415: Fdefine_key (map, keys, function); ! 416: return Qnil; ! 417: } ! 418: ! 419: DEFUN ("global-unset-key", Fglobal_unset_key, Sglobal_unset_key, ! 420: 1, 1, "kUnset key globally: ", ! 421: "Remove global definition of KEY.\n\ ! 422: KEY is a string representing a sequence of keystrokes.") ! 423: (keys) ! 424: Lisp_Object keys; ! 425: { ! 426: return Fglobal_set_key (keys, Qnil); ! 427: } ! 428: ! 429: DEFUN ("local-unset-key", Flocal_unset_key, Slocal_unset_key, 1, 1, ! 430: "kUnset key locally: ", ! 431: "Remove local definition of KEY.\n\ ! 432: KEY is a string representing a sequence of keystrokes.") ! 433: (keys) ! 434: Lisp_Object keys; ! 435: { ! 436: if (!NULL (bf_cur->keymap)) ! 437: Flocal_set_key (keys, Qnil); ! 438: return Qnil; ! 439: } ! 440: ! 441: DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 1, 0, ! 442: "Define SYMBOL as a prefix command.\n\ ! 443: A keymap is created and stored as SYMBOL's function definition.") ! 444: (name) ! 445: Lisp_Object name; ! 446: { ! 447: Fset (name, Fmake_keymap ()); ! 448: return name; ! 449: } ! 450: ! 451: DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0, ! 452: "Selects KEYMAP as the global keymap.") ! 453: (keymap) ! 454: Lisp_Object keymap; ! 455: { ! 456: keymap = get_keymap (keymap, 0); ! 457: CHECK_VECTOR (keymap, 0); ! 458: CurrentGlobalMap = XVECTOR (keymap); ! 459: return Qnil; ! 460: } ! 461: ! 462: DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0, ! 463: "Selects KEYMAP as the local keymap.\n\ ! 464: nil for KEYMAP means no local keymap.") ! 465: (keymap) ! 466: Lisp_Object keymap; ! 467: { ! 468: if (!NULL (keymap)) ! 469: keymap = get_keymap (keymap, 0); ! 470: ! 471: bf_cur->keymap = keymap; ! 472: ! 473: return Qnil; ! 474: } ! 475: ! 476: DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0, ! 477: "Return current buffer's local keymap, or nil if it has none.") ! 478: () ! 479: { ! 480: return bf_cur->keymap; ! 481: } ! 482: ! 483: DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps, ! 484: 1, 1, 0, ! 485: "Find all keymaps accessible via prefix characters from KEYMAP.\n\ ! 486: Returns a list of elements of the form (KEYS . MAP), where the sequence\n\ ! 487: KEYS starting from KEYMAP gets you to MAP. These elements are ordered\n\ ! 488: so that the KEYS increase in length. The first element is (\"\" . KEYMAP).") ! 489: (startmap) ! 490: Lisp_Object startmap; ! 491: { ! 492: Lisp_Object maps, tail; ! 493: Lisp_Object thismap, thisseq; ! 494: Lisp_Object dummy; ! 495: Lisp_Object tem; ! 496: Lisp_Object cmd; ! 497: int i; ! 498: ! 499: maps = Fcons (Fcons (build_string (""), get_keymap (startmap, 0)), Qnil); ! 500: tail = maps; ! 501: ! 502: /* For each map in the list maps, ! 503: look at any other maps it points to ! 504: and stick them at the end if they are not already in the list */ ! 505: ! 506: while (!NULL (tail)) ! 507: { ! 508: thisseq = Fcar (Fcar (tail)); ! 509: thismap = Fcdr (Fcar (tail)); ! 510: for (i = 0; i < 0200; i++) ! 511: { ! 512: cmd = get_keyelt (access_keymap (thismap, i)); ! 513: if (NULL (cmd)) continue; ! 514: tem = Fkeymapp (cmd); ! 515: if (!NULL (tem)) ! 516: { ! 517: cmd = get_keymap (cmd, 0); ! 518: tem = Frassq (cmd, maps); ! 519: if (NULL (tem)) { ! 520: XFASTINT (dummy) = i; ! 521: dummy = concat2 (thisseq, Fchar_to_string (dummy)); ! 522: nconc2 (tail, Fcons (Fcons (dummy, cmd), Qnil)); ! 523: } ! 524: } ! 525: } ! 526: tail = Fcdr (tail); ! 527: } ! 528: ! 529: return maps; ! 530: } ! 531: ! 532: Lisp_Object Qsingle_key_description, Qkey_description; ! 533: ! 534: DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0, ! 535: "Return a pretty description of key-sequence KEYS.\n\ ! 536: Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\ ! 537: spaces are put between sequence elements, etc.") ! 538: (keys) ! 539: Lisp_Object keys; ! 540: { ! 541: return Fmapconcat (Qsingle_key_description, keys, build_string (" ")); ! 542: } ! 543: ! 544: char * ! 545: push_key_description (c, p) ! 546: register unsigned int c; ! 547: register char *p; ! 548: { ! 549: if (c >= 0200) ! 550: { ! 551: *p++ = 'M'; ! 552: *p++ = '-'; ! 553: c -= 0200; ! 554: } ! 555: if (c < 040) ! 556: { ! 557: if (c == 033) ! 558: { ! 559: *p++ = 'E'; ! 560: *p++ = 'S'; ! 561: *p++ = 'C'; ! 562: } ! 563: else if (c == Ctl('I')) ! 564: { ! 565: *p++ = 'T'; ! 566: *p++ = 'A'; ! 567: *p++ = 'B'; ! 568: } ! 569: else if (c == Ctl('J')) ! 570: { ! 571: *p++ = 'L'; ! 572: *p++ = 'F'; ! 573: *p++ = 'D'; ! 574: } ! 575: else if (c == Ctl('M')) ! 576: { ! 577: *p++ = 'R'; ! 578: *p++ = 'E'; ! 579: *p++ = 'T'; ! 580: } ! 581: else ! 582: { ! 583: *p++ = 'C'; ! 584: *p++ = '-'; ! 585: if (c > 0 && c <= Ctl ('Z')) ! 586: *p++ = c + 0140; ! 587: else ! 588: *p++ = c + 0100; ! 589: } ! 590: } ! 591: else if (c == 0177) ! 592: { ! 593: *p++ = 'D'; ! 594: *p++ = 'E'; ! 595: *p++ = 'L'; ! 596: } ! 597: else if (c == ' ') ! 598: { ! 599: *p++ = 'S'; ! 600: *p++ = 'P'; ! 601: *p++ = 'C'; ! 602: } ! 603: else ! 604: *p++ = c; ! 605: return p; ! 606: } ! 607: ! 608: DEFUN ("single-key-description", Fsingle_key_description, Ssingle_key_description, 1, 1, 0, ! 609: "Return a pretty description of command character KEY.\n\ ! 610: Control characters turn into C-whatever, etc.") ! 611: (key) ! 612: Lisp_Object key; ! 613: { ! 614: unsigned char c; ! 615: char tem[6]; ! 616: ! 617: CHECK_NUMBER (key, 0); ! 618: c = XINT (key) & 0377; ! 619: ! 620: *push_key_description (c, tem) = 0; ! 621: ! 622: return build_string (tem); ! 623: } ! 624: ! 625: char * ! 626: push_text_char_description (c, p) ! 627: register unsigned int c; ! 628: register char *p; ! 629: { ! 630: if (c >= 0200) ! 631: { ! 632: *p++ = 'M'; ! 633: *p++ = '-'; ! 634: c -= 0200; ! 635: } ! 636: if (c < 040) ! 637: { ! 638: *p++ = '^'; ! 639: *p++ = c + 64; /* 'A' - 1 */ ! 640: } ! 641: else if (c == 0177) ! 642: { ! 643: *p++ = '^'; ! 644: *p++ = '?'; ! 645: } ! 646: else ! 647: *p++ = c; ! 648: return p; ! 649: } ! 650: ! 651: DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0, ! 652: "Return a pretty description of file-character CHAR.\n\ ! 653: Control characters turn into \"C-char\", etc.") ! 654: (chr) ! 655: Lisp_Object chr; ! 656: { ! 657: char tem[6]; ! 658: ! 659: CHECK_NUMBER (chr, 0); ! 660: ! 661: *push_text_char_description (XINT (chr) & 0377, tem) = 0; ! 662: ! 663: return build_string (tem); ! 664: } ! 665: ! 666: Lisp_Object where_is_in_buffer (); ! 667: ! 668: DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 1, 0, ! 669: "Return list of key sequences that currently invoke command DEFINITION.") ! 670: (definition) ! 671: Lisp_Object definition; ! 672: { ! 673: return where_is_in_buffer (definition, bf_cur, 0); ! 674: } ! 675: ! 676: Lisp_Object ! 677: where_is_in_buffer (definition, buf, firstonly) ! 678: Lisp_Object definition; ! 679: struct buffer *buf; ! 680: int firstonly; /* if true, return after finding one */ ! 681: { ! 682: Lisp_Object start1, start2; ! 683: Lisp_Object maps; ! 684: Lisp_Object this, map; ! 685: Lisp_Object dummy; ! 686: Lisp_Object found; ! 687: Lisp_Object tem; ! 688: register int i; ! 689: ! 690: XSET (start1, Lisp_Vector, CurrentGlobalMap); ! 691: start2 = buf->keymap; ! 692: ! 693: if (!NULL (start2)) ! 694: maps = nconc2 (Faccessible_keymaps (start2), ! 695: Faccessible_keymaps (start1)); ! 696: else ! 697: maps = Faccessible_keymaps (start1); ! 698: ! 699: found = Qnil; ! 700: ! 701: for (; !NULL (maps); maps = Fcdr (maps)) ! 702: { ! 703: this = Fcar (Fcar (maps)); /* Key sequence to reach map */ ! 704: map = Fcdr (Fcar (maps)); /* The map that it reaches */ ! 705: if (LISTP (map)) ! 706: for (map = Fcdr (map); !NULL (map); map = Fcdr (map)) ! 707: { ! 708: QUIT; ! 709: tem = Fcdr (Fcar (map)); ! 710: if (EQ (tem, definition)) ! 711: { ! 712: dummy = Fcar (Fcar (map)); ! 713: dummy = concat2 (this, Fchar_to_string (dummy)); ! 714: if (firstonly) ! 715: return dummy; ! 716: found = Fcons (dummy, found); ! 717: } ! 718: } ! 719: else ! 720: for (i = 0; i < 0200; i++) /* Search that map for a match */ ! 721: { ! 722: QUIT; ! 723: tem = XVECTOR (map)->contents[i]; ! 724: if (EQ (tem, definition)) /* Match found: record key sequence */ ! 725: { ! 726: XFASTINT (dummy) = i; /* which is `this' followed by character i */ ! 727: dummy = concat2 (this, Fchar_to_string (dummy)); ! 728: if (firstonly) ! 729: return dummy; ! 730: found = Fcons (dummy, found); ! 731: } ! 732: } ! 733: } ! 734: return Fnreverse (found); ! 735: } ! 736: ! 737: DEFUN ("where-is", Fwhere_is, Swhere_is, 1, 1, "CWhere is command: ", ! 738: "Print message listing key sequences that invoke specified command.\n\ ! 739: Argument is a command definition, usually a symbol with a function definition.") ! 740: (definition) ! 741: Lisp_Object definition; ! 742: { ! 743: Lisp_Object tem; ! 744: CHECK_SYMBOL (definition, 0); ! 745: tem = Fmapconcat (Qkey_description, Fwhere_is_internal (definition), build_string (", ")); ! 746: if (XSTRING (tem)->size) ! 747: message ("%s is on %s", XSYMBOL (definition)->name->data, XSTRING (tem)->data); ! 748: else ! 749: message ("%s is not on any keys", XSYMBOL (definition)->name->data); ! 750: return Qnil; ! 751: } ! 752: ! 753: Lisp_Object describe_buffer_bindings (); ! 754: ! 755: DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 0, "", ! 756: "Show a list of all defined keys, and their definitions.\n\ ! 757: The list is put in a buffer, which is displayed.") ! 758: () ! 759: { ! 760: Lisp_Object thisbuf; ! 761: XSETTYPE (thisbuf, Lisp_Buffer), XSETBUFFER (thisbuf, bf_cur); ! 762: internal_with_output_to_temp_buffer ("*Help*", describe_buffer_bindings, thisbuf); ! 763: return Qnil; ! 764: } ! 765: ! 766: Lisp_Object ! 767: describe_buffer_bindings (descbuf) ! 768: Lisp_Object descbuf; ! 769: { ! 770: register Lisp_Object start1; ! 771: char *heading = "key binding\n--- -------\n"; ! 772: ! 773: Fset_buffer (Vstandard_output); ! 774: ! 775: start1 = XBUFFER (descbuf)->keymap; ! 776: if (!NULL (start1)) ! 777: { ! 778: InsStr ("Local Bindings:\n"); ! 779: InsStr (heading); ! 780: heading = 0; ! 781: describe_map_tree (start1, 0); ! 782: InsStr ("\n"); ! 783: } ! 784: ! 785: InsStr ("Global Bindings:\n"); ! 786: if (heading) ! 787: InsStr (heading); ! 788: ! 789: XSET (start1, Lisp_Vector, CurrentGlobalMap); ! 790: describe_map_tree (start1, 0); ! 791: ! 792: Fset_buffer (descbuf); ! 793: return Qnil; ! 794: } ! 795: ! 796: /* Insert a desription of the key bindings in STARTMAP, ! 797: followed by those of all maps reachable through STARTMAP. ! 798: If PARTIAL is nonzero, omit certain "uninteresting" commands ! 799: (such as `undefined'). */ ! 800: ! 801: describe_map_tree (startmap, partial) ! 802: Lisp_Object startmap; ! 803: int partial; ! 804: { ! 805: register Lisp_Object maps, elt; ! 806: ! 807: maps = Faccessible_keymaps (startmap); ! 808: ! 809: for (; !NULL (maps); maps = Fcdr (maps)) ! 810: { ! 811: elt = Fcar (maps); ! 812: describe_map (Fcdr (elt), Fcar (elt), partial); ! 813: } ! 814: } ! 815: ! 816: describe_command (definition) ! 817: Lisp_Object definition; ! 818: { ! 819: register Lisp_Object tem1; ! 820: ! 821: if (XTYPE (definition) == Lisp_Symbol) ! 822: { ! 823: XSETSTRING (tem1, XSYMBOL (definition)->name); ! 824: InsCStr (XSTRING (tem1)->data, XSTRING (tem1)->size); ! 825: } ! 826: else ! 827: { ! 828: tem1 = Fkeymapp (definition); ! 829: if (!NULL (tem1)) ! 830: InsStr ("Prefix Command"); ! 831: else ! 832: InsStr ("??"); ! 833: } ! 834: } ! 835: ! 836: /* Describe the contents of map MAP, assuming that this map ! 837: itself is reached by the sequence of prefix keys KEYS (a string). ! 838: PARTIAL is the same as in `describe_map_tree', above. */ ! 839: ! 840: describe_map (map, keys, partial) ! 841: Lisp_Object map, keys; ! 842: int partial; ! 843: { ! 844: register Lisp_Object keysdesc; ! 845: ! 846: InsStr ("\n"); ! 847: ! 848: if (!NULL (keys) && XSTRING (keys)->size > 0) ! 849: keysdesc = Fkey_description (keys); ! 850: else ! 851: keysdesc = Qnil; ! 852: ! 853: if (LISTP (map)) ! 854: describe_alist (Fcdr (map), keysdesc, describe_command, partial); ! 855: else ! 856: describe_vector (map, keysdesc, describe_command, partial); ! 857: } ! 858: ! 859: describe_alist (alist, elt_prefix, elt_describer, partial) ! 860: register Lisp_Object alist; ! 861: register Lisp_Object elt_prefix; ! 862: int (*elt_describer) (); ! 863: int partial; ! 864: { ! 865: Lisp_Object this; ! 866: register Lisp_Object tem1, tem2; ! 867: int indent; ! 868: Lisp_Object suppress; ! 869: ! 870: if (partial) ! 871: suppress = intern ("suppress-keymap"); ! 872: ! 873: for (; LISTP (alist); alist = Fcdr (alist)) ! 874: { ! 875: QUIT; ! 876: tem1 = Fcar (Fcar (alist)); ! 877: tem2 = Fcdr (Fcar (alist)); ! 878: if (NULL (tem2)) continue; ! 879: if (XTYPE (tem2) == Lisp_Symbol && partial) ! 880: { ! 881: this = Fget (tem2, suppress); ! 882: if (!NULL (this)) ! 883: continue; ! 884: } ! 885: ! 886: indent = 0; ! 887: ! 888: if (!NULL (elt_prefix)) ! 889: { ! 890: InsCStr (XSTRING (elt_prefix)->data, XSTRING (elt_prefix)->size); ! 891: InsCStr (" ", 1); ! 892: indent += XSTRING (elt_prefix)->size + 1; ! 893: } ! 894: ! 895: this = Fsingle_key_description (tem1); ! 896: InsCStr (XSTRING (this)->data, XSTRING (this)->size); ! 897: indent += XSTRING (this)->size; ! 898: ! 899: InsCStr (" ", indent<16 ? 16-indent : 1); ! 900: ! 901: (*elt_describer) (tem2); ! 902: InsCStr ("\n", 1); ! 903: } ! 904: } ! 905: ! 906: describe_vector (vector, elt_prefix, elt_describer, partial) ! 907: register Lisp_Object vector; ! 908: register Lisp_Object elt_prefix; ! 909: int (*elt_describer) (); ! 910: int partial; ! 911: { ! 912: Lisp_Object this; ! 913: Lisp_Object dummy; ! 914: Lisp_Object tem1, tem2; ! 915: register int i, size = XVECTOR (vector)->size; ! 916: int indent; ! 917: Lisp_Object suppress; ! 918: ! 919: if (partial) ! 920: suppress = intern ("suppress-keymap"); ! 921: ! 922: for (i = 0; i < size; i++) ! 923: { ! 924: QUIT; ! 925: tem1 = XVECTOR (vector)->contents[i]; ! 926: if (NULL (tem1)) continue; ! 927: if (XTYPE (tem1) == Lisp_Symbol && partial) ! 928: { ! 929: this = Fget (tem1, suppress); ! 930: if (!NULL (this)) ! 931: continue; ! 932: } ! 933: ! 934: indent = 0; ! 935: ! 936: if (!NULL (elt_prefix)) ! 937: { ! 938: InsCStr (XSTRING (elt_prefix)->data, XSTRING (elt_prefix)->size); ! 939: InsCStr (" ", 1); ! 940: indent += XSTRING (elt_prefix)->size + 1; ! 941: } ! 942: XFASTINT (dummy) = i; ! 943: this = Fsingle_key_description (dummy); ! 944: InsCStr (XSTRING (this)->data, XSTRING (this)->size); ! 945: indent += XSTRING (this)->size; ! 946: ! 947: while (i + 1 < size && (tem2 = XVECTOR (vector)->contents[i+1], EQ(tem2, tem1))) ! 948: i++; ! 949: ! 950: if (i != XINT (dummy)) ! 951: { ! 952: InsCStr (" .. ", 4); ! 953: indent += 4; ! 954: if (!NULL (elt_prefix)) ! 955: { ! 956: InsCStr (XSTRING (elt_prefix)->data, XSTRING (elt_prefix)->size); ! 957: InsCStr (" ", 1); ! 958: indent += XSTRING (elt_prefix)->size + 1; ! 959: } ! 960: XFASTINT (dummy) = i; ! 961: this = Fsingle_key_description (dummy); ! 962: InsCStr (XSTRING (this)->data, XSTRING (this)->size); ! 963: indent += XSTRING (this)->size; ! 964: } ! 965: ! 966: InsCStr (" ", indent<16 ? 16-indent : 1); ! 967: ! 968: tem1 = XVECTOR (vector)->contents[i]; ! 969: (*elt_describer) (tem1); ! 970: InsCStr ("\n", 1); ! 971: } ! 972: } ! 973: ! 974: /* Apropos */ ! 975: Lisp_Object apropos_predicate; ! 976: Lisp_Object apropos_accumulate; ! 977: ! 978: static ! 979: apropos_accum (symbol, string) ! 980: Lisp_Object symbol, string; ! 981: { ! 982: register Lisp_Object tem; ! 983: ! 984: tem = Fstring_match (string, Fsymbol_name (symbol), Qnil); ! 985: if (!NULL (tem) && !NULL (apropos_predicate)) ! 986: tem = call1 (apropos_predicate, symbol); ! 987: if (!NULL (tem)) ! 988: apropos_accumulate = Fcons (symbol, apropos_accumulate); ! 989: } ! 990: ! 991: static Lisp_Object ! 992: apropos1 (list) ! 993: register Lisp_Object list; ! 994: { ! 995: struct buffer *old = bf_cur; ! 996: register Lisp_Object symbol, col, tem; ! 997: ! 998: while (!NULL (list)) ! 999: { ! 1000: QUIT; ! 1001: ! 1002: symbol = Fcar (list); ! 1003: list = Fcdr (list); ! 1004: ! 1005: tem = where_is_in_buffer (symbol, bf_cur, 0); ! 1006: tem = Fmapconcat (Qkey_description, tem, build_string (", ")); ! 1007: XFASTINT (col) = 30; ! 1008: ! 1009: SetBfp (XBUFFER (Vstandard_output)); ! 1010: Fprin1 (symbol, Qnil); ! 1011: Findent_to (col, Qnil); ! 1012: Fprinc (tem, Qnil); ! 1013: Fterpri (Qnil); ! 1014: tem = Ffboundp (symbol); ! 1015: if (!NULL (tem)) ! 1016: tem = Fdocumentation (symbol); ! 1017: if (XTYPE (tem) == Lisp_String) ! 1018: insert_first_line (" Function: ", tem); ! 1019: tem = Fget (symbol, Qvariable_documentation); ! 1020: if (XTYPE (tem) == Lisp_String) ! 1021: insert_first_line (" Variable: ", tem); ! 1022: SetBfp (old); ! 1023: } ! 1024: return Qnil; ! 1025: } ! 1026: ! 1027: static ! 1028: insert_first_line (prefix, str) ! 1029: char *prefix; ! 1030: Lisp_Object str; ! 1031: { ! 1032: extern char *index (); ! 1033: register unsigned char *p; ! 1034: register unsigned char *p1; ! 1035: register unsigned char *p2; ! 1036: ! 1037: InsStr (prefix); ! 1038: ! 1039: retry: ! 1040: p = XSTRING (str)->data; ! 1041: p1 = (unsigned char *) index (p, '\n'); ! 1042: ! 1043: for (p2 = p; *p2 && p2 != p1; p2++) ! 1044: if (p2[0] == '\\' && p2[1] == '[') ! 1045: { ! 1046: str = Fsubstitute_command_keys (str); ! 1047: goto retry; ! 1048: } ! 1049: ! 1050: InsCStr (p, p1 ? p1 - p : strlen (p)); ! 1051: InsCStr ("\n", 1); ! 1052: } ! 1053: ! 1054: DEFUN ("apropos", Fapropos, Sapropos, 1, 3, "sApropos: ", ! 1055: "Show all symbols whose names contain match for REGEXP.\n\ ! 1056: If optional arg PRED is non-nil, (funcall PRED SYM) is done\n\ ! 1057: for each symbol and a symbol is mentioned if that returns non-nil.\n\ ! 1058: Returns list of symbols found; if third arg NOPRINT is non-nil,\n\ ! 1059: does not display them, just returns the list.") ! 1060: (string, pred, noprint) ! 1061: Lisp_Object string, pred, noprint; ! 1062: { ! 1063: struct gcpro gcpro1, gcpro2; ! 1064: CHECK_STRING (string, 0); ! 1065: apropos_predicate = pred; ! 1066: GCPRO2 (apropos_predicate, apropos_accumulate); ! 1067: apropos_accumulate = Qnil; ! 1068: map_obarray (Vobarray, apropos_accum, string); ! 1069: apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp); ! 1070: if (NULL (noprint)) ! 1071: internal_with_output_to_temp_buffer ("*Help*", apropos1, ! 1072: apropos_accumulate); ! 1073: UNGCPRO; ! 1074: return apropos_accumulate; ! 1075: } ! 1076: ! 1077: DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command, ! 1078: 1, 1, "P", ! 1079: "Read function name, then read its arguments and call it.") ! 1080: (prefixarg) ! 1081: Lisp_Object prefixarg; ! 1082: { ! 1083: Lisp_Object function; ! 1084: char buf[40]; ! 1085: ! 1086: buf[0] = 0; ! 1087: ! 1088: if (EQ (prefixarg, Qminus)) ! 1089: strcpy (buf, "- "); ! 1090: else if (LISTP (prefixarg) && XINT (XCONS (prefixarg)->car) == 4) ! 1091: strcpy (buf, "C-u "); ! 1092: else if (LISTP (prefixarg) && XTYPE (XCONS (prefixarg)->car) == Lisp_Int) ! 1093: sprintf (buf, "%d ", XINT (XCONS (prefixarg)->car)); ! 1094: else if (XTYPE (prefixarg) == Lisp_Int) ! 1095: sprintf (buf, "%d ", XINT (prefixarg)); ! 1096: ! 1097: strcat (buf, "M-x "); ! 1098: ! 1099: function = Fcompleting_read (build_string (buf), Vobarray, Qcommandp, Qt, Qnil); ! 1100: ! 1101: Vprefix_arg = prefixarg; ! 1102: return Fcommand_execute (Fintern (function, Vobarray), Qt); ! 1103: } ! 1104: ! 1105: syms_of_keymap () ! 1106: { ! 1107: Lisp_Object tem; ! 1108: ! 1109: Qkeymap = intern ("keymap"); ! 1110: staticpro (&Qkeymap); ! 1111: ! 1112: /* Initialize the keymaps standardly used. ! 1113: Each one is the value of a Lisp variable, and is also ! 1114: pointed to by a C variable */ ! 1115: ! 1116: #ifdef HAVE_X_WINDOWS ! 1117: tem = Fmake_keymap (); ! 1118: MouseMap = XVECTOR (tem); ! 1119: Fset (intern ("mouse-map"), tem); ! 1120: #endif /* HAVE_X_WINDOWS */ ! 1121: ! 1122: tem = Fmake_keymap (); ! 1123: GlobalMap = XVECTOR (tem); ! 1124: Fset (intern ("global-map"), tem); ! 1125: ! 1126: tem = Fmake_keymap (); ! 1127: ESCmap = XVECTOR (tem); ! 1128: Fset (intern ("esc-map"), tem); ! 1129: Ffset (intern ("ESC-prefix"), tem); ! 1130: ! 1131: tem = Fmake_keymap (); ! 1132: CtlXmap = XVECTOR (tem); ! 1133: Fset (intern ("ctl-x-map"), tem); ! 1134: Ffset (intern ("Control-X-prefix"), tem); ! 1135: ! 1136: DefLispVar ("minibuffer-local-map", &Vminibuffer_local_map, ! 1137: "Default keymap to use when reading from the minibuffer."); ! 1138: Vminibuffer_local_map = Fmake_sparse_keymap (); ! 1139: ! 1140: DefLispVar ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map, ! 1141: "The keymap used by the minibuf for local bindings when spaces are not\n\ ! 1142: to be allowed in input string."); ! 1143: Vminibuffer_local_ns_map = Fmake_sparse_keymap (); ! 1144: ! 1145: DefLispVar ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map, ! 1146: "Keymap to use when reading from the minibuffer with completion."); ! 1147: Vminibuffer_local_completion_map = Fmake_sparse_keymap (); ! 1148: ! 1149: DefLispVar ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map, ! 1150: "Keymap to use when reading from the minibuffer with completion and\n\ ! 1151: an exact match of one of the completions is required."); ! 1152: Vminibuffer_local_must_match_map = Fmake_sparse_keymap (); ! 1153: ! 1154: CurrentGlobalMap = GlobalMap; ! 1155: ! 1156: Qsingle_key_description = intern ("single-key-description"); ! 1157: staticpro (&Qsingle_key_description); ! 1158: ! 1159: Qkey_description = intern ("key-description"); ! 1160: staticpro (&Qkey_description); ! 1161: ! 1162: Qkeymapp = intern ("keymapp"); ! 1163: staticpro (&Qkeymapp); ! 1164: ! 1165: defsubr (&Skeymapp); ! 1166: defsubr (&Smake_keymap); ! 1167: defsubr (&Smake_sparse_keymap); ! 1168: defsubr (&Skey_binding); ! 1169: defsubr (&Slocal_key_binding); ! 1170: defsubr (&Sglobal_key_binding); ! 1171: defsubr (&Sglobal_set_key); ! 1172: defsubr (&Slocal_set_key); ! 1173: defsubr (&Sdefine_key); ! 1174: defsubr (&Slookup_key); ! 1175: defsubr (&Sglobal_unset_key); ! 1176: defsubr (&Slocal_unset_key); ! 1177: defsubr (&Suse_global_map); ! 1178: defsubr (&Suse_local_map); ! 1179: defsubr (&Scurrent_local_map); ! 1180: defsubr (&Saccessible_keymaps); ! 1181: defsubr (&Skey_description); ! 1182: defsubr (&Ssingle_key_description); ! 1183: defsubr (&Stext_char_description); ! 1184: defsubr (&Swhere_is_internal); ! 1185: defsubr (&Swhere_is); ! 1186: defsubr (&Sdescribe_bindings); ! 1187: defsubr (&Sapropos); ! 1188: defsubr (&Sexecute_extended_command); ! 1189: } ! 1190: ! 1191: keys_of_keymap () ! 1192: { ! 1193: defkey (GlobalMap, 033, "ESC-prefix"); ! 1194: defkey (GlobalMap, Ctl('X'), "Control-X-prefix"); ! 1195: defkey (ESCmap, 'x', "execute-extended-command"); ! 1196: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.