cgit.sxemacs.org Git - packages/blob - xemacs-packages/semantic/semantic-edit.el

   1 ;;; semantic-edit.el --- Edit Management for Semantic
   2
   3 ;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Eric M. Ludlam
   4
   5 ;; X-CVS: $Id: semantic-edit.el,v 1.1 2007-11-26 15:10:35 michaels Exp $
   6
   7 ;; This file is not part of GNU Emacs.
   8
   9 ;; Semantic is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; This software is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  22 ;; Boston, MA 02110-1301, USA.
  23
  24 ;;; Commentary:
  25 ;;
  26 ;; In Semantic 1.x, changes were handled in a simplistic manner, where
  27 ;; tokens that changed were reparsed one at a time.  Any other form of
  28 ;; edit were managed through a full reparse.
  29 ;;
  30 ;; This code attempts to minimize the number of times a full reparse
  31 ;; needs to occur.  While overlays and tokens will continue to be
  32 ;; recycled in the simple case, new cases where tokens are inserted
  33 ;; or old tokens removed  from the original list are handled.
  34 ;;
  35
  36 ;;; NOTES FOR IMPROVEMENT
  37 ;;
  38 ;; Work done by the incremental parser could be improved by the
  39 ;; following:
  40 ;;
  41 ;; 1. Tokens created could have as a property an overlay marking a region
  42 ;;    of themselves that can be edited w/out affecting the definition of
  43 ;;    that token.
  44 ;;
  45 ;; 2. Tokens w/ positioned children could have a property of an
  46 ;;    overlay marking the region in themselves that contain the
  47 ;;    children.  This could be used to better improve splicing near
  48 ;;    the beginning and end of the child lists.
  49 ;;
  50
  51 ;;; BUGS IN INCREMENTAL PARSER
  52 ;;
  53 ;; 1. Changes in the whitespace between tokens could extend a
  54 ;;    following token.  These will be marked as merely unmatched
  55 ;;    syntax instead.
  56
  57 ;;
  58 (require 'semantic)
  59 (require 'working)
  60
  61 ;;; Code:
  62 (defvar semantic-after-partial-cache-change-hook nil
  63   "Hooks run after the buffer cache has been updated.
  64
  65 This hook will run when the cache has been partially reparsed.
  66 Partial reparses are incurred when a user edits a buffer, and only the
  67 modified sections are rescanned.
  68
  69 Hook functions must take one argument, which is the list of tokens
  70 updated in the current buffer.
  71
  72 For language specific hooks, make sure you define this as a local hook.")
  73
  74 (defvar semantic-change-hooks nil
  75   "Hooks run when semantic detects a change in a buffer.
  76 Each hook function must take three arguments, identical to the
  77 common hook `after-change-functions'.")
  78
  79 (defvar semantic-reparse-needed-change-hook nil
  80   "Hooks run when a user edit is detected as needing a reparse.
  81 For language specific hooks, make sure you define this as a local
  82 hook.
  83 Not used yet; part of the next generation reparse mechanism")
  84
  85 (defvar semantic-no-reparse-needed-change-hook nil
  86   "Hooks run when a user edit is detected as not needing a reparse.
  87 If the hook returns non-nil, then declare that a reparse is needed.
  88 For language specific hooks, make sure you define this as a local
  89 hook.
  90 Not used yet; part of the next generation reparse mechanism.")
  91
  92 (defvar semantic-edits-new-change-hooks nil
  93   "Hooks run when a new change is found.
  94 Functions must take one argument representing an overlay on that change.")
  95
  96 (defvar semantic-edits-delete-change-hooks nil
  97   "Hooks run before a change overlay is deleted.
  98 Deleted changes occur when multiple changes are merged.
  99 Functions must take one argument representing an overlay being deleted.")
 100
 101 (defvar semantic-edits-move-change-hooks nil
 102   "Hooks run after a change overlay is moved.
 103 Changes move when a new change overlaps an old change.  The old change
 104 will be moved.
 105 Functions must take one argument representing an overlay being moved.")
 106
 107 (defvar semantic-edits-reparse-change-hooks nil
 108   "Hooks run after a change results in a reparse.
 109 Functions are called before the overlay is deleted, and after the
 110 incremental reparse.")
 111
 112 (defvar semantic-edits-incremental-reparse-failed-hooks nil
 113   "Hooks run after the incremental parser fails.
 114 When this happens, the buffer is marked as needing a full reprase.")
 115
 116 ;;;###autoload
 117 (defcustom semantic-edits-verbose-flag nil
 118   "Non-nil means the incremental perser is verbose.
 119 If nil, errors are still displayed, but informative messages are not."
 120   :group 'semantic
 121   :type 'boolean)
 122
 123 ;;; Change State management
 124 ;;
 125 ;; Manage a series of overlays that define changes recently
 126 ;; made to the current buffer.
 127 ;;;###autoload
 128 (defun semantic-change-function (start end length)
 129   "Provide a mechanism for semantic token management.
 130 Argument START, END, and LENGTH specify the bounds of the change."
 131    (setq semantic-unmatched-syntax-cache-check t)
 132    (run-hook-with-args 'semantic-change-hooks start end length))
 133
 134 (defun semantic-changes-in-region (start end &optional buffer)
 135   "Find change overlays which exist in whole or in part between START and END.
 136 Optional argument BUFFER is the buffer to search for changes in."
 137   (save-excursion
 138     (if buffer (set-buffer buffer))
 139     (let ((ol (semantic-overlays-in (max start (point-min))
 140                                     (min end (point-max))))
 141           (ret nil))
 142       (while ol
 143         (when (semantic-overlay-get (car ol) 'semantic-change)
 144           (setq ret (cons (car ol) ret)))
 145         (setq ol (cdr ol)))
 146       (sort ret #'(lambda (a b) (< (semantic-overlay-start a)
 147                                    (semantic-overlay-start b)))))))
 148
 149 ;;;###autoload
 150 (defun semantic-edits-change-function-handle-changes  (start end length)
 151   "Run whenever a buffer controlled by `semantic-mode' change.
 152 Tracks when and how the buffer is re-parsed.
 153 Argument START, END, and LENGTH specify the bounds of the change."
 154   ;; We move start/end by one so that we can merge changes that occur
 155   ;; just before, or just after.  This lets simple typing capture everything
 156   ;; into one overlay.
 157   (let ((changes-in-change (semantic-changes-in-region (1- start) (1+ end)))
 158         )
 159     (semantic-parse-tree-set-needs-update)
 160     (if (not changes-in-change)
 161         (let ((o (semantic-make-overlay start end)))
 162           (semantic-overlay-put o 'semantic-change t)
 163           ;; Run the hooks safely.  When hooks blow it, our dirty
 164           ;; function will be removed from the list of active change
 165           ;; functions.
 166           (condition-case nil
 167               (run-hook-with-args 'semantic-edits-new-change-hooks o)
 168             (error nil)))
 169       (let ((newstart start) (newend end)
 170             (tmp changes-in-change))
 171         ;; Find greatest bounds of all changes
 172         (while tmp
 173           (when (< (semantic-overlay-start (car tmp)) start)
 174             (setq start (semantic-overlay-start (car tmp))))
 175           (when (> (semantic-overlay-end (car tmp)) end)
 176             (setq end (semantic-overlay-end (car tmp))))
 177           (setq tmp (cdr tmp)))
 178         ;; Move the first found overlay, recycling that overlay.
 179         (semantic-overlay-move (car changes-in-change) start end)
 180         (condition-case nil
 181             (run-hook-with-args 'semantic-edits-move-change-hooks
 182                                 (car changes-in-change))
 183           (error nil))
 184         (setq changes-in-change (cdr changes-in-change))
 185         ;; Delete other changes.  They are now all bound here.
 186         (while changes-in-change
 187           (condition-case nil
 188               (run-hook-with-args 'semantic-edits-delete-change-hooks
 189                                   (car changes-in-change))
 190             (error nil))
 191           (semantic-overlay-delete (car changes-in-change))
 192           (setq changes-in-change (cdr changes-in-change))))
 193       )))
 194
 195 (defsubst semantic-edits-flush-change (change)
 196   "Flush the CHANGE overlay."
 197   (condition-case nil
 198       (run-hook-with-args 'semantic-edits-delete-change-hooks
 199                           change)
 200     (error nil))
 201   (semantic-overlay-delete change))
 202
 203 ;;;###autoload
 204 (defun semantic-edits-flush-changes ()
 205   "Flush the changes in the current buffer."
 206   (let ((changes (semantic-changes-in-region (point-min) (point-max))))
 207     (while changes
 208       (semantic-edits-flush-change (car changes))
 209       (setq changes (cdr changes))))
 210   )
 211
 212 (defun semantic-edits-change-in-one-token-p (change hits)
 213   "Return non-nil of the overlay CHANGE exists solely in one leaf token.
 214 HITS is the list of tokens that CHANGE is in.  It can have more than
 215 one token in it if the leaf token is within a parent token."
 216   (and (< (semantic-tag-start (car hits))
 217           (semantic-overlay-start change))
 218        (> (semantic-tag-end (car hits))
 219           (semantic-overlay-end change))
 220        ;; Recurse on the rest.  If this change is inside all
 221        ;; of these tokens, then they are all leaves or parents
 222        ;; of the smallest token.
 223        (or (not (cdr hits))
 224            (semantic-edits-change-in-one-token-p change (cdr hits))))
 225   )
 226
 227 ;;; Change/Token Query functions
 228 ;;
 229 ;; A change (region of space) can effect tokens in different ways.
 230 ;; These functions perform queries on a buffer to determine different
 231 ;; ways that a change effects a buffer.
 232 ;;
 233 ;; NOTE: After debugging these, replace below to no longer look
 234 ;;       at point and mark (via comments I assume.)
 235 (defsubst semantic-edits-os (change)
 236   "For testing: Start of CHANGE, or smaller of (point) and (mark)."
 237   (if change (semantic-overlay-start change)
 238     (if (< (point) (mark)) (point) (mark))))
 239
 240 (defsubst semantic-edits-oe (change)
 241   "For testing: End of CHANGE, or larger of (point) and (mark)."
 242   (if change (semantic-overlay-end change)
 243     (if (> (point) (mark)) (point) (mark))))
 244
 245 (defun semantic-edits-change-leaf-token (change)
 246   "A leaf token which completely encompasses CHANGE.
 247 If change overlaps a token, but is not encompassed in it, return nil.
 248 Use `semantic-edits-change-overlap-leaf-token'.
 249 If CHANGE is completely encompassed in a token, but overlaps sub-tokens,
 250 return nil."
 251   (let* ((start (semantic-edits-os change))
 252          (end (semantic-edits-oe change))
 253          (tokens (nreverse
 254                   (semantic-find-tag-by-overlay-in-region
 255                    start end))))
 256     ;; A leaf is always first in this list
 257     (if (and tokens
 258              (<= (semantic-tag-start (car tokens)) start)
 259              (> (semantic-tag-end (car tokens)) end))
 260         ;; Ok, we have a match.  If this token has children,
 261         ;; we have to do more tests.
 262         (let ((chil (semantic-tag-components (car tokens))))
 263           (if (not chil)
 264               ;; Simple leaf.