comparison lisp/progmodes/gdb-mi.el @ 103886:d9b3b49cf6d3

(json-partial-output): Fix broken GDB/MI output in -break-info command (Emacs bug #3794).

103885:adbe0e36df45

(defun gdb-clear-partial-output ()
  (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
    (erase-buffer)))

(defun json-partial-output (&optional fix-key)
  "Parse gdb-partial-output-buffer with `json-read'.

If FIX-KEY is non-nil, strip all \"FIX-KEY=\" occurences from
partial output. This is used to get rid of useless keys in lists
in MI messages, e.g.: [key=.., key=..]. -stack-list-frames and
-break-info are examples of MI commands which issue such
responses.

Note that GDB/MI output syntax is different from JSON both
cosmetically and (in some cases) structurally, so correct results
are not guaranteed."
  (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
    (goto-char (point-min))
    (while (re-search-forward (concat "[\\[,]\\(" fix-key "=\\)") nil t)
      (replace-match "" nil nil nil 1))
     (goto-char (point-min))
     (insert "{")
    ;; Wrap field names in double quotes and replace equal sign with
    ;; semicolon.
    ;; TODO: This breaks badly with foo= inside constants
    (while (re-search-forward "\\([[:alpha:]-_]+\\)=" nil t)
      (replace-match "\"\\1\":" nil nil))

(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")
                           'BreakpointTable 'body)))
    (setq gdb-breakpoints-list breakpoints-list)
    (insert "Num\tType\t\tDisp\tEnb\tHits\tAddr       What\n")
    (dolist (breakpoint breakpoints-list)
      (insert

103886:d9b3b49cf6d3

(defun gdb-clear-partial-output ()
  (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
    (erase-buffer)))

(defun json-partial-output (&optional fix-key fix-list)
  "Parse gdb-partial-output-buffer with `json-read'.

If FIX-KEY is non-nil, strip all \"FIX-KEY=\" occurences from
partial output. This is used to get rid of useless keys in lists
in MI messages, e.g.: [key=.., key=..]. -stack-list-frames and
-break-info are examples of MI commands which issue such
responses.

If FIX-LIST is non-nil, \"FIX-LIST={..}\" is replaced with
\"FIX-LIST=[..]\" prior to parsing. This is used to fix broken
-break-info output when it contains breakpoint script field
incompatible with GDB/MI output syntax.

Note that GDB/MI output syntax is different from JSON both
cosmetically and (in some cases) structurally, so correct results
are not guaranteed."
  (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
    (goto-char (point-min))
    (when fix-key
      (save-excursion
        (while (re-search-forward (concat "[\\[,]\\(" fix-key "=\\)") nil t)
          (replace-match "" nil nil nil 1))))
    (when fix-list
      (save-excursion
        ;; Find positions of brackets which enclose broken list
        (while (re-search-forward (concat fix-list "={\"") nil t)
          (let ((p1 (goto-char (- (point) 2)))
                (p2 (progn (forward-sexp)
                           (1- (point)))))
            ;; Replace braces with brackets
            (save-excursion
              (goto-char p1)
              (delete-char 1)
              (insert "[")
              (goto-char p2)
              (delete-char 1)
              (insert "]"))))))
    (goto-char (point-min))
    (insert "{")
    ;; Wrap field names in double quotes and replace equal sign with
    ;; semicolon.
    ;; TODO: This breaks badly with foo= inside constants
    (while (re-search-forward "\\([[:alpha:]-_]+\\)=" nil t)
      (replace-match "\"\\1\":" nil nil))

(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)))
    (setq gdb-breakpoints-list breakpoints-list)
    (insert "Num\tType\t\tDisp\tEnb\tHits\tAddr       What\n")
    (dolist (breakpoint breakpoints-list)
      (insert