code.delx.au - gnu-emacs-elpa/blob - packages/realgud/realgud/common/buffer/source.el

   1 ;;; Copyright (C) 2010, 2012-2015 Rocky Bernstein <rocky@gnu.org>
   2 ;;; source-code buffer code
   3 (eval-when-compile
   4   (require 'cl-lib)
   5   (defvar realgud-srcbuf-info) ;; is buffer local
   6   (defvar realgud-cmdbuf-info) ;; in the cmdbuf, this is buffer local
   7   )
   8
   9 (require 'load-relative)
  10 (require-relative-list '("../helper" "../key") "realgud-")
  11
  12 (declare-function realgud-populate-common-keys 'realgud-menu)
  13 (declare-function buffer-killed?               'realgud-helper)
  14 (declare-function buffer-loc-line-number?      'realgud-loc)
  15 (declare-function realgud-cmdbuf-add-srcbuf    'realgud-cmdbuf)
  16 (declare-function realgud-cmdbuf-info-bp-list  'realgud-cmdbuf)
  17 (declare-function realgud-loc-marker           'realgud-loc)
  18 (declare-function realgud-loc-line-number      'realgud-loc)
  19 (declare-function realgud-loc-num              'realgud-loc)
  20 (declare-function make-realgud-loc-hist        'realgud-lochist)
  21 (declare-function realgud-get-srcbuf           'helper)
  22 (declare-function realgud-short-key-mode-setup 'realgud-shortkey)
  23
  24 (defstruct realgud-srcbuf-info
  25   "debugger object/structure specific to a (top-level) source program
  26 to be debugged."
  27   cmdproc        ;; buffer of the associated debugger process
  28   cur-pos        ;; If not nil, the debugger thinks we are currently
  29                  ;; positioned at a corresponding place in the
  30                  ;; program.
  31   short-key?     ;; Was the source buffer previously in short-key
  32                  ;; mode? Used to deterimine when short-key mode
  33                  ;; changes state in a source buffer, so we need to
  34                  ;; perform on/off actions.
  35   was-read-only? ;; Was buffer initially read only? (i.e. the original
  36                  ;; value of the buffer's buffer-read-only
  37                  ;; variable. Short-key-mode may change the read-only
  38                  ;; state, so we need restore this value when leaving
  39                  ;; short-key mode
  40
  41   loc-hist       ;; ring of locations seen
  42
  43   ;; FILL IN THE FUTURE
  44   ;;(brkpt-alist '())  ;; alist of breakpoints the debugger has referring
  45                        ;; to this buffer. Each item is (brkpt-name . marker)
  46   ;;
  47 )
  48
  49
  50 (defalias 'realgud-srcbuf-info? 'realgud-srcbuf-p)
  51
  52 ;; FIXME: figure out how to put in a loop.
  53 (realgud-struct-field-setter "realgud-srcbuf-info" "cmdproc")
  54 (realgud-struct-field-setter "realgud-srcbuf-info" "short-key?")
  55 (realgud-struct-field-setter "realgud-srcbuf-info" "was-read-only?")
  56
  57 (defun realgud-srcbuf-info-set? ()
  58   "Return true if `realgud-srcbuf-info' is set."
  59   (and (boundp 'realgud-srcbuf-info)
  60        realgud-srcbuf-info
  61        (realgud-srcbuf-info? realgud-srcbuf-info)))
  62
  63 (defun realgud-srcbuf? (&optional buffer)
  64   "Return true if BUFFER is a debugger source buffer."
  65   (with-current-buffer-safe (or buffer (current-buffer))
  66     (and (realgud-srcbuf-info-set?)
  67          (not (buffer-killed? (realgud-sget 'srcbuf-info 'cmdproc)))
  68    )))
  69
  70 (defun realgud-srcbuf-debugger-name (&optional src-buf)
  71   "Return the debugger name recorded in the debugger command-process buffer."
  72   (with-current-buffer-safe (or src-buf (current-buffer))
  73     (realgud-sget 'srcbuf-info 'debugger-name))
  74 )
  75
  76 (defun realgud-srcbuf-loc-hist(src-buf)
  77   "Return the history ring of locations that a debugger process has stored."
  78   (with-current-buffer-safe src-buf
  79     (realgud-sget 'srcbuf-info 'loc-hist))
  80 )
  81
  82 (declare-function fn-p-to-fn?-alias(sym))
  83 (fn-p-to-fn?-alias 'realgud-srcbuf-info-p)
  84 (declare-function realgud-srcbuf-info?(var))
  85 (declare-function realgud-cmdbuf-info-name(cmdbuf-info))
  86
  87 ;; FIXME: support a list of cmdprocs's since we want to allow
  88 ;; a source buffer to potentially participate in several debuggers
  89 ;; which might be active.
  90 (make-variable-buffer-local 'realgud-srcbuf-info)
  91
  92 (defun realgud-srcbuf-init
  93   (src-buffer cmdproc-buffer)
  94   "Initialize SRC-BUFFER as a source-code buffer for a debugger.
  95 CMDPROC-BUFFER is the process-command buffer containing the
  96 debugger.  DEBUGGER-NAME is the name of the debugger as a main
  97 program name."
  98   (with-current-buffer cmdproc-buffer
  99     (set-buffer src-buffer)
 100     (set (make-local-variable 'realgud-srcbuf-info)
 101          (make-realgud-srcbuf-info
 102           :cmdproc cmdproc-buffer
 103           :loc-hist (make-realgud-loc-hist)))
 104     (put 'realgud-srcbuf-info 'variable-documentation
 105          "Debugger information for a buffer containing source code.")))
 106
 107 (defun realgud-srcbuf-init-or-update (src-buffer cmdproc-buffer)
 108   "Call `realgud-srcbuf-init' for SRC-BUFFER update `realgud-srcbuf-info' variables
 109 in it with those from CMDPROC-BUFFER"
 110   (realgud-cmdbuf-add-srcbuf src-buffer cmdproc-buffer)
 111   (with-current-buffer-safe src-buffer
 112     (realgud-populate-common-keys
 113      ;; use-local-map returns nil so e have to call (current-local-map)
 114      ;; again in this case.
 115      (or (current-local-map) (use-local-map (make-sparse-keymap))
 116          (current-local-map)))
 117     (if (realgud-srcbuf-info? realgud-srcbuf-info)
 118         (realgud-srcbuf-info-cmdproc= cmdproc-buffer)
 119       (realgud-srcbuf-init src-buffer cmdproc-buffer))))
 120
 121 (defun realgud:cmdbuf-associate(cmdbuf-name)
 122 "Associate a command buffer with for the current buffer which is
 123 assumed to be a source-code buffer"
 124   (interactive "brealgud command buffer: ")
 125   (realgud-srcbuf-init-or-update (current-buffer) (get-buffer cmdbuf-name))
 126   (realgud-short-key-mode-setup 't)
 127   )
 128
 129 (defun realgud-srcbuf-bp-list(&optional buffer)
 130   "Return a list of breakpoint loc structures that reside in
 131 BUFFER which should be an initialized source buffer."
 132   (let ((src-buffer (realgud-get-srcbuf buffer)))
 133     (if src-buffer
 134         (with-current-buffer src-buffer
 135         (let* ((info realgud-srcbuf-info)
 136                (cmdbuf (realgud-srcbuf-info-cmdproc info)))
 137           (with-current-buffer cmdbuf
 138             (let ((bp-list
 139                    (realgud-cmdbuf-info-bp-list realgud-cmdbuf-info)))
 140               (delq nil
 141                     (mapcar (lambda (loc)
 142                               (cond ((eq src-buffer
 143                                          (marker-buffer (realgud-loc-marker loc)))
 144                                      loc)
 145                                     (nil)))
 146                             bp-list))
 147               )))))))
 148
 149 (defun realgud-get-bpnum-from-line-num(line-num &optional buffer)
 150   "Find a breakpoint number associated with LINE-NUM in source code BUFFER.
 151 If none exists return nil"
 152   (let ((src-buffer (realgud-get-srcbuf buffer))
 153         (bp-num nil)
 154         (bp)
 155         (bp-list)
 156         )
 157     (if src-buffer
 158         (progn
 159           (setq bp-list (realgud-srcbuf-bp-list src-buffer))
 160           (while (and (not bp-num) bp-list)
 161             (setq bp (car bp-list))
 162             (setq bp-list (cdr bp-list))
 163             (if (eq line-num (realgud-loc-line-number bp))
 164                 (setq bp-num (realgud-loc-num bp)))
 165             ))
 166       )
 167     bp-num))
 168
 169 (provide-me "realgud-buffer-")