diff lisp/progmodes/gdb-ui.el @ 90580:7f3f771c85fa

Merge from emacs--devo--0 Patches applied: * emacs--devo--0 (patch 382-398) - Update from CVS - Update from erc--emacs--22 - Fix ERC bug introduced in last patch - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 123-125) - Update from CVS Revision: [e-mail]/emacs--unicode--0--patch-101

--- a/lisp/progmodes/gdb-ui.el	Mon Aug 07 06:45:41 2006 +0000
+++ b/lisp/progmodes/gdb-ui.el	Wed Aug 16 14:08:49 2006 +0000
@@ -115,6 +115,7 @@
 (defvar gdb-main-file nil "Source file from which program execution begins.")
 (defvar gud-old-arrow nil)
 (defvar gdb-overlay-arrow-position nil)
+(defvar gdb-stack-position nil)
 (defvar gdb-server-prefix nil)
 (defvar gdb-flush-pending-output nil)
 (defvar gdb-location-alist nil
@@ -321,7 +322,7 @@
   :version "22.1")
 
 (defcustom gdb-use-separate-io-buffer nil
-  "Non-nil means display output from the inferior in a separate buffer."
+  "Non-nil means display output from the debugged program in a separate buffer."
   :type 'boolean
   :group 'gud
   :version "22.1")
