[Emacs-diffs] emacs/lisp ChangeLog progmodes/gdb-mi.el

[Dmitry Dzhus]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Dmitry Dzhus <sphinx>   09/08/04 15:52:01

Modified files:
        lisp           : ChangeLog 
        lisp/progmodes : gdb-mi.el 

Log message:
        * progmodes/gdb-mi.el (gdb-get-buffer, gdb-get-buffer-create):
        Argument `key' renamed to `buffer-type'.
        (gdb-current-context-buffer-name): Do not add thread info to
        buffer name when no thread is selected.
        (gdbmi-record-list, gdb-shell): Try to handle GDB `shell'
        command (bug 3794).
        (gdb-thread-selected): Handle `=thread-selected' notification.
        (gdb-wait-for-pending): New macro to deal with congestion problems.
        (gdb-breakpoints-list-handler-custom): Don't fail on pending
        breakpoints.
        (gdb-invalidate-disassembly): Use 'fullname instead of 'file. This
        fixes problem similar to one described in bug 3947.
        (gud-menu-map): More menu items.
        (gdb-init-1): Reset `gdb-thread-number' to nil.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/ChangeLog?cvsroot=emacs&r1=1.15893&r2=1.15894
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/progmodes/gdb-mi.el?cvsroot=emacs&r1=1.24&r2=1.25

Patches:
Index: ChangeLog
===================================================================
RCS file: /sources/emacs/emacs/lisp/ChangeLog,v
retrieving revision 1.15893
retrieving revision 1.15894
diff -u -b -r1.15893 -r1.15894
--- ChangeLog   4 Aug 2009 15:17:28 -0000       1.15893
+++ ChangeLog   4 Aug 2009 15:51:58 -0000       1.15894
@@ -1,5 +1,20 @@
 2009-08-04  Dmitry Dzhus  <address@hidden>
 
+       * progmodes/gdb-mi.el (gdb-get-buffer, gdb-get-buffer-create):
+       Argument `key' renamed to `buffer-type'.
+       (gdb-current-context-buffer-name): Do not add thread info to
+       buffer name when no thread is selected.
+       (gdbmi-record-list, gdb-shell): Try to handle GDB `shell'
+       command (bug 3794).
+       (gdb-thread-selected): Handle `=thread-selected' notification.
+       (gdb-wait-for-pending): New macro to deal with congestion problems.
+       (gdb-breakpoints-list-handler-custom): Don't fail on pending
+       breakpoints.
+       (gdb-invalidate-disassembly): Use 'fullname instead of 'file. This
+       fixes problem similar to one described in bug 3947.
+       (gud-menu-map): More menu items.
+       (gdb-init-1): Reset `gdb-thread-number' to nil.
+
        * progmodes/gud.el (gud-stop-subjob, gud-menu-map): Respect GDB
        non-stop settings.
 

Index: progmodes/gdb-mi.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/progmodes/gdb-mi.el,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -b -r1.24 -r1.25
--- progmodes/gdb-mi.el 4 Aug 2009 15:07:27 -0000       1.24
+++ progmodes/gdb-mi.el 4 Aug 2009 15:52:01 -0000       1.25
@@ -233,6 +233,21 @@
   `(setq gdb-pending-triggers
          (delete ,item gdb-pending-triggers)))
 
