Mercurial > emacs
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.
author | Kim F. Storm <storm@cua.dk> |
---|---|
date | Sat, 28 Feb 2004 01:32:01 +0000 |
parents | 1ab08664aea0 |
children | 31f59adf16ea |
files | lisp/gdb-ui.el |
diffstat | 1 files changed, 99 insertions(+), 71 deletions(-) [+] |
line wrap: on
line diff
--- 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)