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

   1 ;;; Copyright (C) 2010, 2012, 2014-2015 Rocky Bernstein <rocky@gnu.org>
   2 ;;; Debugger location
   3 ;;; Commentary:
   4
   5 ;; This describes a debugger location structure and has code for
   6 ;; working with them.
   7
   8 (require 'load-relative)
   9 (require 'loc-changes)
  10 (require-relative-list '("fringe" "follow") "realgud-")
  11 (require-relative-list '("buffer/source") "realgud-buffer-")
  12
  13 ;; FIXME: removed because of recursive loads
  14 ;; (require-relative-list '("buffer/helper") "realgud-buffer-")
  15
  16 (declare-function realgud:strip                  'realgud)
  17 (declare-function realgud-get-cmdbuf-from-srcbuf 'realgud-buffer-helper)
  18 (declare-function realgud-srcbuf?                'realgud-buffer-source)
  19
  20 (defstruct realgud-loc
  21 "Our own location type. Even though a mark contains a
  22 file-name (via a buffer) and a line number (via an offset), we
  23 want to save the values that were seen/requested originally."
  24    num           ;; If there is a number such as a breakpoint or frame
  25                  ;; number associated with this location, this is set.
  26                  ;; nil otherwise.
  27    filename
  28    line-number
  29    column-number ;; Column offset within line
  30    source-text   ;; Source text if available
  31    marker        ;; Position in source code
  32    cmd-marker    ;; Position in command process buffer
  33 )
  34
  35 (defalias 'realgud-loc? 'realgud-loc-p)
  36
  37 ;; The below function is generic and might be found in standard
  38 ;; library. Or it might be moved someplace more generic.
  39 (defun realgud:buffer-line-no-props()
  40   "Returns a string containing the line that `point' is at,
  41 without buffer properties."
  42   (buffer-substring-no-properties (point-at-bol)
  43                                   (point-at-eol)))
  44
  45 (defun realgud:loc-describe (loc)
  46   "Display realgud-cmdcbuf-info.
  47 Information is put in an internal buffer called *Describe*."
  48   (interactive "")
  49   (switch-to-buffer (get-buffer-create "*Describe*"))
  50   (let ((link-start) (link-end) (map) (filename))
  51     (insert "  - filename      :: ")
  52     (setq filename (realgud-loc-filename loc))
  53     (put-text-property
  54      (insert-text-button filename
  55                          'action 'realgud:follow-event
  56                          'help-echo "mouse-2: go to this file")
  57      (point)
  58      'file filename)
  59     (insert "\n")
  60     (mapc 'insert
  61           (list
  62            (format "  - line number   :: %s\n" (realgud-loc-line-number loc))
  63            (format "  - brkpt num     :: %s\n" (realgud-loc-num loc))
  64            (format "  - column number :: %s\n"
  65                    (realgud-loc-column-number loc))
  66            (format "  - source text   :: %s\n" (realgud-loc-source-text loc))
  67            ))
  68     ;; Make locations clickable
  69     (insert "  - source marker :: ")
  70     (put-text-property
  71      (insert-text-button (format "%s" (realgud-loc-marker loc))
  72                          'action 'realgud:follow-event
  73                          'help-echo "mouse-2: go to this source location")
  74      (point)
  75      'mark (realgud-loc-marker loc))
  76
  77     (insert "\n  - cmdbuf marker :: ")
  78     (put-text-property
  79      (insert-text-button (format "%s" (realgud-loc-cmd-marker loc))
  80                          'action 'realgud:follow-event
  81                          'help-echo "mouse-2: go to this command-buffer location")
  82      (point)
  83      'mark (realgud-loc-cmd-marker loc))
  84     (insert "\n")
  85     )
  86   )
  87
  88
  89 (defun realgud-loc-current(&optional source-buffer cmd-marker)
  90   "Create a location object for the point in the current buffer.
  91    If SOURCE-BUFFER is not given, take the current buffer as the
  92    source buffer."
  93   (interactive "")
  94   (unless source-buffer
  95     (setq source-buffer (current-buffer)))
  96   (unless (realgud-srcbuf? source-buffer)
  97     (error "%s is not a realgud source buffer" source-buffer))
  98   (unless cmd-marker
  99     (setq cmd-marker
 100           (realgud-get-cmdbuf-from-srcbuf source-buffer))
 101     )
 102   (with-current-buffer source-buffer
 103     (let ((mark (point-marker))
 104           (text (realgud:buffer-line-no-props)))
 105       (make-realgud-loc
 106        :filename (buffer-file-name source-buffer)
 107        :column-number (current-column)
 108        :line-number (line-number-at-pos)
 109        :source-text text
 110        :marker      mark
 111        :cmd-marker cmd-marker
 112        )
 113       )))
 114
 115 (defun realgud-loc-marker=(loc marker)
 116   (setf (realgud-loc-marker loc) marker))
 117
 118 (defun realgud-loc-goto(loc)
 119   "Position point in the buffer referred to by LOC. This may
 120 involve reading in a file. In the process, the marker inside LOC
 121 may be updated.
 122
 123 If LOC is found, The buffer containing the location referred to,
 124 the source-code buffer, is returned. Otherwise, nil is returned."
 125   (if (realgud-loc? loc)
 126       (let* ((filename    (realgud-loc-filename loc))
 127              (line-number (realgud-loc-line-number loc))
 128              (column-number (realgud-loc-column-number loc))
 129              (marker      (realgud-loc-marker loc))
 130              (cmd-marker  (realgud-loc-cmd-marker loc))
 131              (use-marker  nil)
 132              (src-buffer  (marker-buffer (or marker (make-marker)))))
 133         (if (and (not src-buffer) filename)
 134             (setq src-buffer (find-file-noselect filename)))
 135         (if cmd-marker
 136             (with-current-buffer (marker-buffer cmd-marker)
 137               (goto-char cmd-marker)))
 138         (if src-buffer
 139             (with-current-buffer src-buffer
 140               (when (and marker (marker-position marker))
 141                 ;; A marker has been set in loc, so use that.
 142                 (goto-char (marker-position marker))
 143                 (setq use-marker 't)
 144                 (let ((current-text (realgud:buffer-line-no-props))
 145                       (loc-text (realgud-loc-source-text loc)))
 146                   (unless (and loc-text
 147                                (equal (realgud:strip current-text) (realgud:strip loc-text)))
 148                     (loc-changes-goto line-number)
 149                     (setq current-text (realgud:buffer-line-no-props))
 150                     (when (equal current-text loc-text)
 151                       (message "Marked location needed updating")
 152                       (setq use-marker nil))
 153                     )))
 154               (if use-marker
 155                   (goto-char (marker-position marker))
 156                 ;; else
 157                 ;; We don't have a position set in the source buffer
 158                 ;; so find it and go there. We use `loc-changes-goto'
 159                 ;; to find that spot. `loc-changes-goto' keeps a
 160                 ;; record of the first time we went to that spot, so
 161                 ;; in the face of buffer modifications, it may be more
 162                 ;; reliable.
 163                 (let ((src-marker))
 164                   (loc-changes-goto line-number)
 165                   (when column-number
 166                     (move-to-column column-number))
 167                   (setq src-marker (point-marker))
 168                   (realgud-loc-marker= loc src-marker)
 169                   ))))
 170         src-buffer )))
 171
 172 (provide-me "realgud-")