You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
577 lines
22 KiB
577 lines
22 KiB
;; Copyright (C) 2015-2019 Free Software Foundation, Inc
|
|
;; Author: Rocky Bernstein <rocky@gnu.org>
|
|
|
|
;; This program is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
;;; process-command buffer things
|
|
|
|
(require 'load-relative)
|
|
(require 'json)
|
|
(require-relative-list
|
|
'("../fringe" "../loc" "../lochist" "../regexp") "realgud-")
|
|
(require-relative-list '("info") "realgud-buffer-")
|
|
|
|
(declare-function realgud-get-cmdbuf 'realgud-buffer-helper)
|
|
|
|
(eval-when-compile
|
|
(byte-compile-disable-warning 'cl-functions)
|
|
;; Somehow disabling cl-functions causes the erroneous message:
|
|
;; Warning: the function `reduce' might not be defined at runtime.
|
|
;; FIXME: isolate, fix and/or report back to Emacs developers a bug
|
|
(byte-compile-disable-warning 'unresolved)
|
|
(defvar realgud-cmdbuf-info)
|
|
)
|
|
(require 'cl-lib)
|
|
|
|
(when (< emacs-major-version 26)
|
|
(defun make-mutex(&rest name)
|
|
;; Stub for Emacs that doesn't have mutex
|
|
))
|
|
|
|
(defface debugger-running
|
|
'((((class color) (min-colors 16) (background light))
|
|
(:foreground "Green4" :weight bold))
|
|
(((class color) (min-colors 88) (background dark))
|
|
(:foreground "Green1" :weight bold))
|
|
(((class color) (min-colors 16) (background dark))
|
|
(:foreground "Green" :weight bold))
|
|
(((class color)) (:foreground "green" :weight bold))
|
|
(t (:weight bold)))
|
|
"Face used to highlight debugger run information."
|
|
:group 'realgud
|
|
:version "25.1")
|
|
|
|
(defface debugger-not-running
|
|
'((t :inherit font-lock-warning-face))
|
|
"Face used when debugger or process is not running."
|
|
:group 'realgud
|
|
:version "25.1")
|
|
|
|
|
|
(cl-defstruct realgud-cmdbuf-info
|
|
"The debugger object/structure specific to a process buffer."
|
|
debugger-name ;; Name of debugger
|
|
base-variable-name ;; prefix used in variables pertinent to this
|
|
;; debugger sometimes it is the same as the debugger
|
|
;; and sometimes it is different
|
|
cmd-args ;; Command-line invocation arguments
|
|
frame-switch? ;; Should the selected window be the source buffer or
|
|
;; command buffer?
|
|
in-srcbuf? ;; If true, selected window should be the source buffer.
|
|
;; Otherwise, the command buffer?
|
|
last-input-end ;; point where input last ended. Set from
|
|
;; comint-last-input-end
|
|
prior-prompt-regexp ;; regular expression prompt (e.g.
|
|
;; comint-prompt-regexp) *before* setting
|
|
;; loc-regexp
|
|
no-record? ;; Should we update the location history?
|
|
in-debugger? ;; True if we think we are in a debugger
|
|
src-shortkey? ;; Are source buffers in realgud-short-key mode?
|
|
regexp-hash ;; hash table of regular expressions appropriate for
|
|
;; this debugger. Eventually loc-regexp, file-group
|
|
;; and line-group below will removed and stored here.
|
|
srcbuf-list ;; list of source buffers we have stopped at
|
|
source-path ;; last source-code path we've seen
|
|
|
|
bt-buf ;; backtrace buffer if it exists
|
|
brkpt-buf ;; breakpoint buffer if it exists
|
|
bp-list ;; list of breakpoints
|
|
divert-output? ;; Output is part of a conversation between front-end
|
|
;; debugger.
|
|
cmd-hash ;; Allows us to remap command names like
|
|
;; quit => quit!
|
|
callback-loc-fn ;; If we need, as in the case of Java, to do
|
|
;; special handling to map output to a file
|
|
;; location, this is set to that special
|
|
;; function
|
|
callback-eval-filter ;; If set, this function strip extraneous output
|
|
;; when evaluating an expression. For example,
|
|
;; some trepan debuggers expression values prefaced with:
|
|
;; $DB::D[0] =
|
|
;; FIXME: REMOVE THIS and use regexp-hash
|
|
loc-regexp ;; Location regular expression string
|
|
file-group
|
|
line-group
|
|
alt-file-group
|
|
alt-line-group
|
|
text-group
|
|
|
|
;; A list (or sequence) of regular expression strings of file names
|
|
;; that we should ignore.
|
|
;;
|
|
;; For example in Python debuggers it often starts out "<string>...", while
|
|
;; in Ruby and Perl it often starts out "(eval ...".
|
|
;;
|
|
;; However in this list could be individual files that one encounters in the
|
|
;; course of debugging. For example:
|
|
;; - in nodejs "internal/module.js" or more generally internal/.*\.js.
|
|
;; - in C ../sysdeps/x86_64/multiarch/strchr-avx2.S or or more generally .*/sysdeps/.*
|
|
;; and so on.
|
|
;;
|
|
;; A list of regular expression. When one in the list matches a source
|
|
;; location, we ignore that file. Of course, the regular expression could
|
|
;; be a specific file name. Various programming languages have names
|
|
;; that might not be real. For example, in Python or Ruby when you compile
|
|
;; a or evaluate string you provide a name in the call, and often times
|
|
;; this isn't the real name of a file. It is often something like "exec" or
|
|
;; "<string>", or "<eval>". Each of the debuggers has the opportunity to seed the
|
|
;; the ignore list.
|
|
ignore-re-file-list
|
|
|
|
;; A property list which maps the name as seen in the location to a path that we
|
|
;; can do a "find-file" on
|
|
filename-remap-alist
|
|
|
|
;; A mutex to ensure that two threads doing things in the same debug
|
|
;; session simultaneously
|
|
mutex
|
|
|
|
loc-hist ;; ring of locations seen in the course of execution
|
|
;; see realgud-lochist
|
|
starting-directory ;; directory where initial debug command was issued.
|
|
;; this can be used to resolve relative file names
|
|
)
|
|
(make-variable-buffer-local 'realgud-cmdbuf-info)
|
|
(make-variable-buffer-local 'realgud-last-output-start)
|
|
|
|
(defalias 'realgud-cmdbuf-info? 'realgud-cmdbuf-info-p)
|
|
|
|
;; FIXME: figure out how to put in a loop.
|
|
(realgud-struct-field-setter "realgud-cmdbuf-info" "bp-list")
|
|
(realgud-struct-field-setter "realgud-cmdbuf-info" "bt-buf")
|
|
(realgud-struct-field-setter "realgud-cmdbuf-info" "brkpt-buf")
|
|
(realgud-struct-field-setter "realgud-cmdbuf-info" "cmd-args")
|
|
(realgud-struct-field-setter "realgud-cmdbuf-info" "last-input-end")
|
|
(realgud-struct-field-setter "realgud-cmdbuf-info" "divert-output?")
|
|
(realgud-struct-field-setter "realgud-cmdbuf-info" "frame-switch?")
|
|
(realgud-struct-field-setter "realgud-cmdbuf-info" "in-srcbuf?")
|
|
(realgud-struct-field-setter "realgud-cmdbuf-info" "no-record?")
|
|
(realgud-struct-field-setter "realgud-cmdbuf-info" "prior-prompt-regexp")
|
|
(realgud-struct-field-setter "realgud-cmdbuf-info" "src-shortkey?")
|
|
(realgud-struct-field-setter "realgud-cmdbuf-info" "source-path")
|
|
(realgud-struct-field-setter "realgud-cmdbuf-info" "in-debugger?")
|
|
(realgud-struct-field-setter "realgud-cmdbuf-info" "callback-loc-fn")
|
|
(realgud-struct-field-setter "realgud-cmdbuf-info" "callback-eval-filter")
|
|
(realgud-struct-field-setter "realgud-cmdbuf-info" "starting-directory")
|
|
(realgud-struct-field-setter "realgud-cmdbuf-info" "ignore-re-file-list")
|
|
;; (realgud-struct-field-setter "realgud-cmdbuf-info" "filename-remap-alist")
|
|
|
|
(defun realgud-cmdbuf-filename-remap-alist= (value &optional buffer)
|
|
(setq buffer (realgud-get-cmdbuf buffer))
|
|
(setf (realgud-cmdbuf-info-filename-remap-alist realgud-cmdbuf-info) value))
|
|
|
|
(defun realgud:cmdbuf-follow-buffer(event)
|
|
(interactive "e")
|
|
(let* ((pos (posn-point (event-end event)))
|
|
(buffer (get-text-property pos 'buffer)))
|
|
(find-file-other-window (buffer-file-name buffer))))
|
|
|
|
(defun realgud:cmdbuf-buffers-describe (info)
|
|
(let* ((buffer-list (realgud-cmdbuf-info-srcbuf-list info))
|
|
(debugger-name (realgud-cmdbuf-info-debugger-name info))
|
|
(file-remap-name (intern (format "realgud:%s-file-remap" debugger-name)))
|
|
(file-remap (and (boundp file-remap-name) (eval file-remap-name)))
|
|
(filename)
|
|
(remapped-filename)
|
|
)
|
|
(insert "* Source Buffers Seen (srcbuf-list)\n")
|
|
|
|
(dolist (buffer buffer-list)
|
|
(insert " - ")
|
|
(put-text-property
|
|
(insert-text-button
|
|
(setq filename (buffer-name buffer))
|
|
'action 'realgud:cmdbuf-follow-buffer
|
|
'help-echo "mouse-2: visit this file")
|
|
(point)
|
|
'buffer buffer)
|
|
(when (setq remapped-filename (and file-remap (gethash filename file-remap)))
|
|
(insert (format "\tremapped to: %s" remapped-filename)))
|
|
(insert "\n")
|
|
)))
|
|
|
|
;; FIXME: this is a cheat. We are inserting
|
|
;; and afterwards inserting ""
|
|
(defun realgud:cmdbuf-bp-list-describe (info)
|
|
(let ((bp-list (realgud-cmdbuf-info-bp-list info))
|
|
;; For reasons I don't understand bp-list has duplicates
|
|
(bp-nums nil))
|
|
(cond (bp-list
|
|
(insert "* Breakpoint list (bp-list)\n")
|
|
(dolist (loc bp-list "")
|
|
(let ((bp-num (realgud-loc-num loc)))
|
|
(when (and bp-num (not (cl-member bp-num bp-nums)))
|
|
(insert (format "** Breakpoint %d\n" bp-num))
|
|
(realgud:org-mode-append-loc loc)
|
|
(setq bp-nums (cl-adjoin bp-num bp-nums))
|
|
))))
|
|
;; Since we are inserting, the below in fact
|
|
;; inserts nothing. The string return is
|
|
;; aspirational for when this is fixed
|
|
(t "\n")
|
|
)))
|
|
|
|
(defun realgud:org-mode-encode (header object)
|
|
"Return an org-mode representation of OBJECT as an org-mode string."
|
|
(format "%s%s" header
|
|
(cond ((not object) "nil\n")
|
|
((stringp object) (format "%s\n" object))
|
|
((keywordp object) (json-encode-string
|
|
(substring (symbol-name object) 1)))
|
|
((symbolp object) (json-encode-string
|
|
(symbol-name object)))
|
|
((numberp object) (json-encode-number object))
|
|
((arrayp object) (json-encode-array object))
|
|
((hash-table-p object) (realgud:org-mode-encode-htable object))
|
|
;; ((listp object) (realgud:org-mode-encodelist object))
|
|
(t (signal 'error (list object))))))
|
|
|
|
(defun realgud:org-mode-encode-htable (hash-table)
|
|
"Return an org-mode representation of HASH-TABLE as a s."
|
|
(format "%s"
|
|
(json-join
|
|
(sort (realgud:org-mode-encode-htable-1 hash-table)
|
|
'string<) "")))
|
|
|
|
(defun realgud:org-mode-encode-htable-1 (hash-table)
|
|
"Return an org-mode representation of HASH-TABLE as a s."
|
|
(let (r)
|
|
(maphash
|
|
(lambda (k v)
|
|
(push (format
|
|
" - %s\t::\t%s" k (realgud:org-mode-encode v ""))
|
|
r))
|
|
hash-table)
|
|
r))
|
|
|
|
(defun realgud:cmdbuf-info-describe (&optional buffer)
|
|
"Display realgud-cmdcbuf-info fields of BUFFER.
|
|
BUFFER is either a debugger command or source buffer. If BUFFER is not given
|
|
the current buffer is used as a starting point.
|
|
Information is put in an internal buffer called *Describe Debugger Session*."
|
|
(interactive "")
|
|
(setq buffer (realgud-get-cmdbuf buffer))
|
|
(if buffer
|
|
(with-current-buffer buffer
|
|
(let ((info realgud-cmdbuf-info)
|
|
(cmdbuf-name (buffer-name)))
|
|
(if info
|
|
(progn
|
|
(switch-to-buffer (get-buffer-create "*Describe Debugger Session*"))
|
|
(setq buffer-read-only 'nil)
|
|
(delete-region (point-min) (point-max))
|
|
;;(insert "#+OPTIONS: H:2 num:nil toc:t \\n:nil ::t |:t ^:nil -:t f:t *:t tex:t d:(HIDE) tags:not-in-toc\n")
|
|
(insert (format "#+TITLE: Debugger info for %s
|
|
|
|
This is based on an org-mode buffer. Hit tab to expand/contract sections.
|
|
\n"
|
|
cmdbuf-name))
|
|
(insert "* General Information (realgud-cmdbuf-info)\n")
|
|
;; (insert "* General Information (")
|
|
;; (insert-text-button
|
|
;; "realgud-cmdbuf-info"
|
|
;; ;; FIXME figure out how to set buffer to cmdbuf so we get cmdbuf value
|
|
;; 'action (lambda(button) (describe-variable 'realgud-cmdbuf-info))
|
|
;; 'help-echo "mouse-2: help-on-variable")
|
|
;; (insert ")\n")
|
|
|
|
(mapc 'insert
|
|
(list
|
|
(format " - Debugger name ::\t%s\n"
|
|
(realgud-cmdbuf-info-debugger-name info))
|
|
(format " - Command-line args ::\t%s\n"
|
|
(json-encode (realgud-cmdbuf-info-cmd-args info)))
|
|
(format " - Starting directory ::\t%s\n"
|
|
(realgud-cmdbuf-info-starting-directory info))
|
|
(format " - Current source-code path ::\t[[%s]]\n"
|
|
(realgud-cmdbuf-info-source-path info))
|
|
(format " - Selected window should contain source? :: %s\n"
|
|
(realgud-cmdbuf-info-in-srcbuf? info))
|
|
(format " - Last input end ::\t%s\n"
|
|
(realgud-cmdbuf-info-last-input-end info))
|
|
(format " - Source should go into short-key mode? :: %s\n"
|
|
(realgud-cmdbuf-info-src-shortkey? info))
|
|
(format " - In debugger? ::\t%s\n"
|
|
(realgud-cmdbuf-info-in-debugger? info))
|
|
(format " - Ignore file regexps ::\t%s\n"
|
|
(realgud-cmdbuf-info-ignore-re-file-list info))
|
|
(format " - remapped file names ::\t%s\n"
|
|
(realgud-cmdbuf-info-filename-remap-alist info))
|
|
|
|
(realgud:org-mode-encode "\n** Remap table for debugger commands\n"
|
|
(realgud-cmdbuf-info-cmd-hash info))
|
|
;; (realgud:org-mode-encode "\n** Backtrace buffer"
|
|
;; (realgud-cmdbuf-info-bt-buf info))
|
|
;; (format " - Backtrace buffer ::\t%s\n"
|
|
;; (realgud-cmdbuf-info-bt-buf info))
|
|
))
|
|
(insert "\n")
|
|
(realgud:cmdbuf-bp-list-describe info)
|
|
(insert "\n")
|
|
(realgud:cmdbuf-buffers-describe info)
|
|
(insert "\n")
|
|
(realgud:loc-hist-describe (realgud-cmdbuf-info-loc-hist info))
|
|
(insert "
|
|
#+STARTUP: overview
|
|
#+STARTUP: content
|
|
#+STARTUP: showall
|
|
#+STARTUP: showeverything
|
|
")
|
|
(goto-char (point-min))
|
|
(realgud:info-mode)
|
|
)
|
|
(message "realgud-cmdbuf-info is nil")
|
|
)
|
|
))
|
|
(message "Buffer %s is not a debugger source or command buffer; nothing done."
|
|
(or buffer (current-buffer)))
|
|
)
|
|
)
|
|
|
|
(defun realgud-cmdbuf? (&optional buffer)
|
|
"Return true if BUFFER is a debugger command buffer."
|
|
(with-current-buffer-safe
|
|
(or buffer (current-buffer))
|
|
(realgud-cmdbuf-info-set?)))
|
|
|
|
(defun realgud-cmdbuf-info-set? ()
|
|
"Return true if realgud-cmdbuf-info is set."
|
|
(and (boundp 'realgud-cmdbuf-info)
|
|
realgud-cmdbuf-info
|
|
(realgud-cmdbuf-info? realgud-cmdbuf-info)))
|
|
|
|
(defun realgud-cmdbuf-toggle-in-debugger? (&optional buffer)
|
|
"Toggle state of whether we think we are in the debugger or not"
|
|
(interactive "")
|
|
(setq buffer (realgud-get-cmdbuf buffer))
|
|
(if buffer
|
|
(with-current-buffer buffer
|
|
(realgud-cmdbuf-info-in-debugger?=
|
|
(not (realgud-sget 'cmdbuf-info 'in-debugger?)))
|
|
(message "Command buffer is in debugger?: %s\n"
|
|
(realgud-cmdbuf-info-in-debugger? realgud-cmdbuf-info))
|
|
(realgud-cmdbuf-mode-line-update)
|
|
)
|
|
(message "Buffer %s is not a debugger buffer; nothing done."
|
|
(or buffer (current-buffer)))
|
|
)
|
|
)
|
|
|
|
(defun realgud-cmdbuf-stay-in-source-toggle (&optional buffer)
|
|
"Toggle state of whether we should stay in source code or not"
|
|
(interactive "")
|
|
(setq buffer (realgud-get-cmdbuf buffer))
|
|
(if buffer
|
|
(with-current-buffer buffer
|
|
(realgud-cmdbuf-info-in-srcbuf?=
|
|
(not (realgud-sget 'cmdbuf-info 'in-srcbuf?)))
|
|
(message "Selected window should contain source?: %s\n"
|
|
(realgud-cmdbuf-info-in-srcbuf? realgud-cmdbuf-info))
|
|
)
|
|
(message "Buffer %s is not a debugger buffer; nothing done."
|
|
(or buffer (current-buffer)))
|
|
)
|
|
)
|
|
|
|
(defun realgud-cmdbuf-add-srcbuf(srcbuf &optional cmdbuf)
|
|
"Add SRCBUF to srcbuf-list field of INFO unless it is already included."
|
|
(setq cmdbuf (or cmdbuf (current-buffer)))
|
|
(if (realgud-cmdbuf? cmdbuf)
|
|
(with-current-buffer-safe cmdbuf
|
|
(unless (memq srcbuf (realgud-cmdbuf-info-srcbuf-list realgud-cmdbuf-info))
|
|
(setf (realgud-cmdbuf-info-srcbuf-list realgud-cmdbuf-info)
|
|
(cons srcbuf (realgud-cmdbuf-info-srcbuf-list realgud-cmdbuf-info))))
|
|
)
|
|
)
|
|
)
|
|
|
|
(defun realgud-cmdbuf-set-shortkey(&optional cmdbuf unset)
|
|
(interactive "")
|
|
(setq cmdbuf (or cmdbuf (current-buffer)))
|
|
(if (realgud-cmdbuf? cmdbuf)
|
|
(with-current-buffer-safe cmdbuf
|
|
(setf (realgud-cmdbuf-info-src-shortkey? realgud-cmdbuf-info) (not unset))
|
|
(message "Set source to shortkey is now %s" (not unset))
|
|
))
|
|
)
|
|
|
|
(defun realgud-cmdbuf-command-string(cmd-buffer)
|
|
"Get the command string invocation for this command buffer"
|
|
(cond
|
|
((realgud-cmdbuf? cmd-buffer)
|
|
(with-current-buffer cmd-buffer
|
|
(let*
|
|
((cmd-args (realgud-sget 'cmdbuf-info 'cmd-args))
|
|
(result (car cmd-args)))
|
|
(and cmd-args
|
|
(cl-reduce (lambda(result x)
|
|
(setq result (concat result " " x)))
|
|
cmd-args)))))
|
|
(t nil)))
|
|
|
|
;; FIXME cmd-hash should not be optional. And while I am at it, remove
|
|
;; parameters loc-regexp, file-group, and line-group which can be found
|
|
;; inside pat-hash
|
|
;;
|
|
;; To do this however we need to fix up the caller
|
|
;; realgud:track-set-debugger by changing realgud-pat-hash to store a hash
|
|
;; rather than the loc, file, and line fields; those fields then get
|
|
;; removed.
|
|
|
|
(defun realgud-cmdbuf-init
|
|
(cmd-buf debugger-name regexp-hash &optional cmd-hash base-variable-name
|
|
starting-directory)
|
|
"Initialize CMD-BUF for a working with a debugger.
|
|
DEBUGGER-NAME is the name of the debugger; REGEXP-HASH are debugger-specific
|
|
values set in the debugger's init.el."
|
|
(with-current-buffer-safe cmd-buf
|
|
(let ((realgud-loc-pat (gethash "loc" regexp-hash))
|
|
(font-lock-keywords)
|
|
(font-lock-breakpoint-keywords)
|
|
)
|
|
(setq realgud-cmdbuf-info
|
|
(make-realgud-cmdbuf-info
|
|
:debugger-name debugger-name
|
|
:base-variable-name (or base-variable-name debugger-name)
|
|
:cmd-args nil
|
|
:frame-switch? nil
|
|
:in-srcbuf? nil
|
|
:last-input-end (point-max)
|
|
:prior-prompt-regexp nil
|
|
:no-record? nil
|
|
:in-debugger? nil
|
|
:src-shortkey? t
|
|
:regexp-hash regexp-hash
|
|
:srcbuf-list nil
|
|
:bt-buf nil
|
|
:brkpt-buf nil
|
|
:bp-list nil
|
|
:divert-output? nil
|
|
:cmd-hash cmd-hash
|
|
:callback-loc-fn (gethash "loc-callback-fn" regexp-hash)
|
|
:callback-eval-filter (gethash "callback-eval-filter"
|
|
regexp-hash)
|
|
:loc-regexp (realgud-sget 'loc-pat 'regexp)
|
|
:file-group (realgud-sget 'loc-pat 'file-group)
|
|
:line-group (realgud-sget 'loc-pat 'line-group)
|
|
:alt-file-group (realgud-sget 'loc-pat 'alt-file-group)
|
|
:alt-line-group (realgud-sget 'loc-pat 'alt-line-group)
|
|
:text-group (realgud-sget 'loc-pat 'text-group)
|
|
:ignore-re-file-list (gethash "ignore-re-file-list" regexp-hash)
|
|
:filename-remap-alist nil
|
|
:mutex (make-mutex (buffer-name))
|
|
:loc-hist (make-realgud-loc-hist)
|
|
:starting-directory starting-directory
|
|
))
|
|
(setq font-lock-keywords (realgud-cmdbuf-pat "font-lock-keywords"))
|
|
(if font-lock-keywords
|
|
(set (make-local-variable 'font-lock-defaults)
|
|
(list font-lock-keywords)))
|
|
(setq font-lock-breakpoint-keywords (realgud-cmdbuf-pat "font-lock-breakpoint-keywords"))
|
|
(if font-lock-breakpoint-keywords
|
|
(set (make-local-variable 'font-lock-breakpoint-keywords)
|
|
(list font-lock-breakpoint-keywords)))
|
|
)
|
|
(put 'realgud-cmdbuf-info 'variable-documentation
|
|
"Debugger object for a process buffer."))
|
|
)
|
|
|
|
(defun realgud-cmdbuf-reset (cmd-buf)
|
|
"nil out variable realgud-cmdbuf-info in CMD-BUF"
|
|
(with-current-buffer-safe cmd-buf
|
|
(setq realgud-cmdbuf-info nil)
|
|
))
|
|
|
|
(defun realgud-cmdbuf-debugger-name (&optional cmd-buf)
|
|
"Return the debugger name recorded in the debugger command-process buffer."
|
|
(with-current-buffer-safe (or cmd-buf (current-buffer))
|
|
(if (realgud-cmdbuf?)
|
|
(realgud-sget 'cmdbuf-info 'debugger-name)
|
|
nil))
|
|
)
|
|
|
|
(defun realgud-cmdbuf-mutex (&optional cmd-buf)
|
|
"Return the mutex for the current command buffer"
|
|
(with-current-buffer-safe (or cmd-buf (current-buffer))
|
|
(if (realgud-cmdbuf?)
|
|
(realgud-sget 'cmdbuf-info 'mutex)
|
|
nil))
|
|
)
|
|
|
|
(defun realgud-cmdbuf-filename-remap-alist (&optional cmd-buf)
|
|
"Return the file-remap alist the current command buffer"
|
|
(with-current-buffer-safe (or cmd-buf (current-buffer))
|
|
(if (realgud-cmdbuf?)
|
|
(realgud-sget 'cmdbuf-info 'filename-remap-alist)
|
|
nil))
|
|
)
|
|
|
|
(defun realgud-cmdbuf-pat(key)
|
|
"Extract regexp stored under KEY in a realgud-cmdbuf via realgud-cmdbuf-info"
|
|
(if (realgud-cmdbuf?)
|
|
(let*
|
|
((debugger-name (realgud-cmdbuf-debugger-name))
|
|
(regexp-hash (gethash debugger-name realgud-pat-hash))
|
|
(loc-pat (gethash key regexp-hash)))
|
|
loc-pat)
|
|
nil))
|
|
|
|
(defun realgud-cmdbuf-loc-hist(cmd-buf)
|
|
"Return the history ring of locations that a debugger
|
|
command-process buffer has stored."
|
|
(with-current-buffer-safe cmd-buf
|
|
(realgud-sget 'cmdbuf-info 'loc-hist))
|
|
)
|
|
|
|
(defun realgud-cmdbuf-ignore-re-file-list(cmd-buf)
|
|
(with-current-buffer-safe cmd-buf
|
|
(realgud-sget 'cmdbuf-info 'ignore-re-file-list))
|
|
)
|
|
|
|
(defun realgud-cmdbuf-src-marker(cmd-buf)
|
|
"Return a marker to current source location stored in the history ring."
|
|
(with-current-buffer cmd-buf
|
|
(let* ((loc (realgud-loc-hist-item (realgud-cmdbuf-loc-hist cmd-buf))))
|
|
(and loc (realgud-loc-marker loc)))))
|
|
|
|
(defun realgud-cmdbuf-mode-line-update (&optional opt-cmdbuf)
|
|
"Force update of command buffer to include process status"
|
|
(let ((cmdbuf (realgud-get-cmdbuf opt-cmdbuf))
|
|
(debug-status)
|
|
(status)
|
|
(cmd-process)
|
|
)
|
|
(if (and cmdbuf (buffer-name cmdbuf))
|
|
(with-current-buffer cmdbuf
|
|
(setq cmd-process (get-buffer-process cmdbuf))
|
|
(setq debug-status
|
|
(if (realgud-sget 'cmdbuf-info 'in-debugger?)
|
|
" debugger"
|
|
""))
|
|
(setq status
|
|
(if cmd-process
|
|
(list (propertize
|
|
(format ":%s%s"
|
|
(process-status cmd-process) debug-status)
|
|
'face 'realgud-debugger-running))
|
|
(list (propertize ":not running" 'face
|
|
'realgud-debugger-not-running))
|
|
))
|
|
(setq mode-line-process status)
|
|
;; Force mode line redisplay soon.
|
|
(force-mode-line-update))
|
|
))
|
|
)
|
|
|
|
|
|
(provide-me "realgud-buffer-")
|