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

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