src/.gdbinit

   1 # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, 2001,
   2 #   2002, 2003, 2004, 2005, 2006, 2007  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 2, 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 the
  18 # Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  19 # Boston, MA 02110-1301, USA.
  20
  21 # Force loading of symbols, enough to give us gdb_valbits etc.
  22 set main
  23
  24 # Find lwlib source files too.
  25 dir ../lwlib
  26 #dir /gd/gnu/lesstif-0.89.9/lib/Xm
  27
  28 # Don't enter GDB when user types C-g to quit.
  29 # This has one unfortunate effect: you can't type C-c
  30 # at the GDB to stop Emacs, when using X.
  31 # However, C-z works just as well in that case.
  32 handle 2 noprint pass
  33
  34 # Make it work like SIGINT normally does.
  35 handle SIGTSTP nopass
  36
  37 # Pass on user signals
  38 handle SIGUSR1 noprint pass
  39 handle SIGUSR2 noprint pass
  40
  41 # Don't pass SIGALRM to Emacs.  This makes problems when
  42 # debugging.
  43 handle SIGALRM ignore
  44
  45 # $valmask and $tagmask are mask values set up by the xreload macro below.
  46
  47 # Use $bugfix so that the value isn't a constant.
  48 # Using a constant runs into GDB bugs sometimes.
  49 define xgetptr
  50   set $bugfix = $arg0
  51   set $ptr = (gdb_use_union ? $bugfix.u.val : $bugfix & $valmask) | gdb_data_seg_bits
  52 end
  53
  54 define xgetint
  55   set $bugfix = $arg0
  56   set $int = gdb_use_union ? $bugfix.s.val : (gdb_use_lsb ? $bugfix : $bugfix << gdb_gctypebits) >> gdb_gctypebits
  57 end
  58
  59 define xgettype
  60   set $bugfix = $arg0
  61   set $type = gdb_use_union ? $bugfix.s.type : (enum Lisp_Type) (gdb_use_lsb ? $bugfix & $tagmask : $bugfix >> gdb_valbits)
  62 end
  63
  64 # Set up something to print out s-expressions.
  65 # We save and restore print_output_debug_flag to prevent the w32 port
  66 # from calling OutputDebugString, which causes GDB to display each
  67 # character twice (yuk!).
  68 define pr
  69   set $output_debug = print_output_debug_flag
  70   set print_output_debug_flag = 0
  71   set debug_print ($)
  72   set print_output_debug_flag = $output_debug
  73 end
  74 document pr
  75 Print the emacs s-expression which is $.
  76 Works only when an inferior emacs is executing.
  77 end
  78
  79 # Print out s-expressions
  80 define pp
  81   set $tmp = $arg0
  82   set $output_debug = print_output_debug_flag
  83   set print_output_debug_flag = 0
  84   set safe_debug_print ($tmp)
  85   set print_output_debug_flag = $output_debug
  86 end
  87 document pp
  88 Print the argument as an emacs s-expression
  89 Works only when an inferior emacs is executing.
  90 end
  91
  92 # Print out s-expressions from tool bar
  93 define pp1
  94   set $tmp = $arg0
  95   set $output_debug = print_output_debug_flag
  96   set print_output_debug_flag = 0
  97   set safe_debug_print ($tmp)
  98   set print_output_debug_flag = $output_debug
  99 end
 100 document pp1
 101 Print the argument as an emacs s-expression.
 102 Works only when an inferior emacs is executing.
 103 For use on tool bar when debugging in Emacs
 104 where the variable name would not otherwise
 105 be recorded in the GUD buffer.
 106 end
 107
 108 # Print value of lisp variable
 109 define pv
 110   set $tmp = "$arg0"
 111   set $output_debug = print_output_debug_flag
 112   set print_output_debug_flag = 0
 113   set safe_debug_print ( find_symbol_value (intern ($tmp)))
 114   set print_output_debug_flag = $output_debug
 115 end
 116 document pv
 117 Print the value of the lisp variable given as argument.
 118 Works only when an inferior emacs is executing.
 119 end
 120
 121 # Print value of lisp variable
 122 define pv1
 123   set $tmp = "$arg0"
 124   set $output_debug = print_output_debug_flag
 125   set print_output_debug_flag = 0
 126   set safe_debug_print (find_symbol_value (intern ($tmp)))
 127   set print_output_debug_flag = $output_debug
 128 end
 129 document pv1
 130 Print the value of the lisp variable given as argument.
 131 Works only when an inferior emacs is executing.
 132 For use when debugging in Emacs where the variable
 133 name would not otherwise be recorded in the GUD buffer.
 134 end
 135
 136 # Print out current buffer point and boundaries
 137 define ppt
 138   set $b = current_buffer
 139   set $t = $b->text
 140   printf "BUF PT: %d", $b->pt
 141   if ($b->pt != $b->pt_byte)
 142     printf "[%d]", $b->pt_byte
 143   end
 144   printf " of 1..%d", $t->z
 145   if ($t->z != $t->z_byte)
 146     printf "[%d]", $t->z_byte
 147   end
 148   if ($b->begv != 1 || $b->zv != $t->z)
 149     printf " NARROW=%d..%d", $b->begv, $b->zv
 150     if ($b->begv != $b->begv_byte || $b->zv != $b->zv_byte)
 151       printf " [%d..%d]", $b->begv_byte, $b->zv_byte
 152     end
 153   end
 154   printf " GAP: %d", $t->gpt
 155   if ($t->gpt != $t->gpt_byte)
 156     printf "[%d]", $t->gpt_byte
 157   end
 158   printf " SZ=%d\n", $t->gap_size
 159 end
 160 document ppt
 161 Print current buffer's point and boundaries.
 162 Prints values of point, beg, end, narrow, and gap for current buffer.
 163 end
 164
 165 # Print out iterator given as first arg
 166 define pitx
 167   set $it = $arg0
 168   printf "cur=%d", $it->current.pos.charpos
 169   if ($it->current.pos.charpos != $it->current.pos.bytepos)
 170     printf "[%d]", $it->current.pos.bytepos
 171   end
 172   printf " pos=%d", $it->position.charpos
 173   if ($it->position.charpos != $it->position.bytepos)
 174     printf "[%d]", $it->position.bytepos
 175   end
 176   printf " start=%d", $it->start.pos.charpos
 177   if ($it->start.pos.charpos != $it->start.pos.bytepos)
 178     printf "[%d]", $it->start.pos.bytepos
 179   end
 180   printf " end=%d", $it->end_charpos
 181   printf " stop=%d", $it->stop_charpos
 182   printf " face=%d", $it->face_id
 183   if ($it->multibyte_p)
 184     printf " MB"
 185   end
 186   if ($it->header_line_p)
 187     printf " HL"
 188   end
 189   if ($it->n_overlay_strings > 0)
 190     printf " nov=%d", $it->n_overlay_strings
 191   end
 192   if ($it->sp != 0)
 193     printf " sp=%d", $it->sp
 194   end
 195   if ($it->what == IT_CHARACTER)
 196     if ($it->len == 1 && $it->c >= ' ' && it->c < 255)
 197       printf " ch='%c'", $it->c
 198     else
 199       printf " ch=[%d,%d]", $it->c, $it->len
 200     end
 201   else
 202     printf " "
 203     output $it->what
 204   end
 205   if ($it->method != GET_FROM_BUFFER)
 206     printf " next="
 207     output $it->method
 208     if ($it->method == GET_FROM_STRING)
 209       printf "[%d]", $it->current.string_pos.charpos
 210     end
 211     if ($it->method == GET_FROM_IMAGE)
 212       printf "[%d]", $it->image_id
 213     end
 214     if ($it->method == GET_FROM_COMPOSITION)
 215       printf "[%d,%d,%d]", $it->cmp_id, $it->len, $it->cmp_len
 216     end
 217   end
 218   printf "\n"
 219   if ($it->region_beg_charpos >= 0)
 220     printf "reg=%d-%d ", $it->region_beg_charpos, $it->region_end_charpos
 221   end
 222   printf "vpos=%d hpos=%d", $it->vpos, $it->hpos,
 223   printf " y=%d lvy=%d", $it->current_y, $it->last_visible_y
 224   printf " x=%d vx=%d-%d", $it->current_x, $it->first_visible_x, $it->last_visible_x
 225   printf " w=%d", $it->pixel_width
 226   printf " a+d=%d+%d=%d", $it->ascent, $it->descent, $it->ascent+$it->descent
 227   printf " max=%d+%d=%d", $it->max_ascent, $it->max_descent, $it->max_ascent+$it->max_descent
 228   printf "\n"
 229   set $i = 0
 230   while ($i < $it->sp && $i < 4)
 231     set $e = $it->stack[$i]
 232     printf "stack[%d]: ", $i
 233     output $e->method
 234     printf "[%d]", $e->position.charpos
 235     printf "\n"
 236     set $i = $i + 1
 237   end
 238 end
 239 document pitx
 240 Pretty print a display iterator.
 241 Take one arg, an iterator object or pointer.
 242 end
 243
 244 define pit
 245   pitx it
 246 end
 247 document pit
 248 Pretty print the display iterator it.
 249 end
 250
 251 define prowx
 252   set $row = $arg0
 253   printf "y=%d x=%d pwid=%d", $row->y, $row->x, $row->pixel_width
 254   printf " a+d=%d+%d=%d", $row->ascent, $row->height-$row->ascent, $row->height
 255   printf " phys=%d+%d=%d", $row->phys_ascent, $row->phys_height-$row->phys_ascent, $row->phys_height
 256   printf " vis=%d", $row->visible_height
 257   printf "  L=%d T=%d R=%d", $row->used[0], $row->used[1], $row->used[2]
 258   printf "\n"
 259   printf "start=%d end=%d", $row->start.pos.charpos, $row->end.pos.charpos
 260   if ($row->enabled_p)
 261     printf " ENA"
 262   end
 263   if ($row->displays_text_p)
 264     printf " DISP"
 265   end
 266   if ($row->mode_line_p)
 267     printf " MODEL"
 268   end
 269   if ($row->continued_p)
 270     printf " CONT"
 271   end
 272   if ($row-> truncated_on_left_p)
 273     printf " TRUNC:L"
 274   end
 275   if ($row-> truncated_on_right_p)
 276     printf " TRUNC:R"
 277   end
 278   if ($row->starts_in_middle_of_char_p)
 279     printf " STARTMID"
 280   end
 281   if ($row->ends_in_middle_of_char_p)
 282     printf " ENDMID"
 283   end
 284   if ($row->ends_in_newline_from_string_p)
 285     printf " ENDNLFS"
 286   end
 287   if ($row->ends_at_zv_p)
 288     printf " ENDZV"
 289   end
 290   if ($row->overlapped_p)
 291     printf " OLAPD"
 292   end
 293   if ($row->overlapping_p)
 294     printf " OLAPNG"
 295   end
 296   printf "\n"
 297 end
 298 document prowx
 299 Pretty print information about glyph_row.
 300 Takes one argument, a row object or pointer.
 301 end
 302
 303 define prow
 304   prowx row
 305 end
 306 document prow
 307 Pretty print information about glyph_row in row.
 308 end
 309
 310
 311 define pcursorx
 312   set $cp = $arg0
 313   printf "y=%d x=%d vpos=%d hpos=%d", $cp->y, $cp->x, $cp->vpos, $cp->hpos
 314 end
 315 document pcursorx
 316 Pretty print a window cursor.
 317 end
 318
 319 define pcursor
 320   printf "output: "
 321   pcursorx output_cursor
 322   printf "\n"
 323 end
 324 document pcursor
 325 Pretty print the output_cursor.
 326 end
 327
 328 define pwinx
 329   set $w = $arg0
 330   xgetint $w->sequence_number
 331   if ($w->mini_p != Qnil)
 332     printf "Mini "
 333   end
 334   printf "Window %d ", $int
 335   xgetptr $w->buffer
 336   set $tem = (struct buffer *) $ptr
 337   xgetptr $tem->name
 338   printf "%s", ((struct Lisp_String *) $ptr)->data
 339   printf "\n"
 340   xgetptr $w->start
 341   set $tem = (struct Lisp_Marker *) $ptr
 342   printf "start=%d end:", $tem->charpos
 343   if ($w->window_end_valid != Qnil)
 344     xgetint $w->window_end_pos
 345     printf "pos=%d", $int
 346     xgetint $w->window_end_vpos
 347     printf " vpos=%d", $int
 348   else
 349     printf "invalid"
 350   end
 351   printf " vscroll=%d", $w->vscroll
 352   if ($w->force_start != Qnil)
 353     printf " FORCE_START"
 354   end
 355   if ($w->must_be_updated_p)
 356     printf " MUST_UPD"
 357   end
 358   printf "\n"
 359   printf "cursor: "
 360   pcursorx $w->cursor
 361   printf "  phys: "
 362   pcursorx $w->phys_cursor
 363   if ($w->phys_cursor_on_p)
 364     printf " ON"
 365   else
 366     printf " OFF"
 367   end
 368   printf " blk="
 369   if ($w->last_cursor_off_p != $w->cursor_off_p)
 370     if ($w->last_cursor_off_p)
 371       printf "ON->"
 372     else
 373       printf "OFF->"
 374     end
 375   end
 376   if ($w->cursor_off_p)
 377     printf "ON"
 378   else
 379     printf "OFF"
 380   end
 381   printf "\n"
 382 end
 383 document pwinx
 384 Pretty print a window structure.
 385 Takes one argument, a pointer to a window structure.
 386 end
 387
 388 define pwin
 389   pwinx w
 390 end
 391 document pwin
 392 Pretty print window structure w.
 393 end
 394
 395 define pgx
 396   set $g = $arg0
 397   if ($g->type == CHAR_GLYPH)
 398     if ($g->u.ch >= ' ' && $g->u.ch < 127)
 399       printf "CHAR[%c]", $g->u.ch
 400     else
 401       printf "CHAR[0x%x]", $g->u.ch
 402     end
 403   end
 404   if ($g->type == COMPOSITE_GLYPH)
 405     printf "COMP[%d]", $g->u.cmp_id
 406   end
 407   if ($g->type == IMAGE_GLYPH)
 408     printf "IMAGE[%d]", $g->u.img_id
 409   end
 410   if ($g->type == STRETCH_GLYPH)
 411     printf "STRETCH[%d+%d]", $g->u.stretch.height, $g->u.stretch.ascent
 412   end
 413   xgettype ($g->object)
 414   if ($type == Lisp_String)
 415     printf " str=%x[%d]", $g->object, $g->charpos
 416   else
 417     printf " pos=%d", $g->charpos
 418   end
 419   printf " w=%d a+d=%d+%d", $g->pixel_width, $g->ascent, $g->descent
 420   if ($g->face_id != DEFAULT_FACE_ID)
 421     printf " face=%d", $g->face_id
 422   end
 423   if ($g->voffset)
 424     printf " vof=%d", $g->voffset
 425   end
 426   if ($g->multibyte_p)
 427     printf " MB"
 428   end
 429   if ($g->padding_p)
 430     printf " PAD"
 431   end
 432   if ($g->glyph_not_available_p)
 433     printf " N/A"
 434   end
 435   if ($g->overlaps_vertically_p)
 436     printf " OVL"
 437   end
 438   if ($g->left_box_line_p)
 439     printf " ["
 440   end
 441   if ($g->right_box_line_p)
 442     printf " ]"
 443   end
 444   if ($g->slice.x || $g->slice.y || $g->slice.width || $g->slice.height)
 445     printf " slice=%d,%d,%d,%d" ,$g->slice.x, $g->slice.y, $g->slice.width, $g->slice.height
 446   end
 447   printf "\n"
 448 end
 449 document pgx
 450 Pretty print a glyph structure.
 451 Takes one argument, a pointer to a glyph structure.
 452 end
 453
 454 define pg
 455   set $pgidx = 0
 456   pgx glyph
 457 end
 458 document pg
 459 Pretty print glyph structure glyph.
 460 end
 461
 462 define pgi
 463   set $pgidx = $arg0
 464   pgx (&glyph[$pgidx])
 465 end
 466 document pgi
 467 Pretty print glyph structure glyph[I].
 468 Takes one argument, a integer I.
 469 end
 470
 471 define pgn
 472   set $pgidx = $pgidx + 1
 473   pgx (&glyph[$pgidx])
 474 end
 475 document pgn
 476 Pretty print next glyph structure.
 477 end
 478
 479 define pgrowx
 480   set $row = $arg0
 481   set $area = 0
 482   set $xofs = $row->x
 483   while ($area < 3)
 484     set $used = $row->used[$area]
 485     if ($used > 0)
 486       set $gl0 = $row->glyphs[$area]
 487       set $pgidx = 0
 488       printf "%s: %d glyphs\n", ($area == 0 ? "LEFT" : $area == 2 ? "RIGHT" : "TEXT"), $used
 489       while ($pgidx < $used)
 490         printf "%3d %4d: ", $pgidx, $xofs
 491         pgx $gl0[$pgidx]
 492         set $xofs = $xofs + $gl0[$pgidx]->pixel_width
 493         set $pgidx = $pgidx + 1
 494       end
 495     end
 496     set $area = $area + 1
 497   end
 498 end
 499 document pgrowx
 500 Pretty print all glyphs in a row structure.
 501 Takes one argument, a pointer to a row structure.
 502 end
 503
 504 define pgrow
 505   pgrowx row
 506 end
 507 document pgrow
 508 Pretty print all glyphs in row structure row.
 509 end
 510
 511 define xtype
 512   xgettype $
 513   output $type
 514   echo \n
 515   if $type == Lisp_Misc
 516     xmisctype
 517   else
 518     if $type == Lisp_Vectorlike
 519       xvectype
 520     end
 521   end
 522 end
 523 document xtype
 524 Print the type of $, assuming it is an Emacs Lisp value.
 525 If the first type printed is Lisp_Vector or Lisp_Misc,
 526 a second line gives the more precise type.
 527 end
 528
 529 define xvectype
 530   xgetptr $
 531   set $size = ((struct Lisp_Vector *) $ptr)->size
 532   output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
 533   echo \n
 534 end
 535 document xvectype
 536 Print the size or vector subtype of $.
 537 This command assumes that $ is a vector or pseudovector.
 538 end
 539
 540 define xmisctype
 541   xgetptr $
 542   output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
 543   echo \n
 544 end
 545 document xmisctype
 546 Assume that $ is some misc type and print its specific type.
 547 end
 548
 549 define xint
 550   xgetint $
 551   print $int
 552 end
 553 document xint
 554 Print $ as an Emacs Lisp integer.  This gets the sign right.
 555 end
 556
 557 define xptr
 558   xgetptr $
 559   print (void *) $ptr
 560 end
 561 document xptr
 562 Print the pointer portion of an Emacs Lisp value in $.
 563 end
 564
 565 define xmarker
 566   xgetptr $
 567   print (struct Lisp_Marker *) $ptr
 568 end
 569 document xmarker
 570 Print $ as a marker pointer.
 571 This command assumes that $ is an Emacs Lisp marker value.
 572 end
 573
 574 define xoverlay
 575   xgetptr $
 576   print (struct Lisp_Overlay *) $ptr
 577 end
 578 document xoverlay
 579 Print $ as a overlay pointer.
 580 This command assumes that $ is an Emacs Lisp overlay value.
 581 end
 582
 583 define xmiscfree
 584   xgetptr $
 585   print (struct Lisp_Free *) $ptr
 586 end
 587 document xmiscfree
 588 Print $ as a misc free-cell pointer.
 589 This command assumes that $ is an Emacs Lisp Misc value.
 590 end
 591
 592 define xintfwd
 593   xgetptr $
 594   print (struct Lisp_Intfwd *) $ptr
 595 end
 596 document xintfwd
 597 Print $ as an integer forwarding pointer.
 598 This command assumes that $ is an Emacs Lisp Misc value.
 599 end
 600
 601 define xboolfwd
 602   xgetptr $
 603   print (struct Lisp_Boolfwd *) $ptr
 604 end
 605 document xboolfwd
 606 Print $ as a boolean forwarding pointer.
 607 This command assumes that $ is an Emacs Lisp Misc value.
 608 end
 609
 610 define xobjfwd
 611   xgetptr $
 612   print (struct Lisp_Objfwd *) $ptr
 613 end
 614 document xobjfwd
 615 Print $ as an object forwarding pointer.
 616 This command assumes that $ is an Emacs Lisp Misc value.
 617 end
 618
 619 define xbufobjfwd
 620   xgetptr $
 621   print (struct Lisp_Buffer_Objfwd *) $ptr
 622 end
 623 document xbufobjfwd
 624 Print $ as a buffer-local object forwarding pointer.
 625 This command assumes that $ is an Emacs Lisp Misc value.
 626 end
 627
 628 define xkbobjfwd
 629   xgetptr $
 630   print (struct Lisp_Kboard_Objfwd *) $ptr
 631 end
 632 document xkbobjfwd
 633 Print $ as a kboard-local object forwarding pointer.
 634 This command assumes that $ is an Emacs Lisp Misc value.
 635 end
 636
 637 define xbuflocal
 638   xgetptr $
 639   print (struct Lisp_Buffer_Local_Value *) $ptr
 640 end
 641 document xbuflocal
 642 Print $ as a buffer-local-value pointer.
 643 This command assumes that $ is an Emacs Lisp Misc value.
 644 end
 645
 646 define xsymbol
 647   set $sym = $
 648   xgetptr $sym
 649   print (struct Lisp_Symbol *) $ptr
 650   xprintsym $sym
 651   echo \n
 652 end
 653 document xsymbol
 654 Print the name and address of the symbol $.
 655 This command assumes that $ is an Emacs Lisp symbol value.
 656 end
 657
 658 define xstring
 659   xgetptr $
 660   print (struct Lisp_String *) $ptr
 661   xprintstr $
 662   echo \n
 663 end
 664 document xstring
 665 Print the contents and address of the string $.
 666 This command assumes that $ is an Emacs Lisp string value.
 667 end
 668
 669 define xvector
 670   xgetptr $
 671   print (struct Lisp_Vector *) $ptr
 672   output ($->size > 50) ? 0 : ($->contents[0])@($->size & ~gdb_array_mark_flag)
 673 echo \n
 674 end
 675 document xvector
 676 Print the contents and address of the vector $.
 677 This command assumes that $ is an Emacs Lisp vector value.
 678 end
 679
 680 define xprocess
 681   xgetptr $
 682   print (struct Lisp_Process *) $ptr
 683   output *$
 684   echo \n
 685 end
 686 document xprocess
 687 Print the address of the struct Lisp_process to which $ points.
 688 This command assumes that $ is a Lisp_Object.
 689 end
 690
 691 define xframe
 692   xgetptr $
 693   print (struct frame *) $ptr
 694   xgetptr $->name
 695   set $ptr = (struct Lisp_String *) $ptr
 696   xprintstr $ptr
 697   echo \n
 698 end
 699 document xframe
 700 Print $ as a frame pointer.
 701 This command assumes $ is an Emacs Lisp frame value.
 702 end
 703
 704 define xcompiled
 705   xgetptr $
 706   print (struct Lisp_Vector *) $ptr
 707   output ($->contents[0])@($->size & 0xff)
 708 end
 709 document xcompiled
 710 Print $ as a compiled function pointer.
 711 This command assumes that $ is an Emacs Lisp compiled value.
 712 end
 713
 714 define xwindow
 715   xgetptr $
 716   print (struct window *) $ptr
 717   set $window = (struct window *) $ptr
 718   xgetint $window->total_cols
 719   set $width=$int
 720   xgetint $window->total_lines
 721   set $height=$int
 722   xgetint $window->left_col
 723   set $left=$int
 724   xgetint $window->top_line
 725   set $top=$int
 726   printf "%dx%d+%d+%d\n", $width, $height, $left, $top
 727 end
 728 document xwindow
 729 Print $ as a window pointer, assuming it is an Emacs Lisp window value.
 730 Print the window's position as "WIDTHxHEIGHT+LEFT+TOP".
 731 end
 732
 733 define xwinconfig
 734   xgetptr $
 735   print (struct save_window_data *) $ptr
 736 end
 737 document xwinconfig
 738 Print $ as a window configuration pointer.
 739 This command assumes that $ is an Emacs Lisp window configuration value.
 740 end
 741
 742 define xsubr
 743   xgetptr $
 744   print (struct Lisp_Subr *) $ptr
 745   output *$
 746   echo \n
 747 end
 748 document xsubr
 749 Print the address of the subr which the Lisp_Object $ points to.
 750 end
 751
 752 define xchartable
 753   xgetptr $
 754   print (struct Lisp_Char_Table *) $ptr
 755   printf "Purpose: "
 756   xprintsym $->purpose
 757   printf "  %d extra slots", ($->size & 0x1ff) - 388
 758   echo \n
 759 end
 760 document xchartable
 761 Print the address of the char-table $, and its purpose.
 762 This command assumes that $ is an Emacs Lisp char-table value.
 763 end
 764
 765 define xboolvector
 766   xgetptr $
 767   print (struct Lisp_Bool_Vector *) $ptr
 768   output ($->size > 256) ? 0 : ($->data[0])@((($->size & ~gdb_array_mark_flag) + 7)/ 8)
 769   echo \n
 770 end
 771 document xboolvector
 772 Print the contents and address of the bool-vector $.
 773 This command assumes that $ is an Emacs Lisp bool-vector value.
 774 end
 775
 776 define xbuffer
 777   xgetptr $
 778   print (struct buffer *) $ptr
 779   xgetptr $->name
 780   output ((struct Lisp_String *) $ptr)->data
 781   echo \n
 782 end
 783 document xbuffer
 784 Set $ as a buffer pointer and the name of the buffer.
 785 This command assumes $ is an Emacs Lisp buffer value.
 786 end
 787
 788 define xhashtable
 789   xgetptr $
 790   print (struct Lisp_Hash_Table *) $ptr
 791 end
 792 document xhashtable
 793 Set $ as a hash table pointer.
 794 This command assumes that $ is an Emacs Lisp hash table value.
 795 end
 796
 797 define xcons
 798   xgetptr $
 799   print (struct Lisp_Cons *) $ptr
 800   output/x *$
 801   echo \n
 802 end
 803 document xcons
 804 Print the contents of $ as an Emacs Lisp cons.
 805 end
 806
 807 define nextcons
 808   p $.u.cdr
 809   xcons
 810 end
 811 document nextcons
 812 Print the contents of the next cell in a list.
 813 This command assumes that the last thing you printed was a cons cell contents
 814 (type struct Lisp_Cons) or a pointer to one.
 815 end
 816 define xcar
 817   xgetptr $
 818   xgettype $
 819   print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->car : 0)
 820 end
 821 document xcar
 822 Assume that $ is an Emacs Lisp pair and print its car.
 823 end
 824
 825 define xcdr
 826   xgetptr $
 827   xgettype $
 828   print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.cdr : 0)
 829 end
 830 document xcdr
 831 Assume that $ is an Emacs Lisp pair and print its cdr.
 832 end
 833
 834 define xlist
 835   xgetptr $
 836   set $cons = (struct Lisp_Cons *) $ptr
 837   xgetptr Qnil
 838   set $nil = $ptr
 839   set $i = 0
 840   while $cons != $nil && $i < 10
 841     p/x $cons->car
 842     xpr
 843     xgetptr $cons->u.cdr
 844     set $cons = (struct Lisp_Cons *) $ptr
 845     set $i = $i + 1
 846     printf "---\n"
 847   end
 848   if $cons == $nil
 849     printf "nil\n"
 850   else
 851     printf "...\n"
 852     p $ptr
 853   end
 854 end
 855 document xlist
 856 Print $ assuming it is a list.
 857 end
 858
 859 define xfloat
 860   xgetptr $
 861   print ((struct Lisp_Float *) $ptr)->u.data
 862 end
 863 document xfloat
 864 Print $ assuming it is a lisp floating-point number.
 865 end
 866
 867 define xscrollbar
 868   xgetptr $
 869   print (struct scrollbar *) $ptr
 870 output *$
 871 echo \n
 872 end
 873 document xscrollbar
 874 Print $ as a scrollbar pointer.
 875 end
 876
 877 define xpr
 878   xtype
 879   if $type == Lisp_Int
 880     xint
 881   end
 882   if $type == Lisp_Symbol
 883     xsymbol
 884   end
 885   if $type == Lisp_String
 886     xstring
 887   end
 888   if $type == Lisp_Cons
 889     xcons
 890   end
 891   if $type == Lisp_Float
 892     xfloat
 893   end
 894   if $type == Lisp_Misc
 895     set $misc = (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
 896     if $misc == Lisp_Misc_Free
 897       xmiscfree
 898     end
 899     if $misc == Lisp_Misc_Boolfwd
 900       xboolfwd
 901     end
 902     if $misc == Lisp_Misc_Marker
 903       xmarker
 904     end
 905     if $misc == Lisp_Misc_Intfwd
 906       xintfwd
 907     end
 908     if $misc == Lisp_Misc_Boolfwd
 909       xboolfwd
 910     end
 911     if $misc == Lisp_Misc_Objfwd
 912       xobjfwd
 913     end
 914     if $misc == Lisp_Misc_Buffer_Objfwd
 915       xbufobjfwd
 916     end
 917     if $misc == Lisp_Misc_Buffer_Local_Value
 918       xbuflocal
 919     end
 920 #    if $misc == Lisp_Misc_Some_Buffer_Local_Value
 921 #      xvalue
 922 #    end
 923     if $misc == Lisp_Misc_Overlay
 924       xoverlay
 925     end
 926     if $misc == Lisp_Misc_Kboard_Objfwd
 927       xkbobjfwd
 928     end
 929 #    if $misc == Lisp_Misc_Save_Value
 930 #      xsavevalue
 931 #    end
 932   end
 933   if $type == Lisp_Vectorlike
 934     set $size = ((struct Lisp_Vector *) $ptr)->size
 935     if ($size & PVEC_FLAG)
 936       set $vec = (enum pvec_type) ($size & PVEC_TYPE_MASK)
 937       if $vec == PVEC_NORMAL_VECTOR
 938         xvector
 939       end
 940       if $vec == PVEC_PROCESS
 941         xprocess
 942       end
 943       if $vec == PVEC_FRAME
 944         xframe
 945       end
 946       if $vec == PVEC_COMPILED
 947         xcompiled
 948       end
 949       if $vec == PVEC_WINDOW
 950         xwindow
 951       end
 952       if $vec == PVEC_WINDOW_CONFIGURATION
 953         xwinconfig
 954       end
 955       if $vec == PVEC_SUBR
 956         xsubr
 957       end
 958       if $vec == PVEC_CHAR_TABLE
 959         xchartable
 960       end
 961       if $vec == PVEC_BOOL_VECTOR
 962         xboolvector
 963       end
 964       if $vec == PVEC_BUFFER
 965         xbuffer
 966       end
 967       if $vec == PVEC_HASH_TABLE
 968         xhashtable
 969       end
 970     else
 971       xvector
 972     end
 973   end
 974 end
 975 document xpr
 976 Print $ as a lisp object of any type.
 977 end
 978
 979 define xprintstr
 980   set $data = (char *) $arg0->data
 981   output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)
 982 end
 983
 984 define xprintsym
 985   xgetptr $arg0
 986   set $sym = (struct Lisp_Symbol *) $ptr
 987   xgetptr $sym->xname
 988   set $sym_name = (struct Lisp_String *) $ptr
 989   xprintstr $sym_name
 990 end
 991 document xprintsym
 992   Print argument as a symbol.
 993 end
 994
 995 define xbacktrace
 996   set $bt = backtrace_list
 997   while $bt
 998     xgettype (*$bt->function)
 999     if $type == Lisp_Symbol
