(xframe): Print frame name.

[gnu-emacs] / src / .gdbinit

diff --git a/src/.gdbinit b/src/.gdbinit
index cb1deddb1ea5b1b8138bf9f1e8a746ddf81b3832..04581efcbb16965a30cd9d18fec61ce9ab3d28f3 100644 (file)
--- a/src/.gdbinit
+++ b/src/.gdbinit
@@ -1,5 +1,5 @@
-# Copyright (C) 1992, 93, 94, 95, 96, 97, 1998, 2000, 01, 2004
-#   Free Software Foundation, Inc.
+# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, 2001,
+#   2004, 2005, 2006 Free Software Foundation, Inc.

 #
 # This file is part of GNU Emacs.
 #
 #
 # This file is part of GNU Emacs.
 #


@@ -31,6 +31,9 @@ dir ../lwlib
 # However, C-z works just as well in that case.
 handle 2 noprint pass
 
 # However, C-z works just as well in that case.
 handle 2 noprint pass
 

+# Make it work like SIGINT normally does.
+handle SIGTSTP nopass
+

 # Don't pass SIGALRM to Emacs.  This makes problems when
 # debugging.
 handle SIGALRM ignore
 # Don't pass SIGALRM to Emacs.  This makes problems when
 # debugging.
 handle SIGALRM ignore


@@ -55,8 +58,14 @@ define xgettype
 end
 
 # Set up something to print out s-expressions.
 end
 
 # Set up something to print out s-expressions.

+# We save and restore print_output_debug_flag to prevent the w32 port
+# from calling OutputDebugString, which causes GDB to display each
+# character twice (yuk!).

 define pr
 define pr

+  set $output_debug = print_output_debug_flag
+  set print_output_debug_flag = 0

   set debug_print ($)
   set debug_print ($)

+  set print_output_debug_flag = $output_debug

 end
 document pr
 Print the emacs s-expression which is $.
 end
 document pr
 Print the emacs s-expression which is $.


@@ -66,7 +75,10 @@ end
 # Print out s-expressions
 define pp
   set $tmp = $arg0
 # Print out s-expressions
 define pp
   set $tmp = $arg0

+  set $output_debug = print_output_debug_flag
+  set print_output_debug_flag = 0

   set safe_debug_print ($tmp)
   set safe_debug_print ($tmp)

+  set print_output_debug_flag = $output_debug

 end
 document pp
 Print the argument as an emacs s-expression
 end
 document pp
 Print the argument as an emacs s-expression


@@ -76,12 +88,13 @@ end
 # Print out s-expressions from tool bar
 define pp1
   set $tmp = $arg0
 # Print out s-expressions from tool bar
 define pp1
   set $tmp = $arg0

-  echo $arg0
-  printf " = "
+  set $output_debug = print_output_debug_flag
+  set print_output_debug_flag = 0

   set safe_debug_print ($tmp)
   set safe_debug_print ($tmp)

+  set print_output_debug_flag = $output_debug

 end
 document pp1
 end
 document pp1

-Print the argument as an emacs s-expression
+Print the argument as an emacs s-expression.

 Works only when an inferior emacs is executing.
 For use on tool bar when debugging in Emacs
 where the variable name would not otherwise
 Works only when an inferior emacs is executing.
 For use on tool bar when debugging in Emacs
 where the variable name would not otherwise


@@ -91,7 +104,10 @@ end
 # Print value of lisp variable
 define pv
   set $tmp = "$arg0"
 # Print value of lisp variable
 define pv
   set $tmp = "$arg0"

+  set $output_debug = print_output_debug_flag
+  set print_output_debug_flag = 0

   set safe_debug_print ( find_symbol_value (intern ($tmp)))
   set safe_debug_print ( find_symbol_value (intern ($tmp)))

+  set print_output_debug_flag = $output_debug

 end
 document pv
 Print the value of the lisp variable given as argument.
 end
 document pv
 Print the value of the lisp variable given as argument.


@@ -101,16 +117,16 @@ end
 # Print value of lisp variable
 define pv1
   set $tmp = "$arg0"
 # Print value of lisp variable
 define pv1
   set $tmp = "$arg0"

