emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/auto-overlays 80e9510 01/93: Version 0.7 of the predict


From: Stefan Monnier
Subject: [elpa] externals/auto-overlays 80e9510 01/93: Version 0.7 of the predictive completion package.
Date: Mon, 14 Dec 2020 13:00:25 -0500 (EST)

branch: externals/auto-overlays
commit 80e95102892f8fbaf55b73d2ca482cda2a351284
Author: Toby Cubitt <toby-predictive@dr-qubit.org>
Commit: tsc25 <tsc25@cantab.net>

    Version 0.7 of the predictive completion package.
    First to include auto-overlays.
---
 auto-overlay-line.el  | 133 +++++++
 auto-overlay-self.el  | 299 +++++++++++++++
 auto-overlay-stack.el | 220 +++++++++++
 auto-overlay-word.el  |  81 ++++
 auto-overlays.el      | 996 ++++++++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 1729 insertions(+)

diff --git a/auto-overlay-line.el b/auto-overlay-line.el
new file mode 100644
index 0000000..7361448
--- /dev/null
+++ b/auto-overlay-line.el
@@ -0,0 +1,133 @@
+;;; auto-overlay-line.el --- automatic overlays for single lines
+
+;; Copyright (C) 2005 Toby Cubitt
+
+;; Author: Toby Cubitt
+;; Version: 0.2
+;; Keywords: automatic, overlays, line
+
+;; This file is part of the Emacs Automatic Overlays package.
+;;
+;; The Emacs Automatic Overlays package is free software; you can
+;; redistribute it and/or modify it under the terms of the GNU
+;; General Public License as published by the Free Software
+;; Foundation; either version 2 of the License, or (at your option)
+;; any later version.
+;;
+;; The Emacs Automatic Overlays package is distributed in the hope
+;; that it will be useful, but WITHOUT ANY WARRANTY; without even the
+;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;; PURPOSE.  See the GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with the Emacs Automatic Overlays package; if not, write
+;; to the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+;; Boston, MA 02111-1307 USA
+
+
+;;; Change Log:
+;;
+;; Version 0.2:
+;; * got rid of fake end match overlays, which ensured the overlay always
+;;   extended to end of line, in favour of adding a function to the
+;;   modification hooks of the line overlay itself
+;;
+;; Version 0.1:
+;; * initial version separated off from auto-overlays.el
+
+
+
+;;; Code:
+
+
+(require 'auto-overlays)
+(provide 'auto-overlay-line)
+
+
+;; register line overlay parsing and suicide funtions
+(assq-delete-all 'line auto-overlay-functions)
+(push (list 'line 'auto-o-parse-line-match
+           (lambda (o) (auto-o-delete-overlay (overlay-get o 'parent))))
+      auto-overlay-functions)
+
+
+
+(defun auto-o-parse-line-match (o-match)
+  ;; Create overlay for a new line match.
+  (let ((o-new (make-overlay (overlay-get o-match 'delim-end)
+                            (save-excursion
+                              (goto-char (overlay-get o-match 'delim-end))
+                              (1+ (line-end-position))))))
+    
+    ;; give the new overlay its basic properties
+    (overlay-put o-new 'auto-overlay t)
+    (overlay-put o-new 'set (overlay-get o-match 'set))
+    (overlay-put o-new 'type (overlay-get o-match 'type))
+    ;; match start of new overlay with match
+    (auto-o-match-overlay o-new o-match nil)
+    ;; set overlay's modification hooks to ensure that it always extends to
+    ;; end of line
+    (overlay-put o-new 'modification-hooks
+                (cons 'auto-o-extend-line
+                      (overlay-get o-new 'modification-hooks)))
+    ;; return new overlay
+    o-new)
+)
+
+
+
+(defun auto-o-extend-line (o-self modified &rest unused)
+  ;; All line overlay modification hooks are set to this function, which
+  ;; checks if overlay still extends to end of line, and updates the necessary
+  ;; if not.
+
+  ;; if we will be run after modification, increment pending suicide count to
+  ;; avoid running `auto-overlay-update' until all suicides are done (this
+  ;; isn't a suicide function, but we hook into the same mechanism anyway)
+  (if (null modified)
+      (setq auto-o-pending-suicide-count (1+ auto-o-pending-suicide-count))
+
+    
+    ;; if being run after modification, decrement pending suicide count
+    (setq auto-o-pending-suicide-count (1- auto-o-pending-suicide-count))
+    
+    (save-match-data
+      (let ((start (overlay-start o-self))
+           (end (overlay-end o-self)))
+       (cond
+        ;; if we no longer extend to end of line...
+        ((null (string-match "\n" (buffer-substring-no-properties
+                                   (overlay-start o-self)
+                                   (overlay-end o-self))))
+         ;; grow ourselves so we extend till end of line
+         (move-overlay o-self start (save-excursion
+                                      (goto-char (overlay-end o-self))
+                                      (1+ (line-end-position))))
+         ;; if we're exclusive, delete lower priority overlays in newly
+         ;; covered region
+         (auto-o-update-exclusive (overlay-get o-self 'set)
+                                  end (overlay-end o-self)
+                                  nil (overlay-get o-self 'priority)))
+
+        
+        ;; if we extend beyond end of line...
+        ((/= (overlay-end o-self) (+ start (match-end 0)))
+         ;; shrink ourselves so we extend till end of line
+         (move-overlay o-self start (+ start (match-end 0)))
+         ;; if we're exclusive, re-parse region that is no longer covered
+         (auto-o-update-exclusive (overlay-get o-self 'set)
+                                  (overlay-end o-self) end
+                                  (overlay-get o-self 'priority) nil))
+        )))
+    
+    
+    ;; if there are no more pending suicides and `auto-overlay-update' has
+    ;; been postponed, run it now
+    (when (and auto-o-pending-post-suicide (= auto-o-pending-suicide-count 0))
+      (mapc (lambda (u) (apply (car u) (cdr u)))
+           auto-o-pending-post-suicide)
+      (setq auto-o-pending-post-suicide nil)))
+)
+      
+  
+;; auto-overlay-line.el ends here
diff --git a/auto-overlay-self.el b/auto-overlay-self.el
new file mode 100644
index 0000000..6176b93
--- /dev/null
+++ b/auto-overlay-self.el
@@ -0,0 +1,299 @@
+;;; auto-overlay-self.el --- self-delimited automatic overlays
+
+;; Copyright (C) 2005 Toby Cubitt
+
+;; Author: Toby Cubitt
+;; Version: 0.2
+;; Keywords: automatic, overlays, self
+
+;; This file is part of the Emacs Automatic Overlays package.
+;;
+;; The Emacs Automatic Overlays package is free software; you can
+;; redistribute it and/or modify it under the terms of the GNU
+;; General Public License as published by the Free Software
+;; Foundation; either version 2 of the License, or (at your option)
+;; any later version.
+;;
+;; The Emacs Automatic Overlays package is distributed in the hope
+;; that it will be useful, but WITHOUT ANY WARRANTY; without even the
+;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;; PURPOSE.  See the GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with the Emacs Automatic Overlays package; if not, write
+;; to the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+;; Boston, MA 02111-1307 USA
+
+
+;;; Change Log:
+;;
+;; Version 0.2:
+;; * substantially re-written to postpone cascading until absolutely
+;;   necessary, for improved responsiveness
+;;
+;; Version 0.1:
+;; * initial version separated off from auto-overlays.el
+
+
+
+;;; Code:
+
+
+(require 'auto-overlays)
+(provide 'auto-overlay-self)
+
+(defvar auto-o-pending-self-cascade nil)
+
+;; register self overlay parsing, suicide, initialisation and clear functions
+(assq-delete-all 'self auto-overlay-functions)
+(push '(self auto-o-parse-self-match auto-o-self-suicide)
+      auto-overlay-functions)
+
+;; add initialisation and clear functions to hooks
+(add-hook 'auto-overlay-load-hook 'auto-o-self-load)
+(add-hook 'auto-overlay-unload-hook 'auto-o-self-unload)
+
+
+
+(defun auto-o-self-load ()
+  ;; Make sure `auto-o-perform-self-cascades' is in `before-change-functions',
+  ;; so that any cascading that is required is performed before anything else
+  ;; happens.
+  (add-hook 'before-change-functions 'auto-o-perform-self-cascades t)
+  ;; initialise variables
+  (setq auto-o-pending-self-cascade nil)
+)
+
+
+(defun auto-o-self-unload ()
+  ;; Remove `auto-o-perform-self-cascades' from `before-change-functions'.
+  (remove-hook 'before-change-functions 'auto-o-perform-self-cascades t)
+)
+
+
+
+
+(defun auto-o-parse-self-match (o-match)
+  ;; perform any necessary updates of auto overlays due to a match for a self
+  ;; regexp
+  
+  (let* ((overlay-list (auto-o-self-list o-match))
+        (o (car overlay-list)))
+    
+    (cond
+     ;; if stack is empty, create a new end-unmatched overlay, adding it to
+      ;; the list of unascaded overlays (avoids treating it as a special
+      ;; case), and return it
+     ((null overlay-list)
+      (auto-o-make-self o-match nil))
+     
+     ;; if new delimiter is inside the first existing overlay and existing one
+     ;; is end-unmatched, just match it
+     ((and (not (overlay-get o 'end))
+          (>= (overlay-get o-match 'delim-start) (overlay-start o)))
+      (auto-o-match-overlay o nil o-match 'no-props)
+      ;; remove it from the list of uncascaded overlays
+      (setq auto-o-pending-self-cascade (delq o auto-o-pending-self-cascade))
+      ;; return nil since haven't created any new overlays
+      nil)
+     
+     
+     ;; otherwise...
+     (t
+      (let (o-new)
+       ;; if the new match is outside existing overlays...
+       (if (< (overlay-get o-match 'delim-end) (overlay-start o))
+           ;; create overlay from new match till start of next match, and add
+           ;; it to the list of uncascaded overlays
+           (setq o-new (auto-o-make-self
+                        o-match
+                        (overlay-get (overlay-get o 'start) 'delim-start)))
+         
+         ;; if the new match is inside an existing overlay...
+         (setq o (pop overlay-list))
+         ;; create overlay from end of existing one till start of the one
+         ;; after, and add it to the list of uncascaded overlays
+         (setq o-new (auto-o-make-self
+                      (overlay-get o 'end)
+                      (overlay-get (overlay-get (car overlay-list) 'start)
+                                   'delim-start)))
+         ;; match existing one with the new match
+         (auto-o-match-overlay o nil o-match 'no-props))
+      
+      ;; return newly created overlay
+      o-new))
+     ))
+)
+
+
+
+
+(defun auto-o-self-suicide (o-self)
+  ;; Called when match no longer matches. Unmatch the match overlay O-SELF, if
+  ;; necessary deleting its parent overlay or cascading.
+
+  (let ((o-parent (overlay-get o-self 'parent)))
+    (cond
+     ;; if parent is end-unmatched, delete it from buffer and from list of
+     ;; uncascaded overlays
+     ((not (auto-o-end-matched-p o-parent))
+      (auto-o-delete-overlay o-parent)
+      (setq auto-o-pending-self-cascade
+           (delq o-parent auto-o-pending-self-cascade)))
+
+     ;; if we match the end of parent...
+     ((eq (overlay-get o-parent 'end) o-self)
+      ;; unmatch ourselves from parent and extend parent till next overlay, or
+      ;; end of buffer if there is none
+      (let ((o (nth 1 (auto-o-self-list o-self))))
+       (auto-o-match-overlay
+        o-parent nil (if o (overlay-get (overlay-get o 'start) 'delim-start)
+                       'unmatched)))
+      ;; add parent to uncascaded overlay list
+      (push o-parent auto-o-pending-self-cascade))
+
+     ;; if we match the start of parent...
+     (t
+      (let* ((o-end (overlay-get o-parent 'end))
+            (o (nth 1 (auto-o-self-list o-end))))
+       ;; unmatch ourselves from parent and "flip"
+       (auto-o-match-overlay
+        o-parent o-end
+        (if o (overlay-get (overlay-get o 'start) 'delim-start)
+          'unmatched)))
+      ;; add parent to uncascaded overlay list
+      (push o-parent auto-o-pending-self-cascade))
+     ))
+)
+
+
+
+
+(defun auto-o-make-self (o-start &optional end)
+  ;; Create a self overlay starting at match overlay O-START.
+  ;; If END is a number or marker, the new overlay is end-unmatched and ends
+  ;; at the buffer location specified by the number or marker.
+  ;; If END is nil, the new overlay is end-unmatched and ends at the end of
+  ;; the buffer.
+  (let (o-new)
+    
+    ;; create new overlay (location ensures right things happen when matched)
+    (let (pos)
+      (cond
+       ((overlayp end) (setq pos (overlay-get end 'delim-start)))
+       ((number-or-marker-p end) (setq pos end))
+       (t (setq pos (point-max))))
+      (setq o-new (make-overlay pos pos nil nil 'rear-advance)))
+      
+    ;; give the new overlay its basic properties
+    (overlay-put o-new 'auto-overlay t)
+    (overlay-put o-new 'set (overlay-get o-start 'set))
+    (overlay-put o-new 'type (overlay-get o-start 'type))
+    
+    ;; if overlay is end-unmatched, add it to the list of uncascaded overlays
+    (unless (overlayp end) (push o-new auto-o-pending-self-cascade))
+    
+    ;; match the new overlay and return it
+    (auto-o-match-overlay o-new o-start (if (overlayp end) end nil))
+    o-new)
+)
+
+
+
+
+(defun auto-o-perform-self-cascades (beg end)
+  ;; Perform any necessary self-overlay cascading before the text in the
+  ;; buffer is modified. Called from `before-change-functions'.
+
+  ;; check all overlays waiting to be cascaded, from first in buffer to last
+  (dolist (o (sort auto-o-pending-self-cascade
+                  (lambda (a b) (< (overlay-start a) (overlay-start b)))))
+    ;; if buffer modification occurs after the end of an overlay waiting to be
+    ;; cascaded, cascade all overlays between it and the modified text
+    (when (and (overlay-end o) (< (overlay-end o) end))
+      (auto-o-self-cascade (auto-o-self-list (overlay-get o 'start) end))))
+)
+
+
+
+
+(defun auto-o-self-cascade (overlay-list)
+  ;; "Flip" overlays down through buffer (assumes first overlay in list is
+  ;; end-unmatched).
+  (when (> (length overlay-list) 1)
+    (let ((o (car overlay-list))
+         (o1 (nth 1 overlay-list)))
+      
+      ;; match first (presumably end-matched) overlay and remove it from list
+      (pop overlay-list)
+      (auto-o-match-overlay o nil (overlay-get o1 'start) 'no-props)
+      ;; remove it from list of uncascaded overlays
+      (setq auto-o-pending-self-cascade (delq o auto-o-pending-self-cascade))
+      ;; if we've hit an end-unmatched overlay, we can stop cascading
+      (if (not (auto-o-end-matched-p o1))
+         (progn
+           (auto-o-delete-overlay o1 nil 'protect-match)
+           (setq auto-o-pending-self-cascade
+                 (delq o1 auto-o-pending-self-cascade)))
+
+       ;; otherwise, cascade overlay list till one is left or we hit an
+       ;; end-unmached overlay
+       (unless
+           (catch 'stop
+             (dotimes (i (1- (length overlay-list)))
+               (setq o (nth i overlay-list))
+               (setq o1 (nth (1+ i) overlay-list))
+               (auto-o-match-overlay o (overlay-get o 'end)
+                                     (overlay-get o1 'start)
+                                     'no-props nil 'protect-match)
+               ;; if we hit an end-unmatched overlay, we can stop cascading
+               (when (not (auto-o-end-matched-p o1))
+                 (throw 'stop (progn
+                                ;; delete the end-unmatched overlay
+                                (auto-o-delete-overlay o1 nil 'protect-match)
+                                ;; remove it from uncascaded overlays list
+                                (setq auto-o-pending-self-cascade
+                                      (delq o1 auto-o-pending-self-cascade))
+                                ;; return t to indicate cascading ended early
+                                t)))))
+         
+         ;; if there's an overlay left, "flip" it so it's end-unmatched and
+         ;; extends to next overlay in buffer, and add it to the list of
+         ;; unmatched overlays
+         (let (pos)
+           (setq o (car (last overlay-list)))
+           (if (setq o1 (nth 1 (auto-o-self-list (overlay-get o 'end))))
+               (setq pos (overlay-get (overlay-get o1 'start) 'delim-start))
+             (setq pos (point-max)))
+           (auto-o-match-overlay o (overlay-get o 'end) pos 'no-props))
+         (push o auto-o-pending-self-cascade)))
+      ))
+)
+
+
+
+
+(defun auto-o-self-list (o-start &optional end)
+  ;; Return list of self overlays ending at or after match overlay O-START and
+  ;; starting before or at END, with same type as O-START. If END is null, all
+  ;; overlays after O-START are included.
+
+  (when (null end) (setq end (point-max)))
+  
+  (let (overlay-list)
+    ;; create list of all overlays of same type between O-START and END
+    (mapc (lambda (o) (when (and (>= (overlay-end o)
+                                    (overlay-get o-start 'delim-start))
+                                (<= (overlay-start o) end))
+                       (push o overlay-list)))
+         ;; Note: already have list of overlays of same type so no need to
+         ;;       use `auto-o-overlays-in'
+         (nth (overlay-get o-start 'type)
+              (nth (overlay-get o-start 'set) auto-overlay-list)))
+    ;; sort the list by start position, from first to last
+    (sort overlay-list
+         (lambda (a b) (< (overlay-start a) (overlay-start b)))))
+)
+
+
+;;; auto-overlay-self.el ends here
diff --git a/auto-overlay-stack.el b/auto-overlay-stack.el
new file mode 100644
index 0000000..c6f38f1
--- /dev/null
+++ b/auto-overlay-stack.el
@@ -0,0 +1,220 @@
+;;; auto-overlay-stack.el --- stacked start/end-delimited automatic overlays
+
+;; Copyright (C) 2005 Toby Cubitt
+
+;; Author: Toby Cubitt
+;; Version: 0.1
+;; Keywords: automatic, overlays, stack
+
+;; This file is part of the Emacs Automatic Overlays package.
+;;
+;; The Emacs Automatic Overlays package is free software; you can
+;; redistribute it and/or modify it under the terms of the GNU
+;; General Public License as published by the Free Software
+;; Foundation; either version 2 of the License, or (at your option)
+;; any later version.
+;;
+;; The Emacs Automatic Overlays package is distributed in the hope
+;; that it will be useful, but WITHOUT ANY WARRANTY; without even the
+;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;; PURPOSE.  See the GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with the Emacs Automatic Overlays package; if not, write
+;; to the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+;; Boston, MA 02111-1307 USA
+
+
+;;; Change Log:
+;;
+;; Version 0.1:
+;; * initial version separated off from auto-overlays.el
+
+
+
+;;; Code:
+
+
+(require 'auto-overlays)
+(provide 'auto-overlay-stack)
+
+
+;; register stack overlay parsing and suicide functions
+(assq-delete-all 'stack auto-overlay-functions)
+(push '(stack auto-o-parse-stack-match auto-o-stack-suicide)
+      auto-overlay-functions)
+
+
+
+(defun auto-o-parse-stack-match (o-match)
+  ;; Perform any necessary updates of auto overlays due to a match for a stack
+  ;; regexp.
+
+  (let* ((overlay-stack (auto-o-stack o-match))
+        (o (car overlay-stack)))
+    (cond
+     ;; if the stack is empty, just create and return a new unmatched overlay
+     ((null overlay-stack)
+      (auto-o-make-stack o-match 'unmatched))
+     
+     ;; if appropriate edge of innermost overlay is unmatched, just match it
+     ((or (and (eq (auto-o-edge o-match) 'start)
+              (not (auto-o-start-matched-p o)))
+         (and (eq (auto-o-edge o-match) 'end)
+              (not (auto-o-end-matched-p o))))
+      (auto-o-match-overlay o o-match)
+      ;; return nil since haven't created any new overlays
+      nil)
+     
+     ;; otherwise...
+     (t
+      ;; create new innermost overlay and add it to the overlay stack
+      (push (auto-o-make-stack o-match) overlay-stack)
+      ;; sort out the overlay stack
+      (auto-o-stack-cascade overlay-stack)
+      ;; return newly created overlay
+      (car overlay-stack)))
+    )
+)
+
+
+
+
+(defun auto-o-stack-suicide (o-self)
+  ;; Called when match no longer matches. Unmatch the match overlay O-SELF, if
+  ;; necessary deleting its parent overlay or cascading the stack.
+  
+  (let* ((overlay-stack (auto-o-stack o-self))
+       (o-parent (car overlay-stack)))
+    
+    ;; if parent is the only overlay in the stack...
+    (if (= (length overlay-stack) 1)
+       ;; if we're a start match...
+       (if (eq (auto-o-edge o-self) 'start)
+           (if (auto-o-end-matched-p o-parent)
+               ;; if parent is end-matched, make it start-unmatched
+               (auto-o-match-overlay o-parent 'unmatched nil)
+             ;; if parent is end-unmatched delete it
+             (auto-o-delete-overlay o-parent))
+           
+         ;; if we're an end match...
+         (if (auto-o-start-matched-p o-parent)
+             ;; if parent is start matched, make it end-unmatched
+             (auto-o-match-overlay o-parent nil 'unmatched)
+           ;; if parent is start-unmatched, delete it
+           (auto-o-delete-overlay o-parent)))
+      
+      
+      ;; otherwise, unmatch ourselves from parent and cascade the stack
+      (overlay-put o-parent (auto-o-edge o-self) nil)
+      (overlay-put o-self 'parent nil)
+      (auto-o-stack-cascade overlay-stack)))
+)
+
+      
+
+
+(defun auto-o-make-stack (o-match &optional unmatched)
+  ;; Create a stack overlay for match overlay O-MATCH.
+  ;; If UNMATCHED is nil, overlay will start and end at O-MATCH.
+  ;; If non-nil, overlay will start or end from O-MATCH (depending on whether
+  ;; O-MATCH is a 'start or 'end match) and stretch till end or beginning of
+  ;; buffer.
+
+  (let (o-new pos)
+    ;; create new stack overlay and match it with O-MATCH
+    (cond
+     ((eq (auto-o-edge o-match) 'start)
+      (setq pos (overlay-get o-match 'delim-end))
+      (setq o-new (make-overlay pos pos nil nil 'rear-advance))
+      (auto-o-match-overlay o-new o-match 'unmatched))
+     
+     ((eq (auto-o-edge o-match) 'end)
+      (setq pos (overlay-get o-match 'delim-start))
+      (setq o-new (make-overlay pos pos))
+      (auto-o-match-overlay o-new 'unmatched o-match)))
+
+    ;; give the new overlay its basic properties
+    (overlay-put o-new 'auto-overlay t)
+    (overlay-put o-new 'set (overlay-get o-match 'set))
+    (overlay-put o-new 'type (overlay-get o-match 'type))
+    
+    ;; return the new overlay
+    o-new)
+)
+
+
+
+(defun auto-o-stack-cascade (overlay-stack)
+  ;; Cascade the ends of the overlays in OVERLAY-STACK up or down the stack,
+  ;; so as to re-establish a valid stack. It assumes that only the innermost
+  ;; is incorrect.
+  
+  (let ((o (car overlay-stack)) o1)
+    (cond
+     
+     ;; if innermost overlay is start-matched (and presumably
+     ;; end-unmatched)...
+     ((auto-o-start-matched-p o)
+      ;; cascade overlay end matches up through stack until one is left
+      (dotimes (i (- (length overlay-stack) 1))
+       (setq o (nth i overlay-stack))
+       (setq o1 (nth (+ i 1) overlay-stack))
+       (auto-o-match-overlay o nil
+                             (if (overlay-get o1 'end)
+                                   (overlay-get o1 'end)
+                               'unmatched)
+                             nil nil 'protect-match))
+      ;; if final overlay is start-matched, make it end-unmatched, otherwise
+      ;; delete it
+      (if (auto-o-start-matched-p o1)
+         ;; FIXME: could postpone re-parsing here in case it can be avoided
+         (auto-o-match-overlay o1 nil 'unmatch nil nil 'protect-match)
+       (auto-o-delete-overlay o1 nil 'protect-match)))
+     
+     
+     ;; if innermost overlay is end-matched (and presumably
+     ;; start-unmatched)...
+     ((auto-o-end-matched-p o)
+      ;; cascade overlay start matches up through stack until one is left
+      (dotimes (i (- (length overlay-stack) 1))
+       (setq o (nth i overlay-stack))
+       (setq o1 (nth (+ i 1) overlay-stack))
+       (auto-o-match-overlay o (if (overlay-get o1 'start)
+                                   (overlay-get o1 'start)
+                                 'unmatched)
+                             nil nil nil 'protect-match))
+      ;; if final overlay is end-matched, make it start-unmatched, otherwise
+      ;; delete it
+      (if (auto-o-end-matched-p o1)
+         ;; FIXME: could postpone re-parsing here in case it can be avoided
+         (auto-o-match-overlay o1 'unmatch nil nil nil 'protect-match)
+       (auto-o-delete-overlay o1 nil 'protect-match))))
+    )
+)
+
+
+
+
+(defun auto-o-stack (o-match)
+  ;; Return a list of the overlays that overlap and are of same type as match
+  ;; overlay O-MATCH, ordered from innermost to outermost. (Assumes overlays
+  ;; are correctly stacked.)
+  
+  ;; find overlays of same type overlapping O-MATCH
+  (let ((overlay-stack (auto-overlays-at-point
+                       (if (eq (auto-o-edge o-match) 'start)
+                           (overlay-get o-match 'delim-end)
+                         (overlay-get o-match 'delim-start))
+                       (list '(eq auto-overlay t)
+                             (list '= 'set (overlay-get o-match 'set))
+                             (list '= 'type (overlay-get o-match 'type))))))
+    ;; sort the list by overlay length, i.e. from innermost to outermose
+    (sort overlay-stack
+         (lambda (a b)
+           (< (- (overlay-end a) (overlay-start a))
+              (- (overlay-end b) (overlay-start b))))))
+)
+
+
+;; auto-overlay-stack.el ends here
diff --git a/auto-overlay-word.el b/auto-overlay-word.el
new file mode 100644
index 0000000..92f481b
--- /dev/null
+++ b/auto-overlay-word.el
@@ -0,0 +1,81 @@
+;;; auto-overlay-word.el --- automatic overlays for single "words"
+
+;; Copyright (C) 2005 Toby Cubitt
+
+;; Author: Toby Cubitt
+;; Version: 0.1
+;; Keywords: automatic, overlays, word
+
+;; This file is part of the Emacs Automatic Overlays package.
+;;
+;; The Emacs Automatic Overlays package is free software; you can
+;; redistribute it and/or modify it under the terms of the GNU
+;; General Public License as published by the Free Software
+;; Foundation; either version 2 of the License, or (at your option)
+;; any later version.
+;;
+;; The Emacs Automatic Overlays package is distributed in the hope
+;; that it will be useful, but WITHOUT ANY WARRANTY; without even the
+;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;; PURPOSE.  See the GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with the Emacs Automatic Overlays package; if not, write
+;; to the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+;; Boston, MA 02111-1307 USA
+
+
+;;; Change Log:
+;;
+;; Version 0.1:
+;; * initial version separated off from auto-overlays.el
+
+
+
+;;; Code:
+
+
+(require 'auto-overlays)
+(provide 'auto-overlay-word)
+
+
+;; register word overlay parsing and suicide functions
+(assq-delete-all 'word auto-overlay-functions)
+(push (list 'word 'auto-o-parse-word-match
+           (lambda (o) (auto-o-delete-overlay (overlay-get o 'parent))))
+      auto-overlay-functions)
+
+
+
+(defun auto-o-parse-word-match (o-match)
+  ;; Create a new word overlay for new word match
+  (let ((o-new (make-overlay (overlay-get o-match 'delim-start)
+                            (overlay-get o-match 'delim-end)
+                            nil nil 'rear-advance)))
+    
+    ;; give overlays appropriate properties
+    (overlay-put o-new 'auto-overlay t)
+    (overlay-put o-new 'set (overlay-get o-match 'set))
+    (overlay-put o-new 'type (overlay-get o-match 'type))
+    (overlay-put o-new 'start o-match)
+    (overlay-put o-match 'parent o-new)
+    ;; bundle properties inside list if not already, then update set overlay
+    ;; properties
+    (let ((props (auto-o-props o-match)))
+      (when (symbolp (car props)) (setq props (list props)))
+      (dolist (p (auto-o-props o-match))
+       (overlay-put o-new (car p) (cdr p))))
+    
+    ;; if new overlay is exclusive, delete lower priority overlays within it
+    (when (and (overlay-get o-new 'exclusive)
+              (/= (overlay-start o-new) (overlay-end o-new)))
+      (auto-o-update-exclusive (overlay-get o-new 'set)
+                              (overlay-start o-new) (overlay-end o-new)
+                              nil (overlay-get o-new 'priority)))
+    
+    ;; return new overlay
+    o-new)
+)
+
+
+;; auto-overlay-word.el ends here
diff --git a/auto-overlays.el b/auto-overlays.el
new file mode 100644
index 0000000..1c8ef10
--- /dev/null
+++ b/auto-overlays.el
@@ -0,0 +1,996 @@
+;;; auto-overlays.el --- automatic regexp-delimited overlays for emacs
+
+;; Copyright (C) 2005 Toby Cubitt
+
+;; Author: Toby Cubitt
+;; Version: 0.3
+;; Keywords: automatic, overlays
+
+;; This file is part of the Emacs Automatic Overlays package.
+;;
+;; The Emacs Automatic Overlays package is free software; you can
+;; redistribute it and/or modify it under the terms of the GNU
+;; General Public License as published by the Free Software
+;; Foundation; either version 2 of the License, or (at your option)
+;; any later version.
+;;
+;; The Emacs Automatic Overlays package is distributed in the hope
+;; that it will be useful, but WITHOUT ANY WARRANTY; without even the
+;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;; PURPOSE.  See the GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with the Emacs Automatic Overlays package; if not, write
+;; to the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+;; Boston, MA 02111-1307 USA
+
+
+;;; Change Log:
+;;
+;; Version 0.3
+;; * completely re-written after realising that the match overlays, not the
+;;   auto overlays themselves, should be the "primary" objects - much better!
+;; * moved code for specific overlay types into separate files
+;; * as a side effect, created a mechanism for defining new overlay types
+;;   without modifying the auto-overlay code itself
+;;
+;; Version 0.2:
+;; * added exclusive overlay support
+;; * major code tidying and bug fixes
+;;
+;; Version 0.1:
+;; * initial version created by copying code from Predictive Completion
+;;   package, with minor modifications
+
+
+
+;;; Code:
+
+
+(defvar auto-overlay-functions nil)
+(defvar auto-overlay-regexps nil)
+(make-variable-buffer-local 'auto-overlay-regexps)
+(defvar auto-overlay-load-hook nil)
+(defvar auto-overlay-unload-hook nil)
+
+
+(provide 'auto-overlays)
+(require 'auto-overlay-word)
+(require 'auto-overlay-line)
+(require 'auto-overlay-self)
+(require 'auto-overlay-stack)
+
+
+(defvar auto-overlay-list nil)
+(make-variable-buffer-local 'auto-overlay-list)
+(defvar auto-o-pending-suicide-count 0)
+(make-variable-buffer-local 'auto-o-pending-suicide-count)
+(defvar auto-o-pending-post-suicide nil)
+(make-variable-buffer-local 'auto-o-pending-post-suicide)
+
+
+
+
+(defun auto-overlay-init (regexp-list &optional buffer)
+  "Initialise a set of auto-overlays in BUFFER, or the current
+buffer if none is specified, returning an identifier that can be
+used to clear the overlays in the set by a call to
+`auto-overlay-clear'. Since this identifier is the only means to
+clear the overlay set later, the return value of
+`auto-overlay-init' should usually be saved.
+
+REGEXP-LIST must be a list with elements in one of the following
+forms:
+
+  (CLASS REGEXP @rest PROPS)
+
+  (CLASS (EDGE REGEXP @rest PROPS) (EDGE REGEXP @rest PROPS) ...)
+
+CLASS is a symbol which defines the behaviour of any overlays
+created by matches to the regular expression REGEXP. The inbuilt
+classes are: `word', `line', `self', `stack'. The first form
+should be used for classes that only require one delimiter to
+define an overlay, the second for classes that require start and
+end delimiters. The inbuilt `word', `line' and `self' classes
+require the first form, whereas `stack' requires the second.
+
+Each PROPS element should be a list of the form (PROP . VALUE).
+Each entry specifies an overlay property PROP (a symbol), and a
+VALUE for that property. Overlays created by matches to REGEXP
+acquire those properties.
+
+For classes with start and end delimiters, EDGE should be one of
+`start' or `end'. The order of the entries defines which match is
+used if two regexps for the same EDGE match overlapping text:
+whichever comes first in the list takes precedence. Similarly,
+when an overlay is matched with both `start' and `end'
+delimiters, it acquires the properties of whichever comes first
+in the list.
+
+Usually, each entry in REGEXP-LIST acts independently; the
+different overlays they define have no influence on
+eachother. However, if an overlay is given a non-nil `exclusive'
+property, it prevents matches for any regexps with lower a
+`priority' property within the region it covers. A null
+`priority' is considered lower than any explicitly set
+`priority'.
+
+Multiple calls to `auto-overlay-init' set up separate sets of
+overlays, which act completely independently, and can be
+individually removed by calling `auto-overlay-clear' with the
+appropriate identifier."
+
+  (save-excursion
+    (when buffer (set-buffer buffer))
+    
+    ;; add regexp definitions
+    (push regexp-list auto-overlay-regexps)
+    ;; create auto overlay slots for all the types defined by regexp-list
+    (push (make-list (length regexp-list) nil) auto-overlay-list)
+    
+    
+    ;; when auto-overlays haven't been activated before in this buffer...
+    (when (= (length auto-overlay-regexps) 1)
+      ;; run initialisation hooks
+      (run-hooks 'auto-overlay-load-hook)
+      ;; make sure overlays are updated after any buffer modification
+      (add-hook 'after-change-functions 'auto-overlay-update t))
+    
+    
+    ;; search for new auto overlays
+    (let ((lines (count-lines (point-min) (point-max)))
+         (set (1- (length auto-overlay-regexps))))
+      (goto-char (point-min))
+      (message "Scanning for auto-overlays (line 1 of %d)..."
+              lines)
+      (dotimes (i lines)
+       (when (= 9 (mod i 10))
+         (message
+          "Scanning for auto-overlays (line %d of %d)..."
+          (+ i 1) lines))
+       (auto-overlay-update nil nil nil set)
+       (forward-line 1))
+      (message "Scanning for auto-overlays...done")
+      
+      ;; return overlay set identifier to use in calls to `auto-overlay-clear'
+      set))
+)
+
+
+
+
+(defun auto-overlay-clear (set &optional buffer)
+  "Clear all auto-overlays in the set identified by SET (as
+returned by the call to `auto-overlay-init' that created them)
+from BUFFER, or the current buffer if none is specified."
+
+  (save-excursion
+    (when buffer (set-buffer buffer))
+    
+    ;; delete overlays
+    (mapc 'delete-overlay
+         (auto-overlays-in (point-min) (point-max)
+                           (list
+                            (list (lambda (overlay match) (or overlay match))
+                                  '(auto-overlay auto-overlay-match))
+                            (list '= 'set set))
+                           nil 'inactive))
+    ;; remove overlays from list
+    (setq auto-overlay-list
+         (delq (nth set auto-overlay-list) auto-overlay-list))
+    ;; remove regexp definitions
+    (setq auto-overlay-regexps
+         (delq (nth set auto-overlay-regexps) auto-overlay-regexps))
+
+    
+    ;; if there are no more active auto-overlay definitions...
+    (unless auto-overlay-regexps
+      ;; run clear hooks
+      (run-hooks 'auto-overlay-unload-hook)
+      ;; reset variables
+      (remove-hook 'after-change-functions 'auto-overlay-update t)
+      (setq auto-o-pending-suicide-count 0)
+      (setq auto-o-pending-post-suicide nil))
+    )
+)
+
+
+
+
+(defun auto-overlay-update (&optional start end unused regexp-set)
+  ;; Parse lines from line containing START to line containing END. If only
+  ;; START is supplied, just parse that line. If neither are supplied, parse
+  ;; line containing the point. If REGEXP-SET is specified, only look for
+  ;; matches in that set of overlay regexps definitions.
+  
+  ;; if there are pending match overlay suicides, postpone update till they're
+  ;; done (`auto-o-suicide' will run `auto-overlay-update' again)
+  (if (> auto-o-pending-suicide-count 0)
+      (push (list 'auto-overlay-update start end nil regexp-set)
+           auto-o-pending-post-suicide)
+    
+    ;; otherwise...
+    (let (lines regexp-list class regexp group priority
+               o-match o-overlap o-new)
+      (unless start (setq start (point)))
+      (if end
+         (setq lines
+               (1+ (- (line-number-at-pos start) (line-number-at-pos end))))
+       (setq lines 1))
+      (save-excursion
+       (save-match-data
+         (goto-char start)
+         (dotimes (i lines)
+
+           ;; check each set of overlays, unless specific set was specified
+           (dotimes (set (if regexp-set 1 (length auto-overlay-regexps)))
+             (when regexp-set (setq set regexp-set))
+             ;; check each type of auto overlay
+             (dotimes (type (length (nth set auto-overlay-regexps)))
+               (setq regexp-list (nth type (nth set auto-overlay-regexps)))
+               (setq class (nth 0 regexp-list))
+               (if (auto-o-type-is-list-p set type)
+                   (pop regexp-list)  ; remove class to leave regexp list
+                 (setq regexp-list (list regexp-list))) ; bundle in list
+               
+               ;; check all regexps for current type
+               (dotimes (sequence (length regexp-list))
+                 
+                 ;; extract regexp properties from current entry
+                 (let ((entry (nth sequence regexp-list)))
+                   (setq regexp (nth 1 entry))
+                   (if (atom regexp)
+                       (setq group 0)
+                     (setq group (cdr regexp))
+                     (setq regexp (car regexp)))
+                   (setq priority
+                         (cdr (assq 'priority
+                                    (auto-o-type-props set type sequence)))))
+                 
+                 
+                 ;; look for matches in current line
+                 (forward-line 0)
+                 (while (re-search-forward regexp (line-end-position) t)
+                   (cond
+                    ;; ignore match if it already has a match overlay
+                    ((auto-o-matched-p (match-beginning 0) (match-end 0)
+                                       set type sequence))
+                    
+                    
+                    ;; if match is within a higher priority exclusive
+                    ;; overlay, create match overlay but don't parse it
+                    ((auto-o-within-exclusive-p (match-beginning 0)
+                                                (match-end 0)
+                                                priority)
+                     (auto-o-make-match set type
+                                        (match-beginning 0) (match-end 0)
+                                        sequence (match-beginning group)
+                                        (match-end group)))
+                    
+                    ;; if existing match overlay of same type and edge but
+                    ;; different sequence overlaps the new match...
+                    ((and (auto-o-type-is-list-p set type)
+                          (setq o-overlap
+                                (auto-o-overlapping-match
+                                 (match-beginning 0) (match-end 0)
+                                 set type sequence
+                                 (auto-o-seq-edge set type sequence))))
+                     ;; if new match takes precedence, replace existing one
+                     ;; with new one, otherwise ignore new match
+                     (when (< sequence (overlay-get o-overlap 'sequence))
+                       (delete-overlay o-overlap)
+                       (setq o-match (auto-o-make-match
+                                      set type
+                                      (match-beginning 0) (match-end 0)
+                                      sequence (match-beginning group)
+                                      (match-end group)))
+                       (auto-o-match-overlay (overlay-get o-overlap 'parent)
+                                             o-match)))
+                    
+                    
+                    ;; if we're going to parse the new match...
+                    (t
+                     ;; create a match overlay for it
+                     (setq o-match (auto-o-make-match
+                                    set type
+                                    (match-beginning 0) (match-end 0)
+                                    sequence
+                                    (match-beginning group)
+                                    (match-end group)))
+                     ;; call the appropriate parse function
+                     (setq o-new
+                           (funcall (auto-o-parse-function o-match) o-match))
+                     (unless (listp o-new) (setq o-new (list o-new)))
+                     ;;  and add any new overlays to `auto-overlay-list' and
+                     ;;  give them appropriate properties
+                     (mapc (lambda (o)
+                             (setcar (nthcdr type
+                                             (nth set auto-overlay-list))
+                                     (cons
+                                      o (nth type
+                                             (nth set auto-overlay-list))))
+                             (overlay-put o 'auto-overlay t)
+                             (overlay-put o 'set set)
+                             (unless (overlay-get o 'type)
+                               (overlay-put o 'type type)))
+                           o-new)))
+                   
+                   
+                   ;; go to character one beyond the start of the match, to
+                   ;; make sure we don't miss the next match (if we find the
+                   ;; same one again, it will just be ignored)
+                   (goto-char (+ (match-beginning 0) 1)))))
+             (forward-line 1))
+           )))))
+)
+
+
+
+
+(defun auto-o-suicide (o-self modified &rest rest)
+  ;; This function is assigned to all match overlay modification hooks, and
+  ;; calls the appropriate suicide function for match overlay O-SELF as
+  ;; specified in `auto-overlay-functions'.
+  
+  ;; if we will be run after modification, increment pending suicide count to
+  ;; avoid running `auto-overlay-update' until all suicides are done
+  (if (not modified)
+      (setq auto-o-pending-suicide-count (1+ auto-o-pending-suicide-count))
+
+    ;; if being run after modification...
+    ;; if match overlay no longer matches the text it covers...
+    (unless (and (save-excursion
+                  (goto-char (overlay-start o-self))
+                  (looking-at (auto-o-regexp o-self)))
+                (= (match-end 0) (overlay-end o-self)))
+      ;; if we have a parent overlay, call appropriate suicide function,
+      ;; schedule an update (necessary for complicated reasons!) then delete
+      ;; ourselves
+      (when (overlay-get o-self 'parent)
+       (funcall (auto-o-suicide-function o-self) o-self))
+      (auto-overlay-update (overlay-start o-self) nil nil
+                          (overlay-get o-self 'set))
+      (delete-overlay o-self))
+
+    ;; decrement pending suicide count
+    (setq auto-o-pending-suicide-count (1- auto-o-pending-suicide-count))
+
+    ;; if there are no more pending suicides and there are postponed functions
+    ;; to be run, run them now
+    (when (and auto-o-pending-post-suicide (= auto-o-pending-suicide-count 0))
+      (mapc (lambda (f) (apply (car f) (cdr f)))
+           auto-o-pending-post-suicide)
+      (setq auto-o-pending-post-suicide nil)))
+)
+
+
+
+
+(defun auto-o-update-exclusive (set beg end old-priority new-priority)
+  ;; If priority has increased, delete all overlays between BEG end END that
+  ;; have priority lower than NEW-PRIORITY. If priority has decreased, re-parse
+  ;; all matches with priority lower than OLD-PRIORITY.
+
+  (let (overlay-list)
+    (cond
+     ;; if priority has increased...
+     ((and new-priority
+          (or (null old-priority) (> new-priority old-priority)))
+      ;; find overlays entirely within BEG and END that are both start and end
+      ;; matched and have priority lower than NEW-PRIORITY
+      (setq overlay-list
+           (auto-overlays-in
+            beg end
+            (list '(identity auto-overlay)
+                  (list '= 'set set)
+                  '(identity start)
+                  (list (lambda (type start end)
+                          (or (null (auto-o-type-is-list-p set type))
+                              (and start end)))
+                        '(type start end))
+                  (list (lambda (pri new) (or (null pri) (< pri new)))
+                        'priority new-priority))
+            'within))
+      ;; mark overlays in list as inactive (more efficient than calling
+      ;; suicide functions or deleting the overlays, and leaves them intact in
+      ;; case the exclusivity of the region is later reduced - see below)
+      (dolist (o overlay-list) (overlay-put o 'inactive t))
+      
+      ;; find match overlays between BEG and END that have priority lower then
+      ;; NEW-PRIORITY but still have an active parent overlay
+      (setq overlay-list
+           (auto-overlays-in
+            beg end
+            (list '(identity auto-overlay-match)
+                  (list '= 'set set)
+                  (list (lambda (parent)
+                          (null (overlay-get parent 'inactive)))
+                        'parent)
+                  (list (lambda (pri new) (or (null pri) (< pri new)))
+                        'priority new-priority))))
+      ;; call appropriate suicide function for each match overlay in list
+      (dolist (o overlay-list) (funcall (auto-o-suicide-function o) o)))
+     
+     
+     ;; if priority has decreased...
+     ((and old-priority
+          (or (null new-priority) (< new-priority old-priority)))
+      ;; find inactive overlays entirely within BEG and END that have priority
+      ;; higher or equal to NEW-PRIORITY
+      (setq overlay-list
+           (auto-overlays-in
+            beg end
+            (list '(identity auto-overlay)
+                  (list '= 'set set)
+                  '(identity inactive)
+                  (list (lambda (pri new) (or (null new) (>= pri new)))
+                        'priority new-priority))
+            'within 'inactive))
+      ;; mark overlays in list as active again
+      (dolist (o overlay-list) (overlay-put o 'inactive nil))
+      
+      ;; find match overlays between BEG and END that have priority higher or
+      ;; equal to NEW-PRIORITY but no parent overlay
+      (setq overlay-list
+           (auto-overlays-in
+            beg end
+            (list '(identity auto-overlay-match)
+                  (list '= 'set set)
+                  '(null parent)
+                  (list (lambda (pri new) (or (null new) (>= pri new)))
+                        'priority new-priority))))
+      ;; call appropriate parse function for each match overlay in list
+      (dolist (o-match overlay-list)
+       (when (not (auto-o-within-exclusive-p o-match))
+         (let ((o-new (funcall (auto-o-parse-function o-match) o-match)))
+           ;;  and add any new overlays to `auto-overlay-list' and give them
+           ;;  appropriate properties
+           (unless (listp o-new) (setq o-new (list o-new)))
+           (mapc (lambda (o)
+                   (setcar (nthcdr (overlay-get o 'type)
+                                   (nth set auto-overlay-list))
+                           (cons o (nth (overlay-get o 'type)
+                                        (nth set auto-overlay-list))))
+                   (overlay-put o 'auto-overlay t)
+                   (overlay-put o 'set set)
+                   (unless (overlay-get o 'type)
+                     (overlay-put o 'type (overlay-get o-match 'type))))
+                 o-new)))))
+     ))
+)
+
+
+
+
+(defun auto-o-make-match (set type start end
+                             &optional sequence delim-start delim-end)
+  ;; Create a new match overlay and give it the appropriate properties.
+  (let ((o-match (make-overlay start end nil 'front-advance nil)))
+    (overlay-put o-match 'auto-overlay-match t)
+    (overlay-put o-match 'set set)
+    (overlay-put o-match 'type type)
+    (overlay-put o-match 'delim-start
+                (set-marker (make-marker)
+                            (if delim-start delim-start start)))
+    (overlay-put o-match 'delim-end
+                (set-marker (make-marker)
+                            (if delim-end delim-end end)))
+    (set-marker-insertion-type (overlay-get o-match 'delim-start) t)
+    (set-marker-insertion-type (overlay-get o-match 'delim-end) nil)
+    (overlay-put o-match 'modification-hooks '(auto-o-suicide))
+    (overlay-put o-match 'insert-in-front-hooks '(auto-o-suicide))
+    (overlay-put o-match 'insert-behind-hooks '(auto-o-suicide))
+    ;; when regexp entry is a list of regexps, store sequence property
+    (when (auto-o-type-is-list-p set type)
+      (overlay-put o-match 'sequence sequence))
+    ;; return the new match overlay
+    o-match)
+)
+
+
+
+
+(defun auto-o-match-overlay (overlay start &optional end
+                                    no-props no-parse protect-match)
+  ;; Match start and end of OVERLAY with START and END match overlays.
+  ;; If START or END are numbers or markers, move that edge to the buffer
+  ;; location specified by the number or marker and make it unmatched.
+  ;; If START or END are non-nil but neither of the above, make that edge
+  ;; unmatched.
+  ;; If START or END are null, don't change that edge. However, if END is
+  ;; null, and START is an 'end overlay, match end of OVERLAY rather than
+  ;; start.
+  ;;
+  ;; If NO-PARSE is non-nil, block re-parsing due to exclusive overlay
+  ;; changes. If NO-PROPS is non-nil, block updating of overlay's
+  ;; properties. If PROTECT-MATCH is non-nil, don't modify any match overlays
+  ;; associated with OVERLAY (i.e. don't modify their 'parent properties).
+  
+  (let ((old-start (overlay-start overlay))
+       (old-end (overlay-end overlay))
+       (old-exclusive (overlay-get overlay 'exclusive))
+       (old-priority (overlay-get overlay 'priority)))
+    
+    ;; if END is null, we're not unmatching, and START is an end overlay,
+    ;; match end of overlay instead of start (Note: assumes we're matching an
+    ;; overlay type with 'start and 'end regexps)
+    (when (and (null end) (overlayp start) (eq (auto-o-edge start) 'end))
+      (setq end start)
+      (setq start nil))
+    
+    
+    ;; move overlay to new location
+    (move-overlay overlay
+                 (cond
+                  ((overlayp start) (overlay-get start 'delim-end))
+                  ((number-or-marker-p start) start)
+                  (start (point-min))
+                  (t (overlay-start overlay)))
+                 (cond
+                  ((overlayp end) (overlay-get end 'delim-start))
+                  ((number-or-marker-p end) end)
+                  (end (point-max))
+                  (t (overlay-end overlay))))
+    ;; sort out start and end properties
+    (let (o-match)
+      ;; if unmatching start...
+      (when (and start (not (overlayp start)))
+       (setq o-match (overlay-get overlay 'start))
+       (when (and o-match (null protect-match))
+         (overlay-put o-match 'parent nil))
+       (overlay-put overlay 'start nil))
+      ;; if unmatching end...
+      (when (and end (not (overlayp end)))
+       (setq o-match (overlay-get overlay 'end))
+       (when (and o-match (null protect-match))
+         (overlay-put o-match 'parent nil))
+       (overlay-put overlay 'end nil))
+      ;; if matching start...
+      (when (overlayp start)
+       (setq o-match (overlay-get overlay 'start))
+       (when (and o-match (null protect-match))
+         (overlay-put o-match 'parent nil))
+       (overlay-put overlay 'start start)
+       (overlay-put start 'parent overlay))
+      ;; if matching end...
+      (when (overlayp end)
+       (setq o-match (overlay-get overlay 'end))
+       (when (and o-match (null protect-match))
+         (overlay-put o-match 'parent nil))
+       (overlay-put overlay 'end end)
+       (overlay-put end 'parent overlay)))
+    
+    
+    ;; unless it's blocked, update properties if new match takes precedence
+    ;; (Note: this sometimes sets the overlay's properties to the ones it
+    ;; already had, but it hardly seems worth checking for that)
+    (unless no-props
+      (let (props)
+       (cond
+        ;; if start has been unmatched, use properties of end match
+        ((null (overlay-get overlay 'start))
+         (setq props (auto-o-props (overlay-get overlay 'end))))
+        ;; if end has been unmatched, use properties of start match
+        ((null (overlay-get overlay 'end))
+         (setq props (auto-o-props (overlay-get overlay 'start))))
+        (t  ;; otherwise, use properties of whichever match takes precedence
+         (let ((o-start (overlay-get overlay 'start))
+               (o-end (overlay-get overlay 'end)))
+           (if (< (overlay-get o-start 'sequence)
+                  (overlay-get o-end 'sequence))
+               (setq props (auto-o-props o-start))
+             (setq props (auto-o-props o-end))))))
+       ;; bundle properties inside a list if not already, then update them
+       (when (symbolp (car props)) (setq props (list props)))
+       (dolist (p props) (overlay-put overlay (car p) (cdr p)))))
+    
+    
+    ;; unless it's blocked, check if anything needs reparsing due to
+    ;; exclusive overlay changes
+    (unless no-parse
+      (let ((set (overlay-get overlay 'set))
+           (start (overlay-start overlay))
+           (end (overlay-end overlay))
+           (exclusive (overlay-get overlay 'exclusive))
+           (priority (overlay-get overlay 'priority)))
+       (cond
+        
+       ;; if overlay wasn't and still isn't exclusive, do nothing
+        ((and (null exclusive) (null old-exclusive)))
+        
+        ;; if overlay has become exclusive, delete lower priority overlays
+        ;; within it
+        ((and (null old-exclusive) exclusive)
+         (auto-o-update-exclusive set start end nil priority))
+        
+        ;; if overlay was exclusive but no longer is, re-parse region it
+        ;; used to cover
+        ((and old-exclusive (null exclusive))
+         (auto-o-update-exclusive set old-start old-end old-priority nil))
+        
+        ;; if overlay was and is exclusive, and has been moved to a
+        ;; completely different location re-parse old location and delete
+        ;; lower priority overlays within new location
+        ((or (< end old-start) (> start old-start))
+         (auto-o-update-exclusive set start end old-priority nil)
+         (auto-o-update-exclusive set start end nil priority))
+
+        ;; if overlay was and is exclusive, and overlaps its old location...
+        (t
+         ;; if priority has changed, re-parse/delete in overlap region
+         (when (/= old-priority priority)
+           (auto-o-update-exclusive set
+                                    (max start old-start) (min end old-end)
+                                    old-priority priority))
+         (cond
+          ;; if overlay was exclusive and start has shrunk, re-parse
+          ;; uncovered region
+          ((and (> start old-start) old-exclusive)
+           (auto-o-update-exclusive set old-start start old-priority nil))
+          ;; if overlay is exclusive and has grown, delete lower priority
+          ;; overlays in newly covered region
+          ((and (< start old-start) exclusive)
+           (auto-o-update-exclusive set start old-start nil priority)))
+         (cond
+          ;; if overlay was exclusive and end has shrunk, re-parse
+          ((and (< end old-end) old-exclusive)
+           (auto-o-update-exclusive set end old-end old-priority nil))
+           ;; if overlay is exclusive and has grown, delete lower priority
+          ((and (> end old-end) exclusive)
+           (auto-o-update-exclusive set old-end end nil priority))))
+        )))
+    )
+)
+
+
+
+
+(defun auto-o-delete-overlay (overlay &optional no-parse protect-match)
+  ;; Delete OVERLAY from buffer and `auto-overlay-list'. If PROTECT-MATCH is
+  ;; non-nil, don't modify any match overlays associated with OVERLAY
+  ;; (i.e. leave their 'parent properties alone). If NO-PARSE is non-nil,
+  ;; block re-parsing due to exclusive overlay changes.
+  
+  (let ((start (overlay-start overlay))
+       (end (overlay-end overlay))
+       o-match)
+    ;; delete overlay from buffer and `auto-overlay-list'
+    (delete-overlay overlay)
+    (unless (setq o-match (overlay-get overlay 'start))
+      (setq o-match (overlay-get overlay 'end)))
+    (setcar (nthcdr (overlay-get o-match 'type)
+                   (nth (overlay-get o-match 'set) auto-overlay-list))
+           (delq overlay (nth (overlay-get o-match 'type)
+                              (nth (overlay-get o-match 'set)
+                                   auto-overlay-list))))
+    
+    ;; unless blocked, if overlay's exclusive flag was set, re-parse region it
+    ;; covered
+    (when (and (null no-parse) (overlay-get overlay 'exclusive))
+      (auto-o-update-exclusive (overlay-get overlay 'set) start end
+                              (overlay-get overlay 'priority) nil))
+    
+    ;; Note: it's vital that the match overlays' parent properties are only
+    ;; set to nil *after* `auto-update-exclusive' is run: if the overlay
+    ;; overlapped one of its match overlays, the newly parentless match
+    ;; overlay would be re-parsed by `auto-update-exclusive', which would
+    ;; re-create the parent overlay that's just been deleted!
+    
+    ;; unmatch match overlays
+    (unless protect-match
+      (when (setq o-match (overlay-get overlay 'start))
+       (overlay-put o-match 'parent nil))
+      (when (setq o-match (overlay-get overlay 'end))
+       (overlay-put o-match 'parent nil)))
+    )
+)
+
+
+
+
+(defun auto-overlays-at-point (&optional point prop-test inactive)
+  "Return overlays overlapping POINT (or the point, if POINT is
+null). If PROP-TEST is supplied, it should be a list which
+specifies a property test with one of the following forms (or a
+list of such lists if more than one property test is required):
+
+  (FUNCTION PROPERTY)
+
+  (FUNCTION PROPERTY VALUE)
+
+  (FUNCTION (PROPERTY1 PROPERTY2 ...) (VALUE1 VALUE2 ...))
+
+where PROPERTY indicates an overlay property name (a symbol), and
+VALUE indicates an arbitrary value or lisp expression.
+
+For each overlay between START and END, first the values
+corresponding to the property names are retrieved from the
+overlay, then FUNCTION is called with the properties values
+followed by the other values as its arguments. The test is
+satisfied if the result is non-nil, otherwise it fails. Tests are
+evaluated in order, but only up to the first failure. Only
+overlays that satisfy all property tests are returned.
+
+If INACTIVE is non-nil, both active and inactive overlays are
+returned (usually inactive ones are ignored).
+
+Note that this function returns any overlay. If you want to
+restrict it to auto overlays, include '(identity auto-overlay) in
+PROP-TEST."
+  
+  (when (null point) (setq point (point)))
+  
+  ;; find overlays at point
+  (let (overlay-list
+       (modified (buffer-modified-p))
+       (inhibit inhibit-modification-hooks)
+       (undo buffer-undo-list))
+    (save-excursion
+      ;; there's no inbuilt function that finds all overlays overlapping point
+      ;; including all zero-length overlays, so we use the ugly kludge of
+      ;; inserting a character then deleting it, necessitating inhibiting
+      ;; modification hooks and saving/restoring the buffer's modified flag
+      (setq inhibit-modification-hooks t)
+      (goto-char point)
+      (insert " ")
+      
+      ;; find overlays overlapping point
+      (setq overlay-list (auto-overlays-in (- (point) 1) (point) prop-test
+                                          nil inactive))
+
+      ;; restore buffer properties
+      (delete-backward-char 1)
+      (setq inhibit-modification-hooks inhibit)
+      (set-buffer-modified-p modified)
+      (setq buffer-undo-list undo))
+    
+    ;; return overlay list
+    overlay-list)
+)
+
+
+
+
+(defun auto-overlays-in (start end &optional prop-test within inactive)
+  "Return auto overlays overlapping region between START and END.
+
+If PROP-TEST is supplied, it should be a list which specifies a
+property test with one of the following forms (or a list of such
+lists if more than one property test is required):
+
+  (FUNCTION PROPERTY)
+
+  (FUNCTION PROPERTY VALUE)
+
+  (FUNCTION (PROPERTY1 PROPERTY2 ...) (VALUE1 VALUE2 ...))
+
+where PROPERTY indicates an overlay property name (a symbol), and
+VALUE indicates an arbitrary value or lisp expression.
+
+For each overlay between START and END, first the values
+corresponding to the property names are retrieved from the
+overlay, then FUNCTION is called with the properties values
+followed by the other values as its arguments. The test is
+satisfied if the result is non-nil, otherwise it fails. Tests are
+evaluated in order, but only up to the first failure. Only
+overlays that satisfy all property tests are returned.
+
+If WITHIN is non-nil, only overlays entirely within START and END
+are returned. If INACTIVE is non-nil, both active and inactive
+overlays are returned (usually inactive ones are ignored).
+
+Note that this function returns any overlay. If you want to
+restrict it to auto overlays, include '(identity auto-overlay) in
+PROP-TEST."
+
+   ;; make sure prop-test is a list of lists, even if there's only one, and
+  ;; exclude inactive overlays unless told not to
+  (cond
+   ((null prop-test)
+    (unless inactive (setq prop-test '((null inactive)))))
+   ((functionp (car prop-test))
+    (if inactive
+       (setq prop-test (list prop-test))
+      (setq prop-test (list '(null inactive) prop-test))))
+   (t
+    (unless inactive (setq prop-test (push '(null inactive) prop-test)))))
+  
+  (let (overlay-list function prop-list value-list result)    
+    ;; check properties of each overlay in region
+    (dolist (o (overlays-in start end))
+      ;; check overlay is entirely within region
+      (if (and within
+              (or (< (overlay-start o) start) (> (overlay-end o) end)))
+         (setq result nil)
+       
+       ;; if it is, or we don't care
+       (setq result t)
+       (catch 'failed
+         ;; check if properties match
+         (dolist (test prop-test)
+           ;; (Note: the whole thing would be neater with something like
+           ;; (apply 'and (map ...)) but 'and is a special form, not a
+           ;; function, so can't be applied)
+           (setq function (nth 0 test))
+           (unless (listp (setq prop-list (nth 1 test)))
+             (setq prop-list (list prop-list)))
+           (setq value-list nil)
+           (unless (or (< (length test) 3)
+                       (and (setq value-list (nth 2 test))  ;; nil isn't list
+                            (listp value-list)))
+             (setq value-list (list value-list)))
+           
+           ;; apply the test
+           (setq result
+                 (and result
+                      (apply function
+                             (append (mapcar (lambda (p) (overlay-get o p))
+                                             prop-list)
+                                     value-list))))
+           (when (null result) (throw 'failed nil)))))
+      
+      ;; add overlay to result list if its properties matched
+      (when result (push o overlay-list)))
+    ;; return result list
+    overlay-list)
+)
+
+
+
+
+(defun auto-o-matched-p (beg end set type &optional sequence)
+  ;; Determine if characters between BEG end END are already matched by a
+  ;; match overlay from set SET of type TYPE and optionally sequence
+  ;; SEQUENCE.
+  (let (o-match)
+    (catch 'match
+      (mapc (lambda (o)
+             (when (and (overlay-get o 'auto-overlay-match)
+                        (= (overlay-get o 'set) set)
+                        (= (overlay-get o 'type) type)
+                        (= (overlay-start o) beg)
+                        (= (overlay-end o) end)
+                        (or (not (auto-o-type-is-list-p set type))
+                            (= (overlay-get o 'sequence) sequence)))
+               (setq o-match o)
+               (throw 'match t)))
+           (overlays-in beg end)))
+    o-match)
+)
+
+
+
+
+(defun auto-o-within-exclusive-p (match &optional end priority)
+  ;; If MATCH is an overlay, determine if it is within a higher priority
+  ;; exclusive overlay. If MATCH is a number or marker, determine whether
+  ;; region between MATCH and END is within an exclusive overlay with higher
+  ;; priority than PRIORITY.
+
+  (when (null end)
+    (setq end (overlay-end match))
+    (setq priority (overlay-get match 'priority))
+    (setq match (overlay-start match)))
+  
+  ;; look for higher priority exclusive overlays
+  (auto-overlays-at-point
+   match
+   (list '(identity auto-overlay)
+        '(identity exclusive)
+        (list (lambda (p q) (and p (or (null q) (> p q))))
+              'priority priority)))
+)
+  
+
+
+
+(defun auto-o-overlapping-match (beg end set type sequence edge)
+  ;; Returns any match overlay of same SET, TYPE and EDGE but different
+  ;; SEQUENCE that overlaps region from BEG to END. (Only returns first one it
+  ;; finds; which is returned if more than one exists is undefined.)
+  (let (o-overlap)
+    (catch 'match
+      (mapc (lambda (o)
+             (when (and (overlay-get o 'auto-overlay-match)
+                        (= (overlay-get o 'set) set)
+                        (= (overlay-get o 'type) type)
+                        (/= (overlay-get o 'sequence) sequence)
+                        (eq (auto-o-edge o) edge))
+               (setq o-overlap o)
+               (throw 'match t)))
+           (overlays-in beg end)))
+    o-overlap)
+)
+
+
+
+
+;; --- code-tidying macros ---
+
+(defmacro auto-o-entry (set type &optional sequence)
+  ;; Return regexp entry corresponding to SET, TYPE and SEQUENCE.
+  `(if ,sequence
+       (nth (1+ ,sequence) (nth ,type (nth ,set auto-overlay-regexps)))
+     (nth ,type (nth ,set auto-overlay-regexps))))
+
+
+(defmacro auto-o-class (o-match)
+  ;; Return class of match overlay O-MATCH.
+  `(car (nth (overlay-get ,o-match 'type)
+            (nth (overlay-get ,o-match 'set) auto-overlay-regexps))))
+
+
+(defmacro auto-o-regexp (o-match)
+  ;; Return match overlay O-MATCH's regexp.
+  `(let ((regexp (nth 1 (auto-o-entry (overlay-get ,o-match 'set)
+                                     (overlay-get ,o-match 'type)
+                                     (overlay-get ,o-match 'sequence)))))
+     (if (atom regexp) regexp (car regexp))))
+
+
+(defmacro auto-o-type-props (set type sequence)
+  ;; Return properties of regexp with SET, TYPE and SEQUENCE
+  `(if (auto-o-type-is-list-p ,set ,type)
+       (nthcdr 2 (auto-o-entry ,set ,type ,sequence))
+     (nthcdr 2 (auto-o-entry ,set ,type))))
+
+
+(defmacro auto-o-props (o-match)
+  ;; Return properties associated with match overlay O-MATCH.
+  `(auto-o-type-props (overlay-get ,o-match 'set)
+                     (overlay-get ,o-match 'type)
+                     (overlay-get ,o-match 'sequence)))
+
+
+(defmacro auto-o-seq-edge (set type sequence)
+  ;; Return edge ('start or 'end) of regexp with SET, TYPE and SEQEUNCE
+  ;; (assumes that TYPE contains a list of regexps)
+  `(car (auto-o-entry ,set ,type ,sequence)))
+
+
+(defmacro auto-o-edge (o-match)
+  ;; Return edge ('start or 'end) of match overlay O-MATCH (assumes that
+  ;; O-MATCH's type contains a list of regexps).
+  `(auto-o-seq-edge (overlay-get ,o-match 'set)
+                   (overlay-get ,o-match 'type)
+                   (overlay-get ,o-match 'sequence)))
+
+
+(defmacro auto-o-parse-function (o-match)
+  ;; Return appropriate parse function for match overlay O-MATCH.
+  `(nth 1 (assq (auto-o-class ,o-match) auto-overlay-functions)))
+
+
+(defmacro auto-o-suicide-function (o-match)
+  ;; Return appropriate suicide function for match overlay O-MATCH.
+  `(nth 2 (assq (auto-o-class ,o-match) auto-overlay-functions)))
+
+
+(defmacro auto-o-init-function (entry)
+  ;; Return appropriate suicide function for match overlay O-MATCH.
+  `(nth 3 ,entry))
+
+
+(defmacro auto-o-clear-function (entry)
+  ;; Return appropriate suicide function for match overlay O-MATCH.
+  `(nth 4 ,entry))
+
+
+(defmacro auto-o-start-matched-p (overlay)
+  ;; test if OVERLAY is start-matched
+  `(overlay-get ,overlay 'start))
+
+
+(defmacro auto-o-end-matched-p (overlay)
+  ;; test if OVERLAY is end-matched
+  `(overlay-get ,overlay 'end))
+
+
+(defmacro auto-o-type-is-list-p (set type)
+  ;; Return non-nil if regexp type TYPE contains a list of regexp entries
+  ;; rather than a single entry.
+  `(let ((entry (auto-o-entry ,set ,type 0)))
+    (and (listp entry) (symbolp (car entry)))))
+
+
+;; auto-overlays.el ends here



reply via email to

[Prev in Thread] Current Thread [Next in Thread]