+(defvar gdb-wait-for-pending-timeout 0.5)
+
+(defmacro gdb-wait-for-pending (&rest body)
+  "Wait until `gdb-pending-triggers' is empty and execute BODY.
+
+This function checks `gdb-pending-triggers' value every
+`gdb-wait-for-pending' seconds."
+  (run-with-timer 
+   gdb-wait-for-pending-timeout nil
+   `(lambda ()
+      (if (not gdb-pending-triggers)
+          (progn
+            ,@body)
+        (gdb-wait-for-pending ,@body)))))
+  
 (defcustom gdb-debug-log-max 128
   "Maximum size of `gdb-debug-log'.  If nil, size is unlimited."
   :group 'gdb
@@ -619,6 +634,7 @@
   ;; (re-)initialise
   (setq gdb-selected-frame nil
        gdb-frame-number nil
+        gdb-thread-number nil
        gdb-var-list nil
        gdb-pending-triggers nil
        gdb-output-sink 'user
@@ -1088,35 +1104,35 @@
   "Get current stack frame object for thread of current buffer."
   (gdb-get-field (gdb-current-buffer-thread) 'frame))
 
-(defun gdb-get-buffer (key &optional thread)
+(defun gdb-get-buffer (buffer-type &optional thread)
   "Get a specific GDB buffer.
 
-In that buffer, `gdb-buffer-type' must be equal to KEY and
-`gdb-thread-number' (if provided) must be equal to THREAD."
+In that buffer, `gdb-buffer-type' must be equal to BUFFER-TYPE
+and `gdb-thread-number' (if provided) must be equal to THREAD."
   (catch 'found
     (dolist (buffer (buffer-list) nil)
       (with-current-buffer buffer
-        (when (and (eq gdb-buffer-type key)
+        (when (and (eq gdb-buffer-type buffer-type)
                    (or (not thread)
                        (equal gdb-thread-number thread)))
           (throw 'found buffer))))))
 
-(defun gdb-get-buffer-create (key &optional thread)
-  "Create a new GDB buffer of the type specified by KEY.
-The key should be one of the cars in `gdb-buffer-rules'.
+(defun gdb-get-buffer-create (buffer-type &optional thread)
+  "Create a new GDB buffer of the type specified by BUFFER-TYPE.
+The buffer-type should be one of the cars in `gdb-buffer-rules'.
 
 If THREAD is non-nil, it is assigned to `gdb-thread-number'
 buffer-local variable of the new buffer.
 
 If buffer's mode returns a symbol, it's used to register "
-  (or (gdb-get-buffer key thread)
-      (let ((rules (assoc key gdb-buffer-rules))
+  (or (gdb-get-buffer buffer-type thread)
+      (let ((rules (assoc buffer-type gdb-buffer-rules))
             (new (generate-new-buffer "limbo")))
        (with-current-buffer new
          (let ((mode (gdb-rules-buffer-mode rules))
                 (trigger (gdb-rules-update-trigger rules)))
            (when mode (funcall mode))
-           (setq gdb-buffer-type key)
+           (setq gdb-buffer-type buffer-type)
             (when thread
               (set (make-local-variable 'gdb-thread-number) thread))
            (set (make-local-variable 'gud-minor-mode)
@@ -1430,12 +1446,16 @@
     command))
 
 (defun gdb-current-context-buffer-name (name)
-  "Add thread information and asterisks to string NAME."
+  "Add thread information and asterisks to string NAME.
+
+If `gdb-thread-number' is nil, just wrap NAME in asterisks."
   (concat "*" name
-          (if (local-variable-p 'gdb-thread-number) 
-              " (bound to thread "
-            " (current thread ")
-          gdb-thread-number ")*"))
+          (format
+           (cond ((local-variable-p 'gdb-thread-number) " (bound to thread 
%s)")
+                 (gdb-thread-number " (current thread %s)")
+                 (t ""))
+           gdb-thread-number)
+          "*"))
 
 
 (defcustom gud-gdb-command-name "gdb -i=mi"
@@ -1517,7 +1537,8 @@
 `gdb-running-threads-count' and `gdb-stopped-threads-count'
 instead.
 
-For all-stop mode, thread information is unavailable while target is running"
+For all-stop mode, thread information is unavailable while target
+is running."
   (setq gud-running
         (string= (gdb-get-field (gdb-current-buffer-thread) 'state)
                  "running")))
@@ -1551,7 +1572,10 @@
     (gdb-stopped . "\\*stopped,?\\(.*?\\)\n")
     (gdb-running . "\\*running,\\(.*?\n\\)")
     (gdb-thread-created . "=thread-created,\\(.*?\n\\)")
-    (gdb-thread-exited . "=thread-exited,\\(.*?\n\\)")))
+    (gdb-thread-selected . "=thread-selected,\\(.*?\\)\n")
+    (gdb-thread-exited . "=thread-exited,\\(.*?\n\\)")
+    (gdb-ignored-notification . "=[-[:alpha:]]+,?\\(.*?\\)\n")
+    (gdb-shell . "\\(\\(?:^.+\n\\)+\\)")))
 
 (defun gud-gdbmi-marker-filter (string)
   "Filter GDB/MI output."
@@ -1610,11 +1634,28 @@
 
 (defun gdb-gdb (output-field))
 
+(defun gdb-shell (output-field)
+  (let ((gdb-output-sink gdb-output-sink))
+    (setq gdb-filter-output
+          (concat output-field gdb-filter-output))))
+
+(defun gdb-ignored-notification (output-field))
+
 ;; gdb-invalidate-threads is defined to accept 'update-threads signal
 (defun gdb-thread-created (output-field))
 (defun gdb-thread-exited (output-field)
   (gdb-emit-signal gdb-buf-publisher 'update-threads))
 
+(defun gdb-thread-selected (output-field)
+  "Handler for =thread-selected MI output record.
+
+Sets `gdb-thread-number' to new id."
+  (let* ((result (gdb-json-string output-field))
+         (thread-id (gdb-get-field result 'id)))
+    (gdb-setq-thread-number thread-id)
+    (gdb-wait-for-pending
+     (gdb-update))))
+
 (defun gdb-running (output-field)
   (setq gdb-inferior-status "running")
   (gdb-force-mode-line-update
@@ -1955,8 +1996,11 @@
             (propertize "n" 'face  font-lock-comment-face))) "\t"
         (gdb-get-field breakpoint 'times) "\t"
         (gdb-get-field breakpoint 'addr)))
-      (let ((at (gdb-get-field breakpoint 'at)))
-        (cond ((not at)
+      (let ((at (gdb-get-field breakpoint 'at))
+            (pending (gdb-get-field breakpoint 'pending)))
+        (cond (pending (insert "  " pending))
+              (at (insert " " at))
+              (t
                (progn
                  (insert 
                   (concat " in "
@@ -1966,14 +2010,12 @@
                  (add-text-properties (line-beginning-position)
                                       (line-end-position)
                                       '(mouse-face highlight
-                                        help-echo "mouse-2, RET: visit 
breakpoint"))))
-              (at (insert (concat " " at)))
-              (t (insert (gdb-get-field breakpoint 'original-location)))))
+                                                   help-echo "mouse-2, RET: 
visit breakpoint")))))
       (add-text-properties (line-beginning-position)
                            (line-end-position)
                            `(gdb-breakpoint ,breakpoint))
       (newline))
-    (gdb-place-breakpoints)))
+    (gdb-place-breakpoints))))
 
 ;; Put breakpoint icons in relevant margins (even those set in the GUD buffer).
 (defun gdb-place-breakpoints ()
@@ -2160,53 +2202,6 @@
     (define-key map (vector 'header-line 'down-mouse-1) 'ignore)
     map))
 
-(defmacro gdb-propertize-header (name buffer help-echo mouse-face face)
-  `(propertize ,name
-              'help-echo ,help-echo 
-              'mouse-face ',mouse-face
-              'face ',face
-              'local-map
-              (gdb-make-header-line-mouse-map
-               'mouse-1
-               (lambda (event) (interactive "e")
-                 (save-selected-window
-                   (select-window (posn-window (event-start event)))
-                   (set-window-dedicated-p (selected-window) nil)
-                   (switch-to-buffer
-                    (gdb-get-buffer-create ',buffer))
-                   (setq header-line-format(gdb-set-header ',buffer))
-                   (set-window-dedicated-p (selected-window) t))))))
-
-(defun gdb-set-header (buffer)
-  (cond ((eq buffer 'gdb-locals-buffer)
-        (list
-         (gdb-propertize-header "Locals" gdb-locals-buffer
-                                nil nil mode-line)
-         " "
-         (gdb-propertize-header "Registers" gdb-registers-buffer
-                                "mouse-1: select" mode-line-highlight 
mode-line-inactive)))
-       ((eq buffer 'gdb-registers-buffer)
-        (list
-         (gdb-propertize-header "Locals" gdb-locals-buffer
-                                "mouse-1: select" mode-line-highlight 
mode-line-inactive)
-         " "
-         (gdb-propertize-header "Registers" gdb-registers-buffer
-                                nil nil mode-line)))
-       ((eq buffer 'gdb-breakpoints-buffer)
-        (list
-         (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer
-                                nil nil mode-line)
-         " "
-         (gdb-propertize-header "Threads" gdb-threads-buffer
-                                "mouse-1: select" mode-line-highlight 
mode-line-inactive)))
-       ((eq buffer 'gdb-threads-buffer)
-        (list
-         (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer
-                                "mouse-1: select" mode-line-highlight 
mode-line-inactive)
-         " "
-         (gdb-propertize-header "Threads" gdb-threads-buffer
-                                nil nil mode-line)))))
-
 
 ;; uses "-thread-info". Needs GDB 7.0 onwards.
 ;;; Threads view
@@ -2280,6 +2275,23 @@
     (define-key map "s" 'gdb-step-thread)
     map))
 
+(defmacro gdb-propertize-header (name buffer help-echo mouse-face face)
+  `(propertize ,name
+              'help-echo ,help-echo 
+              'mouse-face ',mouse-face
+              'face ',face
+              'local-map
+              (gdb-make-header-line-mouse-map
+               'mouse-1
+               (lambda (event) (interactive "e")
+                 (save-selected-window
+                   (select-window (posn-window (event-start event)))
+                   (set-window-dedicated-p (selected-window) nil)
+                   (switch-to-buffer
+                    (gdb-get-buffer-create ',buffer))
+                   (setq header-line-format(gdb-set-header ',buffer))
+                   (set-window-dedicated-p (selected-window) t))))))
+
 (defvar gdb-breakpoints-header
   (list
    (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer
@@ -2443,6 +2455,36 @@
   "-exec-step"
   "Step thread at current line.")
 
+(defun gdb-set-header (buffer)
+  (cond ((eq buffer 'gdb-locals-buffer)
+        (list
+         (gdb-propertize-header "Locals" gdb-locals-buffer
+                                nil nil mode-line)
+         " "
+         (gdb-propertize-header "Registers" gdb-registers-buffer
+                                "mouse-1: select" mode-line-highlight 
mode-line-inactive)))
+       ((eq buffer 'gdb-registers-buffer)
+        (list
+         (gdb-propertize-header "Locals" gdb-locals-buffer
+                                "mouse-1: select" mode-line-highlight 
mode-line-inactive)
+         " "
+         (gdb-propertize-header "Registers" gdb-registers-buffer
+                                nil nil mode-line)))
+       ((eq buffer 'gdb-breakpoints-buffer)
+        (list
+         (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer
+                                nil nil mode-line)
+         " "
+         (gdb-propertize-header "Threads" gdb-threads-buffer
+                                "mouse-1: select" mode-line-highlight 
mode-line-inactive)))
+       ((eq buffer 'gdb-threads-buffer)
+        (list
+         (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer
+                                "mouse-1: select" mode-line-highlight 
mode-line-inactive)
+         " "
+         (gdb-propertize-header "Threads" gdb-threads-buffer
+                                nil nil mode-line)))))
+
 
 ;;; Memory view
 
@@ -2851,7 +2893,7 @@
 
 (def-gdb-auto-update-trigger gdb-invalidate-disassembly
   (let* ((frame (gdb-current-buffer-frame))
-         (file (gdb-get-field frame 'file))
+         (file (gdb-get-field frame 'fullname))
          (line (gdb-get-field frame 'line)))
     (when file
       (format "-data-disassemble -f %s -l %s -n -1 -- 0" file line)))
@@ -3375,6 +3417,12 @@
 
 ;;;; Window management
 (defun gdb-display-buffer (buf dedicated &optional frame)
+  "Show buffer BUF.
+
+If BUF is already displayed in some window, show it, deiconifying
+the frame if necessary. Otherwise, find least recently used
+window and show BUF there, if the window is not used for GDB
+already, in which case that window is splitted first."
   (let ((answer (get-buffer-window buf (or frame 0))))
     (if answer
        (display-buffer buf nil (or frame 0)) ;Deiconify the frame if necessary.
@@ -3426,8 +3474,7 @@
   (define-key menu [breakpoints]
     '("Breakpoints" . gdb-frame-breakpoints-buffer)))
 
-(let ((menu (make-sparse-keymap "GDB-MI"))
-      (submenu (make-sparse-keymap "GUD thread control mode")))
+(let ((menu (make-sparse-keymap "GDB-MI")))
   (define-key menu [gdb-customize]
   '(menu-item "Customize" (lambda () (interactive) (customize-group 'gdb))
              :help "Customize Gdb Graphical Mode options."))
@@ -3440,34 +3487,34 @@
              :help "Restore standard layout for debug session."))
   (define-key menu [sep1]
     '(menu-item "--"))
-  (define-key submenu [all-threads]
-    '(menu-item "All threads"
+  (define-key menu [all-threads]
+    '(menu-item "GUD controls all threads"
                 (lambda ()
                   (interactive)
                   (setq gdb-gud-control-all-threads t))
                 :help "GUD start/stop commands apply to all threads"
                 :button (:radio . gdb-gud-control-all-threads)))
-  (define-key submenu [current-thread]
-    '(menu-item "Current thread"
+  (define-key menu [current-thread]
+    '(menu-item "GUD controls current thread"
                 (lambda ()
                   (interactive)
                   (setq gdb-gud-control-all-threads nil))
                 :help "GUD start/stop commands apply to current thread only"
                 :button (:radio . (not gdb-gud-control-all-threads))))
-  (define-key menu [thread-control]
-      `("GUD thread control mode" . ,submenu))
-  (define-key gud-menu-map [mi]
-    `(menu-item "GDB-MI" ,menu :visible (eq gud-minor-mode 'gdbmi)))
+  (define-key menu [sep2]
+    '(menu-item "--"))
+  (define-key menu [gdb-customize-reasons]
+    '(menu-item "Customize switching..."
+                (lambda ()
+                  (interactive)
+                  (customize-option 'gdb-switch-reasons))))
   (define-key menu [gdb-switch-when-another-stopped]
     (menu-bar-make-toggle gdb-toggle-switch-when-another-stopped 
gdb-switch-when-another-stopped
                           "Automatically switch to stopped thread"
                           "GDB thread switching %s"
                           "Switch to stopped thread"))
-  (define-key menu [gdb-non-stop]
-    (menu-bar-make-toggle gdb-toggle-non-stop gdb-non-stop
-                          "Non-stop mode"
-                          "GDB non-stop mode %s"
-                          "Allow examining stopped threads while others 
continue to execute")))
+  (define-key gud-menu-map [mi]
+    `(menu-item "GDB-MI" ,menu :visible (eq gud-minor-mode 'gdbmi))))
 
 (defun gdb-frame-gdb-buffer ()
   "Display GUD buffer in a new frame."