diff --git a/neovm-core/src/emacs_core/builtins/mod.rs b/neovm-core/src/emacs_core/builtins/mod.rs index 2c077c9215..49ba93a1bf 100644 --- a/neovm-core/src/emacs_core/builtins/mod.rs +++ b/neovm-core/src/emacs_core/builtins/mod.rs @@ -4938,13 +4938,13 @@ pub(crate) fn init_builtins(ctx: &mut super::eval::Context) { ); ctx.defsubr( "define-fringe-bitmap", - |_ctx, args| builtin_define_fringe_bitmap(args), + |ctx, args| builtin_define_fringe_bitmap(ctx, args), 2, Some(5), ); ctx.defsubr( "destroy-fringe-bitmap", - |_ctx, args| builtin_destroy_fringe_bitmap(args), + |ctx, args| builtin_destroy_fringe_bitmap(ctx, args), 1, Some(1), ); @@ -5944,7 +5944,7 @@ pub(crate) fn init_builtins(ctx: &mut super::eval::Context) { ); ctx.defsubr( "set-fringe-bitmap-face", - |_ctx, args| builtin_set_fringe_bitmap_face(args), + |ctx, args| builtin_set_fringe_bitmap_face(ctx, args), 1, Some(2), ); diff --git a/neovm-core/src/emacs_core/builtins/stubs.rs b/neovm-core/src/emacs_core/builtins/stubs.rs index a357354d84..7dff2e4379 100644 --- a/neovm-core/src/emacs_core/builtins/stubs.rs +++ b/neovm-core/src/emacs_core/builtins/stubs.rs @@ -1058,7 +1058,10 @@ pub(crate) fn builtin_fillarray(args: Vec) -> EvalResult { } } -pub(crate) fn builtin_define_fringe_bitmap(args: Vec) -> EvalResult { +pub(crate) fn builtin_define_fringe_bitmap( + ctx: &mut crate::emacs_core::eval::Context, + args: Vec, +) -> EvalResult { expect_range_args("define-fringe-bitmap", &args, 2, 5)?; if args[0].as_symbol_name().is_none() { return Err(signal( @@ -1089,11 +1092,23 @@ pub(crate) fn builtin_define_fringe_bitmap(args: Vec) -> EvalResult { // GNU fringe.c: ALIGN can be a symbol (top, bottom, center) or a // list of alignment flags like (top repeat). Accept any non-nil value. // The actual fringe rendering is a stub; just validate minimally. + ctx.note_macro_expansion_mutation(); + let symbols_with_pos_enabled = ctx.symbols_with_pos_enabled; + super::symbols::put_in_obarray_values( + ctx.obarray_mut(), + args[0], + Value::symbol("fringe"), + Value::fixnum(1), + symbols_with_pos_enabled, + )?; Ok(args[0]) } -pub(crate) fn builtin_destroy_fringe_bitmap(args: Vec) -> EvalResult { +pub(crate) fn builtin_destroy_fringe_bitmap( + ctx: &mut crate::emacs_core::eval::Context, + args: Vec, +) -> EvalResult { expect_args("destroy-fringe-bitmap", &args, 1)?; if args[0].as_symbol_name().is_none() { return Err(signal( @@ -1101,6 +1116,15 @@ pub(crate) fn builtin_destroy_fringe_bitmap(args: Vec) -> EvalResult { vec![Value::symbol("symbolp"), args[0]], )); } + ctx.note_macro_expansion_mutation(); + let symbols_with_pos_enabled = ctx.symbols_with_pos_enabled; + super::symbols::put_in_obarray_values( + ctx.obarray_mut(), + args[0], + Value::symbol("fringe"), + Value::NIL, + symbols_with_pos_enabled, + )?; Ok(Value::NIL) } diff --git a/neovm-core/src/emacs_core/builtins/symbols.rs b/neovm-core/src/emacs_core/builtins/symbols.rs index 31ac643693..800b3dda7f 100644 --- a/neovm-core/src/emacs_core/builtins/symbols.rs +++ b/neovm-core/src/emacs_core/builtins/symbols.rs @@ -3085,10 +3085,15 @@ fn is_known_fringe_bitmap(name: &str) -> bool { ) } -pub(crate) fn builtin_set_fringe_bitmap_face(args: Vec) -> EvalResult { +pub(crate) fn builtin_set_fringe_bitmap_face( + ctx: &mut crate::emacs_core::eval::Context, + args: Vec, +) -> EvalResult { expect_range_args("set-fringe-bitmap-face", &args, 1, 2)?; let bitmap = args[0].as_symbol_name(); - if !bitmap.is_some_and(is_known_fringe_bitmap) { + let has_fringe_property = + symbol_property_get(ctx, args[0], Value::symbol("fringe"))?.1.is_some_and(|v| !v.is_nil()); + if !bitmap.is_some_and(is_known_fringe_bitmap) && !has_fringe_property { return Err(signal( "error", vec![Value::string("Undefined fringe bitmap")], diff --git a/neovm-core/src/emacs_core/builtins/tests.rs b/neovm-core/src/emacs_core/builtins/tests.rs index 98ccf1bad2..3c3eee3107 100644 --- a/neovm-core/src/emacs_core/builtins/tests.rs +++ b/neovm-core/src/emacs_core/builtins/tests.rs @@ -9967,6 +9967,71 @@ fn dispatch_builtin_pure_handles_fringe_display_and_debug_output_placeholders() } } +#[test] +fn defined_fringe_bitmap_can_receive_face_until_destroyed() { + crate::test_utils::init_test_tracing(); + let mut eval = crate::emacs_core::eval::Context::new(); + let result = eval + .eval_str( + r#" + (progn + (define-fringe-bitmap 'vm-test-fringe [0 24 60 126]) + (list (get 'vm-test-fringe 'fringe) + (set-fringe-bitmap-face 'vm-test-fringe 'success) + (destroy-fringe-bitmap 'vm-test-fringe) + (get 'vm-test-fringe 'fringe))) + "#, + ) + .expect("defined fringe bitmap sequence should evaluate"); + + assert_eq!( + crate::emacs_core::print::print_value(&result), + "(1 nil nil nil)" + ); + + let err = dispatch_builtin( + &mut eval, + "set-fringe-bitmap-face", + vec![Value::symbol("vm-test-fringe"), Value::symbol("success")], + ) + .expect("set-fringe-bitmap-face should resolve") + .expect_err("destroyed fringe bitmap should no longer accept a face"); + match err { + Flow::Signal(sig) => { + assert_eq!(sig.symbol_name(), "error"); + assert_eq!( + crate::emacs_core::print::print_value(&sig.data[0]), + "\"Undefined fringe bitmap\"" + ); + } + other => panic!("expected signal, got {other:?}"), + } +} + +#[test] +fn set_fringe_bitmap_face_rejects_non_symbol_bitmap_like_gnu() { + crate::test_utils::init_test_tracing(); + let mut eval = crate::emacs_core::eval::Context::new(); + let err = dispatch_builtin( + &mut eval, + "set-fringe-bitmap-face", + vec![Value::fixnum(1), Value::symbol("success")], + ) + .expect("set-fringe-bitmap-face should resolve") + .expect_err("non-symbol bitmap should signal"); + + match err { + Flow::Signal(sig) => { + assert_eq!(sig.symbol_name(), "wrong-type-argument"); + assert_eq!( + sig.data, + vec![Value::symbol("symbolp"), Value::fixnum(1)] + ); + } + other => panic!("expected signal, got {other:?}"), + } +} + #[test] fn mouse_position_builtins_default_to_selected_frame_with_nil_coords() { crate::test_utils::init_test_tracing();