changeset 54179:faca95e6c032

(breakpoint-enabled-icon, breakpoint-disabled-icon): Initialize margin area images to nil. (breakpoint-bitmap): New defvar for breakpoint fringe bitmaps. (breakpoint-enabled-bitmap-face) (breakpoint-disabled-bitmap-face): New faces for bpt in fringe. (gdb-info-breakpoints-custom): Use gdb-remove-breakpoint-icons. (gdb-info-breakpoints-custom): Use gdb-put-breakpoint-icon. (gdb-mouse-toggle-breakpoint): Handle bpt in fringe. (gdb-reset): Use gdb-remove-breakpoint-icons. (gdb-put-string): Add dprop arg to specify alternative display property (for setting fringe bitmap). (gdb-remove-strings): Doc fix. (gdb-put-breakpoint-icon): New defun which displays a breakpoint icon in fringe (if available), or else as icon or text in display margin. Creates necessary icons in breakpoint-bitmap, breakpoint-enabled-icon, and/or breakpoint-disabled-icon. Also make left window margin if required. (gdb-remove-breakpoint-icons): New defun to remove breakpoint icons inserted by gdb-put-breakpoint-icon. Remove left margin if no longer needed. (gdb-assembler-custom): Use gdb-remove-breakpoint-icons and gdb-put-breakpoint-icon. (gdb-assembler-mode): Don't set left-margin-width here.

--- a/lisp/gdb-ui.el	Sat Feb 28 01:02:51 2004 +0000
+++ b/lisp/gdb-ui.el	Sat Feb 28 01:32:01 2004 +0000
@@ -1017,16 +1017,28 @@
 0 0 0 1 0 1 0 1 0 0"
   "PBM data used for disabled breakpoint icon.")
 
-(defvar breakpoint-enabled-icon
-  (find-image `((:type xpm :data ,breakpoint-xpm-data :ascent 100)
-		(:type pbm :data ,breakpoint-enabled-pbm-data :ascent 100)))
+(defvar breakpoint-enabled-icon nil
   "Icon for enabled breakpoint in display margin")
 
-(defvar breakpoint-disabled-icon
-  (find-image `((:type xpm :data ,breakpoint-xpm-data :conversion disabled :ascent 100)
-		(:type pbm :data ,breakpoint-disabled-pbm-data :ascent 100)))
+(defvar breakpoint-disabled-icon nil
   "Icon for disabled breakpoint in display margin")
 
+(defvar breakpoint-bitmap nil
+  "Bitmap for breakpoint in fringe")
+
+(defface breakpoint-enabled-bitmap-face
+  '((t
+     :inherit fringe
+     :foreground "red"))
+  "Face for enabled breakpoint icon in fringe.")
+
+(defface breakpoint-disabled-bitmap-face
+  '((t
+     :inherit fringe
+     :foreground "grey60"))
+  "Face for disabled breakpoint icon in fringe.")
+
+
 ;;-put breakpoint icons in relevant margins (even those set in the GUD buffer)
 (defun gdb-info-breakpoints-custom ()
   (let ((flag)(address))
@@ -1036,9 +1048,7 @@
       (with-current-buffer buffer
 	(if (and (eq gud-minor-mode 'gdba)
 		 (not (string-match "^\*" (buffer-name))))
-	    (if (display-images-p)
-		(remove-images (point-min) (point-max))
-	      (gdb-remove-strings (point-min) (point-max))))))
+	    (gdb-remove-breakpoint-icons (point-min) (point-max)))))
     (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
       (save-excursion
 	(goto-char (point-min))
@@ -1064,35 +1074,11 @@
 			  (save-current-buffer
 			    (set (make-local-variable 'gud-minor-mode) 'gdba)
 			    (set (make-local-variable 'tool-bar-map)
-				 gud-tool-bar-map)
-			    (setq left-margin-width 2)
-			    (if (get-buffer-window (current-buffer))
-				(set-window-margins (get-buffer-window
-						     (current-buffer))
-						    left-margin-width
-						    right-margin-width)))
+				 gud-tool-bar-map))
 			  ;; only want one breakpoint icon at each location
 			  (save-excursion
 			    (goto-line (string-to-number line))
-			    (let ((start (progn (beginning-of-line)
-						(- (point) 1)))
-				  (end (progn (end-of-line) (+ (point) 1))))
-			      (if (display-images-p)
-				  (progn
-				    (remove-images start end)
-				    (if (eq ?y flag)
-					(put-image breakpoint-enabled-icon
-						   (+ start 1)
-						   "breakpoint icon enabled"
-						   'left-margin)
-				      (put-image breakpoint-disabled-icon
-						 (+ start 1)
-						 "breakpoint icon disabled"
-						 'left-margin)))
-				(gdb-remove-strings start end)
-				(if (eq ?y flag)
-				    (gdb-put-string "B" (+ start 1))
-				  (gdb-put-string "b" (+ start 1))))))))))))
+			    (gdb-put-breakpoint-icon (eq flag ?y)))))))))
 	  (end-of-line)))))
   (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom)))
 
