comparison lisp/gdb-ui.el @ 52328:06d74a21fa32

(gdba): Remove gdb-quit (previously removed) from documentation. (gdb-source, gdb-source-info): Update to assembler unnecessary as its done after each GDB command anyway. (gdb-pre-prompt): Use with-current-buffer. (gdb-insert-field): Add help-echo text. (gdb-invalidate-assembler): Re-display of assembler now done in gdb-info-breakpoints-custom. (gdb-info-breakpoints-custom): Force re-display of assembler to happen *after* update of breakpoints buffer. (gdb-display-source-buffer): Don't choke if gdb-source-window isn't visible. (gdb-put-string, gdb-put-arrow): Remove free variables.

52327:8bc12f54b756

Pointers in structures may be followed in a tree-like fashion.

The following interactive lisp functions help control operation :

`gdb-many-windows'    - Toggle the number of windows gdb uses.
`gdb-restore-windows' - To restore the window layout.
`gdb-quit'            - To delete (most) of the buffers used by GDB-UI and
                        reset variables."
  ;;
  (interactive (list (gud-query-cmdline 'gdba)))
  ;;
  ;; Let's start with a basic gud-gdb buffer and then modify it a bit.
  (gdb command-line)

  (setq gud-last-frame
	(cons
	 (match-string 1 args)
	 (string-to-int (match-string 2 args))))
  (setq gdb-current-address (match-string 3 args))
  (setq gdb-view-source t)
  ;;update with new frame for machine code if necessary
  (gdb-invalidate-assembler))

(defun gdb-send-item (item)
  (gdb-set-current-item item)
  (if (stringp item)
      (progn

     ((eq sink 'user) t)
     ((eq sink 'emacs)
      (gdb-set-output-sink 'post-emacs)
      (let ((handler
	     (car (cdr (gdb-get-current-item)))))
	(save-excursion
	  (set-buffer (gdb-get-create-buffer
		       'gdb-partial-output-buffer))
	  (funcall handler))))
     (t
      (gdb-set-output-sink 'user)
      (error "Phase error in gdb-pre-prompt (got %s)" sink)))))

	  (insert "\t")
	  (setq num (+ num 1)))
	(insert-buffer-substring (gdb-get-buffer
				  'gdb-partial-output-buffer)
				 start end)
	(add-text-properties (- (point) (- end start)) (- (point) 1)
			     `(mouse-face highlight local-map ,gdb-dive-map))))
    (delete-region start end)))

(defvar gdb-values nil)

(defun gdb-array-format ()

						 'left-margin)))
				(gdb-remove-strings start end)
				(if (eq ?y flag)
				    (gdb-put-string "B" (+ start 1))
				  (gdb-put-string "b" (+ start 1))))))))))))
	  (end-of-line))))))

(defun gdb-breakpoints-buffer-name ()
  (with-current-buffer gud-comint-buffer
    (concat "*breakpoints of " (gdb-get-target-string) "*")))

	  (switch-to-buffer (find-file-noselect
			     (if (file-exists-p file)
				 file
			       (expand-file-name file gdb-cdir))))
	  (goto-line (string-to-number line))))))
