src/.gdbinit

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