commit 31abd9a7cffad6bc1d87b8b5e523344eaa86c093 (HEAD, refs/remotes/origin/master) Author: Alan Third Date: Mon Aug 31 09:19:45 2020 +0100 * .gitlab-ci.yml (test-all): Change .m to .c for standard C files. diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index ad01e473b4..e60e79ee2b 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -49,7 +49,7 @@ test-all: - configure.ac - lisp/*.el - lisp/**/*.el - - src/*.{h,m} + - src/*.{h,c} - test/lisp/*.el - test/lisp/**/*.el - test/src/*.el @@ -61,7 +61,7 @@ test-all: # MS Windows - lisp/w32*.el - lisp/term/w32*.el - - src/w32*.{h,m} + - src/w32*.{h,c} # GNUstep - lisp/term/ns-win.el - src/ns*.{h,m} commit 4830ef2f65ad32ba457708d398106a65e4a35141 Author: Paul Eggert Date: Mon Aug 31 00:15:22 2020 -0700 * src/alloc.c (live_symbol_holding): Pacify gcc -Wlogical-op. diff --git a/src/alloc.c b/src/alloc.c index 6b5bfcbd93..b12922b585 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4539,9 +4539,9 @@ live_symbol_holding (struct mem_node *m, void *p) ptrdiff_t off = offset % sizeof b->symbols[0]; if (off == Lisp_Symbol - /* Use u's offset since '|| off == 0' would run afoul of gcc + /* Plain '|| off == 0' would run afoul of GCC 10.2 -Wlogical-op, as Lisp_Symbol happens to be zero. */ - || off == offsetof (struct Lisp_Symbol, u) + || (Lisp_Symbol != 0 && off == 0) || off == offsetof (struct Lisp_Symbol, u.s.name) || off == offsetof (struct Lisp_Symbol, u.s.val) commit 416195fd43c803e40afb52472c155b360e5bcca6 Author: Paul Eggert Date: Sun Aug 30 23:56:39 2020 -0700 * src/lisp.h (lisp_h_XPL, XPL): Remove; unused. diff --git a/src/lisp.h b/src/lisp.h index 745c056bd3..88e69b9061 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -339,24 +339,20 @@ typedef EMACS_INT Lisp_Word; # define lisp_h_XLI(o) ((EMACS_INT) (o)) # define lisp_h_XIL(i) ((Lisp_Object) (i)) # define lisp_h_XLP(o) ((void *) (o)) -# define lisp_h_XPL(p) ((Lisp_Object) (p)) # else # define lisp_h_XLI(o) (o) # define lisp_h_XIL(i) (i) # define lisp_h_XLP(o) ((void *) (uintptr_t) (o)) -# define lisp_h_XPL(p) ((Lisp_Object) (uintptr_t) (p)) # endif #else # if LISP_WORDS_ARE_POINTERS # define lisp_h_XLI(o) ((EMACS_INT) (o).i) # define lisp_h_XIL(i) ((Lisp_Object) {(Lisp_Word) (i)}) # define lisp_h_XLP(o) ((void *) (o).i) -# define lisp_h_XPL(p) lisp_h_XIL (p) # else # define lisp_h_XLI(o) ((o).i) # define lisp_h_XIL(i) ((Lisp_Object) {i}) # define lisp_h_XLP(o) ((void *) (uintptr_t) (o).i) -# define lisp_h_XPL(p) ((Lisp_Object) {(uintptr_t) (p)}) # endif #endif @@ -425,7 +421,6 @@ typedef EMACS_INT Lisp_Word; # define XLI(o) lisp_h_XLI (o) # define XIL(i) lisp_h_XIL (i) # define XLP(o) lisp_h_XLP (o) -# define XPL(p) lisp_h_XPL (p) # define CHECK_FIXNUM(x) lisp_h_CHECK_FIXNUM (x) # define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x) # define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x) @@ -735,12 +730,6 @@ INLINE void * return lisp_h_XLP (o); } -INLINE Lisp_Object -(XPL) (void *p) -{ - return lisp_h_XPL (p); -} - /* Extract A's type. */ INLINE enum Lisp_Type commit 89350d4878aa850624a7fd5d36f981db840fa9af Author: Paul Eggert Date: Sun Aug 30 23:40:11 2020 -0700 Use mark_objects elsewhere too * src/alloc.c (mark_vectorlike, mark_face_cache): * src/eval.c (mark_specpdl): * src/fringe.c (mark_fringe_data): * src/keyboard.c (mark_kboards): Use mark_objects instead of doing it by hand. diff --git a/src/alloc.c b/src/alloc.c index 2f66b5eef5..6b5bfcbd93 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6247,7 +6247,6 @@ mark_vectorlike (union vectorlike_header *header) { struct Lisp_Vector *ptr = (struct Lisp_Vector *) header; ptrdiff_t size = ptr->header.size; - ptrdiff_t i; eassert (!vector_marked_p (ptr)); @@ -6262,8 +6261,7 @@ mark_vectorlike (union vectorlike_header *header) the number of Lisp_Object fields that we should trace. The distinction is used e.g. by Lisp_Process which places extra non-Lisp_Object fields at the end of the structure... */ - for (i = 0; i < size; i++) /* ...and then mark its elements. */ - mark_object (ptr->contents[i]); + mark_objects (ptr->contents, size); } /* Like mark_vectorlike but optimized for char-tables (and @@ -6362,8 +6360,7 @@ mark_face_cache (struct face_cache *c) { if (c) { - int i, j; - for (i = 0; i < c->used; ++i) + for (int i = 0; i < c->used; i++) { struct face *face = FACE_FROM_ID_OR_NULL (c->f, i); @@ -6372,8 +6369,7 @@ mark_face_cache (struct face_cache *c) if (face->font && !vectorlike_marked_p (&face->font->header)) mark_vectorlike (&face->font->header); - for (j = 0; j < LFACE_VECTOR_SIZE; ++j) - mark_object (face->lface[j]); + mark_objects (face->lface, LFACE_VECTOR_SIZE); } } } diff --git a/src/eval.c b/src/eval.c index a9bce552b1..126ee2e955 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3974,8 +3974,7 @@ mark_specpdl (union specbinding *first, union specbinding *ptr) mark_object (backtrace_function (pdl)); if (nargs == UNEVALLED) nargs = 1; - while (nargs--) - mark_object (backtrace_args (pdl)[nargs]); + mark_objects (backtrace_args (pdl), nargs); } break; diff --git a/src/fringe.c b/src/fringe.c index c3d64fefc8..75496692d5 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -1733,11 +1733,7 @@ If nil, also continue lines which are exactly as wide as the window. */); void mark_fringe_data (void) { - int i; - - for (i = 0; i < max_fringe_bitmaps; i++) - if (!NILP (fringe_faces[i])) - mark_object (fringe_faces[i]); + mark_objects (fringe_faces, max_fringe_bitmaps); } /* Initialize this module when Emacs starts. */ diff --git a/src/keyboard.c b/src/keyboard.c index 5fa58abce1..590d183c4c 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -12475,13 +12475,11 @@ keys_of_keyboard (void) void mark_kboards (void) { - KBOARD *kb; - Lisp_Object *p; - for (kb = all_kboards; kb; kb = kb->next_kboard) + for (KBOARD *kb = all_kboards; kb; kb = kb->next_kboard) { if (kb->kbd_macro_buffer) - for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++) - mark_object (*p); + mark_objects (kb->kbd_macro_buffer, + kb->kbd_macro_ptr - kb->kbd_macro_buffer); mark_object (KVAR (kb, Voverriding_terminal_local_map)); mark_object (KVAR (kb, Vlast_command)); mark_object (KVAR (kb, Vreal_last_command)); commit 7e2f6f8448f9d98e90e0343e2aeba22a7985480f Author: Paul Eggert Date: Sun Aug 30 23:40:11 2020 -0700 Remove mark_maybe_object * src/alloc.c (mark_maybe_object, mark_maybe_objects): Remove. (mark_objects): New function. * src/eval.c (mark_specpdl): Use mark_objects instead of mark_maybe_objects, since the array now has only valid Lisp objects. * src/lisp.h (SAFE_ALLOCA_LISP_EXTRA): When allocating a large array, clear it so that it contains only valid Lisp objects. This is simpler and safer, and does not hurt performance significantly on my usual benchmark as the code is executed so rarely. diff --git a/src/alloc.c b/src/alloc.c index 5453c54d93..2f66b5eef5 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4680,117 +4680,33 @@ live_small_vector_p (struct mem_node *m, void *p) return live_small_vector_holding (m, p) == p; } -/* Mark OBJ if we can prove it's a Lisp_Object. */ +/* If P points to Lisp data, mark that as live if it isn't already + marked. */ static void -mark_maybe_object (Lisp_Object obj) +mark_maybe_pointer (void *p) { + struct mem_node *m; + #if USE_VALGRIND - VALGRIND_MAKE_MEM_DEFINED (&obj, sizeof (obj)); + VALGRIND_MAKE_MEM_DEFINED (&p, sizeof (p)); #endif - int type_tag = XTYPE (obj); - intptr_t pointer_word_tag = LISP_WORD_TAG (type_tag), offset, ipo; - - switch (type_tag) - { - case_Lisp_Int: case Lisp_Type_Unused0: - return; - - case Lisp_Symbol: - offset = (intptr_t) lispsym; - break; - - default: - offset = 0; - break; - } - - INT_ADD_WRAPV ((intptr_t) XLP (obj), offset - pointer_word_tag, &ipo); - void *po = (void *) ipo; - /* If the pointer is in the dump image and the dump has a record of the object starting at the place where the pointer points, we definitely have an object. If the pointer is in the dump image and the dump has no idea what the pointer is pointing at, we definitely _don't_ have an object. */ - if (pdumper_object_p (po)) + if (pdumper_object_p (p)) { /* Don't use pdumper_object_p_precise here! It doesn't check the tag bits. OBJ here might be complete garbage, so we need to verify both the pointer and the tag. */ - if (pdumper_find_object_type (po) == type_tag) - mark_object (obj); - return; - } - - struct mem_node *m = mem_find (po); - - if (m != MEM_NIL) - { - bool mark_p = false; - - switch (type_tag) - { - case Lisp_String: - mark_p = m->type == MEM_TYPE_STRING && live_string_p (m, po); - break; - - case Lisp_Cons: - mark_p = m->type == MEM_TYPE_CONS && live_cons_p (m, po); - break; - - case Lisp_Symbol: - mark_p = m->type == MEM_TYPE_SYMBOL && live_symbol_p (m, po); - break; - - case Lisp_Float: - mark_p = m->type == MEM_TYPE_FLOAT && live_float_p (m, po); - break; - - case Lisp_Vectorlike: - mark_p = (m->type == MEM_TYPE_VECTOR_BLOCK - ? live_small_vector_p (m, po) - : (m->type == MEM_TYPE_VECTORLIKE - && live_large_vector_p (m, po))); - break; - - default: - eassume (false); - } - - if (mark_p) - mark_object (obj); - } -} - -void -mark_maybe_objects (Lisp_Object const *array, ptrdiff_t nelts) -{ - for (Lisp_Object const *lim = array + nelts; array < lim; array++) - mark_maybe_object (*array); -} - -/* If P points to Lisp data, mark that as live if it isn't already - marked. */ - -static void -mark_maybe_pointer (void *p) -{ - struct mem_node *m; - -#if USE_VALGRIND - VALGRIND_MAKE_MEM_DEFINED (&p, sizeof (p)); -#endif - - if (pdumper_object_p (p)) - { int type = pdumper_find_object_type (p); if (pdumper_valid_object_type_p (type)) mark_object (type == Lisp_Symbol ? make_lisp_symbol (p) : make_lisp_ptr (p, type)); - /* See mark_maybe_object for why we can confidently return. */ return; } @@ -6570,6 +6486,13 @@ mark_hash_table (struct Lisp_Vector *ptr) } } +void +mark_objects (Lisp_Object *obj, ptrdiff_t n) +{ + for (ptrdiff_t i = 0; i < n; i++) + mark_object (obj[i]); +} + /* Determine type of generic Lisp_Object and mark it accordingly. This function implements a straightforward depth-first marking diff --git a/src/eval.c b/src/eval.c index 9daae92e55..a9bce552b1 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3960,7 +3960,7 @@ mark_specpdl (union specbinding *first, union specbinding *ptr) break; case SPECPDL_UNWIND_ARRAY: - mark_maybe_objects (pdl->unwind_array.array, pdl->unwind_array.nelts); + mark_objects (pdl->unwind_array.array, pdl->unwind_array.nelts); break; case SPECPDL_UNWIND_EXCURSION: diff --git a/src/lisp.h b/src/lisp.h index 7983339ac5..745c056bd3 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3767,12 +3767,12 @@ extern AVOID memory_full (size_t); extern AVOID buffer_memory_full (ptrdiff_t); extern bool survives_gc_p (Lisp_Object); extern void mark_object (Lisp_Object); +extern void mark_objects (Lisp_Object *, ptrdiff_t); #if defined REL_ALLOC && !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC extern void refill_memory_reserve (void); #endif extern void alloc_unexec_pre (void); extern void alloc_unexec_post (void); -extern void mark_maybe_objects (Lisp_Object const *, ptrdiff_t); extern void mark_stack (char const *, char const *); extern void flush_stack_call_func1 (void (*func) (void *arg), void *arg); @@ -4884,7 +4884,10 @@ safe_free_unbind_to (ptrdiff_t count, ptrdiff_t sa_count, Lisp_Object val) (buf) = AVAIL_ALLOCA (alloca_nbytes); \ else \ { \ - (buf) = xmalloc (alloca_nbytes); \ + /* Although only the first nelt words need clearing, \ + typically EXTRA is 0 or small so just use xzalloc; \ + this is simpler and often faster. */ \ + (buf) = xzalloc (alloca_nbytes); \ record_unwind_protect_array (buf, nelt); \ } \ } while (false) commit cf95bb0213908a4caab65dccfa67b4f1572babe2 Author: Paul Eggert Date: Sun Aug 30 23:40:11 2020 -0700 Avoid some false matches in mark_maybe_pointer This lets Emacs avoid marking some garbage as if it were in use. On one test platform (RHEL 7.8, Intel Xeon Silver 4116) it sped up ‘cd lisp; make compile-always’ by a bit over 1%. * src/alloc.c (live_string_holding, live_cons_holding) (live_symbol_holding, live_large_vector_holding) (live_small_vector_holding): Count only pointers that point to a struct component, or are a tagged pointer to the start of the struct. Exception: for non-bool-vector pseudovectors, count any pointer past the header, since it’s too much of a pain to write code for every pseudovector. (live_vector_pointer): New function. diff --git a/src/alloc.c b/src/alloc.c index e057107f98..5453c54d93 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4457,9 +4457,17 @@ live_string_holding (struct mem_node *m, void *p) must not be on the free-list. */ if (0 <= offset && offset < sizeof b->strings) { - struct Lisp_String *s = p = cp -= offset % sizeof b->strings[0]; - if (s->u.s.data) - return s; + ptrdiff_t off = offset % sizeof b->strings[0]; + if (off == Lisp_String + || off == 0 + || off == offsetof (struct Lisp_String, u.s.size_byte) + || off == offsetof (struct Lisp_String, u.s.intervals) + || off == offsetof (struct Lisp_String, u.s.data)) + { + struct Lisp_String *s = p = cp -= off; + if (s->u.s.data) + return s; + } } return NULL; } @@ -4489,9 +4497,15 @@ live_cons_holding (struct mem_node *m, void *p) && (b != cons_block || offset / sizeof b->conses[0] < cons_block_index)) { - struct Lisp_Cons *s = p = cp -= offset % sizeof b->conses[0]; - if (!deadp (s->u.s.car)) - return s; + ptrdiff_t off = offset % sizeof b->conses[0]; + if (off == Lisp_Cons + || off == 0 + || off == offsetof (struct Lisp_Cons, u.s.u.cdr)) + { + struct Lisp_Cons *s = p = cp -= off; + if (!deadp (s->u.s.car)) + return s; + } } return NULL; } @@ -4522,9 +4536,23 @@ live_symbol_holding (struct mem_node *m, void *p) && (b != symbol_block || offset / sizeof b->symbols[0] < symbol_block_index)) { - struct Lisp_Symbol *s = p = cp -= offset % sizeof b->symbols[0]; - if (!deadp (s->u.s.function)) - return s; + ptrdiff_t off = offset % sizeof b->symbols[0]; + if (off == Lisp_Symbol + + /* Use u's offset since '|| off == 0' would run afoul of gcc + -Wlogical-op, as Lisp_Symbol happens to be zero. */ + || off == offsetof (struct Lisp_Symbol, u) + + || off == offsetof (struct Lisp_Symbol, u.s.name) + || off == offsetof (struct Lisp_Symbol, u.s.val) + || off == offsetof (struct Lisp_Symbol, u.s.function) + || off == offsetof (struct Lisp_Symbol, u.s.plist) + || off == offsetof (struct Lisp_Symbol, u.s.next)) + { + struct Lisp_Symbol *s = p = cp -= off; + if (!deadp (s->u.s.function)) + return s; + } } return NULL; } @@ -4571,6 +4599,37 @@ live_float_p (struct mem_node *m, void *p) return live_float_holding (m, p) == p; } +/* Return VECTOR if P points within it, NULL otherwise. */ + +static struct Lisp_Vector * +live_vector_pointer (struct Lisp_Vector *vector, void *p) +{ + void *vvector = vector; + char *cvector = vvector; + char *cp = p; + ptrdiff_t offset = cp - cvector; + return ((offset == Lisp_Vectorlike + || offset == 0 + || (sizeof vector->header <= offset + && offset < vector_nbytes (vector) + && (! (vector->header.size & PSEUDOVECTOR_FLAG) + ? (offsetof (struct Lisp_Vector, contents) <= offset + && (((offset - offsetof (struct Lisp_Vector, contents)) + % word_size) + == 0)) + /* For non-bool-vector pseudovectors, treat any pointer + past the header as valid since it's too much of a pain + to write special-case code for every pseudovector. */ + : (! PSEUDOVECTOR_TYPEP (&vector->header, PVEC_BOOL_VECTOR) + || offset == offsetof (struct Lisp_Bool_Vector, size) + || (offsetof (struct Lisp_Bool_Vector, data) <= offset + && (((offset + - offsetof (struct Lisp_Bool_Vector, data)) + % sizeof (bits_word)) + == 0)))))) + ? vector : NULL); +} + /* If P is a pointer to a live, large vector-like object, return the object. Otherwise, return nil. M is a pointer to the mem_block for P. */ @@ -4579,10 +4638,7 @@ static struct Lisp_Vector * live_large_vector_holding (struct mem_node *m, void *p) { eassert (m->type == MEM_TYPE_VECTORLIKE); - struct Lisp_Vector *vp = p; - struct Lisp_Vector *vector = large_vector_vec (m->start); - struct Lisp_Vector *next = ADVANCE (vector, vector_nbytes (vector)); - return vector <= vp && vp < next ? vector : NULL; + return live_vector_pointer (large_vector_vec (m->start), p); } static bool @@ -4612,7 +4668,7 @@ live_small_vector_holding (struct mem_node *m, void *p) { struct Lisp_Vector *next = ADVANCE (vector, vector_nbytes (vector)); if (vp < next && !PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE)) - return vector; + return live_vector_pointer (vector, vp); vector = next; } return NULL; commit aa1b586a1afaa88e5a9521a7640feefc2c12f009 Author: Paul Eggert Date: Sun Aug 30 23:40:11 2020 -0700 Omit no-longer-needed stack mark_maybe_object * src/alloc.c (mark_memory): Do not bother using mark_maybe_object on the stack, since mark_maybe_pointer now marks everything that mark_maybe_object would. diff --git a/src/alloc.c b/src/alloc.c index 78e0b5f60c..e057107f98 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4868,11 +4868,6 @@ mark_memory (void const *start, void const *end) intptr_t ip; INT_ADD_WRAPV ((intptr_t) p, (intptr_t) lispsym, &ip); mark_maybe_pointer ((void *) ip); - - verify (alignof (Lisp_Object) % GC_POINTER_ALIGNMENT == 0); - if (alignof (Lisp_Object) == GC_POINTER_ALIGNMENT - || (uintptr_t) pp % alignof (Lisp_Object) == 0) - mark_maybe_object (*(Lisp_Object const *) pp); } } commit 2ff930d861b772466b9f6b95d1776696298f3e0b Author: Paul Eggert Date: Sun Aug 30 23:40:11 2020 -0700 Fix GC bug with Lisp floats and --with-wide-int On --with-wide-int platforms where Lisp_Object can be put into non-adjacent registers, mark_maybe_pointer failed to mark a float whose only reference was as a tagged pointer. * src/alloc.c (live_float_holding): New function, a generalization of the old live_float_p. (live_float_p): Use it. (mark_maybe_pointer): Use live_float_holding, not live_float_p. diff --git a/src/alloc.c b/src/alloc.c index b16b2f8b93..78e0b5f60c 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4536,23 +4536,39 @@ live_symbol_p (struct mem_node *m, void *p) } -/* Return true if P is a pointer to a live Lisp float on - the heap. M is a pointer to the mem_block for P. */ +/* If P is a (possibly-tagged) pointer to a live Lisp_Float on the + heap, return the address of the Lisp_Float. Otherwise, return NULL. + M is a pointer to the mem_block for P. */ -static bool -live_float_p (struct mem_node *m, void *p) +static struct Lisp_Float * +live_float_holding (struct mem_node *m, void *p) { eassert (m->type == MEM_TYPE_FLOAT); struct float_block *b = m->start; char *cp = p; ptrdiff_t offset = cp - (char *) &b->floats[0]; - /* P must point to the start of a Lisp_Float and not be - one of the unused cells in the current float block. */ - return (0 <= offset && offset < sizeof b->floats - && offset % sizeof b->floats[0] == 0 + /* P must point to (or be a tagged pointer to) the start of a + Lisp_Float and not be one of the unused cells in the current + float block. */ + if (0 <= offset && offset < sizeof b->floats) + { + int off = offset % sizeof b->floats[0]; + if ((off == Lisp_Float || off == 0) && (b != float_block - || offset / sizeof b->floats[0] < float_block_index)); + || offset / sizeof b->floats[0] < float_block_index)) + { + p = cp - off; + return p; + } + } + return NULL; +} + +static bool +live_float_p (struct mem_node *m, void *p) +{ + return live_float_holding (m, p) == p; } /* If P is a pointer to a live, large vector-like object, return the object. @@ -4762,9 +4778,12 @@ mark_maybe_pointer (void *p) break; case MEM_TYPE_FLOAT: - if (! live_float_p (m, p)) - return; - obj = make_lisp_ptr (p, Lisp_Float); + { + struct Lisp_Float *h = live_float_holding (m, p); + if (!h) + return; + obj = make_lisp_ptr (h, Lisp_Float); + } break; case MEM_TYPE_VECTORLIKE: commit 886ba068c82dcf5e0e2e1244bf99841d4ff5690c Author: Stefan Kangas Date: Thu Aug 20 16:41:50 2020 +0200 Bind 'n' and 'p' in compilation-mode-map * lisp/progmodes/compile.el (compilation-mode-map): Bind '(next|previous)-error-no-select' to 'n' and 'p'. (Bug#41844) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 731db0fd6d..0dedde3d01 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -2064,6 +2064,8 @@ Returns the compilation buffer created." (define-key map "\M-p" 'compilation-previous-error) (define-key map "\M-{" 'compilation-previous-file) (define-key map "\M-}" 'compilation-next-file) + (define-key map "n" 'next-error-no-select) + (define-key map "p" 'previous-error-no-select) (define-key map "\t" 'compilation-next-error) (define-key map [backtab] 'compilation-previous-error) (define-key map "g" 'recompile) ; revert commit 6593d73928da6c9fb1ccc57930566ddd2a37c737 Author: Stefan Kangas Date: Sun Aug 30 19:33:10 2020 +0200 Use lexical-binding in life.el and add tests * lisp/play/life.el: Use lexical-binding. (life--tick): Extract from... (life): ...here. (life--max-width, life--max-height): New variables. (life-mode, life-setup): Use above variables. * test/lisp/play/life-tests.el: New file. diff --git a/lisp/play/life.el b/lisp/play/life.el index a7247be850..56ecc5273d 100644 --- a/lisp/play/life.el +++ b/lisp/play/life.el @@ -1,4 +1,4 @@ -;;; life.el --- John Horton Conway's `Life' game for GNU Emacs +;;; life.el --- John Horton Conway's Game of Life -*- lexical-binding:t -*- ;; Copyright (C) 1988, 2001-2020 Free Software Foundation, Inc. @@ -135,11 +135,25 @@ ;; (scroll-up) and (scroll-down) when trying to center the display. (defvar life-window-start nil) +(defvar life--max-width nil + "If non-nil, restrict width to this positive integer. ") + +(defvar life--max-height nil + "If non-nil, restrict height to this positive integer. ") + ;; For mode line (defvar life-current-generation nil) ;; Sadly, mode-line-format won't display numbers. (defvar life-generation-string nil) +(defun life--tick () + "Game tick for `life'." + (let ((inhibit-quit t) + (inhibit-read-only t)) + (life-grim-reaper) + (life-expand-plane-if-needed) + (life-increment-generation))) + ;;;###autoload (defun life (&optional step-time) "Run Conway's Life simulation. @@ -158,12 +172,8 @@ sleep in seconds." (life-setup) (catch 'life-exit (while t - (let ((inhibit-quit t) - (inhibit-read-only t)) - (life-display-generation step-time) - (life-grim-reaper) - (life-expand-plane-if-needed) - (life-increment-generation))))) + (life-display-generation step-time) + (life--tick)))) (define-derived-mode life-mode special-mode "Life" "Major mode for the buffer of `life'." @@ -174,7 +184,8 @@ sleep in seconds." (setq-local life-generation-string "0") (setq-local mode-line-buffer-identification '("Life: generation " life-generation-string)) - (setq-local fill-column (1- (window-width))) + (setq-local fill-column (min (or life--max-width most-positive-fixnum) + (1- (window-width)))) (setq-local life-window-start 1) (buffer-disable-undo)) @@ -196,7 +207,8 @@ sleep in seconds." (indent-to n) (forward-line))) ;; center the pattern vertically - (let ((n (/ (- (1- (window-height)) + (let ((n (/ (- (min (or life--max-height most-positive-fixnum) + (1- (window-height))) (count-lines (point-min) (point-max))) 2))) (goto-char (point-min)) diff --git a/test/lisp/play/life-tests.el b/test/lisp/play/life-tests.el new file mode 100644 index 0000000000..38726bbc41 --- /dev/null +++ b/test/lisp/play/life-tests.el @@ -0,0 +1,80 @@ +;;; life-tests.el --- Tests for life.el -*- lexical-binding:t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; Author: Stefan Kangas + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) +(require 'life) + +(ert-deftest test-life () + (let ((life--max-width 5) + (life--max-height 3) + (life-patterns [(" @ " + " @" + "@@@")]) + (generations '(" + + @ + @ + @@@ +" " + + + @ @ + @@ + @ +" " + + + @ + @ @ + @@ +" " + + + @ + @@ + @@ +" " + + + @ + @ + @@@ +" +))) + (life-setup) + ;; Test initial state. + (goto-char (point-min)) + (dolist (generation generations) + ;; Hack to test buffer contents without trailing whitespace, + ;; while also not modifying the "*Life*" buffer. + (let ((str (buffer-string)) + (delete-trailing-lines t)) + (with-temp-buffer + (insert str) + (delete-trailing-whitespace) + (should (equal (buffer-string) generation)))) + (life--tick)))) + +(provide 'life-tests) + +;;; life-tests.el ends here commit be2ef629eea4bd4a7b16f6db91aab155db3489c7 Author: Stefan Kangas Date: Sun Aug 30 18:21:11 2020 +0200 Various life.el improvements * lisp/play/life.el (life): New defgroup. (life-step-time): New defcustom (lower default from 1 to 0.5). (life): Use above new variable. Make prefix arguments set step time in tenths of a second instead of whole seconds. (life-expand-plane-if-needed): Rename argument to step-time. (life-setup): Fix running `M-x life' with existing buffer. (life-patterns): Add three more classic patterns. diff --git a/lisp/play/life.el b/lisp/play/life.el index 06d5b4082f..a7247be850 100644 --- a/lisp/play/life.el +++ b/lisp/play/life.el @@ -29,6 +29,15 @@ ;;; Code: +(defgroup life nil + "Conway's Game of Life." + :group 'games) + +(defcustom life-step-time 0.5 + "Time to sleep between steps (generations)." + :type 'number + :version "28.1") + (defvar life-patterns [("@@@" " @@" "@@@") ("@@@ @@@" "@@ @@ " "@@@ @@@") @@ -54,6 +63,7 @@ " @@") ("@@@@@@@@@" "@ @ @" "@ @@@@@ @" "@ @ @ @" "@@@ @@@" "@ @ @ @" "@ @@@@@ @" "@ @ @" "@@@@@@@@@") + ;; Glider Gun (infinite, Bill Gosper, 1970) (" @ " " @ @ " " @@ @@ @@" @@ -74,7 +84,26 @@ " @@" " @@ @" "@ @ @") - ("@@@@@@@@ @@@@@ @@@ @@@@@@@ @@@@@")] + ("@@@@@@@@ @@@@@ @@@ @@@@@@@ @@@@@") + ;; Pentadecathlon (period 15, John Conway, 1970) + (" @ @ " + "@@ @@@@ @@" + " @ @ ") + ;; Queen Bee Shuttle (period 30, Bill Gosper, 1970) + (" @ " + " @ @ " + " @ @ " + "@@ @ @ @@" + "@@ @ @ @@" + " @ @ " + " @ ") + ;; 2x Figure eight (period 8, Simon Norton, 1970) + ("@@@ @@@ " + "@@@ @@@ " + "@@@ @@@ " + " @@@ @@@" + " @@@ @@@" + " @@@ @@@")] "Vector of rectangles containing some Life startup patterns.") ;; Macros are used macros for manifest constants instead of variables @@ -112,19 +141,26 @@ (defvar life-generation-string nil) ;;;###autoload -(defun life (&optional sleeptime) +(defun life (&optional step-time) "Run Conway's Life simulation. -The starting pattern is randomly selected. Prefix arg (optional first -arg non-nil from a program) is the number of seconds to sleep between -generations (this defaults to 1)." - (interactive "p") - (or sleeptime (setq sleeptime 1)) +The starting pattern is randomly selected from `life-patterns'. + +Prefix arg is the number of tenths of a second to sleep between +generations (the default is `life-step-time'). + +When called from Lisp, optional argument STEP-TIME is the time to +sleep in seconds." + (interactive "P") + (setq step-time (or (and step-time (/ (if (consp step-time) + (car step-time) + step-time) 10.0)) + life-step-time)) (life-setup) (catch 'life-exit (while t (let ((inhibit-quit t) (inhibit-read-only t)) - (life-display-generation sleeptime) + (life-display-generation step-time) (life-grim-reaper) (life-expand-plane-if-needed) (life-increment-generation))))) @@ -144,10 +180,10 @@ generations (this defaults to 1)." (defun life-setup () (switch-to-buffer (get-buffer-create "*Life*") t) - (erase-buffer) - (life-mode) ;; stuff in the random pattern (let ((inhibit-read-only t)) + (erase-buffer) + (life-mode) (life-insert-random-pattern) ;; make sure (life-life-char) is used throughout (goto-char (point-min)) @@ -276,12 +312,12 @@ generations (this defaults to 1)." (insert ?\n) (setq life-window-start (+ life-window-start fill-column 1))))) -(defun life-display-generation (sleeptime) +(defun life-display-generation (step-time) (goto-char life-window-start) (recenter 0) ;; Redisplay; if the user has hit a key, exit the loop. - (or (and (sit-for sleeptime) (< 0 sleeptime)) + (or (and (sit-for step-time) (< 0 step-time)) (not (input-pending-p)) (throw 'life-exit nil))) commit 87b4368862c621259e5c45dd65420fa93c7d037a Author: Stefan Kangas Date: Sun Aug 30 13:37:37 2020 +0200 Remove some XEmacs compat code from gamegrid.el * lisp/play/gamegrid.el (gamegrid-setup-face): Remove XEmacs compat code. diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index f0132135fd..9b74eb913e 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -265,12 +265,7 @@ format." (set-face-foreground face color) (set-face-background face color) (gamegrid-set-font face) - (condition-case nil - (set-face-background-pixmap face [nothing]);; XEmacs - (error nil)) - (condition-case nil - (set-face-background-pixmap face nil);; Emacs - (error nil))) + (set-face-background-pixmap face nil)) (defun gamegrid-make-mono-tty-face () (let ((face (make-face 'gamegrid-mono-tty-face))) commit 2c284889e0fbfe9c9c23e471a53436e85345e8f4 Author: Stefan Kangas Date: Sun Aug 30 13:06:12 2020 +0200 * lisp/play/tetris.el: Use lexical-binding. diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el index 97979b5b6b..e25cacbb72 100644 --- a/lisp/play/tetris.el +++ b/lisp/play/tetris.el @@ -1,4 +1,4 @@ -;;; tetris.el --- implementation of Tetris for Emacs +;;; tetris.el --- implementation of Tetris for Emacs -*- lexical-binding:t -*- ;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc. commit 9d10a8ca0508bddbb7fa1cc1c16e61c63a56820d Author: Lars Ingebrigtsen Date: Sun Aug 30 17:03:05 2020 +0200 Tweak background colours in shr when there's indentation * lisp/net/shr.el (shr-fill-line): Get the background colour right for the indentation, too. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 8fdc758032..6517596130 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -751,10 +751,10 @@ size, and full-buffer size." (face (get-text-property (point) 'face))) ;; Extend the background to the end of the line. (insert ?\n) + (shr-indent) (when face - (put-text-property (1- (point)) (point) + (put-text-property gap-start (point) 'face (shr-face-background face))) - (shr-indent) (when (and (> (1- gap-start) (point-min)) (get-text-property (point) 'shr-url) ;; The link on both sides of the newline are the commit 34e7617365f16f9dfa6f31f968a0b5dee6d7d54b Author: Mauro Aranda Date: Sun Aug 30 15:55:19 2020 +0200 Respect :must-match for file types in customization buffers * lisp/wid-edit.el (file widget): Add a :match and a :validate function to the 'file widget, to be able to check if the widget value is an existent file, when required (bug#25678). diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index ea7e266e0d..f58a0fb7a3 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -3161,6 +3161,15 @@ It reads a file name from an editable text field." :completions (completion-table-case-fold #'completion-file-name-table (not read-file-name-completion-ignore-case)) + :match (lambda (widget value) + (or (not (widget-get widget :must-match)) + (file-exists-p value))) + :validate (lambda (widget) + (let ((value (widget-value widget))) + (unless (widget-apply widget :match value) + (widget-put widget + :error (format "File %s does not exist" value)) + widget))) :prompt-value 'widget-file-prompt-value :format "%{%t%}: %v" ;; Doesn't work well with terminating newline. commit dd910dd2f84752e03ab369fa3e967e1d0086f16a Author: João Távora Date: Sat Aug 29 16:39:47 2020 +0100 Place flymake-eldoc-function at the end of eldoc-documentation-functions Having it placed in the beginning of that hook meant it was mostly impossible to track the args to a function call while writing it from scratch, since most compilers issue a diagnostic about incorrect number of arguments. See bug#43103. * lisp/progmodes/flymake.el (flymake-mode): Lower priority of flymake-eldoc-function. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 37e73241e5..bdb775795a 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1002,7 +1002,7 @@ special *Flymake log* buffer." :group 'flymake :lighter (add-hook 'after-change-functions 'flymake-after-change-function nil t) (add-hook 'after-save-hook 'flymake-after-save-hook nil t) (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) - (add-hook 'eldoc-documentation-functions 'flymake-eldoc-function nil t) + (add-hook 'eldoc-documentation-functions 'flymake-eldoc-function t t) ;; If Flymake happened to be alrady already ON, we must cleanup ;; existing diagnostic overlays, lest we forget them by blindly commit bf018eefa2a9c33f9f80e977ee085e89df526992 Author: João Távora Date: Sat Aug 29 15:45:26 2020 +0100 ; tiny indentation fix to lisp/progmodes/elisp-mode.el * lisp/progmodes/elisp-mode.el (elisp-eldoc-var-docstring): Fix indentation. diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 21ba42a0fe..72b94a57b4 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1421,7 +1421,7 @@ Intended for `eldoc-documentation-functions' (which see)." "Document variable at point. Intended for `eldoc-documentation-functions' (which see)." (let* ((sym (elisp--current-symbol)) - (docstring (and sym (elisp-get-var-docstring sym)))) + (docstring (and sym (elisp-get-var-docstring sym)))) (when docstring (funcall callback docstring :thing sym commit 130bf51c411f817c799175a456942ca8a6649e29 Author: Lars Ingebrigtsen Date: Sun Aug 30 15:22:20 2020 +0200 Make format-prompt interpret a nil default value as "no default" * doc/lispref/minibuf.texi (Text from Minibuffer): Document it. * lisp/help-fns.el (describe-function): Adjust the caller. * lisp/minibuffer.el (format-prompt): Interpret a nil default value as "no default". diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 8b4240c5d8..cca06c70a5 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -437,6 +437,9 @@ passed to @code{format} (@pxref{Formatting Strings}). @code{minibuffer-default-prompt-format} can be @samp{""}, in which case no default values are displayed. + +If @var{default} is @code{nil}, there is no default value, and +therefore no ``default value'' string is included in the result value. @end defun @node Object from Minibuffer diff --git a/lisp/help-fns.el b/lisp/help-fns.el index d302c05283..617f6ae5e8 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -151,9 +151,7 @@ When called from lisp, FUNCTION may also be a function object." (let* ((fn (function-called-at-point)) (enable-recursive-minibuffers t) (val (completing-read - (if fn - (format-prompt "Describe function" fn) - "Describe function: ") + (format-prompt "Describe function" fn) #'help--symbol-completion-table (lambda (f) (or (fboundp f) (get f 'function-documentation))) t nil nil diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 47f28d0010..864726e3cc 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3863,12 +3863,16 @@ the minibuffer was activated, and execute the forms." If FORMAT-ARGS is nil, PROMPT is used as a plain string. If FORMAT-ARGS is non-nil, PROMPT is used as a format control string, and FORMAT-ARGS are the arguments to be substituted into -it. See `format' for details." +it. See `format' for details. + +If DEFAULT is nil, no \"default value\" string is included in the +return value." (concat (if (null format-args) prompt (apply #'format prompt format-args)) - (format minibuffer-default-prompt-format default) + (and default + (format minibuffer-default-prompt-format default)) ": ")) (provide 'minibuffer) commit 6ac270dcd35df3cc8cbcdc4b7d01da2c99537a6a Author: Lars Ingebrigtsen Date: Sun Aug 30 14:16:07 2020 +0200 Fix compilation warning in snake.el * lisp/play/snake.el (snake-reset-game): Avoid warning about unused variable. diff --git a/lisp/play/snake.el b/lisp/play/snake.el index 00072a4c05..8ea214d802 100644 --- a/lisp/play/snake.el +++ b/lisp/play/snake.el @@ -279,7 +279,7 @@ and then start moving it leftwards.") snake-velocity-queue nil) (let ((x snake-initial-x) (y snake-initial-y)) - (dotimes (i snake-length) + (dotimes (_ snake-length) (gamegrid-set-cell x y snake-snake) (setq snake-positions (cons (vector x y) snake-positions)) (cl-incf x snake-velocity-x) commit 6803328561956dbc42808160b3716061308411fe Author: Michael Albinus Date: Sun Aug 30 14:05:55 2020 +0200 * .gitlab-ci.yml (test-all): Run only when needed. diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 913ba0fd4f..ad01e473b4 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -40,6 +40,32 @@ stages: test-all: # This tests also file monitor libraries inotify and inotifywatch. stage: test + only: + changes: + - "Makefile.in" + - .gitlab-ci.yml + - aclocal.m4 + - autogen.sh + - configure.ac + - lisp/*.el + - lisp/**/*.el + - src/*.{h,m} + - test/lisp/*.el + - test/lisp/**/*.el + - test/src/*.el + except: + changes: + # gfilemonitor, kqueue + - src/gfilenotify.c + - src/kqueue.c + # MS Windows + - lisp/w32*.el + - lisp/term/w32*.el + - src/w32*.{h,m} + # GNUstep + - lisp/term/ns-win.el + - src/ns*.{h,m} + - src/macfont.{h,m} script: - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 inotify-tools - ./autogen.sh autoconf