Emacs Stack Exchange is a question and answer site for those using, extending or developing Emacs. It only takes a minute to sign up.
Sign up to join this community
Say, I have a buffer A in which there is a region of text from some position pos1 to an other position pos2.
I switch to buffer B, call a function with buffer A, pos1 and pos2 as parameters and it copies the referred region to buffer B at point and lets me edit it at either place with all the edits made in buffer B's relevant region mirrored to buffer A's relevant region and vica versa.
The documentation string for the command text-clone-create:
(text-clone-create START END &optional SPREADP SYNTAX)
Create a text clone of START...END at point. Text clones are chunks of text that are automatically kept identical: changes done to one of the clones will be immediately propagated to the other.
The buffer’s content at point is assumed to be already identical to the one between START and END. If SYNTAX is provided it’s a regexp that describes the possible text of the clones; the clone will be shrunk or killed if necessary to ensure that its text matches the regexp. If SPREADP is non-nil it indicates that text inserted before/after the clone should be incorporated in the clone.
Note, that you must copy the text as the first action yourself.
Pityingly, the original version only works for one buffer. But it is easy to fix it for the case that original and clone do not have the same buffer. In the following Elisp code I marked the changed lines with ;;< Tobias.
There is also an interactive helper command my-clone in the code.
my-clone RET. Emacs goes into recursive-edit state.recursive-edit with C-M-c.(defvar text-clone--maintaining nil)
(defun my-text-clone--maintain (ol1 after beg end &optional _len)
"Propagate the changes made under the overlay OL1 to the other clones.
This is used on the `modification-hooks' property of text clones."
(when (and after (not undo-in-progress)
(not text-clone--maintaining)
(overlay-start ol1))
(let ((margin (if (overlay-get ol1 'text-clone-spreadp) 1 0)))
(setq beg (max beg (+ (overlay-start ol1) margin)))
(setq end (min end (- (overlay-end ol1) margin)))
(when (<= beg end)
(save-excursion
(when (overlay-get ol1 'text-clone-syntax)
;; Check content of the clone's text.
(let ((cbeg (+ (overlay-start ol1) margin))
(cend (- (overlay-end ol1) margin)))
(goto-char cbeg)
(save-match-data
(if (not (re-search-forward
(overlay-get ol1 'text-clone-syntax) cend t))
;; Mark the overlay for deletion.
(setq end cbeg)
(when (< (match-end 0) cend)
;; Shrink the clone at its end.
(setq end (min end (match-end 0)))
(move-overlay ol1 (overlay-start ol1)
(+ (match-end 0) margin)))
(when (> (match-beginning 0) cbeg)
;; Shrink the clone at its beginning.
(setq beg (max (match-beginning 0) beg))
(move-overlay ol1 (- (match-beginning 0) margin)
(overlay-end ol1)))))))
;; Now go ahead and update the clones.
(let ((head (- beg (overlay-start ol1)))
(tail (- (overlay-end ol1) end))
(str (buffer-substring beg end))
(nothing-left t)
(text-clone--maintaining t))
(dolist (ol2 (overlay-get ol1 'text-clones))
(with-current-buffer (overlay-buffer ol2) ;;< Tobias
(let ((oe (overlay-end ol2)))
(unless (or (eq ol1 ol2) (null oe))
(setq nothing-left nil)
(let ((mod-beg (+ (overlay-start ol2) head)))
;;(overlay-put ol2 'modification-hooks nil)
(goto-char (- (overlay-end ol2) tail))
(unless (> mod-beg (point))
(save-excursion (insert str))
(delete-region mod-beg (point)))
;;(overlay-put ol2 'modification-hooks '(text-clone--maintain))
)))))
(if nothing-left (delete-overlay ol1))))))))
(defun my-text-clone-create (start end &optional spreadp syntax)
"Create a text clone of START...END at point.
Text clones are chunks of text that are automatically kept identical:
changes done to one of the clones will be immediately propagated to the other.
The buffer's content at point is assumed to be already identical to
the one between START and END.
If SYNTAX is provided it's a regexp that describes the possible text of
the clones; the clone will be shrunk or killed if necessary to ensure that
its text matches the regexp.
If SPREADP is non-nil it indicates that text inserted before/after the
clone should be incorporated in the clone."
;; To deal with SPREADP we can either use an overlay with `nil t' along
;; with insert-(behind|in-front-of)-hooks or use a slightly larger overlay
;; (with a one-char margin at each end) with `t nil'.
;; We opted for a larger overlay because it behaves better in the case
;; where the clone is reduced to the empty string (we want the overlay to
;; stay when the clone's content is the empty string and we want to use
;; `evaporate' to make sure those overlays get deleted when needed).
;;
(let* ((clone-buf (or (and (markerp start) (marker-buffer start))
(current-buffer)))
(pt-end (+ (point) (- end start)))
(start-margin (if (or (not spreadp) (bobp) (with-current-buffer clone-buf (<= start (point-min))))
0 1))
(end-margin (if (or (not spreadp)
(>= pt-end (point-max))
(with-current-buffer clone-buf (>= start (point-max))))
0 1))
;; FIXME: Reuse overlays at point to extend dups!
(ol1 (make-overlay (- start start-margin) (+ end end-margin) clone-buf t)) ;;< Tobias
(ol2 (make-overlay (- (point) start-margin) (+ pt-end end-margin) nil t))
(dups (list ol1 ol2)))
(overlay-put ol1 'modification-hooks '(my-text-clone--maintain)) ;;< Tobias
(when spreadp (overlay-put ol1 'text-clone-spreadp t))
(when syntax (overlay-put ol1 'text-clone-syntax syntax))
;;(overlay-put ol1 'face 'underline)
(overlay-put ol1 'evaporate t)
(overlay-put ol1 'text-clones dups)
;;
(overlay-put ol2 'modification-hooks '(my-text-clone--maintain)) ;;< Tobias
(when spreadp (overlay-put ol2 'text-clone-spreadp t))
(when syntax (overlay-put ol2 'text-clone-syntax syntax))
;;(overlay-put ol2 'face 'underline)
(overlay-put ol2 'evaporate t)
(overlay-put ol2 'text-clones dups)))
(defun my-clone (b e pt)
"Clone region from B to E at PT.
B, E, and PT can be markers."
(interactive (list
(region-beginning)
(region-end)
(save-excursion
(message "Choose clone position and finish with C-M-c.")
(recursive-edit)
(set-marker (make-marker) (point))
)))
(let ((b-mark (set-marker (make-marker) b))
(e-mark (set-marker (make-marker) e))
(txt (buffer-substring b e)))
(with-current-buffer (or (and (markerp pt) (marker-buffer pt))
(current-buffer))
(goto-char pt)
(insert txt)
(goto-char pt)
(my-text-clone-create b-mark e-mark))))
multifiles which I used with some success.
my-text-clone-create that I just corrected. Now, modifications in the original region and changes in the clone are replicated in the respective other region.
make-indirect-buffer + narrow-to-region you cannot collect regions from a collection of buffers within one buffer and edit them there. That is possible with my-text-clone-create. (That is one of my use-cases with multifiles.)