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: 192 bytes --]

On Sat, Oct 27, 2018 at 2:57 AM Eli Zaretskii <eliz@gnu.org> wrote:
> Thanks.  Please see a few minor comments below.

Thanks for your comments.  I have attached new patches based off master.

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

From 73f19816e587ad1214f91f2f8880da4ae495b2ee 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 554716084e..955ad669b8 100644
--- a/doc/lispref/sequences.texi
+++ b/doc/lispref/sequences.texi
@@ -1777,6 +1777,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 29bbde9395..c39303dbc0 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1218,6 +1218,10 @@ to mean that it is not known whether DST is in effect.
 'json-insert', 'json-parse-string', and 'json-parse-buffer'.  These
 are implemented in C using the Jansson library.
 
++++
+** New function 'ring-resize'.
+'ring-resize' can be used to grow or shrink a ring.
+
 ** Mailcap
 
 ---
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..9fa36aa3d3 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-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-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-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-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


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

From 643dcf2a762b34078135eb4c66a2108f2c64dfaa 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               |  5 +++++
 lisp/progmodes/xref.el | 16 ++++++++++++++--
 2 files changed, 19 insertions(+), 2 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index c39303dbc0..203d89ee07 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -460,6 +460,11 @@ for example.
 This command finds definitions of the identifier at the place of a
 mouse click event, and is intended to be bound to a mouse event.
 
++++
+*** Changing 'xref-marker-ring-length' works after 'xref.el' is loaded.
+Previously, setting 'xref-marker-ring-length' would only take effect
+if set before 'xref.el' was loaded.
+
 ** Ecomplete
 
 *** The ecomplete sorting has changed to a decay-based algorithm.
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 6b1421a6f7..3b449bf9b1 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