aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDmitry Dzhus2009-07-07 17:04:51 +0000
committerDmitry Dzhus2009-07-07 17:04:51 +0000
commit28d67a53c593aedadae730262b84366c4bb76b56 (patch)
treeb07392c4633b693169dbf2d2abaada81c512e9eb
parent0996385d0a6cdedaed38bd53f5710f278ecef288 (diff)
downloademacs-28d67a53c593aedadae730262b84366c4bb76b56.tar.gz
emacs-28d67a53c593aedadae730262b84366c4bb76b56.zip
gdb-mi.el: Now using bindat-get-field instead of fadr functions.
-rw-r--r--lisp/ChangeLog1
-rw-r--r--lisp/progmodes/gdb-mi.el68
2 files changed, 41 insertions, 28 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index ec3b9304d37..60dd6ac29a6 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -19,6 +19,7 @@
19 unit size used in memory buffer. 19 unit size used in memory buffer.
20 (gdb-memory-show-next-page, gdb-memory-show-previous-page): Switch 20 (gdb-memory-show-next-page, gdb-memory-show-previous-page): Switch
21 to next/previous page of memory buffer. 21 to next/previous page of memory buffer.
22 Now using (bindat-get-field) instead of fadr functions.
22 23
232009-07-07 Sam Steingold <sds@gnu.org> 242009-07-07 Sam Steingold <sds@gnu.org>
24 25
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 57c3485b849..1b68aca74ef 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -99,7 +99,7 @@
99 99
100(require 'gud) 100(require 'gud)
101(require 'json) 101(require 'json)
102(require 'fadr) 102(require 'bindat)
103 103
104(defvar tool-bar-map) 104(defvar tool-bar-map)
105(defvar speedbar-initial-expansion-list-name) 105(defvar speedbar-initial-expansion-list-name)
@@ -1459,6 +1459,14 @@ are not guaranteed."
1459 (let ((json-array-type 'list)) 1459 (let ((json-array-type 'list))
1460 (json-read)))) 1460 (json-read))))
1461 1461
1462(defalias 'gdb-get-field 'bindat-get-field)
1463
1464(defun gdb-get-many-fields (struct &rest fields)
1465 "Return a list of FIELDS values from STRUCT."
1466 (let ((values))
1467 (dolist (field fields values)
1468 (setq values (append values (list (gdb-get-field struct field)))))))
1469
1462;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed. 1470;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed.
1463;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the 1471;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the
1464;; current input. 1472;; current input.
@@ -1854,18 +1862,20 @@ FILE is a full path."
1854 1862
1855(defun gdb-thread-list-handler-custom () 1863(defun gdb-thread-list-handler-custom ()
1856 (let* ((res (json-partial-output)) 1864 (let* ((res (json-partial-output))
1857 (threads-list (fadr-q "res.threads"))) 1865 (threads-list (gdb-get-field res 'threads)))
1858 (dolist (thread threads-list) 1866 (dolist (thread threads-list)
1859 (insert (fadr-format "~.id (~.target-id) ~.state in ~.frame.func " thread)) 1867 (insert (apply 'format `("%s (%s) %s in %s "
1868 ,@(gdb-get-many-fields thread 'id 'target-id 'state)
1869 ,(gdb-get-field thread 'frame 'func))))
1860 ;; Arguments 1870 ;; Arguments
1861 (insert "(") 1871 (insert "(")
1862 (let ((args (fadr-q "thread.frame.args"))) 1872 (let ((args (gdb-get-field thread 'frame 'args)))
1863 (dolist (arg args) 1873 (dolist (arg args)
1864 (insert (fadr-format "~.name=~.value," arg))) 1874 (insert (apply 'format `("%s=%s" ,@(gdb-get-many-fields arg 'name 'value)))))
1865 (when args (kill-backward-chars 1))) 1875 (when args (kill-backward-chars 1)))
1866 (insert ")") 1876 (insert ")")
1867 (gdb-insert-frame-location (fadr-q "thread.frame")) 1877 (gdb-insert-frame-location (gdb-get-field thread 'frame))
1868 (insert (fadr-format " at ~.frame.addr\n" thread))))) 1878 (insert (format " at %s\n" (gdb-get-field thread 'frame 'addr))))))
1869 1879
1870 1880
1871;;; Memory view 1881;;; Memory view
@@ -1918,18 +1928,19 @@ FILE is a full path."
1918 1928
1919(defun gdb-read-memory-custom () 1929(defun gdb-read-memory-custom ()
1920 (let* ((res (json-partial-output)) 1930 (let* ((res (json-partial-output))
1921 (err-msg (fadr-q "res.msg"))) 1931 (err-msg (gdb-get-field res 'msg)))
1922 (if (not err-msg) 1932 (if (not err-msg)
1923 (let ((memory (fadr-q "res.memory"))) 1933 (let ((memory (gdb-get-field res 'memory)))
1924 (setq gdb-memory-address (fadr-q "res.addr")) 1934 (setq gdb-memory-address (gdb-get-field res 'addr))
1925 (setq gdb-memory-next-page (fadr-q "res.next-page")) 1935 (setq gdb-memory-next-page (gdb-get-field res 'next-page))
1926 (setq gdb-memory-prev-page (fadr-q "res.prev-page")) 1936 (setq gdb-memory-prev-page (gdb-get-field res 'prev-page))
1927 (setq gdb-memory-last-address gdb-memory-address) 1937 (setq gdb-memory-last-address gdb-memory-address)
1928 (dolist (row memory) 1938 (dolist (row memory)
1929 (insert (concat (fadr-q "row.addr") ": ")) 1939 (insert (concat (gdb-get-field row 'addr) ": "))
1930 (dolist (column (fadr-q "row.data")) 1940 (dolist (column (gdb-get-field row 'data))
1931 (insert (concat column "\t"))) 1941 (insert (concat column "\t")))
1932 (newline))) 1942 (newline)))
1943 ;; Show last page instead of empty buffer when out of bounds
1933 (progn 1944 (progn
1934 (let ((gdb-memory-address gdb-memory-last-address)) 1945 (let ((gdb-memory-address gdb-memory-last-address))
1935 (gdb-invalidate-memory) 1946 (gdb-invalidate-memory)
@@ -2319,9 +2330,10 @@ corresponding to the mode line clicked."
2319 2330
2320(defun gdb-disassembly-handler-custom () 2331(defun gdb-disassembly-handler-custom ()
2321 (let* ((res (json-partial-output)) 2332 (let* ((res (json-partial-output))
2322 (instructions (fadr-member res ".asm_insns"))) 2333 (instructions (gdb-get-field res 'asm_insns)))
2323 (dolist (instr instructions) 2334 (dolist (instr instructions)
2324 (insert (fadr-format "~.address <~.func-name+~.offset>:\t~.inst\n" instr))))) 2335 (insert (apply 'format `("%s <%s+%s>:\t%s\n"
2336 ,@(gdb-get-many-fields instr 'address 'func-name 'offset 'inst)))))))
2325 2337
2326 2338
2327;;; Breakpoints view 2339;;; Breakpoints view
@@ -2436,9 +2448,9 @@ corresponding to the mode line clicked."
2436 2448
2437(defun gdb-insert-frame-location (frame) 2449(defun gdb-insert-frame-location (frame)
2438 "Insert \"file:line\" button or library name for FRAME object." 2450 "Insert \"file:line\" button or library name for FRAME object."
2439 (let ((file (fadr-q "frame.fullname")) 2451 (let ((file (gdb-get-field frame 'fullname))
2440 (line (fadr-q "frame.line")) 2452 (line (gdb-get-field frame 'line))
2441 (from (fadr-q "frame.from"))) 2453 (from (gdb-get-field frame 'from)))
2442 (cond (file 2454 (cond (file
2443 ;; Filename with line number 2455 ;; Filename with line number
2444 (insert " of ") 2456 (insert " of ")
@@ -2452,14 +2464,14 @@ corresponding to the mode line clicked."
2452 gdb-pending-triggers)) 2464 gdb-pending-triggers))
2453 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) 2465 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
2454 (let* ((res (json-partial-output "frame")) 2466 (let* ((res (json-partial-output "frame"))
2455 (stack (fadr-q "res.stack")) 2467 (stack (gdb-get-field res 'stack))
2456 (buf (gdb-get-buffer 'gdb-stack-buffer))) 2468 (buf (gdb-get-buffer 'gdb-stack-buffer)))
2457 (and buf 2469 (and buf
2458 (with-current-buffer buf 2470 (with-current-buffer buf
2459 (let ((buffer-read-only nil)) 2471 (let ((buffer-read-only nil))
2460 (erase-buffer) 2472 (erase-buffer)
2461 (dolist (frame (nreverse stack)) 2473 (dolist (frame (nreverse stack))
2462 (insert (fadr-expand "~.level in ~.func" frame)) 2474 (insert (apply 'format `("%s in %s" ,@(gdb-get-many-fields frame 'level 'func))))
2463 (gdb-insert-frame-location frame) 2475 (gdb-insert-frame-location frame)
2464 (newline)) 2476 (newline))
2465 (gdb-stack-list-frames-custom))))))) 2477 (gdb-stack-list-frames-custom)))))))
@@ -2846,13 +2858,13 @@ is set in them."
2846(defun gdb-frame-handler () 2858(defun gdb-frame-handler ()
2847 (setq gdb-pending-triggers 2859 (setq gdb-pending-triggers
2848 (delq 'gdb-get-selected-frame gdb-pending-triggers)) 2860 (delq 'gdb-get-selected-frame gdb-pending-triggers))
2849 (let ((frame (fadr-member (json-partial-output) ".frame"))) 2861 (let ((frame (gdb-get-field (json-partial-output) 'frame)))
2850 (when frame 2862 (when frame
2851 (setq gdb-frame-number (fadr-q "frame.level")) 2863 (setq gdb-frame-number (gdb-get-field frame 'level))
2852 (setq gdb-pc-address (fadr-q "frame.addr")) 2864 (setq gdb-pc-address (gdb-get-field frame addr))
2853 (setq gdb-selected-frame (fadr-q "frame.func")) 2865 (setq gdb-selected-frame (gdb-get-field frame 'func))
2854 (setq gdb-selected-file (fadr-q "frame.fullname")) 2866 (setq gdb-selected-file (gdb-get-field frame 'fullname))
2855 (let ((line (fadr-q "frame.line"))) 2867 (let ((line (gdb-get-field frame 'line)))
2856 (setq gdb-selected-line (or (and line (string-to-number line)) 2868 (setq gdb-selected-line (or (and line (string-to-number line))
2857 nil)) ; don't fail if line is nil 2869 nil)) ; don't fail if line is nil
2858 (when line ; obey the current file only if we have line info 2870 (when line ; obey the current file only if we have line info