unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#35536: 27.0.50; Expose buffer's marker list to Elisp
@ 2019-05-02 15:44 Basil L. Contovounesios
  2019-05-02 16:07 ` Eli Zaretskii
  2019-05-02 19:59 ` Stefan Monnier
  0 siblings, 2 replies; 20+ messages in thread
From: Basil L. Contovounesios @ 2019-05-02 15:44 UTC (permalink / raw)
  To: 35536; +Cc: Mauro Aranda, Stefan Monnier

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

Severity: wishlist
Tags: patch


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-function-marker-list.patch --]
[-- Type: text/x-diff, Size: 10480 bytes --]

From c3c864a034ceb5c43fb791721a4b5c40f4122228 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Tue, 30 Apr 2019 00:17:02 +0100
Subject: [PATCH] Add function marker-list

Suggested by Martin Rudalics <rudalics@gmx.at> in:
https://debbugs.gnu.org/18#47
* doc/lispref/markers.texi (Marker Information): Rename from
'Information from Markers'.  All references changed.  Document
marker-list.
* etc/NEWS (Changes in Emacs 27.1): Announce marker-list.
* src/data.c (syms_of_data): Define Flss symbol for passing to
Fsort.
* src/marker.c (Fcopy_marker): Fix indentation.
(Fbuffer_has_markers_at): Coerce argument to a fixnum before passing
it to XFIXNUM.
(Fmarker_list): New function for listing markers in a given region.
(syms_of_marker): Define subr Smarker_list.
* test/src/marker-tests.el
(marker-set-window-start-from-other-buffer): Simplify.
(marker-list, marker-list-buffer-change): New tests.
---
 doc/lispref/elisp.texi   |  2 +-
 doc/lispref/markers.texi | 22 +++++++++++-------
 etc/NEWS                 |  5 ++++
 src/data.c               |  1 +
 src/marker.c             | 40 ++++++++++++++++++++++++++------
 test/src/marker-tests.el | 50 ++++++++++++++++++++++++++++++++++------
 6 files changed, 97 insertions(+), 23 deletions(-)

diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index e18759654d..67c3e860aa 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -1168,7 +1168,7 @@ Top
 * Overview of Markers::     The components of a marker, and how it relocates.
 * Predicates on Markers::   Testing whether an object is a marker.
 * Creating Markers::        Making empty markers or markers at certain places.
-* Information from Markers::Finding the marker's buffer or character position.
+* Marker Information::      Finding the marker's buffer or character position.
 * Marker Insertion Types::  Two ways a marker can relocate when you
                               insert where it points.
 * Moving Markers::          Moving the marker to a new buffer or position.
diff --git a/doc/lispref/markers.texi b/doc/lispref/markers.texi
index 27fe1414f0..d18cad2eb8 100644
--- a/doc/lispref/markers.texi
+++ b/doc/lispref/markers.texi
@@ -16,7 +16,7 @@ Markers
 * Overview of Markers::      The components of a marker, and how it relocates.
 * Predicates on Markers::    Testing whether an object is a marker.
 * Creating Markers::         Making empty markers or markers at certain places.
-* Information from Markers:: Finding the marker's buffer or character position.
+* Marker Information::       Finding the marker's buffer or character position.
 * Marker Insertion Types::   Two ways a marker can relocate when you
                                insert where it points.
 * Moving Markers::           Moving the marker to a new buffer or position.
@@ -271,12 +271,12 @@ Creating Markers
 @end group
 @end example
 
-@node Information from Markers
-@section Information from Markers
+@node Marker Information
+@section Marker Information
 @cindex marker information
 
-  This section describes the functions for accessing the components of a
-marker object.
+Several functions return information about markers.  The next two
+functions access components of a marker object.
 
 @defun marker-position marker
 This function returns the position that @var{marker} points to, or
@@ -287,8 +287,6 @@ Information from Markers
 This function returns the buffer that @var{marker} points into, or
 @code{nil} if it points nowhere.
 
-@c FIXME: The 'buffer' argument of 'set-marker' already defaults to
-@c the current buffer, why use '(current-buffer)' explicitly here?
 @example
 @group
 (setq m (make-marker))
@@ -304,7 +302,7 @@ Information from Markers
 @end group
 
 @group
-(set-marker m 3770 (current-buffer))
+(set-marker m 3770)
      @result{} #<marker at 3770 in markers.texi>
 @end group
 @group
@@ -318,6 +316,14 @@ Information from Markers
 @end example
 @end defun
 
+@defun marker-list &optional beg end
+This function returns an ordered list of the markers in the accessible
+range of the current buffer.  If @var{beg} is non-@code{nil}, only
+markers pointing at that position are included.  If @var{end} is also
+non-@code{nil}, all markers in the region @var{beg} through @var{end}
+are included.
+@end defun
+
 @node Marker Insertion Types
 @section Marker Insertion Types
 
