emacs: lisp/progmodes/gdb-mi.el comparison

comparison lisp/progmodes/gdb-mi.el @ 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.

author	Dmitry Dzhus <dima@sphinx.net.ru>
date	Tue, 07 Jul 2009 17:36:42 +0000
parents	47e338b0e07b
children	bd7c204d425b

comparison

equal deleted inserted replaced

-:47e338b0e07b
+:dcd3d86fcf81
 ;; Author: Nick Roberts <nickrob@gnu.org>
 ;; Maintainer: FSF
 ;; Keywords: unix, tools
 ;; 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
 ;; (at your option) any later version.
 (setq gud-running nil)
 (gdb-update)
 (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)
 			 (forward-char 2)
 			 (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)
 			  (forward-char 2)
 			  (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)
 			  (forward-char 2)
 			  (gud-call "-exec-until *%a" arg)))
 (gdb-invalidate-breakpoints)
 (gdb-invalidate-threads)
 (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)
 (setcar (nthcdr 5 var) nil))
 (gdb-var-update)))
 (insert "}")
 (goto-char (point-min))
 (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)
 "Return a list of FIELDS values from STRUCT."
 (let ((values))
 (delq ',trigger
 	    gdb-pending-triggers))
 (let ((buf (gdb-get-buffer ',buf-key)))
 (and buf
 	    (with-current-buffer buf
-	      (let* ((window (get-buffer-window buf 0))
+	      (let*((buffer-read-only nil))
-		     (start (window-start window))
-		     (p (window-point window))
-(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
 				       trigger-name gdb-command
 				       output-handler-name custom-defun)
 (insert
 (concat " in "
 (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)
 `(gdb-breakpoint ,breakpoint
 mouse-face highlight
 gdb-memory-rows
 gdb-memory-columns)
 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)))
 (if (not err-msg)
 (let ((memory (gdb-get-field res 'memory)))
 (setq gdb-memory-address (gdb-get-field res 'addr))
 (setq gdb-memory-next-page (gdb-get-field res 'next-page))
 (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
 (let ((gdb-memory-address gdb-memory-last-address))
 (gdb-invalidate-memory)
 (gdb-set-buffer-rules 'gdb-disassembly-buffer
 'gdb-disassembly-buffer-name
 '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
+(if (not file) (error "Disassembly invalidated with no file selected.")
-(format "-data-disassemble -f %s -l %d -n -1 -- 0\n" file line)
+(format "-data-disassemble -f %s -l %d -n -1 -- 0\n" file line)))
-""))
 gdb-disassembly-handler)
 (def-gdb-auto-update-handler
 gdb-disassembly-handler
 gdb-invalidate-disassembly
 (run-mode-hooks 'gdb-disassembly-mode-hook)
 'gdb-invalidate-disassembly)
 (defun gdb-disassembly-handler-custom ()
 (let* ((res (json-partial-output))
-(instructions (gdb-get-field res 'asm_insns)))
+(instructions (gdb-get-field res 'asm_insns))
-(dolist (instr instructions)
+(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"
+(insert
-,@(gdb-get-many-fields instr 'address 'func-name 'offset 'inst))))))
+(concat
-(gdb-disassembly-place-breakpoints))
+(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))
 (address (gdb-get-field breakpoint 'addr)))
 (save-excursion
 (defun gdb-toggle-breakpoint ()
 "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
 (concat (if (string-equal "y" (gdb-get-field breakpoint 'enabled))
 "-break-disable "
 (error "Not recognized as break/watchpoint line")))))
 (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."
 (interactive (list last-input-event))
 (if event (posn-set-point (event-end event)))
 ;; 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))
 	      (file  (gdb-get-field breakpoint 'file))
 	      (line  (gdb-get-field breakpoint 'line)))
 			       (display-buffer buffer))))
 	      (setq gdb-source-window window)
 	      (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.
 ;;
 (gdb-set-buffer-rules 'gdb-stack-buffer
 (if (gdb-get-buffer 'gdb-locals-buffer)
 (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer)
 (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)))
 (when buffer
 (with-current-buffer buffer

Mercurial > emacs

comparison lisp/progmodes/gdb-mi.el @ 103752:dcd3d86fcf81