From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Alexander Pohoyda Newsgroups: gmane.emacs.bugs Subject: GUD improvement Date: Wed, 12 Feb 2003 22:06:15 +0100 (CET) Sender: bug-gnu-emacs-bounces+gnu-bug-gnu-emacs=m.gmane.org@gnu.org Message-ID: <200302122106.h1CL6FbM000562@oak.pohoyda.family> NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="2003-02-12T22:03:45+0100_=_d45e3272" Content-Transfer-Encoding: 8bit X-Trace: main.gmane.org 1045086317 31258 80.91.224.249 (12 Feb 2003 21:45:17 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Wed, 12 Feb 2003 21:45:17 +0000 (UTC) Return-path: Original-Received: from monty-python.gnu.org ([199.232.76.173]) by main.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 18j4WM-0007Iq-00 for ; Wed, 12 Feb 2003 22:34:22 +0100 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.10.13) id 18j4WF-0002IS-04 for gnu-bug-gnu-emacs@m.gmane.org; Wed, 12 Feb 2003 16:34:15 -0500 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.10.13) id 18j4Vk-0001z2-00 for bug-gnu-emacs@gnu.org; Wed, 12 Feb 2003 16:33:44 -0500 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.10.13) id 18j4VU-0001bm-00 for bug-gnu-emacs@gnu.org; Wed, 12 Feb 2003 16:33:29 -0500 Original-Received: from mail.gmx.net ([213.165.65.60]) by monty-python.gnu.org with smtp (Exim 4.10.13) id 18j4VP-0001YW-00 for bug-gnu-emacs@gnu.org; Wed, 12 Feb 2003 16:33:24 -0500 Original-Received: (qmail 23481 invoked by uid 0); 12 Feb 2003 21:33:22 -0000 Original-Received: from p508BE736.dip.t-dialin.net (HELO oak.pohoyda.family) (80.139.231.54) by mail.gmx.net (mp008-rz3) with SMTP; 12 Feb 2003 21:33:22 -0000 Original-Received: from oak.pohoyda.family (oak.pohoyda.family [127.0.0.1]) by oak.pohoyda.family (8.12.6/8.12.6) with ESMTP id h1CL6GsN000567; Wed, 12 Feb 2003 22:06:17 +0100 (CET) (envelope-from apog@oak.pohoyda.family) Original-Received: (from apog@localhost) by oak.pohoyda.family (8.12.6/8.12.6/Submit) id h1CL6FbM000562; Wed, 12 Feb 2003 22:06:15 +0100 (CET) Original-To: bug-gnu-emacs@gnu.org X-BeenThere: bug-gnu-emacs@gnu.org X-Mailman-Version: 2.1b5 Precedence: list List-Id: Bug reports for GNU Emacs, the Swiss army knife of text editors List-Help: List-Post: List-Subscribe: , List-Archive: List-Unsubscribe: , Errors-To: bug-gnu-emacs-bounces+gnu-bug-gnu-emacs=m.gmane.org@gnu.org Xref: main.gmane.org gmane.emacs.bugs:4443 X-Report-Spam: http://spam.gmane.org/gmane.emacs.bugs:4443 > This is a multipart message in MIME format. --2003-02-12T22:03:45+0100_=_d45e3272 Content-Type: text/plain; charset="us-ascii" Content-Transfer-Encoding: 7bit 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 --2003-02-12T22:03:45+0100_=_d45e3272 Content-Type: text/plain; charset="us-ascii" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="gud.el.diff" Content-Description: gud.el.diff --- /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)))) --2003-02-12T22:03:45+0100_=_d45e3272 Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit _______________________________________________ Bug-gnu-emacs mailing list Bug-gnu-emacs@gnu.org http://mail.gnu.org/mailman/listinfo/bug-gnu-emacs --2003-02-12T22:03:45+0100_=_d45e3272--