@@ -1106,7 +1092,10 @@
 	(with-selected-window (posn-window posn)
 	  (save-excursion
 	    (goto-char (posn-point posn))
-	    (if (posn-object posn)
+	    (if (or (posn-object posn)
+		    (and breakpoint-bitmap
+			 (eq (car (fringe-bitmaps-at-pos (posn-point posn)))
+			     breakpoint-bitmap)))
 		(gud-remove nil)
 	      (gud-break nil)))))))
 
@@ -1691,18 +1680,10 @@
 	  (if (memq gud-minor-mode '(gdba pdb))
 	      (if (string-match "^\*.+*$" (buffer-name))
 		  (kill-buffer nil)
-		(if (display-images-p)
-		    (remove-images (point-min) (point-max))
-		  (gdb-remove-strings (point-min) (point-max)))
-		(setq left-margin-width 0)
+		(gdb-remove-breakpoint-icons (point-min) (point-max) t)
 		(setq gud-minor-mode nil)
 		(kill-local-variable 'tool-bar-map)
-		(setq gud-running nil)
-		(if (get-buffer-window (current-buffer))
-		    (set-window-margins (get-buffer-window
-					 (current-buffer))
-					left-margin-width
-					right-margin-width))))))))
+		(setq gud-running nil)))))))
 
 (defun gdb-source-info ()
   "Find the source file where the program starts and displays it with related
@@ -1733,7 +1714,7 @@
     (other-window 1)))
 
 ;;from put-image
