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

   1 ;;; Copyright (C) 2010, 2012, 2014-2015 Rocky Bernstein <rocky@gnu.org>
   2 ;;; Debugger location ring
   3 ;;; Commentary:
   4
   5 ;; This file manages a ring of (recently stopped) positions to allow
   6 ;; the programmer to move between them.
   7
   8 ;;; Code:
   9
  10 (require 'ring)
  11 (require 'org)
  12 (require 'load-relative)
  13 (require-relative-list '("loc") "realgud-")
  14
  15 (declare-function realgud:loc-describe 'realgud-loc)
  16
  17 (defcustom realgud-loc-hist-size 20  ; For testing. Should really be larger.
  18   "Size of realgud's position history ring"
  19   :type 'integer
  20   :group 'realgud)
  21
  22 (defstruct realgud-loc-hist
  23   "A list of source-code positions recently encountered"
  24   (position -1)
  25   (ring (make-ring realgud-loc-hist-size)))
  26
  27 (defun realgud:loc-hist-describe(loc-hist)
  28   "Format LOC-HIST values inside buffer *Describe*"
  29   (switch-to-buffer (get-buffer-create "*Describe*"))
  30   (org-mode)
  31   (insert "** Source Positions Stopped At\n")
  32   (mapc 'insert
  33         (list
  34          (format "  -  buffer size  :: %d\n" realgud-loc-hist-size)
  35          (format "  -  position     :: %d\n"
  36                  (realgud-loc-hist-position loc-hist))))
  37   (let ((locs (cddr (realgud-loc-hist-ring loc-hist)))
  38         (loc)
  39         (i 0))
  40     (while (and (< i (length locs)) (setq loc (elt locs i)) (realgud-loc? loc) )
  41       (insert (format "*** %d\n" i))
  42       (realgud:loc-describe loc)
  43       (setq i (1+ i))
  44       )
  45     )
  46 )
  47
  48 (defun realgud-loc-hist-item-at(loc-hist position)
  49   "Get the current item stored at POSITION of the ring
  50 component in LOC-HIST"
  51   (lexical-let ((ring (realgud-loc-hist-ring loc-hist)))
  52     (if (ring-empty-p ring)
  53         nil
  54       (ring-ref ring position))))
  55
  56 (defun realgud-loc-hist-item(loc-hist)
  57   "Get the current item of LOC-HIST at the position previously set"
  58   (realgud-loc-hist-item-at
  59    loc-hist
  60    (realgud-loc-hist-position loc-hist)))
  61
  62 (defun realgud-loc-hist-add(loc-hist loc)
  63   "Add FRAME to LOC-HIST"
  64   ;; Switching frames shouldn't save a new ring
  65   ;; position. Also make sure no position is different.
  66   ;; Perhaps duplicates should be controlled by an option.
  67   (let* ((ring (realgud-loc-hist-ring loc-hist))
  68          (old-loc (realgud-loc-hist-item loc-hist)))
  69     (unless (and
  70              old-loc
  71              (equal (realgud-loc-filename old-loc)
  72                     (realgud-loc-filename loc))
  73              (equal (realgud-loc-line-number old-loc)
  74                     (realgud-loc-line-number loc))
  75              (equal (realgud-loc-column-number old-loc)
  76                     (realgud-loc-column-number old-loc)))
  77       (setf (realgud-loc-hist-position loc-hist) 0)
  78       (ring-insert ring loc)
  79     )
  80     ))
  81
  82 (defun realgud-loc-hist-clear(loc-hist)
  83   "Clear out all source locations in LOC-HIST"
  84   (lexical-let* ((ring (ring-ref (realgud-loc-hist-ring loc-hist)
  85                                  (realgud-loc-hist-position loc-hist)))
  86                  (head (car ring)))
  87     (setf (realgud-loc-hist-position loc-hist) (- head 1))
  88     (while (not (ring-empty-p ring))
  89       (ring-remove ring))))
  90
  91 (defun realgud-loc-hist-index(loc-hist)
  92   "Return the ring-index value of LOC-HIST"
  93   (lexical-let* (
  94                  (ring (realgud-loc-hist-ring loc-hist))
  95                  (head (car ring))
  96                  (ringlen (cadr ring))
  97                  (index (mod (+ ringlen head
  98                                 (- (realgud-loc-hist-position loc-hist)))
  99                              ringlen)))
 100     (if (zerop index) ringlen index)
 101     ))
 102
 103 (defun realgud-loc-hist-set (loc-hist position)
 104   "Set LOC-HIST to POSITION in the stopping history"
 105   (setf (realgud-loc-hist-position loc-hist) position))
 106
 107 ;; FIXME: add numeric arg?
 108 (defun realgud-loc-hist-newer (loc-hist)
 109   "Set LOC-HIST position to an newer position."
 110
 111   (setf (realgud-loc-hist-position loc-hist)
 112         (ring-minus1 (realgud-loc-hist-position loc-hist)
 113                     (ring-length (realgud-loc-hist-ring loc-hist)))))
 114
 115 (defun realgud-loc-hist-newest (loc-hist)
 116   "Set LOC-HIST position to the newest position."
 117   (setf (realgud-loc-hist-position loc-hist) -1))
 118
 119 ;; FIXME: add numeric arg?
 120 (defun realgud-loc-hist-older (loc-hist)
 121   "Set LOC-HIST position to an older position."
 122     (setf (realgud-loc-hist-position loc-hist)
 123          (ring-plus1 (realgud-loc-hist-position loc-hist)
 124                       (ring-length (realgud-loc-hist-ring loc-hist)))))
 125
 126 (defun realgud-loc-hist-oldest (loc-hist)
 127   "Set LOC-HIST to the oldest stopping point."
 128   (lexical-let* ((ring (realgud-loc-hist-ring loc-hist))
 129                  (head (car ring)))
 130     (setf (realgud-loc-hist-position loc-hist) head)))
 131
 132 (provide-me "realgud-")