-  echo $arg0
-  printf " = "
+  set $output_debug = print_output_debug_flag
+  set print_output_debug_flag = 0

   set safe_debug_print (find_symbol_value (intern ($tmp)))
   set safe_debug_print (find_symbol_value (intern ($tmp)))

+  set print_output_debug_flag = $output_debug

 end
 document pv1
 Print the value of the lisp variable given as argument.
 Works only when an inferior emacs is executing.
 end
 document pv1
 Print the value of the lisp variable given as argument.
 Works only when an inferior emacs is executing.

-For use on tool bar when debugging in Emacs
-where the variable name would not otherwise
-be recorded in the GUD buffer.
+For use when debugging in Emacs where the variable
+name would not otherwise be recorded in the GUD buffer.

 end
 
 # Print out current buffer point and boundaries
 end
 
 # Print out current buffer point and boundaries


@@ -162,7 +178,7 @@ define pitx
     printf " HL"
   end
   if ($it->n_overlay_strings > 0)
     printf " HL"
   end
   if ($it->n_overlay_strings > 0)

-    printf " nov=%d"
+    printf " nov=%d", $it->n_overlay_strings

   end
   if ($it->sp != 0)
     printf " sp=%d", $it->sp
   end
   if ($it->sp != 0)
     printf " sp=%d", $it->sp


@@ -195,6 +211,7 @@ define pitx
   printf "vpos=%d hpos=%d", $it->vpos, $it->hpos,
   printf " y=%d lvy=%d", $it->current_y, $it->last_visible_y
   printf " x=%d vx=%d-%d", $it->current_x, $it->first_visible_x, $it->last_visible_x
   printf "vpos=%d hpos=%d", $it->vpos, $it->hpos,
   printf " y=%d lvy=%d", $it->current_y, $it->last_visible_y
   printf " x=%d vx=%d-%d", $it->current_x, $it->first_visible_x, $it->last_visible_x

+  printf " w=%d", $it->pixel_width

   printf " a+d=%d+%d=%d", $it->ascent, $it->descent, $it->ascent+$it->descent
   printf " max=%d+%d=%d", $it->max_ascent, $it->max_descent, $it->max_ascent+$it->max_descent
   printf "\n"
   printf " a+d=%d+%d=%d", $it->ascent, $it->descent, $it->ascent+$it->descent
   printf " max=%d+%d=%d", $it->max_ascent, $it->max_descent, $it->max_ascent+$it->max_descent
   printf "\n"


@@ -528,6 +545,10 @@ end
 define xframe
   xgetptr $
   print (struct frame *) $ptr
 define xframe
   xgetptr $
   print (struct frame *) $ptr

+  xgetptr $->name
+  set $ptr = (struct Lisp_String *) $ptr
+  xprintstr $ptr
+  echo \n

 end
 document xframe
 Print $ as a frame pointer, assuming it is an Emacs Lisp frame value.
 end
 document xframe
 Print $ as a frame pointer, assuming it is an Emacs Lisp frame value.


@@ -545,7 +566,16 @@ end
 define xwindow
   xgetptr $
   print (struct window *) $ptr
 define xwindow
   xgetptr $
   print (struct window *) $ptr

-  printf "%dx%d+%d+%d\n", $->width, $->height, $->left, $->top
+  set $window = (struct window *) $ptr
+  xgetint $window->total_cols
+  set $width=$int
+  xgetint $window->total_lines
+  set $height=$int
+  xgetint $window->left_col
+  set $left=$int
+  xgetint $window->top_line
+  set $top=$int
+  printf "%dx%d+%d+%d\n", $width, $height, $left, $top

 end
 document xwindow
 Print $ as a window pointer, assuming it is an Emacs Lisp window value.
 end
 document xwindow
 Print $ as a window pointer, assuming it is an Emacs Lisp window value.


@@ -625,7 +655,7 @@ Print the contents of $, assuming it is an Emacs Lisp cons.
 end
 
 define nextcons
 end
 
 define nextcons

-  p $.cdr
+  p $.u.cdr

   xcons
 end
 document nextcons
   xcons
 end
 document nextcons


