Emacs-Rep
view release on metacpan or search on metacpan
rep-at-end-of-changed-region
which are built on top of the (successful) experiment:
rep-rising-or-falling-edge
0.08 Sat Jun 9 19:44:03 2012
Completely re-worked how the changes are managed in
emacs, so that undos of multiple, overlapping changes
work correctly:
Now overlays are used to indicate changed regions
(because they support zero-width regions), and a buffer
local data structure is used to save metadata for each
change, including a list of shadowed changes with
locations measured relative to the change, so that and
"undo" command can properly re-set the extent of any
affected overlays.
The perl side no longer tries to use the "revise_locations"
code to fix-up the recorded locations: instead the change
metadata is used on the emacs side in inverse order so that
the original, unrevised numbering is always correct when
a change is applied.
The metadata returned from the perl routine do_find_and_reps
is restricted to just what's currently in use by rep.el:
there's less redundancy, with the 'end' field elimated
Added TODO file to the distribution.
1.00 Wed Jul 4 12:34:38 2012
Further improvements to TAB/BACKTAB to handle corner cases
(nested, overlapping changes to changes, etc).
Cleaned-up rep.el code somewhat, removing some redundant
features, explicitly checking for nil values (rather than
letting the emacs code crash with myserious overlayp errors).
This application now has no known bugs (though it is
not yet tested with the new GNU emacs 24 release),
hence the jump to 1.0.
peculiar way that would have to be called buggy.
Reverts can still be done back to the original state,
though.
"apply" should check the other windows minor-mode-list
for the presence of rep-modified-mode, and refuse to
act, warning the user that they need to accept changes
before doing an apply again.
o rep.el: write a debugging routine that tells you
the state of the rep overlays at a particular point
(a beefed up version of "what", perhaps).
elisp/rep.el view on Meta::CPAN
delta change in length of the modified text
orig the original string which was matched
rep the replaced string
pre some context characters from immediately before
post some context characters from immediately after
")
(make-variable-buffer-local 'rep-change-metadata)
(put 'rep-change-metadata 'risky-local-variable t)
(defvar rep-property 'rep-metadata-offset
"A property that we guarantee will be present in any rep.el overlay.")
;; (setq rep-property 'rep-metadata-offset)
;; =======
;; documentation variables (used just for places to attach docstrings)
(defvar rep-tag t
"The overlay property rep-tag is used to mark rep overlays so that
the \\[remove-overlays] function can find them easily. This
proerties value is always set to t: according to the
documentation, remove-overlays can't identify overlays solely by
property, it needs to know the value of the property also.
This var is just a place to attach a docstring for this property.
")
(defvar rep-metadata-pass nil
"The overlay property rep-metadata-pass contains the index for the outer
array of the array-of-arrays-of-alists `rep-change-metadata'.
This var is just a place to attach a docstring for this property.
")
(defvar rep-metadata-offset nil
"The overlay property rep-metadata-pass contains the index for the inner
array of the array-of-arrays-of-alists `rep-change-metadata'.
This var is just a place to attach a docstring for this property.
")
;;--------
;; colorized faces used to mark-up changes
(defmacro rep-make-face (name number color1 color2)
"Generate a colorized face suitable to markup changes.
NAME is the name of the face, COLOR1 is for light backgrounds
elisp/rep.el view on Meta::CPAN
(rep-modify-target-buffer
change-metadata target-file-buffer backup-file)
(rep-markup-substitution-lines changes-list-buffer)
(set-buffer target-file-buffer)
;; jump to the first unshadowed change in the modified buffer
(let* (
(goto t)
(o-ster
(rep-next-top-overlay (point-min) rep-property goto))
)
(cond ((overlayp o-ster)
(rep-modified-what-was-changed-here))
(t
(message "No marked-up changes found in buffer."))
))))
(if rep-debug
(rep-metadata-report))
))
;; Used by rep-substitutions-apply-to-other-window
(defun rep-run-perl-substitutions ( changes-list-file target-file backup-file
elisp/rep.el view on Meta::CPAN
data))
;; Used by rep-substitutions-apply-to-other-window
;; code name "modify"
(defun rep-modify-target-buffer (metadata target-buffer backup-file)
"Applies the given change METADATA to the TARGET-BUFFER.
Highlights the changes using different color faces.
For each modification, the buffer-local vars
rep-previous-versions-stack and rep-change-metadata are set by
this function, and the the overlay properties rep-metadata-pass
and rep-metadata-offset are set (indirectly, via the function
rep-create-overlay).
Presumes the target-buffer contains the original, unmodified
text at the outset.
Requires the METADATA to be in an array-of-arrays-of-alists form.
The inner alist describes each change, each change is in an array
of changes produced by a pass of a s/// command, and the outer array
is the collection of effects of the full stack of s/// commands."
(if rep-trace (rep-message (format "%s" "rep-modify-target-buffer")))
(set-buffer target-buffer)
elisp/rep.el view on Meta::CPAN
(let* (
(delta (rep-get 'record 'delta))
(orig (rep-get 'record 'orig)) ;; aka find-string
(rep (rep-get 'record 'rep)) ;; aka replace-string
(beg (rep-get 'record 'beg))
(end2 (+ beg (length rep))) ;; after change
(end1 (- end2 delta)) ;; before change
(shadowed_changes (rep-get-local-state beg end1))
string1 string1-np overlay
)
;; check the substring at beg & end1: make sure it matches orig
(setq string1-np (buffer-substring-no-properties beg end1))
(cond ((not (string= string1-np orig))
(rep-message
(format
"Warning: at %d, \"%s\" is not \"%s\"" beg string1 orig)))
)
;; preserve the shadowed_changes list in the metadata record
(rep-set 'record 'shadowed_changes shadowed_changes)
;; delete the old substring, insert rep
(setq string1 (buffer-substring beg end1))
(delete-region beg end1)
(goto-char beg)
(insert rep)
;; put metadata in overlay properties:
;; i => rep-metadata-record, pass => rep-metadata-pass
(setq overlay (rep-create-overlay beg end2 pass i ))
;; save the record of metadata in the global stash
(aset layer i record)
(aset rep-change-metadata pass layer)
)) ;; end if/setq/let*
(setq i (1- i)) ;; i--
) ;; end while i (inner)
) ;; end let
(setq pass (1+ pass)) ;; pass++
) ;; end while
) ;; end let
) ;; end defun
(defun rep-get-local-state (beg end)
"Get the state of overlays in and around region between BEG and END.
Finds overlays in the vicinity of the given region, and records
important aspects that need to be restored in the event that a change
is undone, notably the beginning and end points of each overlay,
expressed in relative terms, using BEG as the point of origin.
Returns a list of alists, with fields keyed by symbols beg, end and
overlay."
(let* (
(search-prop rep-property)
(outreach 1)
(raw-overlays (overlays-in
(rep-safe-sum beg (- outreach))
(rep-safe-sum end (+ outreach)))
)
(rep-overlays (rep-filter-overlays-by-property raw-overlays search-prop))
state
)
(dolist (overlay rep-overlays)
(let* ( (p1 (overlay-start overlay))
(p2 (overlay-end overlay))
(relative-p1 (- p1 beg))
(relative-p2 (- p2 beg))
(record-alist () )
)
(rep-set 'record-alist 'overlay overlay)
(rep-set 'record-alist 'beg relative-p1) ;;TODO beg/end confusing names?
(rep-set 'record-alist 'end relative-p2)
(push record-alist state)
))
state
))
;; Used by: rep-modify-target-buffer
;; Note: this is the only place that uses make-overlay
;; TODO we could skip passing "previous-string" since it can
;; be looked up from rep-change-metadata using pass and offset (orig).
(defun rep-create-overlay (beg end pass offset )
;; previous-string )
"Create an overlay with properties reflecting a change.
BEG and END are the start and end points of the overlay,
PREV-STRING is the previous version of the text. PASS becomes
the overlay \"priority\", and is used to choose a \"face\", and
is also set to \"rep-metadata-pass\". OFFSET will be saved as
\"rep-metadata-offset\". Returns the new overlay object."
(let* (
(markup-face (rep-lookup-markup-face pass))
(overlay (make-overlay beg end (current-buffer) nil t))
)
(overlay-put overlay 'priority pass)
(overlay-put overlay 'face markup-face)
(overlay-put overlay 'rep-metadata-offset offset)
(overlay-put overlay 'rep-metadata-pass pass)
(overlay-put overlay 'rep-tag t) ;; used by rep-clear-overlays
overlay))
;; Used by rep-modified-accept-changes
(defun rep-clear-overlays (&optional buffer)
"Clears the rep.el properties for the entire BUFFER.
Defaults to current buffer."
(if rep-trace (rep-message (format "%s" "rep-clear-overlays")))
(setq buffer-read-only nil)
(unless buffer
(setq buffer (current-buffer)))
(set-buffer buffer)
(remove-overlays (point-min) (point-max) 'rep-tag 't))
;; used by: rep-substitutions-apply-to-other-window
(defun rep-unserialize-change-metadata (data)
"Converts the raw DATA from rep.pl to a lisp data structure.
That \"raw\" DATA is an aref of hrefs, and it is passed in JSON
form, so simply using the json package to decode it gets an
elisp array of alists."
(if rep-trace (rep-message (format "%s" "rep-unserialize-change-metadata")))
(let* (change-metadata)
(cond (data
elisp/rep.el view on Meta::CPAN
(preserve-stack rep-previous-versions-stack)
)
(cond ((not previous-file)
(message "No previous version found on stack."))
((not (file-exists-p previous-file))
(message "rep.el backup file not found: %s" previous-file))
(t
(copy-file previous-file current-buffer-file-name t)
(revert-buffer t t)))
(rep-clear-overlays)
;; covering flakiness in revert-buffer & text properties.
(font-lock-fontify-buffer)
;; in case you want to revert another step up the stack
(rep-modified-mode t)
(setq rep-previous-versions-stack preserve-stack)
;; also restore cperl syntax colors in substitutions window
(save-excursion
(other-window -1)
(cond ((rep-substitutions-mode-p)
elisp/rep.el view on Meta::CPAN
)
(setq buffer-read-only nil)
(rep-modified-mode -1)
;; turn font-lock back on if it was on
(cond (rep-font-lock-buffer-status
(font-lock-mode 1)
(font-lock-fontify-buffer)
))
(rep-clear-overlays)
(save-buffer)
;; also restore cperl syntax colors in substitutions window
(save-excursion
(other-window -1)
(cond ((rep-substitutions-mode-p)
(font-lock-mode 1)
(font-lock-fontify-buffer)
(other-window 1))))
(message "rep.el: Changes accepted to %s." file)
))
;; bound to TAB, code name "next"
(defun rep-modified-skip-to-next-change ()
"Skips to next beginning of changed region.
As written, sends message indicating beginning and end
of overlay, and the value associated with the property.
If none are found, emits a generic 'thats all'."
;; Could there be multiple overlapping overlays in the same place? Work ok?
(interactive)
(if rep-trace (rep-message (format "%s" "rep-modified-skip-to-next-change")))
(let* (
(goto-flag t)
(big-o
(rep-next-top-overlay (point) rep-property goto-flag))
beg end val
)
(cond ((overlayp big-o)
(rep-modified-what-was-changed-here)
)
(t
(message "No futher changed regions.")
))
))
;; bound to BACKTAB by default
(defun rep-modified-skip-to-prev-change ()
"Move back to the previous changed region, stopping at the beginning point.
Uses `rep-metadata-record' property."
(interactive)
(if rep-trace (rep-message (format "%s" "rep-modified-skip-to-prev-change")))
(let* (
(goto-flag t)
(reverse t)
(big-o
(rep-prev-top-overlay (point) rep-property goto-flag))
)
(cond ((overlayp big-o)
(rep-modified-what-was-changed-here)
)
(t
(message "No futher changed regions.")
))
))
;; C-c.w
(defun rep-modified-what-was-changed-here ()
"Tells you the original string was before it was replaced."
;; looks up the orig string in metadata
(if rep-trace (rep-message (format "%s" "rep-modified-what-was-changed-here")))
(let* (
(ova (rep-top-overlay-here (point) rep-property))
beg end pass offset record-number orig
)
(cond (ova
(setq beg (overlay-start ova))
(setq end (overlay-end ova))
(setq pass
(overlay-get ova 'rep-metadata-pass))
(setq offset
(overlay-get ova 'rep-metadata-offset))
(cond ((eq rep-change-metadata nil)
(message "Warning: in %s rep-change-metadata is nil."
"rep-modified-what-was-changed-here")
)
((and pass offset)
(setq orig (rep-metadata-get 'orig pass offset))
(message "Was: %s" orig)
) ;; any t condition? warn: "something weird"
)))))
elisp/rep.el view on Meta::CPAN
This also supplies additional information like the number of the
substitution pass that made the change."
;; Note it might've be more consistent to just message that there's nothing there.
;; but it's more convienient to skip ahead, and this is a top-level
;; interactive routine not used by other code.
(interactive)
(if rep-trace (rep-message
(format "%s" "rep-modified-what-was-changed-here-verbose")))
(let* (
(here (point))
(ova (rep-top-overlay-here here rep-property))
(goto-flag t)
last-change beg end
pass offset
)
(cond ( (not ova) ;; we are not yet inside a changed region
;; This jumps to the next change, rather than look just "here"
(setq ova (rep-next-overlay here rep-property 0 goto-flag))
))
(cond ((overlayp ova)
;; pass is used to lookup record *and* in messaging (so stet!)
(setq pass
(overlay-get ova 'rep-metadata-pass))
(setq offset
(overlay-get ova 'rep-metadata-offset))
(cond ((and pass offset)
(let* (
(layer (aref rep-change-metadata pass))
(record (aref layer offset))
(orig (rep-get 'record 'orig))
;; Note: hold open door to more info from record for messaging
)
(message
"This was: %s (changed by substitution number: %d)."
orig
elisp/rep.el view on Meta::CPAN
;; Bound to "u" key, code name "undo"
(defun rep-modified-undo-change-here ()
"Undos the individual rep substitution change under the cursor.
Undos the change at point, or if none is there, warns and does nothing.
Note that this has nothing to do with the usual emacs \"undo\"
system, which operates completely independently."
(interactive)
(if rep-trace (rep-message (format "%s" "rep-modified-undo-change-here")))
(let* (
(overlay (rep-top-overlay-here (point) rep-property))
)
(cond ((not (overlayp overlay))
(message "No change to undo at point.")
)
(t
(let* ((beg (overlay-start overlay))
(end (overlay-end overlay))
(existing (buffer-substring-no-properties beg end))
(record (rep-record-from-overlay-and-metadata overlay))
(orig (rep-get 'record 'orig)) ;; for messaging only
(rep (rep-get 'record 'rep))
(shadowed_changes (rep-get 'record 'shadowed_changes))
)
(rep-message (format "undo %s to %s\n" rep orig))
(cond
((not (string= existing rep))
(message
"Can't revert: \"%s\", looks like it was edited (expected \"%s\")."
existing rep)
)
((setq shadow
(rep-overlay-shadowed-p overlay rep-property))
(let* (
(s-record (rep-record-from-overlay-and-metadata shadow))
(s-rep (rep-get 's-record 'rep)) ;; for messaging only
)
(message
"Can't revert fragment: \"%s\". Must undo change of \"%s\" first."
existing s-rep)
))
(t
(let* ((restore-string orig
))
(delete-region beg end)
(goto-char beg)
(insert restore-string)
)
;; readjust overlays of shadowed changes now revealed after the undo
(rep-restore-shadowed-changes-relative-to beg shadowed_changes)
;; disconnect overlay from buffer, we're done with it
(delete-overlay overlay)
(goto-char beg)
(message "Change reverted: \"%s\"" existing)
))))
)))
;; Used by rep-modified-undo-change-here
(defun rep-restore-shadowed-changes-relative-to (origin shadowed_changes)
"Resets extents relative to ORIGIN of all overlays in SHADOWED_CHANGES.
SHADOWED_CHANGES is a list of alists, where each alist is
keyed by the symbols: overlay, beg, end."
(dolist (shadowed_change shadowed_changes)
(let* (
(shadowlay
(rep-get 'shadowed_change 'overlay))
(shadowlay-rel-beg
(rep-get 'shadowed_change 'beg))
(shadowlay-rel-end
(rep-get 'shadowed_change 'end))
(shadowlay-beg (+ shadowlay-rel-beg origin))
(shadowlay-end (+ shadowlay-rel-end origin))
)
(move-overlay shadowlay shadowlay-beg shadowlay-end)
;; (overlay-put shadowlay 'priority (overlay-get shadowlay 'rep-metadata-pass)) ;; didn't help
)))
;;========
;; rep utility functions
;;--------
;; filename/directory manipulations
;; Used by rep-open-substitutions & rep-generate-backup-file-name
(defun rep-sub-directory (file-location)
elisp/rep.el view on Meta::CPAN
(defun rep-metadata-get (field pass offset)
"Gets value of FIELD for PASS and OFFSET from `rep-change-metadata'.
Example usage, get field \"orig\" for record in pass 3, with offset 4:
(rep-metadata-get 'orig 3 4)
"
(let* ((layer (aref rep-change-metadata pass))
(record (aref layer offset))
(value (rep-get 'record field)))
value))
(defun rep-record-from-overlay-and-metadata (overlay)
"Returns a record of rep metadata, given a rep OVERLAY.
The rep OVERLAY should have `rep-metadata-pass' and
`rep-metadata-offset' properties. The returned record is an alist
as documented here: `rep-change-metadata'."
(let* (
(pass
(overlay-get overlay 'rep-metadata-pass))
(offset
(overlay-get overlay 'rep-metadata-offset))
;; TODO consider a check, before trying to look up record:
;; (cond ((and pass offset)
(layer (aref rep-change-metadata pass))
(record (aref layer offset))
)
record))
;;========
;; general utililities
;;--------
;; overlay utilities
;; TODO move overlay utilities to a general-purpose package:
;; overlay-utils.el
;; TODO should I handle the case where the given
;; property does not exist in the overlay?
(defun rep-overlay-get (overlay property)
"Gets the value of the PROPERTY from the OVERLAY.
Returns nil if either input is nil (will not error-out like
\\[overlay-get]."
(cond ((and overlay property)
(overlay-get overlay property)
)
(t
nil)
))
;; Used by *everything*
(defun rep-overlays-here (&optional spot)
"Return a list of overlays at one point in the buffer.
If SPOT is not given, lists the overlays at point. This is a
variant of \\[overlays-in] and \\[overlays-at], designed to
gather both zero-width overlays and the wider ones at a location
found by doing a \\[next-overlay-change]."
(interactive) ;; debug
(let (
(spot (or spot (point)))
(o-list
(append
(overlays-in spot spot) ;; finds zero-width overlays
(overlays-at spot) ;; finds wider overlays
;; (overlays-in (1+ spot) (1+ spot)) ;; also finds wider overlays
))
)
o-list))
;; used by rep-get-local-state, rep-get-local-state, rep-next-overlay
;; and indirectly by everything: "apply", "undo", TAB, BACKTAB, "what", "modify"
(defun rep-filter-overlays-by-property (overlay-list property)
"Given an OVERLAY-LIST selects only the ones matching PROPERTY.
Returns the filtered list. If overlay-list is nil, returns nil.
If property is nil, that means there's no filtering and it
returns the given overlay-list unchanged."
(let ( overlay p hit-list ret)
(setq ret
(cond ((not property)
overlay-list
)
(t
(cond (overlay-list
(dolist (overlay overlay-list)
(setq p-list (overlay-properties overlay))
(dolist (p p-list)
(cond( (equal p property)
(push overlay hit-list)
))
))
hit-list)
(t
nil)) ;; end cond overlay-list
)) ;; end cond not propery
);; end set ret
ret))
;; Used by: rep-next-overlay
(defun rep-filter-overlays-priority (overlay-list priority)
"Given an OVERLAY-LIST selects only the ones greater than PRIORITY.
Returns the filtered list. If either input is nil, returns nil."
(let* ((cutoff priority)
overlay p hit-list prior ret)
(setq ret
(cond ((and overlay-list property)
(dolist (overlay overlay-list)
(cond( (>= (overlay-get overlay 'priority) cutoff)
(push overlay hit-list)
)))
hit-list)
(t
nil)))
ret))
(defun rep-sort-overlays-on-priority (o-list)
"Given a list of overlays, sort them on priority.
Returns a sorted list in descending order, with the maximum
at the top."
;; so if not given valid overlays, it doesn't error out (zat good?)
(let ( new-o-list
)
(setq new-o-list
(sort o-list
'(lambda (a b)
(let ((pa (cond ((overlayp a)
(overlay-get a 'priority))
))
(pb (cond ((overlayp a)
(overlay-get b 'priority))
))
)
(> pa pb) ;; descending order, max at the top
))))
new-o-list))
;; used by "next", "prev", and "rep-top-overlay-here" (used by "undo", "what")
(defun rep-max-priority-overlay (overlay-list)
"Given an OVERLAY-LIST, returns an overlay with maximum priority.
If input is nil, returns nil."
;; The usual deal: sweep through the list, save the last one
;; replace it with the current one if it's priority is larger.
(let* ( (candy-priority -27) ;; initialize to a lower number than is in use
overlay priority candidate ret
)
(cond (overlay-list
(dolist (overlay overlay-list)
(setq priority (overlay-get overlay 'priority))
(cond ((> priority candy-priority)
(setq candidate overlay)
(setq candy-priority priority)
))
)
(setq ret candidate))
(t
(setq ret nil)))
ret))
;; Directly used by:
;; rep-next-top-overlay
;; rep-overlay-shadowed-p
;; rep-modified-what-was-changed-here-verbose
;; Indirectly used by: rep-modified-skip-to-next-change
;; rep-substitutions-apply-to-other-window
(defun rep-next-overlay (&optional position property priority-cutoff goto-flag)
"Looks for the leading edges of overlays following POSITION.
POSITION defaults to point. Works in the current buffer.
If PROPERTY is given, it will search for the first overlay(s)
with that PROPERTY.
If PRIORITY-CUTOFF is given, it will ignore any overlays that
do not have a higher or equal priority.
If more than one qualifying overlays begin at the same place,
returns the overlay with maximum priority, or nil if none are
found.
If the GOTO-FLAG is t, it will also move to the start of
the overlay."
(let* ( (spot (or position (point)))
(save-point-a (point))
(priority priority-cutoff)
o-list overlay
)
;; repeat peek ahead looking for overlays that qualify,
;; i.e. that have property and exceed priority cutoff
(while (not (progn ;; repeat-until
(setq o-list
(rep-next-raw-overlays spot t)) ;; goto flag on
;; restrict by property &/or priority
(if property
(setq o-list (rep-filter-overlays-by-property o-list property)))
(if priority
(setq
o-list (rep-filter-overlays-priority o-list priority)))
;; get set for next interation (if any)
(setq spot (point))
;; exit if found some meeting criteria, or hit the EOB
(or
o-list
(= (point) (point-max)) )
)))
;; get the max (might be more than one)
(setq overlay (rep-max-priority-overlay o-list))
(cond ((and goto-flag
(overlayp overlay))
(goto-char (overlay-start overlay))
)
(t
(goto-char save-point-a)))
overlay))
;; Unused (because BACKTAB uses rep-prev-top-overlay,
;; which uses previous-overlay-change and rep-top-overlay-here)
;; Note rep-next-overlay *is* used to apply changes and such.
(defun rep-prev-overlay (&optional position property priority-cutoff goto-flag)
"Looks for the leading edges of overlays before POSITION.
POSITION defaults to point. Works in the current buffer.
If PROPERTY is given, it will search for the first overlay(s)
with that PROPERTY.
If PRIORITY-CUTOFF is given, it will ignore any overlays that
do not have a higher or equal priority.
If more than one qualifying overlays begin at the same place,
returns the overlay with maximum priority, or nil if none are
found.
If the GOTO-FLAG is t, it will also move to the start of
the overlay."
(let* ( (spot (or position (point)))
(save-point-a (point))
(priority priority-cutoff)
o-list overlay
)
;; repeat peek back looking for overlays that qualify,
;; i.e. that have property and exceed priority cutoff
(while (not (progn ;; repeat-until
(setq o-list
(rep-prev-raw-overlays spot t)) ;; need to goto
;; restrict by property &/or priority
(if property
(setq o-list (rep-filter-overlays-by-property o-list property)))
(if priority
(setq
o-list (rep-filter-overlays-priority o-list priority)))
;; get set for next interation (if any)
(setq spot (point))
;; exit if found some meeting criteria, or hit the BOB
(or
o-list
(= (point) (point-min)) )
)))
;; get the max (might be more than one)
(setq overlay (rep-max-priority-overlay o-list))
(cond ((and goto-flag
(overlayp overlay))
(goto-char (overlay-start overlay))
)
(t
(goto-char save-point-a)))
overlay))
;; Used by rep-next-overlay
(defun rep-next-raw-overlays (&optional position goto-flag)
"Searches for any overlays after POSITION, which defaults to point.
If GOTO-FLAG is set, it will move to the location.
Returns a list of overlays found \(there can be more than one
at the same position\)."
(let* (
(spot (or position (point)))
(save-point-b (point))
o-list
raw-list
)
;; next-overlay-change stops at leading and trailing edges.
;; So if we turn up no overlays with it, it could
;; be we're at the trailing edge, so we try again.
(while ;; repeat-until
(not
(progn
(setq spot (next-overlay-change spot))
(goto-char spot)
(setq o-list
(rep-overlays-here spot))
(or ;; exit if...
o-list ;; found something
(= spot (point-max))) ;; hit EOB
)
)
)
(if o-list
(setq raw-list o-list))
(unless goto-flag
(goto-char save-point-b))
raw-list))
;; Unused, because only referenced by another unused: rep-prev-overlay
(defun rep-prev-raw-overlays (&optional position goto-flag)
"Searches for any overlays before POSITION, which defaults to point.
If GOTO-FLAG is set, it will move to the location.
Returns a list of overlays found \(there can be more than one
at the same position\)."
(let* (
(spot (or position (point)))
(save-point-b (point))
o-list
raw-list
)
;; previous-overlay-change stops at leading and trailing edges.
;; So if we turn up no overlays with it, it could
;; be we're at the trailing edge, so we try again.
(while ;; repeat-until
(not
(progn
(setq spot (previous-overlay-change spot))
(goto-char spot)
(setq o-list
(rep-overlays-here spot))
(or ;; exit if...
o-list ;; found something
(= spot (point-min))) ;; hit BOB
)
)
)
(if o-list
(setq raw-list o-list))
(unless goto-flag
(goto-char save-point-b))
raw-list))
;; Used by "undo", "what" (and indirectly by "tab" and "backtab")
;; specically, used by:
;; rep-prev-top-overlay
;; rep-next-top-overlay
;; rep-modified-undo-change-here
;; rep-modified-what-was-changed-here-verbose
;; rep-modified-what-was-changed-here
(defun rep-top-overlay-here (&optional position property)
"Returns the top overlay active at the given position, in the current buffer.
A \"top\" overlay is \"unshadowed\", i.e. there is no overlapping
overlay of higher priority. If POSITION is not given, it looks
at point, if PROPERTY is given, it looks for the top most overlay
with that PROPERTY. Returns nil, if there's no such overlay."
(let* ((spot (or position (point)))
(save-point-c (point))
(overlays-list
(rep-filter-overlays-by-property (rep-overlays-here spot) property))
(candidate
(rep-max-priority-overlay overlays-list))
beg end priority top
)
(cond (candidate
(setq beg (overlay-start candidate))
(setq end (overlay-end candidate))
(setq priority (overlay-get candidate 'priority))
(setq top candidate) ;; top initialized as candidate, we set to nil if this fails
(goto-char beg) ;; sweep through extent of candidate overlay.
(while (and top ;; once we know it's not top, might as well stop
(<= (point) end) ;; check at every char up to end of overlay
)
(let* (
(raw-overlays-here (rep-overlays-here (point)))
(overlays-here
(rep-filter-overlays-by-property raw-overlays-here property) )
current-priority max-overlay-here
)
(setq current-priority ;; will be -1 if no overlays at all
(cond ( overlays-here
(setq max-overlay-here
(rep-max-priority-overlay overlays-here))
(rep-overlay-get max-overlay-here 'priority)
)
(t -1)))
(cond ((> current-priority priority)
(setq top nil) ;; no top overlay at this POSITION
))
)
(forward-char 1)
))
(t
(setq top nil) ;; if candidate is undef, we want to return nil
))
(goto-char save-point-c)
top))
;; used by: rep-modified-skip-to-next-change (aka "next" or TAB ) also "apply"
(defun rep-next-top-overlay (&optional position property goto-flag)
"Find immediately next top level overlay.
Begins looking at point unless POSITION is given.
If PROPERTY is given, only looks for overlays with that property.
If GOTO-FLAG is on, also moves to the location.
Returns the location found, or nil if none."
(let* ((spot (or position (point)))
(start-point (point))
(goto-flag t)
candidate candidate-spot shadow found beg end priority shadow-beg
)
(while ;; repeat-until
(not
(progn
(setq spot (next-overlay-change spot))
;; Note any "top overlay" is *unshadowed* by definition
(cond ( (setq found
(rep-top-overlay-here spot rep-property))
(setq spot (overlay-start found))
)
)
(cond ((= spot (point-max)) ;; at EOB, so exit
t)
(found ;; found something, so exit
found)
)
)))
(if goto-flag
(goto-char spot))
found))
;; Used by: rep-modified-skip-to-prev-change (aka BACKTAB)
(defun rep-prev-top-overlay (&optional position property goto-flag)
"Find immediately previous top level overlay.
Begins looking at point unless POSITION is given.
If PROPERTY is given, only looks for overlays with that property.
If GOTO-FLAG is on, also moves to the location.
Returns the location found, or nil if none."
(let* ((spot (or position (point)))
(start-point (point))
(goto-flag t)
candidate candidate-spot shadow found beg end priority shadow-beg
)
(while ;; repeat-until
(not
(progn
(setq spot (previous-overlay-change spot))
;; Note any "top overlay" is *unshadowed* by definition
(cond ((setq found
(rep-top-overlay-here spot rep-property))
(setq spot (overlay-start found))
))
(cond ((= spot (point-min)) ;; at BOB, so exit
t)
(found ;; found something, so exit
found)
)
)))
(if goto-flag
(goto-char spot))
found))
;; Used by: rep-prev-top-overlay, rep-modified-undo-change-here
(defun rep-overlay-shadowed-p (overlay &optional tag-property)
"Is OVERLAY shadowed (and not a top overlay)?
With TAG-PROPERTY, only considers overlays that contain that tag.
Returns the shadowing overlay, if one is found, nil otherwise."
(save-excursion ;; pleeeease preserve point. thank you.
(let* ((beg (overlay-start overlay))
(end (overlay-end overlay))
(priority (overlay-get overlay 'priority))
(over-overlay (rep-next-overlay beg tag-property
(1+ priority)
nil))
;; nil => goto-flag is off
shadow dark-beg
)
(cond (over-overlay
(setq dark-beg (overlay-start over-overlay))
))
;; if found a higher overlay that starts before the end of
;; the given one, it's a shadow
(cond ((and over-overlay (<= dark-beg end))
(setq shadow over-overlay)))
shadow
)))
;;--------
;; alist manipulation utilities
;; Used a lot here!
(defun rep-get (alist-symbol key)
( run in 0.352 second using v1.01-cache-2.11-cpan-49f99fa48dc )