diff --git a/etc/NEWS b/etc/NEWS
index 9e3559d27e..dc5923a293 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -340,6 +340,11 @@ longer.
 ** Multicolor fonts such as "Noto Color Emoji" can be displayed on
 Emacs configured with Cairo drawing and linked with cairo >= 1.16.0.
 
++++
+** New function 'marker-list'.
+This function returns a list of markers in the current buffer within a
+given region.
+
 \f
 * Editing Changes in Emacs 27.1
 
diff --git a/src/data.c b/src/data.c
index 476d28eadb..0bf841e928 100644
--- a/src/data.c
+++ b/src/data.c
@@ -3852,6 +3852,7 @@ syms_of_data (void)
   DEFSYM (Qmany, "many");
 
   DEFSYM (Qcdr, "cdr");
+  DEFSYM (Qlss, "<");
 
   error_tail = pure_cons (Qerror, Qnil);
 
diff --git a/src/marker.c b/src/marker.c
index b58051a8c2..d132a43c09 100644
--- a/src/marker.c
+++ b/src/marker.c
@@ -712,7 +712,8 @@ see `marker-insertion-type'.  */)
   register Lisp_Object new;
 
   if (!NILP (marker))
-  CHECK_TYPE (FIXNUMP (marker) || MARKERP (marker), Qinteger_or_marker_p, marker);
+    CHECK_TYPE (FIXNUMP (marker) || MARKERP (marker),
+                Qinteger_or_marker_p, marker);
 
   new = Fmake_marker ();
   Fset_marker (new, marker,
@@ -749,18 +750,42 @@ DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
        doc: /* Return t if there are markers pointing at POSITION in the current buffer.  */)
   (Lisp_Object position)
 {
-  register struct Lisp_Marker *tail;
-  register ptrdiff_t charpos;
+  CHECK_FIXNUM_COERCE_MARKER (position);
+  ptrdiff_t charpos = clip_to_bounds (BEG, XFIXNUM (position), Z);
 
-  charpos = clip_to_bounds (BEG, XFIXNUM (position), Z);
-
-  for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
-    if (tail->charpos == charpos)
+  for (struct Lisp_Marker *m = BUF_MARKERS (current_buffer); m; m = m->next)
+    if (m->charpos == charpos)
       return Qt;
 
   return Qnil;
 }
 
+DEFUN ("marker-list", Fmarker_list, Smarker_list, 0, 2, 0,
+       doc: /* Return a list of markers in the accessible range of the buffer.
+If BEG is non-nil, include only markers pointing at that position.
+If END is also non-nil, include all markers in the region BEG
+through END.  */)
+  (Lisp_Object beg, Lisp_Object end)
+{
+  ptrdiff_t b, e;
+  if (NILP (beg))
+    b = BEGV, e = ZV;
+  else
+    {
+      validate_region (&beg, NILP (end) ? &beg : &end);
+      b = XFIXNAT (beg);
+      e = NILP (end) ? b : XFIXNAT (end);
+    }
+
+  Lisp_Object markers = Qnil;
+
+  for (struct Lisp_Marker *m = BUF_MARKERS (current_buffer); m; m = m->next)
+    if (b <= m->charpos && m->charpos <= e)
+      markers = Fcons (make_lisp_ptr (m, Lisp_Vectorlike), markers);
+
+  return Fsort (markers, Qlss);
+}
+
 #ifdef MARKER_DEBUG
 
 /* For debugging -- count the markers in buffer BUF.  */
@@ -807,4 +832,5 @@ syms_of_marker (void)
   defsubr (&Smarker_insertion_type);
   defsubr (&Sset_marker_insertion_type);
   defsubr (&Sbuffer_has_markers_at);
+  defsubr (&Smarker_list);
 }
diff --git a/test/src/marker-tests.el b/test/src/marker-tests.el
index 79e298d8c2..cbafabb556 100644
--- a/test/src/marker-tests.el
+++ b/test/src/marker-tests.el
@@ -29,16 +29,15 @@
 (ert-deftest marker-set-window-start-from-other-buffer ()
   "`set-window-start' from other buffer's marker."
   (let ((text-quoting-style 'curve))
-    (describe-function 'describe-function))
-  (let* ((help (get-buffer "*Help*"))
-         (marker (with-current-buffer help
-                   (copy-marker (point-max)))))
+    (describe-function #'describe-function))
+  (let ((marker (with-current-buffer "*Help*"
+                  (copy-marker (point-max)))))
     (should (set-window-start (selected-window) marker))))
 
 (ert-deftest marker-set-window-point-from-other-buffer ()
   "`set-window-point' from another buffer's marker."
   (let ((text-quoting-style 'curve))
-    (describe-function 'describe-function))
+    (describe-function #'describe-function))
   (let* ((help (get-buffer "*Help*"))
          (marker (with-current-buffer help
                    (copy-marker (point-max)))))
@@ -48,13 +47,50 @@
 (ert-deftest marker-goto-char-from-other-buffer ()
   "`goto-char' from another buffer's marker."
   (let ((text-quoting-style 'curve))
-    (describe-function 'describe-function))
+    (describe-function #'describe-function))
   (let ((marker-1 (make-marker))
         (marker-2 (make-marker)))
-    (describe-function 'describe-function)
+    (describe-function #'describe-function)
     (with-current-buffer "*Help*"
       (set-marker marker-1 (point-max)))
     (set-marker marker-2 marker-1)
     (should (goto-char marker-2))))
 
+(ert-deftest marker-list ()
+  "Test `marker-list' behavior."
+  (with-temp-buffer
+    ;; No markers created yet.
+    (should-not (marker-list))
+    (insert "first\nsecond\n")
+    (forward-line -1)
+    (let ((markers (list (point-min-marker) (point-max-marker))))
+      ;; Check marker arguments.
+      (should (equal (apply #'marker-list markers) markers))
+      (save-restriction
+        (narrow-to-region (point) (line-end-position))
+        ;; Check accessible range of buffer.
+        (should-not (marker-list))
+        ;; Check invalid region.
+        (should-error (apply #'marker-list markers)
+                      :type 'args-out-of-range)))
+    ;; Check single position and that mark is included.
+    (let ((marker (set-marker (mark-marker) (point))))
+      (should (equal (marker-list (point)) (list marker))))
+    ;; Check that unchained markers are not included.
+    (dolist (marker (marker-list))
+      (set-marker marker nil))
+    (should-not (marker-list))))
+
+(ert-deftest marker-list-buffer-change ()
+  "Test `marker-list' behavior across buffer changes."
+  (with-temp-buffer
+    (let ((marker  (point-marker))
+          (markers (marker-list)))
+      (with-temp-buffer
+        (set-marker marker (point))
+        (should (equal (marker-list) (list marker)))
+        (should (equal (mapcar #'marker-buffer markers)
+                       (list (current-buffer)))))
+      (should-not (marker-list)))))
+
 ;;; marker-tests.el ends here.
-- 
2.20.1


[-- Attachment #3: Type: text/plain, Size: 714 bytes --]


The question of listing a buffer's markers has been raised before:

https://debbugs.gnu.org/18#47
https://lists.gnu.org/archive/html/help-gnu-emacs/2016-06/msg00050.html
https://lists.gnu.org/archive/html/emacs-devel/2007-04/msg01391.html

I attach a patch implementing this based on BUF_MARKERS, as per Martin's
suggestion.  Any reasons not to expose such a function?

Thanks,

-- 
Basil

In GNU Emacs 27.0.50 (build 4, x86_64-pc-linux-gnu, X toolkit, Xaw3d scroll bars)
 of 2019-04-30 built on thunk
Repository revision: 910d170771ac74ab76d6dcb2dda3f3167e01b705
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12003000
System Description: Debian GNU/Linux buster/sid

^ permalink raw reply related	[flat|nested] 20+ messages in thread

end of thread, other threads:[~2019-09-16 21:07 UTC | newest]

Thread overview: 20+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2019-05-02 15:44 bug#35536: 27.0.50; Expose buffer's marker list to Elisp Basil L. Contovounesios
2019-05-02 16:07 ` Eli Zaretskii
2019-05-02 16:51   ` Basil L. Contovounesios
2019-05-02 17:41     ` Eli Zaretskii
2019-05-03 15:50       ` Basil L. Contovounesios
2019-05-03 16:38         ` Drew Adams
2019-05-03 17:22           ` Basil L. Contovounesios
2019-05-03 17:31             ` Drew Adams
2019-05-03 17:39             ` Stefan Monnier
2019-05-03 17:53               ` Drew Adams
2019-05-03 18:13                 ` Stefan Monnier
2019-05-03 20:05                   ` Drew Adams
2019-05-04 21:25                   ` Richard Stallman
2019-09-16 21:07                     ` Lars Ingebrigtsen
2019-05-03 23:01     ` Mauro Aranda
2019-05-04 17:34       ` martin rudalics
2019-05-02 19:59 ` Stefan Monnier
2019-05-02 20:05   ` Eli Zaretskii
2019-05-03 15:50   ` Basil L. Contovounesios
2019-05-03 17:09     ` Stefan Monnier

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).