1 ;;; auto-overlay-nested.el --- nested start/end-delimited automatic overlays
4 ;; Copyright (C) 2005-2015 Free Software Foundation, Inc
6 ;; Author: Toby Cubitt <toby-predictive@dr-qubit.org>
7 ;; Maintainer: Toby Cubitt <toby-predictive@dr-qubit.org>
8 ;; URL: http://www.dr-qubit.org/emacs.php
9 ;; Repository: http://www.dr-qubit.org/git/predictive.git
11 ;; This file is part of the Emacs.
13 ;; This file is free software: you can redistribute it and/or modify it under
14 ;; the terms of the GNU General Public License as published by the Free
15 ;; Software Foundation, either version 3 of the License, or (at your option)
18 ;; This program is distributed in the hope that it will be useful, but WITHOUT
19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
20 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
23 ;; You should have received a copy of the GNU General Public License along
24 ;; with this program. If not, see <http://www.gnu.org/licenses/>.
29 (require 'auto-overlays)
30 (provide 'auto-overlay-nested)
33 ;; set nested overlay parsing and suicide functions, and indicate class
34 ;; requires separate start and end regexps
35 (put 'nested 'auto-overlay-parse-function 'auto-o-parse-nested-match)
36 (put 'nested 'auto-overlay-suicide-function 'auto-o-nested-suicide)
37 (put 'nested 'auto-overlay-complex-class t)
41 (defun auto-o-parse-nested-match (o-match)
42 ;; Perform any necessary updates of auto overlays due to a match for a
45 (let* ((overlay-stack (auto-o-nested-stack o-match))
46 (o (car overlay-stack)))
48 ;; if the stack is empty, just create and return a new unmatched overlay
50 (auto-o-make-nested o-match 'unmatched))
52 ;; if appropriate edge of innermost overlay is unmatched, just match it
53 ((or (and (eq (auto-o-edge o-match) 'start)
54 (not (auto-o-start-matched-p o)))
55 (and (eq (auto-o-edge o-match) 'end)
56 (not (auto-o-end-matched-p o))))
57 (auto-o-match-overlay o o-match)
58 ;; return nil since haven't created any new overlays
63 ;; create new innermost overlay and add it to the overlay stack
64 (push (auto-o-make-nested o-match) overlay-stack)
65 ;; sort out the overlay stack
66 (auto-o-nested-stack-cascade overlay-stack)
67 ;; return newly created overlay
74 (defun auto-o-nested-suicide (o-self)
75 ;; Called when match no longer matches. Unmatch the match overlay O-SELF, if
76 ;; necessary deleting its parent overlay or cascading the stack.
78 (let* ((overlay-stack (auto-o-nested-stack o-self))
79 (o-parent (car overlay-stack)))
82 ;; if other end of parent is unmatched, just delete parent
83 ((not (auto-o-edge-matched-p
85 (if (eq (auto-o-edge o-self) 'start) 'end 'start)))
86 (auto-o-delete-overlay o-parent))
88 ;; if parent is the only overlay in the stack...
89 ((= (length overlay-stack) 1)
90 ;; if we're a start match, make parent start-unmatched
91 (if (eq (auto-o-edge o-self) 'start)
92 (auto-o-match-overlay o-parent 'unmatched nil)
93 ;; if we're an end match, make parent end-unmatched
94 (auto-o-match-overlay o-parent nil 'unmatched)))
96 ;; otherwise, unmatch ourselves from parent and cascade the stack
98 (overlay-put o-parent (auto-o-edge o-self) nil)
99 (overlay-put o-self 'parent nil)
100 (auto-o-nested-stack-cascade overlay-stack))
106 (defun auto-o-make-nested (o-match &optional unmatched)
107 ;; Create a nested overlay for match overlay O-MATCH.
108 ;; If UNMATCHED is nil, overlay will start and end at O-MATCH.
109 ;; If non-nil, overlay will start or end from O-MATCH (depending on whether
110 ;; O-MATCH is a 'start or 'end match) and stretch till end or beginning of
114 ;; create new nested overlay and match it with O-MATCH
116 ((eq (auto-o-edge o-match) 'start)
117 (setq pos (overlay-get o-match 'delim-end))
118 (setq o-new (make-overlay pos pos nil nil 'rear-advance))
119 (overlay-put o-new 'auto-overlay t)
120 (overlay-put o-new 'set-id (overlay-get o-match 'set-id))
121 (overlay-put o-new 'definition-id (overlay-get o-match 'definition-id))
122 (auto-o-match-overlay o-new o-match 'unmatched))
124 ((eq (auto-o-edge o-match) 'end)
125 (setq pos (overlay-get o-match 'delim-start))
126 (setq o-new (make-overlay pos pos nil nil 'rear-advance))
127 (overlay-put o-new 'auto-overlay t)
128 (overlay-put o-new 'set-id (overlay-get o-match 'set-id))
129 (overlay-put o-new 'definition-id (overlay-get o-match 'definition-id))
130 (auto-o-match-overlay o-new 'unmatched o-match)))
132 ;; return the new overlay
137 (defun auto-o-nested-stack-cascade (overlay-stack)
138 ;; Cascade the ends of the overlays in OVERLAY-STACK up or down the stack,
139 ;; so as to re-establish a valid stack. It assumes that only the innermost
142 (let ((o (car overlay-stack)) o1)
145 ;; if innermost overlay is start-matched (and presumably
147 ((auto-o-start-matched-p o)
148 ;; cascade overlay end matches up through stack until one is left
149 (dotimes (i (- (length overlay-stack) 1))
150 (setq o (nth i overlay-stack))
151 (setq o1 (nth (+ i 1) overlay-stack))
152 (auto-o-match-overlay o nil
153 (if (overlay-get o1 'end)
154 (overlay-get o1 'end)
156 nil nil 'protect-match))
157 ;; if final overlay is start-matched, make it end-unmatched, otherwise
159 (if (auto-o-start-matched-p o1)
160 ;; FIXME: could postpone re-parsing here in case it can be avoided
161 (auto-o-match-overlay o1 nil 'unmatch nil nil 'protect-match)
162 (auto-o-delete-overlay o1 nil 'protect-match)))
165 ;; if innermost overlay is end-matched (and presumably
166 ;; start-unmatched)...
167 ((auto-o-end-matched-p o)
168 ;; cascade overlay start matches up through stack until one is left
169 (dotimes (i (- (length overlay-stack) 1))
170 (setq o (nth i overlay-stack))
171 (setq o1 (nth (+ i 1) overlay-stack))
172 (auto-o-match-overlay o (if (overlay-get o1 'start)
173 (overlay-get o1 'start)
175 nil nil nil 'protect-match))
176 ;; if final overlay is end-matched, make it start-unmatched, otherwise
178 (if (auto-o-end-matched-p o1)
179 ;; FIXME: could postpone re-parsing here in case it can be avoided
180 (auto-o-match-overlay o1 'unmatch nil nil nil 'protect-match)
181 (auto-o-delete-overlay o1 nil 'protect-match))))
188 (defun auto-o-nested-stack (o-match)
189 ;; Return a list of the overlays that overlap and correspond to same entry
190 ;; as match overlay O-MATCH, ordered from innermost to outermost. (Assumes
191 ;; overlays are correctly stacked.) The parent of O-MATCH is guaranteed to
192 ;; come before any other overlay that has exactly the same length (which
193 ;; implies they cover identical regions if overlays are correctly
194 ;; stacked). For other overlays with identical lengths, the order is
197 ;; find overlays corresponding to same entry overlapping O-MATCH
198 (let ((overlay-stack (auto-overlays-at-point
199 (if (eq (auto-o-edge o-match) 'start)
200 (overlay-get o-match 'delim-end)
201 (overlay-get o-match 'delim-start))
202 (list '(eq auto-overlay t)
203 (list 'eq 'set-id (overlay-get o-match 'set-id))
204 (list 'eq 'definition-id
205 (overlay-get o-match 'definition-id)))))
206 (o-parent (overlay-get o-match 'parent)))
207 ;; sort the list by overlay length, i.e. from innermost to outermose
210 (let ((len-a (- (overlay-end a) (overlay-start a)))
211 (len-b (- (overlay-end b) (overlay-start b))))
212 ;; parent of O-MATCH comes before any other overlay with
213 ;; identical length, otherwise sort by length
214 (if (= len-a len-b) (eq o-parent a) (< len-a len-b)))))
219 ;; auto-overlay-nested.el ends here