1000       xprintsym (*$bt->function)
1001       printf " (0x%x)\n", *$bt->args
1002     else
1003       printf "0x%x ", *$bt->function
1004       if $type == Lisp_Vectorlike
1005         xgetptr (*$bt->function)
1006         set $size = ((struct Lisp_Vector *) $ptr)->size
1007         output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
1008       else
1009         printf "Lisp type %d", $type
1010       end
1011       echo \n
1012     end
1013     set $bt = $bt->next
1014   end
1015 end
1016 document xbacktrace
1017   Print a backtrace of Lisp function calls from backtrace_list.
1018   Set a breakpoint at Fsignal and call this to see from where
1019   an error was signaled.
1020 end
1021
1022 define which
1023   set debug_print (which_symbols ($arg0))
1024 end
1025 document which
1026   Print symbols which references a given lisp object
1027   either as its symbol value or symbol function.
1028 end
1029
1030 define xbytecode
1031   set $bt = byte_stack_list
1032   while $bt
1033     xgettype ($bt->byte_string)
1034     printf "0x%x => ", $bt->byte_string
1035     which $bt->byte_string
1036     set $bt = $bt->next
1037   end
1038 end
1039 document xbytecode
1040   Print a backtrace of the byte code stack.
1041 end
1042
1043 # Show Lisp backtrace after normal backtrace.
1044 define hookpost-backtrace
1045   set $bt = backtrace_list
1046   if $bt
1047     echo \n
1048     echo Lisp Backtrace:\n
1049     xbacktrace
1050   end
1051 end
1052
1053 define xreload
1054   set $tagmask = (((long)1 << gdb_gctypebits) - 1)
1055   set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
1056 end
1057 document xreload
1058   When starting Emacs a second time in the same gdb session under
1059   FreeBSD 2.2.5, gdb 4.13, $valmask have lost
1060   their values.  (The same happens on current (2000) versions of GNU/Linux
1061   with gdb 5.0.)
1062   This function reloads them.
1063 end
1064 xreload
1065
1066 # Flush display (X only)
1067 define ff
1068   set x_flush (0)
1069 end
1070 document ff
1071 Flush pending X window display updates to screen.
1072 Works only when an inferior emacs is executing.
1073 end
1074
1075
1076 define hook-run
1077   xreload
1078 end
1079
1080 # Call xreload if a new Emacs executable is loaded.
1081 define hookpost-run
1082   xreload
1083 end
1084
1085 set print pretty on
1086 set print sevenbit-strings
1087
1088 show environment DISPLAY
1089 show environment TERM
1090 set args -geometry 80x40+0+0
1091
1092 # People get bothered when they see messages about non-existent functions...
1093 xgetptr Vsystem_type
1094 # $ptr is NULL in temacs
1095 if ($ptr != 0)
1096   set $tem = (struct Lisp_Symbol *) $ptr
1097   xgetptr $tem->xname
1098   set $tem = (struct Lisp_String *) $ptr
1099   set $tem = (char *) $tem->data
1100
1101   # Don't let abort actually run, as it will make stdio stop working and
1102   # therefore the `pr' command above as well.
1103   if $tem[0] == 'w' && $tem[1] == 'i' && $tem[2] == 'n' && $tem[3] == 'd'
1104     # The windows-nt build replaces abort with its own function.
1105     break w32_abort
1106   else
1107     break abort
1108   end
1109 end
1110
1111 # x_error_quitter is defined only on X.  But window-system is set up
1112 # only at run time, during Emacs startup, so we need to defer setting
1113 # the breakpoint.  init_sys_modes is the first function called on
1114 # every platform after init_display, where window-system is set.
1115 tbreak init_sys_modes
1116 commands
1117   silent
1118   xgetptr Vwindow_system
1119   set $tem = (struct Lisp_Symbol *) $ptr
1120   xgetptr $tem->xname
1121   set $tem = (struct Lisp_String *) $ptr
1122   set $tem = (char *) $tem->data
1123   # If we are running in synchronous mode, we want a chance to look
1124   # around before Emacs exits.  Perhaps we should put the break
1125   # somewhere else instead...
1126   if $tem[0] == 'x' && $tem[1] == '\0'
1127     break x_error_quitter
1128   end
1129   continue
1130 end
1131 # arch-tag: 12f34321-7bfa-4240-b77a-3cd3a1696dfe