mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-17 08:31:09 -08:00
(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.
This commit is contained in:
Kim F. Storm
parent
40c6ee742c
commit
c0550a50ac
1 changed files with 99 additions and 71 deletions
170
lisp/gdb-ui.el
170
lisp/gdb-ui.el
|
|
@ -1017,16 +1017,28 @@ static char *magick[] = {
|
|||
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 @@ static char *magick[] = {
|
|||
(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 @@ static char *magick[] = {
|
|||
(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 @@ static char *magick[] = {
|
|||
(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 @@ This arrangement depends on the value of `gdb-many-windows'."
|
|||
(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 @@ buffers."
|
|||
(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 @@ PUTSTRING."
|
|||
(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 @@ PUTSTRING."
|
|||
;;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 @@ BUFFER nil or omitted means use the 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
|
||||
|
|
@ -1813,9 +1861,7 @@ BUFFER nil or omitted means use the current buffer."
|
|||
(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 @@ BUFFER nil or omitted means use the current buffer."
|
|||
(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 @@ BUFFER nil or omitted means use the current buffer."
|
|||
\\{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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue