Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Port other-buffer #1489

Open
wants to merge 8 commits into
base: master
Choose a base branch
from
Open

Port other-buffer #1489

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
c487b7d
Port other-buffer
simon-frankau May 10, 2019
9c4166b
Tidy porting of other-buffer
simon-frankau May 11, 2019
f32dc08
Fix formatting
simon-frankau May 12, 2019
c92152b
Tidy-ups to buffers.rs
simon-frankau May 25, 2019
a5aee9c
Make other_buffer_safely more Rust-style
simon-frankau Jul 14, 2019
e396523
Merge branch 'master' into other-buffer
shaleh Jan 10, 2020
241caa7
rustfmt corrections
agraven Jan 10, 2020
1a972b6
Merge branch 'master' into other-buffer
agraven Jan 31, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
90 changes: 85 additions & 5 deletions rust_src/src/buffers.rs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -35,7 +35,6 @@ use crate::{
numbers::{LispNumber, MOST_POSITIVE_FIXNUM},
obarray::intern,
remacs_sys::symbol_trapped_write::SYMBOL_TRAPPED_WRITE,
remacs_sys::Fmake_marker,
remacs_sys::{
alloc_buffer_text, allocate_buffer, allocate_misc, block_input, bset_update_mode_line,
buffer_fundamental_string, buffer_local_flags, buffer_local_value, buffer_memory_full,
Expand All @@ -51,11 +50,11 @@ use crate::{
},
remacs_sys::{
buffer_permanent_local_flags, Qafter_string, Qbefore_string, Qbuffer_list_update_hook,
Qbuffer_read_only, Qbufferp, Qfundamental_mode, Qget_file_buffer, Qinhibit_quit,
Qinhibit_read_only, Qmakunbound, Qnil, Qoverlayp, Qpermanent_local, Qpermanent_local_hook,
Qt, Qunbound, UNKNOWN_MODTIME_NSECS,
Qbuffer_read_only, Qbufferp, Qerror, Qevaporate, Qfundamental_mode, Qget_file_buffer,
Qinhibit_quit, Qinhibit_read_only, Qmakunbound, Qnil, Qoverlayp, Qpermanent_local,
Qpermanent_local_hook, Qt, Qunbound, Qvisible, UNKNOWN_MODTIME_NSECS,
},
remacs_sys::{Qerror, Qevaporate},
remacs_sys::{Fget_buffer_window, Fmake_marker, Fset_buffer_major_mode},
strings::string_equal,
textprop::get_text_property,
threads::{c_specpdl_index, ThreadState},
Expand Down Expand Up @@ -284,6 +283,10 @@ impl LispBufferRef {
self.name_.is_not_nil()
}

pub fn is_hidden(self) -> bool {
LispStringRef::from(self.name_).byte_at(0) == b' '
}

pub fn set_pt_both(&mut self, charpos: ptrdiff_t, byte: ptrdiff_t) {
self.pt = charpos;
self.pt_byte = byte;
Expand Down Expand Up @@ -1982,4 +1985,81 @@ pub fn byte_char_debug_check(b: LispBufferRef, charpos: isize, bytepos: isize) {
}
}

// True if B can be used as 'other-than-BUFFER' buffer.
fn candidate_buffer(b: LispObject, buffer: LispObject) -> bool {
shaleh marked this conversation as resolved.
Show resolved Hide resolved
match b.as_buffer() {
Some(buf) => !b.eq(buffer) && buf.is_live() && !buf.is_hidden(),
None => false,
}
}

fn get_scratch_buf() -> LispObject {
// TODO: This was AUTO_STRING, which doesn't exist yet in Rust.
let scratch = new_unibyte_string!("*scratch*");
let mut buf = Fget_buffer(scratch);
if buf.is_nil() {
buf = Fget_buffer_create(scratch);
unsafe { Fset_buffer_major_mode(buf) };
}
buf
}

/// Return most recently selected buffer other than BUFFER.
/// Buffers not visible in windows are preferred to visible buffers, unless
/// optional second argument VISIBLE-OK is non-nil. Ignore the argument
/// BUFFER unless it denotes a live buffer. If the optional third argument
/// FRAME specifies a live frame, then use that frame's buffer list instead
/// of the selected frame's buffer list.
///
/// The buffer is found by scanning the selected or specified frame's buffer
/// list first, followed by the list of all buffers. If no other buffer
/// exists, return the buffer `*scratch*' (creating it if necessary).
#[lisp_fn(min = "0")]
pub fn other_buffer(
buffer: LispObject,
visible_ok: LispObject,
frame: LispFrameLiveOrSelected,
) -> LispObject {
let f: LispFrameRef = frame.into();
let pred = f.buffer_predicate;
let mut notsogood = None;

let frame_bufs = f
.buffer_list
.iter_cars(LispConsEndChecks::off, LispConsCircularChecks::off);
let all_bufs = LiveBufferIter::new().map(LispObject::from);
for buf in frame_bufs.chain(all_bufs) {
// If the frame has a buffer_predicate, disregard buffers that
// don't fit the predicate.
if candidate_buffer(buf, buffer)
&& pred.map_or_else(|| true, |p| call!(p, buf).is_not_nil())
{
if visible_ok.is_not_nil() || unsafe { Fget_buffer_window(buf, Qvisible) }.is_nil() {
return buf;
} else {
notsogood = notsogood.or(Some(buf));
}
}
}

match notsogood {
Some(buf) => buf,
None => get_scratch_buf(),
}
}

// The following function is a safe variant of Fother_buffer: It doesn't
// pay attention to any frame-local buffer lists, doesn't care about
// visibility of buffers, and doesn't evaluate any frame predicates.
#[no_mangle]
pub extern "C" fn other_buffer_safely(buffer: LispObject) -> LispObject {
shaleh marked this conversation as resolved.
Show resolved Hide resolved
let found = LiveBufferIter::new()
.map(|x| x.into())
.find(|buf| candidate_buffer(*buf, buffer));
match found {
Some(buf) => buf,
None => get_scratch_buf(),
}
}

include!(concat!(env!("OUT_DIR"), "/buffers_exports.rs"));
100 changes: 0 additions & 100 deletions src/buffer.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -811,105 +811,6 @@ state of the current buffer. Use with care. */)
return flag;
}