@@ -645,15 +675,40 @@ end
 define xcdr
   xgetptr $
   xgettype $
 define xcdr
   xgetptr $
   xgettype $

-  print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->cdr : 0)
+  print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.cdr : 0)

 end
 document xcdr
 Print the cdr of $, assuming it is an Emacs Lisp pair.
 end
 
 end
 document xcdr
 Print the cdr of $, assuming it is an Emacs Lisp pair.
 end
 

+define xlist
+  xgetptr $
+  set $cons = (struct Lisp_Cons *) $ptr
+  xgetptr Qnil
+  set $nil = $ptr
+  set $i = 0
+  while $cons != $nil && $i < 10
+    p/x $cons->car
+    xpr
+    xgetptr $cons->u.cdr
+    set $cons = (struct Lisp_Cons *) $ptr
+    set $i = $i + 1
+    printf "---\n"
+  end
+  if $cons == $nil
+    printf "nil\n"
+  else
+    printf "...\n"
+    p $ptr
+  end
+end
+document xlist
+Print $ assuming it is a list.
+end
+

 define xfloat
   xgetptr $
 define xfloat
   xgetptr $

-  print ((struct Lisp_Float *) $ptr)->data
+  print ((struct Lisp_Float *) $ptr)->u.data

 end
 document xfloat
 Print $ assuming it is a lisp floating-point number.
 end
 document xfloat
 Print $ assuming it is a lisp floating-point number.


@@ -669,6 +724,108 @@ document xscrollbar
 Print $ as a scrollbar pointer.
 end
 
 Print $ as a scrollbar pointer.
 end
 

+define xpr
+  xtype
+  if $type == Lisp_Int
+    xint
+  end
+  if $type == Lisp_Symbol
+    xsymbol
+  end
+  if $type == Lisp_String
+    xstring
+  end
+  if $type == Lisp_Cons
+    xcons
+  end
+  if $type == Lisp_Float
+    xfloat
+  end
+  if $type == Lisp_Misc
+    set $misc = (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
+    if $misc == Lisp_Misc_Free
+      xmiscfree
+    end
+    if $misc == Lisp_Misc_Boolfwd
+      xboolfwd
+    end
+    if $misc == Lisp_Misc_Marker
+      xmarker
+    end
+    if $misc == Lisp_Misc_Intfwd
+      xintfwd
+    end
+    if $misc == Lisp_Misc_Boolfwd
+      xboolfwd
+    end
+    if $misc == Lisp_Misc_Objfwd
+      xobjfwd
+    end
+    if $misc == Lisp_Misc_Buffer_Objfwd
+      xbufobjfwd
+    end
+    if $misc == Lisp_Misc_Buffer_Local_Value
+      xbuflocal
+    end
+#    if $misc == Lisp_Misc_Some_Buffer_Local_Value
+#      xvalue
+#    end
+    if $misc == Lisp_Misc_Overlay
+      xoverlay
+    end
+    if $misc == Lisp_Misc_Kboard_Objfwd
+      xkbobjfwd
+    end
+#    if $misc == Lisp_Misc_Save_Value
+#      xsavevalue
+#    end
+  end
+  if $type == Lisp_Vectorlike
+    set $size = ((struct Lisp_Vector *) $ptr)->size
+    if ($size & PVEC_FLAG)
+      set $vec = (enum pvec_type) ($size & PVEC_TYPE_MASK)
+      if $vec == PVEC_NORMAL_VECTOR
+       xvector
+      end
+      if $vec == PVEC_PROCESS
+       xprocess
+      end
+      if $vec == PVEC_FRAME
+       xframe
+      end
+      if $vec == PVEC_COMPILED
+       xcompiled
+      end
+      if $vec == PVEC_WINDOW
+       xwindow
+      end
+      if $vec == PVEC_WINDOW_CONFIGURATION
+       xwinconfig
+      end
+      if $vec == PVEC_SUBR
+       xsubr
+      end
+      if $vec == PVEC_CHAR_TABLE
+       xchartable
+      end
+      if $vec == PVEC_BOOL_VECTOR
+       xboolvector
+      end
+      if $vec == PVEC_BUFFER
+       xbuffer
+      end
+      if $vec == PVEC_HASH_TABLE
+       xhashtable
+      end
+    else
+      xvector
+    end
+  end
+end
+document xpr
+Print $ as a lisp object of any type.
+end
+

 define xprintstr
   set $data = $arg0->data
   output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)
 define xprintstr
   set $data = $arg0->data
   output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)