-(defun gdb-put-string (putstring pos)
+(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
@@ -1741,7 +1722,8 @@
   (let ((gdb-string "x")
 	(buffer (current-buffer)))
     (let ((overlay (make-overlay pos pos buffer))
-	  (prop (list (list 'margin 'left-margin) putstring)))
+	  (prop (or dprop
+		    (list (list 'margin 'left-margin) putstring))))
       (put-text-property 0 (length gdb-string) 'display prop gdb-string)
       (overlay-put overlay 'put-break t)
       (overlay-put overlay 'before-string gdb-string))))
@@ -1749,7 +1731,7 @@
 ;;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 `put-string'.
+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)))
@@ -1760,6 +1742,72 @@
 	  (delete-overlay overlay)))
       (setq overlays (cdr overlays)))))
 
+(defun gdb-put-breakpoint-icon (enabled)
+  (let ((start (progn (beginning-of-line) (- (point) 1)))
+	(end (progn (end-of-line) (+ (point) 1))))
+    (gdb-remove-breakpoint-icons start end)
+    (if (display-images-p)
+	(if (>= (car (window-fringes)) 8)
+	    (gdb-put-string 
+	     nil (1+ start)
+	     `(left-fringe 
+	       ,(or breakpoint-bitmap
+		    (setq breakpoint-bitmap
+			  (define-fringe-bitmap
+			    "\x3c\x7e\xff\xff\xff\xff\x7e\x3c")))
+	       ,(if enabled
+		    'breakpoint-enabled-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))
+		  (set-window-margins (get-buffer-window
+				       (current-buffer))
+				      left-margin-width
+				      right-margin-width))))
+	  (put-image
+	   (if enabled
+	       (or breakpoint-enabled-icon
+		   (setq breakpoint-enabled-icon
+			 (find-image `((:type xpm :data 
+					      ,breakpoint-xpm-data
+					      :ascent 100 :pointer hand)
+				       (:type pbm :data
+					      ,breakpoint-enabled-pbm-data
+					      :ascent 100 :pointer hand)))))
+	     (or breakpoint-disabled-icon
+		 (setq breakpoint-disabled-icon
+		       (find-image `((:type xpm :data
+					    ,breakpoint-xpm-data
+					    :conversion disabled
+					    :ascent 100)
+				     (:type pbm :data
+					    ,breakpoint-disabled-pbm-data
+					    :ascent 100))))))
+	   (+ start 1) nil 'left-margin))
+      (when (< left-margin-width 2)
+	(save-current-buffer
+	  (setq left-margin-width 2)
+	  (if (get-buffer-window (current-buffer))
+	      (set-window-margins (get-buffer-window
+				   (current-buffer))
+				  left-margin-width
+				  right-margin-width))))
+      (gdb-put-string (if enabled "B" "b") (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))
+  (when remove-margin
+    (setq left-margin-width 0)
+    (if (get-buffer-window (current-buffer))
+	(set-window-margins (get-buffer-window
+			     (current-buffer))
+			    left-margin-width
+			    right-margin-width))))
+
 (defun gdb-put-arrow (putstring pos)
   "Put arrow string PUTSTRING in the left margin in front of POS
 in the current buffer.  PUTSTRING is displayed by putting an
@@ -1813,9 +1861,7 @@
 		  (setq gdb-arrow-position (point))
 		  (gdb-put-arrow "=>" (point))))))
       ;; remove all breakpoint-icons in assembler buffer before updating.
-      (if (display-images-p)
-	  (remove-images (point-min) (point-max))
-	(gdb-remove-strings (point-min) (point-max))))
+      (gdb-remove-breakpoint-icons (point-min) (point-max)))
     (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
       (goto-char (point-min))
       (while (< (point) (- (point-max) 1))
@@ -1832,24 +1878,7 @@
 	      (with-current-buffer buffer
 		  (goto-char (point-min))
 		  (if (re-search-forward address nil t)
-		      (let ((start (progn (beginning-of-line) (- (point) 1)))
-			    (end (progn (end-of-line) (+ (point) 1))))
-			(if (display-images-p)
-			    (progn
-			      (remove-images start end)
-			      (if (eq ?y flag)
-				  (put-image breakpoint-enabled-icon
-					     (+ start 1)
-					     "breakpoint icon enabled"
-					     'left-margin)
-				(put-image breakpoint-disabled-icon
-					   (+ start 1)
-					   "breakpoint icon disabled"
-					   'left-margin)))
-			  (gdb-remove-strings start end)
-			  (if (eq ?y flag)
-			      (gdb-put-string "B" (+ start 1))
-			    (gdb-put-string "b" (+ start 1)))))))))))
+		      (gdb-put-breakpoint-icon (eq flag ?y))))))))
     (if (not (equal gdb-current-address "main"))
 	(set-window-point (get-buffer-window buffer) gdb-arrow-position))))
 
@@ -1864,7 +1893,6 @@
 \\{gdb-assembler-mode-map}"
   (setq major-mode 'gdb-assembler-mode)
   (setq mode-name "Machine")
-  (setq left-margin-width 2)
   (setq fringes-outside-margins t)
   (setq buffer-read-only t)
   (use-local-map gdb-assembler-mode-map)