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))
(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))
(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)))
(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)))))))
(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
(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
(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))))
;;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)))
(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
(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))
(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))))
\\{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)
projects / emacs.git / commitdiff