Re: An idea: combine-change-calls

[Alan Mackenzie <acm@muc.de>]

Hello, Stefan.

On Fri, Mar 30, 2018 at 11:05:24 -0400, Stefan Monnier wrote:
> > (defun wrap-and-run-primitive-undo (beg end list)
> >   (let ((old-bul buffer-undo-list)
> > 	(end-marker (copy-marker end)))

> I'd have expected it to start with:

>     (defun wrap-and-run-primitive-undo (beg end list)
>       (combine-change-calls

That's a refinement I haven't managed to get around to, yet.

> also this is an internal function that will only be useful for
> combine-change-calls, so it needs to have a "--" in its name.

DONE.

> >     (let ((inhibit-modification-hooks t))
> >       (funcall #'primitive-undo 1 list))

> I think you want something like

>     (while list
>       (setq list (primitive-undo 1 list))

Indeed so.  (funcall #'...) is stupid.

> in case there are some undo-boundaries in `list`.

> > (defmacro combine-change-calls (beg end &rest forms)
> >   `(let ((-beg- ,beg)

> It now occurs to me that it's probable preferable to do:

>     (defmacro combine-change-calls (beg end &rest forms)
>       `(combine-change-calls-function ,beg ,end (lambda () ,@forms)))

DONE, at least with the name combine-change-calls-1.  I don't really
like "...-function", since that suggests a hook variable.

> and then

>     (defun combine-change-calls-function (beg rest body)
>       ... do the heavy lifting here ...)

DONE.

> > 	       (while (not (eq (cdr ptr) old-bul))
> > 		 (setq ptr (cdr ptr)))

> This can inf-loop if the new buffer-undo-list happens not to be an
> extension of the old list any more.

Not only can, but does.  I spent around 2 hours yesterday waiting for
this infinite loop to terminate.  ;-(  It is, of course, garbage
collection which lops off the element we're looking for, particularly
when commenting out a large region.

[ .... ]

I have also been optimising (or, more accurately, de-pessimizing) CC
Mode to cope better with large blocks of comments.  Together with
combine-change-calls on {,un}comment-region, comment-region now takes
0.4 seconds to comment out Nil Geisweiller's (the OP of bug #30735) 2500
line test file.  Undo takes even less time.  His original complaint was
of a time of 10 minutes.  C-c C-c on xdisp.c takes around 8 seconds
(though I don't recommend you to try this yourself before I've committed
these CC Mode changes.  ;-)

So, I think this exercise is worthwhile.  I have added some doc strings
to the functions.  I have introduced a variable to hinder a "recursive"
undo--wrap-and-run-primitive-undo appearing in the undo list.  This
happened with uncomment-region calling comment-region.

Sometimes, point ends up at the wrong place after an undo (probably
because of primitive-undo removing POSITION elements from undo-lists, as
we've already discussed.)

If you want to try this out yourself, here are the versions of
{,un}comment-region I've been using for testing:

(defun comment-region (beg end &optional arg)
  "Comment or uncomment each line in the region.
With just \\[universal-argument] prefix arg, uncomment each line in region BEG .. END.
Numeric prefix ARG means use ARG comment characters.
If ARG is negative, delete that many comment characters instead.

The strings used as comment starts are built from `comment-start'
and `comment-padding'; the strings used as comment ends are built
from `comment-end' and `comment-padding'.

By default, the `comment-start' markers are inserted at the
current indentation of the region, and comments are terminated on
each line (even for syntaxes in which newline does not end the
comment and blank lines do not get comments).  This can be
changed with `comment-style'."
  (interactive "*r\nP")
  (comment-normalize-vars)
  (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
  (save-excursion
    ;; FIXME: maybe we should call uncomment depending on ARG.
    (combine-change-calls beg end
                          (funcall comment-region-function beg end arg))))

(defun uncomment-region (beg end &optional arg)
  "Uncomment each line in the BEG .. END region.
The numeric prefix ARG can specify a number of chars to remove from the
comment markers."
  (interactive "*r\nP")
  (comment-normalize-vars)
  (when (> beg end) (setq beg (prog1 end (setq end beg))))
  ;; Bind `comment-use-global-state' to nil.  While uncommenting a region
  ;; (which works a line at a time), a comment can appear to be
  ;; included in a mult-line string, but it is actually not.
  (let ((comment-use-global-state nil))
    (save-excursion
      (combine-change-calls beg end
                            (funcall uncomment-region-function beg end arg)))))


And here is the current state of combine-change-calls itself:


(defvar undo--combining-change-calls nil
  "Non-nil when `combine-change-calls' is running.")

(defun undo--wrap-and-run-primitive-undo (beg end list)
  "Call `primitive-undo' on the undo elements in LIST.

This function is intended to be called purely by `undo' as the
function in an \(apply DELTA BEG END FUNNAME . ARGS) undo
element.  It invokes `before-change-functions' and
`after-change-functions' once each for the entire region \(BEG
END) rather than once for each individual change.

Additionally the fresh \"redo\" elements which are generated on
`buffer-undo-list' will themselves be \"enclosed\" in
`undo--wrap-and-run-primitive-undo'.

Undo elements of this form are generated by the macro
`combine-change-calls'."
  (let ((old-bul buffer-undo-list)
	(end-marker (copy-marker end)))
    (if (not inhibit-modification-hooks)
	(run-hook-with-args 'before-change-functions beg end))
    (let ((inhibit-modification-hooks t))
      (while list
	(setq list (primitive-undo 1 list))))
    (unless (eq buffer-undo-list t)
      (let ((ap-elt
	     (list 'apply
		   (- end end-marker)
		   beg
		   (marker-position end-marker)
		   #'undo--wrap-and-run-primitive-undo
		   beg (marker-position end-marker) buffer-undo-list))
	    (ptr buffer-undo-list))
	(if (not (eq buffer-undo-list old-bul))
	    (progn
	      (while (and (cdr ptr)
			  (not (eq (cdr ptr) old-bul)))
		(setq ptr (cdr ptr)))
	      (unless (cdr ptr)
		(message "w-a-r-p-undo: buffer-undo-list broken"))
	      (setcdr ptr nil)
	      (push ap-elt buffer-undo-list)
	      (setcdr buffer-undo-list old-bul)))))
    (if (not inhibit-modification-hooks)
	(run-hook-with-args 'after-change-functions
			    beg (marker-position end-marker)
			    (- end beg)))))
	  
(defun combine-change-calls-1 (beg end body)
  "Evaluate BODY, running the change hooks just once, for region \(BEG END).

Firstly, `before-change-functions' is invoked for the region
\(BEG END), then BODY (a function) is evaluated with
`inhibit-modification-hooks' non-nil, then finally
`after-change-functions' is invoked on the updated region (BEG
NEW-END) with a calculated OLD-LEN argument.  If
`inhibit-modification-hooks' is initially non-nil, the change
hooks are not run.

The result of `comebine-change-calls-1' is the value returned by
BODY.  BODY must not make a different buffer current, except
temporarily.  It must not make any changes to the buffer outside
the specified region.

Additionally, the buffer modifications of BODY are recorded on
the buffer's undo list as a single \(apply ...) entry containing
the function `undo--wrap-and-run-primitive-undo'."
  (let ((old-bul buffer-undo-list)
	(end-marker (copy-marker end)))
    (if undo--combining-change-calls
	(funcall body)
      (let ((undo--combining-change-calls t))
	(if (not inhibit-modification-hooks)
	    (run-hook-with-args 'before-change-functions beg end))
	(prog1
	    (if (eq buffer-undo-list t)
		(progn
		  (funcall body)
		  (if (not inhibit-modification-hooks)
		      (run-hook-with-args 'after-change-functions
					  beg (marker-position end-marker)
					  (- end beg))))
	      (prog1
		  (let ((inhibit-modification-hooks t))
		    (funcall body))
		(let ((ap-elt
		       (list 'apply
			     (- end end-marker)
			     beg
			     (marker-position end-marker)
			     #'undo--wrap-and-run-primitive-undo
			     beg (marker-position end-marker) buffer-undo-list))
		      (ptr buffer-undo-list))
		  (if (not (eq buffer-undo-list old-bul))
		      (progn
			(while (and (cdr ptr)
				    (not (eq (cdr ptr) old-bul)))
			  (setq ptr (cdr ptr)))
			(unless (cdr ptr)
			  (message "combine-change-calls: buffer-undo-list broken"))
			(setcdr ptr nil)
			(push ap-elt buffer-undo-list)
			(setcdr buffer-undo-list old-bul))))))
	  (if (not inhibit-modification-hooks)
	      (run-hook-with-args 'after-change-functions
				  beg (marker-position end-marker)
				  (- end beg)))
	  (setq end-marker nil))))))

(defmacro combine-change-calls (beg end &rest forms)
  "Evaluate FORMS, running the change hooks just once.

Firstly, `before-change-functions' is invoked for the region
\(BEG END), then the FORMS are evaluated with
`inhibit-modification-hooks' non-nil, and finally
`after-change-functions' is invoked on the updated region.  The
change hooks are not run if `inhibit-modification-hooks' is
non-nil.

The result of `combine-change-calls' is the value returned by the
last of the FORMS to be evaluated.  FORMS may not make a
different buffer current, except temporarily.  FORMS may not
change the buffer outside the specified region.

Additionally, the buffer modifications of BODY are recorded on
the buffer's undo list as a single \(apply ...) entry containing
the function `undo--wrap-and-run-primitive-undo'. "
  `(combine-change-calls-1 ,beg ,end (lambda () ,@forms)))



>         Stefan

-- 
Alan Mackenzie (Nuremberg, Germany).