[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
- [elpa] branch externals/auto-overlays created (now d207912), Stefan Monnier, 2020/12/14
- [elpa] externals/auto-overlays f39daaa 05/93: Version 0.10 of the predictive completion package., Stefan Monnier, 2020/12/14
- [elpa] externals/auto-overlays f41e85c 18/93: Renamed auto-overlays documentation directory., Stefan Monnier, 2020/12/14
- [elpa] externals/auto-overlays f435106 03/93: Version 0.9 of the predictive completion package., Stefan Monnier, 2020/12/14
- [elpa] externals/auto-overlays 2d0dbcf 04/93: Version 0.9.1 of the predictive completion package., Stefan Monnier, 2020/12/14
- [elpa] externals/auto-overlays b76de5a 06/93: Version 0.11.2 of the predictive completion package., Stefan Monnier, 2020/12/14
- [elpa] externals/auto-overlays 80e9510 01/93: Version 0.7 of the predictive completion package.,
Stefan Monnier <=
- [elpa] externals/auto-overlays 49f99f7 07/93: Version 0.12 of the predictive completion package., Stefan Monnier, 2020/12/14
- [elpa] externals/auto-overlays 8aef411 17/93: Minor modifications, Stefan Monnier, 2020/12/14
- [elpa] externals/auto-overlays 10bad81 31/93: Renamed "nest" regexps to "nested"., Stefan Monnier, 2020/12/14
- [elpa] externals/auto-overlays bf53b50 24/93: Adding free documentation license text to packaging. Bumped version numbers., Stefan Monnier, 2020/12/14
- [elpa] externals/auto-overlays 39cb421 38/93: Save predictive mode auxiliary files to a subdirectory,, Stefan Monnier, 2020/12/14
- [elpa] externals/auto-overlays 6290c58 46/93: Added/modified local variables section to switch on predictive-mode automatically, Stefan Monnier, 2020/12/14
- [elpa] externals/auto-overlays 8859d17 35/93: Minor bug fixes., Stefan Monnier, 2020/12/14
- [elpa] externals/auto-overlays 31a4d46 48/93: Bug-fixes in auto-overlay-load-overlays and auto-overlay-save-overlays, Stefan Monnier, 2020/12/14
- [elpa] externals/auto-overlays 68c4640 59/93: Updated Package-Version, Package-Requires, and Keywords package headers., Stefan Monnier, 2020/12/14
- [elpa] externals/auto-overlays 2860354 58/93: Fixed obsolete functions and other compiler warnings., Stefan Monnier, 2020/12/14