comparison lisp/gdb-ui.el @ 48498:8fdedd7dca85

General tidying. Patches from Stefan Monnier.

48497:016a2985b8c6

(defvar gdb-main-file nil "Source file from which program execution begins.")
(defvar gdb-cdir nil "Compilation directory.")
(defvar gdb-main-or-pc nil "Initialisation for Assembler buffer.")
(defvar gdb-prev-main-or-pc nil)

(defun gdba (command-line)
  "Run gdb on program FILE in buffer *gdb-FILE*.
The directory containing FILE becomes the initial working directory
and source-file directory for your debugger.

;; gdb-instance objects
;;

(defun make-gdb-instance (proc)
  "Create a gdb instance object from a gdb process."
  (setq last-proc proc)
  (let ((instance (cons 'gdb-instance proc)))
    (save-excursion
      (set-buffer (process-buffer proc))
      (setq gdb-buffer-instance instance)
      (progn
	(mapcar 'make-variable-buffer-local gdb-instance-variables)
	(setq gdb-buffer-type 'gdba)
	;; If we're taking over the buffer of another process,
	;; take over it's ancillery buffers as well.
	;;
	(let ((dead (or old-gdb-buffer-instance)))
	  (mapcar
	   (function
	    (lambda (b)
	      (progn
		(set-buffer b)
		(if (eq dead gdb-buffer-instance)
		    (setq gdb-buffer-instance instance)))))
	     (buffer-list)))))
    instance))

(defun gdb-instance-process (inst) (cdr inst))

;;; The list of instance variables is built up by the expansions of

;;;
(defvar gdb-instance-variables '()
  "A list of variables that are local to the GUD buffer associated
with a gdb instance.")

(defmacro def-gdb-variable
  (name accessor setter &optional default doc)
  `(progn
     (defvar ,name ,default ,(or doc "undocumented"))
     (if (not (memq ',name gdb-instance-variables))
	 (setq gdb-instance-variables
	       (cons ',name gdb-instance-variables)))

  (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 "")
	   (flag t) (indices-string ""))
      (while gdb-value-list
	(string-match "{*\\([^}]*\\)\\(}*\\)" (car gdb-value-list))
	(setq num 0)
	(while (< num depth)

	(setq num (+ num 1)))
      (insert
       (concat "\n     Slice : " array-slice "\n\nIndex\tValues\n\n"))))
  (setq buffer-read-only t))

(defvar gdb-dive-map nil)
(setq gdb-dive-map (make-keymap))
(define-key gdb-dive-map [mouse-2] 'gdb-dive)
(define-key gdb-dive-map [S-mouse-2] 'gdb-dive-new-frame)

(defun gdb-dive (event)

  (interactive)
  (save-excursion
    (beginning-of-line 1)
    (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
	(error "Not recognized as break/watchpoint line")
      (Gdb-instance-enqueue-idle-input
       gdb-buffer-instance
       (list
	(concat
	 (if (eq ?y (char-after (match-beginning 2)))
	     "server disable "

(defun gdb-display-gdb-buffer (instance)
  (interactive (list (gdb-needed-default-instance)))
  (gdb-display-buffer
   (gdb-get-create-instance-buffer instance 'gdba)))

(defun make-windows-menu (map)
  (define-key map [menu-bar displays]
    (cons "GDB-Windows" (make-sparse-keymap "GDB-Windows")))
  (define-key map [menu-bar displays gdb]
    '("Gdb" . gdb-display-gdb-buffer))
  (define-key map [menu-bar displays locals]

(define-key gud-minor-mode-map "\C-c\M-\C-r" 'gdb-display-registers-buffer)
(define-key gud-minor-mode-map "\C-c\M-\C-f" 'gdb-display-stack-buffer)
(define-key gud-minor-mode-map "\C-c\M-\C-b" 'gdb-display-breakpoints-buffer)

(make-windows-menu gud-minor-mode-map)

(defun gdb-frame-gdb-buffer (instance)
  (interactive (list (gdb-needed-default-instance)))
  (switch-to-buffer-other-frame
   (gdb-get-create-instance-buffer instance 'gdba)))

(defun make-frames-menu (map)
  (define-key map [menu-bar frames]
    (cons "GDB-Frames" (make-sparse-keymap "GDB-Frames")))
  (define-key map [menu-bar frames gdb]
    '("Gdb" . gdb-frame-gdb-buffer))
  (define-key map [menu-bar frames locals]

    '("Display" . gdb-frame-display-buffer))
  (define-key map [menu-bar frames  assembler]
    '("Assembler" . gdb-frame-assembler-buffer)))

(if (display-graphic-p)
    (make-frames-menu gud-minor-mode-map))

(defvar gdb-target-name "--unknown--"
  "The apparent name of the program being debugged in a gud buffer.")

(defun gdb-proc-died (proc)
  ;; Stop displaying an arrow in a source file.
  (setq overlay-arrow-position nil)

  (switch-to-buffer (gdb-breakpoints-buffer-name instance))
  (other-window 1))

(defun gdb-restore-windows ()
  "Restore the basic arrangement of windows used by gdba.
This arrangement depends on the value of `gdb-many-windows'"
  (interactive)
  (if gdb-many-windows
      (progn
	(switch-to-buffer gud-comint-buffer)
	(delete-other-windows)

      (aset gdb-array-stop n stop)))
  (gdb-array-format1))

(defun gdb-array-visualise ()
  "Visualise arrays and slices using graph program from plotutils."
  (Interactive)
  (if (and (display-graphic-p) gdb-display-string)
     (let ((n 0) m)
       (catch 'multi-dimensional
       (while (eq (aref gdb-array-start n) (aref gdb-array-stop n))
	 (setq n (+ n 1)))

	     (progn
	       (x-popup-dialog
		t `(,(concat "Only one dimensional data can be visualised.\n"
			     "Use an array slice to reduce the number of\n"
			     "dimensions") ("OK" t)))
	       (throw 'multi-dimensional))
	   (setq m (+ m 1))))
       (shell-command (concat "echo" gdb-display-string " | graph -a 1 "
			      (int-to-string (aref gdb-array-start n))
			      " -x "
			      (int-to-string (aref gdb-array-start n))

  gdb-assembler-custom)

(defun gdb-assembler-custom ()
  (let ((buffer (gdb-get-instance-buffer gdb-buffer-instance
					 'gdb-assembler-buffer))
	(gdb-arrow-position))
    (if gdb-current-address
	(progn
	  (save-excursion
	    (set-buffer buffer)
	    (remove-arrow)

48498:8fdedd7dca85

(defvar gdb-main-file nil "Source file from which program execution begins.")
(defvar gdb-cdir nil "Compilation directory.")
(defvar gdb-main-or-pc nil "Initialisation for Assembler buffer.")
(defvar gdb-prev-main-or-pc nil)
(defvar gdb-current-address nil)
(defvar gdb-current-frame nil)
(defvar gdb-display-in-progress nil)
(defvar gdb-dive nil)
(defvar gdb-first-time nil)
(defvar breakpoint-enabled-icon 
  "Icon for enabled breakpoint in display margin")
(defvar breakpoint-disabled-icon 
  "Icon for disabled breakpoint in display margin")
(defvar gdb-nesting-level)
(defvar gdb-expression-buffer-name)
(defvar gdb-expression)
(defvar gdb-point)
(defvar gdb-annotation-arg)
(defvar gdb-array-start)
(defvar gdb-array-stop)
(defvar gdb-display-number)
(defvar gdb-dive-display-number)
(defvar gdb-dive-map nil)
(defvar gdb-display-string)
(defvar gdb-values)
(defvar gdb-array-size)
(defvar gdb-array-slice-map nil)
(defvar gdb-buffer-instance nil)
(defvar gdb-source-window nil)
(defvar gdb-target-name "--unknown--"
  "The apparent name of the program being debugged in a gud buffer.")

(defun gdba (command-line)
  "Run gdb on program FILE in buffer *gdb-FILE*.
The directory containing FILE becomes the initial working directory
and source-file directory for your debugger.

;; gdb-instance objects
;;

(defun make-gdb-instance (proc)
  "Create a gdb instance object from a gdb process."
  (let ((instance (cons 'gdb-instance proc)))
    (with-current-buffer (process-buffer proc)
      (setq gdb-buffer-instance instance)
      (progn
	(mapc 'make-local-variable gdb-instance-variables)
	(setq gdb-buffer-type 'gdba)
	;; If we're taking over the buffer of another process,
	;; take over it's ancillary buffers as well.
	;;
	(let ((dead old-gdb-buffer-instance))
	  (dolist (b (buffer-list))
		(set-buffer b)
		(if (eq dead gdb-buffer-instance)
		(setq gdb-buffer-instance instance))))))
    instance))

(defun gdb-instance-process (inst) (cdr inst))

;;; The list of instance variables is built up by the expansions of

;;;
(defvar gdb-instance-variables '()
  "A list of variables that are local to the GUD buffer associated
with a gdb instance.")

(defmacro def-gdb-variable (name accessor setter &optional default doc)
  `(progn
     (defvar ,name ,default ,(or doc "undocumented"))
     (if (not (memq ',name gdb-instance-variables))
	 (setq gdb-instance-variables
	       (cons ',name gdb-instance-variables)))

  (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 ""))
      (while gdb-value-list
	(string-match "{*\\([^}]*\\)\\(}*\\)" (car gdb-value-list))
	(setq num 0)
	(while (< num depth)

	(setq num (+ num 1)))
      (insert
       (concat "\n     Slice : " array-slice "\n\nIndex\tValues\n\n"))))
  (setq buffer-read-only t))

(setq gdb-dive-map (make-keymap))
(define-key gdb-dive-map [mouse-2] 'gdb-dive)
(define-key gdb-dive-map [S-mouse-2] 'gdb-dive-new-frame)

(defun gdb-dive (event)

  (interactive)
  (save-excursion
    (beginning-of-line 1)
    (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
	(error "Not recognized as break/watchpoint line")
      (gdb-instance-enqueue-idle-input
       gdb-buffer-instance
       (list
	(concat
	 (if (eq ?y (char-after (match-beginning 2)))
	     "server disable "

(defun gdb-display-gdb-buffer (instance)
  (interactive (list (gdb-needed-default-instance)))
  (gdb-display-buffer
   (gdb-get-create-instance-buffer instance 'gdba)))

(defun gdb-make-windows-menu (map)
  ;; FIXME: This adds to the DBX, PerlDB, ... menu as well :-(
  ;; Probably we should create gdb-many-windows-map and put those menus
  ;; on that map.
  (define-key map [menu-bar displays]
    (cons "GDB-Windows" (make-sparse-keymap "GDB-Windows")))
  (define-key map [menu-bar displays gdb]
    '("Gdb" . gdb-display-gdb-buffer))
  (define-key map [menu-bar displays locals]

(define-key gud-minor-mode-map "\C-c\M-\C-r" 'gdb-display-registers-buffer)
(define-key gud-minor-mode-map "\C-c\M-\C-f" 'gdb-display-stack-buffer)
(define-key gud-minor-mode-map "\C-c\M-\C-b" 'gdb-display-breakpoints-buffer)

(gdb-make-windows-menu gud-minor-mode-map)

(defun gdb-frame-gdb-buffer (instance)
  (interactive (list (gdb-needed-default-instance)))
  (switch-to-buffer-other-frame
   (gdb-get-create-instance-buffer instance 'gdba)))

(defun gdb-make-frames-menu (map)
  (define-key map [menu-bar frames]
    (cons "GDB-Frames" (make-sparse-keymap "GDB-Frames")))
  (define-key map [menu-bar frames gdb]
    '("Gdb" . gdb-frame-gdb-buffer))
  (define-key map [menu-bar frames locals]

    '("Display" . gdb-frame-display-buffer))
  (define-key map [menu-bar frames  assembler]
    '("Assembler" . gdb-frame-assembler-buffer)))

(if (display-graphic-p)
    (gdb-make-frames-menu gud-minor-mode-map))

(defun gdb-proc-died (proc)
  ;; Stop displaying an arrow in a source file.
  (setq overlay-arrow-position nil)

  (switch-to-buffer (gdb-breakpoints-buffer-name instance))
  (other-window 1))

(defun gdb-restore-windows ()
  "Restore the basic arrangement of windows used by gdba.
This arrangement depends on the value of `gdb-many-windows'."
  (interactive)
  (if gdb-many-windows
      (progn
	(switch-to-buffer gud-comint-buffer)
	(delete-other-windows)

      (aset gdb-array-stop n stop)))
  (gdb-array-format1))

(defun gdb-array-visualise ()
  "Visualise arrays and slices using graph program from plotutils."
  (interactive)
  (if (and (display-graphic-p) gdb-display-string)
     (let ((n 0) m)
       (catch 'multi-dimensional
       (while (eq (aref gdb-array-start n) (aref gdb-array-stop n))
	 (setq n (+ n 1)))

	     (progn
	       (x-popup-dialog
		t `(,(concat "Only one dimensional data can be visualised.\n"
			     "Use an array slice to reduce the number of\n"
			     "dimensions") ("OK" t)))
	       (throw 'multi-dimensional nil))
	   (setq m (+ m 1))))
       (shell-command (concat "echo" gdb-display-string " | graph -a 1 "
			      (int-to-string (aref gdb-array-start n))
			      " -x "
			      (int-to-string (aref gdb-array-start n))

  gdb-assembler-custom)

(defun gdb-assembler-custom ()
  (let ((buffer (gdb-get-instance-buffer gdb-buffer-instance
					 'gdb-assembler-buffer))
	(gdb-arrow-position) (address) (flag))
    (if gdb-current-address
	(progn
	  (save-excursion
	    (set-buffer buffer)
	    (remove-arrow)