From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Tino Calancha Newsgroups: gmane.emacs.bugs Subject: bug#31697: 27.0.50; Add new macro dolist-with-progress-reporter Date: Sun, 03 Jun 2018 23:00:02 +0900 Message-ID: <87vab03r8d.fsf@gmail.com> References: <8736y457ty.fsf@gmail.com> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: blaine.gmane.org 1528034351 11236 195.159.176.226 (3 Jun 2018 13:59:11 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sun, 3 Jun 2018 13:59:11 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) Cc: stefan monnier , Noam Postavsky To: 31697@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sun Jun 03 15:59:07 2018 Return-path: Envelope-to: geb-bug-gnu-emacs@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 1fPTXG-0002mb-L1 for geb-bug-gnu-emacs@m.gmane.org; Sun, 03 Jun 2018 15:59:06 +0200 Original-Received: from localhost ([::1]:35420 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fPTZL-00025o-RG for geb-bug-gnu-emacs@m.gmane.org; Sun, 03 Jun 2018 10:01:15 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:47736) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fPTZC-00025g-Hu for bug-gnu-emacs@gnu.org; Sun, 03 Jun 2018 10:01:09 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fPTZ8-0005aJ-Gy for bug-gnu-emacs@gnu.org; Sun, 03 Jun 2018 10:01:06 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:52514) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1fPTZ8-0005aC-C2 for bug-gnu-emacs@gnu.org; Sun, 03 Jun 2018 10:01:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1fPTZ7-0006Yf-V4 for bug-gnu-emacs@gnu.org; Sun, 03 Jun 2018 10:01:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Tino Calancha Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 03 Jun 2018 14:01:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 31697 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 31697-submit@debbugs.gnu.org id=B31697.152803441425147 (code B ref 31697); Sun, 03 Jun 2018 14:01:01 +0000 Original-Received: (at 31697) by debbugs.gnu.org; 3 Jun 2018 14:00:14 +0000 Original-Received: from localhost ([127.0.0.1]:60411 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fPTYL-0006XX-K8 for submit@debbugs.gnu.org; Sun, 03 Jun 2018 10:00:13 -0400 Original-Received: from mail-pl0-f51.google.com ([209.85.160.51]:38869) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fPTYJ-0006WS-G8 for 31697@debbugs.gnu.org; Sun, 03 Jun 2018 10:00:11 -0400 Original-Received: by mail-pl0-f51.google.com with SMTP id b14-v6so882083pls.5 for <31697@debbugs.gnu.org>; Sun, 03 Jun 2018 07:00:11 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=1bUomIvrkhR6K+Ft5Z0vf3p9pzHyQUYrwuSn/Shbs+o=; b=eHXmG9Nqw5SDbzg2iPWuLuDo0EqW3ej+ycK8ZaSfhX7PrTF4U4g0/21m136sUgQNJg 0xxdYzjBpfXxKFaAEFocb2vcPb33YcENl7lJqCpPlYzO382vYSQEEKvhG0OIyrweHpm8 fe12Nf+h52iP7wI4p/pzuRSuCKwgwKlPBDdO/qc8xuC9jsvomqww8o9JEflLbd9/VrX6 GfevsOStBzWpm8qgkPZFrLq0z6VMqsewZ+ZKQDOivIKAVXG1wYdcUp6K3v7D0YBdjS3D bXaketUvYlx/XWlTyUYhVNhWTxHKbSNmeCNrbCeEA8UoLb9MswpLiLfJzoOjsw15mmMZ kuRQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=1bUomIvrkhR6K+Ft5Z0vf3p9pzHyQUYrwuSn/Shbs+o=; b=ZFFP1rRtV1g/dXbdFQWIugTZFbQ8Z5ij5vL8+IV9NqCSLcfFl4uVwemerL0MEVjeM+ dBlu/uOuZR0ov6fkzU4OCNhdcTWZCnwTZW23Fp4AoUwQ/rMOyVAuoCzjnX3iwQi/w70c t+rxQCpObpiy7aVSiQvW/et3PFxiWaaoZXvfKQ5z2IA95YOX13GM3Ai0XkLblDLuIYtG +trTJC/B0uhHQKQkSSYYo22EBNYrEWLe3kgRpIxqsABl5BwulauPPyI0QzaMGxOSLY5S rXGi+MJT10HmFKoOlq3z9uMfmagZ5AmPGwUFNH8oy0l+Xa8/g8oHTzjYAzPX1vdVyhLA p3RA== X-Gm-Message-State: APt69E02vVuFhBZXqOnFprfBh3NvPorhlTfOBOUHZ9iN1BtN3Vyoca/1 ZIGxrOwzu11kCseSPvwncrA= X-Google-Smtp-Source: ADUXVKJlVJBEFzp6jxacj6oyxChe93w4hK+3ThUCtQ2FaHfRucMEizPLhicpuUqHiS+G2/tYZzKDgQ== X-Received: by 2002:a17:902:8206:: with SMTP id x6-v6mr1252303pln.220.1528034405716; Sun, 03 Jun 2018 07:00:05 -0700 (PDT) Original-Received: from calancha-pc (228.225.128.101.dy.bbexcite.jp. [101.128.225.228]) by smtp.gmail.com with ESMTPSA id q24-v6sm17584330pfh.26.2018.06.03.07.00.04 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Sun, 03 Jun 2018 07:00:05 -0700 (PDT) In-Reply-To: <8736y457ty.fsf@gmail.com> (Tino Calancha's message of "Sun, 03 Jun 2018 22:16:09 +0900") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:146904 Archived-At: Tino Calancha writes: > + (declare (indent 2) (debug ((symbolp form &optional form) form body))) > + (let ((prep (make-symbol "--dolist-progress-reporter--")) > + (count (make-symbol "--dolist-count--"))) > + `(let ((,prep ,reporter-or-message) > + (,count 0)) > + (when (stringp ,prep) > + (setq ,prep (make-progress-reporter ,prep 0 (1- (length ,(cadr spec)))))) > + (dolist ,spec > + ,@body > + (progress-reporter-update ,prep (setq ,count (1+ ,count)))) > + (progress-reporter-done ,prep) > + (or ,@(cdr (cdr spec)) nil)))) As pointed out by Noam in Bug#31696, I am also evaluating twice here the form at (nth 1 SPEC). I must add another variable. Here is the updated patch. --8<-----------------------------cut here---------------start------------->8--- commit 0cd28b8a33fcd1c5e348af67462257b707b79bad Author: Tino Calancha Date: Sun Jun 3 22:56:02 2018 +0900 Add new macro dolist-with-progress-reporter * lisp/subr.el (dolist-with-progress-reporter): New macro (Bug#31697). * lisp/cus-edit.el (custom-group-value-create): Use it. * lisp/dabbrev.el (dabbrev--progress-reporter): Delete variable. (dabbrev--find-expansion): Use dotimes-with-progress-reporter. * doc/lispref/display.texi: Document the macro ; * etc/NEWS: Announce it. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index ce7ec3ac10..dd1d1e80e9 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -485,6 +485,12 @@ Progress @end example @end defmac +@defmac dolist-with-progress-reporter (var count [result]) reporter-or-message body@dots{} +This is another convenience macro that works the same way as @code{dolist} +does, but also reports loop progress using the functions described +above. +@end defmac + @node Logging Messages @subsection Logging Messages in @file{*Messages*} @cindex logging echo-area messages diff --git a/etc/NEWS b/etc/NEWS index 1b324986d9..16e2d6d752 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -562,6 +562,8 @@ manual for more details. * Lisp Changes in Emacs 27.1 +++ +** New macro dolist-with-progress-reporter. ++++ ** New function assoc-delete-all. +++ diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index a12897e799..c227bb0a26 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -4221,19 +4221,14 @@ custom-group-value-create custom-buffer-order-groups)) (prefixes (widget-get widget :custom-prefixes)) (custom-prefix-list (custom-prefix-add symbol prefixes)) - (len (length members)) - (count 0) - (reporter (make-progress-reporter - "Creating group entries..." 0 len)) (have-subtitle (and (not (eq symbol 'emacs)) (eq custom-buffer-order-groups 'last))) prev-type children) - (dolist (entry members) + (dolist-with-progress-reporter (entry members) "Creating group entries..." (unless (eq prev-type 'custom-group) (widget-insert "\n")) - (progress-reporter-update reporter (setq count (1+ count))) (let ((sym (nth 0 entry)) (type (nth 1 entry))) (when (and have-subtitle (eq type 'custom-group)) @@ -4255,8 +4250,7 @@ custom-group-value-create (setq children (nreverse children)) (mapc 'custom-magic-reset children) (widget-put widget :children children) - (custom-group-state-update widget) - (progress-reporter-done reporter)) + (custom-group-state-update widget)) ;; End line (let ((p (1+ (point)))) (insert "\n\n") diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index 57ee9a526a..4af22e6140 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -327,9 +327,6 @@ dabbrev--check-other-buffers ;; The regexp for recognizing a character in an abbreviation. (defvar dabbrev--abbrev-char-regexp nil) -;; The progress reporter for buffer-scanning progress. -(defvar dabbrev--progress-reporter nil) - ;;---------------------------------------------------------------- ;; Macros ;;---------------------------------------------------------------- @@ -739,21 +736,19 @@ dabbrev--find-expansion ;; Put that list in dabbrev--friend-buffer-list. (unless dabbrev--friend-buffer-list (setq dabbrev--friend-buffer-list - (dabbrev--make-friend-buffer-list)) - (setq dabbrev--progress-reporter - (make-progress-reporter - "Scanning for dabbrevs..." - (- (length dabbrev--friend-buffer-list)) 0 0 1 1.5)))) + (dabbrev--make-friend-buffer-list)))) ;; Walk through the buffers till we find a match. (let (expansion) - (while (and (not expansion) dabbrev--friend-buffer-list) + (dolist-with-progress-reporter + (_ dabbrev--friend-buffer-list) + (make-progress-reporter + "Scanning for dabbrevs..." + 0 (length dabbrev--friend-buffer-list) 0 1 1.5) (setq dabbrev--last-buffer (pop dabbrev--friend-buffer-list)) (set-buffer dabbrev--last-buffer) - (progress-reporter-update dabbrev--progress-reporter - (- (length dabbrev--friend-buffer-list))) (setq dabbrev--last-expansion-location (point-min)) - (setq expansion (dabbrev--try-find abbrev nil 1 ignore-case))) - (progress-reporter-done dabbrev--progress-reporter) + (setq expansion (dabbrev--try-find abbrev nil 1 ignore-case)) + (unless expansion (setq dabbrev--friend-buffer-list '()))) expansion))))) ;; Compute the list of buffers to scan. diff --git a/lisp/subr.el b/lisp/subr.el index 914112ccef..0a4de8365f 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5039,6 +5039,33 @@ dotimes-with-progress-reporter (setq ,(car spec) (1+ ,(car spec))))) (progress-reporter-done ,temp2) nil ,@(cdr (cdr spec))))) +(defmacro dolist-with-progress-reporter (spec reporter-or-message &rest body) + "Loop over a list and report progress in the echo area. +Evaluate BODY with VAR bound to each car from LIST, in turn. +Then evaluate RESULT to get return value, default nil. + +REPORTER-OR-MESSAGE is a progress reporter object or a string. In the latter +case, use this string to create a progress reporter. + +At each iteration, print the reporter message followed by progress +percentage in the echo area. After the loop is finished, +print the reporter message followed by word \"done\". + +\(fn (VAR LIST [RESULT]) MESSAGE BODY...)" + (declare (indent 2) (debug ((symbolp form &optional form) form body))) + (let ((prep (make-symbol "--dolist-progress-reporter--")) + (count (make-symbol "--dolist-count--")) + (list (make-symbol "--dolist-list--"))) + `(let ((,prep ,reporter-or-message) + (,count 0) + (,list ,(cadr spec))) + (when (stringp ,prep) + (setq ,prep (make-progress-reporter ,prep 0 (1- (length ,list))))) + (dolist (,(car spec) ,list) + ,@body + (progress-reporter-update ,prep (setq ,count (1+ ,count)))) + (progress-reporter-done ,prep) + (or ,@(cdr (cdr spec)) nil)))) ;;;; Comparing version strings. --8<-----------------------------cut here---------------end--------------->8---