aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorNick Roberts <[email protected]>2003-05-18 22:19:17 +0000
committerNick Roberts <[email protected]>2003-05-18 22:19:17 +0000
commit30dc0b2266e9a1a4421d894b399b1a95881d9e61 (patch)
tree3418a0a86e19698d62fa407a73d6f21214d83f4f
parent66df74e20d4aa4da9b26d65200b0ec4c8e97bb0a (diff)
(put-arrow): Rename gdb-put-arrow and simplify.
(put-string): Rename gdb-put-string and simplify. (remove-strings): Rename gdb-remove-strings. (remove-arrow): Rename gdb-remove-arrow. (gdb-assembler-custom): Try to get line marker (arrow) to display in window (revisited). Use with-current-buffer where possible.
-rw-r--r--lisp/gdb-ui.el182
1 files changed, 67 insertions, 115 deletions
diff --git a/lisp/gdb-ui.el b/lisp/gdb-ui.el
index 60310f071c..9a7b250582 100644
--- a/lisp/gdb-ui.el
+++ b/lisp/gdb-ui.el
@@ -149,7 +149,7 @@ The following interactive lisp functions help control operation :
(beginning-of-line)
(forward-char 2)
(gud-call "until *%a" arg)))
- "\C-u" "Continue up to current line or address.")
+ "\C-u" "Continue to current line or address.")
(setq comint-input-sender 'gdb-send)
;;
@@ -754,8 +754,7 @@ output from the current command if that happens to be appropriate."
(progn
(setq char "*")
(setq gdb-temp-value (substring gdb-temp-value 1 nil))))
- (save-excursion
- (set-buffer gdb-expression-buffer-name)
+ (with-current-buffer gdb-expression-buffer-name
(setq gdb-expression gdb-temp-value)
(if (not (string-match "::" gdb-expression))
(setq gdb-expression (concat char gdb-current-frame
@@ -768,8 +767,7 @@ output from the current command if that happens to be appropriate."
;;-if scalar/string
(if (not (re-search-forward "##" nil t))
(progn
- (save-excursion
- (set-buffer gdb-expression-buffer-name)
+ (with-current-buffer gdb-expression-buffer-name
(let ((buffer-read-only nil))
(delete-region (point-min) (point-max))
(insert-buffer-substring
@@ -778,8 +776,7 @@ output from the current command if that happens to be appropriate."
(goto-char (point-min))
(let ((start (progn (point)))
(end (progn (end-of-line) (point))))
- (save-excursion
- (set-buffer gdb-expression-buffer-name)
+ (with-current-buffer gdb-expression-buffer-name
(setq buffer-read-only nil)
(delete-region (point-min) (point-max))
(insert-buffer-substring (gdb-get-buffer
@@ -798,8 +795,7 @@ output from the current command if that happens to be appropriate."
(progn
(setq gdb-annotation-arg (match-string 1))
(gdb-field-format-begin))))
- (save-excursion
- (set-buffer gdb-expression-buffer-name)
+ (with-current-buffer gdb-expression-buffer-name
(if gdb-dive-display-number
(progn
(let ((buffer-read-only nil))
@@ -830,32 +826,28 @@ output from the current command if that happens to be appropriate."
(defun gdb-array-section-begin (args)
(if gdb-display-in-progress
(progn
- (save-excursion
- (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer))
+ (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
(goto-char (point-max))
(insert (concat "\n##array-section-begin " args "\n"))))))
(defun gdb-array-section-end (ignored)
(if gdb-display-in-progress
(progn
- (save-excursion
- (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer))
+ (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
(goto-char (point-max))
(insert "\n##array-section-end\n")))))
(defun gdb-field-begin (args)
(if gdb-display-in-progress
(progn
- (save-excursion
- (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer))
+ (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
(goto-char (point-max))
(insert (concat "\n##field-begin " args "\n"))))))
(defun gdb-field-end (ignored)
(if gdb-display-in-progress
(progn
- (save-excursion
- (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer))
+ (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
(goto-char (point-max))
(insert "\n##field-end\n")))))
@@ -934,8 +926,7 @@ output from the current command if that happens to be appropriate."
(let ((start (progn (point)))
(end (progn (next-line) (point)))
(num 0))
- (save-excursion
- (set-buffer gdb-expression-buffer-name)
+ (with-current-buffer gdb-expression-buffer-name
(let ((buffer-read-only nil))
(if (string-equal gdb-annotation-arg "\*") (insert "\*"))
(while (<= num gdb-nesting-level)
@@ -966,8 +957,7 @@ output from the current command if that happens to be appropriate."
(if (eq gdb-nesting-level 0)
(progn
(let ((values (buffer-substring gdb-point (- (point) 2))))
- (save-excursion
- (set-buffer gdb-expression-buffer-name)
+ (with-current-buffer gdb-expression-buffer-name
(setq gdb-values
(concat "{" (replace-regexp-in-string "\n" "" values)
"}"))
@@ -1149,22 +1139,16 @@ output from the current command if that happens to be appropriate."
(t (error "Bogon output sink %S" sink)))))
(defun gdb-append-to-partial-output (string)
- (save-excursion
- (set-buffer
- (gdb-get-create-buffer 'gdb-partial-output-buffer))
+ (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
(goto-char (point-max))
(insert string)))
(defun gdb-clear-partial-output ()
- (save-excursion
- (set-buffer
- (gdb-get-create-buffer 'gdb-partial-output-buffer))
+ (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
(delete-region (point-min) (point-max))))
(defun gdb-append-to-inferior-io (string)
- (save-excursion
- (set-buffer
- (gdb-get-create-buffer 'gdb-inferior-io))
+ (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io)
(goto-char (point-max))
(insert-before-markers string))
(if (not (string-equal string ""))
@@ -1172,9 +1156,7 @@ output from the current command if that happens to be appropriate."
(gdb-display-buffer (gdb-get-create-buffer 'gdb-inferior-io)))))
(defun gdb-clear-inferior-io ()
- (save-excursion
- (set-buffer
- (gdb-get-create-buffer 'gdb-inferior-io))
+ (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io)
(delete-region (point-min) (point-max))))
@@ -1222,8 +1204,7 @@ output from the current command if that happens to be appropriate."
(gdb-get-pending-triggers)))
(let ((buf (gdb-get-buffer ',buf-key)))
(and buf
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(let ((p (point))
(buffer-read-only nil))
(delete-region (point-min) (point-max))
@@ -1344,15 +1325,13 @@ static char *magick[] = {
;;
;; remove all breakpoint-icons in source buffers but not assembler buffer
(dolist (buffer (buffer-list))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(if (and (eq gud-minor-mode 'gdba)
(not (string-match "^\*" (buffer-name))))
(if (display-graphic-p)
(remove-images (point-min) (point-max))
- (remove-strings (point-min) (point-max))))))
- (save-excursion
- (set-buffer (gdb-get-buffer 'gdb-breakpoints-buffer))
+ (gdb-remove-strings (point-min) (point-max))))))
+ (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
(save-excursion
(goto-char (point-min))
(while (< (point) (- (point-max) 1))
@@ -1370,11 +1349,10 @@ static char *magick[] = {
(put-text-property (progn (beginning-of-line) (point))
(progn (end-of-line) (point))
'mouse-face 'highlight)
- (save-excursion
- (set-buffer
- (find-file-noselect
- (if (file-exists-p file) file
- (expand-file-name file gdb-cdir))))
+ (with-current-buffer
+ (find-file-noselect
+ (if (file-exists-p file) file
+ (expand-file-name file gdb-cdir)))
(save-current-buffer
(set (make-local-variable 'gud-minor-mode) 'gdba)
(set (make-local-variable 'tool-bar-map)
@@ -1402,12 +1380,10 @@ static char *magick[] = {
(put-image breakpoint-disabled-icon (point)
"breakpoint icon disabled"
'left-margin)))
- (remove-strings start end)
+ (gdb-remove-strings start end)
(if (eq ?y flag)
- (put-string "B" (point) "enabled"
- 'left-margin)
- (put-string "b" (point) "disabled"
- 'left-margin)))))))))))
+ (put-string "B" (point))
+ (put-string "b" (point))))))))))))
(end-of-line))))))
(defun gdb-breakpoints-buffer-name ()
@@ -1518,8 +1494,7 @@ current line."
gdb-info-frames-custom)
(defun gdb-info-frames-custom ()
- (save-excursion
- (set-buffer (gdb-get-buffer 'gdb-stack-buffer))
+ (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
(save-excursion
(let ((buffer-read-only nil))
(goto-char (point-min))
@@ -1605,8 +1580,7 @@ the source buffer."
gdb-info-threads-custom)
(defun gdb-info-threads-custom ()
- (save-excursion
- (set-buffer (gdb-get-buffer 'gdb-threads-buffer))
+ (with-current-buffer (gdb-get-buffer 'gdb-threads-buffer)
(let ((buffer-read-only nil))
(goto-char (point-min))
(while (< (point) (point-max))
@@ -1730,8 +1704,7 @@ the source buffer."
(gdb-set-pending-triggers (delq 'gdb-invalidate-locals
(gdb-get-pending-triggers)))
(let ((buf (gdb-get-buffer 'gdb-partial-output-buffer)))
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(goto-char (point-min))
(while (re-search-forward "^ .*\n" nil t)
(replace-match "" nil nil))
@@ -1742,8 +1715,7 @@ the source buffer."
(while (re-search-forward "{.*=.*\n" nil t)
(replace-match "(structure);\n" nil nil))))
(let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
- (and buf (save-excursion
- (set-buffer buf)
+ (and buf (with-current-buffer buf
(let ((p (point))
(buffer-read-only nil))
(delete-region (point-min) (point-max))
@@ -1800,8 +1772,7 @@ the source buffer."
(defun gdb-info-display-custom ()
(let ((display-list nil))
- (save-excursion
- (set-buffer (gdb-get-buffer 'gdb-display-buffer))
+ (with-current-buffer (gdb-get-buffer 'gdb-display-buffer)
(goto-char (point-min))
(while (< (point) (- (point-max) 1))
(forward-line 1)
@@ -1887,9 +1858,7 @@ the source buffer."
(defun gdb-delete-display ()
"Delete the displayed expression at current line."
(interactive)
- (save-excursion
- (set-buffer
- (gdb-get-buffer 'gdb-display-buffer))
+ (with-current-buffer (gdb-get-buffer 'gdb-display-buffer)
(beginning-of-line 1)
(if (not (looking-at "\\([0-9]+\\): \\([ny]\\)"))
(error "No expression on this line")
@@ -2084,7 +2053,7 @@ This arrangement depends on the value of `gdb-many-windows'."
(kill-buffer nil)
(if (display-graphic-p)
(remove-images (point-min) (point-max))
- (remove-strings (point-min) (point-max)))
+ (gdb-remove-strings (point-min) (point-max)))
(setq left-margin-width 0)
(setq gud-minor-mode nil)
(kill-local-variable 'tool-bar-map)
@@ -2122,63 +2091,51 @@ buffers."
(other-window 1))))
;;from put-image
-(defun put-string (putstring pos &optional string area)
+(defun gdb-put-string (putstring pos)
"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
-PUTSTRING. STRING is defaulted if you omit it.
-POS may be an integer or marker.
-AREA is where to display the string. AREA nil or omitted means
-display it in the text area, a value of `left-margin' means
-display it in the left marginal area, a value of `right-margin'
-means display it in the right marginal area."
- (unless string (setq string "x"))
+PUTSTRING."
+ (setq string "x")
(let ((buffer (current-buffer)))
- (unless (or (null area) (memq area '(left-margin right-margin)))
- (error "Invalid area %s" area))
(setq string (copy-sequence string))
(let ((overlay (make-overlay pos pos buffer))
- (prop (if (null area) putstring (list (list 'margin area) putstring))))
+ (prop (list (list 'margin 'left-margin) putstring)))
(put-text-property 0 (length string) 'display prop string)
- (overlay-put overlay 'put-text t)
+ (overlay-put overlay 'put-break t)
(overlay-put overlay 'before-string string))))
;;from remove-images
-(defun remove-strings (start end &optional buffer)
+(defun gdb-remove-strings (start end &optional buffer)
"Remove strings between START and END in BUFFER.
-Remove only images that were put in BUFFER with calls to `put-string'.
+Remove only strings that were put in BUFFER with calls to `put-string'.
BUFFER nil or omitted means use the current buffer."
(unless buffer
(setq buffer (current-buffer)))
(let ((overlays (overlays-in start end)))
(while overlays
(let ((overlay (car overlays)))
- (when (overlay-get overlay 'put-text)
+ (when (overlay-get overlay 'put-break)
(delete-overlay overlay)))
(setq overlays (cdr overlays)))))
-(defun put-arrow (putstring pos &optional string area)
- "Put arrow 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' \"gdb-arrow\" that has a `display' property whose value is
-PUTSTRING. STRING is defaulted if you omit it.
-POS may be an integer or marker.
-AREA is where to display the string. AREA nil or omitted means
-display it in the text area, a value of `left-margin' means
-display it in the left marginal area, a value of `right-margin'
-means display it in the right marginal area."
+(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
+overlay into the current buffer with a `before-string'
+\"gdb-arrow\" that has a `display' property whose value is
+PUTSTRING. STRING is defaulted if you omit it. POS may be an
+integer or marker."
(setq string "gdb-arrow")
(let ((buffer (current-buffer)))
- (unless (or (null area) (memq area '(left-margin right-margin)))
- (error "Invalid area %s" area))
(setq string (copy-sequence string))
(let ((overlay (make-overlay pos pos buffer))
- (prop (if (null area) putstring (list (list 'margin area) putstring))))
+ (prop (list (list 'margin 'left-margin) putstring)))
(put-text-property 0 (length string) 'display prop string)
- (overlay-put overlay 'put-text t)
+ (overlay-put overlay 'put-arrow t)
(overlay-put overlay 'before-string string))))
-(defun remove-arrow (&optional buffer)
+(defun gdb-remove-arrow (&optional buffer)
"Remove arrow in BUFFER.
Remove only images that were put in BUFFER with calls to `put-arrow'.
BUFFER nil or omitted means use the current buffer."
@@ -2187,7 +2144,7 @@ BUFFER nil or omitted means use the current buffer."
(let ((overlays (overlays-in (point-min) (point-max))))
(while overlays
(let ((overlay (car overlays)))
- (when (string-equal (overlay-get overlay 'before-string) "gdb-arrow")
+ (when (overlay-get overlay 'put-arrow)
(delete-overlay overlay)))
(setq overlays (cdr overlays)))))
@@ -2240,21 +2197,20 @@ BUFFER nil or omitted means use the current buffer."
(defun gdb-assembler-custom ()
(let ((buffer (gdb-get-buffer 'gdb-assembler-buffer))
(address) (flag))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(if (not (equal gdb-current-address "main"))
(progn
- (remove-arrow)
- (goto-char (point-min))
- (if (re-search-forward gdb-current-address nil t)
- (progn
- (put-arrow "=>" (point) nil 'left-margin)
- (set-window-point gdb-source-window (point))))))
- ;; remove all breakpoint-icons in assembler buffer before updating.
+ (gdb-remove-arrow)
+ (save-selected-window
+ (select-window gdb-source-window)
+ (goto-char (point-min))
+ (if (re-search-forward gdb-current-address nil t)
+ (gdb-put-arrow "=>" (point))))))
+ ;; remove all breakpoint-icons in assembler buffer before updating.
(save-excursion
(if (display-graphic-p)
(remove-images (point-min) (point-max))
- (remove-strings (point-min) (point-max))))
+ (gdb-remove-strings (point-min) (point-max))))
(set-buffer (gdb-get-buffer 'gdb-breakpoints-buffer))
(goto-char (point-min))
(while (< (point) (- (point-max) 1))
@@ -2269,8 +2225,7 @@ BUFFER nil or omitted means use the current buffer."
(if (string-match "0x0+\\(.*\\)" number)
(setq address (concat "0x" (match-string 1 address)))
(setq address number)))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(save-excursion
(goto-char (point-min))
(if (re-search-forward address nil t)
@@ -2286,11 +2241,10 @@ BUFFER nil or omitted means use the current buffer."
(put-image breakpoint-disabled-icon (point)
"breakpoint icon disabled"
'left-margin)))
- (remove-strings start end)
+ (gdb-remove-strings start end)
(if (eq ?y flag)
- (put-string "B" (point) "enabled" 'left-margin)
- (put-string "b" (point) "disabled"
- 'left-margin)))))))))))))
+ (put-string "B" (point))
+ (put-string "b" (point))))))))))))))
(defvar gdb-assembler-mode-map
(let ((map (make-sparse-keymap)))
@@ -2332,8 +2286,7 @@ BUFFER nil or omitted means use the current buffer."
(not (string-equal gdb-current-address gdb-previous-address))))
(progn
;; take previous disassemble command off the queue
- (save-excursion
- (set-buffer gud-comint-buffer)
+ (with-current-buffer gud-comint-buffer
(let ((queue (gdb-get-idle-input-queue)) (item))
(dolist (item queue)
(if (equal (cdr item) '(gdb-assembler-handler))
@@ -2359,8 +2312,7 @@ BUFFER nil or omitted means use the current buffer."
(defun gdb-frame-handler ()
(gdb-set-pending-triggers
(delq 'gdb-get-current-frame (gdb-get-pending-triggers)))
- (save-excursion
- (set-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer))
+ (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
(goto-char (point-min))
(if (looking-at "^#[0-9]*\\s-*\\(\\S-*\\) in \\(\\S-*\\)")
(progn