;; I'll get this to work one day!
;; (defun gdb-goto-breakpoint ()
;;   "Display the file in the source buffer at the breakpoint specified on the
;; current line."
;;   (interactive)
;;   (save-excursion
;;     (let ((eol (progn (end-of-line) (point))))
;;       (beginning-of-line 1)
;;       (if (re-search-forward "\\(\\S-*\\):\\([0-9]+\\)" eol t)
;; 	  (let ((line (match-string 2))
;; 		(file (match-string 1)))
;; 	    (save-selected-window
;; 	      (select-window gdb-source-window)
;; 	      (switch-to-buffer (find-file-noselect
;; 				 (if (file-exists-p file)
;; 				     file
;; 				   (expand-file-name file gdb-cdir))))
;; 	      (goto-line (string-to-number line))))))
;;     (let ((eol (progn (end-of-line) (point))))
;;       (beginning-of-line 1)
;;       (if (re-search-forward "<\\(\\S-*?\\)\\(\\+*[0-9]*\\)>" eol t)
;; 	  (save-selected-window
;; 	    (select-window gdb-source-window)
;; 	    (gdb-get-create-buffer 'gdb-assembler-buffer)
;; 	    (gdb-enqueue-input
;; 	     (list (concat "server disassemble " (match-string 1) "\n")
;; 		   'gdb-assembler-handler))
;; 	    (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer)
;; 	      (re-search-forward 
;; 	       (concat (match-string 1) (match-string 2)))))))))

(defun gdb-mouse-goto-breakpoint (event)
  "Display the file in the source buffer at the selected breakpoint."
  (interactive "e")
  (mouse-set-point event)

  (let ((must-split nil)
	(answer nil))
    (unwind-protect
	(progn
	  (walk-windows
	   '(lambda (win)
	      (if (or (eq gud-comint-buffer (window-buffer win))
		      (eq gdb-source-window win))
		  (set-window-dedicated-p win t))))
	  (setq answer (get-buffer-window buf))
	  (if (not answer)

		    (progn
		      (set-window-buffer window buf)
		      (setq answer window))
		  (setq must-split t)))))
      (walk-windows
       '(lambda (win)
	  (if (or (eq gud-comint-buffer (window-buffer win))
		  (eq gdb-source-window win))
	      (set-window-dedicated-p win nil)))))
    (if must-split
	(let* ((largest (get-largest-window))

	  (set-window-buffer answer buf)))
    answer))

