--- /workspace/emacs/lisp/gud.el Mon Feb 10 22:55:00 2003 +++ ../lisp/gud.el Wed Feb 12 13:57:02 2003 @@ -194,6 +194,27 @@ (make-local-variable 'gud-keep-buffer)) buf))) + +(defcustom gud-extra-overlay-style nil + "Non-nil if GUD should highlight current execution line and lines with breakpoints." + :type 'boolean + :group 'gud) + +;; Defines a new style to display a current line when debugging. +(defvar gud-current-debug-line-style + (make-face 'gud-current-debug-line-style)) +(set-face-background gud-current-debug-line-style "Gold") + +;; Defines a new style to display a line with a breakpoint. +(defvar gud-breakpoint-line-style + (make-face 'gud-breakpoint-line-style)) +(set-face-background gud-breakpoint-line-style "IndianRed") + +;; Defines a new style to display a line with a disabled breakpoint. +(defvar gud-dis-breakpoint-line-style + (make-face 'gud-dis-breakpoint-line-style)) +(set-face-background gud-dis-breakpoint-line-style "Pink") + ;; ====================================================================== ;; command definition @@ -385,8 +406,95 @@ (make-variable-buffer-local 'gud-marker-acc) (defun gud-gdb-marker-filter (string) - (setq gud-marker-acc (concat gud-marker-acc string)) + (setq gud-marker-acc (concat (or gud-marker-acc "") string)) (let ((output "")) + (cond + ;; No breakpoints. + ((equal 0 + (string-match "No breakpoints" string)) + ;; Delete all breakpoint overlays. + (gud-delete-overlays 'face gud-breakpoint-line-style) + (gud-delete-overlays 'face gud-dis-breakpoint-line-style)) + + ;; Info on breakpoints. + ((equal 0 + (string-match "Num[ ]+Type[ ]+Disp[ ]+Enb[ ]+Address[ ]+What" + string)) + ;; Delete all breakpoint overlays. + (gud-delete-overlays 'face gud-breakpoint-line-style) + (gud-delete-overlays 'face gud-dis-breakpoint-line-style) + (let ((temp-buffer "*gud-breakpoints*")) + (save-excursion + (generate-new-buffer temp-buffer) + (set-buffer temp-buffer) + (insert string) + ;; Delete the header. + (goto-char (point-min)) + (delete-region (point-min) + (save-excursion + (goto-char (point-min)) + (forward-line) + (point))) + (while (re-search-forward "\\([0-9]+\\)[ ]+breakpoint[ ]+keep[ ]+\\(y\\|n\\)[ ]+[0-9a-fx]+.*[ \n\t]*at \\([^:]*\\):\\([0-9]+\\)" (point-max) t) + (let* ((ovl) + (num (match-string 1)) + (ena (match-string 2)) + (file (match-string 3)) + (buffer file) + (line (string-to-number (match-string 4)))) + (if (get-buffer buffer) + (save-excursion + ;; Switch to the source buffer to find a right point + ;; position later. + (set-buffer buffer) + ;; Create an overlay for every new breakpoint. + (setq ovl + (make-overlay + (progn (goto-line line) (beginning-of-line) (point)) + (progn (goto-line (1+ line)) (beginning-of-line) + (point)))) + (if (string= "y" ena) + (overlay-put ovl 'face gud-breakpoint-line-style) + (overlay-put ovl 'face gud-dis-breakpoint-line-style)) + (overlay-put ovl 'number num)))))) + (kill-buffer temp-buffer))) + + ;; Delete a breakpoint. + ((equal 0 + (string-match "Deleted breakpoint \\([0-9]+\\)" + string)) + (gud-delete-overlays 'number (match-string 1 string))) + + ;; Delete all breakpoints at a given line. + ((equal 0 + (string-match "Deleted breakpoints \\([0-9 ]+\\)" string)) + (let ((str (match-string 1 string)) + (start 0)) + ;; Enumerate all breakpoint numbers, and delete them one by one. + (while (string-match "\\([0-9]+\\) " str start) + (gud-delete-overlays 'number (match-string 1 str)) + (setq start (match-end 0))))) + + ;; Insert a breakpoint. + ((equal 0 + (string-match "Breakpoint \\([0-9]+\\).*file \\([^,]*\\), line \\([0-9]+\\)\." + string)) + (let ((ovl) + (buffer (match-string 2 string)) + (line (string-to-number (match-string 3 string)))) + (if (get-buffer buffer) + (save-excursion + ;; Switch to the source buffer to find a right point + ;; position later. + (set-buffer buffer) + ;; Create an overlay for every new breakpoint. + (setq ovl + (make-overlay + (progn (goto-line line) (beginning-of-line) (point)) + (progn (goto-line (1+ line)) (beginning-of-line) + (point)))) + (overlay-put ovl 'face gud-breakpoint-line-style) + (overlay-put ovl 'number (match-string 1 string))))))) ;; Process all the complete markers in this chunk. (while (string-match gud-gdb-marker-regexp gud-marker-acc) @@ -2278,6 +2386,36 @@ (defvar gud-target-name "--unknown--" "The apparent name of the program being debugged in a gud buffer.") +(defun gud-delete-overlays (prop &optional value) + "Deletes all overlays with PROP set to VALUE." + (let ((ovl) + (buffer) + (buffers (buffer-list))) + (save-excursion + ;; Walk all buffers and search overlays. + (while (car buffers) + (setq buffer (car buffers)) + (if (get-buffer buffer) + (progn + (set-buffer buffer) + (while (setq ovl (gud-find-overlay (overlay-lists) prop value)) + (delete-overlay ovl)) + (setq buffers (cdr buffers)))))))) + +(defun gud-find-overlay (overlays prop &optional value) + "Returns a first overlay with a given PROP set to VALUE. If VALUE is t, returns an overlays with a given PROP set." + (let ((ret) (ovl) + (ovls (nconc (car overlays) (cdr overlays)))) + (while (car ovls) + (setq ovl (car ovls)) + (if (and (overlayp ovl) + (or (equal (overlay-get ovl prop) value) + (and (overlay-get ovl prop) + (equal t value)))) + (setq ret ovl)) + (setq ovls (cdr ovls))) + ret)) + ;; Perform initializations common to all debuggers. ;; The first arg is the specified command line, ;; which starts with the program to debug. @@ -2429,13 +2567,26 @@ ;; buffer killed ;; Stop displaying an arrow in a source file. (setq overlay-arrow-position nil) + (if gud-extra-overlay-style + (progn + ;; Delete all style overlays. + (gud-delete-overlays 'face gud-breakpoint-line-style) + (gud-delete-overlays 'face gud-dis-breakpoint-line-style) + (gud-delete-overlays 'face gud-current-debug-line-style))) (set-process-buffer proc nil) (if (eq gud-minor-mode-type 'gdba) (gdb-reset) (gud-reset))) ((memq (process-status proc) '(signal exit)) + ;; debugger quited ;; Stop displaying an arrow in a source file. (setq overlay-arrow-position nil) + (if gud-extra-overlay-style + (progn + ;; Delete all style overlays. + (gud-delete-overlays 'face gud-breakpoint-line-style) + (gud-delete-overlays 'face gud-dis-breakpoint-line-style) + (gud-delete-overlays 'face gud-current-debug-line-style))) (with-current-buffer gud-comint-buffer (if (eq gud-minor-mode 'gdba) (gdb-reset) @@ -2524,10 +2675,31 @@ (widen) (goto-line line) (setq pos (point)) - (setq overlay-arrow-string "=>") + (if (not gud-extra-overlay-style) + (setq overlay-arrow-string "=>")) (or overlay-arrow-position - (setq overlay-arrow-position (make-marker))) - (set-marker overlay-arrow-position (point) (current-buffer))) + (setq overlay-arrow-position (make-marker))) + (set-marker overlay-arrow-position (point) (current-buffer)) + (if gud-extra-overlay-style + (progn + (let ((curr-line-overlay + (or (gud-find-overlay (overlay-lists) 'face + gud-current-debug-line-style) + (let ((ovl (make-overlay 0 0))) + (overlay-put ovl 'face + gud-current-debug-line-style) + ;; Show this overlay over all breakpoints. + (overlay-put ovl 'priority 2) + ovl)))) + (if curr-line-overlay + (move-overlay curr-line-overlay + (save-excursion + (beginning-of-line) + (point)) + (save-excursion + (beginning-of-line) + (forward-line) + (point)))))))) (cond ((or (< pos (point-min)) (> pos (point-max))) (widen) (goto-char pos))))