From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Alan Mackenzie Newsgroups: gmane.emacs.devel Subject: Re: An idea: combine-change-calls Date: Sat, 31 Mar 2018 21:00:52 +0000 Message-ID: <20180331210052.GB5003@ACM> References: <20180327194507.GD4105@ACM> <20180328204254.GC6592@ACM> <20180329151033.GA5213@ACM> <20180329171101.GB5213@ACM> <20180330114636.GA5432@ACM> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: blaine.gmane.org 1522530034 29564 195.159.176.226 (31 Mar 2018 21:00:34 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sat, 31 Mar 2018 21:00:34 +0000 (UTC) User-Agent: Mutt/1.7.2 (2016-11-26) Cc: emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sat Mar 31 23:00:30 2018 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1f2Nbx-0007ao-BB for ged-emacs-devel@m.gmane.org; Sat, 31 Mar 2018 23:00:29 +0200 Original-Received: from localhost ([::1]:54577 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1f2Ne0-00075C-UU for ged-emacs-devel@m.gmane.org; Sat, 31 Mar 2018 17:02:37 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:53256) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1f2Nce-00073H-IW for emacs-devel@gnu.org; Sat, 31 Mar 2018 17:01:14 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1f2Nca-0000gz-LG for emacs-devel@gnu.org; Sat, 31 Mar 2018 17:01:12 -0400 Original-Received: from colin.muc.de ([193.149.48.1]:10818 helo=mail.muc.de) by eggs.gnu.org with smtp (Exim 4.71) (envelope-from ) id 1f2Nca-0000az-9Q for emacs-devel@gnu.org; Sat, 31 Mar 2018 17:01:08 -0400 Original-Received: (qmail 96712 invoked by uid 3782); 31 Mar 2018 21:01:02 -0000 Original-Received: from acm.muc.de (p5B147D9E.dip0.t-ipconnect.de [91.20.125.158]) by colin.muc.de (tmda-ofmipd) with ESMTP; Sat, 31 Mar 2018 23:01:01 +0200 Original-Received: (qmail 5410 invoked by uid 1000); 31 Mar 2018 21:00:52 -0000 Content-Disposition: inline In-Reply-To: X-Delivery-Agent: TMDA/1.1.12 (Macallan) X-Primary-Address: acm@muc.de X-detected-operating-system: by eggs.gnu.org: FreeBSD 9.x [fuzzy] X-Received-From: 193.149.48.1 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:224210 Archived-At: 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).