[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 13:27:24

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

Log message:
        (gdb-add-pending, gdb-pending-p, gdb-delete-pending): Macros to
        handle pending triggers.
        (gdb-threads-mode-map, def-gdb-thread-buffer-command)
        (def-gdb-thread-buffer-simple-command)
        (gdb-display-stack-for-thread, gdb-display-locals-for-thread)
        (gdb-display-registers-for-thread, gdb-frame-stack-for-thread)
        (gdb-frame-locals-for-thread, gdb-frame-registers-for-thread): New
        commands which show buffers bound to thread.
        (gdb-stack-list-locals-regexp): Removed unused regexp.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/ChangeLog?cvsroot=emacs&r1=1.15888&r2=1.15889
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/progmodes/gdb-mi.el?cvsroot=emacs&r1=1.20&r2=1.21

Patches:
Index: ChangeLog
===================================================================
RCS file: /sources/emacs/emacs/lisp/ChangeLog,v
retrieving revision 1.15888
retrieving revision 1.15889
diff -u -b -r1.15888 -r1.15889
--- ChangeLog   4 Aug 2009 13:19:02 -0000       1.15888
+++ ChangeLog   4 Aug 2009 13:27:21 -0000       1.15889
@@ -26,6 +26,15 @@
        (def-gdb-trigger-and-handler): New macro to define trigger-handler
        pair for GDB buffer.
        (gdb-stack-buffer-name): Add thread information.
+       (gdb-add-pending, gdb-pending-p, gdb-delete-pending): Macros to
+       handle pending triggers.
+       (gdb-threads-mode-map, def-gdb-thread-buffer-command)
+       (def-gdb-thread-buffer-simple-command)
+       (gdb-display-stack-for-thread, gdb-display-locals-for-thread)
+       (gdb-display-registers-for-thread, gdb-frame-stack-for-thread)
+       (gdb-frame-locals-for-thread, gdb-frame-registers-for-thread): New
+       commands which show buffers bound to thread.
+       (gdb-stack-list-locals-regexp): Removed unused regexp.
 
 2009-08-04  Michael Albinus  <address@hidden>
 

Index: progmodes/gdb-mi.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/progmodes/gdb-mi.el,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -b -r1.20 -r1.21
--- progmodes/gdb-mi.el 4 Aug 2009 13:19:05 -0000       1.20
+++ progmodes/gdb-mi.el 4 Aug 2009 13:27:24 -0000       1.21
@@ -191,7 +191,17 @@
               gdb mode sends to gdb on its own behalf.")
 
 (defvar gdb-pending-triggers '()
-  "A list of trigger functions that have run later than their output 
handlers.")
+  "A list of trigger functions which have not yet been handled.
+
+Elements are either function names or pairs (buffer . function)")
+
+(defmacro gdb-add-pending (item)
+  `(push ,item gdb-pending-triggers))
+(defmacro gdb-pending-p (item)
+  `(member ,item gdb-pending-triggers))
+(defmacro gdb-delete-pending (item)
+  `(setq gdb-pending-triggers
+         (delete ,item gdb-pending-triggers)))
 
 (defcustom gdb-debug-log-max 128
   "Maximum size of `gdb-debug-log'.  If nil, size is unlimited."
@@ -724,17 +734,16 @@
 
 (defun gdb-speedbar-update ()
   (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)
-            (not (member 'gdb-speedbar-timer gdb-pending-triggers)))
+            (not (gdb-pending-p 'gdb-speedbar-timer)))
     ;; Dummy command to update speedbar even when idle.
     (gdb-input (list "-environment-pwd" 'gdb-speedbar-timer-fn))
     ;; Keep gdb-pending-triggers non-nil till end.
-    (push 'gdb-speedbar-timer gdb-pending-triggers)))
+    (gdb-add-pending 'gdb-speedbar-timer)))
 
 (defun gdb-speedbar-timer-fn ()
   (if gdb-speedbar-auto-raise
       (raise-frame speedbar-frame))
-  (setq gdb-pending-triggers
-       (delq 'gdb-speedbar-timer gdb-pending-triggers))
+  (gdb-delete-pending 'gdb-speedbar-timer)
   (speedbar-timer-fn))
 
 (defun gdb-var-evaluate-expression-handler (varnum changed)
@@ -831,10 +840,10 @@
 
 ; Uses "-var-update --all-values".  Needs GDB 6.4 onwards.
 (defun gdb-var-update ()
-  (if (not (member 'gdb-var-update gdb-pending-triggers))
+  (if (not (gdb-pending-p 'gdb-var-update))
       (gdb-input
        (list "-var-update --all-values *" 'gdb-var-update-handler)))
-  (push 'gdb-var-update gdb-pending-triggers))
+  (gdb-add-pending 'gdb-var-update))
 
 (defconst gdb-var-update-regexp
   "{.*?name=\"\\(.*?\\)\".*?,\\(?:value=\\(\".*?\"\\),\\)?.*?\
@@ -859,8 +868,7 @@
                         (read (match-string 2))))
                ((string-equal match "invalid")
                 (gdb-var-delete-1 varnum)))))))
-  (setq gdb-pending-triggers
-   (delq 'gdb-var-update gdb-pending-triggers))
+  (gdb-delete-pending 'gdb-var-update)
   (gdb-speedbar-update))
 
 (defun gdb-speedbar-expand-node (text token indent)
@@ -916,13 +924,15 @@
   "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."
+`gdb-thread-number' (if provided) must be equal to THREAD.
+
+When THREAD is nil, global `gdb-thread-number' value is used."
+  (when (not thread) (setq thread gdb-thread-number))
   (catch 'found
     (dolist (buffer (buffer-list) nil)
       (with-current-buffer buffer
         (when (and (eq gdb-buffer-type key)
-                   (or (not thread)
-                       (equal gdb-thread-number thread)))
+                   (equal gdb-thread-number thread))
           (throw 'found buffer))))))
 
 (defun gdb-get-buffer-create (key &optional thread)
@@ -1222,12 +1232,20 @@
   (process-send-string (get-buffer-process gud-comint-buffer)
                       (concat (car item) "\n")))
 
-(defmacro gdb-current-context-command (command)
+(defun gdb-current-context-command (command)
   "Add --thread option to gdb COMMAND.
 
 Option value is taken from `gdb-thread-number'."
   (concat command " --thread " gdb-thread-number))
 
+(defun gdb-current-context-buffer-name (name)
+  "Add thread information and asterisks to string NAME."
+  (concat "*" name
+          (if (local-variable-p 'gdb-thread-number) 
+              " (bound to thread "
+            " (current thread ")
+          gdb-thread-number ")*"))
+
 
 (defcustom gud-gdb-command-name "gdb -i=mi"
   "Default command to execute an executable under the GDB debugger."
@@ -1567,13 +1585,13 @@
 (defmacro def-gdb-auto-update-trigger (trigger-name gdb-command
                                                     handler-name)
   `(defun ,trigger-name (&optional signal)
-     (if (not (member (cons (current-buffer) ',trigger-name)
-                      gdb-pending-triggers))
+     (if (not (gdb-pending-p
+               (cons (current-buffer) ',trigger-name)))
          (progn
            (gdb-input
             (list ,gdb-command
                   (gdb-bind-function-to-buffer ',handler-name 
(current-buffer))))
-           (push (cons (current-buffer) ',trigger-name) 
gdb-pending-triggers)))))
+           (gdb-add-pending (cons (current-buffer) ',trigger-name))))))
 
 ;; Used by disassembly buffer only, the rest use
 ;; def-gdb-trigger-and-handler
@@ -1583,9 +1601,7 @@
 Delete ((current-buffer) . TRIGGER) from `gdb-pending-triggers',
 erase current buffer and evaluate CUSTOM-DEFUN."
   `(defun ,handler-name ()
-     (setq gdb-pending-triggers
-           (delq (cons (current-buffer) ',trigger-name)
-                 gdb-pending-triggers))
+     (gdb-delete-pending (cons (current-buffer) ',trigger-name))
      (let* ((buffer-read-only nil))
        (erase-buffer)
        (,custom-defun)
@@ -1619,8 +1635,6 @@
  'gdb-invalidate-breakpoints)
 
 (defun gdb-breakpoints-list-handler-custom ()
-  (setq gdb-pending-triggers (delq 'gdb-invalidate-breakpoints
-                                 gdb-pending-triggers))
   (let ((breakpoints-list (gdb-get-field 
                            (json-partial-output "bkpt" "script")
                            'BreakpointTable 'body)))
@@ -1946,6 +1960,12 @@
 (defvar gdb-threads-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map " " 'gdb-select-thread)
+    (define-key map "s" 'gdb-display-stack-for-thread)
+    (define-key map "S" 'gdb-frame-stack-for-thread)
+    (define-key map "l" 'gdb-display-locals-for-thread)
+    (define-key map "L" 'gdb-frame-locals-for-thread)
+    (define-key map "r" 'gdb-display-registers-for-thread)
+    (define-key map "R" 'gdb-frame-registers-for-thread)
     map))
 
 (defvar gdb-breakpoints-header
@@ -2005,19 +2025,69 @@
         (set-marker gdb-thread-position (line-beginning-position)))
       (newline))))
 
-(defun gdb-select-thread ()
-  "Select the thread at current line of threads buffer."
+(defmacro def-gdb-thread-buffer-command (name custom-defun &optional doc)
+  "Define a NAME command which will act upon thread on the current line.
+
+CUSTOM-DEFUN may use locally bound `thread' variable, which will
+be the value of 'gdb-thread propery of the current line. If
+'gdb-thread is nil, error is signaled."
+  `(defun ,name ()
+     ,(when doc doc)
   (interactive)
   (save-excursion
   (beginning-of-line)
   (let ((thread (get-text-property (point) 'gdb-thread)))
     (if thread
+             ,custom-defun
+           (error "Not recognized as thread line"))))))
+
+(defmacro def-gdb-thread-buffer-simple-command (name buffer-command &optional 
doc)
+  "Define a NAME which will call BUFFER-COMMAND with id of thread
+on the current line."
+  `(def-gdb-thread-buffer-command ,name
+     (,buffer-command (gdb-get-field thread 'id))
+     ,doc))
+
+(def-gdb-thread-buffer-command gdb-select-thread
         (if (string-equal (gdb-get-field thread 'state) "running")
             (error "Cannot select running thread")
           (let ((new-id (gdb-get-field thread 'id)))
             (setq gdb-thread-number new-id)
             (gud-basic-call (concat "-thread-select " new-id))))
-      (error "Not recognized as thread line")))))
+  "Select the thread at current line of threads buffer.")
+
+(def-gdb-thread-simple-buffer-command
+  gdb-display-stack-for-thread
+  gdb-display-stack-buffer
+  "Display stack buffer for the thread at current line.")
+
+(def-gdb-thread-simple-buffer-command
+  gdb-display-locals-for-thread
+  gdb-display-locals-buffer
+  "Display locals buffer for the thread at current line.")
+
+(def-gdb-thread-simple-buffer-command
+  gdb-display-registers-for-thread
+  gdb-display-registers-buffer
+  "Display registers buffer for the thread at current line.")
+
+(def-gdb-thread-simple-buffer-command
+  gdb-frame-stack-for-thread
+  gdb-frame-stack-buffer
+  "Display a new frame with stack buffer for the thread at
+current line.")
+
+(def-gdb-thread-simple-buffer-command
+  gdb-frame-locals-for-thread
+  gdb-frame-locals-buffer
+  "Display a new frame with locals buffer for the thread at
+current line.")
+
+(def-gdb-thread-simple-buffer-command
+  gdb-frame-registers-for-thread
+  gdb-frame-registers-buffer
+  "Display a new frame with registers buffer for the thread at
+current line.")
 
 
 ;;; Memory view
@@ -2654,7 +2724,8 @@
              (forward-line 1)))))
 
 (defun gdb-stack-buffer-name ()
-  (concat "*stack frames of " (gdb-get-target-string) " (thread " 
gdb-thread-number ")*"))
+  (gdb-current-context-buffer-name
+   (concat "stack frames of " (gdb-get-target-string))))
 
 (def-gdb-display-buffer
  gdb-display-stack-buffer
@@ -2724,9 +2795,6 @@
  'gdb-locals-mode
  'gdb-invalidate-locals)
 
-(defconst gdb-stack-list-locals-regexp
-  (concat "name=\"\\(.*?\\)\",type=\"\\(.*?\\)\""))
-
 (defvar gdb-locals-watch-map
   (let ((map (make-sparse-keymap)))
     (suppress-keymap map)
@@ -2809,7 +2877,8 @@
   'gdb-invalidate-locals)
 
 (defun gdb-locals-buffer-name ()
-  (concat "*locals of " (gdb-get-target-string) "*"))
+  (gdb-current-context-buffer-name
+   (concat "locals of " (gdb-get-target-string))))
 
 (def-gdb-display-buffer
  gdb-display-locals-buffer
@@ -2874,7 +2943,8 @@
   'gdb-invalidate-registers)
 
 (defun gdb-registers-buffer-name ()
-  (concat "*registers of " (gdb-get-target-string) "*"))
+  (gdb-current-context-buffer-name
+   (concat "registers of " (gdb-get-target-string))))
 
 (def-gdb-display-buffer
  gdb-display-registers-buffer
@@ -2889,17 +2959,16 @@
 ;; Needs GDB 6.4 onwards (used to fail with no stack).
 (defun gdb-get-changed-registers ()
   (if (and (gdb-get-buffer 'gdb-registers-buffer)
-          (not (member 'gdb-get-changed-registers gdb-pending-triggers)))
+          (not (gdb-pending-p 'gdb-get-changed-registers)))
       (progn
        (gdb-input
         (list
          "-data-list-changed-registers"
          'gdb-changed-registers-handler))
-       (push 'gdb-get-changed-registers gdb-pending-triggers))))
+       (gdb-add-pending 'gdb-get-changed-registers))))
 
 (defun gdb-changed-registers-handler ()
-  (setq gdb-pending-triggers
-        (delq 'gdb-get-changed-registers gdb-pending-triggers))
+  (gdb-delete-pending 'gdb-get-changed-registers)
   (setq gdb-changed-registers nil)
   (dolist (register-number (gdb-get-field (json-partial-output) 
'changed-registers))
     (push register-number gdb-changed-registers)))
@@ -2928,7 +2997,7 @@
    (propertize "ready" 'face font-lock-variable-name-face)))
 
 (defun gdb-get-selected-frame ()
-  (if (not (member 'gdb-get-selected-frame gdb-pending-triggers))
+  (if (not (gdb-pending-p 'gdb-get-selected-frame))
       (progn
        (gdb-input
         (list (gdb-current-context-command "-stack-info-frame") 
'gdb-frame-handler))
@@ -2936,8 +3005,7 @@
               gdb-pending-triggers))))
 
 (defun gdb-frame-handler ()
-  (setq gdb-pending-triggers
-       (delq 'gdb-get-selected-frame gdb-pending-triggers))
+  (gdb-delete-pending 'gdb-get-selected-frame)
   (let ((frame (gdb-get-field (json-partial-output) 'frame)))
     (when frame
       (setq gdb-frame-number (gdb-get-field frame 'level))