From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Joost Kremers Newsgroups: gmane.emacs.bugs Subject: bug#70664: 29.3; vtable-insert-object cannot insert at top of table Date: Thu, 09 May 2024 18:45:52 +0200 Message-ID: <861q6b7x33.fsf@fastmail.fm> References: <86o79rb3js.fsf@p200300d6272f17850b27304eb886326a.dip0.t-ipconnect.de> <864jbjqc0n.fsf@gnu.org> <8634r0yacn.fsf@p200300d6272c85ce335985c3abedb491.dip0.t-ipconnect.de> <6affc493-a048-465d-a237-afa03896d892@alphapapa.net> <86frv0frp6.fsf@p200300d6272c85ce335985c3abedb491.dip0.t-ipconnect.de> <9333046c-194c-4b59-895a-2bf8427a6135@alphapapa.net> <868r0levw7.fsf@fastmail.fm> <868r0j74qi.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="39413"; mail-complaints-to="usenet@ciao.gmane.io" Cc: adam@alphapapa.net, 70664@debbugs.gnu.org To: Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Thu May 09 18:46:44 2024 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1s56uo-0009vP-2q for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 09 May 2024 18:46:44 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1s56uk-0005EP-RV; Thu, 09 May 2024 12:46:38 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1s56ui-0005Dy-KY for bug-gnu-emacs@gnu.org; Thu, 09 May 2024 12:46:36 -0400 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1s56ui-0007G0-Af for bug-gnu-emacs@gnu.org; Thu, 09 May 2024 12:46:36 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1s56v8-0008Cs-4I for bug-gnu-emacs@gnu.org; Thu, 09 May 2024 12:47:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Joost Kremers Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 09 May 2024 16:47:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70664 X-GNU-PR-Package: emacs Original-Received: via spool by 70664-submit@debbugs.gnu.org id=B70664.171527319531529 (code B ref 70664); Thu, 09 May 2024 16:47:02 +0000 Original-Received: (at 70664) by debbugs.gnu.org; 9 May 2024 16:46:35 +0000 Original-Received: from localhost ([127.0.0.1]:56252 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1s56uh-0008CT-1H for submit@debbugs.gnu.org; Thu, 09 May 2024 12:46:35 -0400 Original-Received: from fhigh7-smtp.messagingengine.com ([103.168.172.158]:51479) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1s56ub-0008Bu-FU for 70664@debbugs.gnu.org; Thu, 09 May 2024 12:46:33 -0400 Original-Received: from compute7.internal (compute7.nyi.internal [10.202.2.48]) by mailfhigh.nyi.internal (Postfix) with ESMTP id 1CD711140078; Thu, 9 May 2024 12:45:58 -0400 (EDT) Original-Received: from mailfrontend2 ([10.202.2.163]) by compute7.internal (MEProxy); Thu, 09 May 2024 12:45:58 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=fastmail.fm; h= cc:cc:content-type:content-type:date:date:from:from:in-reply-to :in-reply-to:message-id:mime-version:references:reply-to:subject :subject:to:to; s=fm3; t=1715273158; x=1715359558; bh=mf787H2ZYV co41GZc9cDO/B13rTd6yC9BTvw+wfkIM8=; b=0cLUA8DQn6uxA2AuOTMi4Tp6/q QiVsOVAO1Au4+QYuom4QBURMVWDIMRu1cBKRsTuryMwUrq/8FFsuQRA1bls+U+4e zO+kiq+CSh5sfO6dmngEPHzFIKStAcmU40deOrOaEp/xA+ftD2z+fSrO/PDK5RBr NzZF7O96OMdfXoJXS0NrVx/yL4VRmWOi8UwYgSR6LV3XhZpvj07k07p1EY/oMAkU F6sGg0Uw8tFDMw6r98QD1TA1nQLe0w1KTE5c6gXR6AXXDT4HDkMI28HINm1fu1g+ VVjxNVq0kesHPYBfxB5y4KNwOmmEOxqK6sLuwHQoKJ0ixDPVy+kSqAtZGaEQ== DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d= messagingengine.com; h=cc:cc:content-type:content-type:date:date :feedback-id:feedback-id:from:from:in-reply-to:in-reply-to :message-id:mime-version:references:reply-to:subject:subject:to :to:x-me-proxy:x-me-proxy:x-me-sender:x-me-sender:x-sasl-enc; s= fm3; t=1715273158; x=1715359558; bh=mf787H2ZYVco41GZc9cDO/B13rTd 6yC9BTvw+wfkIM8=; b=Uwdil2dT+63Fjq1ifNiUjjTLxDJrak1MO4d1p3m2Y6f6 NPRX9Koi1zPTefXA3mOSBd0lyhwk2cGJyEx9P1ZD9oale4QkHnWsP8kZdx12wMs8 o1W/J3C9n2Sw8CcmjI3g2b+vyMdLNE25N1i43OfyxPgiJ/fNWiLc3zol34YtBBjQ cmBtX9Mm0hfx4+AqmDNAsFDbX2HGN1Xe9QJJ9/QWH04ma2hoapO69fPnpppjYZWm enE9iPQDXNkt/e50b3XTQVqo76dwPRn3gmIIR7JXWa8bmOqZSLeQtX0SCAxkZKoa zc15JJZXF81jNu8d2K7dnBDALOt6yhQp/YDo7aWg3Q== X-ME-Sender: X-ME-Received: X-ME-Proxy-Cause: gggruggvucftvghtrhhoucdtuddrgedvledrvdefvddguddtfecutefuodetggdotefrod ftvfcurfhrohhfihhlvgemucfhrghsthforghilhdpqfgfvfdpuffrtefokffrpgfnqfgh necuuegrihhlohhuthemuceftddtnecusecvtfgvtghiphhivghnthhsucdlqddutddtmd enucfjughrpefhvfevufgjfhffkfggtgesmhdtreertddttdenucfhrhhomheplfhoohhs thcumfhrvghmvghrshcuoehjohhoshhtkhhrvghmvghrshesfhgrshhtmhgrihhlrdhfmh eqnecuggftrfgrthhtvghrnhepvdeuudfghfdtvedttdelvdeludelheehfeevfffgvdeh jedvieeiveekjeeikefgnecuvehluhhsthgvrhfuihiivgeptdenucfrrghrrghmpehmrg hilhhfrhhomhepjhhoohhsthhkrhgvmhgvrhhssehfrghsthhmrghilhdrfhhm X-ME-Proxy: Feedback-ID: ie15541ac:Fastmail Original-Received: by mail.messagingengine.com (Postfix) with ESMTPA; Thu, 9 May 2024 12:45:56 -0400 (EDT) In-Reply-To: <868r0j74qi.fsf@gnu.org> (Eli Zaretskii's message of "Thu, 09 May 2024 11:45:57 +0300") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list 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-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:284766 Archived-At: --=-=-= Content-Type: text/plain On Thu, May 09 2024, Eli Zaretskii wrote: > This changes a public API, so it does need to be called out in NEWS, > just in the section which lists Lisp-level changes. OK, I added an entry, now contained in the new patch. > A test can be interactive (since the test suite can be run > interactively as well), but then please skip the test if it's run in > batch mode. Actually, once I took out the 'y-or-n-p' calls, it turned out the test runs fine non-interactively. I included it in the patch. > @code{nil}, in both cases. [...] > Two spaces between sentences, please. Done. Here's the new patch. -- Joost Kremers Life has its moments --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Make-vtable-insert-object-more-versatile.patch >From aacba116ee729663f078e8fb1fee2d0fee01a7a8 Mon Sep 17 00:00:00 2001 From: Joost Kremers Date: Tue, 7 May 2024 11:52:27 +0200 Subject: [PATCH] Make vtable-insert-object more versatile Rename argument AFTER-OBJECT to LOCATION; allow use of index to refer to the insertion position; add argument BEFORE (Bug#70664). * lisp/emacs-lisp/vtable.el (vtable-insert-object): * doc/misc/vtable.texi (Interface Functions): Document the change. --- doc/misc/vtable.texi | 18 +++-- etc/NEWS | 13 ++++ lisp/emacs-lisp/vtable.el | 98 +++++++++++++++++++++------- test/lisp/emacs-lisp/vtable-tests.el | 30 +++++++++ 4 files changed, 132 insertions(+), 27 deletions(-) diff --git a/doc/misc/vtable.texi b/doc/misc/vtable.texi index dd5b70cf32f..822b1097cd9 100644 --- a/doc/misc/vtable.texi +++ b/doc/misc/vtable.texi @@ -548,10 +548,20 @@ Interface Functions table. @end defun -@defun vtable-insert-object table object &optional after-object -Insert @var{object} into @var{table}. If @var{after-object}, insert -the object after this object; otherwise append to @var{table}. This -also updates the displayed table. +@defun vtable-insert-object table object &optional location before +Insert @var{object} into @var{table}. @var{location} should be an +object in the table, the new object is inserted after this object, or +before it if @var{before} is non-nil. If @var{location} is @code{nil}, +@var{object} is appended to @var{table}, or prepended if @var{before} is +non-@code{nil}. + +@var{location} can also be an integer, a zero-based index into the +table. In this case, @var{object} is inserted at that index. If the +index is out of range, @var{object} is prepended to @var{table} if the +index is too small, or appended if it is too large. In this case, +@var{before} is ignored. + +This also updates the displayed table. @end defun @defun vtable-update-object table object &optional old-object diff --git a/etc/NEWS b/etc/NEWS index e2588afeb40..6ed5bf12287 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2563,6 +2563,19 @@ this case, would mean repeating the object in the argument list.) When replacing an object with a different one, passing both the new and old objects is still necessary. +** 'vtable-insert-object' can insert "before" or at an index. +The signature of 'vtable-insert-object' has changed and is now: + +(vtable-insert-object table object &optional location before) + +'location' corresponds to the old 'after-object' argument; if 'before' +is non-nil, the new object is inserted before the 'location' object, +making it possible to insert a new object at the top of the +table. (Before, this was not possible.) In addition, 'location' can be +an integer, a (zero-based) index into the table at which the new object +is inserted ('before' is ignored in this case). + + ** JSON --- diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index d8e5136c666..cb7ea397314 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -348,19 +348,57 @@ vtable-remove-object (when (vtable-goto-object object) (delete-line))))) -(defun vtable-insert-object (table object &optional after-object) - "Insert OBJECT into TABLE after AFTER-OBJECT. -If AFTER-OBJECT is nil (or doesn't exist in the table), insert -OBJECT at the end. +;; FIXME: The fact that the `location' argument of +;; `vtable-insert-object' can be an integer and is then interpreted as +;; an index precludes the use of integers as objects. This seems a very +;; unlikely use-case, so let's just accept this limitation. + +(defun vtable-insert-object (table object &optional location before) + "Insert OBJECT into TABLE at LOCATION. +LOCATION is an object in TABLE. OBJECT is inserted after LOCATION, +unless BEFORE is non-nil, in which case it is inserted before LOCATION. + +If LOCATION is nil, or does not exist in the table, OBJECT is inserted +at the end of the table, or at the beginning if BEFORE is non-nil. + +LOCATION can also be an integer, a (zero-based) index into the table. +OBJECT is inserted at this location. If the index is out of range, +OBJECT is inserted at the beginning (if the index is less than 0) or +end (if the index is too large) of the table. BEFORE is ignored in this +case. + This also updates the displayed table." + ;; FIXME: Inserting an object into an empty vtable currently isn't + ;; possible. `nconc' fails silently (twice), and `setcar' on the cache + ;; raises an error. + (if (null (vtable-objects table)) + (error "[vtable] Cannot insert object into empty vtable")) ;; First insert into the objects. - (let (pos) - (if (and after-object - (setq pos (memq after-object (vtable-objects table)))) - ;; Splice into list. - (setcdr pos (cons object (cdr pos))) - ;; Append. - (nconc (vtable-objects table) (list object)))) + (let ((pos (if location + (if (integerp location) + (prog1 + (nthcdr location (vtable-objects table)) + ;; Do not prepend if index is too large: + (setq before nil)) + (or (memq location (vtable-objects table)) + ;; Prepend if `location' is not found and + ;; `before' is non-nil: + (and before (vtable-objects table)))) + ;; If `location' is nil and `before' is non-nil, we + ;; prepend the new object. + (if before (vtable-objects table))))) + (if (or before ; If `before' is non-nil, `pos' should be, as well. + (and pos (integerp location))) + ;; Add the new object before. + (let ((old-object (car pos))) + (setcar pos object) + (setcdr pos (cons old-object (cdr pos)))) + ;; Otherwise, add the object after. + (if pos + ;; Splice the object into the list. + (setcdr pos (cons object (cdr pos))) + ;; Otherwise, append the object. + (nconc (vtable-objects table) (list object))))) ;; Then adjust the cache and display. (save-excursion (vtable-goto-table table) @@ -372,19 +410,33 @@ vtable-insert-object 'face (vtable-face table)) "")) (ellipsis-width (string-pixel-width ellipsis)) - (elem (and after-object - (assq after-object (car cache)))) + (elem (if location ; This binding mirrors the binding of `pos' above. + (if (integerp location) + (nth location (car cache)) + (or (assq location (car cache)) + (and before (caar cache)))) + (if before (caar cache)))) + (pos (memq elem (car cache))) (line (cons object (vtable--compute-cached-line table object)))) - (if (not elem) - ;; Append. - (progn - (setcar cache (nconc (car cache) (list line))) - (vtable-end-of-table)) - ;; Splice into list. - (let ((pos (memq elem (car cache)))) - (setcdr pos (cons line (cdr pos))) - (unless (vtable-goto-object after-object) - (vtable-end-of-table)))) + (if (or before + (and pos (integerp location))) + ;; Add the new object before:. + (let ((old-line (car pos))) + (setcar pos line) + (setcdr pos (cons old-line (cdr pos))) + (unless (vtable-goto-object (car elem)) + (vtable-beginning-of-table))) + ;; Otherwise, add the object after. + (if pos + ;; Splice the object into the list. + (progn + (setcdr pos (cons line (cdr pos))) + (if (vtable-goto-object location) + (forward-line 1) ; Insert *after*. + (vtable-end-of-table))) + ;; Otherwise, append the object. + (setcar cache (nconc (car cache) (list line))) + (vtable-end-of-table))) (let ((start (point))) ;; FIXME: We have to adjust colors in lines below this if we ;; have :row-colors. diff --git a/test/lisp/emacs-lisp/vtable-tests.el b/test/lisp/emacs-lisp/vtable-tests.el index 08fdf1594a4..1d4b0650210 100644 --- a/test/lisp/emacs-lisp/vtable-tests.el +++ b/test/lisp/emacs-lisp/vtable-tests.el @@ -39,4 +39,34 @@ test-vstable-compute-columns :insert nil))) '(left right left)))) +(ert-deftest test-vtable-insert-object () + (should + (equal (let ((buffer (get-buffer-create " *vtable-test*"))) + (pop-to-buffer buffer) + (erase-buffer) + (let* ((object1 '("Foo" 3)) + (object2 '("Gazonk" 8)) + (table (make-vtable + :columns '("Name" (:name "Rank" :width 5)) + :objects (list object1 object2)))) + (mapc (lambda (args) + (pcase-let ((`(,object ,location ,before) args)) + (vtable-insert-object table object location before))) + `( ; Some correct inputs. + ;; object location before + (("Fizz" 4) ,object1 nil) + (("Bop" 7) ,object2 t) + (("Zat" 5) 2 nil) + (("Dib" 6) 3 t) + (("Wup" 9) nil nil) + (("Quam" 2) nil t) + ;; And some faulty inputs. + (("Yat" 1) -1 nil) ; non-existing index, `before' is ignored. + (("Vop" 10) 100 t) ; non-existing index, `before' is ignored. + (("Jib" 11) ("Bleh" 0) nil) ; non-existing object. + (("Nix" 0) ("Ugh" 0) t) ; non-existing object. + )) + (mapcar #'cadr (vtable-objects table)))) + (number-sequence 0 11)))) + ;;; vtable-tests.el ends here -- 2.45.0 --=-=-=--