emacs: lisp/progmodes/gdb-ui.el comparison

comparison lisp/progmodes/gdb-ui.el @ 90082:6d92d69fae33

Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-4 Merge from emacs--cvs-trunk--0 Patches applied: * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-41 - miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-46 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-47 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-4 Merge from emacs--cvs-trunk--0 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-5 Update from CVS: exi/gnus-faq.texi ([4.1]): Typo. * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-6 Update from CVS

author	Miles Bader <miles@gnu.org>
date	Sat, 22 Jan 2005 21:39:38 +0000
parents	f2ebccfa87d4 4d7bfec0bb4a
children	befae6bafecb

comparison

equal deleted inserted replaced

-:b1b6eac1aaa3
+:6d92d69fae33
 ;; It separates the input/output of your program from that of GDB, if
 ;; required, and watches expressions in the speedbar.  It also uses features of
 ;; 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.
+;; 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 from GDB 5.0 written by Tom Lord and Jim
-;; Kingdon and uses GDB's annotation interface.  You don't need to know about
+;; This file has evolved from gdba.el that was included with GDB 5.0 and
-;; annotations to use this mode as a debugger, but if you are interested
+;; written by Tom Lord and Jim Kingdon.  It uses GDB's annotation interface.
-;; developing the mode itself, then see the Annotations section in the GDB
+;; You don't need to know about annotations to use this mode as a debugger,
-;; info manual.
+;; 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 <mi-command>'.  A file called gdb-mi.el is included in the
+;; 'interpreter mi <mi-command>'.  A file called gdb-mi.el is included with
-;; GDB repository for future releases (6.2 onwards) that uses GDB/MI as the
+;; GDB (6.2 onwards) that uses GDB/MI as the primary interface to GDB.  It is
-;; primary interface to GDB.  It is still under development and is part of a
+;; still under development and is part of a process to migrate Emacs from
-;; process to migrate Emacs from annotations to GDB/MI.
+;; 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:
 (require 'gud)
 (gdb-ann3))
 (defvar gdb-debug-log nil)
 (defcustom gdb-enable-debug-log nil
 "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."
 :type 'boolean
 :group 'gud
 :version "21.4")
 (defun gdb-ann3 ()
 			  (forward-char 2)
 			  (gud-call "until *%a" arg)))
 	   "\C-u" "Continue to current line or address.")
 (define-key gud-minor-mode-map [left-margin mouse-1]
+'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-1]
+;  (define-key gud-minor-mode-map [left-fringe mouse-3]
-'gdb-mouse-toggle-breakpoint)
+;    'gdb-mouse-toggle-breakpoint)
 (setq comint-input-sender 'gdb-send)
 ;;
 ;; (re-)initialize
 (setq gdb-current-address "main")
 (select-frame (make-frame))
 (require 'info)
 (Info-goto-node "(emacs)GDB Graphical Interface"))
 (defconst gdb-var-create-regexp
 "name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"")
 (defun gdb-var-create-handler (expr)
 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
 (goto-char (point-min))
 (if (re-search-forward gdb-var-create-regexp nil t)
 (gdb-enqueue-input
 (list (concat "server interpreter mi \"-var-list-children "  varnum "\"\n")
 	     `(lambda () (gdb-var-list-children-handler ,varnum)))))
 (defconst gdb-var-list-children-regexp
 "name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\"")
 (defun gdb-var-list-children-handler (varnum)
 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
 (goto-char (point-min))
 (let ((var-list nil))
 ;; buffer specific functions
 gdb-info-breakpoints-custom)
 (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\",
 \"  c red\",
 \"+ c None\",
 \"+++    +++\",
 };"
 "XPM data used for breakpoint icon.")
 (defconst breakpoint-enabled-pbm-data
 "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
 0 0 1 1 1 1 1 1 1 1 0 0
 0 1 1 1 1 1 1 1 1 1 1 0
 0 0 0 1 1 1 1 1 1 0 0 0
 0 0 0 0 1 1 1 1 0 0 0 0"
 "PBM data used for enabled breakpoint icon.")
 (defconst breakpoint-disabled-pbm-data
 "P1
 10 10\",
 0 0 1 0 1 0 1 0 0 0
 0 1 0 1 0 1 0 1 0 0
 1 0 1 0 1 0 1 0 1 0
 0 1 0 1 0 1 0 1 0 1
 :group 'gud)
 ;;-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
 	(if (and (eq gud-minor-mode 'gdba)
 		 (not (string-match "\\`\\*.+\\*\\'" (buffer-name))))
 	(goto-char (point-min))
 	(while (< (point) (- (point-max) 1))
 	  (forward-line 1)
 	  (if (looking-at "[^\t].*breakpoint")
 	      (progn
-		(looking-at "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)")
+		(looking-at "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)")
-		(setq flag (char-after (match-beginning 1)))
+		(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)
 			 '(mouse-face highlight
 			   help-echo "mouse-2, RET: visit breakpoint"))
 			    (set (make-local-variable 'tool-bar-map)
 				 gud-tool-bar-map))
 			  ;; 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)
+(defun gdb-mouse-set-clear-breakpoint (event)
-"Toggle breakpoint in left fringe/margin with mouse click."
+"Set/clear 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)
 		    (eq (car (fringe-bitmaps-at-pos (posn-point posn)))
 			'breakpoint))
 		(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) "*")))
 (defun gdb-display-breakpoints-buffer ()
 (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
 'gdb-invalidate-breakpoints
 '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)
 (if (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
 	    (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)")
 :type 'boolean
 :group 'gud
 :version "21.4")
 (defun gdb-many-windows (arg)
 "Toggle the number of windows in the basic arrangement."
 (interactive "P")
 (setq gdb-many-windows
 	(if (null arg)
 	    (not gdb-many-windows)
 	  (> (prefix-numeric-value arg) 0)))
 (defun gdb-put-string (putstring pos &optional dprop)
 "Put string PUTSTRING in front of POS in the current buffer.
 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)
 "Remove strings between START and END in BUFFER.
 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)))
+(dolist (overlay (overlays-in start end))
-(while overlays
-(let ((overlay (car overlays)))
 	(when (overlay-get overlay 'put-break)
-	  (delete-overlay overlay)))
+	  (delete-overlay overlay))))
-(setq overlays (cdr overlays)))))
+(defun gdb-put-breakpoint-icon (enabled bptno)
-(defun gdb-put-breakpoint-icon (enabled)
 (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")))
+(add-text-properties
+0 1 '(help-echo "mouse-1: set/clear bkpt, mouse-3: enable/disable bkpt")
+putstring)
+(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
+			   ,(if enabled
-		    'breakpoint-enabled-bitmap-face
+				'breakpoint-enabled-bitmap-face
-		  'breakpoint-disabled-bitmap-face)))
+			      'breakpoint-disabled-bitmap-face)))
 	  (when (< left-margin-width 2)
 	    (save-current-buffer
 	      (setq left-margin-width 2)
 	      (if (get-buffer-window (current-buffer) 0)
 		  (set-window-margins
 					    :conversion disabled
 					    :ascent 100)
 				     (: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)
 	  (if (get-buffer-window (current-buffer) 0)
 	      (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)
 (if (display-images-p)
 (remove-images start end))

Mercurial > emacs

comparison lisp/progmodes/gdb-ui.el @ 90082:6d92d69fae33