comparison lisp/gdb-ui.el @ 51529:39126c23006f

(gdb-get-current-frame, gdb-frame-handler): Use Gdb command `info frame' instead of `frame' to preserve point. (gdb-invalidate-assembler): Only run disassemble again if frame has changed. (gdb-append-to-inferior-io): Revert change from 2003-05-17.

51528:611abdca734b

;; GDB through the GUD buffer in the usual way, but there are also further
;; buffers which control the execution and describe the state of your program.
;; It separates the input/output of your program from that of GDB and displays
;; expressions and their current values in their own buffers. It also uses
;; features of Emacs 21 such as the display margin for breakpoints, and the
;; toolbar (see the GDB User Interface section in the Emacs info manual).

;; Start the debugger with M-x gdba.

;; This file is based on gdba.el from GDB 5.0 written by Tom Lord and Jim
;; Kingdon and uses GDB's annotation interface. You don't need to know about

  :type 'integer
  :group 'gud)

(defvar gdb-current-address nil "Initialisation for Assembler buffer.")
(defvar gdb-previous-address nil)
(defvar gdb-display-in-progress nil)
(defvar gdb-dive nil)
(defvar gdb-view-source t "Non-nil means that source code can be viewed")
(defvar gdb-selected-view 'source "Code type that user wishes to view")
(defvar gdb-buffer-type nil)

  (setq comint-input-sender 'gdb-send)
  ;;
  ;; (re-)initialise
  (setq gdb-current-address "main")
  (setq gdb-previous-address nil)
  (setq gdb-display-in-progress nil)
  (setq gdb-dive nil)
  (setq gdb-view-source t)
  (setq gdb-selected-view 'source)
  ;;

(defun gdb-append-to-inferior-io (string)
  (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io)
    (goto-char (point-max))
    (insert-before-markers string))
  (if (not (string-equal string ""))
      (select-window 
	(gdb-display-buffer (gdb-get-create-buffer 'gdb-inferior-io)))))

(defun gdb-clear-inferior-io ()
  (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io)
    (delete-region (point-min) (point-max))))


	      (looking-at
	       "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*0x\\(\\S-*\\)")
	      (setq flag (char-after (match-beginning 1)))
	      (setq address (match-string 2))
	      ;; remove leading 0s from output of info break.
	      (if (string-match "0+\\(.*\\)" address)
		  (setq address (match-string 1 address)))
	      (with-current-buffer buffer
		  (goto-char (point-min))
		  (if (re-search-forward address nil t)
		      (let ((start (progn (beginning-of-line) (- (point) 1)))

   (gdb-get-create-buffer 'gdb-assembler-buffer)))

;; modified because if gdb-current-address has changed value a new command
;; must be enqueued to update the buffer with the new output
(defun gdb-invalidate-assembler (&optional ignored)
  (if (and (gdb-get-buffer 'gdb-assembler-buffer)
	   (or (not (member 'gdb-invalidate-assembler
			    (gdb-get-pending-triggers)))
	       (not (string-equal gdb-current-address gdb-previous-address))))
      (progn
	;; take previous disassemble command off the queue
	(with-current-buffer gud-comint-buffer
	  (let ((queue (gdb-get-idle-input-queue)) (item))
	    (dolist (item queue)
	      (if (equal (cdr item) '(gdb-assembler-handler))
		  (gdb-set-idle-input-queue 
		   (delete item (gdb-get-idle-input-queue)))))))
	(gdb-enqueue-idle-input
	 (list (concat "server disassemble " gdb-current-address "\n")
	       'gdb-assembler-handler))
	(gdb-set-pending-triggers
	 (cons 'gdb-invalidate-assembler
	       (gdb-get-pending-triggers)))
	(setq gdb-previous-address gdb-current-address))))

(defun gdb-get-current-frame ()
  (if (not (member 'gdb-get-current-frame (gdb-get-pending-triggers)))
      (progn
	(gdb-enqueue-idle-input
	 (list (concat "server frame\n") 'gdb-frame-handler))
	(gdb-set-pending-triggers
	 (cons 'gdb-get-current-frame
	       (gdb-get-pending-triggers))))))

(defun gdb-frame-handler ()
  (gdb-set-pending-triggers
   (delq 'gdb-get-current-frame (gdb-get-pending-triggers)))
  (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
    (goto-char (point-min))
    (if (looking-at "^#[0-9]*\\s-*\\(\\S-*\\) in \\(\\S-*\\)")
	(progn
	  (setq gdb-current-frame (match-string 2))
	  (let ((address (match-string 1)))
	    ;; remove leading 0s from output of frame command.
	    (if (string-match "0x0+\\(.*\\)" address)
		(setq gdb-current-address 
		      (concat "0x" (match-string 1 address)))
	      (setq gdb-current-address address)))
	  (if (or (if (not (looking-at ".*) at "))
		      (progn (setq gdb-view-source nil) t))
		  (eq gdb-selected-view 'assembler))
	      (progn
		(set-window-buffer 
		 gdb-source-window
		 (gdb-get-create-buffer 'gdb-assembler-buffer))
		(gdb-invalidate-assembler))))
      (if (looking-at "^#0\\s-*\\(\\S-*\\)")
	  (setq gdb-current-frame (match-string 1))))))

(provide 'gdb-ui)

;;; gdb-ui.el ends here

51529:39126c23006f

;; GDB through the GUD buffer in the usual way, but there are also further
;; buffers which control the execution and describe the state of your program.
;; It separates the input/output of your program from that of GDB and displays
;; expressions and their current values in their own buffers. It also uses
;; features of Emacs 21 such as the display margin for breakpoints, and the
;; toolbar (see the GDB Graphical Interface section in the Emacs info manual).

;; Start the debugger with M-x gdba.

;; This file is based on gdba.el from GDB 5.0 written by Tom Lord and Jim
;; Kingdon and uses GDB's annotation interface. You don't need to know about

  :type 'integer
  :group 'gud)

(defvar gdb-current-address nil "Initialisation for Assembler buffer.")
(defvar gdb-previous-address nil)
(defvar gdb-previous-frame nil)
(defvar gdb-display-in-progress nil)
(defvar gdb-dive nil)
(defvar gdb-view-source t "Non-nil means that source code can be viewed")
(defvar gdb-selected-view 'source "Code type that user wishes to view")
(defvar gdb-buffer-type nil)

  (setq comint-input-sender 'gdb-send)
  ;;
  ;; (re-)initialise
  (setq gdb-current-address "main")
  (setq gdb-previous-address nil)
  (setq gdb-previous-frame nil)
  (setq gdb-display-in-progress nil)
  (setq gdb-dive nil)
  (setq gdb-view-source t)
  (setq gdb-selected-view 'source)
  ;;

(defun gdb-append-to-inferior-io (string)
  (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io)
    (goto-char (point-max))
    (insert-before-markers string))
  (if (not (string-equal string ""))
      (gdb-display-buffer (gdb-get-create-buffer 'gdb-inferior-io))))

(defun gdb-clear-inferior-io ()
  (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io)
    (delete-region (point-min) (point-max))))


	      (looking-at
	       "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*0x\\(\\S-*\\)")
	      (setq flag (char-after (match-beginning 1)))
	      (setq address (match-string 2))
	      ;; remove leading 0s from output of info break.
	      (if (string-match "^0+\\(.*\\)" address)
		  (setq address (match-string 1 address)))
	      (with-current-buffer buffer
		  (goto-char (point-min))
		  (if (re-search-forward address nil t)
		      (let ((start (progn (beginning-of-line) (- (point) 1)))

   (gdb-get-create-buffer 'gdb-assembler-buffer)))

;; modified because if gdb-current-address has changed value a new command
;; must be enqueued to update the buffer with the new output
(defun gdb-invalidate-assembler (&optional ignored)
  (if (gdb-get-buffer 'gdb-assembler-buffer)
      (progn
	(if (string-equal gdb-current-frame gdb-previous-frame)
	    (gdb-assembler-custom)
	  (if (or (not (member 'gdb-invalidate-assembler
			       (gdb-get-pending-triggers)))
		  (not (string-equal gdb-current-address 
				     gdb-previous-address)))
	  (progn
	    ;; take previous disassemble command off the queue
	    (with-current-buffer gud-comint-buffer
	      (let ((queue (gdb-get-idle-input-queue)) (item))
		(dolist (item queue)
		  (if (equal (cdr item) '(gdb-assembler-handler))
		      (gdb-set-idle-input-queue 
		       (delete item (gdb-get-idle-input-queue)))))))
	    (gdb-enqueue-idle-input
	     (list (concat "server disassemble " gdb-current-address "\n")
		   'gdb-assembler-handler))
	    (gdb-set-pending-triggers
	     (cons 'gdb-invalidate-assembler
		   (gdb-get-pending-triggers)))
	    (setq gdb-previous-address gdb-current-address)
	    (setq gdb-previous-frame gdb-current-frame)))))))

(defun gdb-get-current-frame ()
  (if (not (member 'gdb-get-current-frame (gdb-get-pending-triggers)))
      (progn
	(gdb-enqueue-idle-input
	 (list (concat "server info frame\n") 'gdb-frame-handler))
	(gdb-set-pending-triggers
	 (cons 'gdb-get-current-frame
	       (gdb-get-pending-triggers))))))

(defun gdb-frame-handler ()
  (gdb-set-pending-triggers
   (delq 'gdb-get-current-frame (gdb-get-pending-triggers)))
  (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
    (goto-char (point-min))
    (forward-line)
    (if (looking-at ".*= 0x\\(\\S-*\\) in \\(\\S-*\\)")
	(progn
	  (setq gdb-current-frame (match-string 2))
	  (let ((address (match-string 1)))
	    ;; remove leading 0s from output of info frame command.
	    (if (string-match "^0+\\(.*\\)" address)
		(setq gdb-current-address 
		      (concat "0x" (match-string 1 address)))
	      (setq gdb-current-address (concat "0x" address))))
	  (if (or (if (not (looking-at ".*(\\S-*:[0-9]*)"))
		      (progn (setq gdb-view-source nil) t))
		  (eq gdb-selected-view 'assembler))
	      (progn
		(set-window-buffer 
		 gdb-source-window
		 (gdb-get-create-buffer 'gdb-assembler-buffer))
		(gdb-invalidate-assembler)))))))

(provide 'gdb-ui)

;;; gdb-ui.el ends here