Function: gud-speedbar-buttons

gud-speedbar-buttons is a byte-compiled function defined in gud.el.gz.

Signature

(gud-speedbar-buttons BUFFER)

Documentation

Create a speedbar display based on the current state of GUD.

If the GUD BUFFER is not running a supported debugger, then turn off the specialized speedbar mode. BUFFER is not used, but is required by the caller.

Source Code

;; Defined in /usr/src/emacs/lisp/progmodes/gud.el.gz
(defun gud-speedbar-buttons (buffer)
  "Create a speedbar display based on the current state of GUD.
If the GUD BUFFER is not running a supported debugger, then turn
off the specialized speedbar mode.  BUFFER is not used, but is
required by the caller."
  (when (and gud-comint-buffer
	     ;; gud-comint-buffer might be killed
	     (buffer-name gud-comint-buffer))
    (let* ((minor-mode (with-current-buffer buffer gud-minor-mode))
	  (window (get-buffer-window (current-buffer) 0))
	  (start (window-start window))
	  (p (window-point window)))
      (cond
       ((eq minor-mode 'gdbmi)
	(erase-buffer)
	(insert "Watch Expressions:\n")
	(let ((var-list gdb-var-list) parent)
	  (while var-list
	    (let* (char (depth 0) (start 0) (var (car var-list))
			(varnum (car var)) (expr (nth 1 var))
			(type (copy-sequence (or (nth 3 var) " ")))
			(value (nth 4 var)) (status (nth 5 var))
			(has-more (nth 6 var)))
	      (put-text-property
	       0 (length expr) 'face 'font-lock-variable-name-face expr)
	      (put-text-property
	       0 (length type) 'face 'font-lock-type-face type)
	      (while (string-match "\\." varnum start)
		(setq depth (1+ depth)
		      start (1+ (match-beginning 0))))
	      (if (eq depth 0) (setq parent nil))
	      (if (and (or (not has-more) (string-equal has-more "0"))
		       (or (equal (nth 2 var) "0")
			   (and (equal (nth 2 var) "1")
			   (string-match "char \\*$" type)) ))
		  (speedbar-make-tag-line
		   'bracket ?? nil nil
		   (concat expr "\t" value)
		   (if (or parent (eq status 'out-of-scope))
		       nil 'gdb-edit-value)
		   nil
		   (if gdb-show-changed-values
		       (or parent (pcase status
				    ('changed 'font-lock-warning-face)
				    ('out-of-scope 'shadow)
				    (_ t)))
		     t)
		   depth)
		(if (eq status 'out-of-scope) (setq parent 'shadow))
		(if (and (nth 1 var-list)
			 (string-match (concat varnum "\\.")
				       (car (nth 1 var-list))))
		    (setq char ?-)
		  (setq char ?+))
		(if (string-match "\\*$\\|\\*&$" type)
		    (speedbar-make-tag-line
		     'bracket char
		     'gdb-speedbar-expand-node varnum
		     (concat expr "\t" type "\t" value)
		     (if (or parent (eq status 'out-of-scope))
			 nil 'gdb-edit-value)
		     nil
		     (if gdb-show-changed-values
			 (or parent (pcase status
				      ('changed 'font-lock-warning-face)
				      ('out-of-scope 'shadow)
				      (_ t)))
		       t)
		     depth)
		  (speedbar-make-tag-line
		   'bracket char
		   'gdb-speedbar-expand-node varnum
		   (concat expr "\t" type)
		   nil nil
		   (if (and (or parent status) gdb-show-changed-values)
		       'shadow t)
		   depth))))
	    (setq var-list (cdr var-list)))))
       (t (unless (and (save-excursion
			 (goto-char (point-min))
			 (looking-at "Current Stack:"))
		       (equal gud-last-last-frame gud-last-speedbar-stackframe))
	    (let ((gud-frame-list
	    (cond ((eq minor-mode 'gdb)
		   (gud-gdb-get-stackframe buffer))
		  ;; Add more debuggers here!
		  (t (speedbar-remove-localized-speedbar-support buffer)
		     nil))))
	      (erase-buffer)
	      (if (not gud-frame-list)
		  (insert "No Stack frames\n")
		(insert "Current Stack:\n"))
	      (dolist (frame gud-frame-list)
		(insert (nth 1 frame) ":\n")
		(if (= (length frame) 2)
		(progn
		  (speedbar-insert-button (car frame)
					  'speedbar-directory-face
					  nil nil nil t))
		(speedbar-insert-button
		 (car frame)
		 'speedbar-file-face
		 'speedbar-highlight-face
		 (cond ((memq minor-mode '(gdbmi gdb))
			'gud-gdb-goto-stackframe)
		       (t (error "Should never be here")))
		 frame t))))
	    (setq gud-last-speedbar-stackframe gud-last-last-frame))))
      (set-window-start window start)
      (set-window-point window p))))