(defun gdb-display-source-buffer (buffer)
  (if (eq gdb-selected-view 'source)
      (set-window-buffer gdb-source-window buffer)
    (set-window-buffer gdb-source-window
		       (gdb-get-buffer 'gdb-assembler-buffer)))
  gdb-source-window)


;;; Shared keymap initialization:

(let ((menu (make-sparse-keymap "GDB-Frames")))

    (if gdb-view-source
      (switch-to-buffer
       (if gud-last-last-frame
	   (gud-find-file (car gud-last-last-frame))
	 (gud-find-file gdb-main-file)))
      (switch-to-buffer (gdb-get-create-buffer 'gdb-assembler-buffer))
      (gdb-invalidate-assembler))
    (setq gdb-source-window (get-buffer-window (current-buffer)))
    (other-window 1)))

;;from put-image
(defun gdb-put-string (putstring pos)
  "Put string PUTSTRING in front of POS in the current buffer.
PUTSTRING is displayed by putting an overlay into the current buffer with a
`before-string' STRING that has a `display' property whose value is
PUTSTRING."
  (setq string "x")
  (let ((buffer (current-buffer)))
    (setq string (copy-sequence string))
    (let ((overlay (make-overlay pos pos buffer))
	  (prop (list (list 'margin 'left-margin) putstring)))
      (put-text-property 0 (length string) 'display prop string)
      (overlay-put overlay 'put-break t)
      (overlay-put overlay 'before-string string))))

;;from remove-images
(defun gdb-remove-strings (start end &optional buffer)
  "Remove strings between START and END in BUFFER.
Remove only strings that were put in BUFFER with calls to `put-string'.

(defun gdb-put-arrow (putstring pos)
  "Put arrow string PUTSTRING in the left margin in front of POS
in the current buffer.  PUTSTRING is displayed by putting an
overlay into the current buffer with a `before-string'
\"gdb-arrow\" that has a `display' property whose value is
PUTSTRING. STRING is defaulted if you omit it.  POS may be an
integer or marker."
  (setq string "gdb-arrow")
  (let ((buffer (current-buffer)))
    (setq string (copy-sequence string))
    (let ((overlay (make-overlay pos pos buffer))
	  (prop (list (list 'margin 'left-margin) putstring)))
      (put-text-property 0 (length string) 'display prop string)
      (overlay-put overlay 'put-arrow t)
      (overlay-put overlay 'before-string string))))

(defun gdb-remove-arrow (&optional buffer)
  "Remove arrow in BUFFER.
Remove only images that were put in BUFFER with calls to `put-arrow'.
BUFFER nil or omitted means use the current buffer."

  (setq mode-name "Assembler")
  (setq left-margin-width 2)
  (setq fringes-outside-margins t)
  (setq buffer-read-only t)
  (use-local-map gdb-assembler-mode-map)
  (gdb-invalidate-assembler)
  (gdb-invalidate-breakpoints))

(defun gdb-assembler-buffer-name ()
  (with-current-buffer gud-comint-buffer
    (concat "*Machine Code " (gdb-get-target-string) "*")))

;; 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

		  (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

52328:06d74a21fa32

Pointers in structures may be followed in a tree-like fashion.

The following interactive lisp functions help control operation :

`gdb-many-windows'    - Toggle the number of windows gdb uses.
`gdb-restore-windows' - To restore the window layout."
  ;;
  (interactive (list (gud-query-cmdline 'gdba)))
  ;;
  ;; Let's start with a basic gud-gdb buffer and then modify it a bit.
  (gdb command-line)

  (setq gud-last-frame
	(cons
	 (match-string 1 args)
	 (string-to-int (match-string 2 args))))
  (setq gdb-current-address (match-string 3 args))
  (setq gdb-view-source t))

(defun gdb-send-item (item)
  (gdb-set-current-item item)
  (if (stringp item)
      (progn

     ((eq sink 'user) t)
     ((eq sink 'emacs)
      (gdb-set-output-sink 'post-emacs)
      (let ((handler
	     (car (cdr (gdb-get-current-item)))))
	(with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
	  (funcall handler))))
     (t
      (gdb-set-output-sink 'user)
      (error "Phase error in gdb-pre-prompt (got %s)" sink)))))

	  (insert "\t")
	  (setq num (+ num 1)))
	(insert-buffer-substring (gdb-get-buffer
				  'gdb-partial-output-buffer)
				 start end)
	(add-text-properties 
	 (- (point) (- end start)) (- (point) 1)
	 `(mouse-face highlight 
	   local-map ,gdb-dive-map
	   help-echo "mouse-2: dive, S-mouse-2: dive in a new frame"))))
    (delete-region start end)))

(defvar gdb-values nil)

(defun gdb-array-format ()

						 'left-margin)))
				(gdb-remove-strings start end)
				(if (eq ?y flag)
				    (gdb-put-string "B" (+ start 1))
				  (gdb-put-string "b" (+ start 1))))))))))))
	  (end-of-line)))))
  (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom)))

(defun gdb-breakpoints-buffer-name ()
  (with-current-buffer gud-comint-buffer
    (concat "*breakpoints of " (gdb-get-target-string) "*")))

	  (switch-to-buffer (find-file-noselect
			     (if (file-exists-p file)
				 file
			       (expand-file-name file gdb-cdir))))
	  (goto-line (string-to-number line))))))

(defun gdb-mouse-goto-breakpoint (event)
  "Display the file in the source buffer at the selected breakpoint."
  (interactive "e")
  (mouse-set-point event)

  (let ((must-split nil)
	(answer nil))
    (unwind-protect
	(progn
	  (walk-windows
	   #'(lambda (win)
	      (if (or (eq gud-comint-buffer (window-buffer win))
		      (eq gdb-source-window win))
		  (set-window-dedicated-p win t))))
	  (setq answer (get-buffer-window buf))
	  (if (not answer)

		    (progn
		      (set-window-buffer window buf)
		      (setq answer window))
		  (setq must-split t)))))
      (walk-windows
       #'(lambda (win)
	  (if (or (eq gud-comint-buffer (window-buffer win))
		  (eq gdb-source-window win))
	      (set-window-dedicated-p win nil)))))
    (if must-split
	(let* ((largest (get-largest-window))

	  (set-window-buffer answer buf)))
    answer))

