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

   1 ;;; loc-changes.el --- keep track of positions even after buffer changes
   2
   3 ;; Copyright (C) 2015 Free Software Foundation, Inc
   4
   5 ;; Author: Rocky Bernstein <rocky@gnu.org>
   6 ;; Version: 1.2
   7 ;; URL: http://github.com/rocky/emacs-loc-changes
   8 ;; Compatibility: GNU Emacs 24.x
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; This package lets users or programs set marks in a buffer prior to
  26 ;; changes so that we can track the original positions after the
  27 ;; change.
  28
  29 ;; One common use is say when debugging a program.  The debugger has its static
  30 ;; notion of the file and positions inside that.  However it may be convenient
  31 ;; for a programmer to edit the program but not restart execution of the program.
  32
  33 ;; Another use might be in a compilation buffer for errors and
  34 ;; warnings which refer to file and line positions.
  35
  36 ;;; Code:
  37
  38 (make-variable-buffer-local 'loc-changes-alist)
  39 (defvar loc-changes-alist '()
  40   "A buffer-local association-list (alist) of line numbers and
  41 their corresponding markers in the buffer. The 'key' is the line number; the value
  42 the marker"
  43   )
  44
  45 (defun loc-changes:follow-mark(event)
  46   (interactive "e")
  47   (let* ((pos (posn-point (event-end event)))
  48          (mark (get-text-property pos 'mark)))
  49     (switch-to-buffer-other-window  (marker-buffer mark))
  50     (goto-char (marker-position mark))
  51     ))
  52
  53
  54 (defun loc-changes:alist-describe (&optional opt-buffer)
  55   "Display buffer-local variable loc-changes-alist. If BUFFER is
  56 not given, the current buffer is used. Information is put in an
  57 internal buffer called *Describe*."
  58   (interactive "")
  59   (let ((buffer (or opt-buffer (current-buffer)))
  60         (alist))
  61     (with-current-buffer buffer
  62           (setq alist loc-changes-alist)
  63           (unless (listp alist) (error "expecting loc-changes-alist to be a list"))
  64           )
  65     (switch-to-buffer (get-buffer-create "*Describe*"))
  66     (setq buffer-read-only 'nil)
  67     (delete-region (point-min) (point-max))
  68     (dolist (assoc alist)
  69           (put-text-property
  70            (insert-text-button
  71             (format "line %d: %s\n" (car assoc) (cdr assoc))
  72             'action 'loc-changes:follow-mark
  73             'help-echo "mouse-2: go to this location")
  74            (point)
  75            'mark (cdr assoc)
  76             )
  77           )
  78     (setq buffer-read-only 't)
  79     ))
  80
  81 ;;;###autoload
  82 (defun loc-changes-goto-line (line-number &optional column-number)
  83   "Position `point' at LINE-NUMBER of the current buffer. If
  84 COLUMN-NUMBER is given, position `point' at that column just
  85 before that column number within the line. Note that the beginning of
  86 the line starts at column 0, so the column number display will be one less
  87 than COLUMN-NUMBER. For example COLUMN-NUMBER 1 will set before the first
  88 column on the line and show 0.
  89
  90 The Emacs `goto-line' docstring says it is the wrong to use that
  91 function in a Lisp program. So here is something that I proclaim
  92 is okay to use in a Lisp program."
  93   (interactive
  94    (if (and current-prefix-arg (not (consp current-prefix-arg)))
  95        (list (prefix-numeric-value current-prefix-arg))
  96      ;; Look for a default, a number in the buffer at point.
  97      (let* ((default
  98               (save-excursion
  99                 (skip-chars-backward "0-9")
 100                 (if (looking-at "[0-9]")
 101                     (string-to-number
 102                      (buffer-substring-no-properties
 103                       (point)
 104                       (progn (skip-chars-forward "0-9")
 105                              (point)))))))
 106             ;; Decide if we're switching buffers.
 107             (buffer
 108              (if (consp current-prefix-arg)
 109                  (other-buffer (current-buffer) t)))
 110             (buffer-prompt
 111              (if buffer
 112                  (concat " in " (buffer-name buffer))
 113                "")))
 114        ;; Read the argument, offering that number (if any) as default.
 115        (list (read-number (format "Goto line%s: " buffer-prompt)
 116                           (list default (line-number-at-pos)))
 117              buffer))))
 118   (unless (wholenump line-number)
 119     (error "Expecting line-number parameter `%s' to be a whole number"
 120            line-number))
 121   (unless (> line-number 0)
 122     (error "Expecting line-number parameter `%d' to be greater than 0"
 123            line-number))
 124   (let ((last-line (line-number-at-pos (point-max))))
 125     (unless (<= line-number last-line)
 126       (error
 127        "Line number %d should not exceed %d, the number of lines in the buffer"
 128        line-number last-line))
 129     (goto-char (point-min))
 130     (forward-line (1- line-number))
 131     (if column-number
 132         (let ((last-column
 133                (save-excursion
 134                  (move-end-of-line 1)
 135                  (current-column))))
 136           (cond ((not (wholenump column-number))
 137                  (message
 138                   "Column ignored. Expecting column-number parameter `%s' to be a whole number"
 139                           column-number))
 140                 ((<= column-number 0)
 141                  (message
 142                   "Column ignored. Expecting column-number parameter `%d' to be a greater than 1"
 143                           column-number))
 144                 ((>= column-number last-column)
 145                  (message
 146                   "Column ignored. Expecting column-number parameter `%d' to be a less than %d"
 147                    column-number last-column))
 148                 (t (forward-char (1- column-number)))))
 149       )
 150     (redisplay)
 151     )
 152   )
 153
 154 (defun loc-changes-add-elt (pos)
 155   "Add an element `loc-changes-alist'. The car will be POS and a
 156 marker for it will be created at the point."
 157   (setq loc-changes-alist
 158         (cons (cons pos (point-marker)) loc-changes-alist)))
 159
 160 ;;;###autoload
 161 (defun loc-changes-add-and-goto (line-number &optional opt-buffer)
 162   "Add a marker at LINE-NUMBER and record LINE-NUMBER and its
 163 marker association in `loc-changes-alist'."
 164   (interactive
 165    (if (and current-prefix-arg (not (consp current-prefix-arg)))
 166        (list (prefix-numeric-value current-prefix-arg))
 167      ;; Look for a default, a number in the buffer at point.
 168      (let* ((default
 169               (save-excursion
 170                 (skip-chars-backward "0-9")
 171                 (if (looking-at "[0-9]")
 172                     (string-to-number
 173                      (buffer-substring-no-properties
 174                       (point)
 175                       (progn (skip-chars-forward "0-9")
 176                              (point)))))))
 177             ;; Decide if we're switching buffers.
 178             (buffer
 179              (if (consp current-prefix-arg)
 180                  (other-buffer (current-buffer) t)))
 181             (buffer-prompt
 182              (if buffer
 183                  (concat " in " (buffer-name buffer))
 184                "")))
 185        ;; Read the argument, offering that number (if any) as default.
 186        (list (read-number (format "Goto line%s: " buffer-prompt)
 187                           (list default (line-number-at-pos)))
 188              buffer))))
 189
 190   (let ((buffer (or opt-buffer (current-buffer))))
 191     (with-current-buffer buffer
 192       (loc-changes-goto-line line-number)
 193       (loc-changes-add-elt line-number)
 194       ))
 195   )
 196
 197 ;;;###autoload
 198 (defun loc-changes-clear-buffer (&optional opt-buffer)
 199   "Remove all location-tracking associations in BUFFER."
 200   (interactive "bbuffer: ")
 201   (let ((buffer (or opt-buffer (current-buffer)))
 202         )
 203     (with-current-buffer buffer
 204       (setq loc-changes-alist '())
 205       ))
 206   )
 207
 208 ;;;###autoload
 209 (defun loc-changes-reset-position (&optional opt-buffer no-insert)
 210   "Update `loc-changes-alist' so that the line number of point is
 211 used to when aline number is requested.
 212
 213 Updates any existing line numbers referred to in marks at this
 214 position.
 215
 216 This may be useful for example in debugging if you save the
 217 buffer and then cause the debugger to reread/reevaluate the file
 218 so that its positions are will be reflected."
 219   (interactive "")
 220   (let* ((line-number (line-number-at-pos (point)))
 221          (elt (assq line-number loc-changes-alist)))
 222     (let ((buffer (or opt-buffer (current-buffer)))
 223           )
 224       (with-current-buffer buffer
 225         (if elt
 226             (setcdr elt (point))
 227           (unless no-insert
 228             (loc-changes-add-elt line-number)
 229             )
 230           ))
 231       )
 232     ))
 233
 234
 235 (defun loc-changes-goto (position &optional opt-buffer no-update)
 236   "Go to the position inside BUFFER taking into account the
 237 previous location marks. Normally if the position hasn't been
 238 seen before, we will add a new mark for this position. However if
 239 NO-UPDATE is set, no mark is added."
 240   (unless (wholenump position)
 241     (error "Expecting line-number parameter `%s' to be a whole number"
 242            position))
 243   (let ((elt (assq position loc-changes-alist)))
 244     (if elt
 245         (let ((marker (cdr elt)))
 246           (unless (markerp marker)
 247             (error "Internal error: loc-changes-alist is not a marker"))
 248           (goto-char (marker-position marker)))
 249       (if no-update
 250           (loc-changes-goto-line position)
 251         (loc-changes-add-and-goto position))
 252       )
 253     )
 254   )
 255
 256 (provide 'loc-changes)
 257 ;;; loc-changes.el ends here