changeset 103752:dcd3d86fcf81

* progmodes/gdb-mi.el (gdb-init-1): Disassembly buffer mode name may contain frame information, so `string-match' should be used. (gdb-update): Disassembly is invalidated through `gdb-get-selected-frame'. (gdb-pad-string): New function to pad string with spaces. (gdb-invalidate-disassembly): Invalidate only if the buffer exists. (gdb-disassembly-handler-custom): Column alignment. (gdb-disassembly-place-breakpoints): Clear old breakpoints before placing new ones. (gdb-toggle-breakpoint, gdb-delete-breakpoint): Now work from the end of line, too. (gdb-frame-handler): Match convention to for disassembly buffer mode name.

--- a/lisp/ChangeLog	Tue Jul 07 17:22:26 2009 +0000
+++ b/lisp/ChangeLog	Tue Jul 07 17:36:42 2009 +0000
@@ -1,21 +1,37 @@
 2009-07-07  Dmitry Dzhus  <[e-mail]>
 
+	* progmodes/gdb-mi.el (gdb-init-1): Disassembly buffer mode name
+	may contain frame information, so `string-match' should be used.
+	(gdb-update): Disassembly is invalidated through
+	`gdb-get-selected-frame'.
+	(gdb-pad-string): New function to pad string with spaces.
+	(gdb-invalidate-disassembly): Invalidate only if the buffer
+	exists.
+	(gdb-disassembly-handler-custom): Column alignment.
+	(gdb-disassembly-place-breakpoints): Clear old breakpoints before
+	placing new ones.
+	(gdb-toggle-breakpoint, gdb-delete-breakpoint): Now work from the
+	end of line, too.
+	(gdb-frame-handler): Match convention to for disassembly buffer
+	mode name.
+
 	* progmodes/gdb-mi.el (gdb-init-1): Set mode name for disassembly
 	buffer properly.
 	(gdb-breakpoints-list-handler-custom): Replacement for
