[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/auto-overlays f435106 03/93: Version 0.9 of the predict
From: |
Stefan Monnier |
Subject: |
[elpa] externals/auto-overlays f435106 03/93: Version 0.9 of the predictive completion package. |
Date: |
Mon, 14 Dec 2020 13:00:26 -0500 (EST) |
branch: externals/auto-overlays
commit f4351060a26ade0339ad9cab5dc9c1c96bb498b0
Author: Toby Cubitt <toby-predictive@dr-qubit.org>
Commit: tsc25 <tsc25@cantab.net>
Version 0.9 of the predictive completion package.
---
auto-overlay-common.el | 233 +++++++++++++++++++++++++
auto-overlay-line.el | 73 ++++----
auto-overlay-self.el | 22 ++-
auto-overlay-stack-sync.el | 113 ++++++++++++
auto-overlay-stack.el | 11 +-
auto-overlays.el | 415 +++++++++++++++++++--------------------------
6 files changed, 579 insertions(+), 288 deletions(-)
diff --git a/auto-overlay-common.el b/auto-overlay-common.el
new file mode 100644
index 0000000..187c4f2
--- /dev/null
+++ b/auto-overlay-common.el
@@ -0,0 +1,233 @@
+;;; auto-overlay-common.el --- general overlay functions
+
+;; Copyright (C) 2006 Toby Cubitt
+
+;; Author: Toby Cubitt
+;; Version: 0.1
+;; 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.1
+;; * initial version split from auto-overlays
+
+
+
+;;; Code:
+
+
+(provide 'auto-overlay-common)
+
+
+(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)))
+
+ (let (overlay-list)
+ ;; get overlays overlapping POINT and zero-length overlays at POINT
+ (setq overlay-list
+ (auto-overlays-in point point prop-test nil inactive))
+ ;; get overlays that end at POINT
+ (dolist (o (auto-overlays-in (1- point) point prop-test nil inactive))
+ (when (and (< (overlay-start o) point)
+ (= (overlay-end o) point))
+ (push o overlay-list)))
+ ;; get overlays that start at POINT
+ (dolist (o (auto-overlays-in point (1+ point) prop-test nil inactive))
+ (when (and (> (overlay-end o) point)
+ (= (overlay-start o) point))
+ (push o overlay-list)))
+
+ overlay-list)
+)
+
+
+
+;; FIXME: get rid of INACTIVE argument
+(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-overlay-highest-priority-at-point (&optional point proptest)
+ "Return highest priority overlay at POINT (defaults to the point).
+
+If two overlays have the same priority, the innermost one takes
+precedence (i.e. the one that begins later, or if they begin at
+the same point the one that ends earlier).
+
+See `auto-overlays-at' for ane explanation of the PROPTEST argument."
+
+ (unless point (setq point (point)))
+
+ ;; get all overlays at point with a non-nil SYMBOL property
+ (let* ((overlay-list (auto-overlays-at-point point proptest))
+ (overlay (pop overlay-list))
+ p p1)
+
+ ;; find the highest priority, innermost overlay
+ (dolist (o1 overlay-list)
+ (setq p (overlay-get overlay 'priority))
+ (setq p1 (overlay-get o1 'priority))
+ (when (or (and (null p) p1)
+ (and p p1 (> p1 p))
+ (and (equal p1 p)
+ (or (> (overlay-start o1) (overlay-start overlay))
+ (and (= (overlay-start o1) (overlay-start overlay))
+ (< (overlay-end o1) (overlay-end o1))))))
+ (setq overlay o1)))
+
+ ;; return the overlay
+ overlay)
+)
+
+
+
+(defun auto-overlay-local-binding (symbol &optional point)
+ "Return \"overlay local \" binding of SYMBOL at POINT,
+or the current local binding if there is no overlay
+binding. POINT defaults to the point.
+
+An \"overlay local\" binding is creating by giving an overlay a
+non-nil value for a property named SYMBOL. If more than one
+overlay at POINT has a non-nil SYMBOL property, the value from
+the highest priority overlay is returned.
+
+See `auto-overlay-highest-priority-at-point' for a definition of
+\"highest priority\"."
+
+ (let ((overlay (auto-overlay-highest-priority-at-point
+ point `(identity ,symbol))))
+ (if overlay
+ (overlay-get overlay symbol)
+ (eval symbol)))
+)
+
+;; auto-overlay-common.el ends here
diff --git a/auto-overlay-line.el b/auto-overlay-line.el
index 7361448..e488fe2 100644
--- a/auto-overlay-line.el
+++ b/auto-overlay-line.el
@@ -1,9 +1,9 @@
;;; auto-overlay-line.el --- automatic overlays for single lines
-;; Copyright (C) 2005 Toby Cubitt
+;; Copyright (C) 2005 2006 Toby Cubitt
;; Author: Toby Cubitt
-;; Version: 0.2
+;; Version: 0.2.1
;; Keywords: automatic, overlays, line
;; This file is part of the Emacs Automatic Overlays package.
@@ -27,6 +27,9 @@
;;; Change Log:
;;
+;; Version 0.2.1
+;; * bug fixes in auto-o-extend-line
+;;
;; 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
@@ -82,43 +85,45 @@
;; 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)
+ ;; avoid running `auto-overlay-update' until we're 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 we haven't been deleted by a suicide function...
+ (when (overlay-buffer o-self)
+ (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
diff --git a/auto-overlay-self.el b/auto-overlay-self.el
index 6176b93..a9ac424 100644
--- a/auto-overlay-self.el
+++ b/auto-overlay-self.el
@@ -1,9 +1,9 @@
;;; auto-overlay-self.el --- self-delimited automatic overlays
-;; Copyright (C) 2005 Toby Cubitt
+;; Copyright (C) 2005 2006 Toby Cubitt
;; Author: Toby Cubitt
-;; Version: 0.2
+;; Version: 0.2.1
;; Keywords: automatic, overlays, self
;; This file is part of the Emacs Automatic Overlays package.
@@ -27,11 +27,14 @@
;;; Change Log:
;;
-;; Version 0.2:
+;; Version 0.2.1
+;; * bug fixes
+;;
+;; Version 0.2
;; * substantially re-written to postpone cascading until absolutely
;; necessary, for improved responsiveness
;;
-;; Version 0.1:
+;; Version 0.1
;; * initial version separated off from auto-overlays.el
@@ -59,7 +62,8 @@
;; 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)
+ (add-hook 'before-change-functions 'auto-o-perform-self-cascades
+ nil t)
;; initialise variables
(setq auto-o-pending-self-cascade nil)
)
@@ -112,11 +116,13 @@
;; 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
+ ;; after (or end of buffer if there isn't one), 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)))
+ (when overlay-list
+ (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))
diff --git a/auto-overlay-stack-sync.el b/auto-overlay-stack-sync.el
new file mode 100644
index 0000000..0cf5b6b
--- /dev/null
+++ b/auto-overlay-stack-sync.el
@@ -0,0 +1,113 @@
+;;; auto-overlay-stack-sync.el --- syncronised stacked automatic overlays
+
+;; Copyright (C) 2006 Toby Cubitt
+
+;; Author: Toby Cubitt
+;; Version: 0.1
+;; Keywords: automatic, overlays, stack, sync
+
+;; 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
+
+
+
+;;; Code:
+
+
+(require 'auto-overlays)
+(require 'auto-overlay-stack)
+(provide 'auto-overlay-stack-sync)
+
+
+;; register stack-sync overlay parsing and suicide functions
+(assq-delete-all 'stack-sync auto-overlay-functions)
+(push '(stack-sync auto-o-parse-stack-match auto-o-stack-suicide
+ auto-o-make-stack-sync-match)
+ auto-overlay-functions)
+
+
+
+(defun auto-o-make-stack-sync-match (o-match)
+ ;; Perform any necessary updates of auto overlays due to a match for a
+ ;; stack-sync regexp.
+
+ ;; add sync function to end of modification-, insert-in-front- and
+ ;; insert-behind-hooks (after suicide function)
+ (overlay-put o-match 'modification-hooks
+ (append (overlay-get o-match 'modification-hooks)
+ '(auto-o-stack-sync-update)))
+ (overlay-put o-match 'insert-in-front-hooks
+ (append (overlay-get o-match 'insert-in-front-hooks)
+ '(auto-o-stack-sync-update)))
+ (overlay-put o-match 'insert-behind-hooks
+ (append (overlay-get o-match 'insert-behind-hooks)
+ '(auto-o-stack-sync-update)))
+ ;; make sure new match overlay is synchronised
+ (auto-o-stack-sync-update o-match t)
+)
+
+
+
+(defun auto-o-stack-sync-update (o-self modified &rest rest)
+ ;; Syncronise start and end delimeters. Called by match overlay's
+ ;; modification-hooks.
+
+ (when modified
+ (if (> auto-o-pending-suicide-count 0)
+ (add-to-list 'auto-o-pending-post-suicide
+ (list 'auto-o-stack-sync-update o-self t) 'append)
+
+ (let ((edge (if (eq (auto-o-edge o-self) 'start) 'end 'start))
+ o-parent o-stack o-other str)
+
+ ;; if match overlay is still in the buffer (it might have been been
+ ;; deleted after a suicide), has a parent, the parent is matched at
+ ;; the other end, and the entire stack is start and end matched...
+ (when (and (overlay-buffer o-self)
+ (setq o-parent (overlay-get o-self 'parent))
+ (setq o-other (overlay-get o-parent edge))
+ (or (null (setq o-stack
+ (car (last (auto-o-stack o-self)))))
+ (and (overlay-get o-stack 'start)
+ (overlay-get o-stack 'end))))
+ (save-excursion
+ (save-match-data
+ ;; set match data for match overlay's regexp and get string to
+ ;; copy to other end
+ (goto-char (overlay-start o-self))
+ (when (looking-at (auto-o-regexp o-self))
+ (setq str (match-string (auto-o-regexp-group-nth 1 o-self)))
+ ;; if string at other end doesn't match, replace it (it's
+ ;; important to check if it already matches or we get infinite
+ ;; recursion when it's own modification-hooks are called)
+ (goto-char (overlay-start o-other))
+ (when (and (looking-at (auto-o-regexp o-other))
+ (not (string=
+ str (match-string (auto-o-regexp-group-nth
+ 1 o-other)))))
+ (replace-match str t t nil
+ (auto-o-regexp-group-nth 1 o-other))))
+ )))
+ )))
+)
diff --git a/auto-overlay-stack.el b/auto-overlay-stack.el
index c6f38f1..0c1224d 100644
--- a/auto-overlay-stack.el
+++ b/auto-overlay-stack.el
@@ -1,9 +1,9 @@
;;; auto-overlay-stack.el --- stacked start/end-delimited automatic overlays
-;; Copyright (C) 2005 Toby Cubitt
+;; Copyright (C) 2005 2006 Toby Cubitt
;; Author: Toby Cubitt
-;; Version: 0.1
+;; Version: 0.1.1
;; Keywords: automatic, overlays, stack
;; This file is part of the Emacs Automatic Overlays package.
@@ -27,7 +27,10 @@
;;; Change Log:
;;
-;; Version 0.1:
+;; Version 0.1.1
+;; * bug fixes
+;;
+;; Version 0.1
;; * initial version separated off from auto-overlays.el
@@ -131,7 +134,7 @@
((eq (auto-o-edge o-match) 'end)
(setq pos (overlay-get o-match 'delim-start))
- (setq o-new (make-overlay pos pos))
+ (setq o-new (make-overlay pos pos nil nil 'rear-advance))
(auto-o-match-overlay o-new 'unmatched o-match)))
;; give the new overlay its basic properties
diff --git a/auto-overlays.el b/auto-overlays.el
index 7f5a0ad..b8da00b 100644
--- a/auto-overlays.el
+++ b/auto-overlays.el
@@ -1,9 +1,9 @@
;;; auto-overlays.el --- automatic regexp-delimited overlays for emacs
-;; Copyright (C) 2005 Toby Cubitt
+;; Copyright (C) 2005 2006 Toby Cubitt
;; Author: Toby Cubitt
-;; Version: 0.3
+;; Version: 0.4
;; Keywords: automatic, overlays
;; This file is part of the Emacs Automatic Overlays package.
@@ -27,6 +27,9 @@
;;; Change Log:
;;
+;; Version 0.4
+;; * (a lot of) bug fixes
+;;
;; Version 0.3
;; * completely re-written after realising that the match overlays, not the
;; auto overlays themselves, should be the "primary" objects - much better!
@@ -38,7 +41,7 @@
;; * added exclusive overlay support
;; * major code tidying and bug fixes
;;
-;; Version 0.1:
+;; Version 0.1
;; * initial version created by copying code from Predictive Completion
;; package, with minor modifications
@@ -54,11 +57,8 @@
(defvar auto-overlay-unload-hook nil)
+(require 'auto-overlay-common)
(provide 'auto-overlays)
-(require 'auto-overlay-word)
-(require 'auto-overlay-line)
-(require 'auto-overlay-self)
-(require 'auto-overlay-stack)
(defvar auto-overlay-list nil)
@@ -134,7 +134,12 @@ appropriate identifier."
;; 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))
+ (add-hook 'after-change-functions 'auto-overlay-update nil t)
+ ;; reset pending-suicide-count before updates to work around bug(?) that
+ ;; overlay modification-hooks are not always called after modification
+ (add-hook 'before-change-functions
+ (lambda (&rest ignore) (setq auto-o-pending-suicide-count 0))
+ nil t))
;; search for new auto overlays
@@ -189,6 +194,9 @@ from BUFFER, or the current buffer if none is specified."
(run-hooks 'auto-overlay-unload-hook)
;; reset variables
(remove-hook 'after-change-functions 'auto-overlay-update t)
+ (remove-hook 'before-change-functions
+ (lambda (&rest ignore)
+ (setq auto-o-pending-suicide-count 0)) t)
(setq auto-o-pending-suicide-count 0)
(setq auto-o-pending-post-suicide nil))
)
@@ -206,16 +214,24 @@ from BUFFER, or the current buffer if none is specified."
;; 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)
+ (progn
+ (save-excursion
+ (goto-char start)
+ (forward-line 0)
+ (setq start (point))
+ (if (null end) (end-of-line)
+ (goto-char end)
+ (end-of-line))
+ (setq end (point)))
+ (add-to-list 'auto-o-pending-post-suicide
+ (list 'auto-overlay-update start end nil regexp-set)))
;; otherwise...
- (let (lines regexp-list class regexp group priority
+ (let (lines regexp-list class regexp group priority set sequence
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 (count-lines start end))
(setq lines 1))
(save-excursion
(save-match-data
@@ -223,8 +239,8 @@ from BUFFER, or the current buffer if none is specified."
(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))
+ (dotimes (s (if regexp-set 1 (length auto-overlay-regexps)))
+ (if regexp-set (setq set regexp-set) (setq set s))
;; check each type of auto overlay
(dotimes (type (length (nth set auto-overlay-regexps)))
(setq regexp-list (nth type (nth set auto-overlay-regexps)))
@@ -234,18 +250,17 @@ from BUFFER, or the current buffer if none is specified."
(setq regexp-list (list regexp-list))) ; bundle in list
;; check all regexps for current type
- (dotimes (sequence (length regexp-list))
+ (dotimes (seq (length regexp-list))
+ (if (> (length regexp-list) 1)
+ (setq sequence seq)
+ (setq sequence nil))
;; 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)))))
+ (setq regexp (auto-o-seq-regexp set type sequence))
+ (setq group (auto-o-seq-regexp-group set type sequence))
+ (setq priority
+ (cdr (assq 'priority
+ (auto-o-type-props set type sequence))))
;; look for matches in current line
@@ -257,22 +272,12 @@ from BUFFER, or the current buffer if none is specified."
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)
+ (match-beginning group) (match-end group)
set type sequence
(auto-o-seq-edge set type sequence))))
;; if new match takes precedence, replace existing one
@@ -284,8 +289,22 @@ from BUFFER, or the current buffer if none is specified."
(match-beginning 0) (match-end 0)
sequence (match-beginning group)
(match-end group)))
- (auto-o-match-overlay (overlay-get o-overlap 'parent)
- o-match)))
+ (when (overlay-get o-overlap 'parent)
+ (auto-o-match-overlay (overlay-get o-overlap 'parent)
+ o-match))
+ ;; run match function if there is one
+ (let ((match-func (auto-o-match-function o-match)))
+ (when match-func (funcall match-func o-match)))))
+
+ ;; if match is within a higher priority exclusive
+ ;; overlay, create match overlay but don't parse it
+ ((auto-o-within-exclusive-p (match-beginning group)
+ (match-end group)
+ priority)
+ (auto-o-make-match set type
+ (match-beginning 0) (match-end 0)
+ sequence (match-beginning group)
+ (match-end group)))
;; if we're going to parse the new match...
@@ -313,7 +332,10 @@ from BUFFER, or the current buffer if none is specified."
(overlay-put o 'set set)
(unless (overlay-get o 'type)
(overlay-put o 'type type)))
- o-new)))
+ o-new)
+ ;; run match function if there is one
+ (let ((match-func (auto-o-match-function o-match)))
+ (when match-func (funcall match-func o-match)))))
;; go to character one beyond the start of the match, to
@@ -332,13 +354,19 @@ from BUFFER, or the current buffer if none is specified."
;; 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...
+ (cond
+ ;; this is here to avoid a weird bug(?) where the modification-hooks seem
+ ;; to be called occasionally for overlays that have already been deleted
+ ((not (overlay-buffer o-self)))
+
+ ;; if we will be run after modification, increment pending suicide count to
+ ;; avoid running `auto-overlay-update' until all suicides are done
+ ((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...
+ (t
(unless (and (save-excursion
(goto-char (overlay-start o-self))
(looking-at (auto-o-regexp o-self)))
@@ -348,19 +376,22 @@ from BUFFER, or the current buffer if none is specified."
;; 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))
+ ;; Note: not supplying the 'set can avoid multiple, effectively
+ ;; identical auto-overlay-update calls
+ (auto-overlay-update (overlay-start 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)))
+ (setq auto-o-pending-post-suicide nil))))
)
@@ -492,19 +523,19 @@ from BUFFER, or the current buffer if none is specified."
(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).
+ "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))
@@ -585,9 +616,9 @@ from BUFFER, or the current buffer if none is specified."
(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
+ ;; unless it's blocked or overlay is inactive, check if anything needs
+ ;; reparsing due to exclusive overlay changes
+ (unless (or no-parse (overlay-get overlay 'inactive))
(let ((set (overlay-get overlay 'set))
(start (overlay-start overlay))
(end (overlay-end overlay))
@@ -688,170 +719,19 @@ from BUFFER, or the current buffer if none is specified."
-(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.
+ ;; 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)))
+ (= (overlay-get o 'sequence) sequence))
+ (= (overlay-start o) beg)
+ (= (overlay-end o) end))
(setq o-match o)
(throw 'match t)))
(overlays-in beg end)))
@@ -868,13 +748,13 @@ PROP-TEST."
;; priority than PRIORITY.
(when (null end)
- (setq end (overlay-end match))
+ (setq end (overlay-get match 'delim-end))
(setq priority (overlay-get match 'priority))
- (setq match (overlay-start match)))
+ (setq match (overlay-get match 'delim-start)))
;; look for higher priority exclusive overlays
- (auto-overlays-at-point
- match
+ (auto-overlays-in
+ match end
(list '(identity auto-overlay)
'(identity exclusive)
(list (lambda (p q) (and p (or (null q) (> p q))))
@@ -886,8 +766,9 @@ PROP-TEST."
(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.)
+ ;; SEQUENCE whose delimeter 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)
@@ -895,7 +776,10 @@ PROP-TEST."
(= (overlay-get o 'set) set)
(= (overlay-get o 'type) type)
(/= (overlay-get o 'sequence) sequence)
- (eq (auto-o-edge o) edge))
+ (eq (auto-o-edge o) edge)
+ ;; check delimeter (not just o) overlaps BEG to END
+ (<= (overlay-get o 'delim-start) end)
+ (>= (overlay-get o 'delim-end) beg))
(setq o-overlap o)
(throw 'match t)))
(overlays-in beg end)))
@@ -920,15 +804,56 @@ PROP-TEST."
(nth (overlay-get ,o-match 'set) auto-overlay-regexps))))
+(defmacro auto-o-seq-regexp (set type &optional sequence)
+ ;; Return regexp corresponsing to SET, TYPE and SEQUENCE.
+ `(let ((regexp (nth 1 (auto-o-entry ,set ,type ,sequence))))
+ (if (atom regexp) regexp (car regexp))))
+
+
(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))))
+ `(auto-o-seq-regexp (overlay-get ,o-match 'set)
+ (overlay-get ,o-match 'type)
+ (overlay-get ,o-match 'sequence)))
+
+
+(defmacro auto-o-seq-regexp-group (set type &optional sequence)
+ ;; Return regexp group corresponsing to SET, TYPE and SEQUENCE, or 0 if none
+ ;; is specified.
+ `(let ((regexp (nth 1 (auto-o-entry ,set ,type ,sequence))))
+ (cond
+ ((atom regexp) 0)
+ ((atom (cdr regexp)) (cdr regexp))
+ (t (cadr regexp)))))
+
+
+(defmacro auto-o-regexp-group (o-match)
+ ;; Return match overlay O-MATCH's regexp group.
+ `(auto-o-seq-regexp-group (overlay-get ,o-match 'set)
+ (overlay-get ,o-match 'type)
+ (overlay-get ,o-match 'sequence)))
+
+
+(defmacro auto-o-seq-regexp-group-nth (n set type &optional sequence)
+ ;; Return Nth regexp group entry corresponsing to SET, TYPE and SEQUENCE, or
+ ;; 0 if there is no Nth entry.
+ `(let ((regexp (nth 1 (auto-o-entry ,set ,type ,sequence))))
+ (cond
+ ((atom regexp) 0)
+ ((> (1+ ,n) (length (cdr regexp))) 0)
+ (t (nth ,n (cdr regexp))))))
+
+(defmacro auto-o-regexp-group-nth (n o-match)
+ ;; Return match overlay O-MATCH's Nth regexp group entry, or 0 if there is
+ ;; no Nth entry.
+ `(auto-o-seq-regexp-group-nth ,n
+ (overlay-get ,o-match 'set)
+ (overlay-get ,o-match 'type)
+ (overlay-get ,o-match 'sequence)))
-(defmacro auto-o-type-props (set type sequence)
+
+(defmacro auto-o-type-props (set type &optional 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))
@@ -966,14 +891,9 @@ PROP-TEST."
`(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-match-function (o-match)
+ `(let ((funcs (assq (auto-o-class ,o-match) auto-overlay-functions)))
+ (when (>= (length funcs) 4) (nth 3 funcs))))
(defmacro auto-o-start-matched-p (overlay)
@@ -993,4 +913,15 @@ PROP-TEST."
(and (listp entry) (symbolp (car entry)))))
+
+;;; ===============================================================
+;;; Compatibility Stuff
+
+(unless (fboundp 'line-number-at-pos)
+ (require 'predictive-compat)
+ (defalias 'line-number-at-pos
+ 'predictive-compat-line-number-at-pos)
+)
+
+
;; 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 <=
- [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, 2020/12/14
- [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