unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* GUD improvement
@ 2003-02-12 21:06 Alexander Pohoyda
  0 siblings, 0 replies; 2+ messages in thread
From: Alexander Pohoyda @ 2003-02-12 21:06 UTC (permalink / raw)


[-- Attachment #1: Type: text/plain, Size: 1002 bytes --]

Hi,

Attached please find a patch for current gud.el, which assigns an
overlay for every breakpoint and for current debugging position.

Instead of => symbol, a line is highlighted with some color. That
helps *a lot* for some coding styles and big screens.
Active breakpoints are also highlighted with some other
color. Disabled breakpoints have their own color.

Breakpoints deleted within gdb itself using "delete 1" syntax are not
refreshed automatically, but if they are deleted with GUD's "C-x C-a
d", it works well. Alternatively, you may refresh all breakpoints
with "info breakpoints" command.

This mode is easily turned on/off with a new
`gud-extra-overlay-style' variable, which is customisable under `gud'
group.


I have been using this patch for one year now with older GUD, and have
made a patch agains current only today.

I hope that people will like it.
Comments and suggestions are welcome.
Thanks for your time and consideration.

-- 
Alexander Pohoyda
<alexander.pohoyda@gmx.net>


[-- Attachment #2: gud.el.diff --]
[-- Type: text/plain, Size: 9041 bytes --]

--- /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)))
 \f
+
+(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))))

[-- Attachment #3: Type: text/plain, Size: 148 bytes --]

_______________________________________________
Bug-gnu-emacs mailing list
Bug-gnu-emacs@gnu.org
http://mail.gnu.org/mailman/listinfo/bug-gnu-emacs

^ permalink raw reply	[flat|nested] 2+ messages in thread

* Re: GUD improvement
@ 2003-02-13 18:15 Nick Roberts
  0 siblings, 0 replies; 2+ messages in thread
From: Nick Roberts @ 2003-02-13 18:15 UTC (permalink / raw)
  Cc: bug-gnu-emacs


Alexander Pohoyda writes:

> Attached please find a patch for current gud.el, which assigns an
> overlay for every breakpoint and for current debugging position.

> Instead of => symbol, a line is highlighted with some color. That
> helps *a lot* for some coding styles and big screens.
> Active breakpoints are also highlighted with some other
> color. Disabled breakpoints have their own color.

> Breakpoints deleted within gdb itself using "delete 1" syntax are not
> refreshed automatically, but if they are deleted with GUD's "C-x C-a
> d", it works well. Alternatively, you may refresh all breakpoints
> with "info breakpoints" command.

Using Emacs built from the CVS repository, if you type `M-x gdba' you will get
a mode for GDB that has some of these features and more. Breakpoints are
displayed as red bullets in the display margin om a graphics terminal. They
are updated automatically even when set or deleted from the GUD buffer. This
mode (in gdb-ui.el) has other features: stack buffer, stream separation,
locals buffer, display windows etc. Please note, though, that it won't work
properly with a released version of Emacs so you can't just download the lisp
package.

Nick

^ permalink raw reply	[flat|nested] 2+ messages in thread

end of thread, other threads:[~2003-02-13 18:15 UTC | newest]

Thread overview: 2+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2003-02-13 18:15 GUD improvement Nick Roberts
  -- strict thread matches above, loose matches on Subject: below --
2003-02-12 21:06 Alexander Pohoyda

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).