/* True if B can be used as 'other-than-BUFFER' buffer. */

static bool
candidate_buffer (Lisp_Object b, Lisp_Object buffer)
{
return (BUFFERP (b) && !EQ (b, buffer)
&& BUFFER_LIVE_P (XBUFFER (b))
&& !BUFFER_HIDDEN_P (XBUFFER (b)));
}

DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0,
doc: /* Return most recently selected buffer other than BUFFER.
Buffers not visible in windows are preferred to visible buffers, unless
optional second argument VISIBLE-OK is non-nil. Ignore the argument
BUFFER unless it denotes a live buffer. If the optional third argument
FRAME specifies a live frame, then use that frame's buffer list instead
of the selected frame's buffer list.

The buffer is found by scanning the selected or specified frame's buffer
list first, followed by the list of all buffers. If no other buffer
exists, return the buffer `*scratch*' (creating it if necessary). */)
(Lisp_Object buffer, Lisp_Object visible_ok, Lisp_Object frame)
{
struct frame *f = decode_live_frame (frame);
Lisp_Object tail = f->buffer_list, pred = f->buffer_predicate;
Lisp_Object buf, notsogood = Qnil;

/* Consider buffers that have been seen in the frame first. */
for (; CONSP (tail); tail = XCDR (tail))
{
buf = XCAR (tail);
if (candidate_buffer (buf, buffer)
/* If the frame has a buffer_predicate, disregard buffers that
don't fit the predicate. */
&& (NILP (pred) || !NILP (call1 (pred, buf))))
{
if (!NILP (visible_ok)
|| NILP (Fget_buffer_window (buf, Qvisible)))
return buf;
else if (NILP (notsogood))
notsogood = buf;
}
}

/* Consider alist of all buffers next. */
FOR_EACH_LIVE_BUFFER (tail, buf)
{
if (candidate_buffer (buf, buffer)
/* If the frame has a buffer_predicate, disregard buffers that
don't fit the predicate. */
&& (NILP (pred) || !NILP (call1 (pred, buf))))
{
if (!NILP (visible_ok)
|| NILP (Fget_buffer_window (buf, Qvisible)))
return buf;
else if (NILP (notsogood))
notsogood = buf;
}
}

if (!NILP (notsogood))
return notsogood;
else
{
AUTO_STRING (scratch, "*scratch*");
buf = Fget_buffer (scratch);
if (NILP (buf))
{
buf = Fget_buffer_create (scratch);
Fset_buffer_major_mode (buf);
}
return buf;
}
}

/* The following function is a safe variant of Fother_buffer: It doesn't
pay attention to any frame-local buffer lists, doesn't care about
visibility of buffers, and doesn't evaluate any frame predicates. */