-	gdb-break-list-handler. Using real parser instead of regexps now.
-	(gdb-place-breakpoints): Replacement for gdb-break-list-custom.
-	Use gdb-breakpoints-list instead of parsing breakpoints buffer to
-	place breakpoints.
+	`gdb-break-list-handler'. Using real parser instead of regexps
+	now.
+	(gdb-place-breakpoints): Replacement for `gdb-break-list-custom'.
+	Use `gdb-breakpoints-list' instead of parsing breakpoints buffer
+	to place breakpoints.
 	(def-gdb-memory-unit): A new macro to define gdb-memory-unit-..
 	functions.
 	(gdb-disassembly-handler-custom): Show overlay arrow.
 	(gdb-disassembly-place-breakpoints): Show breakpoints in
 	disassembly buffer.
 	(gdb-toggle-breakpoint, gdb-delete-breakpoint)
-	(gdb-goto-breakpoint): Using gdb-breakpoint text properties
-	instead of parsing breakpoints buffer.
-	Fixed old menu references in gud-menu-map.
+	(gdb-goto-breakpoint): Using `gdb-breakpoint' text properties
+	instead of parsing breakpoints buffer. Fixed old menu references
+	in `gud-menu-map'.
 
 	* fadr.el: Removed.
 

--- a/lisp/progmodes/gdb-mi.el	Tue Jul 07 17:22:26 2009 +0000
+++ b/lisp/progmodes/gdb-mi.el	Tue Jul 07 17:36:42 2009 +0000
@@ -8,6 +8,8 @@
 
 ;; This file is part of GNU Emacs.
 
+;; Homepage: http://www.emacswiki.org/emacs/GDB-MI
+
 ;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation, either version 3 of the License, or
@@ -388,7 +390,7 @@
   (run-hooks 'gdb-mode-hook))
 
 (defun gdb-init-1 ()
-  (gud-def gud-break (if (not (string-equal mode-name "Disassembly"))
+  (gud-def gud-break (if (not (string-match "Disassembly" mode-name))
 			 (gud-call "break %f:%l" arg)
 		       (save-excursion
 			 (beginning-of-line)
@@ -396,7 +398,7 @@
 			 (gud-call "break *%a" arg)))
 	   "\C-b" "Set breakpoint at current line or address.")
   ;;
-  (gud-def gud-remove (if (not (string-equal mode-name "Disassembly"))
+  (gud-def gud-remove (if (not (string-match "Disassembly" mode-name))
 			  (gud-call "clear %f:%l" arg)
 			(save-excursion
 			  (beginning-of-line)
@@ -404,7 +406,7 @@
 			  (gud-call "clear *%a" arg)))
 	   "\C-d" "Remove breakpoint at current line or address.")
   ;;
-  (gud-def gud-until  (if (not (string-equal mode-name "Disassembly"))
+  (gud-def gud-until  (if (not (string-match "Disassembly" mode-name))
 			  (gud-call "-exec-until %f:%l" arg)
 			(save-excursion
 			  (beginning-of-line)
@@ -1220,7 +1222,6 @@
   (gdb-get-changed-registers)
   (gdb-invalidate-registers)
   (gdb-invalidate-locals)
-  (gdb-invalidate-disassembly)
   (gdb-invalidate-memory)
   (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
     (dolist (var gdb-var-list)
@@ -1466,6 +1467,9 @@
     (let ((json-array-type 'list))
       (json-read))))
 
+(defun gdb-pad-string (string padding)
+  (format (concat "%" (number-to-string padding) "s") string))
+
 (defalias 'gdb-get-field 'bindat-get-field)
 
 (defun gdb-get-many-fields (struct &rest fields)
@@ -1502,13 +1506,8 @@
      (let ((buf (gdb-get-buffer ',buf-key)))
        (and buf
 	    (with-current-buffer buf
-	      (let* ((window (get-buffer-window buf 0))
-		     (start (window-start window))
-		     (p (window-point window))
-                     (buffer-read-only nil))
+	      (let*((buffer-read-only nil))
 		(erase-buffer)
-		(set-window-start window start)
-		(set-window-point window p)
                 (,custom-defun)))))))
 
 (defmacro def-gdb-auto-updated-buffer (buf-key
@@ -1569,7 +1568,7 @@
                           (propertize (gdb-get-field breakpoint 'func)
                                       'face font-lock-function-name-face)))
                  (gdb-insert-frame-location breakpoint)))
-              (at (insert at))
+              (at (insert (concat " " at)))
               (t (insert (gdb-get-field breakpoint 'original-location)))))
       (add-text-properties (line-beginning-position)
                            (line-end-position)
@@ -1903,6 +1902,26 @@
   gdb-read-memory-handler
   gdb-read-memory-custom)
 
+(defun gdb-memory-column-width (size format)
+  "Return length of string with memory unit of SIZE in FORMAT.
+
+SIZE is in bytes, as in `gdb-memory-unit'. FORMAT is a string as
+in `gdb-memory-format'."
+  (let ((format-base (cdr (assoc format
+                                 '(("x" . 16)
+                                   ("d" . 10) ("u" . 10)
+                                   ("o" . 8)
+                                   ("t" . 2))))))
+    (if format-base
+        (let ((res (ceiling (log (expt 2.0 (* size 8)) format-base))))
+          (cond ((string-equal format "x")
+                 (+ 2 res)) ; hexadecimal numbers have 0x in front
+                ((or (string-equal format "d")
+                     (string-equal format "o"))
+                 (1+ res))
+                (t res)))
+      (error "Unknown format"))))
+
 (defun gdb-read-memory-custom ()
   (let* ((res (json-partial-output))
          (err-msg (gdb-get-field res 'msg)))
@@ -1913,9 +1932,12 @@
           (setq gdb-memory-prev-page (gdb-get-field res 'prev-page))
           (setq gdb-memory-last-address gdb-memory-address)
         (dolist (row memory)
-          (insert (concat (gdb-get-field row 'addr) ": "))
+          (insert (concat (gdb-get-field row 'addr) ":"))
           (dolist (column (gdb-get-field row 'data))
-            (insert (concat column "\t")))
+            (insert (gdb-pad-string column
+                                    (+ 2 (gdb-memory-column-width
+                                          gdb-memory-unit
+                                          gdb-memory-format)))))
           (newline)))
       ;; Show last page instead of empty buffer when out of bounds
       (progn
@@ -2255,12 +2277,11 @@
                       'gdb-disassembly-mode)
 
 (def-gdb-auto-update-trigger gdb-invalidate-disassembly
-  (gdb-get-buffer-create 'gdb-disassembly-buffer)
+  (gdb-get-buffer 'gdb-disassembly-buffer)
   (let ((file (or gdb-selected-file gdb-main-file))
         (line (or gdb-selected-line 1)))
-    (if file
-        (format "-data-disassemble -f %s -l %d -n -1 -- 0\n" file line)
-      ""))
+    (if (not file) (error "Disassembly invalidated with no file selected.")
+      (format "-data-disassemble -f %s -l %d -n -1 -- 0\n" file line)))
   gdb-disassembly-handler)
 
 (def-gdb-auto-update-handler
@@ -2308,22 +2329,38 @@
 
 (defun gdb-disassembly-handler-custom ()
   (let* ((res (json-partial-output))
-         (instructions (gdb-get-field res 'asm_insns)))
-    (dolist (instr instructions)
+         (instructions (gdb-get-field res 'asm_insns))
+         (pos 1))
+    (let* ((last-instr (car (last instructions)))
+           (column-padding (+ 2 (string-width
+                                 (apply 'format
+                                        `("<%s+%s>:"
+                                          ,@(gdb-get-many-fields last-instr 'func-name 'offset)))))))
+      (dolist (instr instructions)
       ;; Put overlay arrow
       (when (string-equal (gdb-get-field instr 'address)
                           gdb-pc-address)
         (progn
+          (setq pos (point))
           (setq fringe-indicator-alist
                 (if (string-equal gdb-frame-number "0")
                     nil
                   '((overlay-arrow . hollow-right-triangle))))
           (set-marker gdb-overlay-arrow-position (point))))
-      (insert (apply 'format `("%s <%s+%s>:\t%s\n" 
-                               ,@(gdb-get-many-fields instr 'address 'func-name 'offset 'inst))))))
-  (gdb-disassembly-place-breakpoints))
+      (insert 
+       (concat
+        (gdb-get-field instr 'address)
+        " "
+        (gdb-pad-string (apply 'format `("<%s+%s>:"  ,@(gdb-get-many-fields instr 'func-name 'offset)))
+                        (- column-padding))
+        (gdb-get-field instr 'inst)
+        "\n")))
+      (gdb-disassembly-place-breakpoints)
+      (let ((window (get-buffer-window (current-buffer) 0)))
+        (set-window-point window pos)))))
 
 (defun gdb-disassembly-place-breakpoints ()
+  (gdb-remove-breakpoint-icons (point-min) (point-max))
   (dolist (breakpoint gdb-breakpoints-list)
     (let ((bptno (gdb-get-field breakpoint 'number))
           (flag (gdb-get-field breakpoint 'enabled))
@@ -2386,6 +2423,7 @@
   "Enable/disable breakpoint at current line of breakpoints buffer."
   (interactive)
   (save-excursion
+    (beginning-of-line)
     (let ((breakpoint (get-text-property (point) 'gdb-breakpoint)))
       (if breakpoint
           (gud-basic-call
@@ -2398,11 +2436,13 @@
 (defun gdb-delete-breakpoint ()
   "Delete the breakpoint at current line of breakpoints buffer."
   (interactive)
+  (save-excursion
+  (beginning-of-line)
   (let ((breakpoint (get-text-property (point) 'gdb-breakpoint)))
     (if breakpoint
         (gud-basic-call (concat "-break-delete " (gdb-get-field breakpoint 'number)))
-      (error "Not recognized as break/watchpoint line"))))
-
+      (error "Not recognized as break/watchpoint line")))))
+  
 (defun gdb-goto-breakpoint (&optional event)
   "Go to the location of breakpoint at current line of
 breakpoints buffer."
@@ -2411,6 +2451,8 @@
   ;; Hack to stop gdb-goto-breakpoint displaying in GUD buffer.
   (let ((window (get-buffer-window gud-comint-buffer)))
     (if window (save-selected-window  (select-window window))))
+  (save-excursion
+  (beginning-of-line)
   (let ((breakpoint (get-text-property (point) 'gdb-breakpoint)))
     (if breakpoint
 	(let ((bptno (gdb-get-field breakpoint 'number))
@@ -2426,7 +2468,7 @@
 	      (with-current-buffer buffer
 		(goto-line (string-to-number line))
 		(set-window-point window (point))))))
-      (error "Not recognized as break/watchpoint line"))))
+      (error "Not recognized as break/watchpoint line")))))
 
 
 ;; Frames buffer.  This displays a perpetually correct bactrack trace.
@@ -2872,7 +2914,7 @@
             (setq mode-name (concat "Locals:" gdb-selected-frame))))
       (if (gdb-get-buffer 'gdb-disassembly-buffer)
           (with-current-buffer (gdb-get-buffer 'gdb-disassembly-buffer)
-            (setq mode-name (concat "Machine:" gdb-selected-frame))))
+            (setq mode-name (concat "Disassembly:" gdb-selected-frame))))
       (if gud-overlay-arrow-position
           (let ((buffer (marker-buffer gud-overlay-arrow-position))
                 (position (marker-position gud-overlay-arrow-position)))