From b6d0e4dad049bd1c3ea3a153c6cb8cebf04ea714 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Tue, 18 Jan 2005 11:28:19 +0000 Subject: [PATCH] (gdb-put-string): Copy/create strings so that enable/disabled state of breakpoints is shown correctly in fringe and on ttys. (gdb-put-breakpoint-icon, gdb-info-breakpoints-custom): Add breakpoint information as text properties. (gdb-mouse-toggle-breakpoint): Rename to gdb-mouse-set-clear-breakpoint. (gdb-mouse-toggle-breakpoint): New function. Enable/disable breakpoints in the margin. (gdb-remove-strings): Simplify. --- lisp/progmodes/gdb-ui.el | 127 +++++++++++++++++++++++++++++++---------------- 1 file changed, 83 insertions(+), 44 deletions(-) diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el index aef997d2a66..ad081c2ac9e 100644 --- a/lisp/progmodes/gdb-ui.el +++ b/lisp/progmodes/gdb-ui.el @@ -33,24 +33,28 @@ ;; Emacs 21 such as the fringe/display margin for breakpoints, and the toolbar ;; (see the GDB Graphical Interface section in the Emacs info manual). -;; Start the debugger with M-x gdba. - -;; This file has evolved from gdba.el from GDB 5.0 written by Tom Lord and Jim -;; Kingdon and uses GDB's annotation interface. You don't need to know about -;; annotations to use this mode as a debugger, but if you are interested -;; developing the mode itself, then see the Annotations section in the GDB -;; info manual. +;; By default, M-x gdb will start the debugger. However, if you have customised +;; gud-gdb-command-name, then start it with M-x gdba. + +;; This file has evolved from gdba.el that was included with GDB 5.0 and +;; written by Tom Lord and Jim Kingdon. It uses GDB's annotation interface. +;; You don't need to know about annotations to use this mode as a debugger, +;; but if you are interested developing the mode itself, then see the +;; Annotations section in the GDB info manual. ;; ;; GDB developers plan to make the annotation interface obsolete. A new ;; interface called GDB/MI (machine interface) has been designed to replace ;; it. Some GDB/MI commands are used in this file through the CLI command -;; 'interpreter mi '. A file called gdb-mi.el is included in the -;; GDB repository for future releases (6.2 onwards) that uses GDB/MI as the -;; primary interface to GDB. It is still under development and is part of a -;; process to migrate Emacs from annotations to GDB/MI. +;; 'interpreter mi '. A file called gdb-mi.el is included with +;; GDB (6.2 onwards) that uses GDB/MI as the primary interface to GDB. It is +;; still under development and is part of a process to migrate Emacs from +;; annotations to GDB/MI. ;; ;; Known Bugs: ;; +;; TODO: +;; Use tree-widget.el instead of the speedbar for watch-expressions? +;; Mark breakpoint locations on scroll-bar of source buffer? ;;; Code: @@ -169,13 +173,13 @@ detailed description of this mode. (defvar gdb-debug-log nil) (defcustom gdb-enable-debug-log nil - "Non-nil means record the process input and output in `gdb-debug-log'." + "Non-nil means record the process input and output in `gdb-debug-log'." :type 'boolean :group 'gud :version "21.4") (defcustom gdb-use-inferior-io-buffer nil - "Non-nil means display output from the inferior in a separate buffer." + "Non-nil means display output from the inferior in a separate buffer." :type 'boolean :group 'gud :version "21.4") @@ -210,9 +214,13 @@ detailed description of this mode. "\C-u" "Continue to current line or address.") (define-key gud-minor-mode-map [left-margin mouse-1] - 'gdb-mouse-toggle-breakpoint) + 'gdb-mouse-set-clear-breakpoint) (define-key gud-minor-mode-map [left-fringe mouse-1] + 'gdb-mouse-set-clear-breakpoint) + (define-key gud-minor-mode-map [left-margin mouse-3] 'gdb-mouse-toggle-breakpoint) +; (define-key gud-minor-mode-map [left-fringe mouse-3] +; 'gdb-mouse-toggle-breakpoint) (setq comint-input-sender 'gdb-send) ;; @@ -281,7 +289,7 @@ detailed description of this mode. (Info-goto-node "(emacs)GDB Graphical Interface")) (defconst gdb-var-create-regexp -"name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"") + "name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"") (defun gdb-var-create-handler (expr) (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) @@ -328,7 +336,7 @@ detailed description of this mode. `(lambda () (gdb-var-list-children-handler ,varnum))))) (defconst gdb-var-list-children-regexp -"name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\"") + "name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\"") (defun gdb-var-list-children-handler (varnum) (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) @@ -1038,7 +1046,8 @@ happens to be appropriate." (defvar gdb-cdir nil "Compilation directory.") -(defconst breakpoint-xpm-data "/* XPM */ +(defconst breakpoint-xpm-data + "/* XPM */ static char *magick[] = { /* columns rows colors chars-per-pixel */ \"10 10 2 1\", @@ -1059,7 +1068,7 @@ static char *magick[] = { "XPM data used for breakpoint icon.") (defconst breakpoint-enabled-pbm-data -"P1 + "P1 10 10\", 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 @@ -1074,7 +1083,7 @@ static char *magick[] = { "PBM data used for enabled breakpoint icon.") (defconst breakpoint-disabled-pbm-data -"P1 + "P1 10 10\", 0 0 1 0 1 0 1 0 0 0 0 1 0 1 0 1 0 1 0 0 @@ -1116,8 +1125,7 @@ static char *magick[] = { ;;-put breakpoint icons in relevant margins (even those set in the GUD buffer) (defun gdb-info-breakpoints-custom () - (let ((flag)) - ;; + (let ((flag) (bptno)) ;; remove all breakpoint-icons in source buffers but not assembler buffer (dolist (buffer (buffer-list)) (with-current-buffer buffer @@ -1131,12 +1139,13 @@ static char *magick[] = { (forward-line 1) (if (looking-at "[^\t].*breakpoint") (progn - (looking-at "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)") - (setq flag (char-after (match-beginning 1))) + (looking-at "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)") + (setq bptno (match-string 1)) + (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]+\\)") + (looking-at "\\(\\S-+\\):\\([0-9]+\\)") (let ((line (match-string 2)) (buffer-read-only nil) (file (match-string 1))) (add-text-properties (point-at-bol) (point-at-eol) @@ -1153,12 +1162,12 @@ static char *magick[] = { ;; only want one breakpoint icon at each location (save-excursion (goto-line (string-to-number line)) - (gdb-put-breakpoint-icon (eq flag ?y))))))))) + (gdb-put-breakpoint-icon (eq flag ?y) bptno)))))))) (end-of-line))))) (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom))) -(defun gdb-mouse-toggle-breakpoint (event) - "Toggle breakpoint in left fringe/margin with mouse click." +(defun gdb-mouse-set-clear-breakpoint (event) + "Set/clear breakpoint in left fringe/margin with mouse click." (interactive "e") (mouse-minibuffer-check event) (let ((posn (event-end event))) @@ -1172,6 +1181,31 @@ static char *magick[] = { (gud-remove nil) (gud-break nil))))))) +(defun gdb-mouse-toggle-breakpoint (event) + "Enable/disable breakpoint in left fringe/margin with mouse click." + (interactive "e") + (mouse-minibuffer-check event) + (let ((posn (event-end event))) + (if (numberp (posn-point posn)) + (with-selected-window (posn-window posn) + (save-excursion + (goto-char (posn-point posn)) + (if +; (or + (posn-object posn) +; (eq (car (fringe-bitmaps-at-pos (posn-point posn))) +; 'breakpoint)) + (gdb-enqueue-input + (list + (let ((bptno (get-text-property + 0 'gdb-bptno (car (posn-string posn))))) + (concat + (if (get-text-property + 0 'gdb-enabled (car (posn-string posn))) + "disable " + "enable ") + bptno "\n")) 'ignore)))))))) + (defun gdb-breakpoints-buffer-name () (with-current-buffer gud-comint-buffer (concat "*breakpoints of " (gdb-get-target-string) "*"))) @@ -1227,7 +1261,7 @@ static char *magick[] = { 'gdbmi-invalidate-breakpoints)) (defun gdb-toggle-breakpoint () - "Enable/disable the breakpoint at current line." + "Enable/disable breakpoint at current line." (interactive) (save-excursion (beginning-of-line 1) @@ -1707,7 +1741,7 @@ of the inferior. Non-nil means display the layout shown for :version "21.4") (defun gdb-many-windows (arg) -"Toggle the number of windows in the basic arrangement." + "Toggle the number of windows in the basic arrangement." (interactive "P") (setq gdb-many-windows (if (null arg) @@ -1777,14 +1811,15 @@ buffers." PUTSTRING is displayed by putting an overlay into the current buffer with a `before-string' STRING that has a `display' property whose value is PUTSTRING." - (let ((gdb-string "x") + (let ((string (make-string 1 ?x)) (buffer (current-buffer))) + (setq putstring (copy-sequence putstring)) (let ((overlay (make-overlay pos pos buffer)) (prop (or dprop (list (list 'margin 'left-margin) putstring)))) - (put-text-property 0 (length gdb-string) 'display prop gdb-string) + (put-text-property 0 (length string) 'display prop string) (overlay-put overlay 'put-break t) - (overlay-put overlay 'before-string gdb-string)))) + (overlay-put overlay 'before-string string)))) ;;from remove-images (defun gdb-remove-strings (start end &optional buffer) @@ -1793,25 +1828,27 @@ Remove only strings that were put in BUFFER with calls to `gdb-put-string'. BUFFER nil or omitted means use the current buffer." (unless buffer (setq buffer (current-buffer))) - (let ((overlays (overlays-in start end))) - (while overlays - (let ((overlay (car overlays))) + (dolist (overlay (overlays-in start end)) (when (overlay-get overlay 'put-break) - (delete-overlay overlay))) - (setq overlays (cdr overlays))))) + (delete-overlay overlay)))) -(defun gdb-put-breakpoint-icon (enabled) +(defun gdb-put-breakpoint-icon (enabled bptno) (let ((start (progn (beginning-of-line) (- (point) 1))) - (end (progn (end-of-line) (+ (point) 1)))) + (end (progn (end-of-line) (+ (point) 1))) + (putstring (if enabled "B" "b"))) + (if enabled (add-text-properties + 0 1 `(gdb-bptno ,bptno gdb-enabled t) putstring) + (add-text-properties + 0 1 `(gdb-bptno ,bptno gdb-enabled nil) putstring)) (gdb-remove-breakpoint-icons start end) (if (display-images-p) (if (>= (car (window-fringes)) 8) (gdb-put-string nil (1+ start) `(left-fringe breakpoint - ,(if enabled - 'breakpoint-enabled-bitmap-face - 'breakpoint-disabled-bitmap-face))) + ,(if enabled + 'breakpoint-enabled-bitmap-face + 'breakpoint-disabled-bitmap-face))) (when (< left-margin-width 2) (save-current-buffer (setq left-margin-width 2) @@ -1838,7 +1875,9 @@ BUFFER nil or omitted means use the current buffer." (:type pbm :data ,breakpoint-disabled-pbm-data :ascent 100)))))) - (+ start 1) nil 'left-margin)) + (+ start 1) + putstring + 'left-margin)) (when (< left-margin-width 2) (save-current-buffer (setq left-margin-width 2) @@ -1846,7 +1885,7 @@ BUFFER nil or omitted means use the current buffer." (set-window-margins (get-buffer-window (current-buffer) 0) left-margin-width right-margin-width)))) - (gdb-put-string (if enabled "B" "b") (1+ start))))) + (gdb-put-string putstring (1+ start))))) (defun gdb-remove-breakpoint-icons (start end &optional remove-margin) (gdb-remove-strings start end) -- 2.11.4.GIT