From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: "Basil L. Contovounesios" Newsgroups: gmane.emacs.bugs Subject: bug#31211: 27.0.50; Pruning of command-history in command-execute is off by one Date: Wed, 18 Apr 2018 19:43:37 +0100 Message-ID: <87lgdk1hk6.fsf@tcd.ie> References: <87sh7s1hvv.fsf@tcd.ie> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1524076931 31223 195.159.176.226 (18 Apr 2018 18:42:11 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Wed, 18 Apr 2018 18:42:11 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) To: 31211@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Wed Apr 18 20:42: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 1f8s1u-00081Y-Sd for geb-bug-gnu-emacs@m.gmane.org; Wed, 18 Apr 2018 20:42:07 +0200 Original-Received: from localhost ([::1]:44377 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1f8s41-0008Ls-Kj for geb-bug-gnu-emacs@m.gmane.org; Wed, 18 Apr 2018 14:44:17 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:59346) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1f8s3p-0008Jv-Lz for bug-gnu-emacs@gnu.org; Wed, 18 Apr 2018 14:44:07 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1f8s3m-00057z-HV for bug-gnu-emacs@gnu.org; Wed, 18 Apr 2018 14:44:05 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:51675) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1f8s3m-00057q-90 for bug-gnu-emacs@gnu.org; Wed, 18 Apr 2018 14:44:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1f8s3l-0006qT-Vj for bug-gnu-emacs@gnu.org; Wed, 18 Apr 2018 14:44:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: "Basil L. Contovounesios" Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 18 Apr 2018 18:44:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 31211 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 31211-submit@debbugs.gnu.org id=B31211.152407702726280 (code B ref 31211); Wed, 18 Apr 2018 18:44:01 +0000 Original-Received: (at 31211) by debbugs.gnu.org; 18 Apr 2018 18:43:47 +0000 Original-Received: from localhost ([127.0.0.1]:59570 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1f8s3X-0006pm-6a for submit@debbugs.gnu.org; Wed, 18 Apr 2018 14:43:47 -0400 Original-Received: from mail-wr0-f170.google.com ([209.85.128.170]:36538) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1f8s3V-0006pU-5p for 31211@debbugs.gnu.org; Wed, 18 Apr 2018 14:43:45 -0400 Original-Received: by mail-wr0-f170.google.com with SMTP id q13-v6so7484631wre.3 for <31211@debbugs.gnu.org>; Wed, 18 Apr 2018 11:43:45 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=tcd-ie.20150623.gappssmtp.com; s=20150623; h=from:to:subject:references:mail-followup-to:date:in-reply-to :message-id:user-agent:mime-version; bh=EKOd790uo8EUWFS1ncM33LZ5mG2GB8HX3dnzioaKaZE=; b=Rr+tHP3uaTUioA9IaWn9Jk9dVyTrc2JPjaSIZj5xWOrOCzBFH3CRH12hyj/ZF0jLqu jIhmPw4d3xQadfUHFeWERD7o07vVoFLs1phlx/bS6QGaxI6qRnZ68NEkIc0IY+jyfT+n sEuirR9s4QBpgbOJI+MkVNLpdhrOETFgkBzfwYdveoszbyiWkrOvne+xG35nquZyQvK3 V1koldmtxU9SJm1DSs7eE29iV2DmovYSYp0nk3H9B1KAyy/p743rJzoVQGG1OhTHBBrq 2I8zm31TDIC7PsMB2OzKGJx//0TpKXa0oote8np3j288PaYMGmX9lTdzXbOQvy4YBDue Mkrg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:subject:references:mail-followup-to:date :in-reply-to:message-id:user-agent:mime-version; bh=EKOd790uo8EUWFS1ncM33LZ5mG2GB8HX3dnzioaKaZE=; b=c8h3GydBDoWSxzoGrg93+6duhP7RkgtQ0M7sx5wY6VcDaTcFjOqLTTkEGo5CLeutPL /GuewO0eSWlmMguQbNBVfZ9OzXvE0f6ex3vs7kX9yq5hpfEH6ybQvPbjqrKHMit/D21k IFHBVFmtKPLovNs4E1LrD5Ba/OMgsUlCYMdQCnYdPLdivU/IYFiD3KkdWlxRwv0YWIc4 GnZcSNEEONxWrqD/ZZQlYb4yHZDCvVkXKksBi3VKLURpGB0p8qqF86cn1ow87EJ3XD11 uNsiWv/YdsNEtGYE+7C55Uh4vTh7GV/WH0avT0wlKHIrfxeDeqm0S7OnOWIJmbyTJEpk hJnA== X-Gm-Message-State: ALQs6tCM7IhMj5qIOgcWWxIbXZXdf5hjDqBQZFRpUU7r+qr96+t/i0QJ I3oaejZ5zT6f/DlTLIT9ON4nHapq X-Google-Smtp-Source: AIpwx4+nXOm2ZWo3gY0DamoOFQ6v+tneY1RY/hmQaoZvVmUJ9Oc0yF2AeQledqVzlmzdAyPnxoKTAw== X-Received: by 10.80.163.37 with SMTP id 34mr4654988edn.47.1524077019339; Wed, 18 Apr 2018 11:43:39 -0700 (PDT) Original-Received: from localhost ([213.233.149.31]) by smtp.gmail.com with ESMTPSA id x29sm612638edm.26.2018.04.18.11.43.38 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 18 Apr 2018 11:43:38 -0700 (PDT) Mail-Followup-To: 31211@debbugs.gnu.org In-Reply-To: <87sh7s1hvv.fsf@tcd.ie> (Basil L. Contovounesios's message of "Wed, 18 Apr 2018 19:36:36 +0100") 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:145581 Archived-At: --=-=-= Content-Type: text/plain tags 31211 patch quit --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Improve-simple.el-history-and-ring-pruning.patch >From 6619bb2ace89143b5194af755928bac2157fcd70 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 18 Apr 2018 18:13:26 +0100 Subject: [PATCH 1/2] Improve simple.el history and ring pruning * lisp/simple.el (command-execute): Fix off-by-one error in command-history pruning. (bug#31211) (kill-new, push-mark): Prune kill-ring, mark-ring and global-mark-ring in a single pass, as add-to-history does. --- lisp/simple.el | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index b51be3a8f8..f7f8da87ad 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1894,8 +1894,8 @@ command-execute (push `(execute-kbd-macro ,final ,prefixarg) command-history) ;; Don't keep command history around forever. (when (and (numberp history-length) (> history-length 0)) - (let ((cell (nthcdr history-length command-history))) - (if (consp cell) (setcdr cell nil))))) + (let ((tail (nthcdr (1- history-length) command-history))) + (when (cdr tail) (setcdr tail ()))))) (execute-kbd-macro final prefixarg)) (t ;; Pass `cmd' rather than `final', for the backtrace's sake. @@ -4396,8 +4396,8 @@ kill-new (if (and replace kill-ring) (setcar kill-ring string) (push string kill-ring) - (if (> (length kill-ring) kill-ring-max) - (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))) + (let ((tail (nthcdr (1- kill-ring-max) kill-ring))) + (when (cdr tail) (setcdr tail ()))))) (setq kill-ring-yank-pointer kill-ring) (if interprogram-cut-function (funcall interprogram-cut-function string))) @@ -5705,9 +5705,10 @@ push-mark In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil." (unless (null (mark t)) (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring)) - (when (> (length mark-ring) mark-ring-max) - (move-marker (car (nthcdr mark-ring-max mark-ring)) nil) - (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))) + (let ((tail (nthcdr (1- mark-ring-max) mark-ring))) + (when (cdr tail) + (set-marker (cadr tail) nil) + (setcdr tail ())))) (set-marker (mark-marker) (or location (point)) (current-buffer)) ;; Now push the mark on the global mark ring. (if (and global-mark-ring @@ -5716,9 +5717,10 @@ push-mark ;; Don't push another one. nil (setq global-mark-ring (cons (copy-marker (mark-marker)) global-mark-ring)) - (when (> (length global-mark-ring) global-mark-ring-max) - (move-marker (car (nthcdr global-mark-ring-max global-mark-ring)) nil) - (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil))) + (let ((tail (nthcdr (1- global-mark-ring-max) global-mark-ring))) + (when (cdr tail) + (set-marker (cadr tail) nil) + (setcdr tail ())))) (or nomsg executing-kbd-macro (> (minibuffer-depth) 0) (message "Mark set")) (if (or activate (not transient-mark-mode)) -- 2.17.0 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0002-Minor-simple.el-simplifications-bug-31211.patch >From f9f118d46a065e9a1482300d6879a7d0163921f2 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 18 Apr 2018 17:45:35 +0100 Subject: [PATCH 2/2] Minor simple.el simplifications (bug#31211) * lisp/simple.el (kill-append, push-mark, pop-mark): Simplify conditionals and surrounding code. --- lisp/simple.el | 48 +++++++++++++++++++++++------------------------- 1 file changed, 23 insertions(+), 25 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index f7f8da87ad..0d9abf342b 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -4418,18 +4418,18 @@ kill-append If `interprogram-cut-function' is set, pass the resulting kill to it." (let* ((cur (car kill-ring))) (kill-new (if before-p (concat string cur) (concat cur string)) - (or (= (length cur) 0) - (equal nil (get-text-property 0 'yank-handler cur)))) - (when (and kill-append-merge-undo (not buffer-read-only)) - (let ((prev buffer-undo-list) - (next (cdr buffer-undo-list))) - ;; find the next undo boundary - (while (car next) - (pop next) - (pop prev)) - ;; remove this undo boundary - (when prev - (setcdr prev (cdr next))))))) + (or (string= cur "") + (null (get-text-property 0 'yank-handler cur))))) + (when (and kill-append-merge-undo (not buffer-read-only)) + (let ((prev buffer-undo-list) + (next (cdr buffer-undo-list))) + ;; Find the next undo boundary. + (while (car next) + (pop next) + (pop prev)) + ;; Remove this undo boundary. + (when prev + (setcdr prev (cdr next)))))) (defcustom yank-pop-change-selection nil "Whether rotating the kill ring changes the window system selection. @@ -5703,20 +5703,18 @@ push-mark purposes. See the documentation of `set-mark' for more information. In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil." - (unless (null (mark t)) - (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring)) + (when (mark t) + (push (copy-marker (mark-marker)) mark-ring) (let ((tail (nthcdr (1- mark-ring-max) mark-ring))) (when (cdr tail) (set-marker (cadr tail) nil) (setcdr tail ())))) (set-marker (mark-marker) (or location (point)) (current-buffer)) - ;; Now push the mark on the global mark ring. - (if (and global-mark-ring - (eq (marker-buffer (car global-mark-ring)) (current-buffer))) - ;; The last global mark pushed was in this same buffer. - ;; Don't push another one. - nil - (setq global-mark-ring (cons (copy-marker (mark-marker)) global-mark-ring)) + ;; Don't push the mark on the global mark ring if the last global + ;; mark pushed was in this same buffer. + (unless (and global-mark-ring + (eq (marker-buffer (car global-mark-ring)) (current-buffer))) + (push (copy-marker (mark-marker)) global-mark-ring) (let ((tail (nthcdr (1- global-mark-ring-max) global-mark-ring))) (when (cdr tail) (set-marker (cadr tail) nil) @@ -5732,10 +5730,10 @@ pop-mark Does not set point. Does nothing if mark ring is empty." (when mark-ring (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker))))) - (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer)) - (move-marker (car mark-ring) nil) - (if (null (mark t)) (ding)) - (setq mark-ring (cdr mark-ring))) + (set-marker (mark-marker) (marker-position (car mark-ring))) + (set-marker (car mark-ring) nil) + (unless (mark t) (ding)) + (pop mark-ring)) (deactivate-mark)) (define-obsolete-function-alias -- 2.17.0 --=-=-= Content-Type: text/plain "Basil L. Contovounesios" writes: > Patch addressing this to follow. I attach two patches. The first likens the history and ring pruning in command-execute, kill-new, and push-mark to that in add-to-history, thus also fixing the off-by-one error in command-execute. The second suggests some minor refactors/simplifications in surrounding functions. Thanks, -- Basil --=-=-=--