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

[Nick Roberts]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Nick Roberts <nickrob>  09/06/22 10:57:52

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

Log message:
        Pull further  modified changes from Dmitry's repository 
(http://sphinx.net.ru/hg/gdb-mi/).

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/progmodes/gdb-mi.el?cvsroot=emacs&r1=1.1&r2=1.2

Patches:
Index: gdb-mi.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/progmodes/gdb-mi.el,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -b -r1.1 -r1.2
--- gdb-mi.el   21 Jun 2009 12:08:53 -0000      1.1
+++ gdb-mi.el   22 Jun 2009 10:57:52 -0000      1.2
@@ -919,7 +919,7 @@
 
 ;; Used to define all gdb-frame-*-buffer functions except
 ;; `gdb-frame-separate-io-buffer'
-(defmacro gdb-def-frame-for-buffer (name buffer &optional doc)
+(defmacro def-gdb-frame-for-buffer (name buffer &optional doc)
   "Define a function NAME which shows gdb BUFFER in a separate frame.
 
 DOC is an optional documentation string."
@@ -930,14 +930,15 @@
            (special-display-frame-alist gdb-frame-parameters))
        (display-buffer (gdb-get-buffer-create ,buffer)))))
 
-(defmacro gdb-def-display-buffer (name buffer &optional doc)
+(defmacro def-gdb-display-buffer (name buffer &optional doc)
   "Define a function NAME which shows gdb BUFFER.
 
 DOC is an optional documentation string."
   `(defun ,name ()
+     ,(when doc doc)
      (interactive)
      (gdb-display-buffer
-      (gdb-get-buffer-create ,name) t)))
+      (gdb-get-buffer-create ,buffer) t)))
 
 ;;
 ;; This assoc maps buffer type symbols to rules.  Each rule is a list of
