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: Tue, 07 May 2024 12:52:56 +0200 Message-ID: <868r0levw7.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> 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="17957"; mail-complaints-to="usenet@ciao.gmane.io" Cc: Eli Zaretskii , 70664@debbugs.gnu.org To: Adam Porter Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Tue May 07 12:53:56 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 1s4ISG-0004QE-Kp for geb-bug-gnu-emacs@m.gmane-mx.org; Tue, 07 May 2024 12:53:54 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1s4IS3-0003nx-K8; Tue, 07 May 2024 06:53:39 -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 1s4IS1-0003e9-Kt for bug-gnu-emacs@gnu.org; Tue, 07 May 2024 06:53:37 -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 1s4IS1-0000So-C3 for bug-gnu-emacs@gnu.org; Tue, 07 May 2024 06:53:37 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1s4ISP-0008RA-Sj for bug-gnu-emacs@gnu.org; Tue, 07 May 2024 06:54:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Joost Kremers Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 07 May 2024 10:54:01 +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.171507921732422 (code B ref 70664); Tue, 07 May 2024 10:54:01 +0000 Original-Received: (at 70664) by debbugs.gnu.org; 7 May 2024 10:53:37 +0000 Original-Received: from localhost ([127.0.0.1]:42506 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1s4IS0-0008Qs-IW for submit@debbugs.gnu.org; Tue, 07 May 2024 06:53:37 -0400 Original-Received: from wfout3-smtp.messagingengine.com ([64.147.123.146]:56217) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1s4IRw-0008Qi-3t for 70664@debbugs.gnu.org; Tue, 07 May 2024 06:53:35 -0400 Original-Received: from compute6.internal (compute6.nyi.internal [10.202.2.47]) by mailfout.west.internal (Postfix) with ESMTP id 27C6E1C00182; Tue, 7 May 2024 06:53:01 -0400 (EDT) Original-Received: from mailfrontend1 ([10.202.2.162]) by compute6.internal (MEProxy); Tue, 07 May 2024 06:53:01 -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=1715079180; x=1715165580; bh=jSrRmaYyd0 XTgZOy8BPnwa8svOsVcoAiADLGa0wsDuU=; b=S+oECVkQrv8xuybGIzT5Ll2C6u nPSbN/Lfo1DlLPWM3ACnbR+2uLe7lTBvi8wd9gbdX0JvjSLi1O9AKUFZ+01a9NwG +mK7iDj+cIunLyk3mFOMa4M7h4neLMm0S6N8veE1GMV8VN2liUUhklCQkL2dzXIt 6ew+zk8vs32Xwp0JNcnbg1wD4Gez5RSOZXPXMkY9cwwnNNqLVBFsXeeV/VPW0KED c6/X7/Sjud5NQnIJX68tg0cA5i0EKUu2WAl2DnJWzwZrgk43YOg65Tw3n5xFhobd +XPLMtzCA50kSx1gM2pWJPlV7OGy4Dt1U/nEJk/T9SHO3LpBKgBgKfhTGD3w== 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=1715079180; x=1715165580; bh=jSrRmaYyd0XTgZOy8BPnwa8svOsV coAiADLGa0wsDuU=; b=ZaS6cvzZlq2OZ9xE0Ia1xGITecnmPWt0MvclbUKS0UZL OliZmnv3G/Rt3aW0GHIDMKJvyBDfOo+NWT8lEXJ3fwjnq9l+noEIDvqib5uxZ64d /rFrOw9deLxPNE9qUUcbIfn6R0iYWAS0VW75YqqnDSBHY44NG0XEY10LWSOQreON mXMgtwzeRNsQnZl4c98Bz02+5q8Y5x++ZeqwQZXH/y4cVk9n41Kk3Qd2BdpfprZt m5RPyIWl++Tec0bZcWhF44926UkFxvseXPucm2oh2bJcbBRXDxjOQMxowLJUUz2Y wdrfs3vyovcsbt/ap8XccNryqbtSI7sFnB5PshpQTA== X-ME-Sender: X-ME-Received: X-ME-Proxy-Cause: gggruggvucftvghtrhhoucdtuddrgedvledrvddvkedgfeduucetufdoteggodetrfdotf fvucfrrhhofhhilhgvmecuhfgrshhtofgrihhlpdfqfgfvpdfurfetoffkrfgpnffqhgen uceurghilhhouhhtmecufedttdenucesvcftvggtihhpihgvnhhtshculddquddttddmne cujfgurhephffvvefujghffffkgggtsehmtderredttddtnecuhfhrohhmpeflohhoshht ucfmrhgvmhgvrhhsuceojhhoohhsthhkrhgvmhgvrhhssehfrghsthhmrghilhdrfhhmqe enucggtffrrghtthgvrhhnpedvuedugffhtdevtddtledvleduleehheefveffgfdvheej vdeiieevkeejieekgfenucevlhhushhtvghrufhiiigvpedtnecurfgrrhgrmhepmhgrih hlfhhrohhmpehjohhoshhtkhhrvghmvghrshesfhgrshhtmhgrihhlrdhfmh X-ME-Proxy: Feedback-ID: ie15541ac:Fastmail Original-Received: by mail.messagingengine.com (Postfix) with ESMTPA; Tue, 7 May 2024 06:52:59 -0400 (EDT) In-Reply-To: <9333046c-194c-4b59-895a-2bf8427a6135@alphapapa.net> (Adam Porter's message of "Thu, 2 May 2024 23:16:07 -0500") 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:284633 Archived-At: --=-=-= Content-Type: text/plain Hi Adam, Eli, Here's my first attempt at fixing this bug and generally making `vtable-insert-object` more versatile (see attachment). A few questions / comments: - Is this the right place to send this patch? Or should it go to emacs-devel? - There are quite a few combinations of LOCATION and BEFORE to handle, which may make the code a bit hard to follow. A possible alternative would be to define some internal helper functions, `vtable--insert-before` and `vtable--insert-after`. You guys be the judge. (I added a few comments to hopefully make it clearer) - The patch also updates the documentation. Do check the style, though, my writing usually isn't so great. - I'm sure I made all sorts of mistakes with the commit message. - I don't know if this change warrants a NEWS entry. It's not really user-facing, so I didn't add one. - The current implementation of vtable-insert-object has a bug: it puts the object in the right location in the object list and the cache, but not in the buffer. This patch also fixes this bug. - I don't know how to write a non-interactive test for my changes, because `vtable-insert-object` only works if the vtable is being displayed in a buffer. So instead I wrote an interactive function to test all possible combinations of LOCATION and BEFORE: ```emacs-lisp (defun test-vtable-insert-object-interactive () "Test `vtable-insert-object'." (interactive) (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)) (if (y-or-n-p (format "Update table with location = %s and before = %s?" location before)) (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. )) (if (y-or-n-p "Regenerate table?") (vtable-revert))))) ``` The final table should have the "Rank" column sorted in ascending order (0-11). Regenerating the table should not change it. -- Joost Kremers Life has its moments --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Make-vtable-insert-object-more-versatile.patch >From d48020ff58ff9b2684365772a6161023d4ff22d5 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 +++++-- lisp/emacs-lisp/vtable.el | 98 ++++++++++++++++++++++++++++++--------- 2 files changed, 89 insertions(+), 27 deletions(-) diff --git a/doc/misc/vtable.texi b/doc/misc/vtable.texi index dd5b70cf32f..82a12906e7a 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 nil, +@var{object} is appended to @var{table}, or prepended if @var{before} is +non-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/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index d8e5136c666..b53df6743ea 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. -- 2.45.0 --=-=-=--