(defun gdb-display-source-buffer (buffer)
  (if (eq gdb-selected-view 'source)
      (progn
	(if (window-live-p gdb-source-window)
	    (set-window-buffer gdb-source-window buffer)
	  (gdb-display-buffer buffer)
	  (setq gdb-source-window (get-buffer-window buffer)))
	      gdb-source-window)
    (if (window-live-p gdb-source-window)
	(set-window-buffer gdb-source-window
			   (gdb-get-buffer 'gdb-assembler-buffer))
      (let ((buf (gdb-get-buffer 'gdb-assembler-buffer)))
	(gdb-display-buffer buf)
	(setq gdb-source-window (get-buffer-window buf))))
    nil))


;;; Shared keymap initialization:

(let ((menu (make-sparse-keymap "GDB-Frames")))

    (if gdb-view-source
      (switch-to-buffer
       (if gud-last-last-frame
	   (gud-find-file (car gud-last-last-frame))
	 (gud-find-file gdb-main-file)))
      (switch-to-buffer (gdb-get-create-buffer 'gdb-assembler-buffer)))
    (setq gdb-source-window (get-buffer-window (current-buffer)))
    (other-window 1)))

;;from put-image
(defun gdb-put-string (putstring pos)
  "Put string PUTSTRING in front of POS in the current buffer.
PUTSTRING is displayed by putting an overlay into the current buffer with a
`before-string' STRING that has a `display' property whose value is
PUTSTRING."
  (let ((gdb-string "x")
	(buffer (current-buffer)))
    (let ((overlay (make-overlay pos pos buffer))
	  (prop (list (list 'margin 'left-margin) putstring)))
      (put-text-property 0 (length gdb-string) 'display prop gdb-string)
      (overlay-put overlay 'put-break t)
      (overlay-put overlay 'before-string gdb-string))))

;;from remove-images
(defun gdb-remove-strings (start end &optional buffer)
  "Remove strings between START and END in BUFFER.
Remove only strings that were put in BUFFER with calls to `put-string'.

(defun gdb-put-arrow (putstring pos)
  "Put arrow string PUTSTRING in the left margin in front of POS
in the current buffer.  PUTSTRING is displayed by putting an
overlay into the current buffer with a `before-string'
\"gdb-arrow\" that has a `display' property whose value is
PUTSTRING. POS may be an integer or marker."
  (let ((gdb-string "gdb-arrow")
	(buffer (current-buffer)))
    (let ((overlay (make-overlay pos pos buffer))
	  (prop (list (list 'margin 'left-margin) putstring)))
      (put-text-property 0 (length gdb-string) 'display prop gdb-string)
      (overlay-put overlay 'put-arrow t)
      (overlay-put overlay 'before-string gdb-string))))

(defun gdb-remove-arrow (&optional buffer)
  "Remove arrow in BUFFER.
Remove only images that were put in BUFFER with calls to `put-arrow'.
BUFFER nil or omitted means use the current buffer."

  (setq mode-name "Assembler")
  (setq left-margin-width 2)
  (setq fringes-outside-margins t)
  (setq buffer-read-only t)
  (use-local-map gdb-assembler-mode-map)
  (gdb-invalidate-assembler))

(defun gdb-assembler-buffer-name ()
  (with-current-buffer gud-comint-buffer
    (concat "*Machine Code " (gdb-get-target-string) "*")))

;; 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
	(unless (string-equal gdb-current-frame gdb-previous-frame)
	  (if (or (not (member 'gdb-invalidate-assembler
			       (gdb-get-pending-triggers)))
		  (not (string-equal gdb-current-address 
				     gdb-previous-address)))
	  (progn

		  (eq gdb-selected-view 'assembler))
	      (progn
		(set-window-buffer 
		 gdb-source-window
		 (gdb-get-create-buffer 'gdb-assembler-buffer))
		;;update with new frame for machine code if necessary
		(gdb-invalidate-assembler)))))))

(provide 'gdb-ui)

;;; gdb-ui.el ends here