comparison lisp/gdb-ui.el @ 49039:6c5f45b01d2e

Acknowledge Tom Lord as author of gdba.el. Use let construction to bind buffer-read-only to nil. (gdba): 'set height 0' in GDB. (gdb-display-end, gdb-frame-handler): Corrections to forming full expression name for header-line in display frame. (gdb-info-breakpoints-custom): Highlight breakpoints since they may be clicked on with mouse-2. (gdb-quit): Delete frames of displayed expressions when quitting. (gdb-delete-frames): New function. (gdb-source-info): Don't create stack buffer automatically.

49038:e1f3921c6689

;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;;  This file is based on gdba.el from GDB 5.0 written by Jim Kingdon and uses
;;  GDB's annotation interface. It has been extended to use features of Emacs
;;  21 such as the display margin for breakpoints and the toolbar. It also has
;;  new buffers and lots of other new features such as formatted auto-display
;;  of arrays and structures (see the GDB-UI section in the Emacs info
;;  manual).

;;  You don't need to know about annotations to use this mode as a graphical
;;  user interface to GDB. However, if you are interested developing the mode
;;  itself see the Annotations section in the GDB info manual.
;;

  (mapc 'make-local-variable gdb-variables)
  (setq gdb-buffer-type 'gdba)
  ;;
  (gdb-clear-inferior-io)
  ;;
  ;; find source file and compilation directory here
  (gdb-enqueue-input (list "server list\n" 'ignore))
  (gdb-enqueue-input (list "server info source\n"
			   'gdb-source-info))
  ;;
  (run-hooks 'gdba-mode-hook))

(defun gud-display ()
  "Display (possibly dereferenced) C expression at point."
  (interactive)
  (save-excursion
    (let ((expr (gud-find-c-expr)))
      (gdb-enqueue-input
       (list (concat "server whatis " expr "\n")

      (gdb-enqueue-input
       (list (concat "server display* " expr "\n") 'ignore))
    (gdb-enqueue-input
     (list (concat "server display " expr "\n") 'ignore))))


;; The completion process filter is installed temporarily to slurp the
;; output of GDB up to the next prompt and build the completion list.
;; It must also handle annotations.

      (if (not (string-match "::" gdb-expression))
	  (setq gdb-expression (concat char gdb-current-frame
				       "::" gdb-expression))
	;;else put * back on if necessary
	(setq gdb-expression (concat char gdb-expression)))
      (setq header-line-format (concat "-- " gdb-expression " %-"))))
  ;;
  ;;-if scalar/string
  (if (not (re-search-forward "##" nil t))
      (progn
	(save-excursion
	  (set-buffer gdb-expression-buffer-name)
	  (setq buffer-read-only nil)
	  (delete-region (point-min) (point-max))
	  (insert-buffer-substring
	   (gdb-get-buffer 'gdb-partial-output-buffer))
	  (setq buffer-read-only t)))
    ;; display expression name...
    (goto-char (point-min))
    (let ((start (progn (point)))
	  (end (progn (end-of-line) (point))))
      (save-excursion

	  (gdb-field-format-begin))))
  (save-excursion
    (set-buffer gdb-expression-buffer-name)
    (if gdb-dive-display-number
	(progn
	  (setq buffer-read-only nil)
	  (goto-char (point-max))
	  (insert "\n")
	  (insert-text-button "[back]" 'type 'gdb-display-back)
	  (setq buffer-read-only t))))
  (gdb-clear-partial-output)
  (gdb-set-output-sink 'user)
  (setq gdb-display-in-progress nil))

(define-button-type 'gdb-display-back

  (let ((start (progn (point)))
	(end (progn (next-line) (point)))
	(num 0))
    (save-excursion
      (set-buffer gdb-expression-buffer-name)
      (setq buffer-read-only nil)
      (if (string-equal gdb-annotation-arg "\*") (insert "\*"))
      (while (<= num gdb-nesting-level)
	(insert "\t")
	(setq num (+ num 1)))
      (insert-buffer-substring (gdb-get-buffer
				'gdb-partial-output-buffer)
			       start end)
      (put-text-property (- (point) (- end start)) (- (point) 1)
			 'mouse-face 'highlight)
      (put-text-property (- (point) (- end start)) (- (point) 1)
                         'local-map gdb-dive-map)
      (setq buffer-read-only t))
    (delete-region start end)))

(defvar gdb-values)

(defun gdb-array-format ()

(defvar gdb-display-string)
(defvar gdb-array-size)

(defun gdb-array-format1 ()
  (setq gdb-display-string "")
  (setq buffer-read-only nil)
  (delete-region (point-min) (point-max))
  (let ((gdb-value-list (split-string gdb-values  ", ")))
    (string-match "\\({+\\)" (car gdb-value-list))
    (let* ((depth (- (match-end 1) (match-beginning 1)))
	   (indices  (make-vector depth '0))
	   (index 0) (num 0) (array-start "")
	   (array-stop "") (array-slice "") (array-range nil)
	   (flag t) (indices-string ""))
      (dolist (gdb-value gdb-value-list)
	(string-match "{*\\([^}]*\\)\\(}*\\)" gdb-value)
	(setq num 0)
	(while (< num depth)
	  (setq indices-string
		(concat indices-string
			"[" (int-to-string (aref indices num)) "]"))
	  (if (not (= (aref gdb-array-start num) -1))
	      (if (or (< (aref indices num) (aref gdb-array-start num))
		      (> (aref indices num) (aref gdb-array-stop num)))
		  (setq flag nil))
	    (aset gdb-array-size num (aref indices num)))
	  (setq num (+ num 1)))
	(if flag
	    (let ((gdb-display-value (match-string 1 gdb-value)))
	      (setq gdb-display-string (concat gdb-display-string " "
					       gdb-display-value))
	      (insert
	       (concat indices-string "\t" gdb-display-value "\n"))))
	(setq indices-string "")
	(setq flag t)
	;; 0<= index < depth, start at right : (- depth 1)
	(setq index (- (- depth 1)
		       (- (match-end 2) (match-beginning 2))))
	;;don't set for very last brackets
	(when (>= index 0)
	  (aset indices index (+ 1 (aref indices index)))
	  (setq num (+ 1 index))
	  (while (< num depth)
	    (aset indices num 0)
	    (setq num (+ num 1)))))
      (setq num 0)
      (while (< num depth)
	(if (= (aref gdb-array-start num) -1)
	    (progn
	      (aset gdb-array-start num 0)
	      (aset gdb-array-stop num (aref indices num))))
	(setq array-start (int-to-string (aref gdb-array-start num)))
	(setq array-stop (int-to-string (aref gdb-array-stop num)))
	(setq array-range (concat "[" array-start
				  ":" array-stop "]"))
	(put-text-property 1 (+ (length array-start)
				(length array-stop) 2)
			   'mouse-face 'highlight array-range)
	(put-text-property 1 (+ (length array-start)
				(length array-stop) 2)
			   'local-map gdb-array-slice-map array-range)
	(goto-char (point-min))
	(setq array-slice (concat array-slice array-range))
	(setq num (+ num 1)))
      (goto-char (point-min))
      (insert "Array Size : ")
      (setq num 0)
      (while (< num depth)
	(insert
	 (concat "["
		 (int-to-string (+ (aref gdb-array-size num) 1)) "]"))
	(setq num (+ num 1)))
      (insert
       (concat "\n     Slice : " array-slice "\n\nIndex\tValues\n\n"))))
  (setq buffer-read-only t))

(defun gud-gdba-marker-filter (string)
  "A gud marker filter for gdb. Handle a burst of output from GDB."
  (let (
	;; Recall the left over burst from last time

		(setq flag (char-after (match-beginning 2)))
		(beginning-of-line)
		(if (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t)
		    (progn
		      (looking-at "\\(\\S-*\\):\\([0-9]+\\)")
		      (let ((line (match-string 2))
			    (file (match-string 1)))
			(save-excursion
			  (set-buffer
			   (find-file-noselect 
			    (if (file-exists-p file) file
			      (expand-file-name file gdb-cdir))))

		  (let ((number 
			 (match-string 1 (buffer-name buffer))))
		    (if (not (memq (string-to-int number) display-list))
			(kill-buffer 
			 (get-buffer (concat "*display " number "*")))))))))
      (dolist (frame (frame-list))
	(let ((frame-name (frame-parameter frame 'name)))
	  (if (string-match "\\*display \\([0-9]+\\)\\*" frame-name)
	      (progn
		(let ((number (match-string 1 frame-name)))
		  (if (not (memq (string-to-int number) display-list))
		      (progn (kill-buffer
			      (get-buffer (concat "*display " number "*")))
			     (delete-frame frame)))))))))))

(defvar gdb-display-mode-map
  (let ((map (make-sparse-keymap))
	(menu (make-sparse-keymap "Display")))
    (define-key menu [toggle] '("Toggle" . gdb-toggle-display))

(defun gdb-quit ()
  "Kill the GUD interaction and gdb buffers and reset variables.
Use this command to exit a debugging session cleanly and reset
things like the toolbar and margin in the source buffers."
  (interactive)
  (dolist (buffer (buffer-list))
    (save-excursion
      (set-buffer buffer)
      (if (eq gud-minor-mode 'gdba)
	  (if (string-match "^\*" (buffer-name))

	(other-window 1))
    (delete-other-windows)
    (if gdb-many-windows
	(gdb-setup-windows)
      (gdb-display-breakpoints-buffer)
      (gdb-display-stack-buffer)
      (gdb-display-display-buffer)
      (delete-other-windows)
      (split-window)
      (other-window 1)
      (switch-to-buffer (gud-find-file gdb-main-file))

  (gdb-set-pending-triggers 
   (delq 'gdb-get-current-frame (gdb-get-pending-triggers)))
  (save-excursion 
    (set-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer))
    (goto-char (point-min))
    (if (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)")
	(setq gdb-current-frame (match-string 1)))))

(provide 'gdb-ui)

;;; gdb-ui.el ends here

49039:6c5f45b01d2e

;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;;  This file is based on gdba.el from GDB 5.0 written by Tom Lord and Jim
;;  Kingdon and uses GDB's annotation interface. It has been extended to use
;;  features of Emacs 21 such as the display margin for breakpoints and the
;;  toolbar. It also has new buffers and lots of other new features such as
;;  formatted auto-display of arrays and structures (see the GDB-UI section in
;;  the Emacs info manual). Start the debugger with M-x gdba.

;;  You don't need to know about annotations to use this mode as a graphical
;;  user interface to GDB. However, if you are interested developing the mode
;;  itself see the Annotations section in the GDB info manual.
;;

  (mapc 'make-local-variable gdb-variables)
  (setq gdb-buffer-type 'gdba)
  ;;
  (gdb-clear-inferior-io)
  ;;
  (gdb-enqueue-input (list "set height 0\n" 'ignore))
  ;; find source file and compilation directory here
  (gdb-enqueue-input (list "server list\n" 'ignore))
  (gdb-enqueue-input (list "server info source\n"
			   'gdb-source-info))
  ;;
  (run-hooks 'gdba-mode-hook))

(defun gud-display ()
  "Auto-display (possibly dereferenced) C expression at point."
  (interactive)
  (save-excursion
    (let ((expr (gud-find-c-expr)))
      (gdb-enqueue-input
       (list (concat "server whatis " expr "\n")

      (gdb-enqueue-input
       (list (concat "server display* " expr "\n") 'ignore))
    (gdb-enqueue-input
     (list (concat "server display " expr "\n") 'ignore))))

; this would messy because these bindings don't work with M-x gdb
; (define-key global-map "\C-x\C-a\C-a" 'gud-display)
; (define-key gud-minor-mode-map "\C-c\C-a" 'gud-display)

;; The completion process filter is installed temporarily to slurp the
;; output of GDB up to the next prompt and build the completion list.
;; It must also handle annotations.

      (if (not (string-match "::" gdb-expression))
	  (setq gdb-expression (concat char gdb-current-frame
				       "::" gdb-expression))
	;;else put * back on if necessary
	(setq gdb-expression (concat char gdb-expression)))
      (if (not header-line-format)
	  (setq header-line-format (concat "-- " gdb-expression " %-")))))
  ;;
  ;;-if scalar/string
  (if (not (re-search-forward "##" nil t))
      (progn
	(save-excursion
	  (set-buffer gdb-expression-buffer-name)
	  (let ((buffer-read-only nil))
	    (delete-region (point-min) (point-max))
	    (insert-buffer-substring
	     (gdb-get-buffer 'gdb-partial-output-buffer)))))
    ;; display expression name...
    (goto-char (point-min))
    (let ((start (progn (point)))
	  (end (progn (end-of-line) (point))))
      (save-excursion

	  (gdb-field-format-begin))))
  (save-excursion
    (set-buffer gdb-expression-buffer-name)
    (if gdb-dive-display-number
	(progn
	  (let ((buffer-read-only nil))
	    (goto-char (point-max))
	    (insert "\n")
	    (insert-text-button "[back]" 'type 'gdb-display-back)))))
  (gdb-clear-partial-output)
  (gdb-set-output-sink 'user)
  (setq gdb-display-in-progress nil))

(define-button-type 'gdb-display-back

  (let ((start (progn (point)))
	(end (progn (next-line) (point)))
	(num 0))
    (save-excursion
      (set-buffer gdb-expression-buffer-name)
      (let ((buffer-read-only nil))
	(if (string-equal gdb-annotation-arg "\*") (insert "\*"))
	(while (<= num gdb-nesting-level)
	  (insert "\t")
	  (setq num (+ num 1)))
	(insert-buffer-substring (gdb-get-buffer
				  'gdb-partial-output-buffer)
				 start end)
	(put-text-property (- (point) (- end start)) (- (point) 1)
			   'mouse-face 'highlight)
	(put-text-property (- (point) (- end start)) (- (point) 1)
			   'local-map gdb-dive-map)))
    (delete-region start end)))

(defvar gdb-values)

(defun gdb-array-format ()

(defvar gdb-display-string)
(defvar gdb-array-size)

(defun gdb-array-format1 ()
  (setq gdb-display-string "")
  (let ((buffer-read-only nil))
    (delete-region (point-min) (point-max))
    (let ((gdb-value-list (split-string gdb-values  ", ")))
      (string-match "\\({+\\)" (car gdb-value-list))
      (let* ((depth (- (match-end 1) (match-beginning 1)))
	     (indices  (make-vector depth '0))
	     (index 0) (num 0) (array-start "")
	     (array-stop "") (array-slice "") (array-range nil)
	     (flag t) (indices-string ""))
	(dolist (gdb-value gdb-value-list)
	  (string-match "{*\\([^}]*\\)\\(}*\\)" gdb-value)
	  (setq num 0)
	  (while (< num depth)
	    (setq indices-string
		  (concat indices-string
			  "[" (int-to-string (aref indices num)) "]"))
	    (if (not (= (aref gdb-array-start num) -1))
		(if (or (< (aref indices num) (aref gdb-array-start num))
			(> (aref indices num) (aref gdb-array-stop num)))
		    (setq flag nil))
	      (aset gdb-array-size num (aref indices num)))
	    (setq num (+ num 1)))
	  (if flag
	      (let ((gdb-display-value (match-string 1 gdb-value)))
		(setq gdb-display-string (concat gdb-display-string " "
						 gdb-display-value))
		(insert
		 (concat indices-string "\t" gdb-display-value "\n"))))
	  (setq indices-string "")
	  (setq flag t)
	  ;; 0<= index < depth, start at right : (- depth 1)
	  (setq index (- (- depth 1)
			 (- (match-end 2) (match-beginning 2))))
	  ;;don't set for very last brackets
	  (when (>= index 0)
	    (aset indices index (+ 1 (aref indices index)))
	    (setq num (+ 1 index))
	    (while (< num depth)
	      (aset indices num 0)
	      (setq num (+ num 1)))))
	(setq num 0)
	(while (< num depth)
	  (if (= (aref gdb-array-start num) -1)
	      (progn
		(aset gdb-array-start num 0)
		(aset gdb-array-stop num (aref indices num))))
	  (setq array-start (int-to-string (aref gdb-array-start num)))
	  (setq array-stop (int-to-string (aref gdb-array-stop num)))
	  (setq array-range (concat "[" array-start
				    ":" array-stop "]"))
	  (put-text-property 1 (+ (length array-start)
				  (length array-stop) 2)
			     'mouse-face 'highlight array-range)
	  (put-text-property 1 (+ (length array-start)
				  (length array-stop) 2)
			     'local-map gdb-array-slice-map array-range)
	  (goto-char (point-min))
	  (setq array-slice (concat array-slice array-range))
	  (setq num (+ num 1)))
	(goto-char (point-min))
	(insert "Array Size : ")
	(setq num 0)
	(while (< num depth)
	  (insert
	   (concat "["
		   (int-to-string (+ (aref gdb-array-size num) 1)) "]"))
	  (setq num (+ num 1)))
	(insert
	 (concat "\n     Slice : " array-slice "\n\nIndex\tValues\n\n"))))))

(defun gud-gdba-marker-filter (string)
  "A gud marker filter for gdb. Handle a burst of output from GDB."
  (let (
	;; Recall the left over burst from last time

		(setq flag (char-after (match-beginning 2)))
		(beginning-of-line)
		(if (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t)
		    (progn
		      (looking-at "\\(\\S-*\\):\\([0-9]+\\)")
		      (let ((line (match-string 2)) (buffer-read-only nil)
			    (file (match-string 1)))
			(put-text-property (progn (beginning-of-line) (point))
					   (progn (end-of-line) (point))
					   'mouse-face 'highlight)
			(save-excursion
			  (set-buffer
			   (find-file-noselect 
			    (if (file-exists-p file) file
			      (expand-file-name file gdb-cdir))))

		  (let ((number 
			 (match-string 1 (buffer-name buffer))))
		    (if (not (memq (string-to-int number) display-list))
			(kill-buffer 
			 (get-buffer (concat "*display " number "*")))))))))
      (gdb-delete-frames display-list))))

(defun gdb-delete-frames (display-list)
  (dolist (frame (frame-list))
    (let ((frame-name (frame-parameter frame 'name)))
      (if (string-match "\\*display \\([0-9]+\\)\\*" frame-name)
	  (progn
	    (let ((number (match-string 1 frame-name)))
	      (if (not (memq (string-to-int number) display-list))
		  (progn (kill-buffer
			  (get-buffer (concat "*display " number "*")))
			 (delete-frame frame)))))))))

(defvar gdb-display-mode-map
  (let ((map (make-sparse-keymap))
	(menu (make-sparse-keymap "Display")))
    (define-key menu [toggle] '("Toggle" . gdb-toggle-display))

(defun gdb-quit ()
  "Kill the GUD interaction and gdb buffers and reset variables.
Use this command to exit a debugging session cleanly and reset
things like the toolbar and margin in the source buffers."
  (interactive)
  (gdb-delete-frames '())
  (dolist (buffer (buffer-list))
    (save-excursion
      (set-buffer buffer)
      (if (eq gud-minor-mode 'gdba)
	  (if (string-match "^\*" (buffer-name))

	(other-window 1))
    (delete-other-windows)
    (if gdb-many-windows
	(gdb-setup-windows)
      (gdb-display-breakpoints-buffer)
      (gdb-display-display-buffer)
      (delete-other-windows)
      (split-window)
      (other-window 1)
      (switch-to-buffer (gud-find-file gdb-main-file))

  (gdb-set-pending-triggers 
   (delq 'gdb-get-current-frame (gdb-get-pending-triggers)))
  (save-excursion 
    (set-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer))
    (goto-char (point-min))
    (if (looking-at "^#[0-9]*\\s-*0x\\S-* in \\(\\S-*\\)")
	(setq gdb-current-frame (match-string 1))
      (if (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)")
	  (setq gdb-current-frame (match-string 1))))))

(provide 'gdb-ui)

;;; gdb-ui.el ends here