@@ -353,14 +354,14 @@
 	(error nil))))
 
 (defun gdb-use-separate-io-buffer (arg)
-  "Toggle separate IO for inferior.
+  "Toggle separate IO for debugged program.
 With arg, use separate IO iff arg is positive."
   (interactive "P")
   (setq gdb-use-separate-io-buffer
 	(if (null arg)
 	    (not gdb-use-separate-io-buffer)
 	  (> (prefix-numeric-value arg) 0)))
-  (message (format "Separate inferior IO %sabled"
+  (message (format "Separate IO %sabled"
 		   (if gdb-use-separate-io-buffer "en" "dis")))
   (if (and gud-comint-buffer
 	   (buffer-name gud-comint-buffer))
@@ -1030,7 +1031,7 @@
     (minibuffer . nil)))
 
 (defun gdb-frame-separate-io-buffer ()
-  "Display IO of inferior in a new frame."
+  "Display IO of debugged program in a new frame."
   (interactive)
   (if gdb-use-separate-io-buffer
       (let ((special-display-regexps (append special-display-regexps '(".*")))
@@ -1296,6 +1297,7 @@
 	(setq gud-old-arrow gud-overlay-arrow-position)
 	(setq gud-overlay-arrow-position nil)
 	(setq gdb-overlay-arrow-position nil)
+	(setq gdb-stack-position nil)
 	(if gdb-use-separate-io-buffer
 	    (setq gdb-output-sink 'inferior))))
      (t
@@ -1330,6 +1332,7 @@
   (setq gdb-active-process nil)
   (setq gud-overlay-arrow-position nil)
   (setq gdb-overlay-arrow-position nil)
+  (setq gdb-stack-position nil)
   (setq gud-old-arrow nil)
   (setq gdb-inferior-status "exited")
   (gdb-force-mode-line-update
@@ -1776,9 +1779,8 @@
 	(goto-char (point-min))
 	(while (< (point) (- (point-max) 1))
 	  (forward-line 1)
-	  (if (looking-at "[^\t].*?breakpoint")
+	  (if (looking-at gdb-breakpoint-regexp)
 	      (progn
-		(looking-at "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)")
 		(setq bptno (match-string 1))
 		(setq flag (char-after (match-beginning 2)))
 		(add-text-properties
@@ -1786,43 +1788,55 @@
 		 (if (eq flag ?y)
 		     '(face font-lock-warning-face)
 		   '(face font-lock-type-face)))
-		(beginning-of-line)
-		(if (re-search-forward " in \\(.*\\) at\\s-+" nil t)
-		    (progn
+		(let ((bl (point))
+		      (el (line-end-position)))
+		  (if (re-search-forward " in \\(.*\\) at\\s-+" el t)
+		      (progn
+			(add-text-properties
+			 (match-beginning 1) (match-end 1)
+			 '(face font-lock-function-name-face))
+			(looking-at "\\(\\S-+\\):\\([0-9]+\\)")
+			(let ((line (match-string 2))
+			      (file (match-string 1)))
+			  (add-text-properties bl el
+			   '(mouse-face highlight
+			     help-echo "mouse-2, RET: visit breakpoint"))
+			  (unless (file-exists-p file)
+			    (setq file (cdr (assoc bptno gdb-location-alist))))
+			  (if (and file
+				   (not (string-equal file "File not found")))
+			      (with-current-buffer
+				  (find-file-noselect file 'nowarn)
+				(set (make-local-variable 'gud-minor-mode)
+				     'gdba)
+				(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) bptno)))
+			    (gdb-enqueue-input
+			     (list
+			      (concat gdb-server-prefix "list "
+				      (match-string-no-properties 1) ":1\n")
+			      'ignore))
+			    (gdb-enqueue-input
+			     (list (concat gdb-server-prefix "info source\n")
+				   `(lambda () (gdb-get-location
+						,bptno ,line ,flag)))))))
+		    (if (re-search-forward
+			 "<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>"
+			 el t)
+			(add-text-properties
+			 (match-beginning 1) (match-end 1)
+			 '(face font-lock-function-name-face))
+		      (end-of-line)
+		      (re-search-backward "\\s-\\(\\S-*\\)"
+					  bl t)
 		      (add-text-properties
 		       (match-beginning 1) (match-end 1)
-		       '(face font-lock-function-name-face))
-		      (looking-at "\\(\\S-+\\):\\([0-9]+\\)")
-		      (let ((line (match-string 2))
-			    (file (match-string 1)))
-			(add-text-properties (line-beginning-position)
-					     (line-end-position)
-			 '(mouse-face highlight
-			   help-echo "mouse-2, RET: visit breakpoint"))
-			(unless (file-exists-p file)
-			   (setq file (cdr (assoc bptno gdb-location-alist))))
-			(if (and file
-				 (not (string-equal file "File not found")))
-			    (with-current-buffer
-				(find-file-noselect file 'nowarn)
-			      (set (make-local-variable 'gud-minor-mode)
-				   'gdba)
-			      (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) bptno)))
-			  (gdb-enqueue-input
-			   (list
-			    (concat gdb-server-prefix "list "
-				    (match-string-no-properties 1) ":1\n")
-			    'ignore))
-			  (gdb-enqueue-input
-			   (list (concat gdb-server-prefix "info source\n")
-				 `(lambda () (gdb-get-location
-					      ,bptno ,line ,flag))))))))))
+		       '(face font-lock-variable-name-face)))))))
 	  (end-of-line))))))
   (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom)))
 
@@ -2026,8 +2040,14 @@
 	    (goto-char bl)
 	    (when (looking-at "^#\\([0-9]+\\)")
 	      (when (string-equal (match-string 1) gdb-frame-number)
-		(put-text-property bl (+ bl 4)
-				   'face '(:inverse-video t)))
+		(if (> (car (window-fringes)) 0)
+		    (progn
+		      (or gdb-stack-position
+			  (setq gdb-stack-position (make-marker)))
+		      (set-marker gdb-stack-position (point)))
+		  (set-marker gdb-stack-position nil)
+		  (put-text-property bl (+ bl 4)
+				     'face '(:inverse-video t))))
 	      (when (re-search-forward
 		     (concat
 		      (if (string-equal (match-string 1) "0") "" " in ")
@@ -2098,6 +2118,8 @@
   (kill-all-local-variables)
   (setq major-mode 'gdb-frames-mode)
   (setq mode-name "Frames")
+  (setq gdb-stack-position nil)
+  (add-to-list 'overlay-arrow-variable-list 'gdb-stack-position)
   (setq buffer-read-only t)
   (use-local-map gdb-frames-mode-map)
   (run-mode-hooks 'gdb-frames-mode-hook)
@@ -2549,18 +2571,18 @@
 	    'local-map
 	    (gdb-make-header-line-mouse-map
 	     'mouse-1
-	     #'(lambda () (interactive)
-		 (let ((gdb-memory-address
-			;; Let GDB do the arithmetic.
-			(concat
-			 gdb-memory-address " - "
-			 (number-to-string
-			  (* gdb-memory-repeat-count
-			     (cond ((string= gdb-memory-unit "b") 1)
-				   ((string= gdb-memory-unit "h") 2)
-				   ((string= gdb-memory-unit "w") 4)
-				   ((string= gdb-memory-unit "g") 8)))))))
-		       (gdb-invalidate-memory)))))
+	     (lambda () (interactive)
+	       (let ((gdb-memory-address
+		      ;; Let GDB do the arithmetic.
+		      (concat
+		       gdb-memory-address " - "
+		       (number-to-string
+			(* gdb-memory-repeat-count
+			   (cond ((string= gdb-memory-unit "b") 1)
+				 ((string= gdb-memory-unit "h") 2)
+				 ((string= gdb-memory-unit "w") 4)
+				 ((string= gdb-memory-unit "g") 8)))))))
+		 (gdb-invalidate-memory)))))
 	   "|"
 	   (propertize "+"
 		       'face font-lock-warning-face
@@ -2568,9 +2590,9 @@
 		       'mouse-face 'mode-line-highlight
 		       'local-map (gdb-make-header-line-mouse-map
 				   'mouse-1
-				   #'(lambda () (interactive)
-				       (let ((gdb-memory-address nil))
-					 (gdb-invalidate-memory)))))
+				   (lambda () (interactive)
+				     (let ((gdb-memory-address nil))
+				       (gdb-invalidate-memory)))))
 	   "]: "
 	   (propertize gdb-memory-address
 		       'face font-lock-warning-face
@@ -2635,13 +2657,13 @@
 
 (defvar gdb-locals-watch-map
   (let ((map (make-sparse-keymap)))
-    (define-key map "\r" '(lambda () (interactive)
-			    (beginning-of-line)
-			    (gud-watch)))
-    (define-key map [mouse-2] '(lambda (event) (interactive "e")
-				 (mouse-set-point event)
-				 (beginning-of-line)
-				 (gud-watch)))
+    (define-key map "\r" (lambda () (interactive)
+			   (beginning-of-line)
+			   (gud-watch)))
+    (define-key map [mouse-2] (lambda (event) (interactive "e")
+				(mouse-set-point event)
+				(beginning-of-line)
+				(gud-watch)))
     map)
  "Keymap to create watch expression of a complex data type local variable.")
 
@@ -2764,7 +2786,7 @@
   (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
   (define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
   (define-key menu [inferior]
-    '(menu-item "Inferior IO" gdb-display-separate-io-buffer
+    '(menu-item "Separate IO" gdb-display-separate-io-buffer
 		:enable gdb-use-separate-io-buffer))
   (define-key menu [memory] '("Memory" . gdb-display-memory-buffer))
   (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
@@ -2783,7 +2805,7 @@
   (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
   (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer))
   (define-key menu [inferior]
-    '(menu-item "Inferior IO" gdb-frame-separate-io-buffer
+    '(menu-item "Separate IO" gdb-frame-separate-io-buffer
 		:enable gdb-use-separate-io-buffer))
   (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
   (define-key menu [disassembly] '("Disassembly" . gdb-frame-assembler-buffer))
@@ -2802,9 +2824,9 @@
 	      :help "Toggle look for source frame."
 	      :button (:toggle . gdb-find-source-frame)))
   (define-key menu [gdb-use-separate-io]
-  '(menu-item "Separate Inferior IO" gdb-use-separate-io-buffer
+  '(menu-item "Separate IO" gdb-use-separate-io-buffer
 	      :visible (eq gud-minor-mode 'gdba)
-	      :help "Toggle separate IO for inferior."
+	      :help "Toggle separate IO for debugged program."
 	      :button (:toggle . gdb-use-separate-io-buffer)))
   (define-key menu [gdb-many-windows]
   '(menu-item "Display Other Windows" gdb-many-windows
@@ -2901,12 +2923,13 @@
 	      (setq gud-minor-mode nil)
 	      (kill-local-variable 'tool-bar-map)
 	      (kill-local-variable 'gdb-define-alist))))))
-  (when (markerp gdb-overlay-arrow-position)
-    (move-marker gdb-overlay-arrow-position nil)
-    (setq gdb-overlay-arrow-position nil))
+  (setq gdb-overlay-arrow-position nil)
   (setq overlay-arrow-variable-list
 	(delq 'gdb-overlay-arrow-position overlay-arrow-variable-list))
   (setq fringe-indicator-alist '((overlay-arrow . right-triangle)))
+  (setq gdb-stack-position nil)
+  (setq overlay-arrow-variable-list
+	(delq 'gdb-stack-position overlay-arrow-variable-list))
   (if (boundp 'speedbar-frame) (speedbar-timer-fn))
   (setq gud-running nil)
   (setq gdb-active-process nil)
@@ -3128,8 +3151,7 @@
 			    '((overlay-arrow . hollow-right-triangle))))
 		    (or gdb-overlay-arrow-position
 			(setq gdb-overlay-arrow-position (make-marker)))
-		    (set-marker gdb-overlay-arrow-position
-				(point) (current-buffer))))))
+		    (set-marker gdb-overlay-arrow-position (point))))))
 	;; remove all breakpoint-icons in assembler buffer before updating.
 	(gdb-remove-breakpoint-icons (point-min) (point-max))))
     (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)