@@ -1278,8 +1279,8 @@
 
     (dolist (output-record output-record-list)
       (let ((record-type (cadr output-record))
-           (arg1 (caddr output-record))
-           (arg2 (cadddr output-record)))
+           (arg1 (nth 2 output-record))
+           (arg2 (nth 3 output-record)))
        (if (eq record-type 'gdb-error)
            (gdb-done-or-error arg2 arg1 'error)
          (if (eq record-type 'gdb-done)
@@ -1466,6 +1467,11 @@
           (push ',name gdb-pending-triggers)))))
 
 (defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun)
+  "Define a handler NAME for TRIGGER acting in BUF-KEY with CUSTOM-DEFUN.
+
+Delete TRIGGER from `gdb-pending-triggers', switch to gdb BUF-KEY
+buffer using `gdb-get-buffer', erase it and evalueat
+CUSTOM-DEFUN."
   `(defun ,name ()
      (setq gdb-pending-triggers
       (delq ',trigger
@@ -1478,12 +1484,28 @@
                     (p (window-point window))
                    (buffer-read-only nil))
                (erase-buffer)
-               (insert-buffer-substring (gdb-get-buffer-create
-                                         'gdb-partial-output-buffer))
                (set-window-start window start)
-               (set-window-point window p)))))
-     ;; put customisation here
-     (,custom-defun)))
+               (set-window-point window p)
+                (,custom-defun)))))))
+
+(defmacro def-gdb-auto-updated-buffer (buf-key
+                                      trigger-name gdb-command
+                                      output-handler-name custom-defun)
+  "Define a trigger and its handler for buffers of type BUF-KEY.
+
+TRIGGER-NAME trigger is defined to send GDB-COMMAND if BUF-KEY
+exists.
+
+OUTPUT-HANDLER-NAME handler uses customization of CUSTOM-DEFUN."
+  `(progn
+     (def-gdb-auto-update-trigger ,trigger-name
+       ;; The demand predicate:
+       (gdb-get-buffer ',buf-key)
+       ,gdb-command
+       ,output-handler-name)
+     (def-gdb-auto-update-handler ,output-handler-name
+       ,trigger-name ,buf-key ,custom-defun)))
+
 
 
 ;; Breakpoint buffer : This displays the output of `-break-list'.
@@ -1704,12 +1726,12 @@
   (with-current-buffer gud-comint-buffer
     (concat "*breakpoints of " (gdb-get-target-string) "*")))
 
-(gdb-def-display-buffer
+(def-gdb-display-buffer
  gdb-display-breakpoints-buffer
  'gdb-breakpoints-buffer
  "Display status of user-settable breakpoints.")
 
-(gdb-def-frame-for-buffer
+(def-gdb-frame-for-buffer
  gdb-frame-breakpoints-buffer
  'gdb-breakpoints-buffer
  "Display status of user-settable breakpoints in a new frame.")
@@ -1777,12 +1799,12 @@
 (defun gdb-threads-buffer-name ()
   (concat "*threads of " (gdb-get-target-string) "*"))
 
-(gdb-def-display-buffer
+(def-gdb-display-buffer
  gdb-display-threads-buffer
  'gdb-threads-buffer
  "Display GDB threads.")
 
-(gdb-def-frame-for-buffer
+(def-gdb-frame-for-buffer
  gdb-frame-threads-buffer
  'gdb-threads-buffer
  "Display GDB threads in a new frame.")
@@ -1791,10 +1813,10 @@
                       'gdb-threads-buffer-name
                       'gdb-threads-mode)
 
-(def-gdb-auto-update-trigger gdb-invalidate-threads
-  (gdb-get-buffer-create 'gdb-threads-buffer)
-  "-thread-info\n"
-  gdb-thread-list-handler)
+(def-gdb-auto-updated-buffer gdb-threads-buffer
+  gdb-invalidate-threads "-thread-info\n"
+  gdb-thread-list-handler gdb-thread-list-handler-custom)
+
 
 (defvar gdb-threads-font-lock-keywords
   '(("in \\([^ ]+\\) ("  (1 font-lock-function-name-face))
@@ -1802,6 +1824,10 @@
     ("\\(\\(\\sw\\|[_.]\\)+\\)="  (1 font-lock-variable-name-face)))
   "Font lock keywords used in `gdb-threads-mode'.")
 
+(defvar gdb-threads-mode-map
+  ;; TODO
+  (make-sparse-keymap))
+
 (defun gdb-threads-mode ()
   "Major mode for GDB threads.
 
@@ -1818,20 +1844,9 @@
   (run-mode-hooks 'gdb-threads-mode-hook)
   'gdb-invalidate-threads)
 
-(defvar gdb-threads-mode-map
-  ;; TODO
-  (make-sparse-keymap))
-
-(defun gdb-thread-list-handler ()
-  (setq gdb-pending-triggers (delq 'gdb-invalidate-threads
-                                   gdb-pending-triggers))
+(defun gdb-thread-list-handler-custom ()
   (let* ((res (json-partial-output))
-         (threads-list (fadr-q "res.threads"))
-         (buf (gdb-get-buffer 'gdb-threads-buffer)))
-    (and buf
-         (with-current-buffer buf
-           (let ((buffer-read-only nil))
-             (erase-buffer)
+         (threads-list (fadr-q "res.threads")))
              (dolist (thread threads-list)
                (insert (fadr-format "~.id (~.target-id) ~.state in 
~.frame.func " thread))
                ;; Arguments
@@ -1841,8 +1856,8 @@
                    (insert (fadr-format "~.name=~.value," arg)))
                  (when args (kill-backward-chars 1)))
                (insert ")")
-               (insert-frame-location (fadr-q "thread.frame"))
-               (insert (fadr-format " at ~.frame.addr\n" thread))))))))
+      (gdb-insert-frame-location (fadr-q "thread.frame"))
+      (insert (fadr-format " at ~.frame.addr\n" thread)))))
 
 
 ;;; Memory view
@@ -1856,12 +1871,12 @@
 (defun gdb-disassembly-buffer-name ()
   (concat "*disassembly of " (gdb-get-target-string) "*"))
 
-(gdb-def-display-buffer
+(def-gdb-display-buffer
  gdb-display-disassembly-buffer
  'gdb-disassembly-buffer
  "Display disassembly for current stack frame.")
 
-(gdb-def-frame-for-buffer
+(def-gdb-frame-for-buffer
  gdb-frame-disassembly-buffer
  'gdb-disassembly-buffer
  "Display disassembly in a new frame.")
@@ -1879,6 +1894,12 @@
       ""))
   gdb-disassembly-handler)
 
+(def-gdb-auto-update-handler
+  gdb-disassembly-handler
+  gdb-invalidate-disassembly
+  gdb-disassembly-buffer
+  gdb-disassembly-handler-custom)
+
 (defvar gdb-disassembly-font-lock-keywords
   '(;; <__function.name+n>
     ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>"
@@ -1913,22 +1934,14 @@
   (run-mode-hooks 'gdb-disassembly-mode-hook)
   'gdb-invalidate-disassembly)
 
-(defun gdb-disassembly-handler ()
-  (setq gdb-pending-triggers (delq 'gdb-invalidate-disassembly
-                                   gdb-pending-triggers))
+(defun gdb-disassembly-handler-custom ()
   (let* ((res (json-partial-output))
-         (instructions (fadr-member res ".asm_insns"))
-         (buf (gdb-get-buffer 'gdb-disassembly-buffer)))
-    (and buf
-         (with-current-buffer buf
-           (let ((buffer-read-only nil))
-             (erase-buffer)
+         (instructions (fadr-member res ".asm_insns")))
              (dolist (instr instructions)
-               (insert (fadr-format "~.address 
<~.func-name+~.offset>:\t~.inst\n" instr))))))))
+      (insert (fadr-format "~.address <~.func-name+~.offset>:\t~.inst\n" 
instr)))))
 
 
 ;;; Breakpoints view
-
 (defvar gdb-breakpoints-header
  `(,(propertize "Breakpoints"
                'help-echo "mouse-1: select"
@@ -2038,7 +2051,7 @@
   "-stack-list-frames\n"
   gdb-stack-list-frames-handler)
 
-(defun insert-frame-location (frame)
+(defun gdb-insert-frame-location (frame)
   "Insert \"file:line\" button or library name for FRAME object."
   (let ((file (fadr-q "frame.fullname"))
         (line (fadr-q "frame.line"))
@@ -2064,7 +2077,7 @@
                (erase-buffer)
                (dolist (frame (nreverse stack))
                  (insert (fadr-expand "~.level in ~.func" frame))
-                 (insert-frame-location frame)
+                 (gdb-insert-frame-location frame)
                  (newline))
                (gdb-stack-list-frames-custom)))))))
 
@@ -2095,12 +2108,12 @@
   (with-current-buffer gud-comint-buffer
     (concat "*stack frames of " (gdb-get-target-string) "*")))
 
-(gdb-def-display-buffer
+(def-gdb-display-buffer
  gdb-display-stack-buffer
  'gdb-stack-buffer
  "Display backtrace of current stack.")
 
-(gdb-def-frame-for-buffer
+(def-gdb-frame-for-buffer
  gdb-frame-stack-buffer
  'gdb-stack-buffer
  "Display backtrace of current stack in a new frame.")
@@ -2290,12 +2303,12 @@
   (with-current-buffer gud-comint-buffer
     (concat "*locals of " (gdb-get-target-string) "*")))
 
-(gdb-def-display-buffer
- gdb-display-local-buffer
+(def-gdb-display-buffer
+ gdb-display-locals-buffer
  'gdb-locals-buffer
  "Display local variables of current stack and their values.")
 
-(gdb-def-frame-for-buffer
+(def-gdb-frame-for-buffer
  gdb-frame-locals-buffer
  'gdb-locals-buffer
  "Display local variables of current stack and their values in a new frame.")
@@ -2386,12 +2399,12 @@
   (with-current-buffer gud-comint-buffer
     (concat "*registers of " (gdb-get-target-string) "*")))
 
-(gdb-def-display-buffer
+(def-gdb-display-buffer
  gdb-display-registers-buffer
  'gdb-registers-buffer
  "Display integer register contents.")
 
-(gdb-def-frame-for-buffer
+(def-gdb-frame-for-buffer
  gdb-frame-registers-buffer
  'gdb-registers-buffer
   "Display integer register contents in a new frame.")
@@ -2458,9 +2471,10 @@
       (setq gdb-selected-file (fadr-q "frame.fullname"))
       (let ((line (fadr-q "frame.line")))
         (setq gdb-selected-line (or (and line (string-to-number line))
-                                    nil))) ; don't fail if line is nil
+                                    nil)) ; don't fail if line is nil
+        (when line ; obey the current file only if we have line info
       (setq gud-last-frame (cons gdb-selected-file gdb-selected-line))
-      (gud-display-frame)
+          (gud-display-frame)))
       (if (gdb-get-buffer 'gdb-locals-buffer)
           (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer)
             (setq mode-name (concat "Locals:" gdb-selected-frame))))
@@ -2478,7 +2492,8 @@
                         '((overlay-arrow . hollow-right-triangle))))
                 (setq gud-overlay-arrow-position (make-marker))
                 (set-marker gud-overlay-arrow-position position)))))
-      (gdb-invalidate-disassembly))))
+      (when gdb-selected-line
+            (gdb-invalidate-disassembly)))))
   
 (defvar gdb-prompt-name-regexp "value=\"\\(.*?\\)\"")
 
@@ -2520,7 +2535,7 @@
 ;  (define-key menu [memory] '("Memory" . gdb-display-memory-buffer))
   (define-key menu [memory] '("Memory" . gdb-todo-memory))
   (define-key menu [disassembly]
-    '("Disassembly" . gdb-display-assembler-buffer))
+    '("Disassembly" . gdb-display-disassembly-buffer))
   (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
   (define-key menu [inferior]
     '(menu-item "Separate IO" gdb-display-separate-io-buffer
@@ -2538,7 +2553,7 @@
   (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
 ;  (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer))
   (define-key menu [memory] '("Memory" . gdb-todo-memory))
-  (define-key menu [disassembly] '("Disassembly" . gdb-frame-assembler-buffer))
+  (define-key menu [disassembly] '("Disassembly" . 
gdb-frame-disassembly-buffer))
   (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
   (define-key menu [inferior]
     '(menu-item "Separate IO" gdb-frame-separate-io-buffer