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