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

   1 ;; Copyright (C) 2010, 2014 Rocky Bernstein <rocky@gnu.org>
   2 (require 'load-relative)
   3 (require-relative-list '("../fringe" "../helper" "../lochist")
   4                        "realgud-")
   5 (require-relative-list '("command" "source" "backtrace") "realgud-buffer-")
   6
   7 (declare-function realgud-backtrace?        'realgud-buffer-backtace)
   8 (declare-function realgud-cmdbuf?           'realgud-buffer-command)
   9 (declare-function realgud:loc-hist-describe 'realgud-lochist)
  10 (declare-function realgud-loc-hist-item     'realgud-lochist)
  11 (declare-function realgud-srcbuf?           'realgud-buffer-command)
  12 (declare-function buffer-killed?            'realgud-helper)
  13
  14 (defvar realgud-cmdbuf-info)
  15
  16 (defun realgud-get-cmdbuf-from-backtrace ( &optional opt-buffer)
  17   "Return the command buffer associated with source
  18 OPT-BUFFER or if that is ommited `current-buffer' which is
  19 assumed to be a source-code buffer."
  20   (let ((buffer (or opt-buffer (current-buffer))))
  21     (if (realgud-backtrace? buffer)
  22         (with-current-buffer-safe buffer
  23           (realgud-sget 'backtrace-info 'cmdbuf))
  24       nil)))
  25
  26 (defun realgud-get-cmdbuf-from-srcbuf ( &optional opt-buffer)
  27   "Return the command buffer associated with source
  28 OPT-BUFFER or if that is ommited `current-buffer' which is
  29 assumed to be a source-code buffer."
  30   (let ((buffer (or opt-buffer (current-buffer))))
  31     (if (realgud-srcbuf? buffer)
  32         (with-current-buffer-safe buffer
  33           (realgud-sget 'srcbuf-info 'cmdproc))
  34       nil)))
  35
  36 (defun realgud-get-srcbuf-from-cmdbuf ( &optional opt-buffer opt-loc)
  37   "Return the source-code buffer associated with command
  38 OPT-BUFFER or if that is ommited `current-buffer' which is
  39 assumed to be a process-command buffer."
  40   (let ((buffer (or opt-buffer (current-buffer))))
  41     (if (realgud-cmdbuf? buffer)
  42         (with-current-buffer-safe buffer
  43           (let ((loc
  44                  (or opt-loc
  45                      (realgud-loc-hist-item
  46                       (realgud-cmdbuf-info-loc-hist realgud-cmdbuf-info)))))
  47             (if loc
  48                 (marker-buffer (realgud-loc-marker loc))
  49               nil)
  50             ))
  51       nil)))
  52
  53 (defun realgud-get-srcbuf( &optional opt-buffer opt-loc)
  54   "Return source-code buffer associated with OPT-BUFFER or
  55 `current-buffer' if that is omitted. nil is returned if we don't
  56 find anything. If we started out with a buffer that is set up to
  57 be a source-code buffer we will use that even though it might not
  58 be the source code buffer for the frame that the debugger is
  59 using. See also `realgud-get-current-srcbuf'."
  60
  61   (let ((buffer (or opt-buffer (current-buffer))))
  62     (with-current-buffer-safe buffer
  63       (cond
  64        ;; Perhaps buffer is a source source-code buffer?
  65        ((realgud-srcbuf? buffer) buffer)
  66        ;; Perhaps buffer is a process-command buffer.
  67        ((realgud-cmdbuf? buffer)
  68         (realgud-get-srcbuf-from-cmdbuf buffer opt-loc))
  69        (t nil)))))
  70
  71 (defun realgud-get-current-srcbuf( &optional opt-buffer)
  72   "Return the source-code buffer associated with OPT-BUFFER
  73 or `current-buffer' if that is omitted. nil is returned
  74 if we don't find anything."
  75
  76   (let ((buffer (or opt-buffer (current-buffer))))
  77     (with-current-buffer-safe buffer
  78       (let ((cmdbuf
  79              (cond
  80               ((realgud-srcbuf? buffer)
  81                (realgud-get-cmdbuf-from-srcbuf buffer))
  82               ((realgud-cmdbuf? buffer)
  83                buffer)
  84               (t nil))))
  85         (if cmdbuf
  86             (realgud-get-srcbuf-from-cmdbuf cmdbuf)
  87           nil)))))
  88
  89 (defun realgud-get-cmdbuf( &optional opt-buffer)
  90   "Return the command buffer associated with OPT-BUFFER
  91 or `current-buffer' if that is omitted. nil is returned
  92 if we don't find anything."
  93
  94   (let ((buffer (or opt-buffer (current-buffer))))
  95     (with-current-buffer-safe buffer
  96       (cond
  97        ;; Perhaps buffer is a process-command buffer?
  98        ((realgud-cmdbuf? buffer) buffer)
  99        ;; Perhaps buffer is a source-code buffer?
 100        ((realgud-srcbuf? buffer)
 101         (realgud-get-cmdbuf-from-srcbuf buffer))
 102        ;; Perhaps buffer is a backtrace buffer?
 103        ((realgud-backtrace? buffer)
 104         (realgud-get-cmdbuf-from-backtrace buffer))
 105        (t nil)))))
 106
 107 (defun realgud-get-backtrace-buf( &optional opt-buffer)
 108   "Return the backtrace buffer associated with
 109 OPT-BUFFER or if that is ommited `current-buffer'."
 110   (let* ((buffer (or opt-buffer (current-buffer)))
 111          (cmdbuf (realgud-get-cmdbuf buffer)))
 112     (with-current-buffer-safe cmdbuf
 113       (realgud-sget 'cmdbuf-info 'bt-buf)
 114       ))
 115   )
 116
 117 (defun realgud-get-process (&optional opt-buffer)
 118   "Return the process buffer associated with OPT-BUFFER or
 119   `current-buffer' if that is omitted. nil is returned if
 120 we don't find anything."
 121   (let* ((buffer (or opt-buffer (current-buffer)))
 122          (cmdbuf (realgud-get-cmdbuf buffer)))
 123     (if cmdbuf
 124         (get-buffer-process cmdbuf)
 125       nil)
 126     )
 127 )
 128
 129 (defun realgud:srcbuf-info-describe (&optional buffer)
 130   "Provide descriptive information of the buffer-local variable
 131 `realgud-srcbuf-info', a defstruct. BUFFER if given is the buffer to
 132 use to get the information from.
 133 "
 134   (interactive "")
 135   (setq buffer (realgud-get-srcbuf buffer))
 136   (if buffer
 137       (with-current-buffer buffer
 138         (let ((info realgud-srcbuf-info)
 139               (srcbuf-name (buffer-name))
 140               (a1 realgud-overlay-arrow1)
 141               (a2 realgud-overlay-arrow2)
 142               (a3 realgud-overlay-arrow3)
 143               )
 144           (switch-to-buffer (get-buffer-create "*Describe*"))
 145           (delete-region (point-min) (point-max))
 146           (mapc 'insert
 147                 (list
 148                  (format "srcbuf-info for %s\n" srcbuf-name)
 149                  (format "Was previously read only?: %s\n"
 150                          (realgud-srcbuf-info-was-read-only? info))
 151                  (format "Command Process buffer: %s\n"
 152                          (realgud-srcbuf-info-cmdproc info))
 153
 154                  ;; FIXME This info isn't part of the src info structure.
 155                  (format "Overlay arrow 1: %s\n" a1)
 156                  (format "Overlay arrow 2: %s\n" a2)
 157                  (format "Overlay arrow 3: %s\n" a3)
 158                  (format "Location history:\n")
 159                  ))
 160           (realgud:loc-hist-describe  (realgud-srcbuf-info-loc-hist info))
 161           )
 162         )
 163     (message "Buffer %s is not a debugger source buffer; nothing done."
 164              (or buffer (current-buffer)))
 165     )
 166   )
 167
 168 (provide-me "realgud-buffer-")