4.3BSD - /usr/src/new/emacs/src/keymap.c

   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: }

Defined functions

Defined variables