From: "Basil L. Contovounesios" <contovob@tcd.ie>
To: 35536@debbugs.gnu.org
Cc: Mauro Aranda <maurooaranda@gmail.com>,
Stefan Monnier <monnier@iro.umontreal.ca>
Subject: bug#35536: 27.0.50; Expose buffer's marker list to Elisp
Date: Thu, 02 May 2019 16:44:52 +0100 [thread overview]
Message-ID: <87lfzo274b.fsf@tcd.ie> (raw)
[-- 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
next reply other threads:[~2019-05-02 15:44 UTC|newest]
Thread overview: 20+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-05-02 15:44 Basil L. Contovounesios [this message]
2019-05-02 16:07 ` bug#35536: 27.0.50; Expose buffer's marker list to Elisp 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
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87lfzo274b.fsf@tcd.ie \
--to=contovob@tcd.ie \
--cc=35536@debbugs.gnu.org \
--cc=maurooaranda@gmail.com \
--cc=monnier@iro.umontreal.ca \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.