bug#32849: 26.1; xref-marker-ring-length user option doesn't have setter

[Allen Li <darkfeline@felesatra.moe>]

[-- Attachment #1: Type: text/plain, Size: 1070 bytes --]

Patches attached.

Of note:

I added a ring-resize function.

I wrote tests with names function-to-test/case-tested.  I'm not sure
if this violates style policies for tests.  It seems like existing
code tests multiple cases in a single test, but I find separate tests
easier to understand when they regress.  The / makes the test names
easier to read.

I based this off of 26 (as I think this is a minor bugfix/feature add).
On Thu, Sep 27, 2018 at 2:24 AM Eli Zaretskii <eliz@gnu.org> wrote:
>
> > From: Allen Li <darkfeline@felesatra.moe>
> > Date: Wed, 26 Sep 2018 16:14:15 -0700
> >
> > The xref-marker-ring-length user option doesn't have a setter, so
> > customizing it will not affect xref--marker-ring, except if/when user
> > customizations are loaded in a new Emacs process before xref is loaded.
> > Customizations after xref is loaded will have no effect.
>
> I think the setter should use ring-extend to enlarge the ring, and
> some custom code using ring-remove to make the ring smaller.
>
> Would you like to submit a patch along those lines?
>
> Thanks.

[-- Attachment #2: 0002-Add-setter-for-xref-marker-ring-length.patch --]
[-- Type: text/x-patch, Size: 2301 bytes --]

From ec3e24819c5e2ec2df1f51bd3cb70ac4e598b9d6 Mon Sep 17 00:00:00 2001
From: Allen Li <darkfeline@felesatra.moe>
Date: Wed, 24 Oct 2018 20:48:15 -0600
Subject: [PATCH 2/2] Add setter for xref-marker-ring-length

* etc/NEWS: Document change
* lisp/progmodes/xref.el (xref-marker-ring-length): Add setter
---
 etc/NEWS               |  7 +++++++
 lisp/progmodes/xref.el | 16 ++++++++++++++--
 2 files changed, 21 insertions(+), 2 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index c67b13205c..f9a9fa6afc 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -113,6 +113,13 @@ option 'vc-hg-symbolic-revision-styles' to the value '("{rev}")'.
 ---
 ** shadowfile.el has been rewritten to support Tramp file names.
 
+** xref
+
++++
+*** Setter added for 'xref-marker-ring-length'.
+Previously, setting 'xref-marker-ring-length' would only take effect
+if set before `xref.el` was loaded.
+
 \f
 * New Modes and Packages in Emacs 26.2
 
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index abb2a93425..eaa4014145 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -317,8 +317,12 @@ xref--search-property
 ;;; Marker stack  (M-. pushes, M-, pops)
 
 (defcustom xref-marker-ring-length 16
-  "Length of the xref marker ring."
-  :type 'integer)
+  "Length of the xref marker ring.
+If this variable is not set through Customize, you must call
+‘xref-set-marker-ring-length’ for changes to take effect."
+  :type 'integer
+  :initialize #'custom-initialize-default
+  :set #'xref-set-marker-ring-length)
 
 (defcustom xref-prompt-for-identifier '(not xref-find-definitions
                                             xref-find-definitions-other-window
@@ -354,6 +358,14 @@ xref-after-return-hook
 (defvar xref--marker-ring (make-ring xref-marker-ring-length)
   "Ring of markers to implement the marker stack.")
 
+(defun xref-set-marker-ring-length (var val)
+  "Set ‘xref-marker-ring-length’.
+VAR is the symbol ‘xref-marker-ring-length’ and VAL is the new
+value."
+  (set-default var val)
+  (if (ring-p xref--marker-ring)
+      (ring-resize xref--marker-ring val)))
+
 (defun xref-push-marker-stack (&optional m)
   "Add point M (defaults to `point-marker') to the marker stack."
   (ring-insert xref--marker-ring (or m (point-marker))))
-- 
2.19.1.568.g152ad8e336-goog


[-- Attachment #3: 0001-Add-ring-resize-function.patch --]
[-- Type: text/x-patch, Size: 5026 bytes --]

From 98138a5e9cf2afaae5ec55264daf304201b4b50d Mon Sep 17 00:00:00 2001
From: Allen Li <darkfeline@felesatra.moe>
Date: Wed, 24 Oct 2018 20:44:01 -0600
Subject: [PATCH 1/2] Add ring-resize function

* doc/lispref/sequences.texi (Rings): Document new function
* etc/NEWS: Document new function
* lisp/emacs-lisp/ring.el (ring-resize): New function
* test/lisp/emacs-lisp/ring-tests.el (ring-test-ring-resize): New tests
---
 doc/lispref/sequences.texi         |  5 ++++
 etc/NEWS                           |  4 ++++
 lisp/emacs-lisp/ring.el            | 33 +++++++++++++++++---------
 test/lisp/emacs-lisp/ring-tests.el | 37 ++++++++++++++++++++++++++++++
 4 files changed, 68 insertions(+), 11 deletions(-)

diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi
index 51d724cb1d..233b64d491 100644
--- a/doc/lispref/sequences.texi
+++ b/doc/lispref/sequences.texi
@@ -1771,6 +1771,11 @@ Rings
 room for the inserted element.
 @end defun
 
+@defun ring-resize ring size
+Set the size of @var{ring} to @var{size}.  If the new size is smaller,
+then the oldest items in the ring are discarded.
+@end defun
+
 @cindex fifo data structure
   If you are careful not to exceed the ring size, you can
 use the ring as a first-in-first-out queue.  For example:
diff --git a/etc/NEWS b/etc/NEWS
index dfafe7c5c9..c67b13205c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -161,6 +161,10 @@ To cater to use cases where comments and strings are to be ignored
 when looking for a list, the function 'list-at-point' now takes an
 optional argument to do so.
 
++++
+** New function 'ring-resize'.
+'ring-resize' can be used to grow or shrink a ring.
+
 \f
 * Changes in Emacs 26.2 on Non-Free Operating Systems
 
diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el
index 312df6b2de..1b36811f9e 100644
--- a/lisp/emacs-lisp/ring.el
+++ b/lisp/emacs-lisp/ring.el
@@ -189,17 +189,28 @@ ring-previous
 (defun ring-extend (ring x)
   "Increase the size of RING by X."
   (when (and (integerp x) (> x 0))
-    (let* ((hd       (car ring))
-	   (length   (ring-length ring))
-	   (size     (ring-size ring))
-	   (old-vec  (cddr ring))
-	   (new-vec  (make-vector (+ size x) nil)))
-      (setcdr ring (cons length new-vec))
-      ;; If the ring is wrapped, the existing elements must be written
-      ;; out in the right order.
-      (dotimes (j length)
-	(aset new-vec j (aref old-vec (mod (+ hd j) size))))
-      (setcar ring 0))))
+    (ring-resize ring (+ x (ring-size ring)))))
+
+(defun ring-resize (ring size)
+  "Set the size of RING to SIZE.
+If the new size is smaller, then the oldest items in the ring are
+discarded."
+  (when (integerp size)
+    (let ((length (ring-length ring))
+	  (new-vec (make-vector size nil)))
+      (if (= length 0)
+          (setcdr ring (cons 0 new-vec))
+        (let* ((hd (car ring))
+	       (old-size (ring-size ring))
+	       (old-vec (cddr ring))
+               (copy-length (min size length))
+               (copy-hd (mod (+ hd (- length copy-length)) length)))
+          (setcdr ring (cons copy-length new-vec))
+          ;; If the ring is wrapped, the existing elements must be written
+          ;; out in the right order.
+          (dotimes (j copy-length)
+	    (aset new-vec j (aref old-vec (mod (+ copy-hd j) old-size))))
+          (setcar ring 0))))))
 
 (defun ring-insert+extend (ring item &optional grow-p)
   "Like `ring-insert', but if GROW-P is non-nil, then enlarge ring.
diff --git a/test/lisp/emacs-lisp/ring-tests.el b/test/lisp/emacs-lisp/ring-tests.el
index 0b4e3d9a69..ea78895b04 100644
--- a/test/lisp/emacs-lisp/ring-tests.el
+++ b/test/lisp/emacs-lisp/ring-tests.el
@@ -162,6 +162,43 @@
     (should (= (ring-size ring) 5))
     (should (equal (ring-elements ring) '(3 2 1)))))
 
+(ert-deftest ring-test-ring-resize/grow ()
+  (let ((ring (make-ring 3)))
+    (ring-insert ring 1)
+    (ring-insert ring 2)
+    (ring-insert ring 3)
+    (ring-resize ring 5)
+    (should (= (ring-size ring) 5))
+    (should (equal (ring-elements ring) '(3 2 1)))))
+
+(ert-deftest ring-test-ring-resize/grow-empty ()
+  (let ((ring (make-ring 3)))
+    (ring-resize ring 5)
+    (should (= (ring-size ring) 5))
+    (should (equal (ring-elements ring) '()))))
+
+(ert-deftest ring-test-ring-resize/grow-wrapped-ring ()
+  (let ((ring (make-ring 3)))
+    (ring-insert ring 1)
+    (ring-insert ring 2)
+    (ring-insert ring 3)
+    (ring-insert ring 4)
+    (ring-insert ring 5)
+    (ring-resize ring 5)
+    (should (= (ring-size ring) 5))
+    (should (equal (ring-elements ring) '(5 4 3)))))
+
+(ert-deftest ring-test-ring-resize/shrink ()
+  (let ((ring (make-ring 5)))
+    (ring-insert ring 1)
+    (ring-insert ring 2)
+    (ring-insert ring 3)
+    (ring-insert ring 4)
+    (ring-insert ring 5)
+    (ring-resize ring 3)
+    (should (= (ring-size ring) 3))
+    (should (equal (ring-elements ring) '(5 4 3)))))
+
 (ert-deftest ring-tests-insert ()
   (let ((ring (make-ring 2)))
     (ring-insert+extend ring :a)
-- 
2.19.1.568.g152ad8e336-goog