Lisp_Object
other_buffer_safely (Lisp_Object buffer)
{
Lisp_Object tail, buf;

FOR_EACH_LIVE_BUFFER (tail, buf)
if (candidate_buffer (buf, buffer))
return buf;

AUTO_STRING (scratch, "*scratch*");
buf = Fget_buffer (scratch);
if (NILP (buf))
{
buf = Fget_buffer_create (scratch);
Fset_buffer_major_mode (buf);
}

return buf;
}

/* Truncate undo list and shrink the gap of BUFFER. */

Expand Down Expand Up @@ -5259,7 +5160,6 @@ Functions running this hook are, `get-buffer-create',
defsubr (&Smake_indirect_buffer);
defsubr (&Sbuffer_local_variables);
defsubr (&Sset_buffer_modified_p);
defsubr (&Sother_buffer);
defsubr (&Skill_buffer);
defsubr (&Sbury_buffer_internal);
defsubr (&Sset_buffer_major_mode);
Expand Down
90 changes: 75 additions & 15 deletions test/rust_src/src/buffers-tests.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,11 +7,13 @@
(ert-deftest test-buffer-base-buffer-indirect ()
(let* ((base (get-buffer-create "base"))
(ind-buf (make-indirect-buffer base "indbuf")))
(should (eq (buffer-base-buffer ind-buf) base))))
(should (eq (buffer-base-buffer ind-buf) base))
simon-frankau marked this conversation as resolved.
Show resolved Hide resolved
(kill-buffer base)))

(ert-deftest test-buffer-base-buffer-non-indirect ()
(let ((buf (get-buffer-create "buf")))
(should (eq (buffer-base-buffer buf) nil))))
(should (eq (buffer-base-buffer buf) nil))
(kill-buffer buf)))

(ert-deftest test-buffer-overlay-properties ()
"Tests the overlay-properties function"
Expand All @@ -28,7 +30,8 @@
(overlay-put (make-overlay (point-min) (point-max)) 'test "test")
(should (= (length (overlays-in (point-min) (point-max))) 1))
(delete-overlay (car (overlays-in (point-min) (point-max)))))
(should (eq (overlays-in (point-min) (point-max)) nil))))
(should (eq (overlays-in (point-min) (point-max)) nil))
(kill-buffer buf)))

(ert-deftest test-delete-all-overlays ()
(let ((buf (get-buffer-create "test-delete-all-overlays")))
Expand All @@ -37,7 +40,8 @@
(overlay-put (make-overlay (point-min) (point-max)) 'test "test")
(should (= (length (overlays-in (point-min) (point-max))) 2))
(delete-all-overlays)
(should (eq (overlays-in (point-min) (point-max)) nil)))))
(should (eq (overlays-in (point-min) (point-max)) nil)))
(kill-buffer buf)))

(ert-deftest test-move-overlay-in-buffer-implicit ()
(let ((buf (get-buffer-create "test-move-overlay-in-buffer-implict")))
Expand Down Expand Up @@ -93,47 +97,61 @@
(erase-buffer)
;; ensure widen is called
(widen)
(should (string= (buffer-string) ""))))))
(should (string= (buffer-string) ""))))
(kill-buffer buf)))

(ert-deftest test-buffer-list-for-frame-is-unique ()
(get-buffer-create "foo")
(get-buffer-create "bar")
(get-buffer-create "baz")
(let ((the-buffers (buffer-list (selected-frame))))
(should (equal (delq nil (delete-dups the-buffers))
the-buffers))))
the-buffers)))
(kill-buffer "foo")
(kill-buffer "bar")
(kill-buffer "baz"))

(ert-deftest test-rename-buffer ()
(let ((buf (get-buffer-create "test-rename-buffer")))
(with-current-buffer buf
(rename-buffer "test-rename-buffer-foo")
(should (string= (buffer-name buf) "test-rename-buffer-foo")))))
(should (string= (buffer-name buf) "test-rename-buffer-foo")))
(kill-buffer buf)))

(ert-deftest test-rename-buffer-empty ()
(let ((buf (get-buffer-create "test-rename-buffer-empty")))
(with-current-buffer buf
(should-error (rename-buffer "")))))
(should-error (rename-buffer "")))
(kill-buffer buf)))

(ert-deftest test-rename-buffer-existing ()
(let ((buf (get-buffer-create "test-rename-buffer-existing")))
(let ((buf (get-buffer-create "test-rename-buffer-existing"))
(tgt (get-buffer-create "test-rename-buffer-foo")))
(with-current-buffer buf
(should-error (rename-buffer "test-rename-buffer-foo")))))
(should-error (rename-buffer "test-rename-buffer-foo")))
(kill-buffer buf)
(kill-buffer tgt)))

(ert-deftest test-rename-buffer-unique ()
(let ((buf (get-buffer-create "test-rename-buffer")))
(let ((buf (get-buffer-create "test-rename-buffer"))
(tgt (get-buffer-create "test-rename-buffer-foo")))
(with-current-buffer buf
(rename-buffer "test-rename-buffer-foo" t)
(should (string= (buffer-name buf) "test-rename-buffer-foo<2>")))))
(should (string= (buffer-name buf) "test-rename-buffer-foo<2>")))
(kill-buffer buf)
(kill-buffer tgt)))

(ert-deftest test-generate-new-buffer-name ()
(let ((buf-name "test-generate-new-buffer-name"))
(get-buffer-create buf-name)
(should (string= (generate-new-buffer-name buf-name) (concat buf-name "<2>")))))
(should (string= (generate-new-buffer-name buf-name) (concat buf-name "<2>")))
(kill-buffer buf-name)))

(ert-deftest test-generate-new-buffer-name-ignore ()
(let ((buf-name "test-generate-new-buffer-name"))
(get-buffer-create buf-name)
(should (string= (generate-new-buffer-name buf-name buf-name) buf-name))))
(should (string= (generate-new-buffer-name buf-name buf-name) buf-name))
(kill-buffer buf-name)))

(ert-deftest test-generate-new-buffer-name-space ()
(let ((buf-name " test-generate-new-buffer-name"))
Expand All @@ -144,7 +162,49 @@
;; and less than 1_000_000.
(random-number (string-to-number (substring random-name (1+ (length buf-name))))))
(should-not (string= random-name buf-name))
(should (< 0 random-number 999999)))))
(should (< 0 random-number 999999)))
(kill-buffer buf-name)))

;; If we don't create any new buffers, the "other" buffer is *Messages*.
(ert-deftest test-other-buffer-messages ()
(let* ((other (other-buffer)))
(should (string= (buffer-name other) "*Messages*"))))

;; If we don't allow *Messages*, we end up with a newly-created "*scratch*"
(ert-deftest test-other-buffer-scratch ()
;; *scratch* already exists, force recreation.
(kill-buffer "*scratch*")
(let* ((buf (get-buffer "*Messages*"))
(other (other-buffer buf)))
(should (string= (buffer-name other) "*scratch*"))))

;; If we create several buffers, we end up with the first-created.
(ert-deftest test-other-buffer-many ()
(let* ((msgs (get-buffer "*Messages*"))
(buf1 (get-buffer-create "1"))
(buf2 (get-buffer-create "2"))
(buf3 (get-buffer-create "3"))
(other (other-buffer msgs)))
(should (string= (buffer-name other) "1"))
(kill-buffer buf1)
(kill-buffer buf2)
(kill-buffer buf3)))
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm not quite sure how much testing to throw in. Fully testing other-buffer's functionality would require writing a fair chunk of tests (exercising the predicates, visibility, frame-local buffer lists, etc.), and my elisp knowledge is pretty weak. If you think it's worth it, I can add more, but I don't want to create a huge pile of tests for a single function if that looks silly.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Are there tests in the expensive suite? The more tests we have the more flexibility we have to experiment with editor internals.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It is ok to add simple ones and open an Issue for "feature X needs more testing".

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I couldn't see any further tests of other-buffer. I've added a test for the predicate, but the part with visibility requires much more understanding of how to test frames/windows than I currently have.


;; Predicates allow us to skip buffers.
(ert-deftest test-other-buffer-predicate ()
(let* ((f (selected-frame))
(msgs (get-buffer "*Messages*"))
(buf1 (get-buffer-create "1"))
(buf2 (get-buffer-create "2"))
(buf3 (get-buffer-create "3"))
(pred (lambda (b) (not (eq b buf1)))))
(modify-frame-parameters f (list (cons 'buffer-predicate pred)))
(let ((other (other-buffer msgs)))
(should (string= (buffer-name other ) "2")))
(modify-frame-parameters f (list (cons 'buffer-predicate nil)))
(kill-buffer buf1)
(kill-buffer buf2)
(kill-buffer buf3)))

(provide 'buffers-tests)

Expand Down