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.
208 lines
8.1 KiB
208 lines
8.1 KiB
;;; Copyright (C) 2010, 2012-2015, 2017 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/>.
|
|
|
|
;;; source-code buffer code
|
|
(eval-when-compile
|
|
(defvar realgud-srcbuf-info) ;; is buffer local
|
|
(defvar realgud-cmdbuf-info) ;; in the cmdbuf, this is buffer local
|
|
)
|
|
|
|
(require 'cl-lib)
|
|
(require 'load-relative)
|
|
(require-relative-list '("../helper" "../key") "realgud-")
|
|
|
|
(declare-function realgud-populate-common-keys 'realgud-menu)
|
|
(declare-function buffer-killed? 'realgud-helper)
|
|
(declare-function buffer-loc-line-number? 'realgud-loc)
|
|
(declare-function realgud-cmdbuf-add-srcbuf 'realgud-cmdbuf)
|
|
(declare-function realgud-cmdbuf-info-bp-list 'realgud-cmdbuf)
|
|
(declare-function realgud-cmdbuf? 'realgud-cmdbuf)
|
|
(declare-function realgud-loc-marker 'realgud-loc)
|
|
(declare-function realgud-loc-line-number 'realgud-loc)
|
|
(declare-function realgud-loc-num 'realgud-loc)
|
|
(declare-function make-realgud-loc-hist 'realgud-lochist)
|
|
(declare-function realgud-get-srcbuf 'helper)
|
|
(declare-function realgud-short-key-mode-setup 'realgud-shortkey)
|
|
|
|
(cl-defstruct realgud-srcbuf-info
|
|
"debugger object/structure specific to a (top-level) source program
|
|
to be debugged."
|
|
cmdproc ;; buffer of the associated debugger process
|
|
cur-pos ;; If not nil, the debugger thinks we are currently
|
|
;; positioned at a corresponding place in the
|
|
;; program.
|
|
short-key? ;; Was the source buffer previously in short-key
|
|
;; mode? Used to deterimine when short-key mode
|
|
;; changes state in a source buffer, so we need to
|
|
;; perform on/off actions.
|
|
was-read-only? ;; Was buffer initially read only? (i.e. the original
|
|
;; value of the buffer's buffer-read-only
|
|
;; variable. Short-key-mode may change the read-only
|
|
;; state, so we need restore this value when leaving
|
|
;; short-key mode
|
|
prev-local-map ;; Local map before enabling short-key-mode
|
|
|
|
loc-hist ;; ring of locations seen
|
|
|
|
;; FILL IN THE FUTURE
|
|
;;(brkpt-alist '()) ;; alist of breakpoints the debugger has referring
|
|
;; to this buffer. Each item is (brkpt-name . marker)
|
|
;;
|
|
)
|
|
|
|
|
|
(defalias 'realgud-srcbuf-info? 'realgud-srcbuf-p)
|
|
|
|
;; FIXME: figure out how to put in a loop.
|
|
(realgud-struct-field-setter "realgud-srcbuf-info" "cmdproc")
|
|
(realgud-struct-field-setter "realgud-srcbuf-info" "short-key?")
|
|
(realgud-struct-field-setter "realgud-srcbuf-info" "was-read-only?")
|
|
(realgud-struct-field-setter "realgud-srcbuf-info" "prev-local-map")
|
|
|
|
(defun realgud-srcbuf-info-set? ()
|
|
"Return non-nil if `realgud-srcbuf-info' is set."
|
|
(and (bound-and-true-p realgud-srcbuf-info)
|
|
(realgud-srcbuf-info? realgud-srcbuf-info)))
|
|
|
|
(defun realgud-srcbuf? (&optional buffer)
|
|
"Return non-nil if BUFFER is a debugger source buffer."
|
|
(with-current-buffer-safe (or buffer (current-buffer))
|
|
(and (realgud-srcbuf-info-set?)
|
|
(not (buffer-killed? (realgud-sget 'srcbuf-info 'cmdproc)))
|
|
)))
|
|
|
|
(defun realgud--read-cmd-buf (prompt)
|
|
"Read a command buffer, prompting with PROMPT."
|
|
(let* ((cmd-bufs (cl-remove-if-not #'realgud-cmdbuf? (buffer-list)))
|
|
(buf-names (mapcar #'buffer-name cmd-bufs))
|
|
(default (car buf-names)))
|
|
(when buf-names
|
|
;; Use completing-read instead of read-buffer: annoyingly, ido's
|
|
;; read-buffer ignores predicates.
|
|
(setq prompt (format "%s (default: %s): " prompt default))
|
|
(get-buffer (completing-read prompt buf-names nil t nil nil default)))))
|
|
|
|
(defun realgud--ensure-attached (&optional src-buf)
|
|
"Try to attach SRC-BUF to a command buffer.
|
|
If SRC-BUF is already attached, do nothing. Otherwise, prompt
|
|
the user for a command buffer to associate SRC-BUF to. Returns
|
|
non-nil if association was successful. SRC-BUF defaults to
|
|
current buffer."
|
|
(setq src-buf (or src-buf (current-buffer)))
|
|
(unless (realgud-srcbuf? src-buf)
|
|
(let ((cmd-buf (realgud--read-cmd-buf "Command buffer to attach to")))
|
|
(if cmd-buf
|
|
(realgud-srcbuf-init src-buf cmd-buf)
|
|
(message "No debugger process found to attach %s to" (buffer-name)))))
|
|
(realgud-srcbuf? src-buf))
|
|
|
|
(defun realgud-srcbuf-debugger-name (&optional src-buf)
|
|
"Return the debugger name recorded in the debugger command-process buffer."
|
|
(with-current-buffer-safe (or src-buf (current-buffer))
|
|
(realgud-sget 'srcbuf-info 'debugger-name))
|
|
)
|
|
|
|
(defun realgud-srcbuf-loc-hist(src-buf)
|
|
"Return the history ring of locations that a debugger process has stored."
|
|
(with-current-buffer-safe src-buf
|
|
(realgud-sget 'srcbuf-info 'loc-hist))
|
|
)
|
|
|
|
(declare-function fn-p-to-fn?-alias(sym))
|
|
(fn-p-to-fn?-alias 'realgud-srcbuf-info-p)
|
|
(declare-function realgud-srcbuf-info?(var))
|
|
(declare-function realgud-cmdbuf-info-name(cmdbuf-info))
|
|
|
|
;; FIXME: support a list of cmdprocs's since we want to allow
|
|
;; a source buffer to potentially participate in several debuggers
|
|
;; which might be active.
|
|
(make-variable-buffer-local 'realgud-srcbuf-info)
|
|
|
|
(defun realgud-srcbuf-init
|
|
(src-buffer cmdproc-buffer)
|
|
"Initialize SRC-BUFFER as a source-code buffer for a debugger.
|
|
CMDPROC-BUFFER is the process-command buffer containing the
|
|
debugger."
|
|
(with-current-buffer cmdproc-buffer
|
|
(set-buffer src-buffer)
|
|
(set (make-local-variable 'realgud-srcbuf-info)
|
|
(make-realgud-srcbuf-info
|
|
:cmdproc cmdproc-buffer
|
|
:loc-hist (make-realgud-loc-hist)))
|
|
(put 'realgud-srcbuf-info 'variable-documentation
|
|
"Debugger information for a buffer containing source code.")))
|
|
|
|
(defun realgud-srcbuf-init-or-update (src-buffer cmdproc-buffer)
|
|
"Call `realgud-srcbuf-init' for SRC-BUFFER update `realgud-srcbuf-info' variables
|
|
in it with those from CMDPROC-BUFFER"
|
|
(realgud-cmdbuf-add-srcbuf src-buffer cmdproc-buffer)
|
|
(with-current-buffer-safe src-buffer
|
|
(realgud-populate-common-keys
|
|
;; use-local-map returns nil so e have to call (current-local-map)
|
|
;; again in this case.
|
|
(or (current-local-map) (use-local-map (make-sparse-keymap))
|
|
(current-local-map)))
|
|
(if (realgud-srcbuf-info? realgud-srcbuf-info)
|
|
(realgud-srcbuf-info-cmdproc= cmdproc-buffer)
|
|
(realgud-srcbuf-init src-buffer cmdproc-buffer))))
|
|
|
|
(defun realgud:cmdbuf-associate ()
|
|
"Associate a command buffer with the current (source-code) buffer."
|
|
;; realgud-short-key-mode-setup will attempt to associate if needed.
|
|
(realgud-short-key-mode-setup t))
|
|
|
|
(defun realgud-srcbuf-bp-list(&optional buffer)
|
|
"Return a list of breakpoint loc structures that reside in
|
|
BUFFER. BUFFER should be an initialized source buffer."
|
|
(let ((src-buffer (realgud-get-srcbuf buffer)))
|
|
(if src-buffer
|
|
(with-current-buffer src-buffer
|
|
(let* ((info realgud-srcbuf-info)
|
|
(cmdbuf (realgud-srcbuf-info-cmdproc info)))
|
|
(with-current-buffer cmdbuf
|
|
(let ((bp-list
|
|
(realgud-cmdbuf-info-bp-list realgud-cmdbuf-info)))
|
|
(delq nil
|
|
(mapcar (lambda (loc)
|
|
(cond ((eq src-buffer
|
|
(marker-buffer (realgud-loc-marker loc)))
|
|
loc)
|
|
(nil)))
|
|
bp-list))
|
|
)))))))
|
|
|
|
(defun realgud-get-bpnum-from-line-num(line-num &optional buffer)
|
|
"Find a breakpoint number associated with LINE-NUM in source code BUFFER.
|
|
If none exists return nil"
|
|
(let ((src-buffer (realgud-get-srcbuf buffer))
|
|
(bp-num nil)
|
|
(bp)
|
|
(bp-list)
|
|
)
|
|
(if src-buffer
|
|
(progn
|
|
(setq bp-list (realgud-srcbuf-bp-list src-buffer))
|
|
(while (and (not bp-num) bp-list)
|
|
(setq bp (car bp-list))
|
|
(setq bp-list (cdr bp-list))
|
|
(if (eq line-num (realgud-loc-line-number bp))
|
|
(setq bp-num (realgud-loc-num bp)))
|
|
))
|
|
)
|
|
bp-num))
|
|
|
|
(provide-me "realgud-buffer-")
|