@@ -691,7 +848,7 @@ define xbacktrace
     xgettype (*$bt->function)
     if $type == Lisp_Symbol
       xprintsym (*$bt->function)
     xgettype (*$bt->function)
     if $type == Lisp_Symbol
       xprintsym (*$bt->function)

-      echo \n
+      printf " (0x%x)\n", *$bt->args

     else
       printf "0x%x ", *$bt->function
       if $type == Lisp_Vectorlike
     else
       printf "0x%x ", *$bt->function
       if $type == Lisp_Vectorlike


@@ -712,6 +869,37 @@ document xbacktrace
   an error was signaled.
 end
 
   an error was signaled.
 end
 

+define which
+  set debug_print (which_symbols ($arg0))
+end
+document which
+  Print symbols which references a given lisp object,
+  either as its symbol value or symbol function.
+end
+
+define xbytecode
+  set $bt = byte_stack_list
+  while $bt
+    xgettype ($bt->byte_string)
+    printf "0x%x => ", $bt->byte_string
+    which $bt->byte_string
+    set $bt = $bt->next
+  end
+end
+document xbytecode
+  Print a backtrace of the byte code stack.
+end
+
+# Show Lisp backtrace after normal backtrace.
+define hookpost-backtrace
+  set $bt = backtrace_list
+  if $bt
+    echo \n
+    echo Lisp Backtrace:\n
+    xbacktrace
+  end
+end
+

 define xreload
   set $tagmask = (((long)1 << gdb_gctypebits) - 1)
   set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
 define xreload
   set $tagmask = (((long)1 << gdb_gctypebits) - 1)
   set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1


@@ -751,13 +939,43 @@ show environment DISPLAY
 show environment TERM
 set args -geometry 80x40+0+0
 
 show environment TERM
 set args -geometry 80x40+0+0
 

-# Don't let abort actually run, as it will make
-# stdio stop working and therefore the `pr' command above as well.
-break abort
-
-# If we are running in synchronous mode, we want a chance to look around
-# before Emacs exits.  Perhaps we should put the break somewhere else
-# instead...
-break x_error_quitter
-
+# People get bothered when they see messages about non-existent functions...
+xgetptr Vsystem_type
+# $ptr is NULL in temacs
+if ($ptr != 0)
+  set $tem = (struct Lisp_Symbol *) $ptr
+  xgetptr $tem->xname
+  set $tem = (struct Lisp_String *) $ptr
+  set $tem = (char *) $tem->data
+
+  # Don't let abort actually run, as it will make stdio stop working and
+  # therefore the `pr' command above as well.
+  if $tem[0] == 'w' && $tem[1] == 'i' && $tem[2] == 'n' && $tem[3] == 'd'
+    # The windows-nt build replaces abort with its own function.
+    break w32_abort
+  else
+    break abort
+  end
+end
+
+# x_error_quitter is defined only on X.  But window-system is set up
+# only at run time, during Emacs startup, so we need to defer setting
+# the breakpoint.  init_sys_modes is the first function called on
+# every platform after init_display, where window-system is set.
+tbreak init_sys_modes
+commands
+  silent
+  xgetptr Vwindow_system
+  set $tem = (struct Lisp_Symbol *) $ptr
+  xgetptr $tem->xname
+  set $tem = (struct Lisp_String *) $ptr
+  set $tem = (char *) $tem->data
+  # If we are running in synchronous mode, we want a chance to look
+  # around before Emacs exits.  Perhaps we should put the break
+  # somewhere else instead...
+  if $tem[0] == 'x' && $tem[1] == '\0'
+    break x_error_quitter
+  end
+  continue
+end

 # arch-tag: 12f34321-7bfa-4240-b77a-3cd3a1696dfe
 # arch-tag: 12f34321-7bfa-4240-b77a-3cd3a1696dfe