diff options
| author | Dmitry Dzhus | 2009-07-07 17:04:51 +0000 |
|---|---|---|
| committer | Dmitry Dzhus | 2009-07-07 17:04:51 +0000 |
| commit | 28d67a53c593aedadae730262b84366c4bb76b56 (patch) | |
| tree | b07392c4633b693169dbf2d2abaada81c512e9eb | |
| parent | 0996385d0a6cdedaed38bd53f5710f278ecef288 (diff) | |
| download | emacs-28d67a53c593aedadae730262b84366c4bb76b56.tar.gz emacs-28d67a53c593aedadae730262b84366c4bb76b56.zip | |
gdb-mi.el: Now using bindat-get-field instead of fadr functions.
| -rw-r--r-- | lisp/ChangeLog | 1 | ||||
| -rw-r--r-- | lisp/progmodes/gdb-mi.el | 68 |
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 | ||
| 23 | 2009-07-07 Sam Steingold <sds@gnu.org> | 24 | 2009-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 |