From 41fa88b99bebf7af62cdea0c0867b04e9b968db3 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Fri, 28 Sep 2018 14:02:52 -0400 Subject: [PATCH 01/72] ; Fix some doc typos --- lisp/cedet/ede/project-am.el | 2 +- lisp/cedet/semantic/db-ref.el | 2 +- lisp/cedet/semantic/scope.el | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el index d3f0648350c..e0fb111d076 100644 --- a/lisp/cedet/ede/project-am.el +++ b/lisp/cedet/ede/project-am.el @@ -532,7 +532,7 @@ DIR is the directory to apply to new targets." (project-rescan tmp) (setq ntargets (cons tmp ntargets))) (makefile-macro-file-list macro)) - ;; Non-indirect will have a target whos sources + ;; Non-indirect will have a target whose sources ;; are actual files, not names of other targets. (let ((files (makefile-macro-file-list macro))) (when files diff --git a/lisp/cedet/semantic/db-ref.el b/lisp/cedet/semantic/db-ref.el index 8f20fee9545..40d8dbd58b5 100644 --- a/lisp/cedet/semantic/db-ref.el +++ b/lisp/cedet/semantic/db-ref.el @@ -80,7 +80,7 @@ Abstract tables would be difficult to reference." (cl-defmethod semanticdb-check-references ((dbt semanticdb-table)) "Check and cleanup references in the database DBT. -Any reference to a file that cannot be found, or whos file no longer +Any reference to a file that cannot be found, or whose file no longer refers to DBT will be removed." (let ((refs (oref dbt db-refs)) (myexpr (concat "\\<" (oref dbt file))) diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el index a2c68ed3a63..f18451fd59a 100644 --- a/lisp/cedet/semantic/scope.el +++ b/lisp/cedet/semantic/scope.el @@ -140,7 +140,7 @@ Saves scoping information between runs of the analyzer.") (cl-defmethod semantic-scope-set-typecache ((cache semantic-scope-cache) types-in-scope) "Set the :typescope property on CACHE to some types. -TYPES-IN-SCOPE is a list of type tags whos members are +TYPES-IN-SCOPE is a list of type tags whose members are currently in scope. For each type in TYPES-IN-SCOPE, add those members to the types list. If nil, then the typescope is reset." From 7946445962372c4255180af45cb7c857f1b0b5fa Mon Sep 17 00:00:00 2001 From: Alan Third Date: Fri, 28 Sep 2018 20:23:07 +0100 Subject: [PATCH 02/72] Make all NS drawing be done from drawRect See bug#31904 and bug#32812. * src/nsterm.m (ns_update_begin): Don't lock focus, only clip if there is already a view focused. (ns_update_end): Don't mess with view focusing any more. (ns_focus): Only clip drawing if there is already a focused view, otherwise mark area dirty for later drawing. Renamed ns_clip_to_rect. All callers changed. (ns_unfocus): Don't unfocus the view any more. Renamed ns_reset_clipping. All callers changed. (ns_clip_to_row): Update to match ns_clip_to_rect. (ns_clear_frame): (ns_clear_frame_area): (ns_draw_fringe_bitmap): (ns_draw_window_cursor): (ns_draw_vertical_window_border): (ns_draw_window_divider): (ns_dumpglyphs_stretch): (ns_draw_glyph_string): Only draw if ns_focus or ns_clip_to_row return YES. (ns_copy_bits): Remove superfluous calls to ns_(un)focus. (ns_flush_display): New function. --- src/nsterm.m | 787 +++++++++++++++++++++++++-------------------------- 1 file changed, 386 insertions(+), 401 deletions(-) diff --git a/src/nsterm.m b/src/nsterm.m index 5ed71c9f8f1..954020dcde9 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -276,12 +276,7 @@ - (NSColor *)colorUsingDefaultColorSpace long context_menu_value = 0; /* display update */ -static struct frame *ns_updating_frame; -static NSView *focus_view = NULL; static int ns_window_num = 0; -#ifdef NS_IMPL_GNUSTEP -static NSRect uRect; // TODO: This is dead, remove it? -#endif static BOOL gsaved = NO; static BOOL ns_fake_keydown = NO; #ifdef NS_IMPL_COCOA @@ -1039,12 +1034,13 @@ static NSRect constrain_frame_rect(NSRect frameRect, bool isFullscreen) external (RIF) call; whole frame, called before update_window_begin -------------------------------------------------------------------------- */ { +#ifdef NS_IMPL_COCOA EmacsView *view = FRAME_NS_VIEW (f); + NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_begin"); ns_update_auto_hide_menu_bar (); -#ifdef NS_IMPL_COCOA if ([view isFullscreen] && [view fsIsNative]) { // Fix reappearing tool bar in fullscreen for Mac OS X 10.7 @@ -1053,36 +1049,29 @@ static NSRect constrain_frame_rect(NSRect frameRect, bool isFullscreen) if (! tbar_visible != ! [toolbar isVisible]) [toolbar setVisible: tbar_visible]; } -#endif - - ns_updating_frame = f; - [view lockFocus]; /* drawRect may have been called for say the minibuffer, and then clip path is for the minibuffer. But the display engine may draw more because we have set the frame as garbaged. So reset clip path to the whole view. */ -#ifdef NS_IMPL_COCOA - { - NSBezierPath *bp; - NSRect r = [view frame]; - NSRect cr = [[view window] frame]; - /* If a large frame size is set, r may be larger than the window frame - before constrained. In that case don't change the clip path, as we - will clear in to the tool bar and title bar. */ - if (r.size.height - + FRAME_NS_TITLEBAR_HEIGHT (f) - + FRAME_TOOLBAR_HEIGHT (f) <= cr.size.height) - { - bp = [[NSBezierPath bezierPathWithRect: r] retain]; - [bp setClip]; - [bp release]; - } - } -#endif - -#ifdef NS_IMPL_GNUSTEP - uRect = NSMakeRect (0, 0, 0, 0); + /* FIXME: I don't think we need to do this. */ + if ([NSView focusView] == FRAME_NS_VIEW (f)) + { + NSBezierPath *bp; + NSRect r = [view frame]; + NSRect cr = [[view window] frame]; + /* If a large frame size is set, r may be larger than the window frame + before constrained. In that case don't change the clip path, as we + will clear in to the tool bar and title bar. */ + if (r.size.height + + FRAME_NS_TITLEBAR_HEIGHT (f) + + FRAME_TOOLBAR_HEIGHT (f) <= cr.size.height) + { + bp = [[NSBezierPath bezierPathWithRect: r] retain]; + [bp setClip]; + [bp release]; + } + } #endif } @@ -1164,99 +1153,66 @@ static NSRect constrain_frame_rect(NSRect frameRect, bool isFullscreen) external (RIF) call; for whole frame, called after update_window_end -------------------------------------------------------------------------- */ { - EmacsView *view = FRAME_NS_VIEW (f); - NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_end"); /* if (f == MOUSE_HL_INFO (f)->mouse_face_mouse_frame) */ MOUSE_HL_INFO (f)->mouse_face_defer = 0; - - block_input (); - - [view unlockFocus]; - [[view window] flushWindow]; - - unblock_input (); - ns_updating_frame = NULL; } -static void -ns_focus (struct frame *f, NSRect *r, int n) + +static BOOL +ns_clip_to_rect (struct frame *f, NSRect *r, int n) /* -------------------------------------------------------------------------- - Internal: Focus on given frame. During small local updates this is used to - draw, however during large updates, ns_update_begin and ns_update_end are - called to wrap the whole thing, in which case these calls are stubbed out. - Except, on GNUstep, we accumulate the rectangle being drawn into, because - the back end won't do this automatically, and will just end up flushing - the entire window. + Clip the drawing area to rectangle r in frame f. If drawing is not + currently possible mark r as dirty and return NO, otherwise return + YES. -------------------------------------------------------------------------- */ { - NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_focus"); - if (r != NULL) + NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_clip_to_rect"); + if (r) { NSTRACE_RECT ("r", *r); - } - if (f != ns_updating_frame) - { - NSView *view = FRAME_NS_VIEW (f); - if (view != focus_view) + if ([NSView focusView] == FRAME_NS_VIEW (f)) { - if (focus_view != NULL) - { - [focus_view unlockFocus]; - [[focus_view window] flushWindow]; -/*debug_lock--; */ - } + [[NSGraphicsContext currentContext] saveGraphicsState]; + if (n == 2) + NSRectClipList (r, 2); + else + NSRectClip (*r); + gsaved = YES; - if (view) - [view lockFocus]; - focus_view = view; -/*if (view) debug_lock++; */ + return YES; + } + else + { + NSView *view = FRAME_NS_VIEW (f); + int i; + for (i = 0 ; i < n ; i++) + [view setNeedsDisplayInRect:r[i]]; } } - /* clipping */ - if (r) - { - [[NSGraphicsContext currentContext] saveGraphicsState]; - if (n == 2) - NSRectClipList (r, 2); - else - NSRectClip (*r); - gsaved = YES; - } + return NO; } static void -ns_unfocus (struct frame *f) -/* -------------------------------------------------------------------------- - Internal: Remove focus on given frame - -------------------------------------------------------------------------- */ +ns_reset_clipping (struct frame *f) +/* Internal: Restore the previous graphics state, unsetting any + clipping areas. */ { - NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_unfocus"); + NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_reset_clipping"); if (gsaved) { [[NSGraphicsContext currentContext] restoreGraphicsState]; gsaved = NO; } - - if (f != ns_updating_frame) - { - if (focus_view != NULL) - { - [focus_view unlockFocus]; - [[focus_view window] flushWindow]; - focus_view = NULL; -/*debug_lock--; */ - } - } } -static void +static BOOL ns_clip_to_row (struct window *w, struct glyph_row *row, enum glyph_row_area area, BOOL gc) /* -------------------------------------------------------------------------- @@ -1275,7 +1231,19 @@ static NSRect constrain_frame_rect(NSRect frameRect, bool isFullscreen) clip_rect.size.width = window_width; clip_rect.size.height = row->visible_height; - ns_focus (f, &clip_rect, 1); + return ns_clip_to_rect (f, &clip_rect, 1); +} + + +static void +ns_flush_display (struct frame *f) +/* Force the frame to redisplay. If areas have previously been marked + dirty by setNeedsDisplayInRect (in ns_clip_to_rect), then this will call + draw_rect: which will "expose" those areas. */ +{ + block_input (); + [FRAME_NS_VIEW (f) displayIfNeeded]; + unblock_input (); } @@ -2699,14 +2667,16 @@ so some key presses (TAB) are swallowed by the system. */ r = [view bounds]; block_input (); - ns_focus (f, &r, 1); - [ns_lookup_indexed_color (NS_FACE_BACKGROUND - (FACE_FROM_ID (f, DEFAULT_FACE_ID)), f) set]; - NSRectFill (r); - ns_unfocus (f); + if (ns_clip_to_rect (f, &r, 1)) + { + [ns_lookup_indexed_color (NS_FACE_BACKGROUND + (FACE_FROM_ID (f, DEFAULT_FACE_ID)), f) set]; + NSRectFill (r); + ns_reset_clipping (f); - /* as of 2006/11 or so this is now needed */ - ns_redraw_scroll_bars (f); + /* as of 2006/11 or so this is now needed */ + ns_redraw_scroll_bars (f); + } unblock_input (); } @@ -2727,13 +2697,14 @@ so some key presses (TAB) are swallowed by the system. */ NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_clear_frame_area"); r = NSIntersectionRect (r, [view frame]); - ns_focus (f, &r, 1); - [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set]; + if (ns_clip_to_rect (f, &r, 1)) + { + [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set]; - NSRectFill (r); + NSRectFill (r); - ns_unfocus (f); - return; + ns_reset_clipping (f); + } } static void @@ -2745,11 +2716,11 @@ so some key presses (TAB) are swallowed by the system. */ { hide_bell(); // Ensure the bell image isn't scrolled. - ns_focus (f, &dest, 1); + /* FIXME: scrollRect:by: is deprecated in macOS 10.14. There is + no obvious replacement so we may have to come up with our own. */ [FRAME_NS_VIEW (f) scrollRect: src by: NSMakeSize (dest.origin.x - src.origin.x, dest.origin.y - src.origin.y)]; - ns_unfocus (f); } } @@ -2960,85 +2931,86 @@ so some key presses (TAB) are swallowed by the system. */ } /* Must clip because of partially visible lines. */ - ns_clip_to_row (w, row, ANY_AREA, YES); - - if (!p->overlay_p) + if (ns_clip_to_row (w, row, ANY_AREA, YES)) { - int bx = p->bx, by = p->by, nx = p->nx, ny = p->ny; - - if (bx >= 0 && nx > 0) + if (!p->overlay_p) { - NSRect r = NSMakeRect (bx, by, nx, ny); + int bx = p->bx, by = p->by, nx = p->nx, ny = p->ny; + + if (bx >= 0 && nx > 0) + { + NSRect r = NSMakeRect (bx, by, nx, ny); + NSRectClip (r); + [ns_lookup_indexed_color (face->background, f) set]; + NSRectFill (r); + } + } + + if (p->which) + { + NSRect r = NSMakeRect (p->x, p->y, p->wd, p->h); + EmacsImage *img = bimgs[p->which - 1]; + + if (!img) + { + // Note: For "periodic" images, allocate one EmacsImage for + // the base image, and use it for all dh:s. + unsigned short *bits = p->bits; + int full_height = p->h + p->dh; + int i; + unsigned char *cbits = xmalloc (full_height); + + for (i = 0; i < full_height; i++) + cbits[i] = bits[i]; + img = [[EmacsImage alloc] initFromXBM: cbits width: 8 + height: full_height + fg: 0 bg: 0]; + bimgs[p->which - 1] = img; + xfree (cbits); + } + + NSTRACE_RECT ("r", r); + NSRectClip (r); - [ns_lookup_indexed_color (face->background, f) set]; + /* Since we composite the bitmap instead of just blitting it, we need + to erase the whole background. */ + [ns_lookup_indexed_color(face->background, f) set]; NSRectFill (r); - } - } - if (p->which) - { - NSRect r = NSMakeRect (p->x, p->y, p->wd, p->h); - EmacsImage *img = bimgs[p->which - 1]; - - if (!img) - { - // Note: For "periodic" images, allocate one EmacsImage for - // the base image, and use it for all dh:s. - unsigned short *bits = p->bits; - int full_height = p->h + p->dh; - int i; - unsigned char *cbits = xmalloc (full_height); - - for (i = 0; i < full_height; i++) - cbits[i] = bits[i]; - img = [[EmacsImage alloc] initFromXBM: cbits width: 8 - height: full_height - fg: 0 bg: 0]; - bimgs[p->which - 1] = img; - xfree (cbits); - } - - NSTRACE_RECT ("r", r); - - NSRectClip (r); - /* Since we composite the bitmap instead of just blitting it, we need - to erase the whole background. */ - [ns_lookup_indexed_color(face->background, f) set]; - NSRectFill (r); - - { - NSColor *bm_color; - if (!p->cursor_p) - bm_color = ns_lookup_indexed_color(face->foreground, f); - else if (p->overlay_p) - bm_color = ns_lookup_indexed_color(face->background, f); - else - bm_color = f->output_data.ns->cursor_color; - [img setXBMColor: bm_color]; - } + { + NSColor *bm_color; + if (!p->cursor_p) + bm_color = ns_lookup_indexed_color(face->foreground, f); + else if (p->overlay_p) + bm_color = ns_lookup_indexed_color(face->background, f); + else + bm_color = f->output_data.ns->cursor_color; + [img setXBMColor: bm_color]; + } #ifdef NS_IMPL_COCOA - // Note: For periodic images, the full image height is "h + hd". - // By using the height h, a suitable part of the image is used. - NSRect fromRect = NSMakeRect(0, 0, p->wd, p->h); + // Note: For periodic images, the full image height is "h + hd". + // By using the height h, a suitable part of the image is used. + NSRect fromRect = NSMakeRect(0, 0, p->wd, p->h); - NSTRACE_RECT ("fromRect", fromRect); + NSTRACE_RECT ("fromRect", fromRect); - [img drawInRect: r - fromRect: fromRect - operation: NSCompositingOperationSourceOver - fraction: 1.0 - respectFlipped: YES - hints: nil]; + [img drawInRect: r + fromRect: fromRect + operation: NSCompositingOperationSourceOver + fraction: 1.0 + respectFlipped: YES + hints: nil]; #else - { - NSPoint pt = r.origin; - pt.y += p->h; - [img compositeToPoint: pt operation: NSCompositingOperationSourceOver]; - } + { + NSPoint pt = r.origin; + pt.y += p->h; + [img compositeToPoint: pt operation: NSCompositingOperationSourceOver]; + } #endif + } + ns_reset_clipping (f); } - ns_unfocus (f); } @@ -3120,67 +3092,66 @@ Note that CURSOR_WIDTH is meaningful only for (h)bar cursors. r.size.height = h; r.size.width = w->phys_cursor_width; - /* Prevent the cursor from being drawn outside the text area. */ - ns_clip_to_row (w, glyph_row, TEXT_AREA, NO); /* do ns_focus(f, &r, 1); if remove */ - - - face = FACE_FROM_ID_OR_NULL (f, phys_cursor_glyph->face_id); - if (face && NS_FACE_BACKGROUND (face) - == ns_index_color (FRAME_CURSOR_COLOR (f), f)) + /* Prevent the cursor from being drawn outside the text area. */ + if (ns_clip_to_row (w, glyph_row, TEXT_AREA, NO)) { - [ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), f) set]; - hollow_color = FRAME_CURSOR_COLOR (f); - } - else - [FRAME_CURSOR_COLOR (f) set]; + face = FACE_FROM_ID_OR_NULL (f, phys_cursor_glyph->face_id); + if (face && NS_FACE_BACKGROUND (face) + == ns_index_color (FRAME_CURSOR_COLOR (f), f)) + { + [ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), f) set]; + hollow_color = FRAME_CURSOR_COLOR (f); + } + else + [FRAME_CURSOR_COLOR (f) set]; #ifdef NS_IMPL_COCOA - /* TODO: This makes drawing of cursor plus that of phys_cursor_glyph - atomic. Cleaner ways of doing this should be investigated. - One way would be to set a global variable DRAWING_CURSOR - when making the call to draw_phys..(), don't focus in that - case, then move the ns_unfocus() here after that call. */ - NSDisableScreenUpdates (); + /* TODO: This makes drawing of cursor plus that of phys_cursor_glyph + atomic. Cleaner ways of doing this should be investigated. + One way would be to set a global variable DRAWING_CURSOR + when making the call to draw_phys..(), don't focus in that + case, then move the ns_reset_clipping() here after that call. */ + NSDisableScreenUpdates (); #endif - switch (cursor_type) - { - case DEFAULT_CURSOR: - case NO_CURSOR: - break; - case FILLED_BOX_CURSOR: - NSRectFill (r); - break; - case HOLLOW_BOX_CURSOR: - NSRectFill (r); - [hollow_color set]; - NSRectFill (NSInsetRect (r, 1, 1)); - [FRAME_CURSOR_COLOR (f) set]; - break; - case HBAR_CURSOR: - NSRectFill (r); - break; - case BAR_CURSOR: - s = r; - /* If the character under cursor is R2L, draw the bar cursor - on the right of its glyph, rather than on the left. */ - cursor_glyph = get_phys_cursor_glyph (w); - if ((cursor_glyph->resolved_level & 1) != 0) - s.origin.x += cursor_glyph->pixel_width - s.size.width; + switch (cursor_type) + { + case DEFAULT_CURSOR: + case NO_CURSOR: + break; + case FILLED_BOX_CURSOR: + NSRectFill (r); + break; + case HOLLOW_BOX_CURSOR: + NSRectFill (r); + [hollow_color set]; + NSRectFill (NSInsetRect (r, 1, 1)); + [FRAME_CURSOR_COLOR (f) set]; + break; + case HBAR_CURSOR: + NSRectFill (r); + break; + case BAR_CURSOR: + s = r; + /* If the character under cursor is R2L, draw the bar cursor + on the right of its glyph, rather than on the left. */ + cursor_glyph = get_phys_cursor_glyph (w); + if ((cursor_glyph->resolved_level & 1) != 0) + s.origin.x += cursor_glyph->pixel_width - s.size.width; - NSRectFill (s); - break; - } - ns_unfocus (f); + NSRectFill (s); + break; + } + ns_reset_clipping (f); - /* draw the character under the cursor */ - if (cursor_type != NO_CURSOR) - draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); + /* draw the character under the cursor */ + if (cursor_type != NO_CURSOR) + draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); #ifdef NS_IMPL_COCOA - NSEnableScreenUpdates (); + NSEnableScreenUpdates (); #endif - + } } @@ -3198,12 +3169,14 @@ Note that CURSOR_WIDTH is meaningful only for (h)bar cursors. face = FACE_FROM_ID_OR_NULL (f, VERTICAL_BORDER_FACE_ID); - ns_focus (f, &r, 1); - if (face) - [ns_lookup_indexed_color(face->foreground, f) set]; + if (ns_clip_to_rect (f, &r, 1)) + { + if (face) + [ns_lookup_indexed_color(face->foreground, f) set]; - NSRectFill(r); - ns_unfocus (f); + NSRectFill(r); + ns_reset_clipping (f); + } } @@ -3230,39 +3203,40 @@ Note that CURSOR_WIDTH is meaningful only for (h)bar cursors. NSTRACE ("ns_draw_window_divider"); - ns_focus (f, ÷r, 1); + if (ns_clip_to_rect (f, ÷r, 1)) + { + if ((y1 - y0 > x1 - x0) && (x1 - x0 >= 3)) + /* A vertical divider, at least three pixels wide: Draw first and + last pixels differently. */ + { + [ns_lookup_indexed_color(color_first, f) set]; + NSRectFill(NSMakeRect (x0, y0, 1, y1 - y0)); + [ns_lookup_indexed_color(color, f) set]; + NSRectFill(NSMakeRect (x0 + 1, y0, x1 - x0 - 2, y1 - y0)); + [ns_lookup_indexed_color(color_last, f) set]; + NSRectFill(NSMakeRect (x1 - 1, y0, 1, y1 - y0)); + } + else if ((x1 - x0 > y1 - y0) && (y1 - y0 >= 3)) + /* A horizontal divider, at least three pixels high: Draw first and + last pixels differently. */ + { + [ns_lookup_indexed_color(color_first, f) set]; + NSRectFill(NSMakeRect (x0, y0, x1 - x0, 1)); + [ns_lookup_indexed_color(color, f) set]; + NSRectFill(NSMakeRect (x0, y0 + 1, x1 - x0, y1 - y0 - 2)); + [ns_lookup_indexed_color(color_last, f) set]; + NSRectFill(NSMakeRect (x0, y1 - 1, x1 - x0, 1)); + } + else + { + /* In any other case do not draw the first and last pixels + differently. */ + [ns_lookup_indexed_color(color, f) set]; + NSRectFill(divider); + } - if ((y1 - y0 > x1 - x0) && (x1 - x0 >= 3)) - /* A vertical divider, at least three pixels wide: Draw first and - last pixels differently. */ - { - [ns_lookup_indexed_color(color_first, f) set]; - NSRectFill(NSMakeRect (x0, y0, 1, y1 - y0)); - [ns_lookup_indexed_color(color, f) set]; - NSRectFill(NSMakeRect (x0 + 1, y0, x1 - x0 - 2, y1 - y0)); - [ns_lookup_indexed_color(color_last, f) set]; - NSRectFill(NSMakeRect (x1 - 1, y0, 1, y1 - y0)); + ns_reset_clipping (f); } - else if ((x1 - x0 > y1 - y0) && (y1 - y0 >= 3)) - /* A horizontal divider, at least three pixels high: Draw first and - last pixels differently. */ - { - [ns_lookup_indexed_color(color_first, f) set]; - NSRectFill(NSMakeRect (x0, y0, x1 - x0, 1)); - [ns_lookup_indexed_color(color, f) set]; - NSRectFill(NSMakeRect (x0, y0 + 1, x1 - x0, y1 - y0 - 2)); - [ns_lookup_indexed_color(color_last, f) set]; - NSRectFill(NSMakeRect (x0, y1 - 1, x1 - x0, 1)); - } - else - { - /* In any other case do not draw the first and last pixels - differently. */ - [ns_lookup_indexed_color(color, f) set]; - NSRectFill(divider); - } - - ns_unfocus (f); } static void @@ -3846,83 +3820,84 @@ Function modeled after x_draw_glyph_string_box (). n = ns_get_glyph_string_clip_rect (s, r); *r = NSMakeRect (s->x, s->y, s->background_width, s->height); - ns_focus (s->f, r, n); - - if (s->hl == DRAW_MOUSE_FACE) - { - face = FACE_FROM_ID_OR_NULL (s->f, - MOUSE_HL_INFO (s->f)->mouse_face_face_id); - if (!face) - face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); - } - else - face = FACE_FROM_ID (s->f, s->first_glyph->face_id); - - bgCol = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f); - fgCol = ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f); - - for (i = 0; i < n; ++i) + if (ns_clip_to_rect (s->f, r, n)) { - if (!s->row->full_width_p) + if (s->hl == DRAW_MOUSE_FACE) { - int overrun, leftoverrun; - - /* truncate to avoid overwriting fringe and/or scrollbar */ - overrun = max (0, (s->x + s->background_width) - - (WINDOW_BOX_RIGHT_EDGE_X (s->w) - - WINDOW_RIGHT_FRINGE_WIDTH (s->w))); - r[i].size.width -= overrun; - - /* truncate to avoid overwriting to left of the window box */ - leftoverrun = (WINDOW_BOX_LEFT_EDGE_X (s->w) - + WINDOW_LEFT_FRINGE_WIDTH (s->w)) - s->x; - - if (leftoverrun > 0) - { - r[i].origin.x += leftoverrun; - r[i].size.width -= leftoverrun; - } - - /* XXX: Try to work between problem where a stretch glyph on - a partially-visible bottom row will clear part of the - modeline, and another where list-buffers headers and similar - rows erroneously have visible_height set to 0. Not sure - where this is coming from as other terms seem not to show. */ - r[i].size.height = min (s->height, s->row->visible_height); - } - - [bgCol set]; - - /* NOTE: under NS this is NOT used to draw cursors, but we must avoid - overwriting cursor (usually when cursor on a tab) */ - if (s->hl == DRAW_CURSOR) - { - CGFloat x, width; - - x = r[i].origin.x; - width = s->w->phys_cursor_width; - r[i].size.width -= width; - r[i].origin.x += width; - - NSRectFill (r[i]); - - /* Draw overlining, etc. on the cursor. */ - if (s->w->phys_cursor_type == FILLED_BOX_CURSOR) - ns_draw_text_decoration (s, face, bgCol, width, x); - else - ns_draw_text_decoration (s, face, fgCol, width, x); + face = FACE_FROM_ID_OR_NULL (s->f, + MOUSE_HL_INFO (s->f)->mouse_face_face_id); + if (!face) + face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); } else - { - NSRectFill (r[i]); - } + face = FACE_FROM_ID (s->f, s->first_glyph->face_id); - /* Draw overlining, etc. on the stretch glyph (or the part - of the stretch glyph after the cursor). */ - ns_draw_text_decoration (s, face, fgCol, r[i].size.width, - r[i].origin.x); + bgCol = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f); + fgCol = ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f); + + for (i = 0; i < n; ++i) + { + if (!s->row->full_width_p) + { + int overrun, leftoverrun; + + /* truncate to avoid overwriting fringe and/or scrollbar */ + overrun = max (0, (s->x + s->background_width) + - (WINDOW_BOX_RIGHT_EDGE_X (s->w) + - WINDOW_RIGHT_FRINGE_WIDTH (s->w))); + r[i].size.width -= overrun; + + /* truncate to avoid overwriting to left of the window box */ + leftoverrun = (WINDOW_BOX_LEFT_EDGE_X (s->w) + + WINDOW_LEFT_FRINGE_WIDTH (s->w)) - s->x; + + if (leftoverrun > 0) + { + r[i].origin.x += leftoverrun; + r[i].size.width -= leftoverrun; + } + + /* XXX: Try to work between problem where a stretch glyph on + a partially-visible bottom row will clear part of the + modeline, and another where list-buffers headers and similar + rows erroneously have visible_height set to 0. Not sure + where this is coming from as other terms seem not to show. */ + r[i].size.height = min (s->height, s->row->visible_height); + } + + [bgCol set]; + + /* NOTE: under NS this is NOT used to draw cursors, but we must avoid + overwriting cursor (usually when cursor on a tab). */ + if (s->hl == DRAW_CURSOR) + { + CGFloat x, width; + + x = r[i].origin.x; + width = s->w->phys_cursor_width; + r[i].size.width -= width; + r[i].origin.x += width; + + NSRectFill (r[i]); + + /* Draw overlining, etc. on the cursor. */ + if (s->w->phys_cursor_type == FILLED_BOX_CURSOR) + ns_draw_text_decoration (s, face, bgCol, width, x); + else + ns_draw_text_decoration (s, face, fgCol, width, x); + } + else + { + NSRectFill (r[i]); + } + + /* Draw overlining, etc. on the stretch glyph (or the part + of the stretch glyph after the cursor). */ + ns_draw_text_decoration (s, face, fgCol, r[i].size.width, + r[i].origin.x); + } + ns_reset_clipping (s->f); } - ns_unfocus (s->f); s->background_filled_p = 1; } } @@ -4072,9 +4047,11 @@ overwriting cursor (usually when cursor on a tab) */ if (next->first_glyph->type != STRETCH_GLYPH) { n = ns_get_glyph_string_clip_rect (s->next, r); - ns_focus (s->f, r, n); - ns_maybe_dumpglyphs_background (s->next, 1); - ns_unfocus (s->f); + if (ns_clip_to_rect (s->f, r, n)) + { + ns_maybe_dumpglyphs_background (s->next, 1); + ns_reset_clipping (s->f); + } } else { @@ -4089,10 +4066,12 @@ overwriting cursor (usually when cursor on a tab) */ || s->first_glyph->type == COMPOSITE_GLYPH)) { n = ns_get_glyph_string_clip_rect (s, r); - ns_focus (s->f, r, n); - ns_maybe_dumpglyphs_background (s, 1); - ns_dumpglyphs_box_or_relief (s); - ns_unfocus (s->f); + if (ns_clip_to_rect (s->f, r, n)) + { + ns_maybe_dumpglyphs_background (s, 1); + ns_dumpglyphs_box_or_relief (s); + ns_reset_clipping (s->f); + } box_drawn_p = 1; } @@ -4101,9 +4080,11 @@ overwriting cursor (usually when cursor on a tab) */ case IMAGE_GLYPH: n = ns_get_glyph_string_clip_rect (s, r); - ns_focus (s->f, r, n); - ns_dumpglyphs_image (s, r[0]); - ns_unfocus (s->f); + if (ns_clip_to_rect (s->f, r, n)) + { + ns_dumpglyphs_image (s, r[0]); + ns_reset_clipping (s->f); + } break; case STRETCH_GLYPH: @@ -4113,66 +4094,68 @@ overwriting cursor (usually when cursor on a tab) */ case CHAR_GLYPH: case COMPOSITE_GLYPH: n = ns_get_glyph_string_clip_rect (s, r); - ns_focus (s->f, r, n); - - if (s->for_overlaps || (s->cmp_from > 0 - && ! s->first_glyph->u.cmp.automatic)) - s->background_filled_p = 1; - else - ns_maybe_dumpglyphs_background - (s, s->first_glyph->type == COMPOSITE_GLYPH); - - if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) + if (ns_clip_to_rect (s->f, r, n)) { - unsigned long tmp = NS_FACE_BACKGROUND (s->face); - NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); - NS_FACE_FOREGROUND (s->face) = tmp; + if (s->for_overlaps || (s->cmp_from > 0 + && ! s->first_glyph->u.cmp.automatic)) + s->background_filled_p = 1; + else + ns_maybe_dumpglyphs_background + (s, s->first_glyph->type == COMPOSITE_GLYPH); + + if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) + { + unsigned long tmp = NS_FACE_BACKGROUND (s->face); + NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); + NS_FACE_FOREGROUND (s->face) = tmp; + } + + { + BOOL isComposite = s->first_glyph->type == COMPOSITE_GLYPH; + + if (isComposite) + ns_draw_composite_glyph_string_foreground (s); + else + ns_draw_glyph_string_foreground (s); + } + + { + NSColor *col = (NS_FACE_FOREGROUND (s->face) != 0 + ? ns_lookup_indexed_color (NS_FACE_FOREGROUND (s->face), + s->f) + : FRAME_FOREGROUND_COLOR (s->f)); + [col set]; + + /* Draw underline, overline, strike-through. */ + ns_draw_text_decoration (s, s->face, col, s->width, s->x); + } + + if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) + { + unsigned long tmp = NS_FACE_BACKGROUND (s->face); + NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); + NS_FACE_FOREGROUND (s->face) = tmp; + } + + ns_reset_clipping (s->f); } - - { - BOOL isComposite = s->first_glyph->type == COMPOSITE_GLYPH; - - if (isComposite) - ns_draw_composite_glyph_string_foreground (s); - else - ns_draw_glyph_string_foreground (s); - } - - { - NSColor *col = (NS_FACE_FOREGROUND (s->face) != 0 - ? ns_lookup_indexed_color (NS_FACE_FOREGROUND (s->face), - s->f) - : FRAME_FOREGROUND_COLOR (s->f)); - [col set]; - - /* Draw underline, overline, strike-through. */ - ns_draw_text_decoration (s, s->face, col, s->width, s->x); - } - - if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) - { - unsigned long tmp = NS_FACE_BACKGROUND (s->face); - NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); - NS_FACE_FOREGROUND (s->face) = tmp; - } - - ns_unfocus (s->f); break; case GLYPHLESS_GLYPH: n = ns_get_glyph_string_clip_rect (s, r); - ns_focus (s->f, r, n); - - if (s->for_overlaps || (s->cmp_from > 0 - && ! s->first_glyph->u.cmp.automatic)) - s->background_filled_p = 1; - else - ns_maybe_dumpglyphs_background - (s, s->first_glyph->type == COMPOSITE_GLYPH); - /* ... */ - /* Not yet implemented. */ - /* ... */ - ns_unfocus (s->f); + if (ns_clip_to_rect (s->f, r, n)) + { + if (s->for_overlaps || (s->cmp_from > 0 + && ! s->first_glyph->u.cmp.automatic)) + s->background_filled_p = 1; + else + ns_maybe_dumpglyphs_background + (s, s->first_glyph->type == COMPOSITE_GLYPH); + /* ... */ + /* Not yet implemented. */ + /* ... */ + ns_reset_clipping (s->f); + } break; default: @@ -4183,9 +4166,11 @@ overwriting cursor (usually when cursor on a tab) */ if (!s->for_overlaps && !box_drawn_p && s->face->box != FACE_NO_BOX) { n = ns_get_glyph_string_clip_rect (s, r); - ns_focus (s->f, r, n); - ns_dumpglyphs_box_or_relief (s); - ns_unfocus (s->f); + if (ns_clip_to_rect (s->f, r, n)) + { + ns_dumpglyphs_box_or_relief (s); + ns_reset_clipping (s->f); + } } s->num_clips = 0; @@ -4991,7 +4976,7 @@ static Lisp_Object ns_string_to_lispmod (const char *s) ns_after_update_window_line, ns_update_window_begin, ns_update_window_end, - 0, /* flush_display */ + ns_flush_display, /* flush_display */ x_clear_window_mouse_face, x_get_glyph_overhangs, x_fix_overlapping_area, From 9ad0f1d15c06eb07dfbd9bd3e3b8a0d747942152 Mon Sep 17 00:00:00 2001 From: Alan Third Date: Wed, 26 Sep 2018 22:21:37 +0100 Subject: [PATCH 03/72] Fix deprecation warning * src/nsterm.m (ns_term_init): Use writeToFile or writeToURL as required. --- src/nsterm.m | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/src/nsterm.m b/src/nsterm.m index 954020dcde9..d92d6c32448 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -5193,7 +5193,21 @@ Needs to be here because ns_initialize_display_info () uses AppKit classes. alpha: 1.0] forKey: [NSString stringWithUTF8String: name]]; } - [cl writeToFile: nil]; + + /* FIXME: Report any errors writing the color file below. */ +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 101100 +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101100 + if ([cl respondsToSelector:@selector(writeToURL:error:)]) +#endif + [cl writeToURL:nil error:nil]; +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101100 + else +#endif +#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 101100 */ +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101100 \ + || defined (NS_IMPL_GNUSTEP) + [cl writeToFile: nil]; +#endif } } From e8a4d942dd7305b85850603c97d987e52510a726 Mon Sep 17 00:00:00 2001 From: John Shahid Date: Fri, 21 Sep 2018 11:15:10 -0400 Subject: [PATCH 04/72] Cleanup when opening a new terminal fails. (Bug#32794) * src/term.c (init_tty): Call delete_terminal_internal if emacs_open fail. * src/terminal.c (delete_terminal): Move some code into delete_terminal_internal and call it. (delete_terminal_internal): New function. * src/termhooks.h: Prototype for delete_terminal_internal. --- src/term.c | 1 + src/termhooks.h | 1 + src/terminal.c | 9 ++++++++- 3 files changed, 10 insertions(+), 1 deletion(-) diff --git a/src/term.c b/src/term.c index f542fc527c4..8493cc02c4d 100644 --- a/src/term.c +++ b/src/term.c @@ -4004,6 +4004,7 @@ init_tty (const char *name, const char *terminal_type, bool must_succeed) char const *diagnostic = (fd < 0) ? "Could not open file: %s" : "Not a tty device: %s"; emacs_close (fd); + delete_terminal_internal (terminal); maybe_fatal (must_succeed, terminal, diagnostic, diagnostic, name); } diff --git a/src/termhooks.h b/src/termhooks.h index 1b2c95e8248..543809b9e40 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -729,6 +729,7 @@ extern struct terminal *get_named_terminal (const char *); extern struct terminal *create_terminal (enum output_method, struct redisplay_interface *); extern void delete_terminal (struct terminal *); +extern void delete_terminal_internal (struct terminal *); extern Lisp_Object terminal_glyph_code (struct terminal *, int); /* The initial terminal device, created by initial_term_init. */ diff --git a/src/terminal.c b/src/terminal.c index 070b8aac1fe..043ee67e0c1 100644 --- a/src/terminal.c +++ b/src/terminal.c @@ -314,7 +314,6 @@ create_terminal (enum output_method type, struct redisplay_interface *rif) void delete_terminal (struct terminal *terminal) { - struct terminal **tp; Lisp_Object tail, frame; /* Protect against recursive calls. delete_frame calls the @@ -335,6 +334,14 @@ delete_terminal (struct terminal *terminal) } } + delete_terminal_internal (terminal); +} + +void +delete_terminal_internal (struct terminal *terminal) +{ + struct terminal **tp; + for (tp = &terminal_list; *tp != terminal; tp = &(*tp)->next_terminal) if (! *tp) emacs_abort (); From d416109f06ab3910e3f49176185154a5179b6354 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 29 Sep 2018 10:11:08 +0300 Subject: [PATCH 05/72] Avoid returning early in 'while-no-input' due to subprocesses * src/keyboard.c (kbd_buffer_store_buffered_event): Support also the internal buffer-switch events. (syms_of_keyboard) : New DEFSYM. * lisp/subr.el (while-no-input-ignore-events): Ignore 'buffer-switch' events. Reported by Michael Heerdegen . * etc/NEWS: Mention the change in behavior of 'while-no-input' --- etc/NEWS | 10 ++++++++++ lisp/subr.el | 2 +- src/keyboard.c | 3 +++ 3 files changed, 14 insertions(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index 578b9b8d956..bfd7db016f2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -123,6 +123,16 @@ be removed prior using the changed 'shadow-*' commands. The old name is an alias of the new name. Future Emacs version will obsolete it. +--- +** 'while-no-input' does not return due to input from subprocesses. +Input that arrived from subprocesses while some code executed inside +the 'while-no-input' form injected an internal buffer-switch event +that counted as input and would cause 'while-no-input' to return, +perhaps prematurely. These buffer-switch events are now by default +ignored by 'while-no-input'; if you need to get the old behavior, +remove 'buffer-switch' from the list of events in +'while-no-input-ignore-events'. + * Lisp Changes in Emacs 26.2 diff --git a/lisp/subr.el b/lisp/subr.el index 7582b6cdb85..59f6949b211 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3542,7 +3542,7 @@ is allowed once again. (Immediately, if `inhibit-quit' is nil.)" ;; Don't throw `throw-on-input' on those events by default. (setq while-no-input-ignore-events '(focus-in focus-out help-echo iconify-frame - make-frame-visible selection-request)) + make-frame-visible selection-request buffer-switch)) (defmacro while-no-input (&rest body) "Execute BODY only as long as there's no pending input. diff --git a/src/keyboard.c b/src/keyboard.c index 1da5ac088d3..0d56ea3f7ac 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -3569,6 +3569,7 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event, case ICONIFY_EVENT: ignore_event = Qiconify_frame; break; case DEICONIFY_EVENT: ignore_event = Qmake_frame_visible; break; case SELECTION_REQUEST_EVENT: ignore_event = Qselection_request; break; + case BUFFER_SWITCH_EVENT: ignore_event = Qbuffer_switch; break; default: ignore_event = Qnil; break; } @@ -11104,6 +11105,8 @@ syms_of_keyboard (void) /* Menu and tool bar item parts. */ DEFSYM (Qmenu_enable, "menu-enable"); + DEFSYM (Qbuffer_switch, "buffer-switch"); + #ifdef HAVE_NTGUI DEFSYM (Qlanguage_change, "language-change"); DEFSYM (Qend_session, "end-session"); From 7296b6fbf27aeae76ea63ab2d9d9f2e46491b971 Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Sat, 29 Sep 2018 18:06:03 +0900 Subject: [PATCH 06/72] Improve cl-do, cl-do* docstrings * lisp/emacs-lisp/cl-macs.el(cl-do, cl-do*): Improve docstring (Bug#32803). --- lisp/emacs-lisp/cl-macs.el | 39 ++++++++++++++++++++++++++++++++++++-- 1 file changed, 37 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 0854e665b9b..ffe88a21a85 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1745,7 +1745,24 @@ such that COMBO is equivalent to (and . CLAUSES)." ;;;###autoload (defmacro cl-do (steps endtest &rest body) - "The Common Lisp `do' loop. + "Bind variables and run BODY forms until END-TEST returns non-nil. +First, each VAR is bound to the associated INIT value as if by a `let' form. +Then, in each iteration of the loop, the END-TEST is evaluated; if true, +the loop is finished. Otherwise, the BODY forms are evaluated, then each +VAR is set to the associated STEP expression (as if by a `cl-psetq' form) +and the next iteration begins. + +Once the END-TEST becomes true, the RESULT forms are evaluated (with +the VARs still bound to their values) to produce the result +returned by `cl-do'. + +Note that the entire loop is enclosed in an implicit `nil' block, so +that you can use `cl-return' to exit at any time. + +Also note that END-TEST is checked before evaluating BODY. If END-TEST +is initially non-nil, `cl-do' will exit without running BODY. + +For more details, see `cl-do' description in Info node `(cl) Iteration'. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" (declare (indent 2) @@ -1757,7 +1774,25 @@ such that COMBO is equivalent to (and . CLAUSES)." ;;;###autoload (defmacro cl-do* (steps endtest &rest body) - "The Common Lisp `do*' loop. + "Bind variables and run BODY forms until END-TEST returns non-nil. +First, each VAR is bound to the associated INIT value as if by a `let*' form. +Then, in each iteration of the loop, the END-TEST is evaluated; if true, +the loop is finished. Otherwise, the BODY forms are evaluated, then each +VAR is set to the associated STEP expression (as if by a `setq' +form) and the next iteration begins. + +Once the END-TEST becomes true, the RESULT forms are evaluated (with +the VARs still bound to their values) to produce the result +returned by `cl-do*'. + +Note that the entire loop is enclosed in an implicit `nil' block, so +that you can use `cl-return' to exit at any time. + +Also note that END-TEST is checked before evaluating BODY. If END-TEST +is initially non-nil, `cl-do*' will exit without running BODY. + +This is to `cl-do' what `let*' is to `let'. +For more details, see `cl-do*' description in Info node `(cl) Iteration'. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" (declare (indent 2) (debug cl-do)) From fcea30604254e1e77eaa88d9b4d15dd048d41233 Mon Sep 17 00:00:00 2001 From: Alan Third Date: Sat, 29 Sep 2018 14:47:23 +0100 Subject: [PATCH 07/72] ; Add myself to MAINTAINERS file --- admin/MAINTAINERS | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index 10633a8e0e8..6db1d8801cb 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -240,6 +240,14 @@ Vibhav Pant lisp/net/browse-url.el lisp/erc/* +Alan Third + The NS port: + nextstep/* + src/ns* + src/*.m + lisp/term/ns-win.el + doc/emacs/macos.texi + ;;; Local Variables: ;;; coding: utf-8 From 6650751ce73413d05599df07a9c5bc70744260f3 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Sun, 30 Sep 2018 10:46:26 +0000 Subject: [PATCH 08/72] Temporary workaround for bug #32848 for branch emacs-26 Do not merge with master. * lisp/follow.el (follow-mode): Set make-cursor-line-fully-visible to nil buffer locally whilst follow-mode is active. --- lisp/follow.el | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/lisp/follow.el b/lisp/follow.el index fd397c077bb..7942901bb4f 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -438,7 +438,10 @@ Keys specific to Follow mode: (setq pos-visible-in-window-group-p-function 'follow-pos-visible-in-window-p) (setq selected-window-group-function 'follow-all-followers) - (setq move-to-window-group-line-function 'follow-move-to-window-line)) + (setq move-to-window-group-line-function 'follow-move-to-window-line) + + ;; Crude workaround for bug #32848 for the emacs-26 branch, 2018-09-30. + (setq-local make-cursor-line-fully-visible nil)) ;; Remove globally-installed hook functions only if there is no ;; other Follow mode buffer. @@ -451,6 +454,9 @@ Keys specific to Follow mode: (remove-hook 'post-command-hook 'follow-post-command-hook) (remove-hook 'window-size-change-functions 'follow-window-size-change))) + ;; Second part of crude workaround for bug #32848. + (kill-local-variable 'make-cursor-line-fully-visible) + (kill-local-variable 'move-to-window-group-line-function) (kill-local-variable 'selected-window-group-function) (kill-local-variable 'pos-visible-in-window-group-p-function) From 8bd48212020ee206b782477ac32b918861bcaf08 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 30 Sep 2018 14:14:59 +0300 Subject: [PATCH 09/72] Allow 'make-cursor-line-fully-visible' name a function * src/xdisp.c (cursor_row_fully_visible_p): Handle the case of make-cursor-line-fully-visible being a function. Accept a 3rd argument; if non-zero, assume the caller already tested the conditions for the cursor being fully-visible, and don't recheck them. All callers changed. (try_cursor_movement, try_window_id): Call cursor_row_fully_visible_p instead of testing the value of make-cursor-line-fully-visible directly. (syms_of_xdisp) : Update the doc string. Define a symbol Qmake_cursor_line_fully_visible. (Bug#32848) * lisp/cus-start.el (standard): Update the Custom form. * etc/NEWS: Mention the change in possible values of 'make-cursor-line-fully-visible'. --- etc/NEWS | 6 +++++ lisp/cus-start.el | 7 ++++- src/xdisp.c | 69 +++++++++++++++++++++++++++++++++++------------ 3 files changed, 64 insertions(+), 18 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 7e7de165ec1..155394ef68f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -220,6 +220,12 @@ This triggers to search the program on the remote host as indicated by When set to t, no message will be shown when auto-saving (default value: nil). +--- +** The value of 'make-cursor-line-fully-visible' can now be a function. +In addition to nil or non-nil, the value can now be a predicate +function. Follow mode uses this to control scrolling of its windows +when the last screen line in a window is not fully visible. + * Editing Changes in Emacs 27.1 diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 88a61753f25..e33fe6e5ecf 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -547,7 +547,12 @@ since it could result in memory overflow and make Emacs crash." (const :tag "Respect `truncate-lines'" nil) (other :tag "Truncate if not full-width" t)) "23.1") - (make-cursor-line-fully-visible windows boolean) + (make-cursor-line-fully-visible + windows + (choice + (const :tag "Make cursor always fully visible" t) + (const :tag "Allow cursor to be partially-visible" nil) + (function :tag "User-defined function"))) (mode-line-in-non-selected-windows mode-line boolean "22.1") (line-number-display-limit display (choice integer diff --git a/src/xdisp.c b/src/xdisp.c index 93cd54a3240..d61d421f08a 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -842,7 +842,7 @@ static Lisp_Object redisplay_window_1 (Lisp_Object); static bool set_cursor_from_row (struct window *, struct glyph_row *, struct glyph_matrix *, ptrdiff_t, ptrdiff_t, int, int); -static bool cursor_row_fully_visible_p (struct window *, bool, bool); +static bool cursor_row_fully_visible_p (struct window *, bool, bool, bool); static bool update_menu_bar (struct frame *, bool, bool); static bool try_window_reusing_current_matrix (struct window *); static int try_window_id (struct window *); @@ -14346,7 +14346,7 @@ redisplay_internal (void) eassert (this_line_vpos == it.vpos); eassert (this_line_y == it.current_y); set_cursor_from_row (w, row, w->current_matrix, 0, 0, 0, 0); - if (cursor_row_fully_visible_p (w, false, true)) + if (cursor_row_fully_visible_p (w, false, true, false)) { #ifdef GLYPH_DEBUG *w->desired_matrix->method = 0; @@ -15628,19 +15628,46 @@ run_window_scroll_functions (Lisp_Object window, struct text_pos startp) window's current glyph matrix; otherwise use the desired glyph matrix. + If JUST_TEST_USER_PREFERENCE_P, just test what the value of + make-cursor-row-fully-visible requires, don't test the actual + cursor position. The assumption is that in that case the caller + performs the necessary testing of the cursor position. + A value of false means the caller should do scrolling as if point had gone off the screen. */ static bool cursor_row_fully_visible_p (struct window *w, bool force_p, - bool current_matrix_p) + bool current_matrix_p, + bool just_test_user_preference_p) { struct glyph_matrix *matrix; struct glyph_row *row; int window_height; + Lisp_Object mclfv_p = + buffer_local_value (Qmake_cursor_line_fully_visible, w->contents); - if (!make_cursor_line_fully_visible_p) + /* If no local binding, use the global value. */ + if (EQ (mclfv_p, Qunbound)) + mclfv_p = Vmake_cursor_line_fully_visible; + /* Follow mode sets the variable to a Lisp function in buffers that + are under Follow mode. */ + if (FUNCTIONP (mclfv_p)) + { + Lisp_Object window; + XSETWINDOW (window, w); + /* Implementation note: if the function we call here signals an + error, we will NOT scroll when the cursor is partially-visible. */ + Lisp_Object val = safe_call1 (mclfv_p, window); + if (NILP (val)) + return true; + else if (just_test_user_preference_p) + return false; + } + else if (NILP (mclfv_p)) return true; + else if (just_test_user_preference_p) + return false; /* It's not always possible to find the cursor, e.g, when a window is full of overlay strings. Don't do anything in that case. */ @@ -16002,7 +16029,7 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, /* If cursor ends up on a partially visible line, treat that as being off the bottom of the screen. */ if (! cursor_row_fully_visible_p (w, extra_scroll_margin_lines <= 1, - false) + false, false) /* It's possible that the cursor is on the first line of the buffer, which is partially obscured due to a vscroll (Bug#7537). In that case, avoid looping forever. */ @@ -16367,7 +16394,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, /* Make sure this isn't a header line by any chance, since then MATRIX_ROW_PARTIALLY_VISIBLE_P might yield true. */ && !row->mode_line_p - && make_cursor_line_fully_visible_p) + && !cursor_row_fully_visible_p (w, true, true, true)) { if (PT == MATRIX_ROW_END_CHARPOS (row) && !row->ends_at_zv_p @@ -16385,7 +16412,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, else { set_cursor_from_row (w, row, w->current_matrix, 0, 0, 0, 0); - if (!cursor_row_fully_visible_p (w, false, true)) + if (!cursor_row_fully_visible_p (w, false, true, false)) rc = CURSOR_MOVEMENT_MUST_SCROLL; else rc = CURSOR_MOVEMENT_SUCCESS; @@ -16964,7 +16991,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) new_vpos = window_box_height (w) / 2; } - if (!cursor_row_fully_visible_p (w, false, false)) + if (!cursor_row_fully_visible_p (w, false, false, false)) { /* Point does appear, but on a line partly visible at end of window. Move it back to a fully-visible line. */ @@ -17059,7 +17086,8 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) goto need_larger_matrices; } } - if (w->cursor.vpos < 0 || !cursor_row_fully_visible_p (w, false, false)) + if (w->cursor.vpos < 0 + || !cursor_row_fully_visible_p (w, false, false, false)) { clear_glyph_matrix (w->desired_matrix); goto try_to_scroll; @@ -17206,7 +17234,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) /* Forget any recorded base line for line number display. */ w->base_line_number = 0; - if (!cursor_row_fully_visible_p (w, true, false)) + if (!cursor_row_fully_visible_p (w, true, false, false)) { clear_glyph_matrix (w->desired_matrix); last_line_misfit = true; @@ -17502,7 +17530,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) set_cursor_from_row (w, row, matrix, 0, 0, 0, 0); } - if (!cursor_row_fully_visible_p (w, false, false)) + if (!cursor_row_fully_visible_p (w, false, false, false)) { /* If vscroll is enabled, disable it and try again. */ if (w->vscroll) @@ -19068,9 +19096,10 @@ try_window_id (struct window *w) && CHARPOS (start) > BEGV) /* Old redisplay didn't take scroll margin into account at the bottom, but then global-hl-line-mode doesn't scroll. KFS 2004-06-14 */ - || (w->cursor.y + (make_cursor_line_fully_visible_p - ? cursor_height + this_scroll_margin - : 1)) > it.last_visible_y) + || (w->cursor.y + + (cursor_row_fully_visible_p (w, false, true, true) + ? 1 + : cursor_height + this_scroll_margin)) > it.last_visible_y) { w->cursor.vpos = -1; clear_glyph_matrix (w->desired_matrix); @@ -32903,9 +32932,15 @@ automatically; to decrease the tool-bar height, use \\[recenter]. */); doc: /* Non-nil means raise tool-bar buttons when the mouse moves over them. */); auto_raise_tool_bar_buttons_p = true; - DEFVAR_BOOL ("make-cursor-line-fully-visible", make_cursor_line_fully_visible_p, - doc: /* Non-nil means to scroll (recenter) cursor line if it is not fully visible. */); - make_cursor_line_fully_visible_p = true; + DEFVAR_LISP ("make-cursor-line-fully-visible", Vmake_cursor_line_fully_visible, + doc: /* Whether to scroll the window if the cursor line is not fully visible. +If the value is non-nil, Emacs scrolls or recenters the window to make +the cursor line fully visible. The value could also be a function, which +is called with a single argument, the window to be scrolled, and should +return non-nil if the partially-visible cursor requires scrolling the +window, nil if it's okay to leave the cursor partially-visible. */); + Vmake_cursor_line_fully_visible = Qt; + DEFSYM (Qmake_cursor_line_fully_visible, "make-cursor-line-fully-visible"); DEFVAR_LISP ("tool-bar-border", Vtool_bar_border, doc: /* Border below tool-bar in pixels. From 6a7a869c33bb69efd93bb0ce8d8322083dbbcbac Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 29 Sep 2018 16:40:42 +0200 Subject: [PATCH 10/72] Org manual: Rewrite the Org Mobile section * doc/misc/org.texi (Org Mobile): Rewritten from "MobileOrg" section. Remove all references to non-free software. Moved into "Miscellaneous", much like Org Crypt library. No longer an appendix. (Footnotes): Remove a reference to "MobileOrg". (Bug#32722) --- doc/misc/org.texi | 293 ++++++++++++++++++++++++---------------------- 1 file changed, 152 insertions(+), 141 deletions(-) diff --git a/doc/misc/org.texi b/doc/misc/org.texi index 60647e65e88..873ce4d2cdb 100644 --- a/doc/misc/org.texi +++ b/doc/misc/org.texi @@ -325,7 +325,6 @@ Jambunathan K, Dan Davison, Thomas Dye, David O'Toole, and Philip Rooke. * Working with source code:: Export, evaluate, and tangle code blocks * Miscellaneous:: All the rest which did not fit elsewhere * Hacking:: How to hack your way around -* MobileOrg:: Viewing and capture on a mobile device * History and acknowledgments:: How Org came into being * GNU Free Documentation License:: The license for this documentation. * Main Index:: An index of Org's concepts and features @@ -760,12 +759,19 @@ Miscellaneous * TTY keys:: Using Org on a tty * Interaction:: With other Emacs packages * org-crypt:: Encrypting Org files +* Org Mobile:: Viewing and capture on a mobile device Interaction with other packages * Cooperation:: Packages Org cooperates with * Conflicts:: Packages that lead to conflicts +Org Mobile + +* Setting up the staging area:: For the mobile device +* Pushing to the mobile application:: Uploading Org files and agendas +* Pulling from the mobile application:: Integrating captured and flagged items + Hacking * Hooks:: How to reach into Org's internals @@ -788,12 +794,6 @@ Tables and lists in arbitrary syntax * Translator functions:: Copy and modify * Radio lists:: Sending and receiving lists -MobileOrg - -* Setting up the staging area:: For the mobile device -* Pushing to MobileOrg:: Uploading Org files and agendas -* Pulling from MobileOrg:: Integrating captured and flagged items - @end detailmenu @end menu @@ -17253,6 +17253,7 @@ emacs -Q --batch --eval " * TTY keys:: Using Org on a tty * Interaction:: With other Emacs packages * org-crypt:: Encrypting Org files +* Org Mobile:: Viewing and capture on a mobile device @end menu @@ -18187,6 +18188,150 @@ Suggested Org crypt settings in Emacs init file: Excluding the crypt tag from inheritance prevents encrypting previously encrypted text. +@node Org Mobile +@section Org Mobile + +@cindex smartphone + +Org Mobile is a protocol for synchronizing Org files between Emacs and +other applications, e.g., on mobile devices. It enables offline-views +and capture support for an Org mode system that is rooted on a ``real'' +computer. The external application can also record changes to +existing entries. + +This appendix describes Org's support for agenda view formats +compatible with Org Mobile. It also describes synchronizing changes, +such as to notes, between the mobile application and the computer. + +To change tags and TODO states in the mobile application, first +customize the variables @code{org-todo-keywords} and @code{org-tag-alist}. +These should cover all the important tags and TODO keywords, even if +Org files use only some of them. Though the mobile application is +expected to support in-buffer settings, it is required to understand +TODO states @emph{sets} (see @ref{Per-file keywords}) and +@emph{mutually exclusive} tags (see @ref{Setting tags}) only for those set in +these variables. + +@menu +* Setting up the staging area:: For the mobile device +* Pushing to the mobile application:: Uploading Org files and agendas +* Pulling from the mobile application:: Integrating captured and flagged items +@end menu + +@node Setting up the staging area +@subsection Setting up the staging area + +@vindex org-mobile-directory +The mobile application needs access to a file directory on +a server@footnote{For a server to host files, consider using a WebDAV server, +such as @uref{https://nextcloud.com, Nextcloud}. Additional help is at this @uref{https://orgmode.org/worg/org-faq.html#mobileorg_webdav, FAQ entry}.} to interact with Emacs. Pass its location through +the @code{org-mobile-directory} variable. If you can mount that directory +locally just set the variable to point to that directory: + +@lisp +(setq org-mobile-directory "~/orgmobile/") +@end lisp + +@noindent +Alternatively, by using TRAMP (see @ref{Top,TRAMP User Manual,,tramp,}), +@code{org-mobile-directory} may point to a remote directory accessible +through, for example, SSH and SCP: + +@lisp +(setq org-mobile-directory "/scpc:user@@remote.host:org/webdav/") +@end lisp + +@vindex org-mobile-encryption +With a public server, consider encrypting the files. Org also +requires OpenSSL installed on the local computer. To turn on +encryption, set the same password in the mobile application and in +Emacs. Set the password in the variable +@code{org-mobile-use-encryption}@footnote{If Emacs is configured for safe storing of passwords, then +configure the variable @code{org-mobile-encryption-password}; please read +the docstring of that variable.}. Note that even after the mobile +application encrypts the file contents, the file name remains visible +on the file systems of the local computer, the server, and the mobile +device. + +@node Pushing to the mobile application +@subsection Pushing to the mobile application + +@findex org-mobile-push +@vindex org-mobile-files +The command @code{org-mobile-push} copies files listed in +@code{org-mobile-files} into the staging area. Files include agenda files +(as listed in @code{org-agenda-files}). Customize @code{org-mobile-files} to +add other files. File names are staged with paths relative to +@code{org-directory}, so all files should be inside this directory@footnote{Symbolic links in @code{org-directory} need to have the same name +as their targets.}. + +Push creates a special Org file @samp{agendas.org} with custom agenda views +defined by the user@footnote{While creating the agendas, Org mode forces ID properties on +all referenced entries, so that these entries can be uniquely +identified if Org Mobile flags them for further action. To avoid +setting properties configure the variable +@code{org-mobile-force-id-on-agenda-items} to @code{nil}. Org mode then relies +on outline paths, assuming they are unique.}. + +Finally, Org writes the file @samp{index.org}, containing links to other +files. The mobile application reads this file first from the server +to determine what other files to download for agendas. For faster +downloads, it is expected to only read files whose checksums@footnote{Checksums are stored automatically in the file +@samp{checksums.dat}.} +have changed. + +@node Pulling from the mobile application +@subsection Pulling from the mobile application + +@findex org-mobile-pull +The command @code{org-mobile-pull} synchronizes changes with the server. +More specifically, it first pulls the Org files for viewing. It then +appends captured entries and pointers to flagged or changed entries to +the file @samp{mobileorg.org} on the server. Org ultimately integrates its +data in an inbox file format, through the following steps: + +@enumerate +@item +@vindex org-mobile-inbox-for-pull +Org moves all entries found in @samp{mobileorg.org}@footnote{The file will be empty after this operation.} and appends +them to the file pointed to by the variable +@code{org-mobile-inbox-for-pull}. It should reside neither in the +staging area nor on the server. Each captured entry and each +editing event is a top-level entry in the inbox file. + +@item +@cindex @samp{FLAGGED}, tag +After moving the entries, Org processes changes to the shared +files. Some of them are applied directly and without user +interaction. Examples include changes to tags, TODO state, +headline and body text. Entries requiring further action are +tagged as @samp{FLAGGED}. Org marks entries with problems with an error +message in the inbox. They have to be resolved manually. + +@item +Org generates an agenda view for flagged entries for user +intervention to clean up. For notes stored in flagged entries, Org +displays them in the echo area when point is on the corresponding +agenda item. + +@table @asis +@item @kbd{?} +Pressing @kbd{?} displays the entire flagged note in +another window. Org also pushes it to the kill ring. To +store flagged note as a normal note, use @kbd{? z C-y C-c C-c}. Pressing @kbd{?} twice does these things: first +it removes the @samp{FLAGGED} tag; second, it removes the flagged +note from the property drawer; third, it signals that manual +editing of the flagged entry is now finished. +@end table +@end enumerate + +@kindex ? @r{(Agenda dispatcher)} +From the agenda dispatcher, @kbd{?} returns to the view to finish +processing flagged entries. Note that these entries may not be the +most recent since the mobile application searches files that were last +pulled. To get an updated agenda view with changes since the last +pull, pull again. + @node Hacking @appendix Hacking @cindex hacking @@ -19151,140 +19296,6 @@ The following example counts the number of entries with TODO keyword (length (org-map-entries t "/+WAITING" 'agenda)) @end lisp -@node MobileOrg -@appendix MobileOrg -@cindex iPhone -@cindex MobileOrg - -MobileOrg is a companion mobile app that runs on iOS and Android devices. -MobileOrg enables offline-views and capture support for an Org mode system -that is rooted on a ``real'' computer. MobileOrg can record changes to -existing entries. - -The @uref{https://github.com/MobileOrg/, iOS implementation} for the -@emph{iPhone/iPod Touch/iPad} series of devices, was started by Richard -Moreland and is now in the hands Sean Escriva. Android users should check -out @uref{http://wiki.github.com/matburt/mobileorg-android/, MobileOrg -Android} by Matt Jones. Though the two implementations are not identical, -they offer similar features. - -This appendix describes Org's support for agenda view formats compatible with -MobileOrg. It also describes synchronizing changes, such as to notes, -between MobileOrg and the computer. - -To change tags and TODO states in MobileOrg, first customize the variables -@code{org-todo-keywords} and @code{org-tag-alist}. These should cover all -the important tags and TODO keywords, even if Org files use only some of -them. Though MobileOrg has in-buffer settings, it understands TODO states -@emph{sets} (@pxref{Per-file keywords}) and @emph{mutually exclusive} tags -(@pxref{Setting tags}) only for those set in these variables. - -@menu -* Setting up the staging area:: For the mobile device -* Pushing to MobileOrg:: Uploading Org files and agendas -* Pulling from MobileOrg:: Integrating captured and flagged items -@end menu - -@node Setting up the staging area -@section Setting up the staging area - -MobileOrg needs access to a file directory on a server to interact with -Emacs. With a public server, consider encrypting the files. MobileOrg -version 1.5 supports encryption for the iPhone. Org also requires -@file{openssl} installed on the local computer. To turn on encryption, set -the same password in MobileOrg and in Emacs. Set the password in the -variable @code{org-mobile-use-encryption}@footnote{If Emacs is configured for -safe storing of passwords, then configure the variable, -@code{org-mobile-encryption-password}; please read the docstring of that -variable.}. Note that even after MobileOrg encrypts the file contents, the -file names will remain visible on the file systems of the local computer, the -server, and the mobile device. - -For a server to host files, consider options like -@uref{http://dropbox.com,Dropbox.com} account@footnote{An alternative is to -use webdav server. MobileOrg documentation has details of webdav server -configuration. Additional help is at -@uref{https://orgmode.org/worg/org-faq.html#mobileorg_webdav, FAQ entry}.}. -On first connection, MobileOrg creates a directory @file{MobileOrg/} on -Dropbox. Pass its location to Emacs through an init file variable as -follows: - -@lisp -(setq org-mobile-directory "~/Dropbox/MobileOrg") -@end lisp - -Org copies files to the above directory for MobileOrg. Org also uses the -same directory for sharing notes between Org and MobileOrg. - -@node Pushing to MobileOrg -@section Pushing to MobileOrg - -Org pushes files listed in @code{org-mobile-files} to -@code{org-mobile-directory}. Files include agenda files (as listed in -@code{org-agenda-files}). Customize @code{org-mobile-files} to add other -files. File names will be staged with paths relative to -@code{org-directory}, so all files should be inside this -directory@footnote{Symbolic links in @code{org-directory} should have the -same name as their targets.}. - -Push creates a special Org file @file{agendas.org} with custom agenda views -defined by the user@footnote{While creating the agendas, Org mode will force -ID properties on all referenced entries, so that these entries can be -uniquely identified if MobileOrg flags them for further action. To avoid -setting properties configure the variable -@code{org-mobile-force-id-on-agenda-items} to @code{nil}. Org mode will then -rely on outline paths, assuming they are unique.}. - -Org writes the file @file{index.org}, containing links to other files. -MobileOrg reads this file first from the server to determine what other files -to download for agendas. For faster downloads, MobileOrg will read only -those files whose checksums@footnote{Checksums are stored automatically in -the file @file{checksums.dat}.} have changed. - -@node Pulling from MobileOrg -@section Pulling from MobileOrg - -When MobileOrg synchronizes with the server, it pulls the Org files for -viewing. It then appends to the file @file{mobileorg.org} on the server the -captured entries, pointers to flagged and changed entries. Org integrates -its data in an inbox file format. - -@enumerate -@item -Org moves all entries found in -@file{mobileorg.org}@footnote{@file{mobileorg.org} will be empty after this -operation.} and appends them to the file pointed to by the variable -@code{org-mobile-inbox-for-pull}. Each captured entry and each editing event -is a top-level entry in the inbox file. -@item -After moving the entries, Org attempts changes to MobileOrg. Some changes -are applied directly and without user interaction. Examples include changes -to tags, TODO state, headline and body text. Entries for further action are -tagged as @code{:FLAGGED:}. Org marks entries with problems with an error -message in the inbox. They have to be resolved manually. -@item -Org generates an agenda view for flagged entries for user intervention to -clean up. For notes stored in flagged entries, MobileOrg displays them in -the echo area when the cursor is on the corresponding agenda item. - -@table @kbd -@kindex ? -@item ? -Pressing @kbd{?} displays the entire flagged note in another window. Org -also pushes it to the kill ring. To store flagged note as a normal note, use -@kbd{? z C-y C-c C-c}. Pressing @kbd{?} twice does these things: first it -removes the @code{:FLAGGED:} tag; second, it removes the flagged note from -the property drawer; third, it signals that manual editing of the flagged -entry is now finished. -@end table -@end enumerate - -@kindex C-c a ? -@kbd{C-c a ?} returns to the agenda view to finish processing flagged -entries. Note that these entries may not be the most recent since MobileOrg -searches files that were last pulled. To get an updated agenda view with -changes since the last pull, pull again. - @node History and acknowledgments @appendix History and acknowledgments @cindex acknowledgments From 65e6824efb760dc151884b0e211524d714f2d798 Mon Sep 17 00:00:00 2001 From: Sam Steingold Date: Sun, 30 Sep 2018 08:32:29 -0400 Subject: [PATCH 11/72] Document 2d54710c36: vc-git-stash & *vc-dir* --- etc/NEWS | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 155394ef68f..a54abd7a638 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -325,6 +325,10 @@ file. This new variable allows customizing the default arguments passed to git-grep when 'vc-git-grep' is used. +*** Command 'vc-git-stash' now respects marks in the '*vc-dir*' buffer. +When some files are marked, only those are stashed. +When no files are marked, all modified files are stashed, as before. + ** diff-mode *** Hunks are now automatically refined by default. To disable it, set the new defcustom 'diff-font-lock-refine' to nil. From d2111c5f72ccae7c3b31b476cce2a0bf458bc38d Mon Sep 17 00:00:00 2001 From: "Charles A. Roelli" Date: Sun, 30 Sep 2018 17:05:29 +0200 Subject: [PATCH 12/72] * doc/emacs/help.texi (Misc Help): Document 'info-other-window'. --- doc/emacs/help.texi | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 94d27a276dc..66673eb2337 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -523,13 +523,17 @@ currently in use. @xref{Coding Systems}. @section Other Help Commands @kindex C-h i +@kindex C-h 4 i @findex info +@findex info-other-window @cindex Info @cindex manuals, included @kbd{C-h i} (@code{info}) runs the Info program, which browses -structured documentation files. The entire Emacs manual is available -within Info, along with many other manuals for the GNU system. Type -@kbd{h} after entering Info to run a tutorial on using Info. +structured documentation files. @kbd{C-h 4 i} +(@code{info-other-window}) does the same, but shows the Info buffer in +another window. The entire Emacs manual is available within Info, +along with many other manuals for the GNU system. Type @kbd{h} after +entering Info to run a tutorial on using Info. @cindex find Info manual by its file name With a numeric argument @var{n}, @kbd{C-h i} selects the Info buffer From 87d0007499d8434f40926c99f1edc3c4a700a79d Mon Sep 17 00:00:00 2001 From: "Michael R. Mauger" Date: Mon, 1 Oct 2018 00:12:51 -0400 Subject: [PATCH 13/72] Automate support for `sql-indent' ELPA package * progmodes/lisp/sql.el (sql-use-indent-support): New variable. (sql-is-indent-available): New function. (sql-indent-enable): Use above. (sql-mode-hook, sql-interactive-mode-hook): Add `sql-indent-enable'. --- etc/NEWS | 23 +++++++++++++++++++++++ lisp/progmodes/sql.el | 37 ++++++++++++++++++++++++++++++++----- 2 files changed, 55 insertions(+), 5 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index a54abd7a638..daacf49e62d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -365,6 +365,29 @@ better emulate 'M-.' in both Bash and zsh, since the former counts from the beginning of the arguments, while the latter counts from the end. +** SQL + +*** Installation of 'sql-indent' from ELPA is strongly encouraged. +This package support sophisticated rules for properly indenting SQL +statements. SQL is not like other programming languages like C, Java, +or Python where code is sparse and rules for formatting are fairly +well established. Instead SQL is more like COBOL (from which it came) +and code tends to be very dense and line ending decisions driven by +syntax and line length considerations to make readable code. +Experienced SQL developers may prefer to rely upon existing Emacs +facilities for formatting code but the 'sql-indent' package provides +facilities to aid more casual SQL developers layout queries and +complex expressions. + +*** 'sql-use-indent-support' (default t) enables SQL indention support. +The `sql-indent' package from ELPA must be installed to get the +indentation support in 'sql-mode' and 'sql-interactive-mode'. + +*** 'sql-mode-hook' and 'sql-interactive-mode-hook' changed. +Both hook variables have had 'sql-indent-enable' added to their +default values. If youhave existing customizations to these variables, +you should make sure that the new default entry is included. + ** Term --- diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index ba180c2b26c..1cdae35ac30 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -213,7 +213,7 @@ ;; Drew Adams -- Emacs 20 support ;; Harald Maier -- sql-send-string ;; Stefan Monnier -- font-lock corrections; -;; code polish +;; code polish; on-going guidance and mentorship ;; Paul Sleigh -- MySQL keyword enhancement ;; Andrew Schein -- sql-port bug ;; Ian Bjorhovde -- db2 escape newlines @@ -222,6 +222,7 @@ ;; Mark Wilkinson -- file-local variables ignored ;; Simen Heggestøyl -- Postgres database completion ;; Robert Cochran -- MariaDB support +;; Alex Harsanyi -- sql-indent package and support ;; @@ -723,6 +724,30 @@ This allows highlighting buffers properly when you open them." :group 'SQL :safe 'symbolp) +;; SQL indent support + +(defcustom sql-use-indent-support t + "If non-nil then use the SQL indent support features of sql-indent. +The `sql-indent' package in ELPA provides indentation support for +SQL statements with easy customizations to support varied layout +requirements. + +The package must be available to be loaded and activated." + :group 'SQL + :link '(url-link "https://elpa.gnu.org/packages/sql-indent.html") + :type 'booleanp + :version "27.1") + +(defun sql-is-indent-available () + "Check if sql-indent module is available." + (when (locate-library "sql-indent") + (fboundp 'sqlind-minor-mode))) + +(defun sql-indent-enable () + "Enable `sqlind-minor-mode' if available and requested." + (when (sql-is-indent-available) + (sqlind-minor-mode (if sql-use-indent-support +1 -1)))) + ;; misc customization of sql.el behavior (defcustom sql-electric-stuff nil @@ -850,15 +875,17 @@ commands when the input history is read, as if you had set ;; The usual hooks -(defcustom sql-interactive-mode-hook '() +(defcustom sql-interactive-mode-hook '(sql-indent-enable) "Hook for customizing `sql-interactive-mode'." :type 'hook - :group 'SQL) + :group 'SQL + :version "27.1") -(defcustom sql-mode-hook '() +(defcustom sql-mode-hook '(sql-indent-enable) "Hook for customizing `sql-mode'." :type 'hook - :group 'SQL) + :group 'SQL + :version "27.1") (defcustom sql-set-sqli-hook '() "Hook for reacting to changes of `sql-buffer'. From 3a2b5a713f92ffba3bdb52725e98030ad5b43a67 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 1 Oct 2018 10:19:27 +0300 Subject: [PATCH 14/72] ; * lisp/bindings.el (bindings--define-key): Doc fix. (Bug#32885) --- lisp/bindings.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/bindings.el b/lisp/bindings.el index 3e202b9b78c..a1af4389bee 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -265,7 +265,10 @@ Normally nil in most modes, since there is no process to display.") (make-variable-buffer-local 'mode-line-process) (defun bindings--define-key (map key item) - "Make as much as possible of the menus pure." + "Define KEY in keymap MAP according to ITEM from a menu. +This is like `define-key', but it takes the definition from the +specified menu item, and makes pure copies of as much as possible +of the menu's data." (declare (indent 2)) (define-key map key (cond From 9c028d6965c7bb3024ada4f59be133b940438127 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 1 Oct 2018 10:45:33 +0300 Subject: [PATCH 15/72] * lisp/savehist.el (savehist-mode): Doc fix. (Bug#32889) --- lisp/savehist.el | 27 ++++++++++++++++++++++----- 1 file changed, 22 insertions(+), 5 deletions(-) diff --git a/lisp/savehist.el b/lisp/savehist.el index fbb5f533902..893590ce809 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -172,13 +172,30 @@ minibuffer history.") (define-minor-mode savehist-mode "Toggle saving of minibuffer history (Savehist mode). With a prefix argument ARG, enable Savehist mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. +positive, and disable it otherwise. If called from Lisp, +also enable the mode if ARG is omitted or nil. When Savehist mode is enabled, minibuffer history is saved -periodically and when exiting Emacs. When Savehist mode is -enabled for the first time in an Emacs session, it loads the -previous minibuffer history from `savehist-file'. +to `savehist-file' periodically and when exiting Emacs. When +Savehist mode is enabled for the first time in an Emacs session, +it loads the previous minibuffer histories from `savehist-file'. +The variable `savehist-autosave-interval' controls the +periodicity of saving minibuffer histories. + +If `savehist-save-minibuffer-history' is non-nil (the default), +all recorded minibuffer histories will be saved. You can arrange +for additional history variables to be saved and restored by +customizing `savehist-additional-variables', which by default is +an empty list. For example, to save the history of commands +invoked via \\[execute-extended-command], add `command-history' to the list in +`savehist-additional-variables'. + +Alternatively, you could customize `savehist-save-minibuffer-history' +to nil, and add to `savehist-additional-variables' only those +history variables you want to save. + +To ignore some history variables, add their symbols to the list +in `savehist-ignored-variables'. This mode should normally be turned on from your Emacs init file. Calling it at any other time replaces your current minibuffer From 35b56a24a09792a0e966f861aa01c07ed1826a82 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Mon, 1 Oct 2018 06:23:16 -0400 Subject: [PATCH 16/72] ; Auto-commit of loaddefs files. --- lisp/ldefs-boot.el | 31 +++++++++++++++++++++++++------ 1 file changed, 25 insertions(+), 6 deletions(-) diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 2ff94d333ba..a9ea74102db 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -28927,13 +28927,30 @@ or call the function `savehist-mode'.") (autoload 'savehist-mode "savehist" "\ Toggle saving of minibuffer history (Savehist mode). With a prefix argument ARG, enable Savehist mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. +positive, and disable it otherwise. If called from Lisp, +also enable the mode if ARG is omitted or nil. When Savehist mode is enabled, minibuffer history is saved -periodically and when exiting Emacs. When Savehist mode is -enabled for the first time in an Emacs session, it loads the -previous minibuffer history from `savehist-file'. +to `savehist-file' periodically and when exiting Emacs. When +Savehist mode is enabled for the first time in an Emacs session, +it loads the previous minibuffer histories from `savehist-file'. +The variable `savehist-autosave-interval' controls the +periodicity of saving minibuffer histories. + +If `savehist-save-minibuffer-history' is non-nil (the default), +all recorded minibuffer histories will be saved. You can arrange +for additional history variables to be saved and restored by +customizing `savehist-additional-variables', which by default is +an empty list. For example, to save the history of commands +invoked via \\[execute-extended-command], add `command-history' to the list in +`savehist-additional-variables'. + +Alternatively, you could customize `savehist-save-minibuffer-history' +to nil, and add to `savehist-additional-variables' only those +history variables you want to save. + +To ignore some history variables, add their symbols to the list +in `savehist-ignored-variables'. This mode should normally be turned on from your Emacs init file. Calling it at any other time replaces your current minibuffer @@ -33666,8 +33683,10 @@ Return the number at point, or nil if none is found. (autoload 'list-at-point "thingatpt" "\ Return the Lisp list at point, or nil if none is found. +If IGNORE-COMMENT-OR-STRING is non-nil comments and strings are +treated as white space. -\(fn)" nil nil) +\(fn &optional IGNORE-COMMENT-OR-STRING)" nil nil) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thingatpt" '("form-at-point" "thing-at-point-" "sentence-at-point" "word-at-point" "in-string-p" "end-of-thing" "beginning-of-thing"))) From 0915462e46157f25022bb6f0f433e40c2e8461be Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Mon, 1 Oct 2018 07:23:39 -0400 Subject: [PATCH 17/72] ; Auto-commit of loaddefs files. --- lisp/ldefs-boot.el | 107 ++++++++++++++++++++++++++++++++++----------- 1 file changed, 82 insertions(+), 25 deletions(-) diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index bdf4c315295..5ff089812bb 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -6626,7 +6626,7 @@ buffers accepted by the function pointed out by variable `dabbrev-friend-buffer-function', if `dabbrev-check-other-buffers' says so. Then, if `dabbrev-check-all-buffers' is non-nil, look in all the other buffers, subject to constraints specified -by `dabbrev-ignored-buffer-names' and `dabbrev-ignored-regexps'. +by `dabbrev-ignored-buffer-names' and `dabbrev-ignored-buffer-regexps'. A positive prefix argument, N, says to take the Nth backward *distinct* possibility. A negative argument says search forward. @@ -11451,7 +11451,9 @@ See documentation of variable `tags-file-name'. (defalias 'pop-tag-mark 'xref-pop-marker-stack) -(autoload 'next-file "etags" "\ +(defalias 'next-file 'tags-next-file) + +(autoload 'tags-next-file "etags" "\ Select next file among files in current tags table. A first argument of t (prefix arg, if interactive) initializes to the @@ -11471,40 +11473,32 @@ Continue last \\[tags-search] or \\[tags-query-replace] command. Used noninteractively with non-nil argument to begin such a command (the argument is passed to `next-file', which see). -Two variables control the processing we do on each file: the value of -`tags-loop-scan' is a form to be executed on each file to see if it is -interesting (it returns non-nil if so) and `tags-loop-operate' is a form to -evaluate to operate on an interesting file. If the latter evaluates to -nil, we exit; otherwise we scan the next file. - \(fn &optional FIRST-TIME)" t nil) +(make-obsolete 'tags-loop-continue 'multifile-continue '"27.1") + (autoload 'tags-search "etags" "\ Search through all files listed in tags table for match for REGEXP. Stops when a match is found. To continue searching for next match, use command \\[tags-loop-continue]. -If FILE-LIST-FORM is non-nil, it should be a form that, when -evaluated, will return a list of file names. The search will be -restricted to these files. +If FILES if non-nil should be a list or an iterator returning the files to search. +The search will be restricted to these files. Also see the documentation of the `tags-file-name' variable. -\(fn REGEXP &optional FILE-LIST-FORM)" t nil) +\(fn REGEXP &optional FILES)" t nil) (autoload 'tags-query-replace "etags" "\ Do `query-replace-regexp' of FROM with TO on all files listed in tags table. Third arg DELIMITED (prefix arg) means replace only word-delimited matches. If you exit (\\[keyboard-quit], RET or q), you can resume the query replace with the command \\[tags-loop-continue]. -Fourth arg FILE-LIST-FORM non-nil means initialize the replacement loop. +For non-interactive use, superceded by `multifile-initialize-replace'. -If FILE-LIST-FORM is non-nil, it is a form to evaluate to -produce the list of files to search. +\(fn FROM TO &optional DELIMITED FILES)" t nil) -See also the documentation of the variable `tags-file-name'. - -\(fn FROM TO &optional DELIMITED FILE-LIST-FORM)" t nil) +(set-advertised-calling-convention 'tags-query-replace '(from to &optional delimited) '"27.1") (autoload 'list-tags "etags" "\ Display list of tags in file FILE. @@ -11541,7 +11535,7 @@ for \\[find-tag] (which see). \(fn)" nil nil) -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "etags" '("default-tags-table-function" "etags-" "file-of-tag" "find-tag-" "goto-tag-location-function" "initialize-new-tags-table" "last-tag" "list-tags-function" "next-file-list" "select-tags-table-" "snarf-tag-function" "tag" "verify-tags-table-function" "xref-"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "etags" '("default-tags-table-function" "etags-" "file-of-tag" "find-tag-" "goto-tag-location-function" "initialize-new-tags-table" "last-tag" "list-tags-function" "select-tags-table-" "snarf-tag-function" "tag" "verify-tags-table-function" "xref-"))) ;;;*** @@ -12631,7 +12625,7 @@ Execute BODY, and unwind connection-local variables. (function-put 'with-connection-local-profiles 'lisp-indent-function '1) -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "files-x" '("connection-local-" "hack-connection-local-variables" "modify-" "read-file-local-variable"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "files-x" '("connection-local-" "dir-locals-to-string" "hack-connection-local-variables" "modify-" "read-file-local-variable"))) ;;;*** @@ -16909,6 +16903,9 @@ Define a filter named NAME. DOCUMENTATION is the documentation of the function. READER is a form which should read a qualifier from the user. DESCRIPTION is a short string describing the filter. +ACCEPT-LIST is a boolean; if non-nil, the filter accepts either +a single condition or a list of them; in the latter +case the filter is the `or' composition of the conditions. BODY should contain forms which will be evaluated to test whether or not a particular buffer should be displayed or not. The forms in BODY @@ -17152,7 +17149,7 @@ See also the variable `idlwave-shell-prompt-pattern'. \(Type \\[describe-mode] in the shell buffer for a list of commands.) -\(fn &optional ARG QUICK)" t nil) +\(fn &optional ARG)" t nil) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "idlw-shell" '("idlwave-"))) @@ -22267,6 +22264,41 @@ QUALITY can be: (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mule-util" '("filepos-to-bufferpos--dos" "truncate-string-ellipsis"))) +;;;*** + +;;;### (autoloads nil "multifile" "multifile.el" (0 0 0 0)) +;;; Generated autoloads from multifile.el + +(autoload 'multifile-initialize "multifile" "\ +Initialize a new round of operation on several files. +FILES can be either a list of file names, or an iterator (used with `iter-next') +which returns a file name at each step. +SCAN-FUNCTION is a function called with no argument inside a buffer +and it should return non-nil if that buffer has something on which to operate. +OPERATE-FUNCTION is a function called with no argument; it is expected +to perform the operation on the current file buffer and when done +should return non-nil to mean that we should immediately continue +operating on the next file and nil otherwise. + +\(fn FILES SCAN-FUNCTION OPERATE-FUNCTION)" nil nil) + +(autoload 'multifile-initialize-search "multifile" "\ + + +\(fn REGEXP FILES CASE-FOLD)" nil nil) + +(autoload 'multifile-initialize-replace "multifile" "\ +Initialize a new round of query&replace on several files. +FROM is a regexp and TO is the replacement to use. +FILES describes the file, as in `multifile-initialize'. +CASE-FOLD can be t, nil, or `default', the latter one meaning to obey +the default setting of `case-fold-search'. +DELIMITED if non-nil means replace only word-delimited matches. + +\(fn FROM TO FILES CASE-FOLD &optional DELIMITED)" nil nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "multifile" '("multifile-"))) + ;;;*** ;;;### (autoloads nil "mwheel" "mwheel.el" (0 0 0 0)) @@ -24850,7 +24882,8 @@ STRING should be on something resembling an RFC2822 string, a la somewhat liberal in what format it accepts, and will attempt to return a \"likely\" value even for somewhat malformed strings. The values returned are identical to those of `decode-time', but -any values that are unknown are returned as nil. +any unknown values other than DST are returned as nil, and an +unknown DST value is returned as -1. \(fn STRING)" nil nil) @@ -26354,6 +26387,20 @@ recognized. \(fn)" t nil) +(autoload 'project-search "project" "\ +Search for REGEXP in all the files of the project. +Stops when a match is found. +To continue searching for next match, use command \\[multifile-continue]. + +\(fn REGEXP)" t nil) + +(autoload 'project-query-replace "project" "\ +Search for REGEXP in all the files of the project. +Stops when a match is found. +To continue searching for next match, use command \\[multifile-continue]. + +\(fn FROM TO)" t nil) + (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "project" '("project-"))) ;;;*** @@ -33791,15 +33838,17 @@ Return the number at point, or nil if none is found. (autoload 'list-at-point "thingatpt" "\ Return the Lisp list at point, or nil if none is found. +If IGNORE-COMMENT-OR-STRING is non-nil comments and strings are +treated as white space. -\(fn)" nil nil) +\(fn &optional IGNORE-COMMENT-OR-STRING)" nil nil) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thingatpt" '("beginning-of-thing" "define-thing-chars" "end-of-thing" "filename" "form-at-point" "in-string-p" "sentence-at-point" "thing-at-point-" "word-at-point"))) ;;;*** -;;;### (autoloads nil "thread" "emacs-lisp/thread.el" (0 0 0 0)) -;;; Generated autoloads from emacs-lisp/thread.el +;;;### (autoloads nil "thread" "thread.el" (0 0 0 0)) +;;; Generated autoloads from thread.el (autoload 'thread-handle-event "thread" "\ Handle thread events, propagated by `thread-signal'. @@ -33808,6 +33857,14 @@ An EVENT has the format \(fn EVENT)" t nil) +(autoload 'list-threads "thread" "\ +Display a list of threads. + +\(fn)" t nil) + (put 'list-threads 'disabled "Beware: manually canceling threads can ruin your Emacs session.") + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thread" '("thread-list-"))) + ;;;*** ;;;### (autoloads nil "thumbs" "thumbs.el" (0 0 0 0)) From 508c40ef1dd625b9c9a58c863995ed241f4a5184 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 1 Oct 2018 14:17:27 +0200 Subject: [PATCH 18/72] Comple fix for Bug#32550 * lisp/net/tramp.el (tramp-rfn-eshadow-update-overlay): Use `save-excursion'. This completes the fix of Bug#32550. --- lisp/net/tramp.el | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 452e70ec353..98ec8415c74 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1941,21 +1941,20 @@ been set up by `rfn-eshadow-setup-minibuffer'." (minibuffer-prompt-end))) ;; We do not want to send any remote command. (non-essential t)) - (when - (tramp-tramp-file-p - (buffer-substring-no-properties end (point-max))) - (save-restriction - (narrow-to-region - (1+ (or (string-match - (tramp-rfn-eshadow-update-overlay-regexp) - (buffer-string) end) - end)) - (point-max)) - (let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay) - (rfn-eshadow-update-overlay-hook nil) - file-name-handler-alist) - (move-overlay rfn-eshadow-overlay (point-max) (point-max)) - (rfn-eshadow-update-overlay))))))) + (when (tramp-tramp-file-p (buffer-substring end (point-max))) + (save-excursion + (save-restriction + (narrow-to-region + (1+ (or (string-match + (tramp-rfn-eshadow-update-overlay-regexp) + (buffer-string) end) + end)) + (point-max)) + (let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay) + (rfn-eshadow-update-overlay-hook nil) + file-name-handler-alist) + (move-overlay rfn-eshadow-overlay (point-max) (point-max)) + (rfn-eshadow-update-overlay)))))))) (add-hook 'rfn-eshadow-update-overlay-hook 'tramp-rfn-eshadow-update-overlay) From 886a1f26413b3eec427155163a2f3ceb163efce8 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 1 Oct 2018 14:33:51 +0200 Subject: [PATCH 19/72] Minor edits in tramp.texi * doc/misc/tramp.texi (Password handling): Say "user option". (Remote shell setup): Say "environment variable". (External packages): Add `non-essential' to variable index. --- doc/misc/tramp.texi | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 88fa55fdeeb..530e8dc1b4c 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1646,7 +1646,7 @@ the need. The package @file{auth-source.el}, originally developed for No Gnus, reads passwords from different sources, @xref{Help for users, , auth-source, auth}. The default authentication file is -@file{~/.authinfo.gpg}, but this can be changed via the variable +@file{~/.authinfo.gpg}, but this can be changed via the user option @code{auth-sources}. @noindent @@ -1670,7 +1670,7 @@ If there doesn't exist a proper entry, the password is read interactively. After successful login (verification of the password), it is offered to save a corresponding entry for further use by @code{auth-source} backends which support this. This could be changed -by setting the variable @code{auth-source-save-behavior} to @code{nil}. +by setting the user option @code{auth-source-save-behavior} to @code{nil}. @vindex auth-source-debug Set @code{auth-source-debug} to @code{t} to debug messages. @@ -2031,10 +2031,10 @@ shell-specific config files. For example, bash can use parsing. This redefinition affects the looks of a prompt in an interactive remote shell through commands, such as @kbd{M-x shell @key{RET}}. Such prompts, however, can be reset to something more -readable and recognizable using these @value{tramp} variables. +readable and recognizable using these environment variables. -@value{tramp} sets the @env{INSIDE_EMACS} variable in the startup -script file @file{~/.emacs_SHELLNAME}. +@value{tramp} sets the @env{INSIDE_EMACS} environment variable in the +startup script file @file{~/.emacs_SHELLNAME}. @env{SHELLNAME} is @code{bash} or equivalent shell names. Change it by setting the environment variable @env{ESHELL} in the @file{.emacs} as @@ -3671,7 +3671,7 @@ Due to the remote shell saving tilde expansions triggered by @value{tramp} can suppress this behavior with the user option @code{tramp-histfile-override}. When set to @code{t}, environment variable @env{HISTFILE} is unset, and environment variables -@env{HISTFILESIZE} @env{HISTSIZE} are set to 0. +@env{HISTFILESIZE} and @env{HISTSIZE} are set to 0. Alternatively, @code{tramp-histfile-override} could be a string. Environment variable @env{HISTFILE} is set to this file name then. Be @@ -4133,6 +4133,7 @@ handlers. @section Integrating with external Lisp packages @subsection File name completion. +@vindex non-essential Sometimes, it is not convenient to open a new connection to a remote host, including entering the password and alike. For example, this is nasty for packages providing file name completion. Such a package From c45789a595cc09457d54c4c878e8aae84f79d59d Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 1 Oct 2018 14:34:35 +0200 Subject: [PATCH 20/72] Use `float-time' in tramp-sh.el where needed * lisp/net/tramp-sh.el (tramp-sh-handle-verify-visited-file-modtime): Use `float-time'. --- lisp/net/tramp-sh.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index b2be43395f8..956fe2ddb73 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1449,7 +1449,7 @@ of." ;; recorded last modification time, or there is no established ;; connection. (if (or (not f) - (zerop (visited-file-modtime)) + (zerop (float-time (visited-file-modtime))) (not (file-remote-p f nil 'connected))) t (with-parsed-tramp-file-name f nil From dfbb207ff946792efebb31c0c59b8245c304544a Mon Sep 17 00:00:00 2001 From: "Charles A. Roelli" Date: Mon, 1 Oct 2018 21:41:11 +0200 Subject: [PATCH 21/72] * lisp/vc/vc.el (vc-checkin): Simplify 'run-hook' call. --- lisp/vc/vc.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index d3d66d6fb5f..6962664d59f 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1536,8 +1536,7 @@ The optional argument REV may be a string specifying the new revision level (only supported for some older VCSes, like RCS and CVS). Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." - (when vc-before-checkin-hook - (run-hooks 'vc-before-checkin-hook)) + (run-hooks 'vc-before-checkin-hook) (vc-start-logentry files comment initial-contents "Enter a change comment." From 0f505bbef6bc70d16899a24512e8eeb8eab505b4 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 2 Oct 2018 16:51:51 +0200 Subject: [PATCH 22/72] Rearrangements in tramp*.texi * doc/misc/trampver.texi (trampfn): New macro, taken from tramp.texi. * doc/misc/tramp.texi (trampfn): Moved to trampver.texi. (Top): Add sections `System Requirement' and `Basic Installation'. --- doc/misc/tramp.texi | 15 ++++----------- doc/misc/trampver.texi | 10 ++++++++++ 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 530e8dc1b4c..7bc365ffdfe 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -12,16 +12,6 @@ @c This is *so* much nicer :) @footnotestyle end -@c Macro for formatting a file name according to the respective -@c syntax. Macro arguments should not have any leading or trailing -@c whitespace. Not very elegant, but I don't know it better. - -@macro trampfn {method, userhost, localname} -@value{prefix}@c -\method\@value{postfixhop}@c -\userhost\@value{postfix}\localname\ -@end macro - @copying Copyright @copyright{} 1999--2018 Free Software Foundation, Inc. @@ -122,8 +112,11 @@ For the developer: --- The Detailed Node Listing --- @c @ifset installchapter + Installing @value{tramp} with your Emacs +* System Requirements:: Prerequisites for :@value{tramp} installation. +* Basic Installation:: Installation steps.: * Installation parameters:: Parameters in order to control installation. * Testing:: A test suite for @value{tramp}. * Load paths:: How to plug-in @value{tramp} into your environment. @@ -4107,7 +4100,7 @@ Unloading @value{tramp} resets Ange FTP plugins also. @c For the developer @node Files directories and localnames -@chapter How file names, directories and localnames are mangled and managed. +@chapter How file names, directories and localnames are mangled and managed @menu * Localname deconstruction:: Splitting a localname into its component parts. diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 807330bb9b1..3a3ada9e846 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -44,3 +44,13 @@ @set ipv6prefix @set ipv6postfix @end ifset + +@c Macro for formatting a file name according to the respective +@c syntax. Macro arguments should not have any leading or trailing +@c whitespace. Not very elegant, but I don't know it better. + +@macro trampfn {method, userhost, localname} +@value{prefix}@c +\method\@value{postfixhop}@c +\userhost\@value{postfix}\localname\ +@end macro From 3eedabaef37ecbcf30144ab9efa2441bbfc950e0 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 2 Oct 2018 12:37:04 -0400 Subject: [PATCH 23/72] * lisp/emacs-lisp/autoload.el (autoload-ignored-definitions): New var (autoload-generate-file-autoloads): Use it. --- lisp/emacs-lisp/autoload.el | 26 ++++++++++++++++---------- 1 file changed, 16 insertions(+), 10 deletions(-) diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 3d733519111..c9ee532ac82 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -660,6 +660,21 @@ Don't try to split prefixes that are already longer than that.") (defvar autoload-builtin-package-versions nil) +(defvar autoload-ignored-definitions + '("define-obsolete-function-alias" + "define-obsolete-variable-alias" + "define-category" "define-key" + "defgroup" "defface" "defadvice" + "def-edebug-spec" + ;; Hmm... this is getting ugly: + "define-widget" + "define-erc-module" + "define-erc-response-handler" + "defun-rcirc-command") + "List of strings naming definitions to ignore for prefixes. +More specifically those definitions will not be considered for the +`register-definition-prefixes' call.") + ;; When called from `generate-file-autoloads' we should ignore ;; `generated-autoload-file' altogether. When called from ;; `update-file-autoloads' we don't know `outbuf'. And when called from @@ -758,16 +773,7 @@ FILE's modification time." (looking-at "(\\(def[^ ]+\\) ['(]*\\([^' ()\"\n]+\\)[\n \t]") (not (member (match-string 1) - '("define-obsolete-function-alias" - "define-obsolete-variable-alias" - "define-category" "define-key" - "defgroup" "defface" "defadvice" - "def-edebug-spec" - ;; Hmm... this is getting ugly: - "define-widget" - "define-erc-module" - "define-erc-response-handler" - "defun-rcirc-command")))) + autoload-ignored-definitions))) (push (match-string-no-properties 2) defs)) (forward-sexp 1) (forward-line 1))))))) From cdca208932a1d7f81a31f858f5f9fa55760b8323 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Tue, 2 Oct 2018 19:56:43 -0400 Subject: [PATCH 24/72] Fix note about interactive advice (Bug#32905) * doc/lispref/functions.texi (Core Advising Primitives): Add missing ':', and finish the sentence fragment. --- doc/lispref/functions.texi | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 93059e8e3a6..9b8057080ea 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -1674,7 +1674,9 @@ Note: The interactive spec of @var{function} will apply to the combined function and should hence obey the calling convention of the combined function rather than that of @var{function}. In many cases, it makes no difference since they are identical, but it does matter for @code{:around}, -@code{:filter-args}, and @code{filter-return}, where @var{function}. +@code{:filter-args}, and @code{:filter-return}, where @var{function} +receives different arguments than the original function stored in +@var{place}. @end defmac @defmac remove-function place function From 51f0cccdde9bd1679e20f35d30e39e872ce6513a Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Wed, 3 Oct 2018 10:45:59 +0000 Subject: [PATCH 25/72] Put follow-mode's engine on pre-redisplay-hook instead of post-command-hook This fixes bug #32874. * lisp/follow.el (follow-mode): Put follow-pre-redisplay-function onto pre-redisplay-function instead of putting follow-post-command-hook onto post-command-hook. Amend the removal operation analogously. (follow-pre-redisplay-function): New function. --- lisp/follow.el | 35 +++++++++++++++++++++++++++++------ 1 file changed, 29 insertions(+), 6 deletions(-) diff --git a/lisp/follow.el b/lisp/follow.el index 7aa7b514739..e2d3a11b654 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -187,8 +187,8 @@ ;; Implementation: ;; ;; The main method by which Follow mode aligns windows is via the -;; function `follow-post-command-hook', which is run after each -;; command. This "fixes up" the alignment of other windows which are +;; function `follow-pre-redisplay-function', which is run before each +;; redisplay. This "fixes up" the alignment of other windows which are ;; showing the same Follow mode buffer, on the same frame as the ;; selected window. It does not try to deal with buffers other than ;; the buffer of the selected frame, or windows on other frames. @@ -418,7 +418,7 @@ Keys specific to Follow mode: (if follow-mode (progn (add-hook 'compilation-filter-hook 'follow-align-compilation-windows t t) - (add-hook 'post-command-hook 'follow-post-command-hook t) + (add-function :before pre-redisplay-function 'follow-pre-redisplay-function) (add-hook 'window-size-change-functions 'follow-window-size-change t) (add-hook 'after-change-functions 'follow-after-change nil t) (add-hook 'isearch-update-post-hook 'follow-post-command-hook nil t) @@ -445,7 +445,7 @@ Keys specific to Follow mode: (setq following (buffer-local-value 'follow-mode (car buffers)) buffers (cdr buffers))) (unless following - (remove-hook 'post-command-hook 'follow-post-command-hook) + (remove-function pre-redisplay-function 'follow-pre-redisplay-function) (remove-hook 'window-size-change-functions 'follow-window-size-change))) (kill-local-variable 'move-to-window-group-line-function) @@ -1260,10 +1260,27 @@ non-first windows in Follow mode." (not (eq win top)))) ;; Loop while this is true. (set-buffer orig-buffer)))) +;;; Pre Display Function + +;; This function is added to `pre-display-function' and is thus called +;; before each redisplay operation. It supersedes (2018-09) the +;; former use of the post command hook, and now does the right thing +;; when a program calls `redisplay' or `sit-for'. + +(defun follow-pre-redisplay-function (wins) + (if (or (eq wins t) + (null wins) + (and (listp wins) + (memq (selected-window) wins))) + (follow-post-command-hook))) + ;;; Post Command Hook -;; The magic little box. This function is called after every command. - +;; The magic little box. This function was formerly called after every +;; command. It is now called before each redisplay operation (see +;; `follow-pre-redisplay-function' above), and at the end of several +;; search/replace commands. It retains its historical name. +;; ;; This is not as complicated as it seems. It is simply a list of common ;; display situations and the actions to take, plus commands for redrawing ;; the screen if it should be unaligned. @@ -1284,6 +1301,12 @@ non-first windows in Follow mode." (setq follow-windows-start-end-cache nil)) (follow-adjust-window win))))) +;; NOTE: to debug follow-mode with edebug, it is helpful to add +;; `follow-post-command-hook' to `post-command-hook' temporarily. Do +;; this locally to the target buffer with, say,: +;; M-: (add-hook 'post-command-hook 'follow-post-command-hook t t) +;; . + (defun follow-adjust-window (win) ;; Adjust the window WIN and its followers. (cl-assert (eq (window-buffer win) (current-buffer))) From f8df6f23070d506e64e3f5079940ca5bef2f1b7e Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Sun, 30 Sep 2018 15:58:40 +0000 Subject: [PATCH 26/72] * etc/NEWS: Note setting make-cursor-line-fully-visible to nil in follow-mode Also re-insert the "temporary note" explaining --- and +++. --- etc/NEWS | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index bfd7db016f2..440741b9b8f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -15,6 +15,12 @@ in older Emacs versions. You can narrow news to a specific version by calling 'view-emacs-news' with a prefix argument or by typing C-u C-h C-n. +Temporary note: ++++ indicates that all necessary documentation updates are complete. + (This means all relevant manuals in doc/ AND lisp doc-strings.) +--- means no change in the manuals is needed. +When you add a new item, use the appropriate mark if you are sure it applies, + * Installation Changes in Emacs 26.2 @@ -45,6 +51,14 @@ often cause crashes. Set it to nil if you really need those fonts. * Changes in Specialized Modes and Packages in Emacs 26.2 +--- +** Follow mode +Follow mode now sets a buffer local value of nil for +make-cursor-line-fully-visible in any buffer using it. This ensures +correct operation if point is moved by C-n to the next window when +there is a partially displayed line at the bottom of the original +window. + ** Ibuffer --- From 2c8ea4654dc72ccb93ef63632a888ea3d395f599 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Wed, 3 Oct 2018 12:08:27 +0000 Subject: [PATCH 27/72] Revert "* etc/NEWS: Note setting make-cursor-line-fully-visible to nil in follow-mode" This reverts commit f3c8f4bde2de2b9d42c44f5e44f34c427bebdc58. --- etc/NEWS | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 440741b9b8f..bfd7db016f2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -15,12 +15,6 @@ in older Emacs versions. You can narrow news to a specific version by calling 'view-emacs-news' with a prefix argument or by typing C-u C-h C-n. -Temporary note: -+++ indicates that all necessary documentation updates are complete. - (This means all relevant manuals in doc/ AND lisp doc-strings.) ---- means no change in the manuals is needed. -When you add a new item, use the appropriate mark if you are sure it applies, - * Installation Changes in Emacs 26.2 @@ -51,14 +45,6 @@ often cause crashes. Set it to nil if you really need those fonts. * Changes in Specialized Modes and Packages in Emacs 26.2 ---- -** Follow mode -Follow mode now sets a buffer local value of nil for -make-cursor-line-fully-visible in any buffer using it. This ensures -correct operation if point is moved by C-n to the next window when -there is a partially displayed line at the bottom of the original -window. - ** Ibuffer --- From ea77c6594e5ccc9057ca664ef1dea766ca291b8e Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Wed, 3 Oct 2018 12:08:59 +0000 Subject: [PATCH 28/72] Revert "Temporary workaround for bug #32848 for branch emacs-26" This reverts commit 6650751ce73413d05599df07a9c5bc70744260f3. --- lisp/follow.el | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/lisp/follow.el b/lisp/follow.el index 7942901bb4f..fd397c077bb 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -438,10 +438,7 @@ Keys specific to Follow mode: (setq pos-visible-in-window-group-p-function 'follow-pos-visible-in-window-p) (setq selected-window-group-function 'follow-all-followers) - (setq move-to-window-group-line-function 'follow-move-to-window-line) - - ;; Crude workaround for bug #32848 for the emacs-26 branch, 2018-09-30. - (setq-local make-cursor-line-fully-visible nil)) + (setq move-to-window-group-line-function 'follow-move-to-window-line)) ;; Remove globally-installed hook functions only if there is no ;; other Follow mode buffer. @@ -454,9 +451,6 @@ Keys specific to Follow mode: (remove-hook 'post-command-hook 'follow-post-command-hook) (remove-hook 'window-size-change-functions 'follow-window-size-change))) - ;; Second part of crude workaround for bug #32848. - (kill-local-variable 'make-cursor-line-fully-visible) - (kill-local-variable 'move-to-window-group-line-function) (kill-local-variable 'selected-window-group-function) (kill-local-variable 'pos-visible-in-window-group-p-function) From 99f45ee42c5554d606407f6da37700e9bf86bd35 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Wed, 3 Oct 2018 15:57:15 +0000 Subject: [PATCH 29/72] In follow mode, prevent the cursor resting on a partially displayed line Don't merge to master. This fixes bug #32848 * lisp/follow.el (follow-adjust-window): If point ends up in a partially displayed line in a left hand or middle window, move it one line forward, to prevent unwanted scrolling should make-cursor-line-fully-visible be non-nil. --- lisp/follow.el | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/lisp/follow.el b/lisp/follow.el index fd397c077bb..eb48ec179cf 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -1385,7 +1385,13 @@ non-first windows in Follow mode." (unless (eq win (selected-window)) (let ((p (window-point win))) (set-window-start win (window-start win) nil) - (set-window-point win p)))) + (if (nth 2 (pos-visible-in-window-p p win t)) + ;; p is in a partially visible line. We can't leave + ;; window-point there, because C-x o back into WIN + ;; would then fail. + (with-selected-window win + (forward-line)) ; redisplay will recenter it in WIN. + (set-window-point win p))))) (unless visible ;; If point may not be visible in the selected window, From 43a8494babaeec60464e11c46c2ebfc993179d72 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 3 Oct 2018 19:34:02 +0200 Subject: [PATCH 30/72] * doc/misc/trampver.texi (trampfn): Call `unmacro' prior defining * doc/misc/trampver.texi (trampfn): Call `unmacro' prior defining. trampver.texi is included several times; it raises an error otherwise. --- doc/misc/trampver.texi | 1 + 1 file changed, 1 insertion(+) diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 3a3ada9e846..db4654ce28e 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -49,6 +49,7 @@ @c syntax. Macro arguments should not have any leading or trailing @c whitespace. Not very elegant, but I don't know it better. +@unmacro trampfn @macro trampfn {method, userhost, localname} @value{prefix}@c \method\@value{postfixhop}@c From ac3622c81acb93fa340a1e0e73188b1587b3970a Mon Sep 17 00:00:00 2001 From: "Charles A. Roelli" Date: Wed, 3 Oct 2018 19:59:34 +0200 Subject: [PATCH 31/72] Improve documentation of 'read-hide-char' * src/minibuf.c (syms_of_minibuf) : Clarify documentation and mention where else the variable is used. * doc/lispref/minibuf.texi (Reading a Password): Add an index entry for 'read-hide-char'. --- doc/lispref/minibuf.texi | 1 + src/minibuf.c | 7 +++++-- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 2951ef5aaec..97797d00096 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -2236,6 +2236,7 @@ Here is an example of using this function: To read a password to pass to another program, you can use the function @code{read-passwd}. +@vindex read-hide-char @defun read-passwd prompt &optional confirm default This function reads a password, prompting with @var{prompt}. It does not echo the password as the user types it; instead, it echoes diff --git a/src/minibuf.c b/src/minibuf.c index 691fad07b79..f1bde913fc9 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -2107,8 +2107,11 @@ properties. */); DEFVAR_LISP ("read-hide-char", Vread_hide_char, doc: /* Whether to hide input characters in noninteractive mode. -It must be a character, which will be used to mask the input -characters. This variable should never be set globally. */); +If non-nil, it must be a character, which will be used to mask the +input characters. This variable should never be set globally. + +This variable also overrides the default character that `read-passwd' +uses to hide passwords. */); Vread_hide_char = Qnil; defsubr (&Sactive_minibuffer_window); From 00ea749f2af44bff6ea8c1259477fbf0ead8a306 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Thu, 20 Sep 2018 14:03:29 +0200 Subject: [PATCH 32/72] Install emacs-module.h (Bug#31929) * Makefile.in (includedir): New variable. (install-arch-indep): Install emacs-module.h. (uninstall): Uninstall emacs-module.h. --- Makefile.in | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/Makefile.in b/Makefile.in index c6b2cfa78af..e10fdc3bd69 100644 --- a/Makefile.in +++ b/Makefile.in @@ -151,6 +151,9 @@ libexecdir=@libexecdir@ # Currently only used for the systemd service file. libdir=@libdir@ +# Where to install emacs-module.h. +includedir=@includedir@ + # Where to install Emacs's man pages. # Note they contain cross-references that expect them to be in section 1. mandir=@mandir@ @@ -560,6 +563,8 @@ set_installuser=for installuser in $${LOGNAME} $${USERNAME} $${USER} \ ## See also these comments from 2004 about cp -r working fine: ## https://lists.gnu.org/r/autoconf-patches/2004-11/msg00005.html install-arch-indep: lisp install-info install-man ${INSTALL_ARCH_INDEP_EXTRA} + umask 022 && $(MKDIR_P) -m 0755 $(includedir) + $(INSTALL_DATA) src/emacs-module.h $(includedir)/emacs-module.h -set ${COPYDESTS} ; \ unset CDPATH; \ $(set_installuser); \ @@ -743,6 +748,7 @@ install-strip: ### ### Don't delete the lisp and etc directories if they're in the source tree. uninstall: uninstall-$(NTDIR) uninstall-doc + rm -f $(includedir)/emacs-module.h $(MAKE) -C lib-src uninstall -unset CDPATH; \ for dir in "$(DESTDIR)${lispdir}" "$(DESTDIR)${etcdir}" ; do \ From c1d0dbd6ca92cb221024382b19654e4fbf1d1ed3 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Wed, 3 Oct 2018 16:47:01 -0400 Subject: [PATCH 33/72] Tweak Makefile emacs-module.h handling * Makefile.in (install-arch-indep, uninstall): Respect DESTDIR. Handle whitespace. Remove non-portable mkdir argument. --- Makefile.in | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Makefile.in b/Makefile.in index e10fdc3bd69..d8d345e8059 100644 --- a/Makefile.in +++ b/Makefile.in @@ -563,8 +563,8 @@ set_installuser=for installuser in $${LOGNAME} $${USERNAME} $${USER} \ ## See also these comments from 2004 about cp -r working fine: ## https://lists.gnu.org/r/autoconf-patches/2004-11/msg00005.html install-arch-indep: lisp install-info install-man ${INSTALL_ARCH_INDEP_EXTRA} - umask 022 && $(MKDIR_P) -m 0755 $(includedir) - $(INSTALL_DATA) src/emacs-module.h $(includedir)/emacs-module.h + umask 022 && $(MKDIR_P) "$(DESTDIR)$(includedir)" + $(INSTALL_DATA) src/emacs-module.h "$(DESTDIR)$(includedir)/emacs-module.h" -set ${COPYDESTS} ; \ unset CDPATH; \ $(set_installuser); \ @@ -748,7 +748,7 @@ install-strip: ### ### Don't delete the lisp and etc directories if they're in the source tree. uninstall: uninstall-$(NTDIR) uninstall-doc - rm -f $(includedir)/emacs-module.h + rm -f "$(DESTDIR)$(includedir)/emacs-module.h" $(MAKE) -C lib-src uninstall -unset CDPATH; \ for dir in "$(DESTDIR)${lispdir}" "$(DESTDIR)${etcdir}" ; do \ From 5cbce95796a2a8b8857fb9e289a9fd9a1158677b Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Wed, 3 Oct 2018 17:08:28 -0400 Subject: [PATCH 34/72] * Makefile.in (uninstall): Remove some stray icon files. --- Makefile.in | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/Makefile.in b/Makefile.in index d8d345e8059..f0b2b66c88b 100644 --- a/Makefile.in +++ b/Makefile.in @@ -786,7 +786,9 @@ uninstall: uninstall-$(NTDIR) uninstall-doc (if cd "$(DESTDIR)${icondir}"; then \ rm -f hicolor/*x*/apps/"${EMACS_NAME}.png" \ "hicolor/scalable/apps/${EMACS_NAME}.svg" \ - hicolor/scalable/mimetypes/`echo emacs-document | sed '$(TRANSFORM)'`.svg; \ + "hicolor/scalable/apps/${EMACS_NAME}.ico" \ + "hicolor/scalable/mimetypes/${EMACS_NAME}-document.svg" \ + "hicolor/scalable/mimetypes/${EMACS_NAME}-document23.svg"; \ fi) -rm -f "$(DESTDIR)${desktopdir}/${EMACS_NAME}.desktop" -rm -f "$(DESTDIR)${appdatadir}/${EMACS_NAME}.appdata.xml" From 945a7622326f7d93dd318f01d54f6bf23e0021cf Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 3 Oct 2018 15:55:43 -0700 Subject: [PATCH 35/72] Fix emacs_re_safe_alloca calculation Problem and draft fix noted by Eli Zaretskii in: https://lists.gnu.org/r/emacs-devel/2018-10/msg00022.html * src/emacs.c (main): Fix arithmetic used in calculation of emacs_re_safe_alloca. --- src/emacs.c | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/emacs.c b/src/emacs.c index b1c96d18285..ddaaf3fed51 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -888,11 +888,11 @@ main (int argc, char **argv) lim = newlim; } } - /* If the stack is big enough, let regex-emacs.c more of it before - falling back to heap allocation. */ - emacs_re_safe_alloca = max - (min (lim - extra, SIZE_MAX) * (min_ratio / ratio), - MAX_ALLOCA); + /* If the stack is big enough, let regex-emacs.c use more of it + before falling back to heap allocation. */ + ptrdiff_t max_failures + = min (lim - extra, min (PTRDIFF_MAX, SIZE_MAX)) / ratio; + emacs_re_safe_alloca = max (max_failures * min_ratio, MAX_ALLOCA); } #endif /* HAVE_SETRLIMIT and RLIMIT_STACK and not CYGWIN */ From 44bf4a6b012f65327718b8c8334bfac1aee26370 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 4 Oct 2018 09:46:14 +0200 Subject: [PATCH 36/72] Some reaarangements in tramp*.texi * doc/misc/trampver.texi (trampfn): Change check for definition of macro. (tramp-bug-report-address): New variable. * doc/misc/tramp.texi (Top, Bug Reports): Use it. --- doc/misc/tramp.texi | 12 ++++++------ doc/misc/trampver.texi | 19 +++++++++++-------- lisp/net/trampver.el | 9 ++++----- 3 files changed, 21 insertions(+), 19 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 7bc365ffdfe..7c5ebf334ae 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -73,9 +73,9 @@ Savannah Project Page}. @end ifhtml There is a mailing list for @value{tramp}, available at -@email{tramp-devel@@gnu.org}, and archived at -@uref{https://lists.gnu.org/r/tramp-devel/, the -@value{tramp} Mail Archive}. +@email{@value{tramp-bug-report-address}}, and archived at +@uref{https://lists.gnu.org/r/tramp-devel/, the @value{tramp} Mail +Archive}. @page @insertcopying @@ -3247,9 +3247,9 @@ discussing, and general discussions about @value{tramp}. post for moderator approval. Sometimes this approval step may take as long as 48 hours due to public holidays. -@email{tramp-devel@@gnu.org} is the mailing list. Messages sent to -this address go to all the subscribers. This is @emph{not} the -address to send subscription requests to. +@email{@value{tramp-bug-report-address}} is the mailing list. +Messages sent to this address go to all the subscribers. This is +@emph{not} the address to send subscription requests to. To subscribe to the mailing list, visit: @uref{https://lists.gnu.org/mailman/listinfo/tramp-devel/, the diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index db4654ce28e..aac7243446f 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -5,12 +5,12 @@ @c Copyright (C) 2003-2018 Free Software Foundation, Inc. @c See file doclicense.texi for copying conditions. -@c In the Tramp GIT, the version number is auto-frobbed from -@c configure.ac, so you should edit that file and run -@c "autoconf && ./configure" to change the version number. +@c In the Tramp GIT, the version number is auto-frobbed from tramp.el, +@c and the bug report address is auto-frobbed from configure.ac. @set trampver 2.4.1-pre +@set tramp-bug-report-address tramp-devel@@gnu.org -@c Other flags from configuration +@c Other flags from configuration. @set instprefix /usr/local @set lispdir /usr/local/share/emacs/site-lisp @set infodir /usr/local/share/info @@ -46,12 +46,15 @@ @end ifset @c Macro for formatting a file name according to the respective -@c syntax. Macro arguments should not have any leading or trailing -@c whitespace. Not very elegant, but I don't know it better. - -@unmacro trampfn +@c syntax. trampver.texi is included several times in tramp.texi and +@c trampinst.texi. Redefining the macro is reported as warning for +@c creating the dvi and pdf files, so we declare the macro only the +@c first time this file is included. +@ifclear trampfndefined +@set trampfndefined @macro trampfn {method, userhost, localname} @value{prefix}@c \method\@value{postfixhop}@c \userhost\@value{postfix}\localname\ @end macro +@end ifclear diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 1956ab648b3..f17129a402b 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -25,11 +25,10 @@ ;;; Code: -;; In the Tramp GIT repository, the version number and the bug report -;; address are auto-frobbed from configure.ac, so you should edit that -;; file and run "autoconf && ./configure" to change them. Emacs -;; version check is defined in macro AC_EMACS_INFO of aclocal.m4; -;; should be changed only there. +;; In the Tramp GIT, the version number is auto-frobbed from tramp.el, +;; and the bug report address is auto-frobbed from configure.ac. +;; Emacs version check is defined in macro AC_EMACS_INFO of +;; aclocal.m4; should be changed only there. ;;;###tramp-autoload (defconst tramp-version "2.4.1-pre" From 86d2169ac3458412a084c7fc4047c3a389924cad Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 4 Oct 2018 19:13:17 +0300 Subject: [PATCH 37/72] Avoid ridiculously high stack limit requests on macOS * src/emacs.c (main): Avoid wraparound in subtraction of rlim_t values, in case rlim_t is an unsigned type. (Bug#32338) --- src/emacs.c | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/emacs.c b/src/emacs.c index 483e848f6db..f80047e89e7 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -875,7 +875,8 @@ main (int argc, char **argv) newlim = rlim.rlim_max; newlim -= newlim % pagesize; - if (pagesize <= newlim - lim) + if (newlim > lim /* in case rlim_t is an unsigned type */ + && pagesize <= newlim - lim) { rlim.rlim_cur = newlim; if (setrlimit (RLIMIT_STACK, &rlim) == 0) @@ -884,9 +885,10 @@ main (int argc, char **argv) } /* If the stack is big enough, let regex.c more of it before falling back to heap allocation. */ - emacs_re_safe_alloca = max - (min (lim - extra, SIZE_MAX) * (min_ratio / ratio), - MAX_ALLOCA); + if (lim < extra) + lim = extra; /* avoid wrap-around in unsigned subtraction */ + emacs_re_safe_alloca = + max (min (lim - extra, SIZE_MAX) * (min_ratio / ratio), MAX_ALLOCA); } #endif /* HAVE_SETRLIMIT and RLIMIT_STACK and not CYGWIN */ From 2cae1cf6f87a10f9d85d1759b1703abcc421c9a5 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sun, 8 Apr 2018 16:49:20 -0700 Subject: [PATCH 38/72] Further fix to eieio-persistent * lisp/emacs-lisp/eieio-base.el (eieio-persistent-validate/fix-slot-value): Make handling of hash tables and vectors recursive. This is necessary because the write process, in `eieio-override-prin1' is also recursive. With any luck, this will be the last fix of its kind. If that's true, cherry-pick to Emacs 26.2 later on. --- lisp/emacs-lisp/eieio-base.el | 32 +++++++++++++++----------------- 1 file changed, 15 insertions(+), 17 deletions(-) diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index cba6cab1d4f..b55bde71396 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -360,32 +360,30 @@ Second, any text properties will be stripped from strings." proposed-value)))) ;; For hash-tables and vectors, the top-level `read' will not ;; "look inside" member values, so we need to do that - ;; explicitly. + ;; explicitly. Because `eieio-override-prin1' is recursive in + ;; the case of hash-tables and vectors, we recurse + ;; `eieio-persistent-validate/fix-slot-value' here as well. ((hash-table-p proposed-value) (maphash (lambda (key value) - (cond ((class-p (car-safe value)) - (setf (gethash key proposed-value) - (eieio-persistent-convert-list-to-object - value))) - ((and (consp value) - (eq (car value) 'quote)) - (setf (gethash key proposed-value) - (cadr value))))) + (setf (gethash key proposed-value) + (if (class-p (car-safe value)) + (eieio-persistent-convert-list-to-object + value) + (eieio-persistent-validate/fix-slot-value + class slot value)))) proposed-value) proposed-value) ((vectorp proposed-value) (dotimes (i (length proposed-value)) (let ((val (aref proposed-value i))) - (cond ((class-p (car-safe val)) - (aset proposed-value i - (eieio-persistent-convert-list-to-object - (aref proposed-value i)))) - ((and (consp val) - (eq (car val) 'quote)) - (aset proposed-value i - (cadr val)))))) + (aset proposed-value i + (if (class-p (car-safe val)) + (eieio-persistent-convert-list-to-object + val) + (eieio-persistent-validate/fix-slot-value + class slot val))))) proposed-value) ((stringp proposed-value) From 79bda3bc4731c7ac67b499a154c636d8eeb2edee Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Fri, 5 Oct 2018 00:22:20 +0000 Subject: [PATCH 39/72] Make nneething allow CRLF-encoded files (bug#32940) * lisp/gnus/nneething.el (nneething-request-article): Bind coding system to raw-text instead of binary when reading a file, that may be CRLF-encoded (bug#32940). --- lisp/gnus/nneething.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el index 9b6a92f10e7..886cbf81461 100644 --- a/lisp/gnus/nneething.el +++ b/lisp/gnus/nneething.el @@ -123,7 +123,7 @@ included.") (file-exists-p file) ; The file exists. (not (file-directory-p file)) ; It's not a dir. (save-excursion - (let ((nnmail-file-coding-system 'binary)) + (let ((nnmail-file-coding-system 'raw-text)) (nnmail-find-file file)) ; Insert the file in the nntp buf. (unless (nnheader-article-p) ; Either it's a real article... (let ((type From 8c53d9fede22b1929de4b9aaaca6a5611d5c5475 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 5 Oct 2018 16:51:17 +0300 Subject: [PATCH 40/72] Fix a typo in a doc string. * lisp/window.el (display-buffer-alist): Fix a typo in a doc string. Reported by Michael Heerdegen . --- lisp/window.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/window.el b/lisp/window.el index 818bd3dd2bd..f96c887be48 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -6831,7 +6831,7 @@ See `display-buffer' for details.") (put 'display-buffer-overriding-action 'risky-local-variable t) (defcustom display-buffer-alist nil - "Alist of uder-defined conditional actions for `display-buffer'. + "Alist of user-defined conditional actions for `display-buffer'. Its value takes effect before `display-buffer-base-action' and `display-buffer-fallback-action', but after `display-buffer-overriding-action', which see. From 7e4229411be6064a7dcd95480af6f02faa86751f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Oct 2018 12:38:36 +0300 Subject: [PATCH 41/72] Update the locale and language database * lisp/international/mule-cmds.el (locale-language-names): Update the list of supported locales. Use existing language names where available. --- lisp/international/mule-cmds.el | 52 ++++++++++++++++++++------------- 1 file changed, 31 insertions(+), 21 deletions(-) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 333fe2aa917..88dfa6f34ba 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -2229,7 +2229,7 @@ See `set-language-info-alist' for use in programs." ("bg" "Bulgarian" cp1251) ; Bulgarian ; bh Bihari ; bi Bislama - ("bn" . "UTF-8") ; Bengali, Bangla + ("bn" "Bengali" utf-8) ; Bengali, Bangla ("bo" . "Tibetan") ("br" . "Latin-1") ; Breton ("bs" . "Latin-2") ; Bosnian @@ -2242,6 +2242,7 @@ See `set-language-info-alist' for use in programs." ("de" "German" iso-8859-1) ; dv Divehi ; dz Bhutani + ("ee" . "Latin-4") ; Ewe ("el" "Greek" iso-8859-7) ;; Users who specify "en" explicitly typically want Latin-1, not ASCII. ;; That's actually what the GNU locales define, modulo things like @@ -2250,10 +2251,10 @@ See `set-language-info-alist' for use in programs." ("en" "English" iso-8859-1) ; English ("eo" . "Esperanto") ; Esperanto ("es" "Spanish" iso-8859-1) - ("et" . "Latin-1") ; Estonian + ("et" . "Latin-9") ; Estonian ("eu" . "Latin-1") ; Basque - ("fa" . "UTF-8") ; Persian - ("fi" . "Latin-1") ; Finnish + ("fa" "Persian" utf-8) ; Persian + ("fi" . "Latin-9") ; Finnish ("fj" . "Latin-1") ; Fiji ("fo" . "Latin-1") ; Faroese ("fr" "French" iso-8859-1) ; French @@ -2263,11 +2264,12 @@ See `set-language-info-alist' for use in programs." ("gez" "Ethiopic" utf-8) ; Geez ("gl" . "Latin-1") ; Gallegan; Galician ; gn Guarani - ("gu" . "UTF-8") ; Gujarati + ("gu" "Gujarati" utf-8) ; Gujarati ("gv" . "Latin-1") ; Manx Gaelic ; ha Hausa ("he" "Hebrew" iso-8859-8) ("hi" "Devanagari" utf-8) ; Hindi + ("hni_IN" . "UTF-8") ; Chhattisgarhi ("hr" "Croatian" iso-8859-2) ; Croatian ("hu" . "Latin-2") ; Hungarian ; hy Armenian @@ -2284,20 +2286,20 @@ See `set-language-info-alist' for use in programs." ("ka" "Georgian" georgian-ps) ; Georgian ; kk Kazakh ("kl" . "Latin-1") ; Greenlandic - ; km Cambodian + ("km" "Khmer" utf-8) ; Cambodian, Khmer ("kn" "Kannada" utf-8) ("ko" "Korean" euc-kr) - ; ks Kashmiri + ("ks" . "UTF-8") ; Kashmiri ; ku Kurdish ("kw" . "Latin-1") ; Cornish - ; ky Kirghiz + ("ky" . "UTF-8") ; Kirghiz ("la" . "Latin-1") ; Latin ("lb" . "Latin-1") ; Luxemburgish - ("lg" . "Laint-6") ; Ganda + ("lg" . "Latin-6") ; Ganda, a.k.a. Luganda ; ln Lingala ("lo" "Lao" utf-8) ; Laothian ("lt" "Lithuanian" iso-8859-13) - ("lv" . "Latvian") ; Latvian, Lettish + ("lv" "Latvian" iso-8859-13) ; Latvian, Lettish ; mg Malagasy ("mi" . "Latin-7") ; Maori ("mk" "Cyrillic-ISO" iso-8859-5) ; Macedonian @@ -2307,24 +2309,29 @@ See `set-language-info-alist' for use in programs." ("mr" "Devanagari" utf-8) ; Marathi ("ms" . "Latin-1") ; Malay ("mt" . "Latin-3") ; Maltese - ; my Burmese + ("my" "Burmese" utf-8) ; Burmese ; na Nauru ("nb" . "Latin-1") ; Norwegian ("ne" "Devanagari" utf-8) ; Nepali ("nl" "Dutch" iso-8859-1) + ("nn" . "Latin-1") ; Norwegian Nynorsk ("no" . "Latin-1") ; Norwegian + ("nr_ZA" . "UTF-8") ; South Ndebele + ("nso_ZA" . "UTF-8") ; Pedi ("oc" . "Latin-1") ; Occitan ("om_ET" . "UTF-8") ; (Afan) Oromo ("om" . "Latin-1") ; (Afan) Oromo - ; or Oriya - ("pa" . "UTF-8") ; Punjabi - ("pl" . "Latin-2") ; Polish + ("or" "Oriya" utf-8) + ("pa" "Punjabi" utf-8) ; Punjabi + ("pl" "Polish" iso-8859-2) ; Polish ; ps Pashto, Pushto + ("pt_BR" "Brazilian Portuguese" iso-8859-1) ; Brazilian Portuguese ("pt" . "Latin-1") ; Portuguese ; qu Quechua ("rm" . "Latin-1") ; Rhaeto-Romanic ; rn Kirundi ("ro" "Romanian" iso-8859-2) + ("ru_RU.koi8r" "Cyrillic-KOI8" koi8-r) ("ru_RU" "Russian" iso-8859-5) ("ru_UA" "Russian" koi8-u) ; rw Kinyarwanda @@ -2333,7 +2340,7 @@ See `set-language-info-alist' for use in programs." ("se" . "UTF-8") ; Northern Sami ; sg Sangho ("sh" . "Latin-2") ; Serbo-Croatian - ; si Sinhalese + ("si" "Sinhala" utf-8) ; Sinhalese ("sid" . "UTF-8") ; Sidamo ("sk" "Slovak" iso-8859-2) ("sl" "Slovenian" iso-8859-2) @@ -2341,7 +2348,7 @@ See `set-language-info-alist' for use in programs." ; sn Shona ("so_ET" "UTF-8") ; Somali ("so" "Latin-1") ; Somali - ("sq" . "Latin-1") ; Albanian + ("sq" . "Latin-2") ; Albanian ("sr" . "Latin-2") ; Serbian (Latin alphabet) ; ss Siswati ("st" . "Latin-1") ; Sesotho @@ -2349,17 +2356,20 @@ See `set-language-info-alist' for use in programs." ("sv" "Swedish" iso-8859-1) ; Swedish ("sw" . "Latin-1") ; Swahili ("ta" "Tamil" utf-8) - ("te" . "UTF-8") ; Telugu + ("te" "Telugu" utf-8) ; Telugu ("tg" "Tajik" koi8-t) - ("th" "Thai" tis-620) + ("th_TH.tis620" "Thai" tis-620) + ("th_TH.TIS-620" "Thai" tis-620) + ("th_TH" "Thai" iso-8859-11) + ("th" "Thai" iso-8859-11) ("ti" "Ethiopic" utf-8) ; Tigrinya ("tig_ER" . "UTF-8") ; Tigre ; tk Turkmen ("tl" . "Latin-1") ; Tagalog - ; tn Setswana + ("tn" . "Latin-9") ; Setswana, Tswana ; to Tonga ("tr" "Turkish" iso-8859-9) - ; ts Tsonga + ("ts" . "Latin-1") ; Tsonga ("tt" . "UTF-8") ; Tatar ; tw Twi ; ug Uighur @@ -2367,6 +2377,7 @@ See `set-language-info-alist' for use in programs." ("ur" . "UTF-8") ; Urdu ("uz_UZ@cyrillic" . "UTF-8"); Uzbek ("uz" . "Latin-1") ; Uzbek + ("ve" . "UTF-8") ; Venda ("vi" "Vietnamese" utf-8) ; vo Volapuk ("wa" . "Latin-1") ; Walloon @@ -2396,7 +2407,6 @@ See `set-language-info-alist' for use in programs." ;; Nonstandard or obsolete language codes ("cz" . "Czech") ; e.g. Solaris 2.6 - ("ee" . "Latin-4") ; Estonian, e.g. X11R6.4 ("iw" . "Hebrew") ; e.g. X11R6.4 ("sp" . "Cyrillic-ISO") ; Serbian (Cyrillic alphabet), e.g. X11R6.4 ("su" . "Latin-1") ; Finnish, e.g. Solaris 2.6 From b99192fe24fc5dd75340083403e95a65cb4a6d79 Mon Sep 17 00:00:00 2001 From: "Charles A. Roelli" Date: Sat, 6 Oct 2018 21:24:32 +0200 Subject: [PATCH 42/72] * lisp/simple.el (transient-mark-mode): Correct documentation. (Bug#32956) --- lisp/simple.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index d5674aae9b4..8bbafe49d32 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5793,10 +5793,10 @@ Transient Mark mode if ARG is omitted or nil. Transient Mark mode is a global minor mode. When enabled, the region is highlighted with the `region' face whenever the mark -is active. The mark is \"deactivated\" by changing the buffer, -and after certain other operations that set the mark but whose -main purpose is something else--for example, incremental search, -\\[beginning-of-buffer], and \\[end-of-buffer]. +is active. The mark is \"deactivated\" after certain non-motion +commands, including those that change the text in the buffer, and +during shift or mouse selection by any unshifted cursor motion +command (see Info node `Shift Selection' for more details). You can also deactivate the mark by typing \\[keyboard-quit] or \\[keyboard-escape-quit]. From b5d08da1e9ea7ee1334d810348c656babe6a15d2 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 3 Oct 2018 09:10:00 -0700 Subject: [PATCH 43/72] Move timestamp-related stuff to timefns.c MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This does not change behavior; it’s just long-overdue refactoring (Bug#32902). * src/emacs.c (main): Call init_timefns, syms_of_timefns. * src/timefns.c: New file, containing timestamp-related stuff from editfns.c and sysdep.c. * src/Makefile.in (base_obj): Add timefns.o. * src/editfns.c: Simplify by moving a big chunk to timefns.c. Do not include systime.h, sys/resource.h, sys/param.h, strftime.h, coding.h. (HAVE_TZALLOC_BUG, TM_YEAR_BASE, HAVE_TM_GMTOFF, tzeqlen) (local_tz, utc_tz, emacs_localtime_rz, emacs_mktime_z) (invalid_time_zone_specification, xtzfree, tzlookup) (TIME_T_MIN, TIME_T_MAX, time_overflow, invalid_time) (check_time_validity, hi_time, lo_time, Fcurrent_time) (time_add, time_subtract, time_arith, Ftime_add) (Ftime_subtract, Ftime_less_p, Fget_internal_run_time) (make_lisp_time, disassemble_lisp_time, decode_float_time) (lisp_to_timespec, lisp_time_struct, lisp_time_argument) (lisp_seconds_argument, Ffloat_time, emacs_nmemftime) (Fformat_time_string, format_time_string, Fdecode_time) (check_tm_member, Fencode_time, Fcurrent_time_string) (tm_gmtoff, Fcurrent_time_zone, Fset_time_zone_rule) (emacs_getenv_TZ, emacs_setenv_TZ): Move to timefns.c. * src/emacs.c (main): Adjust to initialization changes. * src/sysdep.c: Include if it's present. Regularize includes a bit. (Fget_internal_run_time): Move here from editfns.c. (init_timefns, syms_of_timefns): New functions. * src/w32.h (w32_get_internal_run_time): Move decl here so that it need not be cloned. * test/src/editfns-tests.el: * test/src/editfns-tests.el (format-time-string-with-zone) (format-time-string-with-outlandish-zone) (editfns-tests--have-leap-seconds) (format-time-string-with-bignum-on-32-bit): Move to ... * test/src/timefns-tests.el: ... this new file. --- src/Makefile.in | 2 +- src/editfns.c | 1289 +------------------------------------ src/emacs.c | 10 +- src/lisp.h | 4 +- src/sysdep.c | 87 ++- src/systime.h | 8 +- src/timefns.c | 1287 ++++++++++++++++++++++++++++++++++++ src/w32.c | 2 - src/w32.h | 1 + test/src/editfns-tests.el | 59 -- test/src/timefns-tests.el | 79 +++ 11 files changed, 1440 insertions(+), 1388 deletions(-) create mode 100644 src/timefns.c create mode 100644 test/src/timefns-tests.el diff --git a/src/Makefile.in b/src/Makefile.in index 72f568988a8..2dba1026c34 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -399,7 +399,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ eval.o floatfns.o fns.o font.o print.o lread.o $(MODULES_OBJ) \ syntax.o $(UNEXEC_OBJ) bytecode.o \ process.o gnutls.o callproc.o \ - region-cache.o sound.o atimer.o \ + region-cache.o sound.o timefns.o atimer.o \ doprnt.o intervals.o textprop.o composite.o xml.o lcms.o $(NOTIFY_OBJ) \ $(XWIDGETS_OBJ) \ profiler.o decompress.o \ diff --git a/src/editfns.c b/src/editfns.c index 47509c23d04..e995b38a44d 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -35,34 +35,13 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" -/* systime.h includes which, on some systems, is required - for ; thus systime.h must be included before - */ -#include "systime.h" - -#if defined HAVE_SYS_RESOURCE_H -#include -#endif - -#include #include #include #include -#ifdef HAVE_TIMEZONE_T -# include -# if defined __NetBSD_Version__ && __NetBSD_Version__ < 700000000 -# define HAVE_TZALLOC_BUG true -# endif -#endif -#ifndef HAVE_TZALLOC_BUG -# define HAVE_TZALLOC_BUG false -#endif - #include #include #include -#include #include #include "composite.h" @@ -70,34 +49,12 @@ along with GNU Emacs. If not, see . */ #include "ptr-bounds.h" #include "character.h" #include "buffer.h" -#include "coding.h" #include "window.h" #include "blockinput.h" -#define TM_YEAR_BASE 1900 - -#ifdef WINDOWSNT -extern Lisp_Object w32_get_internal_run_time (void); -#endif - -static struct lisp_time lisp_time_struct (Lisp_Object, int *); -static Lisp_Object format_time_string (char const *, ptrdiff_t, struct timespec, - Lisp_Object, struct tm *); -static long int tm_gmtoff (struct tm *); -static int tm_diff (struct tm *, struct tm *); static void update_buffer_properties (ptrdiff_t, ptrdiff_t); static Lisp_Object styled_format (ptrdiff_t, Lisp_Object *, bool); -#ifndef HAVE_TM_GMTOFF -# define HAVE_TM_GMTOFF false -#endif - -enum { tzeqlen = sizeof "TZ=" - 1 }; - -/* Time zones equivalent to current local time and to UTC, respectively. */ -static timezone_t local_tz; -static timezone_t const utc_tz = 0; - /* The cached value of Vsystem_name. This is used only to compare it to Vsystem_name, so it need not be visible to the GC. */ static Lisp_Object cached_system_name; @@ -109,153 +66,9 @@ init_and_cache_system_name (void) cached_system_name = Vsystem_name; } -static struct tm * -emacs_localtime_rz (timezone_t tz, time_t const *t, struct tm *tm) -{ - tm = localtime_rz (tz, t, tm); - if (!tm && errno == ENOMEM) - memory_full (SIZE_MAX); - return tm; -} - -static time_t -emacs_mktime_z (timezone_t tz, struct tm *tm) -{ - errno = 0; - time_t t = mktime_z (tz, tm); - if (t == (time_t) -1 && errno == ENOMEM) - memory_full (SIZE_MAX); - return t; -} - -static _Noreturn void -invalid_time_zone_specification (Lisp_Object zone) -{ - xsignal2 (Qerror, build_string ("Invalid time zone specification"), zone); -} - -/* Free a timezone, except do not free the time zone for local time. - Freeing utc_tz is also a no-op. */ -static void -xtzfree (timezone_t tz) -{ - if (tz != local_tz) - tzfree (tz); -} - -/* Convert the Lisp time zone rule ZONE to a timezone_t object. - The returned value either is 0, or is LOCAL_TZ, or is newly allocated. - If SETTZ, set Emacs local time to the time zone rule; otherwise, - the caller should eventually pass the returned value to xtzfree. */ -static timezone_t -tzlookup (Lisp_Object zone, bool settz) -{ - static char const tzbuf_format[] = "<%+.*"pI"d>%s%"pI"d:%02d:%02d"; - char const *trailing_tzbuf_format = tzbuf_format + sizeof "<%+.*"pI"d" - 1; - char tzbuf[sizeof tzbuf_format + 2 * INT_STRLEN_BOUND (EMACS_INT)]; - char const *zone_string; - timezone_t new_tz; - - if (NILP (zone)) - return local_tz; - else if (EQ (zone, Qt) || EQ (zone, make_fixnum (0))) - { - zone_string = "UTC0"; - new_tz = utc_tz; - } - else - { - bool plain_integer = FIXNUMP (zone); - - if (EQ (zone, Qwall)) - zone_string = 0; - else if (STRINGP (zone)) - zone_string = SSDATA (ENCODE_SYSTEM (zone)); - else if (plain_integer || (CONSP (zone) && FIXNUMP (XCAR (zone)) - && CONSP (XCDR (zone)))) - { - Lisp_Object abbr UNINIT; - if (!plain_integer) - { - abbr = XCAR (XCDR (zone)); - zone = XCAR (zone); - } - - EMACS_INT abszone = eabs (XFIXNUM (zone)), hour = abszone / (60 * 60); - int hour_remainder = abszone % (60 * 60); - int min = hour_remainder / 60, sec = hour_remainder % 60; - - if (plain_integer) - { - int prec = 2; - EMACS_INT numzone = hour; - if (hour_remainder != 0) - { - prec += 2, numzone = 100 * numzone + min; - if (sec != 0) - prec += 2, numzone = 100 * numzone + sec; - } - sprintf (tzbuf, tzbuf_format, prec, - XFIXNUM (zone) < 0 ? -numzone : numzone, - &"-"[XFIXNUM (zone) < 0], hour, min, sec); - zone_string = tzbuf; - } - else - { - AUTO_STRING (leading, "<"); - AUTO_STRING_WITH_LEN (trailing, tzbuf, - sprintf (tzbuf, trailing_tzbuf_format, - &"-"[XFIXNUM (zone) < 0], - hour, min, sec)); - zone_string = SSDATA (concat3 (leading, ENCODE_SYSTEM (abbr), - trailing)); - } - } - else - invalid_time_zone_specification (zone); - - new_tz = tzalloc (zone_string); - - if (HAVE_TZALLOC_BUG && !new_tz && errno != ENOMEM && plain_integer - && XFIXNUM (zone) % (60 * 60) == 0) - { - /* tzalloc mishandles POSIX strings; fall back on tzdb if - possible (Bug#30738). */ - sprintf (tzbuf, "Etc/GMT%+"pI"d", - (XFIXNUM (zone) / (60 * 60))); - new_tz = tzalloc (zone_string); - } - - if (!new_tz) - { - if (errno == ENOMEM) - memory_full (SIZE_MAX); - invalid_time_zone_specification (zone); - } - } - - if (settz) - { - block_input (); - emacs_setenv_TZ (zone_string); - tzset (); - timezone_t old_tz = local_tz; - local_tz = new_tz; - tzfree (old_tz); - unblock_input (); - } - - return new_tz; -} - void -init_editfns (bool dumping) +init_editfns (void) { -#if !defined CANNOT_DUMP - /* A valid but unlikely setting for the TZ environment variable. - It is OK (though a bit slower) if the user chooses this value. */ - static char dump_tz_string[] = "TZ=UtC0"; -#endif - const char *user_name; register char *p; struct passwd *pw; /* password entry for the current user */ @@ -264,37 +77,6 @@ init_editfns (bool dumping) /* Set up system_name even when dumping. */ init_and_cache_system_name (); -#ifndef CANNOT_DUMP - /* When just dumping out, set the time zone to a known unlikely value - and skip the rest of this function. */ - if (dumping) - { - xputenv (dump_tz_string); - tzset (); - return; - } -#endif - - char *tz = getenv ("TZ"); - -#if !defined CANNOT_DUMP - /* If the execution TZ happens to be the same as the dump TZ, - change it to some other value and then change it back, - to force the underlying implementation to reload the TZ info. - This is needed on implementations that load TZ info from files, - since the TZ file contents may differ between dump and execution. */ - if (tz && strcmp (tz, &dump_tz_string[tzeqlen]) == 0) - { - ++*tz; - tzset (); - --*tz; - } -#endif - - /* Set the time zone rule now, so that the call to putenv is done - before multiple threads are active. */ - tzlookup (tz ? build_string (tz) : Qwall, true); - pw = getpwuid (getuid ()); #ifdef MSDOS /* We let the real user name default to "root" because that's quite @@ -1349,7 +1131,7 @@ of the user with that uid, or nil if there is no such user. */) (That can happen if Emacs is dumpable but you decide to run `temacs -l loadup' and not dump. */ if (NILP (Vuser_login_name)) - init_editfns (false); + init_editfns (); if (NILP (uid)) return Vuser_login_name; @@ -1372,7 +1154,7 @@ This ignores the environment variables LOGNAME and USER, so it differs from (That can happen if Emacs is dumpable but you decide to run `temacs -l loadup' and not dump. */ if (NILP (Vuser_login_name)) - init_editfns (false); + init_editfns (); return Vuser_real_login_name; } @@ -1493,1058 +1275,6 @@ Value is a fixnum, if it's small enough, otherwise a bignum. */) return INT_TO_INTEGER (pid); } - - -#ifndef TIME_T_MIN -# define TIME_T_MIN TYPE_MINIMUM (time_t) -#endif -#ifndef TIME_T_MAX -# define TIME_T_MAX TYPE_MAXIMUM (time_t) -#endif - -/* Report that a time value is out of range for Emacs. */ -void -time_overflow (void) -{ - error ("Specified time is not representable"); -} - -static _Noreturn void -invalid_time (void) -{ - error ("Invalid time specification"); -} - -/* Check a return value compatible with that of decode_time_components. */ -static void -check_time_validity (int validity) -{ - if (validity <= 0) - { - if (validity < 0) - time_overflow (); - else - invalid_time (); - } -} - -/* Return the upper part of the time T (everything but the bottom 16 bits). */ -static EMACS_INT -hi_time (time_t t) -{ - time_t hi = t >> LO_TIME_BITS; - if (FIXNUM_OVERFLOW_P (hi)) - time_overflow (); - return hi; -} - -/* Return the bottom bits of the time T. */ -static int -lo_time (time_t t) -{ - return t & ((1 << LO_TIME_BITS) - 1); -} - -DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0, - doc: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00. -The time is returned as a list of integers (HIGH LOW USEC PSEC). -HIGH has the most significant bits of the seconds, while LOW has the -least significant 16 bits. USEC and PSEC are the microsecond and -picosecond counts. */) - (void) -{ - return make_lisp_time (current_timespec ()); -} - -static struct lisp_time -time_add (struct lisp_time ta, struct lisp_time tb) -{ - EMACS_INT hi = ta.hi + tb.hi; - int lo = ta.lo + tb.lo; - int us = ta.us + tb.us; - int ps = ta.ps + tb.ps; - us += (1000000 <= ps); - ps -= (1000000 <= ps) * 1000000; - lo += (1000000 <= us); - us -= (1000000 <= us) * 1000000; - hi += (1 << LO_TIME_BITS <= lo); - lo -= (1 << LO_TIME_BITS <= lo) << LO_TIME_BITS; - return (struct lisp_time) { hi, lo, us, ps }; -} - -static struct lisp_time -time_subtract (struct lisp_time ta, struct lisp_time tb) -{ - EMACS_INT hi = ta.hi - tb.hi; - int lo = ta.lo - tb.lo; - int us = ta.us - tb.us; - int ps = ta.ps - tb.ps; - us -= (ps < 0); - ps += (ps < 0) * 1000000; - lo -= (us < 0); - us += (us < 0) * 1000000; - hi -= (lo < 0); - lo += (lo < 0) << LO_TIME_BITS; - return (struct lisp_time) { hi, lo, us, ps }; -} - -static Lisp_Object -time_arith (Lisp_Object a, Lisp_Object b, bool subtract) -{ - if (FLOATP (a) && !isfinite (XFLOAT_DATA (a))) - { - double da = XFLOAT_DATA (a); - double db = XFLOAT_DATA (Ffloat_time (b)); - return make_float (subtract ? da - db : da + db); - } - if (FLOATP (b) && !isfinite (XFLOAT_DATA (b))) - return subtract ? make_float (-XFLOAT_DATA (b)) : b; - - int alen, blen; - struct lisp_time ta = lisp_time_struct (a, &alen); - struct lisp_time tb = lisp_time_struct (b, &blen); - struct lisp_time t = (subtract ? time_subtract : time_add) (ta, tb); - if (FIXNUM_OVERFLOW_P (t.hi)) - time_overflow (); - Lisp_Object val = Qnil; - - switch (max (alen, blen)) - { - default: - val = Fcons (make_fixnum (t.ps), val); - FALLTHROUGH; - case 3: - val = Fcons (make_fixnum (t.us), val); - FALLTHROUGH; - case 2: - val = Fcons (make_fixnum (t.lo), val); - val = Fcons (make_fixnum (t.hi), val); - break; - } - - return val; -} - -DEFUN ("time-add", Ftime_add, Stime_add, 2, 2, 0, - doc: /* Return the sum of two time values A and B, as a time value. -A nil value for either argument stands for the current time. -See `current-time-string' for the various forms of a time value. */) - (Lisp_Object a, Lisp_Object b) -{ - return time_arith (a, b, false); -} - -DEFUN ("time-subtract", Ftime_subtract, Stime_subtract, 2, 2, 0, - doc: /* Return the difference between two time values A and B, as a time value. -Use `float-time' to convert the difference into elapsed seconds. -A nil value for either argument stands for the current time. -See `current-time-string' for the various forms of a time value. */) - (Lisp_Object a, Lisp_Object b) -{ - return time_arith (a, b, true); -} - -/* Return negative, 0, positive if a < b, a == b, a > b respectively. - Return positive if either a or b is a NaN; this is good enough - for the current callers. */ -static int -time_cmp (Lisp_Object a, Lisp_Object b) -{ - if ((FLOATP (a) && !isfinite (XFLOAT_DATA (a))) - || (FLOATP (b) && !isfinite (XFLOAT_DATA (b)))) - { - double da = FLOATP (a) ? XFLOAT_DATA (a) : 0; - double db = FLOATP (b) ? XFLOAT_DATA (b) : 0; - return da < db ? -1 : da != db; - } - - int alen, blen; - struct lisp_time ta = lisp_time_struct (a, &alen); - struct lisp_time tb = lisp_time_struct (b, &blen); - return (ta.hi != tb.hi ? (ta.hi < tb.hi ? -1 : 1) - : ta.lo != tb.lo ? (ta.lo < tb.lo ? -1 : 1) - : ta.us != tb.us ? (ta.us < tb.us ? -1 : 1) - : ta.ps < tb.ps ? -1 : ta.ps != tb.ps); -} - -DEFUN ("time-less-p", Ftime_less_p, Stime_less_p, 2, 2, 0, - doc: /* Return non-nil if time value T1 is earlier than time value T2. -A nil value for either argument stands for the current time. -See `current-time-string' for the various forms of a time value. */) - (Lisp_Object t1, Lisp_Object t2) -{ - return time_cmp (t1, t2) < 0 ? Qt : Qnil; -} - -DEFUN ("time-equal-p", Ftime_equal_p, Stime_equal_p, 2, 2, 0, - doc: /* Return non-nil if T1 and T2 are equal time values. -A nil value for either argument stands for the current time. -See `current-time-string' for the various forms of a time value. */) - (Lisp_Object t1, Lisp_Object t2) -{ - return time_cmp (t1, t2) == 0 ? Qt : Qnil; -} - - -DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time, - 0, 0, 0, - doc: /* Return the current run time used by Emacs. -The time is returned as in the style of `current-time'. - -On systems that can't determine the run time, `get-internal-run-time' -does the same thing as `current-time'. */) - (void) -{ -#ifdef HAVE_GETRUSAGE - struct rusage usage; - time_t secs; - int usecs; - - if (getrusage (RUSAGE_SELF, &usage) < 0) - /* This shouldn't happen. What action is appropriate? */ - xsignal0 (Qerror); - - /* Sum up user time and system time. */ - secs = usage.ru_utime.tv_sec + usage.ru_stime.tv_sec; - usecs = usage.ru_utime.tv_usec + usage.ru_stime.tv_usec; - if (usecs >= 1000000) - { - usecs -= 1000000; - secs++; - } - return make_lisp_time (make_timespec (secs, usecs * 1000)); -#else /* ! HAVE_GETRUSAGE */ -#ifdef WINDOWSNT - return w32_get_internal_run_time (); -#else /* ! WINDOWSNT */ - return Fcurrent_time (); -#endif /* WINDOWSNT */ -#endif /* HAVE_GETRUSAGE */ -} - - -/* Make a Lisp list that represents the Emacs time T. T may be an - invalid time, with a slightly negative tv_nsec value such as - UNKNOWN_MODTIME_NSECS; in that case, the Lisp list contains a - correspondingly negative picosecond count. */ -Lisp_Object -make_lisp_time (struct timespec t) -{ - time_t s = t.tv_sec; - int ns = t.tv_nsec; - return list4i (hi_time (s), lo_time (s), ns / 1000, ns % 1000 * 1000); -} - -/* Decode a Lisp list SPECIFIED_TIME that represents a time. - Set *PHIGH, *PLOW, *PUSEC, *PPSEC to its parts; do not check their values. - Return 2, 3, or 4 to indicate the effective length of SPECIFIED_TIME - if successful, 0 if unsuccessful. */ -static int -disassemble_lisp_time (Lisp_Object specified_time, Lisp_Object *phigh, - Lisp_Object *plow, Lisp_Object *pusec, - Lisp_Object *ppsec) -{ - Lisp_Object high = make_fixnum (0); - Lisp_Object low = specified_time; - Lisp_Object usec = make_fixnum (0); - Lisp_Object psec = make_fixnum (0); - int len = 4; - - if (CONSP (specified_time)) - { - high = XCAR (specified_time); - low = XCDR (specified_time); - if (CONSP (low)) - { - Lisp_Object low_tail = XCDR (low); - low = XCAR (low); - if (CONSP (low_tail)) - { - usec = XCAR (low_tail); - low_tail = XCDR (low_tail); - if (CONSP (low_tail)) - psec = XCAR (low_tail); - else - len = 3; - } - else if (!NILP (low_tail)) - { - usec = low_tail; - len = 3; - } - else - len = 2; - } - else - len = 2; - - /* When combining components, require LOW to be an integer, - as otherwise it would be a pain to add up times. */ - if (! INTEGERP (low)) - return 0; - } - else if (INTEGERP (specified_time)) - len = 2; - - *phigh = high; - *plow = low; - *pusec = usec; - *ppsec = psec; - return len; -} - -/* Convert T into an Emacs time *RESULT, truncating toward minus infinity. - Return true if T is in range, false otherwise. */ -static bool -decode_float_time (double t, struct lisp_time *result) -{ - double lo_multiplier = 1 << LO_TIME_BITS; - double emacs_time_min = MOST_NEGATIVE_FIXNUM * lo_multiplier; - if (! (emacs_time_min <= t && t < -emacs_time_min)) - return false; - - double small_t = t / lo_multiplier; - EMACS_INT hi = small_t; - double t_sans_hi = t - hi * lo_multiplier; - int lo = t_sans_hi; - long double fracps = (t_sans_hi - lo) * 1e12L; -#ifdef INT_FAST64_MAX - int_fast64_t ifracps = fracps; - int us = ifracps / 1000000; - int ps = ifracps % 1000000; -#else - int us = fracps / 1e6L; - int ps = fracps - us * 1e6L; -#endif - us -= (ps < 0); - ps += (ps < 0) * 1000000; - lo -= (us < 0); - us += (us < 0) * 1000000; - hi -= (lo < 0); - lo += (lo < 0) << LO_TIME_BITS; - result->hi = hi; - result->lo = lo; - result->us = us; - result->ps = ps; - return true; -} - -/* From the time components HIGH, LOW, USEC and PSEC taken from a Lisp - list, generate the corresponding time value. - If LOW is floating point, the other components should be zero. - - If RESULT is not null, store into *RESULT the converted time. - If *DRESULT is not null, store into *DRESULT the number of - seconds since the start of the POSIX Epoch. - - Return 1 if successful, 0 if the components are of the - wrong type, and -1 if the time is out of range. */ -int -decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec, - Lisp_Object psec, - struct lisp_time *result, double *dresult) -{ - EMACS_INT hi, us, ps; - intmax_t lo; - if (! (FIXNUMP (high) - && FIXNUMP (usec) && FIXNUMP (psec))) - return 0; - if (! INTEGERP (low)) - { - if (FLOATP (low)) - { - double t = XFLOAT_DATA (low); - if (result && ! decode_float_time (t, result)) - return -1; - if (dresult) - *dresult = t; - return 1; - } - else if (NILP (low)) - { - struct timespec now = current_timespec (); - if (result) - { - result->hi = hi_time (now.tv_sec); - result->lo = lo_time (now.tv_sec); - result->us = now.tv_nsec / 1000; - result->ps = now.tv_nsec % 1000 * 1000; - } - if (dresult) - *dresult = now.tv_sec + now.tv_nsec / 1e9; - return 1; - } - else - return 0; - } - - hi = XFIXNUM (high); - if (! integer_to_intmax (low, &lo)) - return -1; - us = XFIXNUM (usec); - ps = XFIXNUM (psec); - - /* Normalize out-of-range lower-order components by carrying - each overflow into the next higher-order component. */ - us += ps / 1000000 - (ps % 1000000 < 0); - lo += us / 1000000 - (us % 1000000 < 0); - if (INT_ADD_WRAPV (lo >> LO_TIME_BITS, hi, &hi)) - return -1; - ps = ps % 1000000 + 1000000 * (ps % 1000000 < 0); - us = us % 1000000 + 1000000 * (us % 1000000 < 0); - lo &= (1 << LO_TIME_BITS) - 1; - - if (result) - { - if (FIXNUM_OVERFLOW_P (hi)) - return -1; - result->hi = hi; - result->lo = lo; - result->us = us; - result->ps = ps; - } - - if (dresult) - { - double dhi = hi; - *dresult = (us * 1e6 + ps) / 1e12 + lo + dhi * (1 << LO_TIME_BITS); - } - - return 1; -} - -struct timespec -lisp_to_timespec (struct lisp_time t) -{ - if (! ((TYPE_SIGNED (time_t) ? TIME_T_MIN >> LO_TIME_BITS <= t.hi : 0 <= t.hi) - && t.hi <= TIME_T_MAX >> LO_TIME_BITS)) - return invalid_timespec (); - time_t s = (t.hi << LO_TIME_BITS) + t.lo; - int ns = t.us * 1000 + t.ps / 1000; - return make_timespec (s, ns); -} - -/* Decode a Lisp list SPECIFIED_TIME that represents a time. - Store its effective length into *PLEN. - If SPECIFIED_TIME is nil, use the current time. - Signal an error if SPECIFIED_TIME does not represent a time. */ -static struct lisp_time -lisp_time_struct (Lisp_Object specified_time, int *plen) -{ - Lisp_Object high, low, usec, psec; - struct lisp_time t; - int len = disassemble_lisp_time (specified_time, &high, &low, &usec, &psec); - if (!len) - invalid_time (); - int val = decode_time_components (high, low, usec, psec, &t, 0); - check_time_validity (val); - *plen = len; - return t; -} - -/* Like lisp_time_struct, except return a struct timespec. - Discard any low-order digits. */ -struct timespec -lisp_time_argument (Lisp_Object specified_time) -{ - int len; - struct lisp_time lt = lisp_time_struct (specified_time, &len); - struct timespec t = lisp_to_timespec (lt); - if (! timespec_valid_p (t)) - time_overflow (); - return t; -} - -/* Like lisp_time_argument, except decode only the seconds part, - and do not check the subseconds part. */ -static time_t -lisp_seconds_argument (Lisp_Object specified_time) -{ - Lisp_Object high, low, usec, psec; - struct lisp_time t; - - int val = disassemble_lisp_time (specified_time, &high, &low, &usec, &psec); - if (val != 0) - { - val = decode_time_components (high, low, make_fixnum (0), - make_fixnum (0), &t, 0); - if (0 < val - && ! ((TYPE_SIGNED (time_t) - ? TIME_T_MIN >> LO_TIME_BITS <= t.hi - : 0 <= t.hi) - && t.hi <= TIME_T_MAX >> LO_TIME_BITS)) - val = -1; - } - check_time_validity (val); - return (t.hi << LO_TIME_BITS) + t.lo; -} - -DEFUN ("float-time", Ffloat_time, Sfloat_time, 0, 1, 0, - doc: /* Return the current time, as a float number of seconds since the epoch. -If SPECIFIED-TIME is given, it is the time to convert to float -instead of the current time. The argument should have the form -\(HIGH LOW) or (HIGH LOW USEC) or (HIGH LOW USEC PSEC). Thus, -you can use times from `current-time' and from `file-attributes'. -SPECIFIED-TIME can also have the form (HIGH . LOW), but this is -considered obsolete. - -WARNING: Since the result is floating point, it may not be exact. -If precise time stamps are required, use either `current-time', -or (if you need time as a string) `format-time-string'. */) - (Lisp_Object specified_time) -{ - double t; - Lisp_Object high, low, usec, psec; - if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec) - && decode_time_components (high, low, usec, psec, 0, &t))) - invalid_time (); - return make_float (t); -} - -/* Write information into buffer S of size MAXSIZE, according to the - FORMAT of length FORMAT_LEN, using time information taken from *TP. - Use the time zone specified by TZ. - Use NS as the number of nanoseconds in the %N directive. - Return the number of bytes written, not including the terminating - '\0'. If S is NULL, nothing will be written anywhere; so to - determine how many bytes would be written, use NULL for S and - ((size_t) -1) for MAXSIZE. - - This function behaves like nstrftime, except it allows null - bytes in FORMAT and it does not support nanoseconds. */ -static size_t -emacs_nmemftime (char *s, size_t maxsize, const char *format, - size_t format_len, const struct tm *tp, timezone_t tz, int ns) -{ - size_t total = 0; - - /* Loop through all the null-terminated strings in the format - argument. Normally there's just one null-terminated string, but - there can be arbitrarily many, concatenated together, if the - format contains '\0' bytes. nstrftime stops at the first - '\0' byte so we must invoke it separately for each such string. */ - for (;;) - { - size_t len; - size_t result; - - if (s) - s[0] = '\1'; - - result = nstrftime (s, maxsize, format, tp, tz, ns); - - if (s) - { - if (result == 0 && s[0] != '\0') - return 0; - s += result + 1; - } - - maxsize -= result + 1; - total += result; - len = strlen (format); - if (len == format_len) - return total; - total++; - format += len + 1; - format_len -= len + 1; - } -} - -DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0, - doc: /* Use FORMAT-STRING to format the time TIME, or now if omitted or nil. -TIME is specified as (HIGH LOW USEC PSEC), as returned by -`current-time' or `file-attributes'. It can also be a single integer -number of seconds since the epoch. The obsolete form (HIGH . LOW) is -also still accepted. - -The optional ZONE is omitted or nil for Emacs local time, t for -Universal Time, `wall' for system wall clock time, or a string as in -the TZ environment variable. It can also be a list (as from -`current-time-zone') or an integer (as from `decode-time') applied -without consideration for daylight saving time. - -The value is a copy of FORMAT-STRING, but with certain constructs replaced -by text that describes the specified date and time in TIME: - -%Y is the year, %y within the century, %C the century. -%G is the year corresponding to the ISO week, %g within the century. -%m is the numeric month. -%b and %h are the locale's abbreviated month name, %B the full name. - (%h is not supported on MS-Windows.) -%d is the day of the month, zero-padded, %e is blank-padded. -%u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6. -%a is the locale's abbreviated name of the day of week, %A the full name. -%U is the week number starting on Sunday, %W starting on Monday, - %V according to ISO 8601. -%j is the day of the year. - -%H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H - only blank-padded, %l is like %I blank-padded. -%p is the locale's equivalent of either AM or PM. -%q is the calendar quarter (1–4). -%M is the minute (00-59). -%S is the second (00-59; 00-60 on platforms with leap seconds) -%s is the number of seconds since 1970-01-01 00:00:00 +0000. -%N is the nanosecond, %6N the microsecond, %3N the millisecond, etc. -%Z is the time zone abbreviation, %z is the numeric form. - -%c is the locale's date and time format. -%x is the locale's "preferred" date format. -%D is like "%m/%d/%y". -%F is the ISO 8601 date format (like "%Y-%m-%d"). - -%R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p". -%X is the locale's "preferred" time format. - -Finally, %n is a newline, %t is a tab, %% is a literal %, and -unrecognized %-sequences stand for themselves. - -Certain flags and modifiers are available with some format controls. -The flags are `_', `-', `^' and `#'. For certain characters X, -%_X is like %X, but padded with blanks; %-X is like %X, -but without padding. %^X is like %X, but with all textual -characters up-cased; %#X is like %X, but with letter-case of -all textual characters reversed. -%NX (where N stands for an integer) is like %X, -but takes up at least N (a number) positions. -The modifiers are `E' and `O'. For certain characters X, -%EX is a locale's alternative version of %X; -%OX is like %X, but uses the locale's number symbols. - -For example, to produce full ISO 8601 format, use "%FT%T%z". - -usage: (format-time-string FORMAT-STRING &optional TIME ZONE) */) - (Lisp_Object format_string, Lisp_Object timeval, Lisp_Object zone) -{ - struct timespec t = lisp_time_argument (timeval); - struct tm tm; - - CHECK_STRING (format_string); - format_string = code_convert_string_norecord (format_string, - Vlocale_coding_system, 1); - return format_time_string (SSDATA (format_string), SBYTES (format_string), - t, zone, &tm); -} - -static Lisp_Object -format_time_string (char const *format, ptrdiff_t formatlen, - struct timespec t, Lisp_Object zone, struct tm *tmp) -{ - char buffer[4000]; - char *buf = buffer; - ptrdiff_t size = sizeof buffer; - size_t len; - int ns = t.tv_nsec; - USE_SAFE_ALLOCA; - - timezone_t tz = tzlookup (zone, false); - /* On some systems, like 32-bit MinGW, tv_sec of struct timespec is - a 64-bit type, but time_t is a 32-bit type. emacs_localtime_rz - expects a pointer to time_t value. */ - time_t tsec = t.tv_sec; - tmp = emacs_localtime_rz (tz, &tsec, tmp); - if (! tmp) - { - xtzfree (tz); - time_overflow (); - } - synchronize_system_time_locale (); - - while (true) - { - buf[0] = '\1'; - len = emacs_nmemftime (buf, size, format, formatlen, tmp, tz, ns); - if ((0 < len && len < size) || (len == 0 && buf[0] == '\0')) - break; - - /* Buffer was too small, so make it bigger and try again. */ - len = emacs_nmemftime (NULL, SIZE_MAX, format, formatlen, tmp, tz, ns); - if (STRING_BYTES_BOUND <= len) - { - xtzfree (tz); - string_overflow (); - } - size = len + 1; - buf = SAFE_ALLOCA (size); - } - - xtzfree (tz); - AUTO_STRING_WITH_LEN (bufstring, buf, len); - Lisp_Object result = code_convert_string_norecord (bufstring, - Vlocale_coding_system, 0); - SAFE_FREE (); - return result; -} - -DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 2, 0, - doc: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST UTCOFF). -The optional TIME should be a list of (HIGH LOW . IGNORED), -as from `current-time' and `file-attributes', or nil to use the -current time. It can also be a single integer number of seconds since -the epoch. The obsolete form (HIGH . LOW) is also still accepted. - -The optional ZONE is omitted or nil for Emacs local time, t for -Universal Time, `wall' for system wall clock time, or a string as in -the TZ environment variable. It can also be a list (as from -`current-time-zone') or an integer (the UTC offset in seconds) applied -without consideration for daylight saving time. - -The list has the following nine members: SEC is an integer between 0 -and 60; SEC is 60 for a leap second, which only some operating systems -support. MINUTE is an integer between 0 and 59. HOUR is an integer -between 0 and 23. DAY is an integer between 1 and 31. MONTH is an -integer between 1 and 12. YEAR is an integer indicating the -four-digit year. DOW is the day of week, an integer between 0 and 6, -where 0 is Sunday. DST is t if daylight saving time is in effect, -nil if it is not in effect, and -1 if this information is -not available. UTCOFF is an integer indicating the UTC offset in -seconds, i.e., the number of seconds east of Greenwich. (Note that -Common Lisp has different meanings for DOW and UTCOFF.) - -usage: (decode-time &optional TIME ZONE) */) - (Lisp_Object specified_time, Lisp_Object zone) -{ - time_t time_spec = lisp_seconds_argument (specified_time); - struct tm local_tm, gmt_tm; - timezone_t tz = tzlookup (zone, false); - struct tm *tm = emacs_localtime_rz (tz, &time_spec, &local_tm); - xtzfree (tz); - - if (! (tm - && MOST_NEGATIVE_FIXNUM - TM_YEAR_BASE <= local_tm.tm_year - && local_tm.tm_year <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE)) - time_overflow (); - - /* Avoid overflow when INT_MAX < EMACS_INT_MAX. */ - EMACS_INT tm_year_base = TM_YEAR_BASE; - - return CALLN (Flist, - make_fixnum (local_tm.tm_sec), - make_fixnum (local_tm.tm_min), - make_fixnum (local_tm.tm_hour), - make_fixnum (local_tm.tm_mday), - make_fixnum (local_tm.tm_mon + 1), - make_fixnum (local_tm.tm_year + tm_year_base), - make_fixnum (local_tm.tm_wday), - (local_tm.tm_isdst < 0 ? make_fixnum (-1) - : local_tm.tm_isdst == 0 ? Qnil : Qt), - (HAVE_TM_GMTOFF - ? make_fixnum (tm_gmtoff (&local_tm)) - : gmtime_r (&time_spec, &gmt_tm) - ? make_fixnum (tm_diff (&local_tm, &gmt_tm)) - : Qnil)); -} - -/* Return OBJ - OFFSET, checking that OBJ is a valid fixnum and that - the result is representable as an int. */ -static int -check_tm_member (Lisp_Object obj, int offset) -{ - CHECK_FIXNUM (obj); - EMACS_INT n = XFIXNUM (obj); - int result; - if (INT_SUBTRACT_WRAPV (n, offset, &result)) - time_overflow (); - return result; -} - -DEFUN ("encode-time", Fencode_time, Sencode_time, 6, MANY, 0, - doc: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time. -This is the reverse operation of `decode-time', which see. - -The optional ZONE is omitted or nil for Emacs local time, t for -Universal Time, `wall' for system wall clock time, or a string as in -the TZ environment variable. It can also be a list (as from -`current-time-zone') or an integer (as from `decode-time') applied -without consideration for daylight saving time. - -You can pass more than 7 arguments; then the first six arguments -are used as SECOND through YEAR, and the *last* argument is used as ZONE. -The intervening arguments are ignored. -This feature lets (apply \\='encode-time (decode-time ...)) work. - -Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed; -for example, a DAY of 0 means the day preceding the given month. -Year numbers less than 100 are treated just like other year numbers. -If you want them to stand for years in this century, you must do that yourself. - -Years before 1970 are not guaranteed to work. On some systems, -year values as low as 1901 do work. - -usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */) - (ptrdiff_t nargs, Lisp_Object *args) -{ - time_t value; - struct tm tm; - Lisp_Object zone = (nargs > 6 ? args[nargs - 1] : Qnil); - - tm.tm_sec = check_tm_member (args[0], 0); - tm.tm_min = check_tm_member (args[1], 0); - tm.tm_hour = check_tm_member (args[2], 0); - tm.tm_mday = check_tm_member (args[3], 0); - tm.tm_mon = check_tm_member (args[4], 1); - tm.tm_year = check_tm_member (args[5], TM_YEAR_BASE); - tm.tm_isdst = -1; - - timezone_t tz = tzlookup (zone, false); - value = emacs_mktime_z (tz, &tm); - xtzfree (tz); - - if (value == (time_t) -1) - time_overflow (); - - return list2i (hi_time (value), lo_time (value)); -} - -DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, - 0, 2, 0, - doc: /* Return the current local time, as a human-readable string. -Programs can use this function to decode a time, -since the number of columns in each field is fixed -if the year is in the range 1000-9999. -The format is `Sun Sep 16 01:03:52 1973'. -However, see also the functions `decode-time' and `format-time-string' -which provide a much more powerful and general facility. - -If SPECIFIED-TIME is given, it is a time to format instead of the -current time. The argument should have the form (HIGH LOW . IGNORED). -Thus, you can use times obtained from `current-time' and from -`file-attributes'. SPECIFIED-TIME can also be a single integer number -of seconds since the epoch. The obsolete form (HIGH . LOW) is also -still accepted. - -The optional ZONE is omitted or nil for Emacs local time, t for -Universal Time, `wall' for system wall clock time, or a string as in -the TZ environment variable. It can also be a list (as from -`current-time-zone') or an integer (as from `decode-time') applied -without consideration for daylight saving time. */) - (Lisp_Object specified_time, Lisp_Object zone) -{ - time_t value = lisp_seconds_argument (specified_time); - timezone_t tz = tzlookup (zone, false); - - /* Convert to a string in ctime format, except without the trailing - newline, and without the 4-digit year limit. Don't use asctime - or ctime, as they might dump core if the year is outside the - range -999 .. 9999. */ - struct tm tm; - struct tm *tmp = emacs_localtime_rz (tz, &value, &tm); - xtzfree (tz); - if (! tmp) - time_overflow (); - - static char const wday_name[][4] = - { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" }; - static char const mon_name[][4] = - { "Jan", "Feb", "Mar", "Apr", "May", "Jun", - "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" }; - printmax_t year_base = TM_YEAR_BASE; - char buf[sizeof "Mon Apr 30 12:49:17 " + INT_STRLEN_BOUND (int) + 1]; - int len = sprintf (buf, "%s %s%3d %02d:%02d:%02d %"pMd, - wday_name[tm.tm_wday], mon_name[tm.tm_mon], tm.tm_mday, - tm.tm_hour, tm.tm_min, tm.tm_sec, - tm.tm_year + year_base); - - return make_unibyte_string (buf, len); -} - -/* Yield A - B, measured in seconds. - This function is copied from the GNU C Library. */ -static int -tm_diff (struct tm *a, struct tm *b) -{ - /* Compute intervening leap days correctly even if year is negative. - Take care to avoid int overflow in leap day calculations, - but it's OK to assume that A and B are close to each other. */ - int a4 = (a->tm_year >> 2) + (TM_YEAR_BASE >> 2) - ! (a->tm_year & 3); - int b4 = (b->tm_year >> 2) + (TM_YEAR_BASE >> 2) - ! (b->tm_year & 3); - int a100 = a4 / 25 - (a4 % 25 < 0); - int b100 = b4 / 25 - (b4 % 25 < 0); - int a400 = a100 >> 2; - int b400 = b100 >> 2; - int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400); - int years = a->tm_year - b->tm_year; - int days = (365 * years + intervening_leap_days - + (a->tm_yday - b->tm_yday)); - return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour)) - + (a->tm_min - b->tm_min)) - + (a->tm_sec - b->tm_sec)); -} - -/* Yield A's UTC offset, or an unspecified value if unknown. */ -static long int -tm_gmtoff (struct tm *a) -{ -#if HAVE_TM_GMTOFF - return a->tm_gmtoff; -#else - return 0; -#endif -} - -DEFUN ("current-time-zone", Fcurrent_time_zone, Scurrent_time_zone, 0, 2, 0, - doc: /* Return the offset and name for the local time zone. -This returns a list of the form (OFFSET NAME). -OFFSET is an integer number of seconds ahead of UTC (east of Greenwich). - A negative value means west of Greenwich. -NAME is a string giving the name of the time zone. -If SPECIFIED-TIME is given, the time zone offset is determined from it -instead of using the current time. The argument should have the form -\(HIGH LOW . IGNORED). Thus, you can use times obtained from -`current-time' and from `file-attributes'. SPECIFIED-TIME can also be -a single integer number of seconds since the epoch. The obsolete form -(HIGH . LOW) is also still accepted. - -The optional ZONE is omitted or nil for Emacs local time, t for -Universal Time, `wall' for system wall clock time, or a string as in -the TZ environment variable. It can also be a list (as from -`current-time-zone') or an integer (as from `decode-time') applied -without consideration for daylight saving time. - -Some operating systems cannot provide all this information to Emacs; -in this case, `current-time-zone' returns a list containing nil for -the data it can't find. */) - (Lisp_Object specified_time, Lisp_Object zone) -{ - struct timespec value; - struct tm local_tm, gmt_tm; - Lisp_Object zone_offset, zone_name; - - zone_offset = Qnil; - value = make_timespec (lisp_seconds_argument (specified_time), 0); - zone_name = format_time_string ("%Z", sizeof "%Z" - 1, value, - zone, &local_tm); - - /* gmtime_r expects a pointer to time_t, but tv_sec of struct - timespec on some systems (MinGW) is a 64-bit field. */ - time_t tsec = value.tv_sec; - if (HAVE_TM_GMTOFF || gmtime_r (&tsec, &gmt_tm)) - { - long int offset = (HAVE_TM_GMTOFF - ? tm_gmtoff (&local_tm) - : tm_diff (&local_tm, &gmt_tm)); - zone_offset = make_fixnum (offset); - if (SCHARS (zone_name) == 0) - { - /* No local time zone name is available; use numeric zone instead. */ - long int hour = offset / 3600; - int min_sec = offset % 3600; - int amin_sec = min_sec < 0 ? - min_sec : min_sec; - int min = amin_sec / 60; - int sec = amin_sec % 60; - int min_prec = min_sec ? 2 : 0; - int sec_prec = sec ? 2 : 0; - char buf[sizeof "+0000" + INT_STRLEN_BOUND (long int)]; - zone_name = make_formatted_string (buf, "%c%.2ld%.*d%.*d", - (offset < 0 ? '-' : '+'), - hour, min_prec, min, sec_prec, sec); - } - } - - return list2 (zone_offset, zone_name); -} - -DEFUN ("set-time-zone-rule", Fset_time_zone_rule, Sset_time_zone_rule, 1, 1, 0, - doc: /* Set the Emacs local time zone using TZ, a string specifying a time zone rule. -If TZ is nil or `wall', use system wall clock time; this differs from -the usual Emacs convention where nil means current local time. If TZ -is t, use Universal Time. If TZ is a list (as from -`current-time-zone') or an integer (as from `decode-time'), use the -specified time zone without consideration for daylight saving time. - -Instead of calling this function, you typically want something else. -To temporarily use a different time zone rule for just one invocation -of `decode-time', `encode-time', or `format-time-string', pass the -function a ZONE argument. To change local time consistently -throughout Emacs, call (setenv "TZ" TZ): this changes both the -environment of the Emacs process and the variable -`process-environment', whereas `set-time-zone-rule' affects only the -former. */) - (Lisp_Object tz) -{ - tzlookup (NILP (tz) ? Qwall : tz, true); - return Qnil; -} - -/* A buffer holding a string of the form "TZ=value", intended - to be part of the environment. If TZ is supposed to be unset, - the buffer string is "tZ=". */ - static char *tzvalbuf; - -/* Get the local time zone rule. */ -char * -emacs_getenv_TZ (void) -{ - return tzvalbuf[0] == 'T' ? tzvalbuf + tzeqlen : 0; -} - -/* Set the local time zone rule to TZSTRING, which can be null to - denote wall clock time. Do not record the setting in LOCAL_TZ. - - This function is not thread-safe, in theory because putenv is not, - but mostly because of the static storage it updates. Other threads - that invoke localtime etc. may be adversely affected while this - function is executing. */ - -int -emacs_setenv_TZ (const char *tzstring) -{ - static ptrdiff_t tzvalbufsize; - ptrdiff_t tzstringlen = tzstring ? strlen (tzstring) : 0; - char *tzval = tzvalbuf; - bool new_tzvalbuf = tzvalbufsize <= tzeqlen + tzstringlen; - - if (new_tzvalbuf) - { - /* Do not attempt to free the old tzvalbuf, since another thread - may be using it. In practice, the first allocation is large - enough and memory does not leak. */ - tzval = xpalloc (NULL, &tzvalbufsize, - tzeqlen + tzstringlen - tzvalbufsize + 1, -1, 1); - tzvalbuf = tzval; - tzval[1] = 'Z'; - tzval[2] = '='; - } - - if (tzstring) - { - /* Modify TZVAL in place. Although this is dicey in a - multithreaded environment, we know of no portable alternative. - Calling putenv or setenv could crash some other thread. */ - tzval[0] = 'T'; - strcpy (tzval + tzeqlen, tzstring); - } - else - { - /* Turn 'TZ=whatever' into an empty environment variable 'tZ='. - Although this is also dicey, calling unsetenv here can crash Emacs. - See Bug#8705. */ - tzval[0] = 't'; - tzval[tzeqlen] = 0; - } - - -#ifndef WINDOWSNT - /* Modifying *TZVAL merely requires calling tzset (which is the - caller's responsibility). However, modifying TZVAL requires - calling putenv; although this is not thread-safe, in practice this - runs only on startup when there is only one thread. */ - bool need_putenv = new_tzvalbuf; -#else - /* MS-Windows 'putenv' copies the argument string into a block it - allocates, so modifying *TZVAL will not change the environment. - However, the other threads run by Emacs on MS-Windows never call - 'xputenv' or 'putenv' or 'unsetenv', so the original cause for the - dicey in-place modification technique doesn't exist there in the - first place. */ - bool need_putenv = true; -#endif - if (need_putenv) - xputenv (tzval); - - return 0; -} /* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a @@ -5764,19 +4494,6 @@ it to be non-nil. */); defsubr (&Sgroup_real_gid); defsubr (&Suser_full_name); defsubr (&Semacs_pid); - defsubr (&Scurrent_time); - defsubr (&Stime_add); - defsubr (&Stime_subtract); - defsubr (&Stime_equal_p); - defsubr (&Stime_less_p); - defsubr (&Sget_internal_run_time); - defsubr (&Sformat_time_string); - defsubr (&Sfloat_time); - defsubr (&Sdecode_time); - defsubr (&Sencode_time); - defsubr (&Scurrent_time_string); - defsubr (&Scurrent_time_zone); - defsubr (&Sset_time_zone_rule); defsubr (&Ssystem_name); defsubr (&Smessage); defsubr (&Smessage_box); diff --git a/src/emacs.c b/src/emacs.c index ddaaf3fed51..b7a82793523 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1512,6 +1512,8 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem syms_of_minibuf (); syms_of_process (); syms_of_search (); + syms_of_sysdep (); + syms_of_timefns (); syms_of_frame (); syms_of_syntax (); syms_of_terminal (); @@ -1653,9 +1655,11 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem init_charset (); - /* This calls putenv and so must precede init_process_emacs. Also, - it sets Voperating_system_release, which init_process_emacs uses. */ - init_editfns (dumping); + /* This calls putenv and so must precede init_process_emacs. */ + init_timefns (dumping); + + /* This sets Voperating_system_release, which init_process_emacs uses. */ + init_editfns (); /* These two call putenv. */ #ifdef HAVE_DBUS diff --git a/src/lisp.h b/src/lisp.h index bb190b691b0..ae329268dc4 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4014,11 +4014,10 @@ extern void save_excursion_save (union specbinding *); extern void save_excursion_restore (Lisp_Object, Lisp_Object); extern Lisp_Object save_restriction_save (void); extern void save_restriction_restore (Lisp_Object); -extern _Noreturn void time_overflow (void); extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool); extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, bool); -extern void init_editfns (bool); +extern void init_editfns (void); extern void syms_of_editfns (void); /* Defined in buffer.c. */ @@ -4355,6 +4354,7 @@ extern ptrdiff_t emacs_write_quit (int, void const *, ptrdiff_t); extern void emacs_perror (char const *); extern int renameat_noreplace (int, char const *, int, char const *); extern int str_collate (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); +extern void syms_of_sysdep (void); /* Defined in filelock.c. */ extern void lock_file (Lisp_Object); diff --git a/src/sysdep.c b/src/sysdep.c index 722d8138ded..06956863611 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -91,13 +91,19 @@ along with GNU Emacs. If not, see . */ #include #include +#include "syssignal.h" +#include "systime.h" #include "systty.h" #include "syswait.h" +#ifdef HAVE_SYS_RESOURCE_H +# include +#endif + #ifdef HAVE_SYS_UTSNAME_H -#include -#include -#endif /* HAVE_SYS_UTSNAME_H */ +# include +# include +#endif #include "keyboard.h" #include "frame.h" @@ -118,18 +124,15 @@ along with GNU Emacs. If not, see . */ #endif #ifdef WINDOWSNT -#include +# include /* In process.h which conflicts with the local copy. */ -#define _P_WAIT 0 +# define _P_WAIT 0 int _cdecl _spawnlp (int, const char *, const char *, ...); /* The following is needed for O_CLOEXEC, F_SETFD, FD_CLOEXEC, and several prototypes of functions called below. */ -#include +# include #endif -#include "syssignal.h" -#include "systime.h" - /* ULLONG_MAX is missing on Red Hat Linux 7.3; see Bug#11781. */ #ifndef ULLONG_MAX #define ULLONG_MAX TYPE_MAXIMUM (unsigned long long int) @@ -2704,30 +2707,6 @@ emacs_perror (char const *message) errno = err; } -/* Return a struct timeval that is roughly equivalent to T. - Use the least timeval not less than T. - Return an extremal value if the result would overflow. */ -struct timeval -make_timeval (struct timespec t) -{ - struct timeval tv; - tv.tv_sec = t.tv_sec; - tv.tv_usec = t.tv_nsec / 1000; - - if (t.tv_nsec % 1000 != 0) - { - if (tv.tv_usec < 999999) - tv.tv_usec++; - else if (tv.tv_sec < TYPE_MAXIMUM (time_t)) - { - tv.tv_sec++; - tv.tv_usec = 0; - } - } - - return tv; -} - /* Set the access and modification time stamps of FD (a.k.a. FILE) to be ATIME and MTIME, respectively. FD must be either negative -- in which case it is ignored -- @@ -3911,6 +3890,42 @@ system_process_attributes (Lisp_Object pid) } #endif /* !defined (WINDOWSNT) */ + +DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time, + 0, 0, 0, + doc: /* Return the current run time used by Emacs. +The time is returned as in the style of `current-time'. + +On systems that can't determine the run time, `get-internal-run-time' +does the same thing as `current-time'. */) + (void) +{ +#ifdef HAVE_GETRUSAGE + struct rusage usage; + time_t secs; + int usecs; + + if (getrusage (RUSAGE_SELF, &usage) < 0) + /* This shouldn't happen. What action is appropriate? */ + xsignal0 (Qerror); + + /* Sum up user time and system time. */ + secs = usage.ru_utime.tv_sec + usage.ru_stime.tv_sec; + usecs = usage.ru_utime.tv_usec + usage.ru_stime.tv_usec; + if (usecs >= 1000000) + { + usecs -= 1000000; + secs++; + } + return make_lisp_time (make_timespec (secs, usecs * 1000)); +#else /* ! HAVE_GETRUSAGE */ +#ifdef WINDOWSNT + return w32_get_internal_run_time (); +#else /* ! WINDOWSNT */ + return Fcurrent_time (); +#endif /* WINDOWSNT */ +#endif /* HAVE_GETRUSAGE */ +} /* Wide character string collation. */ @@ -4116,3 +4131,9 @@ str_collate (Lisp_Object s1, Lisp_Object s2, return res; } #endif /* WINDOWSNT */ + +void +syms_of_sysdep (void) +{ + defsubr (&Sget_internal_run_time); +} diff --git a/src/systime.h b/src/systime.h index ad5ab857308..f2f51b009e2 100644 --- a/src/systime.h +++ b/src/systime.h @@ -19,6 +19,7 @@ along with GNU Emacs. If not, see . */ #ifndef EMACS_SYSTIME_H #define EMACS_SYSTIME_H +#include "lisp.h" #include INLINE_HEADER_BEGIN @@ -66,7 +67,6 @@ timespec_valid_p (struct timespec t) /* defined in sysdep.c */ extern int set_file_times (int, const char *, struct timespec, struct timespec); -extern struct timeval make_timeval (struct timespec) ATTRIBUTE_CONST; /* defined in keyboard.c */ extern void set_waiting_for_input (struct timespec *); @@ -82,12 +82,16 @@ struct lisp_time int lo, us, ps; }; -/* defined in editfns.c */ +/* defined in timefns.c */ +extern struct timeval make_timeval (struct timespec) ATTRIBUTE_CONST; extern Lisp_Object make_lisp_time (struct timespec); extern int decode_time_components (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, struct lisp_time *, double *); extern struct timespec lisp_to_timespec (struct lisp_time); extern struct timespec lisp_time_argument (Lisp_Object); +extern _Noreturn void time_overflow (void); +extern void init_timefns (bool); +extern void syms_of_timefns (void); INLINE_HEADER_END diff --git a/src/timefns.c b/src/timefns.c new file mode 100644 index 00000000000..fcb4485ae30 --- /dev/null +++ b/src/timefns.c @@ -0,0 +1,1287 @@ +/* Timestamp functions for Emacs + +Copyright (C) 1985-1987, 1989, 1993-2018 Free Software Foundation, Inc. + +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 . */ + +#include + +#include "systime.h" + +#include "blockinput.h" +#include "coding.h" +#include "lisp.h" + +#include + +#include +#include +#include +#include + +#ifdef HAVE_TIMEZONE_T +# include +# if defined __NetBSD_Version__ && __NetBSD_Version__ < 700000000 +# define HAVE_TZALLOC_BUG true +# endif +#endif +#ifndef HAVE_TZALLOC_BUG +# define HAVE_TZALLOC_BUG false +#endif + +#define TM_YEAR_BASE 1900 + +#ifndef HAVE_TM_GMTOFF +# define HAVE_TM_GMTOFF false +#endif + +#ifndef TIME_T_MIN +# define TIME_T_MIN TYPE_MINIMUM (time_t) +#endif +#ifndef TIME_T_MAX +# define TIME_T_MAX TYPE_MAXIMUM (time_t) +#endif + +/* Return a struct timeval that is roughly equivalent to T. + Use the least timeval not less than T. + Return an extremal value if the result would overflow. */ +struct timeval +make_timeval (struct timespec t) +{ + struct timeval tv; + tv.tv_sec = t.tv_sec; + tv.tv_usec = t.tv_nsec / 1000; + + if (t.tv_nsec % 1000 != 0) + { + if (tv.tv_usec < 999999) + tv.tv_usec++; + else if (tv.tv_sec < TYPE_MAXIMUM (time_t)) + { + tv.tv_sec++; + tv.tv_usec = 0; + } + } + + return tv; +} + +/* Yield A's UTC offset, or an unspecified value if unknown. */ +static long int +tm_gmtoff (struct tm *a) +{ +#if HAVE_TM_GMTOFF + return a->tm_gmtoff; +#else + return 0; +#endif +} + +/* Yield A - B, measured in seconds. + This function is copied from the GNU C Library. */ +static int +tm_diff (struct tm *a, struct tm *b) +{ + /* Compute intervening leap days correctly even if year is negative. + Take care to avoid int overflow in leap day calculations, + but it's OK to assume that A and B are close to each other. */ + int a4 = (a->tm_year >> 2) + (TM_YEAR_BASE >> 2) - ! (a->tm_year & 3); + int b4 = (b->tm_year >> 2) + (TM_YEAR_BASE >> 2) - ! (b->tm_year & 3); + int a100 = a4 / 25 - (a4 % 25 < 0); + int b100 = b4 / 25 - (b4 % 25 < 0); + int a400 = a100 >> 2; + int b400 = b100 >> 2; + int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400); + int years = a->tm_year - b->tm_year; + int days = (365 * years + intervening_leap_days + + (a->tm_yday - b->tm_yday)); + return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour)) + + (a->tm_min - b->tm_min)) + + (a->tm_sec - b->tm_sec)); +} + +enum { tzeqlen = sizeof "TZ=" - 1 }; + +/* Time zones equivalent to current local time and to UTC, respectively. */ +static timezone_t local_tz; +static timezone_t const utc_tz = 0; + +static struct tm * +emacs_localtime_rz (timezone_t tz, time_t const *t, struct tm *tm) +{ + tm = localtime_rz (tz, t, tm); + if (!tm && errno == ENOMEM) + memory_full (SIZE_MAX); + return tm; +} + +static time_t +emacs_mktime_z (timezone_t tz, struct tm *tm) +{ + errno = 0; + time_t t = mktime_z (tz, tm); + if (t == (time_t) -1 && errno == ENOMEM) + memory_full (SIZE_MAX); + return t; +} + +static _Noreturn void +invalid_time_zone_specification (Lisp_Object zone) +{ + xsignal2 (Qerror, build_string ("Invalid time zone specification"), zone); +} + +/* Free a timezone, except do not free the time zone for local time. + Freeing utc_tz is also a no-op. */ +static void +xtzfree (timezone_t tz) +{ + if (tz != local_tz) + tzfree (tz); +} + +/* Convert the Lisp time zone rule ZONE to a timezone_t object. + The returned value either is 0, or is LOCAL_TZ, or is newly allocated. + If SETTZ, set Emacs local time to the time zone rule; otherwise, + the caller should eventually pass the returned value to xtzfree. */ +static timezone_t +tzlookup (Lisp_Object zone, bool settz) +{ + static char const tzbuf_format[] = "<%+.*"pI"d>%s%"pI"d:%02d:%02d"; + char const *trailing_tzbuf_format = tzbuf_format + sizeof "<%+.*"pI"d" - 1; + char tzbuf[sizeof tzbuf_format + 2 * INT_STRLEN_BOUND (EMACS_INT)]; + char const *zone_string; + timezone_t new_tz; + + if (NILP (zone)) + return local_tz; + else if (EQ (zone, Qt) || EQ (zone, make_fixnum (0))) + { + zone_string = "UTC0"; + new_tz = utc_tz; + } + else + { + bool plain_integer = FIXNUMP (zone); + + if (EQ (zone, Qwall)) + zone_string = 0; + else if (STRINGP (zone)) + zone_string = SSDATA (ENCODE_SYSTEM (zone)); + else if (plain_integer || (CONSP (zone) && FIXNUMP (XCAR (zone)) + && CONSP (XCDR (zone)))) + { + Lisp_Object abbr UNINIT; + if (!plain_integer) + { + abbr = XCAR (XCDR (zone)); + zone = XCAR (zone); + } + + EMACS_INT abszone = eabs (XFIXNUM (zone)), hour = abszone / (60 * 60); + int hour_remainder = abszone % (60 * 60); + int min = hour_remainder / 60, sec = hour_remainder % 60; + + if (plain_integer) + { + int prec = 2; + EMACS_INT numzone = hour; + if (hour_remainder != 0) + { + prec += 2, numzone = 100 * numzone + min; + if (sec != 0) + prec += 2, numzone = 100 * numzone + sec; + } + sprintf (tzbuf, tzbuf_format, prec, + XFIXNUM (zone) < 0 ? -numzone : numzone, + &"-"[XFIXNUM (zone) < 0], hour, min, sec); + zone_string = tzbuf; + } + else + { + AUTO_STRING (leading, "<"); + AUTO_STRING_WITH_LEN (trailing, tzbuf, + sprintf (tzbuf, trailing_tzbuf_format, + &"-"[XFIXNUM (zone) < 0], + hour, min, sec)); + zone_string = SSDATA (concat3 (leading, ENCODE_SYSTEM (abbr), + trailing)); + } + } + else + invalid_time_zone_specification (zone); + + new_tz = tzalloc (zone_string); + + if (HAVE_TZALLOC_BUG && !new_tz && errno != ENOMEM && plain_integer + && XFIXNUM (zone) % (60 * 60) == 0) + { + /* tzalloc mishandles POSIX strings; fall back on tzdb if + possible (Bug#30738). */ + sprintf (tzbuf, "Etc/GMT%+"pI"d", - (XFIXNUM (zone) / (60 * 60))); + new_tz = tzalloc (zone_string); + } + + if (!new_tz) + { + if (errno == ENOMEM) + memory_full (SIZE_MAX); + invalid_time_zone_specification (zone); + } + } + + if (settz) + { + block_input (); + emacs_setenv_TZ (zone_string); + tzset (); + timezone_t old_tz = local_tz; + local_tz = new_tz; + tzfree (old_tz); + unblock_input (); + } + + return new_tz; +} + +void +init_timefns (bool dumping) +{ +#ifndef CANNOT_DUMP + /* A valid but unlikely setting for the TZ environment variable. + It is OK (though a bit slower) if the user chooses this value. */ + static char dump_tz_string[] = "TZ=UtC0"; + + /* When just dumping out, set the time zone to a known unlikely value + and skip the rest of this function. */ + if (dumping) + { + xputenv (dump_tz_string); + tzset (); + return; + } +#endif + + char *tz = getenv ("TZ"); + +#if !defined CANNOT_DUMP + /* If the execution TZ happens to be the same as the dump TZ, + change it to some other value and then change it back, + to force the underlying implementation to reload the TZ info. + This is needed on implementations that load TZ info from files, + since the TZ file contents may differ between dump and execution. */ + if (tz && strcmp (tz, &dump_tz_string[tzeqlen]) == 0) + { + ++*tz; + tzset (); + --*tz; + } +#endif + + /* Set the time zone rule now, so that the call to putenv is done + before multiple threads are active. */ + tzlookup (tz ? build_string (tz) : Qwall, true); +} + +/* Report that a time value is out of range for Emacs. */ +void +time_overflow (void) +{ + error ("Specified time is not representable"); +} + +static _Noreturn void +invalid_time (void) +{ + error ("Invalid time specification"); +} + +/* Check a return value compatible with that of decode_time_components. */ +static void +check_time_validity (int validity) +{ + if (validity <= 0) + { + if (validity < 0) + time_overflow (); + else + invalid_time (); + } +} + +/* Return the upper part of the time T (everything but the bottom 16 bits). */ +static EMACS_INT +hi_time (time_t t) +{ + time_t hi = t >> LO_TIME_BITS; + if (FIXNUM_OVERFLOW_P (hi)) + time_overflow (); + return hi; +} + +/* Return the bottom bits of the time T. */ +static int +lo_time (time_t t) +{ + return t & ((1 << LO_TIME_BITS) - 1); +} + +/* Decode a Lisp list SPECIFIED_TIME that represents a time. + Set *PHIGH, *PLOW, *PUSEC, *PPSEC to its parts; do not check their values. + Return 2, 3, or 4 to indicate the effective length of SPECIFIED_TIME + if successful, 0 if unsuccessful. */ +static int +disassemble_lisp_time (Lisp_Object specified_time, Lisp_Object *phigh, + Lisp_Object *plow, Lisp_Object *pusec, + Lisp_Object *ppsec) +{ + Lisp_Object high = make_fixnum (0); + Lisp_Object low = specified_time; + Lisp_Object usec = make_fixnum (0); + Lisp_Object psec = make_fixnum (0); + int len = 4; + + if (CONSP (specified_time)) + { + high = XCAR (specified_time); + low = XCDR (specified_time); + if (CONSP (low)) + { + Lisp_Object low_tail = XCDR (low); + low = XCAR (low); + if (CONSP (low_tail)) + { + usec = XCAR (low_tail); + low_tail = XCDR (low_tail); + if (CONSP (low_tail)) + psec = XCAR (low_tail); + else + len = 3; + } + else if (!NILP (low_tail)) + { + usec = low_tail; + len = 3; + } + else + len = 2; + } + else + len = 2; + + /* When combining components, require LOW to be an integer, + as otherwise it would be a pain to add up times. */ + if (! INTEGERP (low)) + return 0; + } + else if (INTEGERP (specified_time)) + len = 2; + + *phigh = high; + *plow = low; + *pusec = usec; + *ppsec = psec; + return len; +} + +/* Convert T into an Emacs time *RESULT, truncating toward minus infinity. + Return true if T is in range, false otherwise. */ +static bool +decode_float_time (double t, struct lisp_time *result) +{ + double lo_multiplier = 1 << LO_TIME_BITS; + double emacs_time_min = MOST_NEGATIVE_FIXNUM * lo_multiplier; + if (! (emacs_time_min <= t && t < -emacs_time_min)) + return false; + + double small_t = t / lo_multiplier; + EMACS_INT hi = small_t; + double t_sans_hi = t - hi * lo_multiplier; + int lo = t_sans_hi; + long double fracps = (t_sans_hi - lo) * 1e12L; +#ifdef INT_FAST64_MAX + int_fast64_t ifracps = fracps; + int us = ifracps / 1000000; + int ps = ifracps % 1000000; +#else + int us = fracps / 1e6L; + int ps = fracps - us * 1e6L; +#endif + us -= (ps < 0); + ps += (ps < 0) * 1000000; + lo -= (us < 0); + us += (us < 0) * 1000000; + hi -= (lo < 0); + lo += (lo < 0) << LO_TIME_BITS; + result->hi = hi; + result->lo = lo; + result->us = us; + result->ps = ps; + return true; +} + +/* From the time components HIGH, LOW, USEC and PSEC taken from a Lisp + list, generate the corresponding time value. + If LOW is floating point, the other components should be zero. + + If RESULT is not null, store into *RESULT the converted time. + If *DRESULT is not null, store into *DRESULT the number of + seconds since the start of the POSIX Epoch. + + Return 1 if successful, 0 if the components are of the + wrong type, and -1 if the time is out of range. */ +int +decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec, + Lisp_Object psec, + struct lisp_time *result, double *dresult) +{ + EMACS_INT hi, us, ps; + intmax_t lo; + if (! (FIXNUMP (high) + && FIXNUMP (usec) && FIXNUMP (psec))) + return 0; + if (! INTEGERP (low)) + { + if (FLOATP (low)) + { + double t = XFLOAT_DATA (low); + if (result && ! decode_float_time (t, result)) + return -1; + if (dresult) + *dresult = t; + return 1; + } + else if (NILP (low)) + { + struct timespec now = current_timespec (); + if (result) + { + result->hi = hi_time (now.tv_sec); + result->lo = lo_time (now.tv_sec); + result->us = now.tv_nsec / 1000; + result->ps = now.tv_nsec % 1000 * 1000; + } + if (dresult) + *dresult = now.tv_sec + now.tv_nsec / 1e9; + return 1; + } + else + return 0; + } + + hi = XFIXNUM (high); + if (! integer_to_intmax (low, &lo)) + return -1; + us = XFIXNUM (usec); + ps = XFIXNUM (psec); + + /* Normalize out-of-range lower-order components by carrying + each overflow into the next higher-order component. */ + us += ps / 1000000 - (ps % 1000000 < 0); + lo += us / 1000000 - (us % 1000000 < 0); + if (INT_ADD_WRAPV (lo >> LO_TIME_BITS, hi, &hi)) + return -1; + ps = ps % 1000000 + 1000000 * (ps % 1000000 < 0); + us = us % 1000000 + 1000000 * (us % 1000000 < 0); + lo &= (1 << LO_TIME_BITS) - 1; + + if (result) + { + if (FIXNUM_OVERFLOW_P (hi)) + return -1; + result->hi = hi; + result->lo = lo; + result->us = us; + result->ps = ps; + } + + if (dresult) + { + double dhi = hi; + *dresult = (us * 1e6 + ps) / 1e12 + lo + dhi * (1 << LO_TIME_BITS); + } + + return 1; +} + +struct timespec +lisp_to_timespec (struct lisp_time t) +{ + if (! ((TYPE_SIGNED (time_t) ? TIME_T_MIN >> LO_TIME_BITS <= t.hi : 0 <= t.hi) + && t.hi <= TIME_T_MAX >> LO_TIME_BITS)) + return invalid_timespec (); + time_t s = (t.hi << LO_TIME_BITS) + t.lo; + int ns = t.us * 1000 + t.ps / 1000; + return make_timespec (s, ns); +} + +/* Decode a Lisp list SPECIFIED_TIME that represents a time. + Store its effective length into *PLEN. + If SPECIFIED_TIME is nil, use the current time. + Signal an error if SPECIFIED_TIME does not represent a time. */ +static struct lisp_time +lisp_time_struct (Lisp_Object specified_time, int *plen) +{ + Lisp_Object high, low, usec, psec; + struct lisp_time t; + int len = disassemble_lisp_time (specified_time, &high, &low, &usec, &psec); + if (!len) + invalid_time (); + int val = decode_time_components (high, low, usec, psec, &t, 0); + check_time_validity (val); + *plen = len; + return t; +} + +/* Like lisp_time_struct, except return a struct timespec. + Discard any low-order digits. */ +struct timespec +lisp_time_argument (Lisp_Object specified_time) +{ + int len; + struct lisp_time lt = lisp_time_struct (specified_time, &len); + struct timespec t = lisp_to_timespec (lt); + if (! timespec_valid_p (t)) + time_overflow (); + return t; +} + +/* Like lisp_time_argument, except decode only the seconds part, + and do not check the subseconds part. */ +static time_t +lisp_seconds_argument (Lisp_Object specified_time) +{ + Lisp_Object high, low, usec, psec; + struct lisp_time t; + + int val = disassemble_lisp_time (specified_time, &high, &low, &usec, &psec); + if (val != 0) + { + val = decode_time_components (high, low, make_fixnum (0), + make_fixnum (0), &t, 0); + if (0 < val + && ! ((TYPE_SIGNED (time_t) + ? TIME_T_MIN >> LO_TIME_BITS <= t.hi + : 0 <= t.hi) + && t.hi <= TIME_T_MAX >> LO_TIME_BITS)) + val = -1; + } + check_time_validity (val); + return (t.hi << LO_TIME_BITS) + t.lo; +} + +static struct lisp_time +time_add (struct lisp_time ta, struct lisp_time tb) +{ + EMACS_INT hi = ta.hi + tb.hi; + int lo = ta.lo + tb.lo; + int us = ta.us + tb.us; + int ps = ta.ps + tb.ps; + us += (1000000 <= ps); + ps -= (1000000 <= ps) * 1000000; + lo += (1000000 <= us); + us -= (1000000 <= us) * 1000000; + hi += (1 << LO_TIME_BITS <= lo); + lo -= (1 << LO_TIME_BITS <= lo) << LO_TIME_BITS; + return (struct lisp_time) { hi, lo, us, ps }; +} + +static struct lisp_time +time_subtract (struct lisp_time ta, struct lisp_time tb) +{ + EMACS_INT hi = ta.hi - tb.hi; + int lo = ta.lo - tb.lo; + int us = ta.us - tb.us; + int ps = ta.ps - tb.ps; + us -= (ps < 0); + ps += (ps < 0) * 1000000; + lo -= (us < 0); + us += (us < 0) * 1000000; + hi -= (lo < 0); + lo += (lo < 0) << LO_TIME_BITS; + return (struct lisp_time) { hi, lo, us, ps }; +} + +static Lisp_Object +time_arith (Lisp_Object a, Lisp_Object b, bool subtract) +{ + if (FLOATP (a) && !isfinite (XFLOAT_DATA (a))) + { + double da = XFLOAT_DATA (a); + double db = XFLOAT_DATA (Ffloat_time (b)); + return make_float (subtract ? da - db : da + db); + } + if (FLOATP (b) && !isfinite (XFLOAT_DATA (b))) + return subtract ? make_float (-XFLOAT_DATA (b)) : b; + + int alen, blen; + struct lisp_time ta = lisp_time_struct (a, &alen); + struct lisp_time tb = lisp_time_struct (b, &blen); + struct lisp_time t = (subtract ? time_subtract : time_add) (ta, tb); + if (FIXNUM_OVERFLOW_P (t.hi)) + time_overflow (); + Lisp_Object val = Qnil; + + switch (max (alen, blen)) + { + default: + val = Fcons (make_fixnum (t.ps), val); + FALLTHROUGH; + case 3: + val = Fcons (make_fixnum (t.us), val); + FALLTHROUGH; + case 2: + val = Fcons (make_fixnum (t.lo), val); + val = Fcons (make_fixnum (t.hi), val); + break; + } + + return val; +} + +DEFUN ("time-add", Ftime_add, Stime_add, 2, 2, 0, + doc: /* Return the sum of two time values A and B, as a time value. +A nil value for either argument stands for the current time. +See `current-time-string' for the various forms of a time value. */) + (Lisp_Object a, Lisp_Object b) +{ + return time_arith (a, b, false); +} + +DEFUN ("time-subtract", Ftime_subtract, Stime_subtract, 2, 2, 0, + doc: /* Return the difference between two time values A and B, as a time value. +Use `float-time' to convert the difference into elapsed seconds. +A nil value for either argument stands for the current time. +See `current-time-string' for the various forms of a time value. */) + (Lisp_Object a, Lisp_Object b) +{ + return time_arith (a, b, true); +} + +/* Return negative, 0, positive if a < b, a == b, a > b respectively. + Return positive if either a or b is a NaN; this is good enough + for the current callers. */ +static int +time_cmp (Lisp_Object a, Lisp_Object b) +{ + if ((FLOATP (a) && !isfinite (XFLOAT_DATA (a))) + || (FLOATP (b) && !isfinite (XFLOAT_DATA (b)))) + { + double da = FLOATP (a) ? XFLOAT_DATA (a) : 0; + double db = FLOATP (b) ? XFLOAT_DATA (b) : 0; + return da < db ? -1 : da != db; + } + + int alen, blen; + struct lisp_time ta = lisp_time_struct (a, &alen); + struct lisp_time tb = lisp_time_struct (b, &blen); + return (ta.hi != tb.hi ? (ta.hi < tb.hi ? -1 : 1) + : ta.lo != tb.lo ? (ta.lo < tb.lo ? -1 : 1) + : ta.us != tb.us ? (ta.us < tb.us ? -1 : 1) + : ta.ps < tb.ps ? -1 : ta.ps != tb.ps); +} + +DEFUN ("time-less-p", Ftime_less_p, Stime_less_p, 2, 2, 0, + doc: /* Return non-nil if time value T1 is earlier than time value T2. +A nil value for either argument stands for the current time. +See `current-time-string' for the various forms of a time value. */) + (Lisp_Object t1, Lisp_Object t2) +{ + return time_cmp (t1, t2) < 0 ? Qt : Qnil; +} + +DEFUN ("time-equal-p", Ftime_equal_p, Stime_equal_p, 2, 2, 0, + doc: /* Return non-nil if T1 and T2 are equal time values. +A nil value for either argument stands for the current time. +See `current-time-string' for the various forms of a time value. */) + (Lisp_Object t1, Lisp_Object t2) +{ + return time_cmp (t1, t2) == 0 ? Qt : Qnil; +} + + +/* Make a Lisp list that represents the Emacs time T. T may be an + invalid time, with a slightly negative tv_nsec value such as + UNKNOWN_MODTIME_NSECS; in that case, the Lisp list contains a + correspondingly negative picosecond count. */ +Lisp_Object +make_lisp_time (struct timespec t) +{ + time_t s = t.tv_sec; + int ns = t.tv_nsec; + return list4i (hi_time (s), lo_time (s), ns / 1000, ns % 1000 * 1000); +} + +DEFUN ("float-time", Ffloat_time, Sfloat_time, 0, 1, 0, + doc: /* Return the current time, as a float number of seconds since the epoch. +If SPECIFIED-TIME is given, it is the time to convert to float +instead of the current time. The argument should have the form +\(HIGH LOW) or (HIGH LOW USEC) or (HIGH LOW USEC PSEC). Thus, +you can use times from `current-time' and from `file-attributes'. +SPECIFIED-TIME can also have the form (HIGH . LOW), but this is +considered obsolete. + +WARNING: Since the result is floating point, it may not be exact. +If precise time stamps are required, use either `current-time', +or (if you need time as a string) `format-time-string'. */) + (Lisp_Object specified_time) +{ + double t; + Lisp_Object high, low, usec, psec; + if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec) + && decode_time_components (high, low, usec, psec, 0, &t))) + invalid_time (); + return make_float (t); +} + +/* Write information into buffer S of size MAXSIZE, according to the + FORMAT of length FORMAT_LEN, using time information taken from *TP. + Use the time zone specified by TZ. + Use NS as the number of nanoseconds in the %N directive. + Return the number of bytes written, not including the terminating + '\0'. If S is NULL, nothing will be written anywhere; so to + determine how many bytes would be written, use NULL for S and + ((size_t) -1) for MAXSIZE. + + This function behaves like nstrftime, except it allows null + bytes in FORMAT and it does not support nanoseconds. */ +static size_t +emacs_nmemftime (char *s, size_t maxsize, const char *format, + size_t format_len, const struct tm *tp, timezone_t tz, int ns) +{ + size_t total = 0; + + /* Loop through all the null-terminated strings in the format + argument. Normally there's just one null-terminated string, but + there can be arbitrarily many, concatenated together, if the + format contains '\0' bytes. nstrftime stops at the first + '\0' byte so we must invoke it separately for each such string. */ + for (;;) + { + size_t len; + size_t result; + + if (s) + s[0] = '\1'; + + result = nstrftime (s, maxsize, format, tp, tz, ns); + + if (s) + { + if (result == 0 && s[0] != '\0') + return 0; + s += result + 1; + } + + maxsize -= result + 1; + total += result; + len = strlen (format); + if (len == format_len) + return total; + total++; + format += len + 1; + format_len -= len + 1; + } +} + +static Lisp_Object +format_time_string (char const *format, ptrdiff_t formatlen, + struct timespec t, Lisp_Object zone, struct tm *tmp) +{ + char buffer[4000]; + char *buf = buffer; + ptrdiff_t size = sizeof buffer; + size_t len; + int ns = t.tv_nsec; + USE_SAFE_ALLOCA; + + timezone_t tz = tzlookup (zone, false); + /* On some systems, like 32-bit MinGW, tv_sec of struct timespec is + a 64-bit type, but time_t is a 32-bit type. emacs_localtime_rz + expects a pointer to time_t value. */ + time_t tsec = t.tv_sec; + tmp = emacs_localtime_rz (tz, &tsec, tmp); + if (! tmp) + { + xtzfree (tz); + time_overflow (); + } + synchronize_system_time_locale (); + + while (true) + { + buf[0] = '\1'; + len = emacs_nmemftime (buf, size, format, formatlen, tmp, tz, ns); + if ((0 < len && len < size) || (len == 0 && buf[0] == '\0')) + break; + + /* Buffer was too small, so make it bigger and try again. */ + len = emacs_nmemftime (NULL, SIZE_MAX, format, formatlen, tmp, tz, ns); + if (STRING_BYTES_BOUND <= len) + { + xtzfree (tz); + string_overflow (); + } + size = len + 1; + buf = SAFE_ALLOCA (size); + } + + xtzfree (tz); + AUTO_STRING_WITH_LEN (bufstring, buf, len); + Lisp_Object result = code_convert_string_norecord (bufstring, + Vlocale_coding_system, 0); + SAFE_FREE (); + return result; +} + +DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0, + doc: /* Use FORMAT-STRING to format the time TIME, or now if omitted or nil. +TIME is specified as (HIGH LOW USEC PSEC), as returned by +`current-time' or `file-attributes'. It can also be a single integer +number of seconds since the epoch. The obsolete form (HIGH . LOW) is +also still accepted. + +The optional ZONE is omitted or nil for Emacs local time, t for +Universal Time, `wall' for system wall clock time, or a string as in +the TZ environment variable. It can also be a list (as from +`current-time-zone') or an integer (as from `decode-time') applied +without consideration for daylight saving time. + +The value is a copy of FORMAT-STRING, but with certain constructs replaced +by text that describes the specified date and time in TIME: + +%Y is the year, %y within the century, %C the century. +%G is the year corresponding to the ISO week, %g within the century. +%m is the numeric month. +%b and %h are the locale's abbreviated month name, %B the full name. + (%h is not supported on MS-Windows.) +%d is the day of the month, zero-padded, %e is blank-padded. +%u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6. +%a is the locale's abbreviated name of the day of week, %A the full name. +%U is the week number starting on Sunday, %W starting on Monday, + %V according to ISO 8601. +%j is the day of the year. + +%H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H + only blank-padded, %l is like %I blank-padded. +%p is the locale's equivalent of either AM or PM. +%q is the calendar quarter (1–4). +%M is the minute (00-59). +%S is the second (00-59; 00-60 on platforms with leap seconds) +%s is the number of seconds since 1970-01-01 00:00:00 +0000. +%N is the nanosecond, %6N the microsecond, %3N the millisecond, etc. +%Z is the time zone abbreviation, %z is the numeric form. + +%c is the locale's date and time format. +%x is the locale's "preferred" date format. +%D is like "%m/%d/%y". +%F is the ISO 8601 date format (like "%Y-%m-%d"). + +%R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p". +%X is the locale's "preferred" time format. + +Finally, %n is a newline, %t is a tab, %% is a literal %, and +unrecognized %-sequences stand for themselves. + +Certain flags and modifiers are available with some format controls. +The flags are `_', `-', `^' and `#'. For certain characters X, +%_X is like %X, but padded with blanks; %-X is like %X, +but without padding. %^X is like %X, but with all textual +characters up-cased; %#X is like %X, but with letter-case of +all textual characters reversed. +%NX (where N stands for an integer) is like %X, +but takes up at least N (a number) positions. +The modifiers are `E' and `O'. For certain characters X, +%EX is a locale's alternative version of %X; +%OX is like %X, but uses the locale's number symbols. + +For example, to produce full ISO 8601 format, use "%FT%T%z". + +usage: (format-time-string FORMAT-STRING &optional TIME ZONE) */) + (Lisp_Object format_string, Lisp_Object timeval, Lisp_Object zone) +{ + struct timespec t = lisp_time_argument (timeval); + struct tm tm; + + CHECK_STRING (format_string); + format_string = code_convert_string_norecord (format_string, + Vlocale_coding_system, 1); + return format_time_string (SSDATA (format_string), SBYTES (format_string), + t, zone, &tm); +} + +DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 2, 0, + doc: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST UTCOFF). +The optional TIME should be a list of (HIGH LOW . IGNORED), +as from `current-time' and `file-attributes', or nil to use the +current time. It can also be a single integer number of seconds since +the epoch. The obsolete form (HIGH . LOW) is also still accepted. + +The optional ZONE is omitted or nil for Emacs local time, t for +Universal Time, `wall' for system wall clock time, or a string as in +the TZ environment variable. It can also be a list (as from +`current-time-zone') or an integer (the UTC offset in seconds) applied +without consideration for daylight saving time. + +The list has the following nine members: SEC is an integer between 0 +and 60; SEC is 60 for a leap second, which only some operating systems +support. MINUTE is an integer between 0 and 59. HOUR is an integer +between 0 and 23. DAY is an integer between 1 and 31. MONTH is an +integer between 1 and 12. YEAR is an integer indicating the +four-digit year. DOW is the day of week, an integer between 0 and 6, +where 0 is Sunday. DST is t if daylight saving time is in effect, +nil if it is not in effect, and -1 if daylight saving information is +not available. UTCOFF is an integer indicating the UTC offset in +seconds, i.e., the number of seconds east of Greenwich. (Note that +Common Lisp has different meanings for DOW and UTCOFF.) + +usage: (decode-time &optional TIME ZONE) */) + (Lisp_Object specified_time, Lisp_Object zone) +{ + time_t time_spec = lisp_seconds_argument (specified_time); + struct tm local_tm, gmt_tm; + timezone_t tz = tzlookup (zone, false); + struct tm *tm = emacs_localtime_rz (tz, &time_spec, &local_tm); + xtzfree (tz); + + if (! (tm + && MOST_NEGATIVE_FIXNUM - TM_YEAR_BASE <= local_tm.tm_year + && local_tm.tm_year <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE)) + time_overflow (); + + /* Avoid overflow when INT_MAX < EMACS_INT_MAX. */ + EMACS_INT tm_year_base = TM_YEAR_BASE; + + return CALLN (Flist, + make_fixnum (local_tm.tm_sec), + make_fixnum (local_tm.tm_min), + make_fixnum (local_tm.tm_hour), + make_fixnum (local_tm.tm_mday), + make_fixnum (local_tm.tm_mon + 1), + make_fixnum (local_tm.tm_year + tm_year_base), + make_fixnum (local_tm.tm_wday), + (local_tm.tm_isdst < 0 ? make_fixnum (-1) + : local_tm.tm_isdst == 0 ? Qnil : Qt), + (HAVE_TM_GMTOFF + ? make_fixnum (tm_gmtoff (&local_tm)) + : gmtime_r (&time_spec, &gmt_tm) + ? make_fixnum (tm_diff (&local_tm, &gmt_tm)) + : Qnil)); +} + +/* Return OBJ - OFFSET, checking that OBJ is a valid fixnum and that + the result is representable as an int. */ +static int +check_tm_member (Lisp_Object obj, int offset) +{ + CHECK_FIXNUM (obj); + EMACS_INT n = XFIXNUM (obj); + int result; + if (INT_SUBTRACT_WRAPV (n, offset, &result)) + time_overflow (); + return result; +} + +DEFUN ("encode-time", Fencode_time, Sencode_time, 6, MANY, 0, + doc: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time. +This is the reverse operation of `decode-time', which see. + +The optional ZONE is omitted or nil for Emacs local time, t for +Universal Time, `wall' for system wall clock time, or a string as in +the TZ environment variable. It can also be a list (as from +`current-time-zone') or an integer (as from `decode-time') applied +without consideration for daylight saving time. + +You can pass more than 7 arguments; then the first six arguments +are used as SECOND through YEAR, and the *last* argument is used as ZONE. +The intervening arguments are ignored. +This feature lets (apply \\='encode-time (decode-time ...)) work. + +Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed; +for example, a DAY of 0 means the day preceding the given month. +Year numbers less than 100 are treated just like other year numbers. +If you want them to stand for years in this century, you must do that yourself. + +Years before 1970 are not guaranteed to work. On some systems, +year values as low as 1901 do work. + +usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + time_t value; + struct tm tm; + Lisp_Object zone = (nargs > 6 ? args[nargs - 1] : Qnil); + + tm.tm_sec = check_tm_member (args[0], 0); + tm.tm_min = check_tm_member (args[1], 0); + tm.tm_hour = check_tm_member (args[2], 0); + tm.tm_mday = check_tm_member (args[3], 0); + tm.tm_mon = check_tm_member (args[4], 1); + tm.tm_year = check_tm_member (args[5], TM_YEAR_BASE); + tm.tm_isdst = -1; + + timezone_t tz = tzlookup (zone, false); + value = emacs_mktime_z (tz, &tm); + xtzfree (tz); + + if (value == (time_t) -1) + time_overflow (); + + return list2i (hi_time (value), lo_time (value)); +} + +DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0, + doc: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00. +The time is returned as a list of integers (HIGH LOW USEC PSEC). +HIGH has the most significant bits of the seconds, while LOW has the +least significant 16 bits. USEC and PSEC are the microsecond and +picosecond counts. */) + (void) +{ + return make_lisp_time (current_timespec ()); +} + +DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, + 0, 2, 0, + doc: /* Return the current local time, as a human-readable string. +Programs can use this function to decode a time, +since the number of columns in each field is fixed +if the year is in the range 1000-9999. +The format is `Sun Sep 16 01:03:52 1973'. +However, see also the functions `decode-time' and `format-time-string' +which provide a much more powerful and general facility. + +If SPECIFIED-TIME is given, it is a time to format instead of the +current time. The argument should have the form (HIGH LOW . IGNORED). +Thus, you can use times obtained from `current-time' and from +`file-attributes'. SPECIFIED-TIME can also be a single integer number +of seconds since the epoch. The obsolete form (HIGH . LOW) is also +still accepted. + +The optional ZONE is omitted or nil for Emacs local time, t for +Universal Time, `wall' for system wall clock time, or a string as in +the TZ environment variable. It can also be a list (as from +`current-time-zone') or an integer (as from `decode-time') applied +without consideration for daylight saving time. */) + (Lisp_Object specified_time, Lisp_Object zone) +{ + time_t value = lisp_seconds_argument (specified_time); + timezone_t tz = tzlookup (zone, false); + + /* Convert to a string in ctime format, except without the trailing + newline, and without the 4-digit year limit. Don't use asctime + or ctime, as they might dump core if the year is outside the + range -999 .. 9999. */ + struct tm tm; + struct tm *tmp = emacs_localtime_rz (tz, &value, &tm); + xtzfree (tz); + if (! tmp) + time_overflow (); + + static char const wday_name[][4] = + { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" }; + static char const mon_name[][4] = + { "Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" }; + printmax_t year_base = TM_YEAR_BASE; + char buf[sizeof "Mon Apr 30 12:49:17 " + INT_STRLEN_BOUND (int) + 1]; + int len = sprintf (buf, "%s %s%3d %02d:%02d:%02d %"pMd, + wday_name[tm.tm_wday], mon_name[tm.tm_mon], tm.tm_mday, + tm.tm_hour, tm.tm_min, tm.tm_sec, + tm.tm_year + year_base); + + return make_unibyte_string (buf, len); +} + +DEFUN ("current-time-zone", Fcurrent_time_zone, Scurrent_time_zone, 0, 2, 0, + doc: /* Return the offset and name for the local time zone. +This returns a list of the form (OFFSET NAME). +OFFSET is an integer number of seconds ahead of UTC (east of Greenwich). + A negative value means west of Greenwich. +NAME is a string giving the name of the time zone. +If SPECIFIED-TIME is given, the time zone offset is determined from it +instead of using the current time. The argument should have the form +\(HIGH LOW . IGNORED). Thus, you can use times obtained from +`current-time' and from `file-attributes'. SPECIFIED-TIME can also be +a single integer number of seconds since the epoch. The obsolete form +(HIGH . LOW) is also still accepted. + +The optional ZONE is omitted or nil for Emacs local time, t for +Universal Time, `wall' for system wall clock time, or a string as in +the TZ environment variable. It can also be a list (as from +`current-time-zone') or an integer (as from `decode-time') applied +without consideration for daylight saving time. + +Some operating systems cannot provide all this information to Emacs; +in this case, `current-time-zone' returns a list containing nil for +the data it can't find. */) + (Lisp_Object specified_time, Lisp_Object zone) +{ + struct timespec value; + struct tm local_tm, gmt_tm; + Lisp_Object zone_offset, zone_name; + + zone_offset = Qnil; + value = make_timespec (lisp_seconds_argument (specified_time), 0); + zone_name = format_time_string ("%Z", sizeof "%Z" - 1, value, + zone, &local_tm); + + /* gmtime_r expects a pointer to time_t, but tv_sec of struct + timespec on some systems (MinGW) is a 64-bit field. */ + time_t tsec = value.tv_sec; + if (HAVE_TM_GMTOFF || gmtime_r (&tsec, &gmt_tm)) + { + long int offset = (HAVE_TM_GMTOFF + ? tm_gmtoff (&local_tm) + : tm_diff (&local_tm, &gmt_tm)); + zone_offset = make_fixnum (offset); + if (SCHARS (zone_name) == 0) + { + /* No local time zone name is available; use numeric zone instead. */ + long int hour = offset / 3600; + int min_sec = offset % 3600; + int amin_sec = min_sec < 0 ? - min_sec : min_sec; + int min = amin_sec / 60; + int sec = amin_sec % 60; + int min_prec = min_sec ? 2 : 0; + int sec_prec = sec ? 2 : 0; + char buf[sizeof "+0000" + INT_STRLEN_BOUND (long int)]; + zone_name = make_formatted_string (buf, "%c%.2ld%.*d%.*d", + (offset < 0 ? '-' : '+'), + hour, min_prec, min, sec_prec, sec); + } + } + + return list2 (zone_offset, zone_name); +} + +DEFUN ("set-time-zone-rule", Fset_time_zone_rule, Sset_time_zone_rule, 1, 1, 0, + doc: /* Set the Emacs local time zone using TZ, a string specifying a time zone rule. +If TZ is nil or `wall', use system wall clock time; this differs from +the usual Emacs convention where nil means current local time. If TZ +is t, use Universal Time. If TZ is a list (as from +`current-time-zone') or an integer (as from `decode-time'), use the +specified time zone without consideration for daylight saving time. + +Instead of calling this function, you typically want something else. +To temporarily use a different time zone rule for just one invocation +of `decode-time', `encode-time', or `format-time-string', pass the +function a ZONE argument. To change local time consistently +throughout Emacs, call (setenv "TZ" TZ): this changes both the +environment of the Emacs process and the variable +`process-environment', whereas `set-time-zone-rule' affects only the +former. */) + (Lisp_Object tz) +{ + tzlookup (NILP (tz) ? Qwall : tz, true); + return Qnil; +} + +/* A buffer holding a string of the form "TZ=value", intended + to be part of the environment. If TZ is supposed to be unset, + the buffer string is "tZ=". */ + static char *tzvalbuf; + +/* Get the local time zone rule. */ +char * +emacs_getenv_TZ (void) +{ + return tzvalbuf[0] == 'T' ? tzvalbuf + tzeqlen : 0; +} + +/* Set the local time zone rule to TZSTRING, which can be null to + denote wall clock time. Do not record the setting in LOCAL_TZ. + + This function is not thread-safe, in theory because putenv is not, + but mostly because of the static storage it updates. Other threads + that invoke localtime etc. may be adversely affected while this + function is executing. */ + +int +emacs_setenv_TZ (const char *tzstring) +{ + static ptrdiff_t tzvalbufsize; + ptrdiff_t tzstringlen = tzstring ? strlen (tzstring) : 0; + char *tzval = tzvalbuf; + bool new_tzvalbuf = tzvalbufsize <= tzeqlen + tzstringlen; + + if (new_tzvalbuf) + { + /* Do not attempt to free the old tzvalbuf, since another thread + may be using it. In practice, the first allocation is large + enough and memory does not leak. */ + tzval = xpalloc (NULL, &tzvalbufsize, + tzeqlen + tzstringlen - tzvalbufsize + 1, -1, 1); + tzvalbuf = tzval; + tzval[1] = 'Z'; + tzval[2] = '='; + } + + if (tzstring) + { + /* Modify TZVAL in place. Although this is dicey in a + multithreaded environment, we know of no portable alternative. + Calling putenv or setenv could crash some other thread. */ + tzval[0] = 'T'; + strcpy (tzval + tzeqlen, tzstring); + } + else + { + /* Turn 'TZ=whatever' into an empty environment variable 'tZ='. + Although this is also dicey, calling unsetenv here can crash Emacs. + See Bug#8705. */ + tzval[0] = 't'; + tzval[tzeqlen] = 0; + } + + +#ifndef WINDOWSNT + /* Modifying *TZVAL merely requires calling tzset (which is the + caller's responsibility). However, modifying TZVAL requires + calling putenv; although this is not thread-safe, in practice this + runs only on startup when there is only one thread. */ + bool need_putenv = new_tzvalbuf; +#else + /* MS-Windows 'putenv' copies the argument string into a block it + allocates, so modifying *TZVAL will not change the environment. + However, the other threads run by Emacs on MS-Windows never call + 'xputenv' or 'putenv' or 'unsetenv', so the original cause for the + dicey in-place modification technique doesn't exist there in the + first place. */ + bool need_putenv = true; +#endif + if (need_putenv) + xputenv (tzval); + + return 0; +} + +void +syms_of_timefns (void) +{ + defsubr (&Scurrent_time); + defsubr (&Stime_add); + defsubr (&Stime_subtract); + defsubr (&Stime_less_p); + defsubr (&Stime_equal_p); + defsubr (&Sformat_time_string); + defsubr (&Sfloat_time); + defsubr (&Sdecode_time); + defsubr (&Sencode_time); + defsubr (&Scurrent_time_string); + defsubr (&Scurrent_time_zone); + defsubr (&Sset_time_zone_rule); +} diff --git a/src/w32.c b/src/w32.c index 4b57d916416..e643c421506 100644 --- a/src/w32.c +++ b/src/w32.c @@ -535,8 +535,6 @@ static Lisp_Object ltime (ULONGLONG); /* Get total user and system times for get-internal-run-time. Returns a list of integers if the times are provided by the OS (NT derivatives), otherwise it returns the result of current-time. */ -Lisp_Object w32_get_internal_run_time (void); - Lisp_Object w32_get_internal_run_time (void) { diff --git a/src/w32.h b/src/w32.h index 9c219cdda62..42b3d98245f 100644 --- a/src/w32.h +++ b/src/w32.h @@ -195,6 +195,7 @@ extern int filename_from_ansi (const char *, char *); extern int filename_to_ansi (const char *, char *); extern int filename_from_utf16 (const wchar_t *, char *); extern int filename_to_utf16 (const char *, wchar_t *); +extern Lisp_Object w32_get_internal_run_time (void); extern void w32_init_file_name_codepage (void); extern int codepage_for_filenames (CPINFO *); extern Lisp_Object ansi_encode_filename (Lisp_Object); diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 4a840c8d7d1..17b2c510734 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -204,65 +204,6 @@ (should (string-equal (format "%d" 0.9) "0")) (should (string-equal (format "%d" 1.1) "1"))) -;;; Check format-time-string with various TZ settings. -;;; Use only POSIX-compatible TZ values, since the tests should work -;;; even if tzdb is not in use. -(ert-deftest format-time-string-with-zone () - ;; Don’t use (0 0 0 0) as the test case, as there are too many bugs - ;; in MS-Windows (and presumably other) C libraries when formatting - ;; time stamps near the Epoch of 1970-01-01 00:00:00 UTC, and this - ;; test is for GNU Emacs, not for C runtimes. Instead, look before - ;; you leap: "look" is the timestamp just before the first leap - ;; second on 1972-06-30 23:59:60 UTC, so it should format to the - ;; same string regardless of whether the underlying C library - ;; ignores leap seconds, while avoiding circa-1970 glitches. - ;; - ;; Similarly, stick to the limited set of time zones that are - ;; supported by both POSIX and MS-Windows: exactly 3 ASCII letters - ;; in the abbreviation, and no DST. - (let ((look '(1202 22527 999999 999999)) - (format "%Y-%m-%d %H:%M:%S.%3N %z (%Z)")) - ;; UTC. - (should (string-equal - (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" look t) - "1972-06-30 23:59:59.999 +0000")) - ;; "UTC0". - (should (string-equal - (format-time-string format look "UTC0") - "1972-06-30 23:59:59.999 +0000 (UTC)")) - ;; Negative UTC offset, as a Lisp list. - (should (string-equal - (format-time-string format look '(-28800 "PST")) - "1972-06-30 15:59:59.999 -0800 (PST)")) - ;; Negative UTC offset, as a Lisp integer. - (should (string-equal - (format-time-string format look -28800) - ;; MS-Windows build replaces unrecognizable TZ values, - ;; such as "-08", with "ZZZ". - (if (eq system-type 'windows-nt) - "1972-06-30 15:59:59.999 -0800 (ZZZ)" - "1972-06-30 15:59:59.999 -0800 (-08)"))) - ;; Positive UTC offset that is not an hour multiple, as a string. - (should (string-equal - (format-time-string format look "IST-5:30") - "1972-07-01 05:29:59.999 +0530 (IST)")))) - -;;; This should not dump core. -(ert-deftest format-time-string-with-outlandish-zone () - (should (stringp - (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" nil - (concat (make-string 2048 ?X) "0"))))) - -(defun editfns-tests--have-leap-seconds () - (string-equal (format-time-string "%Y-%m-%d %H:%M:%S" 78796800 t) - "1972-06-30 23:59:60")) - -(ert-deftest format-time-string-with-bignum-on-32-bit () - (should (or (string-equal - (format-time-string "%Y-%m-%d %H:%M:%S" (- (ash 1 31) 3600) t) - "2038-01-19 02:14:08") - (editfns-tests--have-leap-seconds)))) - (ert-deftest format-with-field () (should (equal (format "First argument %2$s, then %3$s, then %1$s" 1 2 3) "First argument 2, then 3, then 1")) diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el new file mode 100644 index 00000000000..8418b509e17 --- /dev/null +++ b/test/src/timefns-tests.el @@ -0,0 +1,79 @@ +;;; timefns-tests.el -- tests for timefns.c + +;; Copyright (C) 2016-2018 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; This program 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. + +;; This program 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 this program. If not, see . + +(require 'ert) + +;;; Check format-time-string with various TZ settings. +;;; Use only POSIX-compatible TZ values, since the tests should work +;;; even if tzdb is not in use. +(ert-deftest format-time-string-with-zone () + ;; Don’t use (0 0 0 0) as the test case, as there are too many bugs + ;; in MS-Windows (and presumably other) C libraries when formatting + ;; time stamps near the Epoch of 1970-01-01 00:00:00 UTC, and this + ;; test is for GNU Emacs, not for C runtimes. Instead, look before + ;; you leap: "look" is the timestamp just before the first leap + ;; second on 1972-06-30 23:59:60 UTC, so it should format to the + ;; same string regardless of whether the underlying C library + ;; ignores leap seconds, while avoiding circa-1970 glitches. + ;; + ;; Similarly, stick to the limited set of time zones that are + ;; supported by both POSIX and MS-Windows: exactly 3 ASCII letters + ;; in the abbreviation, and no DST. + (let ((look '(1202 22527 999999 999999)) + (format "%Y-%m-%d %H:%M:%S.%3N %z (%Z)")) + ;; UTC. + (should (string-equal + (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" look t) + "1972-06-30 23:59:59.999 +0000")) + ;; "UTC0". + (should (string-equal + (format-time-string format look "UTC0") + "1972-06-30 23:59:59.999 +0000 (UTC)")) + ;; Negative UTC offset, as a Lisp list. + (should (string-equal + (format-time-string format look '(-28800 "PST")) + "1972-06-30 15:59:59.999 -0800 (PST)")) + ;; Negative UTC offset, as a Lisp integer. + (should (string-equal + (format-time-string format look -28800) + ;; MS-Windows build replaces unrecognizable TZ values, + ;; such as "-08", with "ZZZ". + (if (eq system-type 'windows-nt) + "1972-06-30 15:59:59.999 -0800 (ZZZ)" + "1972-06-30 15:59:59.999 -0800 (-08)"))) + ;; Positive UTC offset that is not an hour multiple, as a string. + (should (string-equal + (format-time-string format look "IST-5:30") + "1972-07-01 05:29:59.999 +0530 (IST)")))) + +;;; This should not dump core. +(ert-deftest format-time-string-with-outlandish-zone () + (should (stringp + (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" nil + (concat (make-string 2048 ?X) "0"))))) + +(defun timefns-tests--have-leap-seconds () + (string-equal (format-time-string "%Y-%m-%d %H:%M:%S" 78796800 t) + "1972-06-30 23:59:60")) + +(ert-deftest format-time-string-with-bignum-on-32-bit () + (should (or (string-equal + (format-time-string "%Y-%m-%d %H:%M:%S" (- (ash 1 31) 3600) t) + "2038-01-19 02:14:08") + (timefns-tests--have-leap-seconds)))) From 0faad0a0025cb4c6cbdba44e5b259690fae27b1a Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 3 Oct 2018 09:10:00 -0700 Subject: [PATCH 44/72] Coalesce duplicate make_lisp_timeval etc. * src/sysdep.c (timeval_to_timespec, make_lisp_timeval): Coalesce duplicate definitions (Bug#32902). --- src/sysdep.c | 40 ++++++++++++++++------------------------ 1 file changed, 16 insertions(+), 24 deletions(-) diff --git a/src/sysdep.c b/src/sysdep.c index 06956863611..7a0c8a8ab85 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -3047,6 +3047,22 @@ list_system_processes (void) #endif /* !defined (WINDOWSNT) */ + +#if defined __FreeBSD__ || defined DARWIN_OS + +static struct timespec +timeval_to_timespec (struct timeval t) +{ + return make_timespec (t.tv_sec, t.tv_usec * 1000); +} +static Lisp_Object +make_lisp_timeval (struct timeval t) +{ + return make_lisp_time (timeval_to_timespec (t)); +} + +#endif + #if defined GNU_LINUX && defined HAVE_LONG_LONG_INT static struct timespec time_from_jiffies (unsigned long long tval, long hz) @@ -3567,18 +3583,6 @@ system_process_attributes (Lisp_Object pid) #elif defined __FreeBSD__ -static struct timespec -timeval_to_timespec (struct timeval t) -{ - return make_timespec (t.tv_sec, t.tv_usec * 1000); -} - -static Lisp_Object -make_lisp_timeval (struct timeval t) -{ - return make_lisp_time (timeval_to_timespec (t)); -} - Lisp_Object system_process_attributes (Lisp_Object pid) { @@ -3748,18 +3752,6 @@ system_process_attributes (Lisp_Object pid) #elif defined DARWIN_OS -static struct timespec -timeval_to_timespec (struct timeval t) -{ - return make_timespec (t.tv_sec, t.tv_usec * 1000); -} - -static Lisp_Object -make_lisp_timeval (struct timeval t) -{ - return make_lisp_time (timeval_to_timespec (t)); -} - Lisp_Object system_process_attributes (Lisp_Object pid) { From 84f39d3389209e566dde9acbdd78f5572f0c6751 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 3 Oct 2018 09:10:01 -0700 Subject: [PATCH 45/72] Export converting mpz to [u]intmax This refactoring will help improve timestamp handling later (Bug#32902). * src/bignum.c (mpz_set_uintmax): Move to bignum.h, and make inline. (mpz_set_uintmax_slow): Now extern. (mpz_to_intmax, mpz_to_uintmax): New functions, with implementation taken from the old bignum_to_intmax and bignum_to_uintmax. (bignum_to_intmax, bignum_to_uintmax): Use them. --- src/bignum.c | 93 ++++++++++++++++++++++++++++------------------------ src/bignum.h | 11 +++++++ 2 files changed, 62 insertions(+), 42 deletions(-) diff --git a/src/bignum.c b/src/bignum.c index 1e78d981b7d..5d8ab670f24 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -101,18 +101,6 @@ make_bignum (void) return make_bignum_bits (mpz_sizeinbase (mpz[0], 2)); } -static void mpz_set_uintmax_slow (mpz_t, uintmax_t); - -/* Set RESULT to V. */ -static void -mpz_set_uintmax (mpz_t result, uintmax_t v) -{ - if (v <= ULONG_MAX) - mpz_set_ui (result, v); - else - mpz_set_uintmax_slow (result, v); -} - /* Return a Lisp integer equal to N, which must not be in fixnum range. */ Lisp_Object make_bigint (intmax_t n) @@ -183,7 +171,7 @@ mpz_set_intmax_slow (mpz_t result, intmax_t v) mpz_limbs_finish (result, negative ? -n : n); } -static void +void mpz_set_uintmax_slow (mpz_t result, uintmax_t v) { int maxlimbs = (UINTMAX_WIDTH + GMP_NUMB_BITS - 1) / GMP_NUMB_BITS; @@ -200,13 +188,13 @@ mpz_set_uintmax_slow (mpz_t result, uintmax_t v) mpz_limbs_finish (result, n); } -/* Return the value of the bignum X if it fits, 0 otherwise. - A bignum cannot be zero, so 0 indicates failure reliably. */ -intmax_t -bignum_to_intmax (Lisp_Object x) +/* If Z fits into *PI, store its value there and return true. + Return false otherwise. */ +bool +mpz_to_intmax (mpz_t const z, intmax_t *pi) { - ptrdiff_t bits = mpz_sizeinbase (XBIGNUM (x)->value, 2); - bool negative = mpz_sgn (XBIGNUM (x)->value) < 0; + ptrdiff_t bits = mpz_sizeinbase (z, 2); + bool negative = mpz_sgn (z) < 0; if (bits < INTMAX_WIDTH) { @@ -215,39 +203,60 @@ bignum_to_intmax (Lisp_Object x) do { - intmax_t limb = mpz_getlimbn (XBIGNUM (x)->value, i++); + intmax_t limb = mpz_getlimbn (z, i++); v += limb << shift; shift += GMP_NUMB_BITS; } while (shift < bits); - return negative ? -v : v; + *pi = negative ? -v : v; + return true; } - return ((bits == INTMAX_WIDTH && INTMAX_MIN < -INTMAX_MAX && negative - && mpz_scan1 (XBIGNUM (x)->value, 0) == INTMAX_WIDTH - 1) - ? INTMAX_MIN : 0); + if (bits == INTMAX_WIDTH && INTMAX_MIN < -INTMAX_MAX && negative + && mpz_scan1 (z, 0) == INTMAX_WIDTH - 1) + { + *pi = INTMAX_MIN; + return true; + } + return false; +} +bool +mpz_to_uintmax (mpz_t const z, uintmax_t *pi) +{ + if (mpz_sgn (z) < 0) + return false; + ptrdiff_t bits = mpz_sizeinbase (z, 2); + if (UINTMAX_WIDTH < bits) + return false; + + uintmax_t v = 0; + int i = 0, shift = 0; + + do + { + uintmax_t limb = mpz_getlimbn (z, i++); + v += limb << shift; + shift += GMP_NUMB_BITS; + } + while (shift < bits); + + *pi = v; + return true; +} + +/* Return the value of the bignum X if it fits, 0 otherwise. + A bignum cannot be zero, so 0 indicates failure reliably. */ +intmax_t +bignum_to_intmax (Lisp_Object x) +{ + intmax_t i; + return mpz_to_intmax (XBIGNUM (x)->value, &i) ? i : 0; } uintmax_t bignum_to_uintmax (Lisp_Object x) { - uintmax_t v = 0; - if (0 <= mpz_sgn (XBIGNUM (x)->value)) - { - ptrdiff_t bits = mpz_sizeinbase (XBIGNUM (x)->value, 2); - if (bits <= UINTMAX_WIDTH) - { - int i = 0, shift = 0; - - do - { - uintmax_t limb = mpz_getlimbn (XBIGNUM (x)->value, i++); - v += limb << shift; - shift += GMP_NUMB_BITS; - } - while (shift < bits); - } - } - return v; + uintmax_t i; + return mpz_to_uintmax (XBIGNUM (x)->value, &i) ? i : 0; } /* Yield an upper bound on the buffer size needed to contain a C diff --git a/src/bignum.h b/src/bignum.h index e9cd5c07635..fd035e6e14d 100644 --- a/src/bignum.h +++ b/src/bignum.h @@ -45,7 +45,10 @@ extern mpz_t mpz[4]; extern void init_bignum (void); extern Lisp_Object make_integer_mpz (void); +extern bool mpz_to_intmax (mpz_t const, intmax_t *) ARG_NONNULL ((1, 2)); +extern bool mpz_to_uintmax (mpz_t const, uintmax_t *) ARG_NONNULL ((1, 2)); extern void mpz_set_intmax_slow (mpz_t, intmax_t) ARG_NONNULL ((1)); +extern void mpz_set_uintmax_slow (mpz_t, uintmax_t) ARG_NONNULL ((1)); extern double mpz_get_d_rounded (mpz_t const); INLINE_HEADER_BEGIN @@ -68,6 +71,14 @@ mpz_set_intmax (mpz_t result, intmax_t v) else mpz_set_intmax_slow (result, v); } +INLINE void ARG_NONNULL ((1)) +mpz_set_uintmax (mpz_t result, uintmax_t v) +{ + if (v <= ULONG_MAX) + mpz_set_ui (result, v); + else + mpz_set_uintmax_slow (result, v); +} /* Return a pointer to an mpz_t that is equal to the Lisp integer I. If I is a bignum this returns a pointer to I's representation; From 93fe420942c08111a6048af7c4d7807c61d80a09 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 3 Oct 2018 09:10:01 -0700 Subject: [PATCH 46/72] New (TICKS . HZ) timestamp format This follows on a suggestion by Stefan Monnier in: https://lists.gnu.org/r/emacs-devel/2018-08/msg00991.html (Bug#32902). * doc/lispref/buffers.texi (Modification Time): * doc/lispref/os.texi (Processor Run Time, Time Calculations) * doc/lispref/processes.texi (System Processes): * doc/lispref/text.texi (Undo): Let the "Time of Day" section cover timestamp format details. * doc/lispref/os.texi (Time of Day): Say that timestamp internal format should not be assumed. Document new (ticks . hz) format. Omit mention of seconds-to-time since it is now just an alias for encode-time. (Time Conversion): Document encode-time extension. * etc/NEWS: Mention changes. * lisp/calendar/cal-dst.el (calendar-system-time-basis): Now const. * lisp/calendar/cal-dst.el (calendar-absolute-from-time) (calendar-time-from-absolute) (calendar-next-time-zone-transition): * lisp/emacs-lisp/timer.el (timer-next-integral-multiple-of-time): Simplify by using bignums, (TICKS . HZ), and new encode-time. * lisp/emacs-lisp/timer.el (timer-next-integral-multiple-of-time): Simplify by using bignums and new encode-time. * lisp/calendar/parse-time.el (parse-iso8601-time-string): Handle DST more accurately, by using new encode-time. * lisp/calendar/time-date.el (seconds-to-time): * lisp/calendar/timeclock.el (timeclock-seconds-to-time): Now just an alias for encode-time. * lisp/calendar/time-date.el (days-to-time): * lisp/emacs-lisp/timer.el (timer--time-setter): * lisp/net/ntlm.el (ntlm-compute-timestamp): * lisp/obsolete/vc-arch.el (vc-arch-add-tagline): * lisp/org/org-id.el (org-id-uuid, org-id-time-to-b36): * lisp/tar-mode (tar-octal-time): Don't assume timestamps default to list form. * lisp/tar-mode.el (tar-parse-octal-long-integer): Now an obsolete alias for tar-parse-octal-integer. * src/keyboard.c (decode_timer): Adjust to changes to time decoding functions elsewhere. * src/timefns.c: Include bignum.h, limits.h. (FASTER_TIMEFNS): New macro. (WARN_OBSOLETE_TIMESTAMPS, CURRENT_TIME_LIST) (timespec_hz, trillion, ztrillion): New constants. (make_timeval): Use TIME_T_MAX instead of its definiens. (check_time_validity, time_add, time_subtract): Remove. All uses removed. (disassemble_lisp_time): Remove; old code now folded into decode_lisp_time. All callers changed. (invalid_hz, s_ns_to_double, ticks_hz_list4, mpz_set_time) (timespec_mpz, timespec_ticks, time_hz_ticks) (lisp_time_hz_ticks, lisp_time_seconds) (time_form_stamp, lisp_time_form_stamp, decode_ticks_hz) (decode_lisp_time, mpz_time, list4_to_timespec): New functions. (decode_float_time, decode_time_components, lisp_to_timespec): Adjust to new struct lisp_time, which does not lose information like the old one did. (enum timeform): New enum. (decode_time_components): New arg FORM. All callers changed. RESULT and DRESULT are now mutually exclusive; no callers need to change because of this. (decode_time_components, lisp_time_struct) (lisp_seconds_argument, time_arith, make_lisp_time, Ffloat_time) (Fencode_time): Add support for (TICKS . HZ) form. (DECODE_SECS_ONLY): New constant. (lisp_time_struct): 2nd arg is now enum timeform, not int. All callers changed. (check_tm_member): Support bignums.m (Fencode_time): Add new two-arg functionality. * src/systime.h (struct lisp_time): Now ticks+hz rather than hi+lo+us+ps, since ticks+hz does not lose info. * test/src/systime-tests.el (time-equal-p-nil-nil): New test. --- doc/lispref/buffers.texi | 10 +- doc/lispref/os.texi | 157 +++-- doc/lispref/processes.texi | 19 +- doc/lispref/text.texi | 5 +- doc/misc/emacs-mime.texi | 69 ++- etc/NEWS | 15 + lisp/calendar/cal-dst.el | 55 +- lisp/calendar/parse-time.el | 5 +- lisp/calendar/time-date.el | 10 +- lisp/calendar/timeclock.el | 3 +- lisp/emacs-lisp/timer.el | 42 +- lisp/net/ntlm.el | 3 +- lisp/obsolete/vc-arch.el | 3 +- lisp/org/org-id.el | 4 +- lisp/tar-mode.el | 28 +- src/bignum.c | 2 +- src/keyboard.c | 11 +- src/systime.h | 15 +- src/timefns.c | 1151 ++++++++++++++++++++++++----------- test/src/timefns-tests.el | 3 + 20 files changed, 1040 insertions(+), 570 deletions(-) diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 1acf4baedba..8789a8d56f6 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -648,10 +648,7 @@ file should not be done. @defun visited-file-modtime This function returns the current buffer's recorded last file -modification time, as a list of the form @code{(@var{high} @var{low} -@var{microsec} @var{picosec})}. (This is the same format that -@code{file-attributes} uses to return time values; @pxref{File -Attributes}.) +modification time, as a Lisp timestamp (@pxref{Time of Day}). If the buffer has no recorded last modification time, this function returns zero. This case occurs, for instance, if the buffer is not @@ -671,9 +668,8 @@ is not @code{nil}, and otherwise to the last modification time of the visited file. If @var{time} is neither @code{nil} nor an integer flag returned -by @code{visited-file-modtime}, it should have the form -@code{(@var{high} @var{low} @var{microsec} @var{picosec})}, -the format used by @code{current-time} (@pxref{Time of Day}). +by @code{visited-file-modtime}, it should be a Lisp time value +(@pxref{Time of Day}). This function is useful if the buffer was not read from the file normally, or if the file itself has been changed for some known benign diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 8ce5a5ed6d8..ea6915350e8 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1233,11 +1233,44 @@ return value is @code{nil}. This section explains how to determine the current time and time zone. +@cindex Lisp timestamp +@cindex timestamp, Lisp + Many functions like @code{current-time} and @code{file-attributes} +return @dfn{Lisp timestamp} values that count seconds, and that can +represent absolute time by counting seconds since the @dfn{epoch} of +1970-01-01 00:00:00 UTC. + + Although traditionally Lisp timestamps were integer pairs, their +form has evolved and programs ordinarily should not depend on the +current default form. If your program needs a particular timestamp +form, you can use the @code{encode-time} function to convert it to the +needed form. @xref{Time Conversion}. + @cindex epoch - Most of these functions represent time as a list of four integers -@code{(@var{sec-high} @var{sec-low} @var{microsec} @var{picosec})}. -This represents the number of seconds from the @dfn{epoch} (January -1, 1970 at 00:00 UTC), using the formula: + There are currently three forms of Lisp timestamps, each of +which represents a number of seconds: + +@itemize @bullet +@item +An integer. Although this is the simplest form, it cannot represent +subsecond timestamps. + +@item +A pair of integers @code{(@var{ticks} . @var{hz})}, where @var{hz} is +positive. This represents @var{ticks}/@var{hz} seconds, which is the +same time as plain @var{ticks} if @var{hz} is 1. A common value for +@var{hz} is 1000000000, for a nanosecond-resolution +clock.@footnote{Currently @var{hz} should be at least 65536 to avoid +compatibility warnings when the timestamp is passed to standard +functions, as previous versions of Emacs would interpret such a +timestamps differently due to backward-compatibility concerns. These +warnings are intended to be removed in a future Emacs version.} + +@item +A list of four integers @code{(@var{high} @var{low} @var{micro} +@var{pico})}, where 0 @leq{} @var{low} < 65536, 0 @leq{} @var{micro} < +1000000, and 0 @leq{} @var{pico} < 1000000. +This represents the number of seconds using the formula: @ifnottex @var{high} * 2**16 + @var{low} + @var{micro} * 10**@minus{}6 + @var{pico} * 10**@minus{}12. @@ -1245,21 +1278,23 @@ This represents the number of seconds from the @dfn{epoch} (January @tex $high*2^{16} + low + micro*10^{-6} + pico*10^{-12}$. @end tex -The return value of @code{current-time} represents time using this -form, as do the timestamps in the return values of other functions -such as @code{file-attributes} (@pxref{Definition of -file-attributes}). In some cases, functions may return two- or +In some cases, functions may default to returning two- or three-element lists, with omitted @var{microsec} and @var{picosec} components defaulting to zero. +On all current machines @var{picosec} is a multiple of 1000, but this +may change as higher-resolution clocks become available. +@end itemize @cindex time value Function arguments, e.g., the @var{time} argument to @code{current-time-string}, accept a more-general @dfn{time value} -format, which can be a list of integers as above, or a single number -for seconds since the epoch, or @code{nil} for the current time. You -can convert a time value into a human-readable string using -@code{current-time-string} and @code{format-time-string}, into a list -of integers using @code{seconds-to-time}, and into other forms using +format, which can be a Lisp timestamp, @code{nil} for the current +time, a single floating-point number for seconds, or a list +@code{(@var{high} @var{low} @var{micro})} or @code{(@var{high} +@var{low})} that is a truncated list timestamp with missing elements +taken to be zero. You can convert a time value into +a human-readable string using @code{format-time-string}, into a Lisp +timestamp using @code{encode-time}, and into other forms using @code{decode-time} and @code{float-time}. These functions are described in the following sections. @@ -1287,12 +1322,7 @@ defaults to the current time zone rule. @xref{Time Zone Rules}. @end defun @defun current-time -This function returns the current time, represented as a list of four -integers @code{(@var{sec-high} @var{sec-low} @var{microsec} @var{picosec})}. -These integers have trailing zeros on systems that return time with -lower resolutions. On all current machines @var{picosec} is a -multiple of 1000, but this may change as higher-resolution clocks -become available. +This function returns the current time as a Lisp timestamp. @end defun @defun float-time &optional time @@ -1306,13 +1336,6 @@ exact. Do not use this function if precise time stamps are required. @code{time-to-seconds} is an alias for this function. @end defun -@defun seconds-to-time time -This function converts a time value to list-of-integer form. -For example, if @var{time} is a number, @code{(time-to-seconds -(seconds-to-time @var{time}))} equals the number unless overflow -or rounding errors occur. -@end defun - @node Time Zone Rules @section Time Zone Rules @cindex time zone rules @@ -1434,32 +1457,63 @@ seconds east of Greenwich. @var{dow} and @var{utcoff}. @end defun -@defun encode-time seconds minutes hour day month year &optional zone -This function is the inverse of @code{decode-time}. It converts seven -items of calendrical data into a list-of-integer time value. For the -meanings of the arguments, see the table above under -@code{decode-time}. +@defun encode-time time &optional form +This function converts @var{time} to a Lisp timestamp. +It can act as the inverse of @code{decode-time}. + +The first argument can be a Lisp time value such as @code{nil} for the +current time, a number of seconds, a pair @code{(@var{ticks} +. @var{hz})}, or a list @code{(@var{high} @var{low} @var{micro} +@var{pico})} (@pxref{Time of Day}). It can also be a list +@code{(@var{second} @var{minute} @var{hour} @var{day} @var{month} +@var{year} @var{ignored} @var{dst} @var{zone})} that specifies a +decoded time in the style of @code{decode-time}, so that +@code{(encode-time (decode-time ...))} works. For the meanings of +these list members, see the table under @code{decode-time}. + +The optional @var{form} argument specifies the desired timestamp form +to be returned. If @var{form} is the symbol @code{integer}, this +function returns an integer count of seconds. If @var{form} is a +positive integer, it specifies a clock frequency and this function +returns an integer-pair timestamp @code{(@var{ticks} +. @var{form})}.@footnote{Currently a positive integer @var{form} +should be at least 65536 if the returned value is intended to be given +to standard functions expecting Lisp timestamps.} If @var{form} is +@code{t}, this function treats it as a positive integer suitable for +representing the timestamp; for example, it is treated as 1000000000 +if the platform timestamp has nanosecond resolution. If @var{form} is +@code{list}, this function returns an integer list @code{(@var{high} +@var{low} @var{micro} @var{pico})}. Although an omitted or @code{nil} +@var{form} currently acts like @code{list}, this is planned to change +in a future Emacs version, so callers requiring list timestamps should +pass @code{list} explicitly. + +As an obsolescent calling convention, this function can be given six +or more arguments. The first six arguments @var{second}, +@var{minute}, @var{hour}, @var{day}, @var{month}, and @var{year} +specify most of the components of a decoded time. If there are more +than six arguments the @emph{last} argument is used as @var{zone} and +any other extra arguments are ignored, so that @code{(apply +'encode-time (decode-time ...))} works; otherwise @var{zone} defaults +to the current time zone rule (@pxref{Time Zone Rules}). The decoded +time's @var{dst} component is treated as if it was @minus{}1, and +@var{form} so it takes its default value. Year numbers less than 100 are not treated specially. If you want them to stand for years above 1900, or years above 2000, you must alter them yourself before you call @code{encode-time}. -The optional argument @var{zone} defaults to the current time zone rule. -@xref{Time Zone Rules}. - -If you pass more than seven arguments to @code{encode-time}, the first -six are used as @var{seconds} through @var{year}, the last argument is -used as @var{zone}, and the arguments in between are ignored. This -feature makes it possible to use the elements of a list returned by -@code{decode-time} as the arguments to @code{encode-time}, like this: +The @code{encode-time} function acts as a rough inverse to +@code{decode-time}. For example, you can pass the output of +the latter to the former as follows: @example -(apply 'encode-time (decode-time @dots{})) +(encode-time (decode-time @dots{})) @end example You can perform simple date arithmetic by using out-of-range values for -the @var{seconds}, @var{minutes}, @var{hour}, @var{day}, and @var{month} -arguments; for example, day 0 means the day preceding the given month. +@var{seconds}, @var{minutes}, @var{hour}, @var{day}, and @var{month}; +for example, day 0 means the day preceding the given month. The operating system puts limits on the range of possible time values; if you try to encode a time that is out of range, an error results. @@ -1474,12 +1528,12 @@ on others, years as early as 1901 do work. @cindex formatting time values These functions convert time values to text in a string, and vice versa. -Time values include @code{nil}, numbers, and lists of two to four -integers (@pxref{Time of Day}). +Time values include @code{nil}, numbers, and Lisp timestamps +(@pxref{Time of Day}). @defun date-to-time string This function parses the time-string @var{string} and returns the -corresponding time value. +corresponding Lisp timestamp. @end defun @defun format-time-string format-string &optional time zone @@ -1701,10 +1755,8 @@ When called interactively, it prints the uptime in the echo area. @end deffn @defun get-internal-run-time -This function returns the processor run time used by Emacs as a list -of four integers: @code{(@var{sec-high} @var{sec-low} @var{microsec} -@var{picosec})}, using the same format as @code{current-time} -(@pxref{Time of Day}). +This function returns the processor run time used by Emacs, as a Lisp +timestamp (@pxref{Time of Day}). Note that the time returned by this function excludes the time Emacs was not using the processor, and if the Emacs process has several @@ -1729,9 +1781,10 @@ interactively, it prints the duration in the echo area. @cindex calendrical computations These functions perform calendrical computations using time values -(@pxref{Time of Day}). A value of @code{nil} for any of their +(@pxref{Time of Day}). As with any time value, a value of +@code{nil} for any of their time-value arguments stands for the current system time, and a single -integer number stands for the number of seconds since the epoch. +number stands for the number of seconds since the epoch. @defun time-less-p t1 t2 This returns @code{t} if time value @var{t1} is less than time value @@ -1757,7 +1810,7 @@ float-time}) to convert the result into seconds. This returns the sum of two time values, as a time value. However, the result is a float if either argument is a float infinity or NaN@. One argument should represent a time difference rather than a point in time, -either as a list or as a single number of elapsed seconds. +as a time value that is often just a single number of elapsed seconds. Here is how to add a number of seconds to a time value: @example diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 89ad1cf8381..e1113e37f10 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -2158,19 +2158,17 @@ faults for all the child processes of the given process. @item utime Time spent by the process in the user context, for running the -application's code. The corresponding @var{value} is in the -@w{@code{(@var{high} @var{low} @var{microsec} @var{picosec})}} format, the same -format used by functions @code{current-time} (@pxref{Time of Day, -current-time}) and @code{file-attributes} (@pxref{File Attributes}). +application's code. The corresponding @var{value} is a Lisp +timestamp (@pxref{Time of Day}). @item stime Time spent by the process in the system (kernel) context, for -processing system calls. The corresponding @var{value} is in the same -format as for @code{utime}. +processing system calls. The corresponding @var{value} is a Lisp +timestamp. @item time The sum of @code{utime} and @code{stime}. The corresponding -@var{value} is in the same format as for @code{utime}. +@var{value} is a Lisp timestamp. @item cutime @itemx cstime @@ -2189,13 +2187,10 @@ nice values get scheduled more favorably.) The number of threads in the process. @item start -The time when the process was started, in the same -@code{(@var{high} @var{low} @var{microsec} @var{picosec})} format used by -@code{file-attributes} and @code{current-time}. +The time when the process was started, as a Lisp timestamp. @item etime -The time elapsed since the process started, in the format @code{(@var{high} -@var{low} @var{microsec} @var{picosec})}. +The time elapsed since the process started, as a Lisp timestamp. @item vsize The virtual memory size of the process, measured in kilobytes. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 825827095b4..6c38d8eed09 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -1327,9 +1327,8 @@ elements follow immediately after this element. @item (t . @var{time-flag}) This kind of element indicates that an unmodified buffer became -modified. A @var{time-flag} of the form -@code{(@var{sec-high} @var{sec-low} @var{microsec} -@var{picosec})} represents the visited file's modification time as of +modified. A @var{time-flag} that is a non-integer Lisp timestamp +represents the visited file's modification time as of when it was previously visited or saved, using the same format as @code{current-time}; see @ref{Time of Day}. A @var{time-flag} of 0 means the buffer does not correspond to any file; diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi index 9280311b5c9..f46b2a7fc1d 100644 --- a/doc/misc/emacs-mime.texi +++ b/doc/misc/emacs-mime.texi @@ -1524,12 +1524,12 @@ many mailers don't support it. @xref{rfc2231}. @section time-date While not really a part of the @acronym{MIME} library, it is convenient to -document this library here. It deals with parsing @code{Date} headers +document time conversion functions often used when parsing @code{Date} headers and manipulating time. (Not by using tesseracts, though, I'm sorry to say.) -These functions convert between five formats: A date string, an Emacs -time structure, a decoded time list, a second number, and a day number. +These functions convert between five formats: A date string, a Lisp +timestamp, a decoded time list, a second number, and a day number. Here's a bunch of time/date/second/day examples: @@ -1537,35 +1537,41 @@ Here's a bunch of time/date/second/day examples: (parse-time-string "Sat Sep 12 12:21:54 1998 +0200") @result{} (54 21 12 12 9 1998 6 -1 7200) -(date-to-time "Sat Sep 12 12:21:54 1998 +0200") -@result{} (13818 19266) +(encode-time (date-to-time "Sat Sep 12 12:21:54 1998 +0200") + 1000000) +@result{} (905595714000000 . 1000000) -(parse-iso8601-time-string "1998-09-12T12:21:54+0200") -@result{} (13818 19266) +(encode-time (parse-iso8601-time-string "1998-09-12T12:21:54+0200") + 1000000) +@result{} (905595714000000 . 1000000) -(float-time '(13818 19266)) +(float-time '(905595714000000 . 1000000)) @result{} 905595714.0 -(seconds-to-time 905595714.0) -@result{} (13818 19266 0 0) +(encode-time 905595714.0 1000000) +@result{} (905595714000000 . 1000000) -(time-to-days '(13818 19266)) +(time-to-days '(905595714000000 . 1000000)) @result{} 729644 -(days-to-time 729644) -@result{} (961933 512) +(encode-time (days-to-time 729644) 1000000) +@result{} (63041241600000000 . 1000000) -(time-since '(13818 19266)) -@result{} (6797 9607 984839 247000) +(encode-time (time-since '(905595714000000 . 1000000)) + 1000000) +@result{} (631963244775642171 . 1000000000) -(time-less-p '(13818 19266) '(13818 19145)) +(time-less-p '(905595714000000 . 1000000) + '(905595593000000000 . 1000000000)) @result{} nil -(time-equal-p '(13818 19266) '(13818 19145)) -@result{} nil +(time-equal-p '(905595593000000000 . 1000000000) + '(905595593000000 . 1000000 )) +@result{} t -(time-subtract '(13818 19266) '(13818 19145)) -@result{} (0 121) +(time-subtract '(905595714000000 . 1000000) + '(905595593000000000 . 1000000000)) +@result{} (121000000000 . 1000000000) (days-between "Sat Sep 12 12:21:54 1998 +0200" "Sat Sep 07 12:21:54 1998 +0200") @@ -1574,13 +1580,13 @@ Here's a bunch of time/date/second/day examples: (date-leap-year-p 2000) @result{} t -(time-to-day-in-year '(13818 19266)) +(time-to-day-in-year '(905595714000000 . 1000000)) @result{} 255 (time-to-number-of-days (time-since (date-to-time "Mon, 01 Jan 2001 02:22:26 GMT"))) -@result{} 4314.095589286675 +@result{} 6472.722661506652 @end example And finally, we have @code{safe-date-to-time}, which does the same as @@ -1595,22 +1601,24 @@ An RFC822 (or similar) date string. For instance: @code{"Sat Sep 12 12:21:54 1998 +0200"}. @item time -An internal Emacs time. For instance: @code{(13818 26466 0 0)}. +A Lisp timestamp. +For instance: @code{(905595714000000 . 1000000)}. @item seconds -A floating point representation of the internal Emacs time. For -instance: @code{905595714.0}. +An integer or floating point count of seconds. For instance: +@code{905595714.0}, @code{905595714}. @item days An integer number representing the number of days since 00000101. For instance: @code{729644}. @item decoded time -A list of decoded time. For instance: @code{(54 21 12 12 9 1998 6 t +A list of decoded time. For instance: @code{(54 21 12 12 9 1998 6 nil 7200)}. @end table -All the examples above represent the same moment. +All the examples above represent the same moment, except that +@var{days} represents the day containing the moment. These are the functions available: @@ -1621,8 +1629,9 @@ Take a date and return a time. @item float-time Take a time and return seconds. (This is a built-in function.) -@item seconds-to-time -Take seconds and return a time. +@item encode-time +Take seconds (and other ways to represent time, notably decoded time +lists), and return a time. @item time-to-days Take a time and return days. @@ -1645,7 +1654,7 @@ Take two times and say whether the first time is less (i.e., earlier) than the second time. (This is a built-in function.) @item time-equal-p -Check, whether two time values are equal. The time values must not be +Check whether two time values are equal. The time values need not be in the same format. (This is a built-in function.) @item time-since diff --git a/etc/NEWS b/etc/NEWS index daacf49e62d..020450c9570 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -995,6 +995,21 @@ like file-attributes that compute file sizes and other attributes, functions like process-id that compute process IDs, and functions like user-uid and group-gid that compute user and group IDs. ++++ +** Although the default timestamp format is still (HI LO US PS), +it is planned to change in a future Emacs version, to exploit bignums. +The documentation has been updated to mention that the timestamp +format may change and that programs should use functions like +format-time-string, decode-time, and encode-time rather than probing +the innards of a timestamp directly, or creating a timestamp by hand. + ++++ +** encode-time supports a new API (encode-time TIME &optional FORM). +This can convert decoded times and Lisp time values to Lisp timestamps +of various forms, including a new timestamp form (TICKS . HZ), where +TICKS is an integer and HZ is a positive integer denoting a clock +frequency. The old encode-time API is still supported. + +++ ** 'time-add', 'time-subtract', and 'time-less-p' now accept infinities and NaNs too, and propagate them or return nil like diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el index 00a8e7498af..25264bda097 100644 --- a/lisp/calendar/cal-dst.el +++ b/lisp/calendar/cal-dst.el @@ -97,62 +97,48 @@ If the locale never uses daylight saving time, set this to nil." ;;;###autoload (put 'calendar-current-time-zone-cache 'risky-local-variable t) -(defvar calendar-system-time-basis +(defconst calendar-system-time-basis (calendar-absolute-from-gregorian '(1 1 1970)) "Absolute date of starting date of system clock.") (defun calendar-absolute-from-time (x utc-diff) "Absolute local date of time X; local time is UTC-DIFF seconds from UTC. -X is (HIGH . LOW) or (HIGH LOW . IGNORED) where HIGH and LOW are the -high and low 16 bits, respectively, of the number of seconds since -1970-01-01 00:00:00 UTC, ignoring leap seconds. +X is the number of seconds since 1970-01-01 00:00:00 UTC, +ignoring leap seconds. Returns the pair (ABS-DATE . SECONDS) where SECONDS after local midnight on absolute date ABS-DATE is the equivalent moment to X." - (let* ((h (car x)) - (xtail (cdr x)) - (l (+ utc-diff (if (numberp xtail) xtail (car xtail)))) - (u (+ (* 512 (mod h 675)) (floor l 128)))) - ;; Overflow is a terrible thing! - (cons (+ calendar-system-time-basis - ;; floor((2^16 h +l) / (60*60*24)) - (* 512 (floor h 675)) (floor u 675)) - ;; (2^16 h +l) mod (60*60*24) - (+ (* (mod u 675) 128) (mod l 128))))) + (let ((secsperday 86400) + (local (+ x utc-diff))) + (cons (+ calendar-system-time-basis (floor local secsperday)) + (mod local secsperday)))) (defun calendar-time-from-absolute (abs-date s) "Time of absolute date ABS-DATE, S seconds after midnight. -Returns the list (HIGH LOW) where HIGH and LOW are the high and low -16 bits, respectively, of the number of seconds 1970-01-01 00:00:00 UTC, -ignoring leap seconds, that is the equivalent moment to S seconds after -midnight UTC on absolute date ABS-DATE." - (let* ((a (- abs-date calendar-system-time-basis)) - (u (+ (* 163 (mod a 512)) (floor s 128)))) - ;; Overflow is a terrible thing! - (list - ;; floor((60*60*24*a + s) / 2^16) - (+ a (* 163 (floor a 512)) (floor u 512)) - ;; (60*60*24*a + s) mod 2^16 - (+ (* 128 (mod u 512)) (mod s 128))))) +Return the number of seconds since 1970-01-01 00:00:00 UTC, +ignoring leap seconds, that is the equivalent moment to S seconds +after midnight UTC on absolute date ABS-DATE." + (let ((secsperday 86400)) + (+ s (* secsperday (- abs-date calendar-system-time-basis))))) (defun calendar-next-time-zone-transition (time) "Return the time of the next time zone transition after TIME. Both TIME and the result are acceptable arguments to `current-time-zone'. Return nil if no such transition can be found." - (let* ((base 65536) ; 2^16 = base of current-time output - (quarter-multiple 120) ; approx = (seconds per quarter year) / base + (let* ((time (encode-time time 'integer)) (time-zone (current-time-zone time)) (time-utc-diff (car time-zone)) hi hi-zone (hi-utc-diff time-utc-diff) + (quarter-seconds 7889238) ; Average seconds per 1/4 Gregorian year. (quarters '(2 1 3))) ;; Heuristic: probe the time zone offset in the next three calendar ;; quarters, looking for a time zone offset different from TIME. (while (and quarters (eq time-utc-diff hi-utc-diff)) - (setq hi (cons (+ (car time) (* (car quarters) quarter-multiple)) 0) + (setq hi (+ time (* (car quarters) quarter-seconds)) hi-zone (current-time-zone hi) hi-utc-diff (car hi-zone) quarters (cdr quarters))) @@ -163,23 +149,16 @@ Return nil if no such transition can be found." ;; Now HI is after the next time zone transition. ;; Set LO to TIME, and then binary search to increase LO and decrease HI ;; until LO is just before and HI is just after the time zone transition. - (let* ((tail (cdr time)) - (lo (cons (car time) (if (numberp tail) tail (car tail)))) + (let* ((lo time) probe) (while ;; Set PROBE to halfway between LO and HI, rounding down. ;; If PROBE equals LO, we are done. - (let* ((lsum (+ (cdr lo) (cdr hi))) - (hsum (+ (car lo) (car hi) (/ lsum base))) - (hsumodd (logand 1 hsum))) - (setq probe (cons (/ (- hsum hsumodd) 2) - (/ (+ (* hsumodd base) (% lsum base)) 2))) - (not (equal lo probe))) + (not (= lo (setq probe (/ (+ lo hi) 2)))) ;; Set either LO or HI to PROBE, depending on probe results. (if (eq (car (current-time-zone probe)) hi-utc-diff) (setq hi probe) (setq lo probe))) - (setcdr hi (list (cdr hi))) hi)))) (autoload 'calendar-persian-to-absolute "cal-persia") diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el index d6c1e9ea169..9443fde4c99 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -227,7 +227,7 @@ If DATE-STRING cannot be parsed, it falls back to (tz-re (nth 2 parse-time-iso8601-regexp)) re-start time seconds minute hour - day month year day-of-week dst tz) + day month year day-of-week (dst -1) tz) ;; We need to populate 'time' with ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ) @@ -243,6 +243,7 @@ If DATE-STRING cannot be parsed, it falls back to seconds (string-to-number (match-string 3 date-string)) re-start (match-end 0)) (when (string-match tz-re date-string re-start) + (setq dst nil) (if (string= "Z" (match-string 1 date-string)) (setq tz 0) ;; UTC timezone indicated by Z (setq tz (+ @@ -260,7 +261,7 @@ If DATE-STRING cannot be parsed, it falls back to (setq time (parse-time-string date-string))) (and time - (apply 'encode-time time)))) + (encode-time time)))) (provide 'parse-time) diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 74c607ccb68..c3898e0257e 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -168,15 +168,15 @@ If DATE lacks timezone information, GMT is assumed." (defalias 'time-to-seconds 'float-time) ;;;###autoload -(defun seconds-to-time (seconds) - "Convert SECONDS to a time value." - (time-add 0 seconds)) +(defalias 'seconds-to-time 'encode-time) ;;;###autoload (defun days-to-time (days) "Convert DAYS into a time value." - (let ((time (seconds-to-time (* 86400 days)))) - (if (integerp days) + (let ((time (encode-time (* 86400 days)))) + ;; Traditionally, this returned a two-element list if DAYS was an integer. + ;; Keep that tradition if encode-time outputs timestamps in list form. + (if (and (integerp days) (consp (cdr time))) (setcdr (cdr time) nil)) time)) diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el index b46e7732fd3..ddc297604ec 100644 --- a/lisp/calendar/timeclock.el +++ b/lisp/calendar/timeclock.el @@ -534,8 +534,7 @@ non-nil, the amount returned will be relative to past time worked." string))) (define-obsolete-function-alias 'timeclock-time-to-seconds 'float-time "26.1") -(define-obsolete-function-alias 'timeclock-seconds-to-time 'seconds-to-time - "26.1") +(define-obsolete-function-alias 'timeclock-seconds-to-time 'encode-time "26.1") ;; Should today-only be removed in favor of timeclock-relative? - gm (defsubst timeclock-when-to-leave (&optional today-only) diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index 74d37b0eaed..927e640feaa 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -57,17 +57,11 @@ (defun timer--time-setter (timer time) (timer--check timer) - (setf (timer--high-seconds timer) (pop time)) - (let ((low time) (usecs 0) (psecs 0)) - (when (consp time) - (setq low (pop time)) - (when time - (setq usecs (pop time)) - (when time - (setq psecs (car time))))) - (setf (timer--low-seconds timer) low) - (setf (timer--usecs timer) usecs) - (setf (timer--psecs timer) psecs) + (let ((lt (encode-time time 'list))) + (setf (timer--high-seconds timer) (nth 0 lt)) + (setf (timer--low-seconds timer) (nth 1 lt)) + (setf (timer--usecs timer) (nth 2 lt)) + (setf (timer--psecs timer) (nth 3 lt)) time)) ;; Pseudo field `time'. @@ -102,24 +96,14 @@ fire each time Emacs is idle for that many seconds." "Yield the next value after TIME that is an integral multiple of SECS. More precisely, the next value, after TIME, that is an integral multiple of SECS seconds since the epoch. SECS may be a fraction." - (let* ((trillion 1000000000000) - (time-sec (+ (nth 1 time) - (* 65536 (nth 0 time)))) - (delta-sec (mod (- time-sec) secs)) - (next-sec (+ time-sec (floor delta-sec))) - (next-sec-psec (floor (* trillion (mod delta-sec 1)))) - (sub-time-psec (+ (or (nth 3 time) 0) - (* 1000000 (nth 2 time)))) - (psec-diff (- sub-time-psec next-sec-psec))) - (if (and (<= next-sec time-sec) (< 0 psec-diff)) - (setq next-sec-psec (+ sub-time-psec - (mod (- psec-diff) (* trillion secs))))) - (setq next-sec (+ next-sec (floor next-sec-psec trillion))) - (setq next-sec-psec (mod next-sec-psec trillion)) - (list (floor next-sec 65536) - (floor (mod next-sec 65536)) - (floor next-sec-psec 1000000) - (floor (mod next-sec-psec 1000000))))) + (let* ((ticks-hz (if (and (consp time) (integerp (car time)) + (integerp (cdr time)) (< 0 (cdr time))) + time + (encode-time time 1000000000000))) + (hz (cdr ticks-hz)) + (s-ticks (* secs hz)) + (more-ticks (+ (car ticks-hz) s-ticks))) + (encode-time (cons (- more-ticks (% more-ticks s-ticks)) hz)))) (defun timer-relative-time (time secs &optional usecs psecs) "Advance TIME by SECS seconds and optionally USECS microseconds diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el index 217f0b859f2..7a68c68ab61 100644 --- a/lisp/net/ntlm.el +++ b/lisp/net/ntlm.el @@ -155,8 +155,7 @@ signed integer." ;; tenths of microseconds between ;; 1601-01-01 and 1970-01-01 "116444736000000000)") - ;; add trailing zeros to support old current-time formats - 'rawnum (append (current-time) '(0 0)))) + 'rawnum (encode-time nil 'list))) result-bytes) (dotimes (byte 8) (push (calc-eval "and($1,16#FF)" 'rawnum tenths-of-us-since-jan-1-1601) diff --git a/lisp/obsolete/vc-arch.el b/lisp/obsolete/vc-arch.el index 9860c9d3faa..e4c52d51464 100644 --- a/lisp/obsolete/vc-arch.el +++ b/lisp/obsolete/vc-arch.el @@ -133,7 +133,8 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (file-error (insert (format "%s <%s> %s" (current-time-string) user-mail-address - (+ (nth 2 (current-time)) + (+ (% (car (encode-time nil 1000000)) + 1000000) (buffer-size))))))) (comment-region beg (point)))) diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index 26b203ff06d..ad9b7d1ec7f 100644 --- a/lisp/org/org-id.el +++ b/lisp/org/org-id.el @@ -357,7 +357,7 @@ So a typical ID could look like \"Org:4nd91V40HI\"." "Return string with random (version 4) UUID." (let ((rnd (md5 (format "%s%s%s%s%s%s%s" (random) - (current-time) + (encode-time nil 'list) (user-uid) (emacs-pid) (user-full-name) @@ -416,7 +416,7 @@ The input I may be a character, or a single-letter string." "Encode TIME as a 10-digit string. This string holds the time to micro-second accuracy, and can be decoded using `org-id-decode'." - (setq time (or time (current-time))) + (setq time (encode-time time 'list)) (concat (org-id-int-to-b36 (nth 0 time) 4) (org-id-int-to-b36 (nth 1 time) 4) (org-id-int-to-b36 (or (nth 2 time) 0) 4))) diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 19e5159816a..cf4e53abef7 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -304,7 +304,7 @@ write-date, checksum, link-type, and link-name." (tar-parse-octal-integer string tar-uid-offset tar-gid-offset) (tar-parse-octal-integer string tar-gid-offset tar-size-offset) (tar-parse-octal-integer string tar-size-offset tar-time-offset) - (tar-parse-octal-long-integer string tar-time-offset tar-chk-offset) + (tar-parse-octal-integer string tar-time-offset tar-chk-offset) (tar-parse-octal-integer string tar-chk-offset tar-linkp-offset) link-p linkname @@ -342,20 +342,8 @@ write-date, checksum, link-type, and link-name." start (1+ start))) n))) -(defun tar-parse-octal-long-integer (string &optional start end) - (if (null start) (setq start 0)) - (if (null end) (setq end (length string))) - (if (= (aref string start) 0) - (list 0 0) - (let ((lo 0) - (hi 0)) - (while (< start end) - (if (>= (aref string start) ?0) - (setq lo (+ (* lo 8) (- (aref string start) ?0)) - hi (+ (* hi 8) (ash lo -16)) - lo (logand lo 65535))) - (setq start (1+ start))) - (list hi lo)))) +(define-obsolete-function-alias 'tar-parse-octal-long-integer + 'tar-parse-octal-integer "27.1") (defun tar-parse-octal-integer-safe (string) (if (zerop (length string)) (error "empty string")) @@ -1276,14 +1264,8 @@ for this to be permanent." (defun tar-octal-time (timeval) - ;; Format a timestamp as 11 octal digits. Ghod, I hope this works... - (let ((hibits (car timeval)) (lobits (car (cdr timeval)))) - (format "%05o%01o%05o" - (ash hibits -2) - (logior (ash (logand 3 hibits) 1) - (if (> (logand lobits 32768) 0) 1 0)) - (logand 32767 lobits) - ))) + ;; Format a timestamp as 11 octal digits. + (format "%011o" (encode-time timeval 'integer))) (defun tar-subfile-save-buffer () "In tar subfile mode, save this buffer into its parent tar-file buffer. diff --git a/src/bignum.c b/src/bignum.c index 5d8ab670f24..0ab8de3ab7a 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -31,7 +31,7 @@ along with GNU Emacs. If not, see . */ storage is exhausted. Admittedly this is not ideal. An mpz value in a temporary is made permanent by mpz_swapping it with a bignum's value. Although typically at most two temporaries are needed, - rounding_driver and rounddiv_q need four altogther. */ + time_arith, rounddiv_q and rounding_driver each need four. */ mpz_t mpz[4]; diff --git a/src/keyboard.c b/src/keyboard.c index 35d74f4a795..8ea15d3c890 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -4163,18 +4163,13 @@ decode_timer (Lisp_Object timer, struct timespec *result) Lisp_Object *vec; if (! (VECTORP (timer) && ASIZE (timer) == 9)) - return 0; + return false; vec = XVECTOR (timer)->contents; if (! NILP (vec[0])) - return 0; + return false; if (! FIXNUMP (vec[2])) return false; - - struct lisp_time t; - if (decode_time_components (vec[1], vec[2], vec[3], vec[8], &t, 0) <= 0) - return false; - *result = lisp_to_timespec (t); - return timespec_valid_p (*result); + return list4_to_timespec (vec[1], vec[2], vec[3], vec[8], result); } diff --git a/src/systime.h b/src/systime.h index f2f51b009e2..0bc1e90fb05 100644 --- a/src/systime.h +++ b/src/systime.h @@ -75,19 +75,22 @@ extern void set_waiting_for_input (struct timespec *); (HI << LO_TIME_BITS) + LO + US / 1e6 + PS / 1e12. */ enum { LO_TIME_BITS = 16 }; -/* A Lisp time (HI LO US PS), sans the cons cells. */ +/* Components of a new-format Lisp timestamp. */ struct lisp_time { - EMACS_INT hi; - int lo, us, ps; + /* Clock count as a Lisp integer. */ + Lisp_Object ticks; + + /* Clock frequency (ticks per second) as a positive Lisp integer. + (TICKS . HZ) is a valid Lisp timestamp unless HZ < 65536. */ + Lisp_Object hz; }; /* defined in timefns.c */ extern struct timeval make_timeval (struct timespec) ATTRIBUTE_CONST; extern Lisp_Object make_lisp_time (struct timespec); -extern int decode_time_components (Lisp_Object, Lisp_Object, Lisp_Object, - Lisp_Object, struct lisp_time *, double *); -extern struct timespec lisp_to_timespec (struct lisp_time); +extern bool list4_to_timespec (Lisp_Object, Lisp_Object, Lisp_Object, + Lisp_Object, struct timespec *); extern struct timespec lisp_time_argument (Lisp_Object); extern _Noreturn void time_overflow (void); extern void init_timefns (bool); diff --git a/src/timefns.c b/src/timefns.c index fcb4485ae30..72cb54d3a0c 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -22,12 +22,14 @@ along with GNU Emacs. If not, see . */ #include "systime.h" #include "blockinput.h" +#include "bignum.h" #include "coding.h" #include "lisp.h" #include #include +#include #include #include #include @@ -55,6 +57,47 @@ along with GNU Emacs. If not, see . */ # define TIME_T_MAX TYPE_MAXIMUM (time_t) #endif +/* Compile with -DFASTER_TIMEFNS=0 to disable common optimizations and + allow easier testing of some slow-path code. */ +#ifndef FASTER_TIMEFNS +# define FASTER_TIMEFNS 1 +#endif + +/* Whether to warn about Lisp timestamps (TICKS . HZ) that may be + instances of obsolete-format timestamps (HI . LO) where HI is + the high-order bits and LO the low-order 16 bits. Currently this + is true, but it should change to false in a future version of + Emacs. Compile with -DWARN_OBSOLETE_TIMESTAMPS=0 to see what the + future will be like. */ +#ifndef WARN_OBSOLETE_TIMESTAMPS +enum { WARN_OBSOLETE_TIMESTAMPS = true }; +#endif + +/* Although current-time etc. generate list-format timestamps + (HI LO US PS), the plan is to change these functions to generate + frequency-based timestamps (TICKS . HZ) in a future release. + To try this now, compile with -DCURRENT_TIME_LIST=0. */ +#ifndef CURRENT_TIME_LIST +enum { CURRENT_TIME_LIST = true }; +#endif + +#if FIXNUM_OVERFLOW_P (1000000000) +static Lisp_Object timespec_hz; +#else +# define timespec_hz make_fixnum (TIMESPEC_HZ) +#endif + +#define TRILLION 1000000000000 +#if FIXNUM_OVERFLOW_P (TRILLION) +static Lisp_Object trillion; +# define ztrillion (XBIGNUM (trillion)->value) +#else +# define trillion make_fixnum (TRILLION) +# if ULONG_MAX < TRILLION || !FASTER_TIMEFNS +mpz_t ztrillion; +# endif +#endif + /* Return a struct timeval that is roughly equivalent to T. Use the least timeval not less than T. Return an extremal value if the result would overflow. */ @@ -69,7 +112,7 @@ make_timeval (struct timespec t) { if (tv.tv_usec < 999999) tv.tv_usec++; - else if (tv.tv_sec < TYPE_MAXIMUM (time_t)) + else if (tv.tv_sec < TIME_T_MAX) { tv.tv_sec++; tv.tv_usec = 0; @@ -309,92 +352,24 @@ invalid_time (void) error ("Invalid time specification"); } -/* Check a return value compatible with that of decode_time_components. */ -static void -check_time_validity (int validity) +static _Noreturn void +invalid_hz (Lisp_Object hz) { - if (validity <= 0) - { - if (validity < 0) - time_overflow (); - else - invalid_time (); - } + xsignal2 (Qerror, build_string ("Invalid time frequency"), hz); } /* Return the upper part of the time T (everything but the bottom 16 bits). */ -static EMACS_INT +static Lisp_Object hi_time (time_t t) { - time_t hi = t >> LO_TIME_BITS; - if (FIXNUM_OVERFLOW_P (hi)) - time_overflow (); - return hi; + return INT_TO_INTEGER (t >> LO_TIME_BITS); } /* Return the bottom bits of the time T. */ -static int +static Lisp_Object lo_time (time_t t) { - return t & ((1 << LO_TIME_BITS) - 1); -} - -/* Decode a Lisp list SPECIFIED_TIME that represents a time. - Set *PHIGH, *PLOW, *PUSEC, *PPSEC to its parts; do not check their values. - Return 2, 3, or 4 to indicate the effective length of SPECIFIED_TIME - if successful, 0 if unsuccessful. */ -static int -disassemble_lisp_time (Lisp_Object specified_time, Lisp_Object *phigh, - Lisp_Object *plow, Lisp_Object *pusec, - Lisp_Object *ppsec) -{ - Lisp_Object high = make_fixnum (0); - Lisp_Object low = specified_time; - Lisp_Object usec = make_fixnum (0); - Lisp_Object psec = make_fixnum (0); - int len = 4; - - if (CONSP (specified_time)) - { - high = XCAR (specified_time); - low = XCDR (specified_time); - if (CONSP (low)) - { - Lisp_Object low_tail = XCDR (low); - low = XCAR (low); - if (CONSP (low_tail)) - { - usec = XCAR (low_tail); - low_tail = XCDR (low_tail); - if (CONSP (low_tail)) - psec = XCAR (low_tail); - else - len = 3; - } - else if (!NILP (low_tail)) - { - usec = low_tail; - len = 3; - } - else - len = 2; - } - else - len = 2; - - /* When combining components, require LOW to be an integer, - as otherwise it would be a pain to add up times. */ - if (! INTEGERP (low)) - return 0; - } - else if (INTEGERP (specified_time)) - len = 2; - - *phigh = high; - *plow = low; - *pusec = usec; - *ppsec = psec; - return len; + return make_fixnum (t & ((1 << LO_TIME_BITS) - 1)); } /* Convert T into an Emacs time *RESULT, truncating toward minus infinity. @@ -402,219 +377,591 @@ disassemble_lisp_time (Lisp_Object specified_time, Lisp_Object *phigh, static bool decode_float_time (double t, struct lisp_time *result) { - double lo_multiplier = 1 << LO_TIME_BITS; - double emacs_time_min = MOST_NEGATIVE_FIXNUM * lo_multiplier; - if (! (emacs_time_min <= t && t < -emacs_time_min)) + if (!isfinite (t)) return false; - - double small_t = t / lo_multiplier; - EMACS_INT hi = small_t; - double t_sans_hi = t - hi * lo_multiplier; - int lo = t_sans_hi; - long double fracps = (t_sans_hi - lo) * 1e12L; -#ifdef INT_FAST64_MAX - int_fast64_t ifracps = fracps; - int us = ifracps / 1000000; - int ps = ifracps % 1000000; -#else - int us = fracps / 1e6L; - int ps = fracps - us * 1e6L; -#endif - us -= (ps < 0); - ps += (ps < 0) * 1000000; - lo -= (us < 0); - us += (us < 0) * 1000000; - hi -= (lo < 0); - lo += (lo < 0) << LO_TIME_BITS; - result->hi = hi; - result->lo = lo; - result->us = us; - result->ps = ps; + /* Actual hz unknown; guess TIMESPEC_HZ. */ + mpz_set_d (mpz[1], t); + mpz_set_si (mpz[0], floor ((t - trunc (t)) * TIMESPEC_HZ)); + mpz_addmul_ui (mpz[0], mpz[1], TIMESPEC_HZ); + result->ticks = make_integer_mpz (); + result->hz = timespec_hz; return true; } -/* From the time components HIGH, LOW, USEC and PSEC taken from a Lisp - list, generate the corresponding time value. - If LOW is floating point, the other components should be zero. +/* Compute S + NS/TIMESPEC_HZ as a double. + Calls to this function suffer from double-rounding; + work around some of the problem by using long double. */ +static double +s_ns_to_double (long double s, long double ns) +{ + return s + ns / TIMESPEC_HZ; +} + +/* Make a 4-element timestamp (HI LO US PS) from TICKS and HZ. + Drop any excess precision. */ +static Lisp_Object +ticks_hz_list4 (Lisp_Object ticks, Lisp_Object hz) +{ + mpz_t *zticks = bignum_integer (&mpz[0], ticks); +#if FASTER_TIMEFNS && TRILLION <= ULONG_MAX + mpz_mul_ui (mpz[0], *zticks, TRILLION); +#else + mpz_mul (mpz[0], *zticks, ztrillion); +#endif + mpz_fdiv_q (mpz[0], mpz[0], *bignum_integer (&mpz[1], hz)); +#if FASTER_TIMEFNS && TRILLION <= ULONG_MAX + unsigned long int fullps = mpz_fdiv_q_ui (mpz[0], mpz[0], TRILLION); + int us = fullps / 1000000; + int ps = fullps % 1000000; +#else + mpz_fdiv_qr (mpz[0], mpz[1], mpz[0], ztrillion); + int ps = mpz_fdiv_q_ui (mpz[1], mpz[1], 1000000); + int us = mpz_get_ui (mpz[1]); +#endif + unsigned long ulo = mpz_get_ui (mpz[0]); + if (mpz_sgn (mpz[0]) < 0) + ulo = -ulo; + int lo = ulo & ((1 << LO_TIME_BITS) - 1); + mpz_fdiv_q_2exp (mpz[0], mpz[0], LO_TIME_BITS); + return list4 (make_integer_mpz (), make_fixnum (lo), + make_fixnum (us), make_fixnum (ps)); +} + +/* Set ROP to T. */ +static void +mpz_set_time (mpz_t rop, time_t t) +{ + if (EXPR_SIGNED (t)) + mpz_set_intmax (rop, t); + else + mpz_set_uintmax (rop, t); +} + +/* Store into mpz[0] a clock tick count for T, assuming a + TIMESPEC_HZ-frequency clock. Use mpz[1] as a temp. */ +static void +timespec_mpz (struct timespec t) +{ + mpz_set_ui (mpz[0], t.tv_nsec); + mpz_set_time (mpz[1], t.tv_sec); + mpz_addmul_ui (mpz[0], mpz[1], TIMESPEC_HZ); +} + +/* Convert T to a Lisp integer counting TIMESPEC_HZ ticks. */ +static Lisp_Object +timespec_ticks (struct timespec t) +{ + intmax_t accum; + if (FASTER_TIMEFNS + && !INT_MULTIPLY_WRAPV (t.tv_sec, TIMESPEC_HZ, &accum) + && !INT_ADD_WRAPV (t.tv_nsec, accum, &accum)) + return make_int (accum); + timespec_mpz (t); + return make_integer_mpz (); +} + +/* Convert T to a Lisp integer counting HZ ticks, taking the floor. + Assume T is valid, but check HZ. */ +static Lisp_Object +time_hz_ticks (time_t t, Lisp_Object hz) +{ + if (FIXNUMP (hz)) + { + if (XFIXNUM (hz) <= 0) + invalid_hz (hz); + intmax_t ticks; + if (FASTER_TIMEFNS && !INT_MULTIPLY_WRAPV (t, XFIXNUM (hz), &ticks)) + return make_int (ticks); + } + else if (! (BIGNUMP (hz) && 0 < mpz_sgn (XBIGNUM (hz)->value))) + invalid_hz (hz); + + mpz_set_time (mpz[0], t); + mpz_mul (mpz[0], mpz[0], *bignum_integer (&mpz[1], hz)); + return make_integer_mpz (); +} +static Lisp_Object +lisp_time_hz_ticks (struct lisp_time t, Lisp_Object hz) +{ + if (FASTER_TIMEFNS && EQ (t.hz, hz)) + return t.ticks; + if (FIXNUMP (hz)) + { + if (XFIXNUM (hz) <= 0) + invalid_hz (hz); + intmax_t ticks; + if (FASTER_TIMEFNS && FIXNUMP (t.ticks) && FIXNUMP (t.hz) + && !INT_MULTIPLY_WRAPV (XFIXNUM (t.ticks), XFIXNUM (hz), &ticks)) + return make_int (ticks / XFIXNUM (t.hz) + - (ticks % XFIXNUM (t.hz) < 0)); + } + else if (! (BIGNUMP (hz) && 0 < mpz_sgn (XBIGNUM (hz)->value))) + invalid_hz (hz); + + mpz_mul (mpz[0], + *bignum_integer (&mpz[0], t.ticks), + *bignum_integer (&mpz[1], hz)); + mpz_fdiv_q (mpz[0], mpz[0], *bignum_integer (&mpz[1], t.hz)); + return make_integer_mpz (); +} + +/* Convert T to a Lisp integer counting seconds, taking the floor. */ +static Lisp_Object +lisp_time_seconds (struct lisp_time t) +{ + if (!FASTER_TIMEFNS) + return lisp_time_hz_ticks (t, make_fixnum (1)); + if (FIXNUMP (t.ticks) && FIXNUMP (t.hz)) + return make_fixnum (XFIXNUM (t.ticks) / XFIXNUM (t.hz) + - (XFIXNUM (t.ticks) % XFIXNUM (t.hz) < 0)); + mpz_fdiv_q (mpz[0], + *bignum_integer (&mpz[0], t.ticks), + *bignum_integer (&mpz[1], t.hz)); + return make_integer_mpz (); +} + +/* Convert T to a Lisp timestamp. */ +Lisp_Object +make_lisp_time (struct timespec t) +{ + if (CURRENT_TIME_LIST) + { + time_t s = t.tv_sec; + int ns = t.tv_nsec; + return list4 (hi_time (s), lo_time (s), + make_fixnum (ns / 1000), make_fixnum (ns % 1000 * 1000)); + } + else + return Fcons (timespec_ticks (t), timespec_hz); +} + +/* Convert T to a Lisp timestamp. FORM specifies the timestamp format. */ +static Lisp_Object +time_form_stamp (time_t t, Lisp_Object form) +{ + if (NILP (form)) + form = CURRENT_TIME_LIST ? Qlist : Qt; + if (EQ (form, Qlist)) + return list2 (hi_time (t), lo_time (t)); + if (EQ (form, Qt) || EQ (form, Qinteger)) + return INT_TO_INTEGER (t); + return Fcons (time_hz_ticks (t, form), form); +} +static Lisp_Object +lisp_time_form_stamp (struct lisp_time t, Lisp_Object form) +{ + if (NILP (form)) + form = CURRENT_TIME_LIST ? Qlist : Qt; + if (EQ (form, Qlist)) + return ticks_hz_list4 (t.ticks, t.hz); + if (EQ (form, Qinteger)) + return lisp_time_seconds (t); + if (EQ (form, Qt)) + form = t.hz; + return Fcons (lisp_time_hz_ticks (t, form), form); +} + +/* From what should be a valid timestamp (TICKS . HZ), generate the + corresponding time values. If RESULT is not null, store into *RESULT the converted time. - If *DRESULT is not null, store into *DRESULT the number of - seconds since the start of the POSIX Epoch. + Otherwise, store into *DRESULT the number of seconds since the + start of the POSIX Epoch. Unsuccessful calls may or may not store + results. - Return 1 if successful, 0 if the components are of the - wrong type, and -1 if the time is out of range. */ -int -decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec, - Lisp_Object psec, - struct lisp_time *result, double *dresult) + Return true if successful, false if (TICKS . HZ) would not + be a valid new-format timestamp. */ +static bool +decode_ticks_hz (Lisp_Object ticks, Lisp_Object hz, + struct lisp_time *result, double *dresult) { - EMACS_INT hi, us, ps; - intmax_t lo; - if (! (FIXNUMP (high) - && FIXNUMP (usec) && FIXNUMP (psec))) - return 0; - if (! INTEGERP (low)) + int ns; + mpz_t *q = &mpz[0]; + + if (! (INTEGERP (ticks) + && ((FIXNUMP (hz) && 0 < XFIXNUM (hz)) + || (BIGNUMP (hz) && 0 < mpz_sgn (XBIGNUM (hz)->value))))) + return false; + + if (result) { - if (FLOATP (low)) + result->ticks = ticks; + result->hz = hz; + } + else + { + if (FASTER_TIMEFNS && EQ (hz, timespec_hz)) { - double t = XFLOAT_DATA (low); - if (result && ! decode_float_time (t, result)) - return -1; - if (dresult) - *dresult = t; - return 1; - } - else if (NILP (low)) - { - struct timespec now = current_timespec (); - if (result) + if (FIXNUMP (ticks)) { - result->hi = hi_time (now.tv_sec); - result->lo = lo_time (now.tv_sec); - result->us = now.tv_nsec / 1000; - result->ps = now.tv_nsec % 1000 * 1000; + verify (1 < TIMESPEC_HZ); + EMACS_INT s = XFIXNUM (ticks) / TIMESPEC_HZ; + ns = XFIXNUM (ticks) % TIMESPEC_HZ; + if (ns < 0) + s--, ns += TIMESPEC_HZ; + *dresult = s_ns_to_double (s, ns); + return true; } - if (dresult) - *dresult = now.tv_sec + now.tv_nsec / 1e9; - return 1; + ns = mpz_fdiv_q_ui (*q, XBIGNUM (ticks)->value, TIMESPEC_HZ); + } + else if (FASTER_TIMEFNS && EQ (hz, make_fixnum (1))) + { + ns = 0; + if (FIXNUMP (ticks)) + { + *dresult = XFIXNUM (ticks); + return true; + } + q = &XBIGNUM (ticks)->value; } else - return 0; + { + mpz_mul_ui (*q, *bignum_integer (&mpz[1], ticks), TIMESPEC_HZ); + mpz_fdiv_q (*q, *q, *bignum_integer (&mpz[1], hz)); + ns = mpz_fdiv_q_ui (*q, *q, TIMESPEC_HZ); + } + + *dresult = s_ns_to_double (mpz_get_d (*q), ns); } - hi = XFIXNUM (high); - if (! integer_to_intmax (low, &lo)) - return -1; - us = XFIXNUM (usec); - ps = XFIXNUM (psec); + return true; +} + +/* Lisp timestamp classification. */ +enum timeform + { + TIMEFORM_INVALID = 0, + TIMEFORM_HI_LO, /* seconds in the form (HI << LO_TIME_BITS) + LO. */ + TIMEFORM_HI_LO_US, /* seconds plus microseconds (HI LO US) */ + TIMEFORM_NIL, /* current time in nanoseconds */ + TIMEFORM_HI_LO_US_PS, /* seconds plus micro and picoseconds (HI LO US PS) */ + TIMEFORM_FLOAT, /* time as a float */ + TIMEFORM_TICKS_HZ /* fractional time: HI is ticks, LO is ticks per second */ + }; + +/* From the valid form FORM and the time components HIGH, LOW, USEC + and PSEC, generate the corresponding time value. If LOW is + floating point, the other components should be zero and FORM should + not be TIMEFORM_TICKS_HZ. + + If RESULT is not null, store into *RESULT the converted time. + Otherwise, store into *DRESULT the number of seconds since the + start of the POSIX Epoch. Unsuccessful calls may or may not store + results. + + Return true if successful, false if the components are of the wrong + type. */ +static bool +decode_time_components (enum timeform form, + Lisp_Object high, Lisp_Object low, + Lisp_Object usec, Lisp_Object psec, + struct lisp_time *result, double *dresult) +{ + switch (form) + { + case TIMEFORM_INVALID: + return false; + + case TIMEFORM_TICKS_HZ: + return decode_ticks_hz (high, low, result, dresult); + + case TIMEFORM_FLOAT: + { + double t = XFLOAT_DATA (low); + if (result) + return decode_float_time (t, result); + else + { + *dresult = t; + return true; + } + } + + case TIMEFORM_NIL: + { + struct timespec now = current_timespec (); + if (result) + { + result->ticks = timespec_ticks (now); + result->hz = timespec_hz; + } + else + *dresult = s_ns_to_double (now.tv_sec, now.tv_nsec); + return true; + } + + default: + break; + } + + if (! (INTEGERP (high) && INTEGERP (low) + && FIXNUMP (usec) && FIXNUMP (psec))) + return false; + EMACS_INT us = XFIXNUM (usec); + EMACS_INT ps = XFIXNUM (psec); /* Normalize out-of-range lower-order components by carrying each overflow into the next higher-order component. */ us += ps / 1000000 - (ps % 1000000 < 0); - lo += us / 1000000 - (us % 1000000 < 0); - if (INT_ADD_WRAPV (lo >> LO_TIME_BITS, hi, &hi)) - return -1; + mpz_set_intmax (mpz[0], us / 1000000 - (us % 1000000 < 0)); + mpz_add (mpz[0], mpz[0], *bignum_integer (&mpz[1], low)); + mpz_addmul_ui (mpz[0], *bignum_integer (&mpz[1], high), 1 << LO_TIME_BITS); ps = ps % 1000000 + 1000000 * (ps % 1000000 < 0); us = us % 1000000 + 1000000 * (us % 1000000 < 0); - lo &= (1 << LO_TIME_BITS) - 1; if (result) { - if (FIXNUM_OVERFLOW_P (hi)) - return -1; - result->hi = hi; - result->lo = lo; - result->us = us; - result->ps = ps; - } + switch (form) + { + case TIMEFORM_HI_LO: + /* Floats and nil were handled above, so it was an integer. */ + result->hz = make_fixnum (1); + break; - if (dresult) - { - double dhi = hi; - *dresult = (us * 1e6 + ps) / 1e12 + lo + dhi * (1 << LO_TIME_BITS); - } + case TIMEFORM_HI_LO_US: + mpz_mul_ui (mpz[0], mpz[0], 1000000); + mpz_add_ui (mpz[0], mpz[0], us); + result->hz = make_fixnum (1000000); + break; - return 1; + case TIMEFORM_HI_LO_US_PS: + mpz_mul_ui (mpz[0], mpz[0], 1000000); + mpz_add_ui (mpz[0], mpz[0], us); + mpz_mul_ui (mpz[0], mpz[0], 1000000); + mpz_add_ui (mpz[0], mpz[0], ps); + result->hz = trillion; + break; + + default: + eassume (false); + } + result->ticks = make_integer_mpz (); + } + else + *dresult = mpz_get_d (mpz[0]) + (us * 1e6L + ps) / 1e12L; + + return true; } -struct timespec +enum { DECODE_SECS_ONLY = WARN_OBSOLETE_TIMESTAMPS + 1 }; + +/* Decode a Lisp timestamp SPECIFIED_TIME that represents a time. + + FLAGS specifies conversion flags. If FLAGS & DECODE_SECS_ONLY, + ignore and do not validate any sub-second components of an + old-format SPECIFIED_TIME. If FLAGS & WARN_OBSOLETE_TIMESTAMPS, + diagnose what could be obsolete (HIGH . LOW) timestamps. + + If PFORM is not null, store into *PFORM the form of SPECIFIED-TIME. + If RESULT is not null, store into *RESULT the converted time; + otherwise, store into *DRESULT the number of seconds since the + start of the POSIX Epoch. Unsuccessful calls may or may not store + results. + + Return true if successful, false if SPECIFIED_TIME is + not a valid Lisp timestamp. */ +static bool +decode_lisp_time (Lisp_Object specified_time, int flags, + enum timeform *pform, + struct lisp_time *result, double *dresult) +{ + Lisp_Object high = make_fixnum (0); + Lisp_Object low = specified_time; + Lisp_Object usec = make_fixnum (0); + Lisp_Object psec = make_fixnum (0); + enum timeform form = TIMEFORM_HI_LO; + + if (NILP (specified_time)) + form = TIMEFORM_NIL; + else if (FLOATP (specified_time)) + form = TIMEFORM_FLOAT; + else if (CONSP (specified_time)) + { + high = XCAR (specified_time); + low = XCDR (specified_time); + if (CONSP (low)) + { + Lisp_Object low_tail = XCDR (low); + low = XCAR (low); + if (! (flags & DECODE_SECS_ONLY)) + { + if (CONSP (low_tail)) + { + usec = XCAR (low_tail); + low_tail = XCDR (low_tail); + if (CONSP (low_tail)) + { + psec = XCAR (low_tail); + form = TIMEFORM_HI_LO_US_PS; + } + else + form = TIMEFORM_HI_LO_US; + } + else if (!NILP (low_tail)) + { + usec = low_tail; + form = TIMEFORM_HI_LO_US; + } + } + } + else + { + if (flags & WARN_OBSOLETE_TIMESTAMPS + && RANGED_FIXNUMP (0, low, (1 << LO_TIME_BITS) - 1)) + message ("obsolete timestamp with cdr %"pI"d", XFIXNUM (low)); + form = TIMEFORM_TICKS_HZ; + } + + /* Require LOW to be an integer, as otherwise the computation + would be considerably trickier. */ + if (! INTEGERP (low)) + form = TIMEFORM_INVALID; + } + + if (pform) + *pform = form; + return decode_time_components (form, high, low, usec, psec, result, dresult); +} + +/* Convert Z to time_t, returning true if it fits. */ +static bool +mpz_time (mpz_t const z, time_t *t) +{ + if (TYPE_SIGNED (time_t)) + { + intmax_t i; + if (! (mpz_to_intmax (z, &i) && TIME_T_MIN <= i && i <= TIME_T_MAX)) + return false; + *t = i; + } + else + { + uintmax_t i; + if (! (mpz_to_uintmax (z, &i) && i <= TIME_T_MAX)) + return false; + *t = i; + } + return true; +} + +/* Convert T to struct timespec, returning an invalid timespec + if T does not fit. */ +static struct timespec lisp_to_timespec (struct lisp_time t) { - if (! ((TYPE_SIGNED (time_t) ? TIME_T_MIN >> LO_TIME_BITS <= t.hi : 0 <= t.hi) - && t.hi <= TIME_T_MAX >> LO_TIME_BITS)) - return invalid_timespec (); - time_t s = (t.hi << LO_TIME_BITS) + t.lo; - int ns = t.us * 1000 + t.ps / 1000; - return make_timespec (s, ns); + struct timespec result = invalid_timespec (); + int ns; + mpz_t *q = &mpz[0]; + + if (FASTER_TIMEFNS && EQ (t.hz, timespec_hz)) + { + if (FIXNUMP (t.ticks)) + { + EMACS_INT s = XFIXNUM (t.ticks) / TIMESPEC_HZ; + ns = XFIXNUM (t.ticks) % TIMESPEC_HZ; + if (ns < 0) + s--, ns += TIMESPEC_HZ; + if ((TYPE_SIGNED (time_t) ? TIME_T_MIN <= s : 0 <= s) + && s <= TIME_T_MAX) + { + result.tv_sec = s; + result.tv_nsec = ns; + } + return result; + } + else + ns = mpz_fdiv_q_ui (*q, XBIGNUM (t.ticks)->value, TIMESPEC_HZ); + } + else if (FASTER_TIMEFNS && EQ (t.hz, make_fixnum (1))) + { + ns = 0; + if (FIXNUMP (t.ticks)) + { + EMACS_INT s = XFIXNUM (t.ticks); + if ((TYPE_SIGNED (time_t) ? TIME_T_MIN <= s : 0 <= s) + && s <= TIME_T_MAX) + { + result.tv_sec = s; + result.tv_nsec = ns; + } + return result; + } + else + q = &XBIGNUM (t.ticks)->value; + } + else + { + mpz_mul_ui (*q, *bignum_integer (q, t.ticks), TIMESPEC_HZ); + mpz_fdiv_q (*q, *q, *bignum_integer (&mpz[1], t.hz)); + ns = mpz_fdiv_q_ui (*q, *q, TIMESPEC_HZ); + } + + if (mpz_time (*q, &result.tv_sec)) + result.tv_nsec = ns; + return result; +} + +/* Convert (HIGH LOW USEC PSEC) to struct timespec. + Return true if successful. */ +bool +list4_to_timespec (Lisp_Object high, Lisp_Object low, + Lisp_Object usec, Lisp_Object psec, + struct timespec *result) +{ + struct lisp_time t; + if (! decode_time_components (TIMEFORM_HI_LO_US_PS, high, low, usec, psec, + &t, 0)) + return false; + *result = lisp_to_timespec (t); + return timespec_valid_p (*result); } /* Decode a Lisp list SPECIFIED_TIME that represents a time. - Store its effective length into *PLEN. If SPECIFIED_TIME is nil, use the current time. Signal an error if SPECIFIED_TIME does not represent a time. */ static struct lisp_time -lisp_time_struct (Lisp_Object specified_time, int *plen) +lisp_time_struct (Lisp_Object specified_time, enum timeform *pform) { - Lisp_Object high, low, usec, psec; + int flags = WARN_OBSOLETE_TIMESTAMPS; struct lisp_time t; - int len = disassemble_lisp_time (specified_time, &high, &low, &usec, &psec); - if (!len) + if (! decode_lisp_time (specified_time, flags, pform, &t, 0)) invalid_time (); - int val = decode_time_components (high, low, usec, psec, &t, 0); - check_time_validity (val); - *plen = len; return t; } -/* Like lisp_time_struct, except return a struct timespec. - Discard any low-order digits. */ +/* Decode a Lisp list SPECIFIED_TIME that represents a time. + Discard any low-order (sub-ns) resolution. + If SPECIFIED_TIME is nil, use the current time. + Signal an error if SPECIFIED_TIME does not represent a timespec. */ struct timespec lisp_time_argument (Lisp_Object specified_time) { - int len; - struct lisp_time lt = lisp_time_struct (specified_time, &len); + struct lisp_time lt = lisp_time_struct (specified_time, 0); struct timespec t = lisp_to_timespec (lt); if (! timespec_valid_p (t)) time_overflow (); return t; } -/* Like lisp_time_argument, except decode only the seconds part, - and do not check the subseconds part. */ +/* Like lisp_time_argument, except decode only the seconds part, and + do not check the subseconds part. */ static time_t lisp_seconds_argument (Lisp_Object specified_time) { - Lisp_Object high, low, usec, psec; - struct lisp_time t; - - int val = disassemble_lisp_time (specified_time, &high, &low, &usec, &psec); - if (val != 0) - { - val = decode_time_components (high, low, make_fixnum (0), - make_fixnum (0), &t, 0); - if (0 < val - && ! ((TYPE_SIGNED (time_t) - ? TIME_T_MIN >> LO_TIME_BITS <= t.hi - : 0 <= t.hi) - && t.hi <= TIME_T_MAX >> LO_TIME_BITS)) - val = -1; - } - check_time_validity (val); - return (t.hi << LO_TIME_BITS) + t.lo; -} - -static struct lisp_time -time_add (struct lisp_time ta, struct lisp_time tb) -{ - EMACS_INT hi = ta.hi + tb.hi; - int lo = ta.lo + tb.lo; - int us = ta.us + tb.us; - int ps = ta.ps + tb.ps; - us += (1000000 <= ps); - ps -= (1000000 <= ps) * 1000000; - lo += (1000000 <= us); - us -= (1000000 <= us) * 1000000; - hi += (1 << LO_TIME_BITS <= lo); - lo -= (1 << LO_TIME_BITS <= lo) << LO_TIME_BITS; - return (struct lisp_time) { hi, lo, us, ps }; -} - -static struct lisp_time -time_subtract (struct lisp_time ta, struct lisp_time tb) -{ - EMACS_INT hi = ta.hi - tb.hi; - int lo = ta.lo - tb.lo; - int us = ta.us - tb.us; - int ps = ta.ps - tb.ps; - us -= (ps < 0); - ps += (ps < 0) * 1000000; - lo -= (us < 0); - us += (us < 0) * 1000000; - hi -= (lo < 0); - lo += (lo < 0) << LO_TIME_BITS; - return (struct lisp_time) { hi, lo, us, ps }; + int flags = WARN_OBSOLETE_TIMESTAMPS | DECODE_SECS_ONLY; + struct lisp_time lt; + if (! decode_lisp_time (specified_time, flags, 0, <, 0)) + invalid_time (); + struct timespec t = lisp_to_timespec (lt); + if (! timespec_valid_p (t)) + time_overflow (); + return t.tv_sec; } +/* Given Lisp operands A and B, add their values, and return the + result as a Lisp timestamp that is in (TICKS . HZ) form if either A + or B are in that form, (HI LO US PS) form otherwise. Subtract + instead of adding if SUBTRACT. */ static Lisp_Object time_arith (Lisp_Object a, Lisp_Object b, bool subtract) { @@ -627,45 +974,80 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract) if (FLOATP (b) && !isfinite (XFLOAT_DATA (b))) return subtract ? make_float (-XFLOAT_DATA (b)) : b; - int alen, blen; - struct lisp_time ta = lisp_time_struct (a, &alen); - struct lisp_time tb = lisp_time_struct (b, &blen); - struct lisp_time t = (subtract ? time_subtract : time_add) (ta, tb); - if (FIXNUM_OVERFLOW_P (t.hi)) - time_overflow (); - Lisp_Object val = Qnil; + enum timeform aform, bform; + struct lisp_time ta = lisp_time_struct (a, &aform); + struct lisp_time tb = lisp_time_struct (b, &bform); + Lisp_Object ticks, hz; - switch (max (alen, blen)) + if (FASTER_TIMEFNS && EQ (ta.hz, tb.hz)) { - default: - val = Fcons (make_fixnum (t.ps), val); - FALLTHROUGH; - case 3: - val = Fcons (make_fixnum (t.us), val); - FALLTHROUGH; - case 2: - val = Fcons (make_fixnum (t.lo), val); - val = Fcons (make_fixnum (t.hi), val); - break; + hz = ta.hz; + if (FIXNUMP (ta.ticks) && FIXNUMP (tb.ticks)) + ticks = make_int (subtract + ? XFIXNUM (ta.ticks) - XFIXNUM (tb.ticks) + : XFIXNUM (ta.ticks) + XFIXNUM (tb.ticks)); + else + { + (subtract ? mpz_sub : mpz_add) + (mpz[0], + *bignum_integer (&mpz[0], ta.ticks), + *bignum_integer (&mpz[1], tb.ticks)); + ticks = make_integer_mpz (); + } + } + else + { + /* The plan is to decompose ta into na/da and tb into nb/db. + Start by computing da and db. */ + mpz_t *da = bignum_integer (&mpz[1], ta.hz); + mpz_t *db = bignum_integer (&mpz[2], tb.hz); + + /* The plan is to compute (na * (db/g) + nb * (da/g)) / lcm (da, db) + where g = gcd (da, db). Start by computing g. */ + mpz_t *g = &mpz[3]; + mpz_gcd (*g, *da, *db); + + /* fa = da/g, fb = db/g. */ + mpz_t *fa = &mpz[1], *fb = &mpz[3]; + mpz_tdiv_q (*fa, *da, *g); + mpz_tdiv_q (*fb, *db, *g); + + /* FIXME: Maybe omit need for extra temp by computing fa * db here? */ + + /* hz = fa * db. This is equal to lcm (da, db). */ + mpz_mul (mpz[0], *fa, *db); + hz = make_integer_mpz (); + + /* ticks = (fb * na) OPER (fa * nb), where OPER is + or -. + OP is the multiply-add or multiply-sub form of OPER. */ + mpz_t *na = bignum_integer (&mpz[0], ta.ticks); + mpz_mul (mpz[0], *fb, *na); + mpz_t *nb = bignum_integer (&mpz[3], tb.ticks); + (subtract ? mpz_submul : mpz_addmul) (mpz[0], *fa, *nb); + ticks = make_integer_mpz (); } - return val; + /* Return the (TICKS . HZ) form if either argument is that way, + otherwise the (HI LO US PS) form for backward compatibility. */ + return (aform == TIMEFORM_TICKS_HZ || bform == TIMEFORM_TICKS_HZ + ? Fcons (ticks, hz) + : ticks_hz_list4 (ticks, hz)); } DEFUN ("time-add", Ftime_add, Stime_add, 2, 2, 0, - doc: /* Return the sum of two time values A and B, as a time value. -A nil value for either argument stands for the current time. -See `current-time-string' for the various forms of a time value. */) + doc: /* Return the sum of two time values A and B, as a timestamp. +See Info node `(elisp)Time of Day' for time value formats. +For example, nil stands for the current time. */) (Lisp_Object a, Lisp_Object b) { return time_arith (a, b, false); } DEFUN ("time-subtract", Ftime_subtract, Stime_subtract, 2, 2, 0, - doc: /* Return the difference between two time values A and B, as a time value. -Use `float-time' to convert the difference into elapsed seconds. -A nil value for either argument stands for the current time. -See `current-time-string' for the various forms of a time value. */) + doc: /* Return the difference between two time values A and B, as a timestamp. +You can use `float-time' to convert the difference into elapsed seconds. +See Info node `(elisp)Time of Day' for time value formats. +For example, nil stands for the current time. */) (Lisp_Object a, Lisp_Object b) { return time_arith (a, b, true); @@ -685,54 +1067,52 @@ time_cmp (Lisp_Object a, Lisp_Object b) return da < db ? -1 : da != db; } - int alen, blen; - struct lisp_time ta = lisp_time_struct (a, &alen); - struct lisp_time tb = lisp_time_struct (b, &blen); - return (ta.hi != tb.hi ? (ta.hi < tb.hi ? -1 : 1) - : ta.lo != tb.lo ? (ta.lo < tb.lo ? -1 : 1) - : ta.us != tb.us ? (ta.us < tb.us ? -1 : 1) - : ta.ps < tb.ps ? -1 : ta.ps != tb.ps); + struct lisp_time ta = lisp_time_struct (a, 0); + + /* Compare nil to nil correctly, and other eq values while we're at it. + Compare here rather than earlier, to handle NaNs and check formats. */ + if (EQ (a, b)) + return 0; + + struct lisp_time tb = lisp_time_struct (b, 0); + mpz_t *za = bignum_integer (&mpz[0], ta.ticks); + mpz_t *zb = bignum_integer (&mpz[1], tb.ticks); + if (! (FASTER_TIMEFNS && EQ (ta.hz, tb.hz))) + { + /* This could be sped up by looking at the signs, sizes, and + number of bits of the two sides; see how GMP does mpq_cmp. + It may not be worth the trouble here, though. */ + mpz_mul (mpz[0], *za, *bignum_integer (&mpz[2], tb.hz)); + mpz_mul (mpz[1], *zb, *bignum_integer (&mpz[2], ta.hz)); + za = &mpz[0]; + zb = &mpz[1]; + } + return mpz_cmp (*za, *zb); } DEFUN ("time-less-p", Ftime_less_p, Stime_less_p, 2, 2, 0, - doc: /* Return non-nil if time value T1 is earlier than time value T2. -A nil value for either argument stands for the current time. -See `current-time-string' for the various forms of a time value. */) - (Lisp_Object t1, Lisp_Object t2) + doc: /* Return non-nil if time value A is less than time value B. +See Info node `(elisp)Time of Day' for time value formats. +For example, nil stands for the current time. */) + (Lisp_Object a, Lisp_Object b) { - return time_cmp (t1, t2) < 0 ? Qt : Qnil; + return time_cmp (a, b) < 0 ? Qt : Qnil; } DEFUN ("time-equal-p", Ftime_equal_p, Stime_equal_p, 2, 2, 0, - doc: /* Return non-nil if T1 and T2 are equal time values. -A nil value for either argument stands for the current time. -See `current-time-string' for the various forms of a time value. */) - (Lisp_Object t1, Lisp_Object t2) + doc: /* Return non-nil if A and B are equal time values. +See Info node `(elisp)Time of Day' for time value formats. */) + (Lisp_Object a, Lisp_Object b) { - return time_cmp (t1, t2) == 0 ? Qt : Qnil; + return time_cmp (a, b) == 0 ? Qt : Qnil; } -/* Make a Lisp list that represents the Emacs time T. T may be an - invalid time, with a slightly negative tv_nsec value such as - UNKNOWN_MODTIME_NSECS; in that case, the Lisp list contains a - correspondingly negative picosecond count. */ -Lisp_Object -make_lisp_time (struct timespec t) -{ - time_t s = t.tv_sec; - int ns = t.tv_nsec; - return list4i (hi_time (s), lo_time (s), ns / 1000, ns % 1000 * 1000); -} - DEFUN ("float-time", Ffloat_time, Sfloat_time, 0, 1, 0, doc: /* Return the current time, as a float number of seconds since the epoch. -If SPECIFIED-TIME is given, it is the time to convert to float -instead of the current time. The argument should have the form -\(HIGH LOW) or (HIGH LOW USEC) or (HIGH LOW USEC PSEC). Thus, -you can use times from `current-time' and from `file-attributes'. -SPECIFIED-TIME can also have the form (HIGH . LOW), but this is -considered obsolete. +If SPECIFIED-TIME is given, it is a Lisp time value to convert to +float instead of the current time. See Info node `(elisp)Time of Day' +for time value formats. WARNING: Since the result is floating point, it may not be exact. If precise time stamps are required, use either `current-time', @@ -740,9 +1120,7 @@ or (if you need time as a string) `format-time-string'. */) (Lisp_Object specified_time) { double t; - Lisp_Object high, low, usec, psec; - if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec) - && decode_time_components (high, low, usec, psec, 0, &t))) + if (! decode_lisp_time (specified_time, 0, 0, 0, &t)) invalid_time (); return make_float (t); } @@ -849,10 +1227,7 @@ format_time_string (char const *format, ptrdiff_t formatlen, DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0, doc: /* Use FORMAT-STRING to format the time TIME, or now if omitted or nil. -TIME is specified as (HIGH LOW USEC PSEC), as returned by -`current-time' or `file-attributes'. It can also be a single integer -number of seconds since the epoch. The obsolete form (HIGH . LOW) is -also still accepted. +TIME is a Lisp time value; see Info node `(elisp)Time of Day'. The optional ZONE is omitted or nil for Emacs local time, t for Universal Time, `wall' for system wall clock time, or a string as in @@ -925,10 +1300,8 @@ usage: (format-time-string FORMAT-STRING &optional TIME ZONE) */) DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 2, 0, doc: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST UTCOFF). -The optional TIME should be a list of (HIGH LOW . IGNORED), -as from `current-time' and `file-attributes', or nil to use the -current time. It can also be a single integer number of seconds since -the epoch. The obsolete form (HIGH . LOW) is also still accepted. +The optional TIME is the Lisp time value to convert. See Info node +`(elisp)Time of Day' for time value formats. The optional ZONE is omitted or nil for Emacs local time, t for Universal Time, `wall' for system wall clock time, or a string as in @@ -983,32 +1356,71 @@ usage: (decode-time &optional TIME ZONE) */) } /* Return OBJ - OFFSET, checking that OBJ is a valid fixnum and that - the result is representable as an int. */ + the result is representable as an int. 0 <= OFFSET <= TM_YEAR_BASE. */ static int check_tm_member (Lisp_Object obj, int offset) { - CHECK_FIXNUM (obj); - EMACS_INT n = XFIXNUM (obj); - int result; - if (INT_SUBTRACT_WRAPV (n, offset, &result)) - time_overflow (); - return result; + if (FASTER_TIMEFNS && INT_MAX <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE) + { + CHECK_FIXNUM (obj); + EMACS_INT n = XFIXNUM (obj); + int i; + if (INT_SUBTRACT_WRAPV (n, offset, &i)) + time_overflow (); + return i; + } + else + { + CHECK_INTEGER (obj); + mpz_sub_ui (mpz[0], *bignum_integer (&mpz[0], obj), offset); + intmax_t i; + if (! (mpz_to_intmax (mpz[0], &i) && INT_MIN <= i && i <= INT_MAX)) + time_overflow (); + return i; + } } -DEFUN ("encode-time", Fencode_time, Sencode_time, 6, MANY, 0, - doc: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time. -This is the reverse operation of `decode-time', which see. +DEFUN ("encode-time", Fencode_time, Sencode_time, 1, MANY, 0, + doc: /* Convert TIME to a timestamp. +Optional FORM specifies how the returned value should be encoded. +This can act as the reverse operation of `decode-time', which see. -The optional ZONE is omitted or nil for Emacs local time, t for -Universal Time, `wall' for system wall clock time, or a string as in -the TZ environment variable. It can also be a list (as from +If TIME is a list (SECOND MINUTE HOUR DAY MONTH YEAR IGNORED DST ZONE) +it a decoded time in the style of `decode-time', so that (encode-time +(decode-time ...)) works. TIME can also be a Lisp time value; see +Info node `(elisp)Time of Day'. + +If FORM is a positive integer, the time is returned as a pair of +integers (TICKS . FORM), where TICKS is the number of clock ticks and FORM +is the clock frequency in ticks per second. (Currently the positive +integer should be at least 65536 if the returned value is expected to +be given to standard functions expecting Lisp timestamps.) If FORM is +t, the time is returned as (TICKS . PHZ), where PHZ is a +platform-dependent clock frequency. If FORM is `integer', the time is +returned as an integer count of seconds. If FORM is `list', the time is +returned as an integer list (HIGH LOW USEC PSEC), where HIGH has the +most significant bits of the seconds, LOW has the least significant 16 +bits, and USEC and PSEC are the microsecond and picosecond counts. +Returned values are rounded toward minus infinity. Although an +omitted or nil FORM currently acts like `list', this is planned to +change, so callers requiring list timestamps should specify `list'. + +As an obsolescent calling convention, the first 6 arguments SECOND, +MINUTE, HOUR, DAY, MONTH, and YEAR specify the components of a decoded +time, where DST assumed to be -1 and FORM is omitted. If there are more +than 6 arguments the *last* argument is used as ZONE and any other +extra arguments are ignored, so that (apply \\='encode-time +(decode-time ...)) works; otherwise ZONE is assumed to be nil. + +If the input is a decoded time, ZONE is nil for Emacs local time, t +for Universal Time, `wall' for system wall clock time, or a string as +in the TZ environment variable. It can also be a list (as from `current-time-zone') or an integer (as from `decode-time') applied without consideration for daylight saving time. -You can pass more than 7 arguments; then the first six arguments -are used as SECOND through YEAR, and the *last* argument is used as ZONE. -The intervening arguments are ignored. -This feature lets (apply \\='encode-time (decode-time ...)) work. +If the input is a decoded time and ZONE specifies a time zone with +daylight-saving transitions, DST is t for daylight saving time and nil +for standard time. If DST is -1, the daylight saving flag is guessed. Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed; for example, a DAY of 0 means the day preceding the given month. @@ -1018,21 +1430,55 @@ If you want them to stand for years in this century, you must do that yourself. Years before 1970 are not guaranteed to work. On some systems, year values as low as 1901 do work. -usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */) +usage: (encode-time TIME &optional FORM) */) (ptrdiff_t nargs, Lisp_Object *args) { time_t value; struct tm tm; - Lisp_Object zone = (nargs > 6 ? args[nargs - 1] : Qnil); - - tm.tm_sec = check_tm_member (args[0], 0); - tm.tm_min = check_tm_member (args[1], 0); - tm.tm_hour = check_tm_member (args[2], 0); - tm.tm_mday = check_tm_member (args[3], 0); - tm.tm_mon = check_tm_member (args[4], 1); - tm.tm_year = check_tm_member (args[5], TM_YEAR_BASE); + Lisp_Object form = Qnil, zone = Qnil; + Lisp_Object a = args[0]; tm.tm_isdst = -1; + if (nargs <= 2) + { + if (nargs == 2) + form = args[1]; + Lisp_Object tail = a; + for (int i = 0; i < 9; i++, tail = XCDR (tail)) + if (! CONSP (tail)) + { + struct lisp_time t; + if (! decode_lisp_time (a, 0, 0, &t, 0)) + invalid_time (); + return lisp_time_form_stamp (t, form); + } + tm.tm_sec = check_tm_member (XCAR (a), 0); a = XCDR (a); + tm.tm_min = check_tm_member (XCAR (a), 0); a = XCDR (a); + tm.tm_hour = check_tm_member (XCAR (a), 0); a = XCDR (a); + tm.tm_mday = check_tm_member (XCAR (a), 0); a = XCDR (a); + tm.tm_mon = check_tm_member (XCAR (a), 1); a = XCDR (a); + tm.tm_year = check_tm_member (XCAR (a), TM_YEAR_BASE); a = XCDR (a); + a = XCDR (a); + if (SYMBOLP (XCAR (a))) + tm.tm_isdst = !NILP (XCAR (a)); + a = XCDR (a); + zone = XCAR (a); + } + else if (nargs < 6) + xsignal2 (Qwrong_number_of_arguments, Qencode_time, make_fixnum (nargs)); + else + { + if (6 < nargs) + zone = args[nargs - 1]; + form = Qnil; + tm.tm_sec = check_tm_member (a, 0); + tm.tm_min = check_tm_member (args[1], 0); + tm.tm_hour = check_tm_member (args[2], 0); + tm.tm_mday = check_tm_member (args[3], 0); + tm.tm_mon = check_tm_member (args[4], 1); + tm.tm_year = check_tm_member (args[5], TM_YEAR_BASE); + } + timezone_t tz = tzlookup (zone, false); value = emacs_mktime_z (tz, &tm); xtzfree (tz); @@ -1040,15 +1486,17 @@ usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */) if (value == (time_t) -1) time_overflow (); - return list2i (hi_time (value), lo_time (value)); + return time_form_stamp (value, form); } DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0, - doc: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00. -The time is returned as a list of integers (HIGH LOW USEC PSEC). -HIGH has the most significant bits of the seconds, while LOW has the -least significant 16 bits. USEC and PSEC are the microsecond and -picosecond counts. */) + doc: /* Return the current time, counting the number of seconds since the epoch. + +See Info node `(elisp)Time of Day' for the format of the returned +timestamp. Although this is currently list format, it may change in +future versions of Emacs. Use `encode-time' if you need a particular +form; for example, (encode-time nil \\='list) returns the current time +in list form. */) (void) { return make_lisp_time (current_timespec ()); @@ -1064,12 +1512,9 @@ The format is `Sun Sep 16 01:03:52 1973'. However, see also the functions `decode-time' and `format-time-string' which provide a much more powerful and general facility. -If SPECIFIED-TIME is given, it is a time to format instead of the -current time. The argument should have the form (HIGH LOW . IGNORED). -Thus, you can use times obtained from `current-time' and from -`file-attributes'. SPECIFIED-TIME can also be a single integer number -of seconds since the epoch. The obsolete form (HIGH . LOW) is also -still accepted. +If SPECIFIED-TIME is given, it is the Lisp time value to format +instead of the current time. See Info node `(elisp)Time of Day' for +time value formats. The optional ZONE is omitted or nil for Emacs local time, t for Universal Time, `wall' for system wall clock time, or a string as in @@ -1113,11 +1558,8 @@ OFFSET is an integer number of seconds ahead of UTC (east of Greenwich). A negative value means west of Greenwich. NAME is a string giving the name of the time zone. If SPECIFIED-TIME is given, the time zone offset is determined from it -instead of using the current time. The argument should have the form -\(HIGH LOW . IGNORED). Thus, you can use times obtained from -`current-time' and from `file-attributes'. SPECIFIED-TIME can also be -a single integer number of seconds since the epoch. The obsolete form -(HIGH . LOW) is also still accepted. +instead of using the current time. The argument should be a Lisp +time value; see Info node `(elisp)Time of Day'. The optional ZONE is omitted or nil for Emacs local time, t for Universal Time, `wall' for system wall clock time, or a string as in @@ -1272,6 +1714,21 @@ emacs_setenv_TZ (const char *tzstring) void syms_of_timefns (void) { +#ifndef timespec_hz + timespec_hz = make_int (TIMESPEC_HZ); + staticpro (×pec_hz); +#endif +#ifndef trillion + trillion = make_int (1000000000000); + staticpro (&trillion); +#endif +#if (ULONG_MAX < TRILLION || !FASTER_TIMEFNS) && !defined ztrillion + mpz_init_set_ui (ztrillion, 1000000); + mpz_mul_ui (ztrillion, ztrillion, 1000000); +#endif + + DEFSYM (Qencode_time, "encode-time"); + defsubr (&Scurrent_time); defsubr (&Stime_add); defsubr (&Stime_subtract); diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el index 8418b509e17..435dcf7db70 100644 --- a/test/src/timefns-tests.el +++ b/test/src/timefns-tests.el @@ -77,3 +77,6 @@ (format-time-string "%Y-%m-%d %H:%M:%S" (- (ash 1 31) 3600) t) "2038-01-19 02:14:08") (timefns-tests--have-leap-seconds)))) + +(ert-deftest time-equal-p-nil-nil () + (should (time-equal-p nil nil))) From 3cc452327eff056f17637566aaf05a877e61d69a Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 3 Oct 2018 09:10:01 -0700 Subject: [PATCH 47/72] Improvements on (TICKS . HZ) This patch is in response to Eli's review (Bug#32902#10). * src/systime.c: Doc strings of affected functions now refer to format-time-string instead of to Lisp manual, and format-time-string's doc string covers time values. * test/src/systime-tests.el (format-time-string-with-zone): Check decode-time too. (decode-then-encode-time, time-arith-tests): New tests. --- doc/lispref/buffers.texi | 2 +- doc/lispref/os.texi | 14 ++--- src/timefns.c | 79 ++++++++++++++------------ test/src/timefns-tests.el | 116 +++++++++++++++++++++++++++++--------- 4 files changed, 140 insertions(+), 71 deletions(-) diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 8789a8d56f6..b2a4b0eab1a 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -654,7 +654,7 @@ If the buffer has no recorded last modification time, this function returns zero. This case occurs, for instance, if the buffer is not visiting a file or if the time has been explicitly cleared by @code{clear-visited-file-modtime}. Note, however, that -@code{visited-file-modtime} returns a list for some non-file buffers +@code{visited-file-modtime} returns a timestamp for some non-file buffers too. For instance, in a Dired buffer listing a directory, it returns the last modification time of that directory, as recorded by Dired. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index ea6915350e8..64c327c3809 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1457,14 +1457,14 @@ seconds east of Greenwich. @var{dow} and @var{utcoff}. @end defun -@defun encode-time time &optional form +@defun encode-time &optional time form &rest obsolescent-arguments This function converts @var{time} to a Lisp timestamp. It can act as the inverse of @code{decode-time}. -The first argument can be a Lisp time value such as @code{nil} for the -current time, a number of seconds, a pair @code{(@var{ticks} -. @var{hz})}, or a list @code{(@var{high} @var{low} @var{micro} -@var{pico})} (@pxref{Time of Day}). It can also be a list +The first argument can be a time value such as a number of seconds, a +pair @code{(@var{ticks} . @var{hz})}, a list @code{(@var{high} +@var{low} @var{micro} @var{pico})}, or @code{nil} (the default) for +the current time (@pxref{Time of Day}). It can also be a list @code{(@var{second} @var{minute} @var{hour} @var{day} @var{month} @var{year} @var{ignored} @var{dst} @var{zone})} that specifies a decoded time in the style of @code{decode-time}, so that @@ -1494,10 +1494,10 @@ or more arguments. The first six arguments @var{second}, specify most of the components of a decoded time. If there are more than six arguments the @emph{last} argument is used as @var{zone} and any other extra arguments are ignored, so that @code{(apply -'encode-time (decode-time ...))} works; otherwise @var{zone} defaults +#\\='encode-time (decode-time ...))} works; otherwise @var{zone} defaults to the current time zone rule (@pxref{Time Zone Rules}). The decoded time's @var{dst} component is treated as if it was @minus{}1, and -@var{form} so it takes its default value. +@var{form} takes its default value. Year numbers less than 100 are not treated specially. If you want them to stand for years above 1900, or years above 2000, you must alter them diff --git a/src/timefns.c b/src/timefns.c index 72cb54d3a0c..7bce3b1e500 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -1035,8 +1035,8 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract) } DEFUN ("time-add", Ftime_add, Stime_add, 2, 2, 0, - doc: /* Return the sum of two time values A and B, as a timestamp. -See Info node `(elisp)Time of Day' for time value formats. + doc: /* Return the sum of two time values A and B, as a time value. +See `format-time-string' for the various forms of a time value. For example, nil stands for the current time. */) (Lisp_Object a, Lisp_Object b) { @@ -1044,9 +1044,9 @@ For example, nil stands for the current time. */) } DEFUN ("time-subtract", Ftime_subtract, Stime_subtract, 2, 2, 0, - doc: /* Return the difference between two time values A and B, as a timestamp. + doc: /* Return the difference between two time values A and B, as a time value. You can use `float-time' to convert the difference into elapsed seconds. -See Info node `(elisp)Time of Day' for time value formats. +See `format-time-string' for the various forms of a time value. For example, nil stands for the current time. */) (Lisp_Object a, Lisp_Object b) { @@ -1092,7 +1092,7 @@ time_cmp (Lisp_Object a, Lisp_Object b) DEFUN ("time-less-p", Ftime_less_p, Stime_less_p, 2, 2, 0, doc: /* Return non-nil if time value A is less than time value B. -See Info node `(elisp)Time of Day' for time value formats. +See `format-time-string' for the various forms of a time value. For example, nil stands for the current time. */) (Lisp_Object a, Lisp_Object b) { @@ -1101,7 +1101,7 @@ For example, nil stands for the current time. */) DEFUN ("time-equal-p", Ftime_equal_p, Stime_equal_p, 2, 2, 0, doc: /* Return non-nil if A and B are equal time values. -See Info node `(elisp)Time of Day' for time value formats. */) +See `format-time-string' for the various forms of a time value. */) (Lisp_Object a, Lisp_Object b) { return time_cmp (a, b) == 0 ? Qt : Qnil; @@ -1110,12 +1110,12 @@ See Info node `(elisp)Time of Day' for time value formats. */) DEFUN ("float-time", Ffloat_time, Sfloat_time, 0, 1, 0, doc: /* Return the current time, as a float number of seconds since the epoch. -If SPECIFIED-TIME is given, it is a Lisp time value to convert to -float instead of the current time. See Info node `(elisp)Time of Day' -for time value formats. +If SPECIFIED-TIME is given, it is a time value to convert to float +instead of the current time. See `format-time-string' for the various +forms of a time value. WARNING: Since the result is floating point, it may not be exact. -If precise time stamps are required, use either `current-time', +If precise time stamps are required, use either `encode-time', or (if you need time as a string) `format-time-string'. */) (Lisp_Object specified_time) { @@ -1226,8 +1226,12 @@ format_time_string (char const *format, ptrdiff_t formatlen, } DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0, - doc: /* Use FORMAT-STRING to format the time TIME, or now if omitted or nil. -TIME is a Lisp time value; see Info node `(elisp)Time of Day'. + doc: /* Use FORMAT-STRING to format the time value TIME. +A time value that is omitted or nil stands for the current time, +a number stands for that many seconds, an integer pair (TICKS . HZ) +stands for TICKS/HZ seconds, and an integer list (HI LO US PS) stands +for HI*2**16 + LO + US/10**6 + PS/10**12 seconds. This function +treats seconds as time since the epoch of 1970-01-01 00:00:00 UTC. The optional ZONE is omitted or nil for Emacs local time, t for Universal Time, `wall' for system wall clock time, or a string as in @@ -1300,8 +1304,8 @@ usage: (format-time-string FORMAT-STRING &optional TIME ZONE) */) DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 2, 0, doc: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST UTCOFF). -The optional TIME is the Lisp time value to convert. See Info node -`(elisp)Time of Day' for time value formats. +The optional TIME is the time value to convert. See +`format-time-string' for the various forms of a time value. The optional ZONE is omitted or nil for Emacs local time, t for Universal Time, `wall' for system wall clock time, or a string as in @@ -1381,22 +1385,23 @@ check_tm_member (Lisp_Object obj, int offset) } DEFUN ("encode-time", Fencode_time, Sencode_time, 1, MANY, 0, - doc: /* Convert TIME to a timestamp. + doc: /* Convert optional TIME to a timestamp. Optional FORM specifies how the returned value should be encoded. This can act as the reverse operation of `decode-time', which see. If TIME is a list (SECOND MINUTE HOUR DAY MONTH YEAR IGNORED DST ZONE) -it a decoded time in the style of `decode-time', so that (encode-time -(decode-time ...)) works. TIME can also be a Lisp time value; see -Info node `(elisp)Time of Day'. +it is a decoded time in the style of `decode-time', so that (encode-time +(decode-time ...)) works. TIME can also be a time value. +See `format-time-string' for the various forms of a time value. +For example, an omitted TIME stands for the current time. If FORM is a positive integer, the time is returned as a pair of integers (TICKS . FORM), where TICKS is the number of clock ticks and FORM is the clock frequency in ticks per second. (Currently the positive integer should be at least 65536 if the returned value is expected to be given to standard functions expecting Lisp timestamps.) If FORM is -t, the time is returned as (TICKS . PHZ), where PHZ is a -platform-dependent clock frequency. If FORM is `integer', the time is +t, the time is returned as (TICKS . PHZ), where PHZ is a platform dependent +clock frequency in ticks per second. If FORM is `integer', the time is returned as an integer count of seconds. If FORM is `list', the time is returned as an integer list (HIGH LOW USEC PSEC), where HIGH has the most significant bits of the seconds, LOW has the least significant 16 @@ -1405,11 +1410,12 @@ Returned values are rounded toward minus infinity. Although an omitted or nil FORM currently acts like `list', this is planned to change, so callers requiring list timestamps should specify `list'. -As an obsolescent calling convention, the first 6 arguments SECOND, -MINUTE, HOUR, DAY, MONTH, and YEAR specify the components of a decoded -time, where DST assumed to be -1 and FORM is omitted. If there are more +As an obsolescent calling convention, if this function is called with +6 or more arguments, the first 6 arguments are SECOND, MINUTE, HOUR, +DAY, MONTH, and YEAR, and specify the components of a decoded time, +where DST assumed to be -1 and FORM is omitted. If there are more than 6 arguments the *last* argument is used as ZONE and any other -extra arguments are ignored, so that (apply \\='encode-time +extra arguments are ignored, so that (apply #\\='encode-time (decode-time ...)) works; otherwise ZONE is assumed to be nil. If the input is a decoded time, ZONE is nil for Emacs local time, t @@ -1430,7 +1436,7 @@ If you want them to stand for years in this century, you must do that yourself. Years before 1970 are not guaranteed to work. On some systems, year values as low as 1901 do work. -usage: (encode-time TIME &optional FORM) */) +usage: (encode-time &optional TIME FORM &rest OBSOLESCENT-ARGUMENTS) */) (ptrdiff_t nargs, Lisp_Object *args) { time_t value; @@ -1490,13 +1496,13 @@ usage: (encode-time TIME &optional FORM) */) } DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0, - doc: /* Return the current time, counting the number of seconds since the epoch. - -See Info node `(elisp)Time of Day' for the format of the returned -timestamp. Although this is currently list format, it may change in -future versions of Emacs. Use `encode-time' if you need a particular -form; for example, (encode-time nil \\='list) returns the current time -in list form. */) + doc: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00. +The time is returned as a list of integers (HIGH LOW USEC PSEC). +HIGH has the most significant bits of the seconds, while LOW has the +least significant 16 bits. USEC and PSEC are the microsecond and +picosecond counts. Use `encode-time' if you need a particular +timestamp form; for example, (encode-time nil \\='integer) returns the +current time in seconds. */) (void) { return make_lisp_time (current_timespec ()); @@ -1512,9 +1518,9 @@ The format is `Sun Sep 16 01:03:52 1973'. However, see also the functions `decode-time' and `format-time-string' which provide a much more powerful and general facility. -If SPECIFIED-TIME is given, it is the Lisp time value to format -instead of the current time. See Info node `(elisp)Time of Day' for -time value formats. +If SPECIFIED-TIME is given, it is the time value to format instead of +the current time. See `format-time-string' for the various forms of a +time value. The optional ZONE is omitted or nil for Emacs local time, t for Universal Time, `wall' for system wall clock time, or a string as in @@ -1559,7 +1565,8 @@ OFFSET is an integer number of seconds ahead of UTC (east of Greenwich). NAME is a string giving the name of the time zone. If SPECIFIED-TIME is given, the time zone offset is determined from it instead of using the current time. The argument should be a Lisp -time value; see Info node `(elisp)Time of Day'. +time value; see `format-time-string' for the various forms of a time +value. The optional ZONE is omitted or nil for Emacs local time, t for Universal Time, `wall' for system wall clock time, or a string as in diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el index 435dcf7db70..ebeb43de163 100644 --- a/test/src/timefns-tests.el +++ b/test/src/timefns-tests.el @@ -19,7 +19,7 @@ (require 'ert) -;;; Check format-time-string with various TZ settings. +;;; Check format-time-string and decode-time with various TZ settings. ;;; Use only POSIX-compatible TZ values, since the tests should work ;;; even if tzdb is not in use. (ert-deftest format-time-string-with-zone () @@ -35,32 +35,61 @@ ;; Similarly, stick to the limited set of time zones that are ;; supported by both POSIX and MS-Windows: exactly 3 ASCII letters ;; in the abbreviation, and no DST. - (let ((look '(1202 22527 999999 999999)) - (format "%Y-%m-%d %H:%M:%S.%3N %z (%Z)")) - ;; UTC. - (should (string-equal - (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" look t) - "1972-06-30 23:59:59.999 +0000")) - ;; "UTC0". - (should (string-equal - (format-time-string format look "UTC0") - "1972-06-30 23:59:59.999 +0000 (UTC)")) - ;; Negative UTC offset, as a Lisp list. - (should (string-equal - (format-time-string format look '(-28800 "PST")) - "1972-06-30 15:59:59.999 -0800 (PST)")) - ;; Negative UTC offset, as a Lisp integer. - (should (string-equal - (format-time-string format look -28800) - ;; MS-Windows build replaces unrecognizable TZ values, - ;; such as "-08", with "ZZZ". - (if (eq system-type 'windows-nt) - "1972-06-30 15:59:59.999 -0800 (ZZZ)" - "1972-06-30 15:59:59.999 -0800 (-08)"))) - ;; Positive UTC offset that is not an hour multiple, as a string. - (should (string-equal - (format-time-string format look "IST-5:30") - "1972-07-01 05:29:59.999 +0530 (IST)")))) + (let ((format "%Y-%m-%d %H:%M:%S.%3N %z (%Z)")) + (dolist (look '((1202 22527 999999 999999) + (7879679999900 . 100000) + (78796799999999999999 . 1000000000000))) + ;; UTC. + (should (string-equal + (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" look t) + "1972-06-30 23:59:59.999 +0000")) + (should (equal (decode-time look t) + '(59 59 23 30 6 1972 5 nil 0))) + ;; "UTC0". + (should (string-equal + (format-time-string format look "UTC0") + "1972-06-30 23:59:59.999 +0000 (UTC)")) + (should (equal (decode-time look "UTC0") + '(59 59 23 30 6 1972 5 nil 0))) + ;; Negative UTC offset, as a Lisp list. + (should (string-equal + (format-time-string format look '(-28800 "PST")) + "1972-06-30 15:59:59.999 -0800 (PST)")) + (should (equal (decode-time look '(-28800 "PST")) + '(59 59 15 30 6 1972 5 nil -28800))) + ;; Negative UTC offset, as a Lisp integer. + (should (string-equal + (format-time-string format look -28800) + ;; MS-Windows build replaces unrecognizable TZ values, + ;; such as "-08", with "ZZZ". + (if (eq system-type 'windows-nt) + "1972-06-30 15:59:59.999 -0800 (ZZZ)" + "1972-06-30 15:59:59.999 -0800 (-08)"))) + (should (equal (decode-time look -28800) + '(59 59 15 30 6 1972 5 nil -28800))) + ;; Positive UTC offset that is not an hour multiple, as a string. + (should (string-equal + (format-time-string format look "IST-5:30") + "1972-07-01 05:29:59.999 +0530 (IST)")) + (should (equal (decode-time look "IST-5:30") + '(59 29 5 1 7 1972 6 nil 19800)))))) + +(ert-deftest decode-then-encode-time () + (let ((time-values (list 0 -2 1 0.0 -0.0 -2.0 1.0 + most-negative-fixnum most-positive-fixnum + (1- most-negative-fixnum) + (1+ most-positive-fixnum) + 1e+INF -1e+INF 1e+NaN -1e+NaN + '(0 1 0 0) '(1 0 0 0) '(-1 0 0 0) + '(123456789000000 . 1000000) + (cons (1+ most-positive-fixnum) 1000000000000) + (cons 1000000000000 (1+ most-positive-fixnum))))) + (dolist (a time-values) + (let* ((d (ignore-errors (decode-time a t))) + (e (encode-time d)) + (diff (float-time (time-subtract a e)))) + (should (or (not d) + (and (<= 0 diff) (< diff 1)))))))) ;;; This should not dump core. (ert-deftest format-time-string-with-outlandish-zone () @@ -80,3 +109,36 @@ (ert-deftest time-equal-p-nil-nil () (should (time-equal-p nil nil))) + +(ert-deftest time-arith-tests () + (let ((time-values (list 0 -1 1 0.0 -0.0 -1.0 1.0 + most-negative-fixnum most-positive-fixnum + (1- most-negative-fixnum) + (1+ most-positive-fixnum) + 1e+INF -1e+INF 1e+NaN -1e+NaN + '(0 0 0 1) '(0 0 1 0) '(0 1 0 0) '(1 0 0 0) + '(-1 0 0 0) '(1 2 3 4) '(-1 2 3 4) + '(-123456789 . 100000) '(123456789 . 1000000) + (cons (1+ most-positive-fixnum) 1000000000000) + (cons 1000000000000 (1+ most-positive-fixnum))))) + (dolist (a time-values) + (dolist (b time-values) + (let ((aa (time-subtract (time-add a b) b))) + (should (or (time-equal-p a aa) (and (floatp aa) (isnan aa))))) + (should (= 1 (+ (if (time-less-p a b) 1 0) + (if (time-equal-p a b) 1 0) + (if (time-less-p b a) 1 0) + (if (or (and (floatp a) (isnan a)) + (and (floatp b) (isnan b))) + 1 0)))) + (should (or (not (time-less-p 0 b)) + (time-less-p a (time-add a b)) + (time-equal-p a (time-add a b)) + (and (floatp (time-add a b)) (isnan (time-add a b))))) + (let ((x (float-time (time-add a b))) + (y (+ (float-time a) (float-time b)))) + (should (or (and (isnan x) (isnan y)) + (= x y) + (< 0.99 (/ x y) 1.01) + (< 0.99 (/ (- (float-time a)) (float-time b)) + 1.01)))))))) From ee3f4698704c26c503064e15ad7a75b7d693b1e4 Mon Sep 17 00:00:00 2001 From: Scott Corley Date: Sun, 7 Oct 2018 00:10:29 -0700 Subject: [PATCH 48/72] Fix overflow lockup with frames > 255 lines * src/scroll.c (struct matrix_elt): Change unsigned char fields to int to handle frames with more than 255 lines (Bug#32951). Copyright-paperwork-exempt: yes --- src/scroll.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/scroll.c b/src/scroll.c index a29f2d37f54..240005b4e32 100644 --- a/src/scroll.c +++ b/src/scroll.c @@ -41,13 +41,13 @@ struct matrix_elt int deletecost; /* Number of inserts so far in this run of inserts, for the cost in insertcost. */ - unsigned char insertcount; + int insertcount; /* Number of deletes so far in this run of deletes, for the cost in deletecost. */ - unsigned char deletecount; + int deletecount; /* Number of writes so far since the last insert or delete for the cost in writecost. */ - unsigned char writecount; + int writecount; }; static void do_direct_scrolling (struct frame *, From 1baf191a484f9942352e37183c66e2471a8cb577 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 7 Oct 2018 00:10:29 -0700 Subject: [PATCH 49/72] * src/scroll.c (calculate_scrolling): Remove casts. --- src/scroll.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/scroll.c b/src/scroll.c index 240005b4e32..5d0f32080e7 100644 --- a/src/scroll.c +++ b/src/scroll.c @@ -186,13 +186,13 @@ calculate_scrolling (struct frame *frame, else { cost = p1->writecost + first_insert_cost[i]; - if ((int) p1->insertcount > i) + if (p1->insertcount > i) emacs_abort (); cost1 = p1->insertcost + next_insert_cost[i - p1->insertcount]; } p->insertcost = min (cost, cost1) + draw_cost[i] + extra_cost; p->insertcount = (cost < cost1) ? 1 : p1->insertcount + 1; - if ((int) p->insertcount > i) + if (p->insertcount > i) emacs_abort (); /* Calculate the cost if we do a delete line after From 14c032d5f8d4ccb608cc906db34ddf17ce465449 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 7 Oct 2018 17:45:12 +0300 Subject: [PATCH 50/72] Avoid assertion violations in nonsensical calls to 'signal' * src/eval.c (Fsignal): If both arguments are nil, replace the first one with 'error', to avoid assertion violations further down the line. (Bug#32961) --- src/eval.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/eval.c b/src/eval.c index f9563a3f80c..e90a9861a1a 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1503,7 +1503,7 @@ DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, This function does not return. An error symbol is a symbol with an `error-conditions' property -that is a list of condition names. +that is a list of condition names. The symbol should be non-nil. A handler for any of those names will get to handle this signal. The symbol `error' should normally be one of them. @@ -1515,6 +1515,9 @@ See also the function `condition-case'. */ attributes: noreturn) (Lisp_Object error_symbol, Lisp_Object data) { + /* If they call us with nonsensical arguments, produce "peculiar error". */ + if (NILP (error_symbol) && NILP (data)) + error_symbol = Qerror; signal_or_quit (error_symbol, data, false); eassume (false); } From a0605d96187bc4103a982cededcd12e2628aba66 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 7 Oct 2018 20:51:11 +0300 Subject: [PATCH 51/72] Fix MinGW compilation problem in timefns.c * src/timefns.c (lisp_to_timespec): Fix a mismatch between time_t and timespec.tv_sec data types. --- src/timefns.c | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/timefns.c b/src/timefns.c index 7bce3b1e500..c94d97d9a84 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -896,8 +896,14 @@ lisp_to_timespec (struct lisp_time t) ns = mpz_fdiv_q_ui (*q, *q, TIMESPEC_HZ); } - if (mpz_time (*q, &result.tv_sec)) - result.tv_nsec = ns; + /* With some versions of MinGW, tv_sec is a 64-bit type, whereas + time_t is a 32-bit type. */ + time_t sec; + if (mpz_time (*q, &sec)) + { + result.tv_sec = sec; + result.tv_nsec = ns; + } return result; } From 940ae156043c27101759c1577697d3a09d5bc948 Mon Sep 17 00:00:00 2001 From: Scott Corley Date: Sun, 7 Oct 2018 23:21:40 -0700 Subject: [PATCH 52/72] Fix overflow lockup with frames > 255 lines Backport from master. * src/scroll.c (struct matrix_elt): Change unsigned char fields to int to handle frames with more than 255 lines (Bug#32951). Copyright-paperwork-exempt: yes --- src/scroll.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/scroll.c b/src/scroll.c index 8a53f9614f7..7751a0885a1 100644 --- a/src/scroll.c +++ b/src/scroll.c @@ -47,13 +47,13 @@ struct matrix_elt int deletecost; /* Number of inserts so far in this run of inserts, for the cost in insertcost. */ - unsigned char insertcount; + int insertcount; /* Number of deletes so far in this run of deletes, for the cost in deletecost. */ - unsigned char deletecount; + int deletecount; /* Number of writes so far since the last insert or delete for the cost in writecost. */ - unsigned char writecount; + int writecount; }; static void do_direct_scrolling (struct frame *, From 3f1470d96fa8f71a6b5fe87396b2054309c6a59c Mon Sep 17 00:00:00 2001 From: "Charles A. Roelli" Date: Mon, 8 Oct 2018 19:21:41 +0200 Subject: [PATCH 53/72] * doc/emacs/mark.texi (Mark): Index "(de)activating the mark". (Bug#32956) --- doc/emacs/mark.texi | 2 ++ 1 file changed, 2 insertions(+) diff --git a/doc/emacs/mark.texi b/doc/emacs/mark.texi index 0ffa9f74ac6..10505873c53 100644 --- a/doc/emacs/mark.texi +++ b/doc/emacs/mark.texi @@ -17,11 +17,13 @@ one comes earlier in the text; each time you move point, the region changes. @cindex active region +@cindex activating the mark Setting the mark at a position in the text also @dfn{activates} it. When the mark is active, we say also that the region is active; Emacs indicates its extent by highlighting the text within it, using the @code{region} face (@pxref{Face Customization}). +@cindex deactivating the mark After certain non-motion commands, including any command that changes the text in the buffer, Emacs automatically @dfn{deactivates} the mark; this turns off the highlighting. You can also explicitly From 763721613bd478396dec11c8ccf145927ae70a48 Mon Sep 17 00:00:00 2001 From: "Charles A. Roelli" Date: Mon, 8 Oct 2018 21:49:41 +0200 Subject: [PATCH 54/72] New hook 'vc-retrieve-tag-hook' (Bug#32754) * etc/NEWS: Mention the new variable. * lisp/vc/vc.el (vc-retrieve-tag-hook): New hook. (vc-retrieve-tag): Run the new hook and update its documentation string. --- etc/NEWS | 2 ++ lisp/vc/vc.el | 11 ++++++++++- 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index 020450c9570..ee74e86f40f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -329,6 +329,8 @@ git-grep when 'vc-git-grep' is used. When some files are marked, only those are stashed. When no files are marked, all modified files are stashed, as before. +*** The new hook 'vc-retrieve-tag-hook' runs after retrieving a tag. + ** diff-mode *** Hunks are now automatically refined by default. To disable it, set the new defcustom 'diff-font-lock-refine' to nil. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 6962664d59f..7707999636a 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -834,6 +834,13 @@ See `run-hooks'." :type 'hook :group 'vc) +;;;###autoload +(defcustom vc-retrieve-tag-hook nil + "Normal hook (list of functions) run after retrieving a tag." + :type 'hook + :group 'vc + :version "27.1") + (defcustom vc-revert-show-diff t "If non-nil, `vc-revert' shows a `vc-diff' buffer before querying." :type 'boolean @@ -2153,7 +2160,8 @@ otherwise use the repository root of the current buffer. If NAME is empty, it refers to the latest revisions of the current branch. If locking is used for the files in DIR, then there must not be any locked files at or below DIR (but if NAME is empty, locked files are -allowed and simply skipped)." +allowed and simply skipped). +This function runs the hook `vc-retrieve-tag-hook' when finished." (interactive (let* ((granularity (vc-call-backend (vc-responsible-backend default-directory) @@ -2180,6 +2188,7 @@ allowed and simply skipped)." (vc-call-backend (vc-responsible-backend dir) 'retrieve-tag dir name update) (vc-resynch-buffer dir t t t) + (run-hooks 'vc-retrieve-tag-hook) (message "%s" (concat msg "done")))) From 4cf1eb8062d258338ceb83d5c0703f4000cd8181 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 8 Oct 2018 23:14:59 +0300 Subject: [PATCH 55/72] ; * src/data.c (Fkeywordp): Remove inaccurate commentary. (Bug#32979) --- src/data.c | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/data.c b/src/data.c index 4569f002420..8d58cbd9410 100644 --- a/src/data.c +++ b/src/data.c @@ -344,8 +344,6 @@ DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0, return Qnil; } -/* Define this in C to avoid unnecessarily consing up the symbol - name. */ DEFUN ("keywordp", Fkeywordp, Skeywordp, 1, 1, 0, doc: /* Return t if OBJECT is a keyword. This means that it is a symbol with a print name beginning with `:' From fc6004e61760d3bd3e27b593c318e634a221652c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 8 Oct 2018 20:59:59 -0400 Subject: [PATCH 56/72] * lisp/net/ntlm.el: Use lexical-binding (ntlm-string-as-unibyte): Remove. (ntlm-build-auth-response): Use encode-coding-string instead. (ntlm-build-auth-request, ntlm-build-auth-response, ntlm-ascii2unicode) (ntlm-smb-owf-encrypt, ntlm-smb-hash, ntlm-smb-dohash, ntlm-md4hash): Use fewer setq more Lisp-style. --- lisp/net/ntlm.el | 166 ++++++++++++++++++++++------------------------- 1 file changed, 78 insertions(+), 88 deletions(-) diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el index 7a68c68ab61..142c37510ec 100644 --- a/lisp/net/ntlm.el +++ b/lisp/net/ntlm.el @@ -1,4 +1,4 @@ -;;; ntlm.el --- NTLM (NT LanManager) authentication support +;;; ntlm.el --- NTLM (NT LanManager) authentication support -*- lexical-binding:t -*- ;; Copyright (C) 2001, 2007-2018 Free Software Foundation, Inc. @@ -106,7 +106,7 @@ is not given." (request-flags (concat (make-string 1 7) (make-string 1 130) (make-string 1 8) (make-string 1 0))) ;0x07 0x82 0x08 0x00 - lu ld off-d off-u) + ) (when (and user (string-match "@" user)) (unless domain (setq domain (substring user (1+ (match-beginning 0))))) @@ -115,10 +115,10 @@ is not given." ;; set "negotiate domain supplied" bit (aset request-flags 1 (logior (aref request-flags 1) ?\x10))) ;; set fields offsets within the request struct - (setq lu (length user)) - (setq ld (length domain)) - (setq off-u 32) ;offset to the string 'user - (setq off-d (+ 32 lu)) ;offset to the string 'domain + (let* ((lu (length user)) + (ld (length domain)) + (off-u 32) ;offset to the string 'user + (off-d (+ 32 lu))) ;offset to the string 'domain ;; pack the request struct in a string (concat request-ident ;8 bytes request-msgType ;4 bytes @@ -131,24 +131,20 @@ is not given." (md4-pack-int32 (cons 0 off-d)) ;domain field, offset field user ;buffer field domain ;buffer field - ))) - -(eval-when-compile - (defmacro ntlm-string-as-unibyte (string) - (if (fboundp 'string-as-unibyte) - `(string-as-unibyte ,string) - string))) + )))) (defun ntlm-compute-timestamp () "Compute an NTLMv2 timestamp. Return a unibyte string representing the number of tenths of a microsecond since January 1, 1601 as a 64-bit little-endian signed integer." + ;; FIXME: This can likely be significantly simplified using the new + ;; bignums support! (let* ((s-to-tenths-of-us "mul(add(lsh($1,16),$2),10000000)") (us-to-tenths-of-us "mul($3,10)") (ps-to-tenths-of-us "idiv($4,100000)") (tenths-of-us-since-jan-1-1601 - (apply 'calc-eval (concat "add(add(add(" + (apply #'calc-eval (concat "add(add(add(" s-to-tenths-of-us "," us-to-tenths-of-us ")," ps-to-tenths-of-us ")," @@ -157,12 +153,12 @@ signed integer." "116444736000000000)") 'rawnum (encode-time nil 'list))) result-bytes) - (dotimes (byte 8) + (dotimes (_byte 8) (push (calc-eval "and($1,16#FF)" 'rawnum tenths-of-us-since-jan-1-1601) result-bytes) (setq tenths-of-us-since-jan-1-1601 (calc-eval "rsh($1,8,64)" 'rawnum tenths-of-us-since-jan-1-1601))) - (apply 'unibyte-string (nreverse result-bytes)))) + (apply #'unibyte-string (nreverse result-bytes)))) (defun ntlm-generate-nonce () "Generate a random nonce, not to be used more than once. @@ -177,7 +173,13 @@ the NTLM based server for the user USER and the password hash list PASSWORD-HASHES. NTLM uses two hash values which are represented by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of (list (ntlm-smb-passwd-hash password) (ntlm-md4hash password))" - (let* ((rchallenge (ntlm-string-as-unibyte challenge)) + (let* ((rchallenge (if (multibyte-string-p challenge) + (progn + ;; FIXME: Maybe it would be better to + ;; signal an error. + (message "Incorrect challenge string type in ntlm-build-auth-response") + (encode-coding-string challenge 'binary)) + challenge)) ;; get fields within challenge struct ;;(ident (substring rchallenge 0 8)) ;ident, 8 bytes ;;(msgType (substring rchallenge 8 12)) ;msgType, 4 bytes @@ -188,20 +190,16 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of ;0x07 0x82 0x08 0x00 (flags (substring rchallenge 20 24)) ;flags, 4 bytes (challengeData (substring rchallenge 24 32)) ;challengeData, 8 bytes - uDomain-len uDomain-offs - ;; response struct and its fields + ;; Extract domain string from challenge string. + ;;(uDomain-len (md4-unpack-int16 (substring uDomain 0 2))) + (uDomain-offs (md4-unpack-int32 (substring uDomain 4 8))) + ;; Response struct and its fields. lmRespData ;lmRespData, 24 bytes ntRespData ;ntRespData, variable length - domain ;ascii domain string - workstation ;ascii workstation string - ll ln lu ld lw off-lm off-nt off-u off-d off-w) - ;; extract domain string from challenge string - (setq uDomain-len (md4-unpack-int16 (substring uDomain 0 2))) - (setq uDomain-offs (md4-unpack-int32 (substring uDomain 4 8))) - ;; match Mozilla behavior, which is to send an empty domain string - (setq domain "") - ;; match Mozilla behavior, which is to send "WORKSTATION" - (setq workstation "WORKSTATION") + ;; Match Mozilla behavior, which is to send an empty domain string + (domain "") ;ascii domain string + ;; Match Mozilla behavior, which is to send "WORKSTATION". + (workstation "WORKSTATION")) ;ascii workstation string ;; overwrite domain in case user is given in @ format (when (string-match "@" user) (setq domain (substring user (1+ (match-beginning 0)))) @@ -260,13 +258,11 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of ;; so just treat it the same as levels 0 and 1 ;; check if "negotiate NTLM2 key" flag is set in type 2 message (if (not (zerop (logand (aref flags 2) 8))) - (let (randomString - sessionHash) - ;; generate NTLM2 session response data - (setq randomString (ntlm-generate-nonce)) - (setq sessionHash (secure-hash 'md5 + ;; generate NTLM2 session response data + (let* ((randomString (ntlm-generate-nonce)) + (sessionHash (secure-hash 'md5 (concat challengeData randomString) - nil nil t)) + nil nil t))) (setq sessionHash (substring sessionHash 0 8)) (setq lmRespData (concat randomString (make-string 16 0))) (setq ntRespData (ntlm-smb-owf-encrypt @@ -278,16 +274,16 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of (ntlm-smb-owf-encrypt (cadr password-hashes) challengeData)))) ;; get offsets to fields to pack the response struct in a string - (setq ll (length lmRespData)) - (setq ln (length ntRespData)) - (setq lu (length user)) - (setq ld (length domain)) - (setq lw (length workstation)) - (setq off-u 64) ;offset to string 'uUser - (setq off-d (+ off-u (* 2 lu))) ;offset to string 'uDomain - (setq off-w (+ off-d (* 2 ld))) ;offset to string 'uWks - (setq off-lm (+ off-w (* 2 lw))) ;offset to string 'lmResponse - (setq off-nt (+ off-lm ll)) ;offset to string 'ntResponse + (let* ((ll (length lmRespData)) + (ln (length ntRespData)) + (lu (length user)) + (ld (length domain)) + (lw (length workstation)) + (off-u 64) ;offset to string 'uUser + (off-d (+ off-u (* 2 lu))) ;offset to string 'uDomain + (off-w (+ off-d (* 2 ld))) ;offset to string 'uWks + (off-lm (+ off-w (* 2 lw))) ;offset to string 'lmResponse + (off-nt (+ off-lm ll))) ;offset to string 'ntResponse ;; pack the response struct in a string (concat "NTLMSSP\0" ;response ident field, 8 bytes (md4-pack-int32 '(0 . 3)) ;response msgType field, 4 bytes @@ -341,7 +337,7 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of (ntlm-ascii2unicode workstation lw) ;Unicode workstation, 2*lw bytes lmRespData ;lmResponse, 24 bytes ntRespData ;ntResponse, ln bytes - ))) + )))) (defun ntlm-get-password-hashes (password) "Return a pair of SMB hash and NT MD4 hash of the given password PASSWORD." @@ -351,7 +347,10 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of (defun ntlm-ascii2unicode (str len) "Convert an ASCII string into a NT Unicode string, which is little-endian utf16." - (let ((utf (make-string (* 2 len) 0)) (i 0) val) + ;; FIXME: Can't we use encode-coding-string with a `utf-16le' coding system? + (let ((utf (make-string (* 2 len) 0)) + (i 0) + val) (while (and (< i len) (not (zerop (setq val (aref str i))))) (aset utf (* 2 i) val) @@ -380,9 +379,9 @@ string PASSWD. PASSWD is truncated to 14 bytes if longer." "Return the response string of 24 bytes long for the given password string PASSWD based on the DES encryption. PASSWD is of at most 14 bytes long and the challenge string C8 of 8 bytes long." - (let ((len (min (length passwd) 16)) p22) - (setq p22 (concat (substring passwd 0 len) ;fill top 16 bytes with passwd - (make-string (- 22 len) 0))) + (let* ((len (min (length passwd) 16)) + (p22 (concat (substring passwd 0 len) ;Fill top 16 bytes with passwd. + (make-string (- 22 len) 0)))) (ntlm-smb-des-e-p24 p22 c8))) (defun ntlm-smb-des-e-p24 (p22 c8) @@ -404,26 +403,26 @@ string C8." "Return the hash string of length 8 for a string IN of length 8 and a string KEY of length 8. FORW is t or nil." (let ((out (make-string 8 0)) - outb ;string of length 64 (inb (make-string 64 0)) (keyb (make-string 64 0)) (key2 (ntlm-smb-str-to-key key)) - (i 0) aa) + (i 0)) (while (< i 64) (unless (zerop (logand (aref in (/ i 8)) (ash 1 (- 7 (% i 8))))) (aset inb i 1)) (unless (zerop (logand (aref key2 (/ i 8)) (ash 1 (- 7 (% i 8))))) (aset keyb i 1)) (setq i (1+ i))) - (setq outb (ntlm-smb-dohash inb keyb forw)) - (setq i 0) - (while (< i 64) - (unless (zerop (aref outb i)) - (setq aa (aref out (/ i 8))) - (aset out (/ i 8) - (logior aa (ash 1 (- 7 (% i 8)))))) - (setq i (1+ i))) - out)) + (let ((outb (ntlm-smb-dohash inb keyb forw)) + aa) + (setq i 0) + (while (< i 64) + (unless (zerop (aref outb i)) + (setq aa (aref out (/ i 8))) + (aset out (/ i 8) + (logior aa (ash 1 (- 7 (% i 8)))))) + (setq i (1+ i))) + out))) (defun ntlm-smb-str-to-key (str) "Return a string of length 8 for the given string STR of length 7." @@ -570,27 +569,22 @@ length of STR is LEN." "Return the hash value for a string IN and a string KEY. Length of IN and KEY are 64. FORW non-nil means forward, nil means backward." - (let (pk1 ;string of length 56 - c ;string of length 28 - d ;string of length 28 - cd ;string of length 56 - (ki (make-vector 16 0)) ;vector of string of length 48 - pd1 ;string of length 64 - l ;string of length 32 - r ;string of length 32 - rl ;string of length 64 - (i 0) (j 0) (k 0)) - (setq pk1 (ntlm-string-permute key ntlm-smb-perm1 56)) - (setq c (substring pk1 0 28)) - (setq d (substring pk1 28 56)) + (let* ((pk1 (ntlm-string-permute key ntlm-smb-perm1 56)) ;string of length 56 + (c (substring pk1 0 28)) ;string of length 28 + (d (substring pk1 28 56)) ;string of length 28 + cd ;string of length 56 + (ki (make-vector 16 0)) ;vector of string of length 48 + pd1 ;string of length 64 + l ;string of length 32 + r ;string of length 32 + rl ;string of length 64 + (i 0) (j 0) (k 0)) - (setq i 0) - (while (< i 16) + (dotimes (i 16) (setq c (ntlm-string-lshift c (aref ntlm-smb-sc i) 28)) (setq d (ntlm-string-lshift d (aref ntlm-smb-sc i) 28)) (setq cd (concat (substring c 0 28) (substring d 0 28))) - (aset ki i (ntlm-string-permute cd ntlm-smb-perm2 48)) - (setq i (1+ i))) + (aset ki i (ntlm-string-permute cd ntlm-smb-perm2 48))) (setq pd1 (ntlm-string-permute in ntlm-smb-perm3 64)) @@ -649,16 +643,12 @@ backward." (defun ntlm-md4hash (passwd) "Return the 16 bytes MD4 hash of a string PASSWD after converting it into a Unicode string. PASSWD is truncated to 128 bytes if longer." - (let (len wpwd) - ;; Password cannot be longer than 128 characters - (setq len (length passwd)) - (if (> len 128) - (setq len 128)) - ;; Password must be converted to NT Unicode - (setq wpwd (ntlm-ascii2unicode passwd len)) - ;; Calculate length in bytes - (setq len (* len 2)) - (md4 wpwd len))) + (let* ((len (min (length passwd) 128)) ;Pwd can't be > than 128 characters. + ;; Password must be converted to NT Unicode. + (wpwd (ntlm-ascii2unicode passwd len))) + (md4 wpwd + ;; Calculate length in bytes. + (* len 2)))) (provide 'ntlm) From cf1ebfa055fcd0749aa4ed2fc4c399470b9eb3de Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 8 Oct 2018 18:21:47 -0700 Subject: [PATCH 57/72] Update from Gnulib This incorporates: 2018-10-05 explicit_bzero: make it possible to namespace 2018-10-04 fcntl: make it possible to namespace 2018-10-01 mkostemp, mkostemps: fix C++ compilation on Mac OS X 2018-09-19 maint: mktime.c now shared with glibc 2018-09-18 file-has-acl: fix test failure on Cygwin 2.9 2018-09-18 gettime: nanotime never existed * admin/merge-gnulib (AVOIDED_MODULES): Add mkdir. * doc/misc/texinfo.tex, lib/acl-internal.c, lib/acl-internal.h: * lib/acl_entries.c, lib/explicit_bzero.c, lib/fcntl.c: * lib/get-permissions.c, lib/gettime.c, lib/mktime.c: * lib/set-permissions.c, lib/stdlib.in.h, m4/acl.m4, m4/gettime.m4: Copy from Gnulib. * lib/gnulib.mk.in: Regenerate. --- admin/merge-gnulib | 2 +- doc/misc/texinfo.tex | 3 +- lib/acl-internal.c | 12 +- lib/acl-internal.h | 16 +- lib/acl_entries.c | 6 +- lib/explicit_bzero.c | 4 +- lib/fcntl.c | 380 ++++++++++++++++++++++-------------------- lib/get-permissions.c | 10 +- lib/gettime.c | 2 - lib/gnulib.mk.in | 1 + lib/mktime.c | 4 +- lib/set-permissions.c | 14 +- lib/stdlib.in.h | 3 +- m4/acl.m4 | 5 +- m4/gettime.m4 | 4 +- 15 files changed, 250 insertions(+), 216 deletions(-) diff --git a/admin/merge-gnulib b/admin/merge-gnulib index abb192911d9..575e3fa74a7 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -47,7 +47,7 @@ GNULIB_MODULES=' AVOIDED_MODULES=' btowc close dup fchdir fstat langinfo lock - malloc-posix mbrtowc mbsinit msvc-inval msvc-nothrow nl_langinfo + malloc-posix mbrtowc mbsinit mkdir msvc-inval msvc-nothrow nl_langinfo openat-die opendir raise save-cwd select setenv sigprocmask stat stdarg stdbool threadlib tzset unsetenv utime utime-h diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index d7f7f53a348..5840aff4d7c 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,7 +3,7 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2018-06-02.09} +\def\texinfoversion{2018-09-21.20} % % Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, % 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, @@ -8004,6 +8004,7 @@ \gdef\boldbrax{\let(=\opnr\let)=\clnr\let[=\lbrb\let]=\rbrb} \gdef\magicamp{\let&=\amprm} } +\let\ampchar\& \newcount\parencount diff --git a/lib/acl-internal.c b/lib/acl-internal.c index c62adb0d9d5..92e7b9bdf58 100644 --- a/lib/acl-internal.c +++ b/lib/acl-internal.c @@ -23,7 +23,7 @@ #include "acl-internal.h" -#if USE_ACL && HAVE_ACL_GET_FILE +#if USE_ACL && HAVE_ACL_GET_FILE /* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */ # if HAVE_ACL_TYPE_EXTENDED /* Mac OS X */ @@ -37,7 +37,7 @@ acl_extended_nontrivial (acl_t acl) return (acl_entries (acl) > 0); } -# else /* Linux, FreeBSD, IRIX, Tru64 */ +# else /* Linux, FreeBSD, IRIX, Tru64, Cygwin >= 2.5 */ /* ACL is an ACL, from a file, stored as type ACL_TYPE_ACCESS. Return 1 if the given ACL is non-trivial. @@ -51,7 +51,7 @@ acl_access_nontrivial (acl_t acl) at least, allowing us to write return (3 < acl_entries (acl)); but the following code is more robust. */ -# if HAVE_ACL_FIRST_ENTRY /* Linux, FreeBSD */ +# if HAVE_ACL_FIRST_ENTRY /* Linux, FreeBSD, Cygwin >= 2.5 */ acl_entry_t ace; int got_one; @@ -124,7 +124,7 @@ acl_default_nontrivial (acl_t acl) # endif -#elif USE_ACL && HAVE_FACL && defined GETACL /* Solaris, Cygwin, not HP-UX */ +#elif USE_ACL && HAVE_FACL && defined GETACL /* Solaris, Cygwin < 2.5, not HP-UX */ /* Test an ACL retrieved with GETACL. Return 1 if the given ACL, consisting of COUNT entries, is non-trivial. @@ -479,7 +479,7 @@ void free_permission_context (struct permission_context *ctx) { #if USE_ACL -# if HAVE_ACL_GET_FILE /* Linux, FreeBSD, Mac OS X, IRIX, Tru64 */ +# if HAVE_ACL_GET_FILE /* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */ if (ctx->acl) acl_free (ctx->acl); # if !HAVE_ACL_TYPE_EXTENDED @@ -487,7 +487,7 @@ free_permission_context (struct permission_context *ctx) acl_free (ctx->default_acl); # endif -# elif defined GETACL /* Solaris, Cygwin */ +# elif defined GETACL /* Solaris, Cygwin < 2.5 */ free (ctx->entries); # ifdef ACE_GETACL free (ctx->ace_entries); diff --git a/lib/acl-internal.h b/lib/acl-internal.h index 0669d83c469..2da7c5a0366 100644 --- a/lib/acl-internal.h +++ b/lib/acl-internal.h @@ -30,7 +30,8 @@ # define GETACLCNT ACL_CNT #endif -/* On Linux, additional ACL related API is available in . */ +/* On Linux and Cygwin >= 2.5, additional ACL related API is available in + . */ #ifdef HAVE_ACL_LIBACL_H # include #endif @@ -72,7 +73,7 @@ _GL_INLINE_HEADER_BEGIN # if HAVE_ACL_GET_FILE /* POSIX 1003.1e (draft 17 -- abandoned) specific version. */ -/* Linux, FreeBSD, Mac OS X, IRIX, Tru64 */ +/* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */ # ifndef MIN_ACL_ENTRIES # define MIN_ACL_ENTRIES 4 @@ -122,7 +123,10 @@ rpl_acl_set_fd (int fd, acl_t acl) # endif /* Linux-specific */ -# ifndef HAVE_ACL_EXTENDED_FILE +/* Cygwin >= 2.5 implements this function, but it returns 1 for all + directories, thus is unusable. */ +# if !defined HAVE_ACL_EXTENDED_FILE || defined __CYGWIN__ +# undef HAVE_ACL_EXTENDED_FILE # define HAVE_ACL_EXTENDED_FILE false # define acl_extended_file(name) (-1) # endif @@ -163,7 +167,7 @@ extern int acl_access_nontrivial (acl_t); extern int acl_default_nontrivial (acl_t); # endif -# elif HAVE_FACL && defined GETACL /* Solaris, Cygwin, not HP-UX */ +# elif HAVE_FACL && defined GETACL /* Solaris, Cygwin < 2.5, not HP-UX */ /* Set to 0 if a file's mode is stored independently from the ACL. */ # if defined __CYGWIN__ /* Cygwin */ @@ -256,14 +260,14 @@ extern int acl_nontrivial (int count, struct acl *entries); struct permission_context { mode_t mode; #if USE_ACL -# if HAVE_ACL_GET_FILE /* Linux, FreeBSD, Mac OS X, IRIX, Tru64 */ +# if HAVE_ACL_GET_FILE /* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */ acl_t acl; # if !HAVE_ACL_TYPE_EXTENDED acl_t default_acl; # endif bool acls_not_supported; -# elif defined GETACL /* Solaris, Cygwin */ +# elif defined GETACL /* Solaris, Cygwin < 2.5 */ int count; aclent_t *entries; # ifdef ACE_GETACL diff --git a/lib/acl_entries.c b/lib/acl_entries.c index 59dd420eaf4..ce730d466e1 100644 --- a/lib/acl_entries.c +++ b/lib/acl_entries.c @@ -22,7 +22,7 @@ #include "acl-internal.h" /* This file assumes POSIX-draft like ACLs - (Linux, FreeBSD, Mac OS X, IRIX, Tru64). */ + (Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5). */ /* Return the number of entries in ACL. Return -1 and set errno upon failure to determine it. */ @@ -34,7 +34,7 @@ acl_entries (acl_t acl) if (acl != NULL) { -#if HAVE_ACL_FIRST_ENTRY /* Linux, FreeBSD, Mac OS X */ +#if HAVE_ACL_FIRST_ENTRY /* Linux, FreeBSD, Mac OS X, Cygwin >= 2.5 */ # if HAVE_ACL_TYPE_EXTENDED /* Mac OS X */ /* acl_get_entry returns 0 when it successfully fetches an entry, and -1/EINVAL at the end. */ @@ -45,7 +45,7 @@ acl_entries (acl_t acl) got_one >= 0; got_one = acl_get_entry (acl, ACL_NEXT_ENTRY, &ace)) count++; -# else /* Linux, FreeBSD */ +# else /* Linux, FreeBSD, Cygwin >= 2.5 */ /* acl_get_entry returns 1 when it successfully fetches an entry, and 0 at the end. */ acl_entry_t ace; diff --git a/lib/explicit_bzero.c b/lib/explicit_bzero.c index 78ec747c3a6..79b7fd66b66 100644 --- a/lib/explicit_bzero.c +++ b/lib/explicit_bzero.c @@ -27,9 +27,11 @@ #include +#if _LIBC /* glibc-internal users use __explicit_bzero_chk, and explicit_bzero redirects to that. */ -#undef explicit_bzero +# undef explicit_bzero +#endif /* Set LEN bytes of S to 0. The compiler will not delete a call to this function, even if S is dead after the call. */ diff --git a/lib/fcntl.c b/lib/fcntl.c index 8e976173c0b..74e0f5d3910 100644 --- a/lib/fcntl.c +++ b/lib/fcntl.c @@ -27,10 +27,10 @@ #include #include -#if !HAVE_FCNTL -# define rpl_fcntl fcntl +#ifdef __KLIBC__ +# define INCL_DOS +# include #endif -#undef fcntl #if defined _WIN32 && ! defined __CYGWIN__ /* Get declarations of the native Windows API functions. */ @@ -166,93 +166,18 @@ dupfd (int oldfd, int newfd, int flags) } #endif /* W32 */ +/* Forward declarations, because we '#undef fcntl' in the middle of this + compilation unit. */ +/* Our implementation of fcntl (fd, F_DUPFD, target). */ +static int rpl_fcntl_DUPFD (int fd, int target); +/* Our implementation of fcntl (fd, F_DUPFD_CLOEXEC, target). */ +static int rpl_fcntl_DUPFD_CLOEXEC (int fd, int target); #ifdef __KLIBC__ - -# define INCL_DOS -# include - -static int -klibc_fcntl (int fd, int action, /* arg */...) -{ - va_list arg_ptr; - int arg; - struct stat sbuf; - int result = -1; - - va_start (arg_ptr, action); - arg = va_arg (arg_ptr, int); - result = fcntl (fd, action, arg); - /* EPERM for F_DUPFD, ENOTSUP for others */ - if (result == -1 && (errno == EPERM || errno == ENOTSUP) - && !fstat (fd, &sbuf) && S_ISDIR (sbuf.st_mode)) - { - ULONG ulMode; - - switch (action) - { - case F_DUPFD: - /* Find available fd */ - while (fcntl (arg, F_GETFL) != -1 || errno != EBADF) - arg++; - - result = dup2 (fd, arg); - break; - - /* Using underlying APIs is right ? */ - case F_GETFD: - if (DosQueryFHState (fd, &ulMode)) - break; - - result = (ulMode & OPEN_FLAGS_NOINHERIT) ? FD_CLOEXEC : 0; - break; - - case F_SETFD: - if (arg & ~FD_CLOEXEC) - break; - - if (DosQueryFHState (fd, &ulMode)) - break; - - if (arg & FD_CLOEXEC) - ulMode |= OPEN_FLAGS_NOINHERIT; - else - ulMode &= ~OPEN_FLAGS_NOINHERIT; - - /* Filter supported flags. */ - ulMode &= (OPEN_FLAGS_WRITE_THROUGH | OPEN_FLAGS_FAIL_ON_ERROR - | OPEN_FLAGS_NO_CACHE | OPEN_FLAGS_NOINHERIT); - - if (DosSetFHState (fd, ulMode)) - break; - - result = 0; - break; - - case F_GETFL: - result = 0; - break; - - case F_SETFL: - if (arg != 0) - break; - - result = 0; - break; - - default : - errno = EINVAL; - break; - } - } - - va_end (arg_ptr); - - return result; -} - -# define fcntl klibc_fcntl +/* Adds support for fcntl on directories. */ +static int klibc_fcntl (int fd, int action, /* arg */...); #endif + /* Perform the specified ACTION on the file descriptor FD, possibly using the argument ARG further described below. This replacement handles the following actions, and forwards all others on to the @@ -273,112 +198,30 @@ klibc_fcntl (int fd, int action, /* arg */...) return -1 and set errno. */ int -rpl_fcntl (int fd, int action, /* arg */...) +fcntl (int fd, int action, /* arg */...) +#undef fcntl +#ifdef __KLIBC__ +# define fcntl klibc_fcntl +#endif { va_list arg; int result = -1; va_start (arg, action); switch (action) { - -#if !HAVE_FCNTL case F_DUPFD: { int target = va_arg (arg, int); - result = dupfd (fd, target, 0); + result = rpl_fcntl_DUPFD (fd, target); break; } -#elif FCNTL_DUPFD_BUGGY || REPLACE_FCHDIR - case F_DUPFD: - { - int target = va_arg (arg, int); - /* Detect invalid target; needed for cygwin 1.5.x. */ - if (target < 0 || getdtablesize () <= target) - errno = EINVAL; - else - { - /* Haiku alpha 2 loses fd flags on original. */ - int flags = fcntl (fd, F_GETFD); - if (flags < 0) - { - result = -1; - break; - } - result = fcntl (fd, action, target); - if (0 <= result && fcntl (fd, F_SETFD, flags) == -1) - { - int saved_errno = errno; - close (result); - result = -1; - errno = saved_errno; - } -# if REPLACE_FCHDIR - if (0 <= result) - result = _gl_register_dup (fd, result); -# endif - } - break; - } /* F_DUPFD */ -#endif /* FCNTL_DUPFD_BUGGY || REPLACE_FCHDIR */ case F_DUPFD_CLOEXEC: { int target = va_arg (arg, int); - -#if !HAVE_FCNTL - result = dupfd (fd, target, O_CLOEXEC); + result = rpl_fcntl_DUPFD_CLOEXEC (fd, target); break; -#else /* HAVE_FCNTL */ -# if defined __HAIKU__ - /* On Haiku, the system fcntl (fd, F_DUPFD_CLOEXEC, target) sets - the FD_CLOEXEC flag on fd, not on target. Therefore avoid the - system fcntl in this case. */ -# define have_dupfd_cloexec -1 -# else - /* Try the system call first, if the headers claim it exists - (that is, if GNULIB_defined_F_DUPFD_CLOEXEC is 0), since we - may be running with a glibc that has the macro but with an - older kernel that does not support it. Cache the - information on whether the system call really works, but - avoid caching failure if the corresponding F_DUPFD fails - for any reason. 0 = unknown, 1 = yes, -1 = no. */ - static int have_dupfd_cloexec = GNULIB_defined_F_DUPFD_CLOEXEC ? -1 : 0; - if (0 <= have_dupfd_cloexec) - { - result = fcntl (fd, action, target); - if (0 <= result || errno != EINVAL) - { - have_dupfd_cloexec = 1; -# if REPLACE_FCHDIR - if (0 <= result) - result = _gl_register_dup (fd, result); -# endif - } - else - { - result = rpl_fcntl (fd, F_DUPFD, target); - if (result < 0) - break; - have_dupfd_cloexec = -1; - } - } - else -# endif - result = rpl_fcntl (fd, F_DUPFD, target); - if (0 <= result && have_dupfd_cloexec == -1) - { - int flags = fcntl (result, F_GETFD); - if (flags < 0 || fcntl (result, F_SETFD, flags | FD_CLOEXEC) == -1) - { - int saved_errno = errno; - close (result); - errno = saved_errno; - result = -1; - } - } - break; -#endif /* HAVE_FCNTL */ - } /* F_DUPFD_CLOEXEC */ + } #if !HAVE_FCNTL case F_GETFD: @@ -598,3 +441,186 @@ rpl_fcntl (int fd, int action, /* arg */...) va_end (arg); return result; } + +static int +rpl_fcntl_DUPFD (int fd, int target) +{ + int result; +#if !HAVE_FCNTL + result = dupfd (fd, target, 0); +#elif FCNTL_DUPFD_BUGGY || REPLACE_FCHDIR + /* Detect invalid target; needed for cygwin 1.5.x. */ + if (target < 0 || getdtablesize () <= target) + { + result = -1; + errno = EINVAL; + } + else + { + /* Haiku alpha 2 loses fd flags on original. */ + int flags = fcntl (fd, F_GETFD); + if (flags < 0) + result = -1; + else + { + result = fcntl (fd, F_DUPFD, target); + if (0 <= result && fcntl (fd, F_SETFD, flags) == -1) + { + int saved_errno = errno; + close (result); + result = -1; + errno = saved_errno; + } +# if REPLACE_FCHDIR + if (0 <= result) + result = _gl_register_dup (fd, result); +# endif + } + } +#else + result = fcntl (fd, F_DUPFD, target); +#endif + return result; +} + +static int +rpl_fcntl_DUPFD_CLOEXEC (int fd, int target) +{ + int result; +#if !HAVE_FCNTL + result = dupfd (fd, target, O_CLOEXEC); +#else /* HAVE_FCNTL */ +# if defined __HAIKU__ + /* On Haiku, the system fcntl (fd, F_DUPFD_CLOEXEC, target) sets + the FD_CLOEXEC flag on fd, not on target. Therefore avoid the + system fcntl in this case. */ +# define have_dupfd_cloexec -1 +# else + /* Try the system call first, if the headers claim it exists + (that is, if GNULIB_defined_F_DUPFD_CLOEXEC is 0), since we + may be running with a glibc that has the macro but with an + older kernel that does not support it. Cache the + information on whether the system call really works, but + avoid caching failure if the corresponding F_DUPFD fails + for any reason. 0 = unknown, 1 = yes, -1 = no. */ + static int have_dupfd_cloexec = GNULIB_defined_F_DUPFD_CLOEXEC ? -1 : 0; + if (0 <= have_dupfd_cloexec) + { + result = fcntl (fd, F_DUPFD_CLOEXEC, target); + if (0 <= result || errno != EINVAL) + { + have_dupfd_cloexec = 1; +# if REPLACE_FCHDIR + if (0 <= result) + result = _gl_register_dup (fd, result); +# endif + } + else + { + result = rpl_fcntl_DUPFD (fd, target); + if (result >= 0) + have_dupfd_cloexec = -1; + } + } + else +# endif + result = rpl_fcntl_DUPFD (fd, target); + if (0 <= result && have_dupfd_cloexec == -1) + { + int flags = fcntl (result, F_GETFD); + if (flags < 0 || fcntl (result, F_SETFD, flags | FD_CLOEXEC) == -1) + { + int saved_errno = errno; + close (result); + errno = saved_errno; + result = -1; + } + } +#endif /* HAVE_FCNTL */ + return result; +} + +#undef fcntl + +#ifdef __KLIBC__ + +static int +klibc_fcntl (int fd, int action, /* arg */...); +{ + va_list arg_ptr; + int arg; + struct stat sbuf; + int result; + + va_start (arg_ptr, action); + arg = va_arg (arg_ptr, int); + result = fcntl (fd, action, arg); + /* EPERM for F_DUPFD, ENOTSUP for others */ + if (result == -1 && (errno == EPERM || errno == ENOTSUP) + && !fstat (fd, &sbuf) && S_ISDIR (sbuf.st_mode)) + { + ULONG ulMode; + + switch (action) + { + case F_DUPFD: + /* Find available fd */ + while (fcntl (arg, F_GETFL) != -1 || errno != EBADF) + arg++; + + result = dup2 (fd, arg); + break; + + /* Using underlying APIs is right ? */ + case F_GETFD: + if (DosQueryFHState (fd, &ulMode)) + break; + + result = (ulMode & OPEN_FLAGS_NOINHERIT) ? FD_CLOEXEC : 0; + break; + + case F_SETFD: + if (arg & ~FD_CLOEXEC) + break; + + if (DosQueryFHState (fd, &ulMode)) + break; + + if (arg & FD_CLOEXEC) + ulMode |= OPEN_FLAGS_NOINHERIT; + else + ulMode &= ~OPEN_FLAGS_NOINHERIT; + + /* Filter supported flags. */ + ulMode &= (OPEN_FLAGS_WRITE_THROUGH | OPEN_FLAGS_FAIL_ON_ERROR + | OPEN_FLAGS_NO_CACHE | OPEN_FLAGS_NOINHERIT); + + if (DosSetFHState (fd, ulMode)) + break; + + result = 0; + break; + + case F_GETFL: + result = 0; + break; + + case F_SETFL: + if (arg != 0) + break; + + result = 0; + break; + + default: + errno = EINVAL; + break; + } + } + + va_end (arg_ptr); + + return result; +} + +#endif diff --git a/lib/get-permissions.c b/lib/get-permissions.c index 83ba2639a17..3b984510955 100644 --- a/lib/get-permissions.c +++ b/lib/get-permissions.c @@ -38,9 +38,9 @@ get_permissions (const char *name, int desc, mode_t mode, #if USE_ACL && HAVE_ACL_GET_FILE /* POSIX 1003.1e (draft 17 -- abandoned) specific version. */ - /* Linux, FreeBSD, Mac OS X, IRIX, Tru64 */ + /* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */ # if !HAVE_ACL_TYPE_EXTENDED - /* Linux, FreeBSD, IRIX, Tru64 */ + /* Linux, FreeBSD, IRIX, Tru64, Cygwin >= 2.5 */ if (HAVE_ACL_GET_FD && desc != -1) ctx->acl = acl_get_fd (desc); @@ -60,13 +60,13 @@ get_permissions (const char *name, int desc, mode_t mode, return -1; } -# if HAVE_ACL_TYPE_NFS4 /* FreeBSD */ +# if HAVE_ACL_TYPE_NFS4 /* FreeBSD */ /* TODO (see set_permissions). */ -# endif +# endif -# else /* HAVE_ACL_TYPE_EXTENDED */ +# else /* HAVE_ACL_TYPE_EXTENDED */ /* Mac OS X */ /* On Mac OS X, acl_get_file (name, ACL_TYPE_ACCESS) diff --git a/lib/gettime.c b/lib/gettime.c index 171f22476f8..bb59c44ff0e 100644 --- a/lib/gettime.c +++ b/lib/gettime.c @@ -30,8 +30,6 @@ gettime (struct timespec *ts) { #if defined CLOCK_REALTIME && HAVE_CLOCK_GETTIME clock_gettime (CLOCK_REALTIME, ts); -#elif HAVE_NANOTIME - nanotime (ts); #else struct timeval tv; gettimeofday (&tv, NULL); diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 2e265b3068b..431d0c0b77b 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -44,6 +44,7 @@ # --avoid=malloc-posix \ # --avoid=mbrtowc \ # --avoid=mbsinit \ +# --avoid=mkdir \ # --avoid=msvc-inval \ # --avoid=msvc-nothrow \ # --avoid=nl_langinfo \ diff --git a/lib/mktime.c b/lib/mktime.c index 6953e984e5d..557712fdaa4 100644 --- a/lib/mktime.c +++ b/lib/mktime.c @@ -78,7 +78,7 @@ #include "mktime-internal.h" -#ifndef _LIBC +#if !defined _LIBC && (NEED_MKTIME_WORKING || NEED_MKTIME_WINDOWS) static void my_tzset (void) { @@ -527,7 +527,7 @@ mktime (struct tm *tp) be set as if the tzset() function had been called. */ __tzset (); -# if defined __LIBC || NEED_MKTIME_WORKING +# if defined _LIBC || NEED_MKTIME_WORKING static mktime_offset_t localtime_offset; return __mktime_internal (tp, __localtime_r, &localtime_offset); # else diff --git a/lib/set-permissions.c b/lib/set-permissions.c index d42335aa502..a415e133ac7 100644 --- a/lib/set-permissions.c +++ b/lib/set-permissions.c @@ -24,7 +24,7 @@ #include "acl-internal.h" #if USE_ACL -# if ! defined HAVE_ACL_FROM_MODE && defined HAVE_ACL_FROM_TEXT /* FreeBSD, IRIX, Tru64 */ +# if ! defined HAVE_ACL_FROM_MODE && defined HAVE_ACL_FROM_TEXT /* FreeBSD, IRIX, Tru64, Cygwin >= 2.5 */ # if HAVE_ACL_GET_FILE && !HAVE_ACL_TYPE_EXTENDED static acl_t @@ -32,7 +32,7 @@ acl_from_mode (mode_t mode) { # if HAVE_ACL_FREE_TEXT /* Tru64 */ char acl_text[] = "u::---,g::---,o::---,"; -# else /* FreeBSD, IRIX */ +# else /* FreeBSD, IRIX, Cygwin >= 2.5 */ char acl_text[] = "u::---,g::---,o::---"; # endif @@ -51,7 +51,7 @@ acl_from_mode (mode_t mode) # endif # endif -# if HAVE_FACL && defined GETACL /* Solaris, Cygwin, not HP-UX */ +# if HAVE_FACL && defined GETACL /* Solaris, Cygwin < 2.5, not HP-UX */ static int set_acls_from_mode (const char *name, int desc, mode_t mode, bool *must_chmod) { @@ -489,9 +489,9 @@ set_acls (struct permission_context *ctx, const char *name, int desc, # if HAVE_ACL_GET_FILE /* POSIX 1003.1e (draft 17 -- abandoned) specific version. */ - /* Linux, FreeBSD, Mac OS X, IRIX, Tru64 */ + /* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */ # if !HAVE_ACL_TYPE_EXTENDED - /* Linux, FreeBSD, IRIX, Tru64 */ + /* Linux, FreeBSD, IRIX, Tru64, Cygwin >= 2.5 */ # ifndef HAVE_ACL_FROM_TEXT # error Must have acl_from_text (see POSIX 1003.1e draft 17). @@ -542,14 +542,14 @@ set_acls (struct permission_context *ctx, const char *name, int desc, } } -# if HAVE_ACL_TYPE_NFS4 /* FreeBSD */ +# if HAVE_ACL_TYPE_NFS4 /* FreeBSD */ /* File systems either support POSIX ACLs (for example, ufs) or NFS4 ACLs (for example, zfs). */ /* TODO: Implement setting ACLs once get_permissions() reads them. */ -# endif +# endif # else /* HAVE_ACL_TYPE_EXTENDED */ /* Mac OS X */ diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h index 3bf35bf6b0f..441c018ec18 100644 --- a/lib/stdlib.in.h +++ b/lib/stdlib.in.h @@ -90,9 +90,10 @@ struct random_data # endif #endif -#if (@GNULIB_MKSTEMP@ || @GNULIB_MKSTEMPS@ || @GNULIB_GETSUBOPT@ || defined GNULIB_POSIXCHECK) && ! defined __GLIBC__ && !(defined _WIN32 && ! defined __CYGWIN__) +#if (@GNULIB_MKSTEMP@ || @GNULIB_MKSTEMPS@ || @GNULIB_MKOSTEMP@ || @GNULIB_MKOSTEMPS@ || @GNULIB_GETSUBOPT@ || defined GNULIB_POSIXCHECK) && ! defined __GLIBC__ && !(defined _WIN32 && ! defined __CYGWIN__) /* On Mac OS X 10.3, only declares mkstemp. */ /* On Mac OS X 10.5, only declares mkstemps. */ +/* On Mac OS X 10.13, only declares mkostemp and mkostemps. */ /* On Cygwin 1.7.1, only declares getsubopt. */ /* But avoid namespace pollution on glibc systems and native Windows. */ # include diff --git a/m4/acl.m4 b/m4/acl.m4 index 485cf9af08b..b64aa849c88 100644 --- a/m4/acl.m4 +++ b/m4/acl.m4 @@ -1,5 +1,5 @@ # acl.m4 - check for access control list (ACL) primitives -# serial 22 +# serial 23 # Copyright (C) 2002, 2004-2018 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation @@ -30,7 +30,8 @@ AC_DEFUN([gl_FUNC_ACL], ac_save_LIBS=$LIBS dnl Test for POSIX-draft-like API (GNU/Linux, FreeBSD, Mac OS X, - dnl IRIX, Tru64). -lacl is needed on GNU/Linux, -lpacl on OSF/1. + dnl IRIX, Tru64, Cygwin >= 2.5). + dnl -lacl is needed on GNU/Linux, -lpacl on OSF/1. if test $use_acl = 0; then AC_SEARCH_LIBS([acl_get_file], [acl pacl], [if test "$ac_cv_search_acl_get_file" != "none required"; then diff --git a/m4/gettime.m4 b/m4/gettime.m4 index ad355463cce..671b70d5ab2 100644 --- a/m4/gettime.m4 +++ b/m4/gettime.m4 @@ -1,4 +1,4 @@ -# gettime.m4 serial 8 +# gettime.m4 serial 9 dnl Copyright (C) 2002, 2004-2006, 2009-2018 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -9,5 +9,5 @@ AC_DEFUN([gl_GETTIME], dnl Prerequisites of lib/gettime.c. AC_REQUIRE([gl_CLOCK_TIME]) AC_REQUIRE([gl_TIMESPEC]) - AC_CHECK_FUNCS_ONCE([gettimeofday nanotime]) + AC_CHECK_FUNCS_ONCE([gettimeofday]) ]) From 333f0bfe766185c66952c6fbd4796c6bb97c868d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 8 Oct 2018 22:33:22 -0400 Subject: [PATCH 58/72] * lisp/calendar/timeclock.el: Use lexical-binding Require cl-lib. Remove redundant :group args. (timeclock-status-string): Avoid 'setq'. (timeclock-ask-for-project, timeclock-ask-for-reason): Completionu tables can be simple lists of strings. (timeclock-read-moment): Doesn't deserve to be defsubst (most of the others don't either, admittedly). (timeclock-entry): New type. (timeclock-entry-begin, timeclock-entry-end, timeclock-entry-project) (timeclock-entry-comment): Define via 'cl-defstruct'. (timeclock-entry-list-projects, timeclock-day-list-projects): Avoid add-to-list on lexical vars. (timeclock-day-list): Use 'push'. (timeclock-log-data): Use 'pcase'. (timeclock-mean): Simplify. (timeclock-generate-report): Use dotimes. --- lisp/calendar/timeclock.el | 344 +++++++++++++++++-------------------- 1 file changed, 153 insertions(+), 191 deletions(-) diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el index ddc297604ec..646f5298fe4 100644 --- a/lisp/calendar/timeclock.el +++ b/lisp/calendar/timeclock.el @@ -1,4 +1,4 @@ -;;; timeclock.el --- mode for keeping track of how much you work +;;; timeclock.el --- mode for keeping track of how much you work -*- lexical-binding:t -*- ;; Copyright (C) 1999-2018 Free Software Foundation, Inc. @@ -62,7 +62,7 @@ ;; `timeclock-ask-before-exiting' to t using M-x customize (this is ;; the default), or by adding the following to your init file: ;; -;; (add-hook 'kill-emacs-query-functions 'timeclock-query-out) +;; (add-hook 'kill-emacs-query-functions #'timeclock-query-out) ;; NOTE: If you change your timelog file without using timeclock's ;; functions, or if you change the value of any of timeclock's @@ -75,6 +75,8 @@ ;;; Code: +(require 'cl-lib) + (defgroup timeclock nil "Keeping track of the time that gets spent." :group 'data) @@ -84,13 +86,11 @@ (defcustom timeclock-file (locate-user-emacs-file "timelog" ".timelog") "The file used to store timeclock data in." :version "24.4" ; added locate-user-emacs-file - :type 'file - :group 'timeclock) + :type 'file) (defcustom timeclock-workday (* 8 60 60) "The length of a work period in seconds." - :type 'integer - :group 'timeclock) + :type 'integer) (defcustom timeclock-relative t "Whether to make reported time relative to `timeclock-workday'. @@ -100,24 +100,21 @@ Tuesday is twelve hours -- relative to an averaged work period of eight hours -- or eight hours, non-relative. So relative time takes into account any discrepancy of time under-worked or over-worked on previous days. This only affects the timeclock mode line display." - :type 'boolean - :group 'timeclock) + :type 'boolean) (defcustom timeclock-get-project-function 'timeclock-ask-for-project "The function used to determine the name of the current project. When clocking in, and no project is specified, this function will be called to determine what is the current project to be worked on. If this variable is nil, no questions will be asked." - :type 'function - :group 'timeclock) + :type 'function) (defcustom timeclock-get-reason-function 'timeclock-ask-for-reason "A function used to determine the reason for clocking out. When clocking out, and no reason is specified, this function will be called to determine what is the reason. If this variable is nil, no questions will be asked." - :type 'function - :group 'timeclock) + :type 'function) (defcustom timeclock-get-workday-function nil "A function used to determine the length of today's workday. @@ -127,19 +124,17 @@ the return value is nil, or equal to `timeclock-workday', nothing special will be done. If it is a quantity different from `timeclock-workday', however, a record will be output to the timelog file to note the fact that that day has a length that is different from the norm." - :type '(choice (const nil) function) - :group 'timeclock) + :type '(choice (const nil) function)) (defcustom timeclock-ask-before-exiting t "If non-nil, ask if the user wants to clock out before exiting Emacs. This variable only has effect if set with \\[customize]." :set (lambda (symbol value) (if value - (add-hook 'kill-emacs-query-functions 'timeclock-query-out) - (remove-hook 'kill-emacs-query-functions 'timeclock-query-out)) + (add-hook 'kill-emacs-query-functions #'timeclock-query-out) + (remove-hook 'kill-emacs-query-functions #'timeclock-query-out)) (set symbol value)) - :type 'boolean - :group 'timeclock) + :type 'boolean) (defvar timeclock-update-timer nil "The timer used to update `timeclock-mode-string'.") @@ -172,7 +167,7 @@ a positive argument to force an update." (if (and currently-displaying (or (and value (boundp 'display-time-hook) - (memq 'timeclock-update-mode-line + (memq #'timeclock-update-mode-line display-time-hook)) (and (not value) timeclock-update-timer))) @@ -185,7 +180,6 @@ a positive argument to force an update." ;; FIXME: The return value isn't used, AFAIK! value)) :type 'boolean - :group 'timeclock :require 'time) (defcustom timeclock-first-in-hook nil @@ -194,40 +188,33 @@ Note that this hook is run before recording any events. Thus the value of `timeclock-hours-today', `timeclock-last-event' and the return value of function `timeclock-last-period' are relative previous to today." - :type 'hook - :group 'timeclock) + :type 'hook) (defcustom timeclock-load-hook nil "Hook that gets run after timeclock has been loaded." - :type 'hook - :group 'timeclock) + :type 'hook) (defcustom timeclock-in-hook nil "A hook run every time an \"in\" event is recorded." - :type 'hook - :group 'timeclock) + :type 'hook) (defcustom timeclock-day-over-hook nil "A hook that is run when the workday has been completed. This hook is only run if the current time remaining is being displayed in the mode line. See the variable `timeclock-mode-line-display'." - :type 'hook - :group 'timeclock) + :type 'hook) (defcustom timeclock-out-hook nil "A hook run every time an \"out\" event is recorded." - :type 'hook - :group 'timeclock) + :type 'hook) (defcustom timeclock-done-hook nil "A hook run every time a project is marked as completed." - :type 'hook - :group 'timeclock) + :type 'hook) (defcustom timeclock-event-hook nil "A hook run every time any event is recorded." - :type 'hook - :group 'timeclock) + :type 'hook) (defvar timeclock-last-event nil "A list containing the last event that was recorded. @@ -294,12 +281,12 @@ display (non-nil means on)." (or (memq 'timeclock-mode-string global-mode-string) (setq global-mode-string (append global-mode-string '(timeclock-mode-string)))) - (add-hook 'timeclock-event-hook 'timeclock-update-mode-line) + (add-hook 'timeclock-event-hook #'timeclock-update-mode-line) (when timeclock-update-timer (cancel-timer timeclock-update-timer) (setq timeclock-update-timer nil)) (if (boundp 'display-time-hook) - (remove-hook 'display-time-hook 'timeclock-update-mode-line)) + (remove-hook 'display-time-hook #'timeclock-update-mode-line)) (if timeclock-use-display-time (progn ;; Update immediately so there is a visible change @@ -308,15 +295,15 @@ display (non-nil means on)." (timeclock-update-mode-line) (message "Activate `display-time-mode' or turn off \ `timeclock-use-display-time' to see timeclock information")) - (add-hook 'display-time-hook 'timeclock-update-mode-line)) + (add-hook 'display-time-hook #'timeclock-update-mode-line)) (setq timeclock-update-timer (run-at-time nil 60 'timeclock-update-mode-line)))) (setq global-mode-string (delq 'timeclock-mode-string global-mode-string)) - (remove-hook 'timeclock-event-hook 'timeclock-update-mode-line) + (remove-hook 'timeclock-event-hook #'timeclock-update-mode-line) (if (boundp 'display-time-hook) (remove-hook 'display-time-hook - 'timeclock-update-mode-line)) + #'timeclock-update-mode-line)) (when timeclock-update-timer (cancel-timer timeclock-update-timer) (setq timeclock-update-timer nil)))) @@ -365,7 +352,8 @@ discover the name of the project." (if (not (= workday timeclock-workday)) (timeclock-log "h" (number-to-string (/ workday (if (zerop (% workday (* 60 60))) - 60 60.0) 60)))))) + 60 60.0) + 60)))))) (timeclock-log "i" (or project (and timeclock-get-project-function (or find-project @@ -417,12 +405,11 @@ If SHOW-SECONDS is non-nil, display second resolution. If TODAY-ONLY is non-nil, the display will be relative only to time worked today, ignoring the time worked on previous days." (interactive "P") - (let ((remainder (timeclock-workday-remaining - (or today-only - (not timeclock-relative)))) - (last-in (equal (car timeclock-last-event) "i")) - status) - (setq status + (let* ((remainder (timeclock-workday-remaining + (or today-only + (not timeclock-relative)))) + (last-in (equal (car timeclock-last-event) "i")) + (status (format "Currently %s since %s (%s), %s %s, leave at %s" (if last-in "IN" "OUT") (if show-seconds @@ -435,7 +422,7 @@ worked today, ignoring the time worked on previous days." (timeclock-seconds-to-string remainder show-seconds t) (if (> remainder 0) "remaining" "over") - (timeclock-when-to-leave-string show-seconds today-only))) + (timeclock-when-to-leave-string show-seconds today-only)))) (if (called-interactively-p 'interactive) (message "%s" status) status))) @@ -623,7 +610,7 @@ arguments of `completing-read'." (format "Clock into which project (default %s): " (or timeclock-last-project (car timeclock-project-list))) - (mapcar 'list timeclock-project-list) + timeclock-project-list (or timeclock-last-project (car timeclock-project-list)))) @@ -632,7 +619,7 @@ arguments of `completing-read'." (defun timeclock-ask-for-reason () "Ask the user for the reason they are clocking out." (timeclock-completing-read "Reason for clocking out: " - (mapcar 'list timeclock-reason-list))) + timeclock-reason-list)) (define-obsolete-function-alias 'timeclock-update-modeline 'timeclock-update-mode-line "24.3") @@ -700,7 +687,7 @@ being logged for. Normally only \"in\" events specify a project." "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)\\s-+" "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)[ \t]*" "\\([^\n]*\\)")) -(defsubst timeclock-read-moment () +(defun timeclock-read-moment () "Read the moment under point from the timelog." (if (looking-at timeclock-moment-regexp) (let ((code (match-string 1)) @@ -725,27 +712,19 @@ This is only provided for coherency when used by (float-time (cadr timeclock-last-event))) timeclock-last-period)) +(cl-defstruct (timeclock-entry + (:constructor nil) (:copier nil) + (:type list)) + begin end project comment + ;; FIXME: Documented in docstring of timeclock-log-data, but I can't see + ;; where it's used in the code. + final-p) + (defsubst timeclock-entry-length (entry) "Return the length of ENTRY in seconds." (- (float-time (cadr entry)) (float-time (car entry)))) -(defsubst timeclock-entry-begin (entry) - "Return the start time of ENTRY." - (car entry)) - -(defsubst timeclock-entry-end (entry) - "Return the end time of ENTRY." - (cadr entry)) - -(defsubst timeclock-entry-project (entry) - "Return the project of ENTRY." - (nth 2 entry)) - -(defsubst timeclock-entry-comment (entry) - "Return the comment of ENTRY." - (nth 3 entry)) - (defsubst timeclock-entry-list-length (entry-list) "Return the total length of ENTRY-LIST in seconds." (let ((length 0)) @@ -771,14 +750,11 @@ This is only provided for coherency when used by (- (timeclock-entry-list-span entry-list) (timeclock-entry-list-length entry-list))) -(defsubst timeclock-entry-list-projects (entry-list) +(defun timeclock-entry-list-projects (entry-list) "Return a list of all the projects in ENTRY-LIST." - (let (projects proj) + (let (projects) (dolist (entry entry-list) - (setq proj (timeclock-entry-project entry)) - (if projects - (add-to-list 'projects proj) - (setq projects (list proj)))) + (cl-pushnew (timeclock-entry-project entry) projects :test #'equal)) projects)) (defsubst timeclock-day-required (day) @@ -854,9 +830,7 @@ This is only provided for coherency when used by (let (projects) (dolist (day day-list) (dolist (proj (timeclock-day-projects day)) - (if projects - (add-to-list 'projects proj) - (setq projects (list proj))))) + (cl-pushnew proj projects :test #'equal))) projects)) (defsubst timeclock-current-debt (&optional log-data) @@ -871,7 +845,7 @@ This is only provided for coherency when used by "Return a list of the cdrs of the date alist from LOG-DATA." (let (day-list) (dolist (date-list (timeclock-day-alist log-data)) - (setq day-list (cons (cdr date-list) day-list))) + (push (cdr date-list) day-list)) day-list)) (defsubst timeclock-project-alist (&optional log-data) @@ -1022,54 +996,55 @@ See the documentation for the given function if more info is needed." (and beg (not last) (setq last t event (list "o" now)))) (setq line (1+ line)) - (cond ((equal (car event) "b") - (setcar log-data (string-to-number (nth 2 event)))) - ((equal (car event) "h") - (setq last-date-limited (timeclock-time-to-date (cadr event)) - last-date-seconds (* (string-to-number (nth 2 event)) - 3600.0))) - ((equal (car event) "i") - (if beg - (error "Error in format of timelog file, line %d" line) - (setq beg t)) - (setq entry (list (cadr event) nil - (and (> (length (nth 2 event)) 0) - (nth 2 event)))) - (let ((date (timeclock-time-to-date (cadr event)))) - (if (and last-date - (not (equal date last-date))) - (progn - (setcar (cdr log-data) - (cons (cons last-date day) - (cadr log-data))) - (setq day (list (and last-date-limited - last-date-seconds)))) - (unless day - (setq day (list (and last-date-limited - last-date-seconds))))) - (setq last-date date - last-date-limited nil))) - ((equal (downcase (car event)) "o") - (if (not beg) - (error "Error in format of timelog file, line %d" line) - (setq beg nil)) - (setcar (cdr entry) (cadr event)) - (let ((desc (and (> (length (nth 2 event)) 0) - (nth 2 event)))) - (if desc - (nconc entry (list (nth 2 event)))) - (if (equal (car event) "O") - (nconc entry (if desc - (list t) - (list nil t)))) - (nconc day (list entry)) - (setq desc (nth 2 entry)) - (let ((proj (assoc desc (nth 2 log-data)))) - (if (null proj) - (setcar (cddr log-data) - (cons (cons desc (list entry)) - (nth 2 log-data))) - (nconc (cdr proj) (list entry))))))) + (pcase (car event) + ("b" + (setcar log-data (string-to-number (nth 2 event)))) + ("h" + (setq last-date-limited (timeclock-time-to-date (cadr event)) + last-date-seconds (* (string-to-number (nth 2 event)) + 3600.0))) + ("i" + (if beg + (error "Error in format of timelog file, line %d" line) + (setq beg t)) + (setq entry (list (cadr event) nil + (and (> (length (nth 2 event)) 0) + (nth 2 event)))) + (let ((date (timeclock-time-to-date (cadr event)))) + (if (and last-date + (not (equal date last-date))) + (progn + (setcar (cdr log-data) + (cons (cons last-date day) + (cadr log-data))) + (setq day (list (and last-date-limited + last-date-seconds)))) + (unless day + (setq day (list (and last-date-limited + last-date-seconds))))) + (setq last-date date + last-date-limited nil))) + ((or "o" "O") + (if (not beg) + (error "Error in format of timelog file, line %d" line) + (setq beg nil)) + (setcar (cdr entry) (cadr event)) + (let ((desc (and (> (length (nth 2 event)) 0) + (nth 2 event)))) + (if desc + (nconc entry (list (nth 2 event)))) + (if (equal (car event) "O") + (nconc entry (if desc + (list t) + (list nil t)))) + (nconc day (list entry)) + (setq desc (nth 2 entry)) + (let ((proj (assoc desc (nth 2 log-data)))) + (if (null proj) + (setcar (cddr log-data) + (cons (cons desc (list entry)) + (nth 2 log-data))) + (nconc (cdr proj) (list entry))))))) (forward-line)) (if day (setcar (cdr log-data) @@ -1185,14 +1160,12 @@ If optional argument TIME is non-nil, use that instead of the current time." (defun timeclock-mean (l) "Compute the arithmetic mean of the values in the list L." - (let ((total 0) - (count 0)) - (dolist (thisl l) - (setq total (+ total thisl) - count (1+ count))) - (if (zerop count) - 0 - (/ total count)))) + (if (not (consp l)) + 0 + (let ((total 0)) + (dolist (thisl l) + (setq total (+ total thisl))) + (/ total (length l))))) (defun timeclock-generate-report (&optional html-p) "Generate a summary report based on the current timelog file. @@ -1296,81 +1269,69 @@ HTML-P is non-nil, HTML markup is added." six-months-ago one-year-ago))) ;; collect statistics from complete timelog (dolist (day day-list) - (let ((i 0) (l 5)) - (while (< i l) - (unless (time-less-p - (timeclock-day-begin day) - (aref lengths i)) - (let ((base (float-time - (timeclock-day-base - (timeclock-day-begin day))))) - (nconc (aref time-in i) - (list (- (float-time (timeclock-day-begin day)) - base))) - (let ((span (timeclock-day-span day)) - (len (timeclock-day-length day)) - (req (timeclock-day-required day))) - ;; If the day's actual work length is less than - ;; 70% of its span, then likely the exit time - ;; and break amount are not worthwhile adding to - ;; the statistic - (when (and (> span 0) - (> (/ (float len) (float span)) 0.70)) - (nconc (aref time-out i) - (list (- (float-time (timeclock-day-end day)) - base))) - (nconc (aref breaks i) (list (- span len)))) - (if req - (setq len (+ len (- timeclock-workday req)))) - (nconc (aref workday i) (list len))))) - (setq i (1+ i))))) + (dotimes (i 5) + (unless (time-less-p + (timeclock-day-begin day) + (aref lengths i)) + (let ((base (float-time + (timeclock-day-base + (timeclock-day-begin day))))) + (nconc (aref time-in i) + (list (- (float-time (timeclock-day-begin day)) + base))) + (let ((span (timeclock-day-span day)) + (len (timeclock-day-length day)) + (req (timeclock-day-required day))) + ;; If the day's actual work length is less than + ;; 70% of its span, then likely the exit time + ;; and break amount are not worthwhile adding to + ;; the statistic + (when (and (> span 0) + (> (/ (float len) (float span)) 0.70)) + (nconc (aref time-out i) + (list (- (float-time (timeclock-day-end day)) + base))) + (nconc (aref breaks i) (list (- span len)))) + (if req + (setq len (+ len (- timeclock-workday req)))) + (nconc (aref workday i) (list len))))))) ;; average statistics - (let ((i 0) (l 5)) - (while (< i l) - (aset time-in i (timeclock-mean (cdr (aref time-in i)))) - (aset time-out i (timeclock-mean (cdr (aref time-out i)))) - (aset breaks i (timeclock-mean (cdr (aref breaks i)))) - (aset workday i (timeclock-mean (cdr (aref workday i)))) - (setq i (1+ i)))) + (dotimes (i 5) + (aset time-in i (timeclock-mean (cdr (aref time-in i)))) + (aset time-out i (timeclock-mean (cdr (aref time-out i)))) + (aset breaks i (timeclock-mean (cdr (aref breaks i)))) + (aset workday i (timeclock-mean (cdr (aref workday i))))) ;; Output the HTML table (insert "\n") (insert "Time in\n") - (let ((i 0) (l 5)) - (while (< i l) - (insert "" - (timeclock-seconds-to-string (aref time-in i)) - "\n") - (setq i (1+ i)))) + (dotimes (i 5) + (insert "" + (timeclock-seconds-to-string (aref time-in i)) + "\n")) (insert "\n") (insert "\n") (insert "Time out\n") - (let ((i 0) (l 5)) - (while (< i l) - (insert "" - (timeclock-seconds-to-string (aref time-out i)) - "\n") - (setq i (1+ i)))) + (dotimes (i 5) + (insert "" + (timeclock-seconds-to-string (aref time-out i)) + "\n")) (insert "\n") (insert "\n") (insert "Break\n") - (let ((i 0) (l 5)) - (while (< i l) - (insert "" - (timeclock-seconds-to-string (aref breaks i)) - "\n") - (setq i (1+ i)))) + (dotimes (i 5) + (insert "" + (timeclock-seconds-to-string (aref breaks i)) + "\n")) (insert "\n") (insert "\n") (insert "Workday\n") - (let ((i 0) (l 5)) - (while (< i l) - (insert "" - (timeclock-seconds-to-string (aref workday i)) - "\n") - (setq i (1+ i)))) + (dotimes (i 5) + (insert "" + (timeclock-seconds-to-string (aref workday i)) + "\n")) (insert "\n")) (insert " @@ -1393,6 +1354,7 @@ HTML-P is non-nil, HTML markup is added." ;; make sure we know the list of reasons, projects, and have computed ;; the last event and current discrepancy. (if (file-readable-p timeclock-file) + ;; FIXME: Loading a file should not have these kinds of side-effects. (timeclock-reread-log)) ;;; timeclock.el ends here From cd7caee630f9425a1a16e4da31e892a2ec29ac09 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 9 Oct 2018 17:46:31 +0300 Subject: [PATCH 59/72] Unbreak 'revert-buffer' in Occur buffers * lisp/replace.el (occur-revert-function): Use the value of occur-revert-function from the correct buffer. (Bug#32987) * test/lisp/replace-tests.el (replace-occur-revert-bug32543) (replace-occur-revert-bug32987): New tests. --- lisp/replace.el | 16 ++++++------- test/lisp/replace-tests.el | 47 +++++++++++++++++++++++++++++++++++++- 2 files changed, 54 insertions(+), 9 deletions(-) diff --git a/lisp/replace.el b/lisp/replace.el index 00b2ceee356..04e5d4273e0 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1226,14 +1226,14 @@ the user called `occur'." (pcase-let ((`(,region-start ,region-end ,orig-line ,buffer) (occur--parse-occur-buffer)) (regexp (car occur-revert-arguments))) - (with-current-buffer buffer - (when (wholenump orig-line) - (goto-char (point-min)) - (forward-line (1- orig-line))) - (save-excursion - (if (or region-start region-end) - (occur regexp nil (list (cons region-start region-end))) - (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))))))))) + (if (not (or region-start region-end)) + (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))) + (with-current-buffer buffer + (when (wholenump orig-line) + (goto-char (point-min)) + (forward-line (1- orig-line))) + (save-excursion + (occur regexp nil (list (cons region-start region-end))))))))) (defun occur-mode-find-occurrence () (let ((pos (get-text-property (point) 'occur-target))) diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el index 3fcdce6704f..5a91a2cc7f6 100644 --- a/test/lisp/replace-tests.el +++ b/test/lisp/replace-tests.el @@ -359,6 +359,52 @@ Each element has the format: (dotimes (i (length replace-occur-tests)) (replace-occur-test-create i)) +(ert-deftest replace-occur-revert-bug32543 () + "Test `occur-revert' with non-nil `list-matching-lines-jump-to-current-line'." + (let ((temp-buffer (get-buffer-create " *test-occur*"))) + (unwind-protect + (save-window-excursion + (with-current-buffer temp-buffer + (erase-buffer) + (setq list-matching-lines-jump-to-current-line t) + (insert +";; This buffer is for text that is not saved, and for Lisp evaluation. +;; To create a file, visit it with C-x C-f and enter text in its buffer. + +") + (occur "and") + (with-current-buffer "*Occur*" + (revert-buffer) + (goto-char (point-min)) + (should (string-match "\\`2 matches for \"and\" in buffer: " + (buffer-substring-no-properties + (point) (line-end-position))))))) + (and (buffer-name temp-buffer) + (kill-buffer temp-buffer))))) + +(ert-deftest replace-occur-revert-bug32987 () + "Test `occur-revert' with non-nil `list-matching-lines-jump-to-current-line'." + (let ((temp-buffer (get-buffer-create " *test-occur*"))) + (unwind-protect + (save-window-excursion + (with-current-buffer temp-buffer + (erase-buffer) + (setq list-matching-lines-jump-to-current-line nil) + (insert +";; This buffer is for text that is not saved, and for Lisp evaluation. +;; To create a file, visit it with C-x C-f and enter text in its buffer. + +") + (occur "and") + (with-current-buffer "*Occur*" + (revert-buffer) + (goto-char (point-min)) + (should (string-match "\\`2 matches for \"and\" in buffer: " + (buffer-substring-no-properties + (point) (line-end-position))))))) + (and (buffer-name temp-buffer) + (kill-buffer temp-buffer))))) + ;;; Tests for `query-replace' undo feature. @@ -454,5 +500,4 @@ Return the last evalled form in BODY." input "a" "B" ((?\s . (1 2 3)) (?E . (4)) (?U . (5))) ?q (string= input (buffer-string)))))) - ;;; replace-tests.el ends here From 5d1fbe25d48ba3ab663afcfe8ee8d5236e8f4cb5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 9 Oct 2018 10:47:13 -0400 Subject: [PATCH 60/72] * lisp/replace.el: Rework implementation of the occur region Put the region info in the "list of buffers" used for multi-occur. (occur--parse-occur-buffer): Remove. (occur): Pass the region to occur-1 as an overlay. (occur-1): 'bufs' is now a list of buffers or overlays. (occur-engine): 'buffers' is now a list of buffers or overlays. --- lisp/replace.el | 204 ++++++++++++++++++++++-------------------------- 1 file changed, 92 insertions(+), 112 deletions(-) diff --git a/lisp/replace.el b/lisp/replace.el index 00b2ceee356..a134e4e3e58 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1099,10 +1099,9 @@ a previously found match." map) "Keymap for `occur-mode'.") -(defvar occur-revert-arguments nil +(defvar-local occur-revert-arguments nil "Arguments to pass to `occur-1' to revert an Occur mode buffer. See `occur-revert-function'.") -(make-variable-buffer-local 'occur-revert-arguments) (put 'occur-revert-arguments 'permanent-local t) (defcustom occur-mode-hook '(turn-on-font-lock) @@ -1130,8 +1129,8 @@ for this is to reveal context in an outline-mode when the occurrence is hidden." Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. \\{occur-mode-map}" - (set (make-local-variable 'revert-buffer-function) 'occur-revert-function) - (setq next-error-function 'occur-next-error)) + (setq-local revert-buffer-function #'occur-revert-function) + (setq next-error-function #'occur-next-error)) ;;; Occur Edit mode @@ -1154,7 +1153,7 @@ the originating buffer. To return to ordinary Occur mode, use \\[occur-cease-edit]." (setq buffer-read-only nil) - (add-hook 'after-change-functions 'occur-after-change-function nil t) + (add-hook 'after-change-functions #'occur-after-change-function nil t) (message (substitute-command-keys "Editing: Type \\[occur-cease-edit] to return to Occur mode."))) @@ -1206,34 +1205,9 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]." (move-to-column col))))))) -(defun occur--parse-occur-buffer() - "Retrieve a list of the form (BEG END ORIG-LINE BUFFER). -BEG and END define the region. -ORIG-LINE and BUFFER are the line and the buffer from which -the user called `occur'." - (save-excursion - (goto-char (point-min)) - (let ((buffer (get-text-property (point) 'occur-title)) - (beg-pos (get-text-property (point) 'region-start)) - (end-pos (get-text-property (point) 'region-end)) - (orig-line (get-text-property (point) 'current-line))) - (list beg-pos end-pos orig-line buffer)))) - (defun occur-revert-function (_ignore1 _ignore2) "Handle `revert-buffer' for Occur mode buffers." - (if (cdr (nth 2 occur-revert-arguments)) ; multi-occur - (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))) - (pcase-let ((`(,region-start ,region-end ,orig-line ,buffer) - (occur--parse-occur-buffer)) - (regexp (car occur-revert-arguments))) - (with-current-buffer buffer - (when (wholenump orig-line) - (goto-char (point-min)) - (forward-line (1- orig-line))) - (save-excursion - (if (or region-start region-end) - (occur regexp nil (list (cons region-start region-end))) - (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))))))))) + (apply #'occur-1 (append occur-revert-arguments (list (buffer-name))))) (defun occur-mode-find-occurrence () (let ((pos (get-text-property (point) 'occur-target))) @@ -1487,23 +1461,14 @@ is not modified." (and (use-region-p) (list (region-bounds))))) (let* ((start (and (caar region) (max (caar region) (point-min)))) (end (and (cdar region) (min (cdar region) (point-max)))) - (in-region-p (or start end))) - (when in-region-p - (or start (setq start (point-min))) - (or end (setq end (point-max)))) - (let ((occur--region-start start) - (occur--region-end end) - (occur--region-start-line - (and in-region-p - (line-number-at-pos (min start end)))) - (occur--orig-line - (line-number-at-pos (point)))) - (save-excursion ; If no matches `occur-1' doesn't restore the point. - (and in-region-p (narrow-to-region - (save-excursion (goto-char start) (line-beginning-position)) - (save-excursion (goto-char end) (line-end-position)))) - (occur-1 regexp nlines (list (current-buffer))) - (and in-region-p (widen)))))) + (in-region (or start end)) + (bufs (if (not in-region) (list (current-buffer)) + (let ((ol (make-overlay + (or start (point-min)) + (or end (point-max))))) + (overlay-put ol 'occur--orig-point (point)) + (list ol))))) + (occur-1 regexp nlines bufs))) (defvar ido-ignore-item-temp-list) @@ -1574,17 +1539,27 @@ See also `multi-occur'." (query-replace-descr regexp)))) (defun occur-1 (regexp nlines bufs &optional buf-name) + ;; BUFS is a list of buffer-or-overlay! (unless (and regexp (not (equal regexp ""))) (error "Occur doesn't work with the empty regexp")) (unless buf-name (setq buf-name "*Occur*")) (let (occur-buf - (active-bufs (delq nil (mapcar #'(lambda (buf) - (when (buffer-live-p buf) buf)) - bufs)))) + (active-bufs + (delq nil (mapcar (lambda (boo) + (when (or (buffer-live-p boo) + (and (overlayp boo) + (overlay-buffer boo))) + boo)) + bufs)))) ;; Handle the case where one of the buffers we're searching is the ;; output buffer. Just rename it. - (when (member buf-name (mapcar 'buffer-name active-bufs)) + (when (member buf-name + ;; FIXME: Use cl-exists. + (mapcar + (lambda (boo) + (buffer-name (if (overlayp boo) (overlay-buffer boo) boo))) + active-bufs)) (with-current-buffer (get-buffer buf-name) (rename-uniquely))) @@ -1604,22 +1579,24 @@ See also `multi-occur'." (let ((count (if (stringp nlines) ;; Treat nlines as a regexp to collect. - (let ((bufs active-bufs) - (count 0)) - (while bufs - (with-current-buffer (car bufs) + (let ((count 0)) + (dolist (boo active-bufs) + (with-current-buffer + (if (overlayp boo) (overlay-buffer boo) boo) (save-excursion - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - ;; Insert the replacement regexp. - (let ((str (match-substitute-replacement nlines))) - (if str - (with-current-buffer occur-buf - (insert str) - (setq count (1+ count)) - (or (zerop (current-column)) - (insert "\n")))))))) - (setq bufs (cdr bufs))) + (goto-char + (if (overlayp boo) (overlay-start boo) (point-min))) + (let ((end (if (overlayp boo) (overlay-end boo)))) + (while (re-search-forward regexp end t) + ;; Insert the replacement regexp. + (let ((str (match-substitute-replacement + nlines))) + (if str + (with-current-buffer occur-buf + (insert str) + (setq count (1+ count)) + (or (zerop (current-column)) + (insert "\n")))))))))) count) ;; Perform normal occur. (occur-engine @@ -1662,49 +1639,54 @@ See also `multi-occur'." (defun occur-engine (regexp buffers out-buf nlines case-fold title-face prefix-face match-face keep-props) + ;; BUFFERS is a list of buffer-or-overlay! (with-current-buffer out-buf (let ((global-lines 0) ;; total count of matching lines (global-matches 0) ;; total count of matches (coding nil) (case-fold-search case-fold) - (in-region-p (and occur--region-start occur--region-end)) (multi-occur-p (cdr buffers))) ;; Map over all the buffers - (dolist (buf buffers) - (when (buffer-live-p buf) - (let ((lines 0) ;; count of matching lines - (matches 0) ;; count of matches - (curr-line ;; line count - (or occur--region-start-line 1)) - (orig-line (or occur--orig-line 1)) - (orig-line-shown-p) - (prev-line nil) ;; line number of prev match endpt - (prev-after-lines nil) ;; context lines of prev match - (matchbeg 0) - (origpt nil) - (begpt nil) - (endpt nil) - (marker nil) - (curstring "") - (ret nil) - (inhibit-field-text-motion t) - (headerpt (with-current-buffer out-buf (point)))) - (with-current-buffer buf - ;; The following binding is for when case-fold-search - ;; has a local binding in the original buffer, in which - ;; case we cannot bind it globally and let that have - ;; effect in every buffer we search. - (let ((case-fold-search case-fold)) - (or coding - ;; Set CODING only if the current buffer locally - ;; binds buffer-file-coding-system. - (not (local-variable-p 'buffer-file-coding-system)) - (setq coding buffer-file-coding-system)) - (save-excursion - (goto-char (point-min)) ;; begin searching in the buffer - (while (not (eobp)) + (dolist (boo buffers) + (when (if (overlayp boo) (overlay-buffer boo) (buffer-live-p boo)) + (with-current-buffer (if (overlayp boo) (overlay-buffer boo) boo) + (let ((inhibit-field-text-motion t) + (lines 0) ; count of matching lines + (matches 0) ; count of matches + (headerpt (with-current-buffer out-buf (point))) + ) + (save-excursion + ;; begin searching in the buffer + (goto-char (if (overlayp boo) (overlay-start boo) (point-min))) + (forward-line 0) + (let ((limit (if (overlayp boo) (overlay-end boo) (point-max))) + (curr-line (line-number-at-pos)) ; line count + (orig-line (if (not (overlayp boo)) 1 + (line-number-at-pos + (overlay-get boo 'occur--orig-point)))) + (orig-line-shown-p) + (prev-line nil) ; line number of prev match endpt + (prev-after-lines nil) ; context lines of prev match + (matchbeg 0) + (origpt nil) + (begpt nil) + (endpt nil) + (marker nil) + (curstring "") + (ret nil) + ;; The following binding is for when case-fold-search + ;; has a local binding in the original buffer, in which + ;; case we cannot bind it globally and let that have + ;; effect in every buffer we search. + (case-fold-search case-fold)) + (or coding + ;; Set CODING only if the current buffer locally + ;; binds buffer-file-coding-system. + (not (local-variable-p 'buffer-file-coding-system)) + (setq coding buffer-file-coding-system)) + (while (< (point) limit) (setq origpt (point)) - (when (setq endpt (re-search-forward regexp nil t)) + (when (setq endpt (re-search-forward regexp limit t)) (setq lines (1+ lines)) ;; increment matching lines count (setq matchbeg (match-beginning 0)) ;; Get beginning of first match line and end of the last. @@ -1878,17 +1860,14 @@ See also `multi-occur'." ;; Don't display regexp for multi-buffer. (if (> (length buffers) 1) "" (occur-regexp-descr regexp)) - (buffer-name buf) - (if in-region-p + (buffer-name (if (overlayp boo) (overlay-buffer boo) boo)) + (if (overlayp boo) (format " within region: %d-%d" - occur--region-start - occur--region-end) + (overlay-start boo) + (overlay-end boo)) "")) 'read-only t)) (setq end (point)) - (add-text-properties beg end `(occur-title ,buf current-line ,orig-line - region-start ,occur--region-start - region-end ,occur--region-end)) (when title-face (add-face-text-property beg end title-face)) (goto-char (if (and list-matching-lines-jump-to-current-line @@ -2425,7 +2404,7 @@ characters." (message (if query-flag - (apply 'propertize + (apply #'propertize (concat "Query replacing " (if backward "backward " "") (if delimited-flag @@ -2880,10 +2859,11 @@ characters." (if (= replace-count 1) "" "s") (if (> (+ skip-read-only-count skip-filtered-count - skip-invisible-count) 0) + skip-invisible-count) + 0) (format " (skipped %s)" (mapconcat - 'identity + #'identity (delq nil (list (if (> skip-read-only-count 0) (format "%s read-only" From 262f5c809913a232a931131d040964cbdf4ac6f9 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 9 Oct 2018 17:55:15 +0300 Subject: [PATCH 61/72] Revert part of last commit * lisp/replace.el (occur-revert-function): Revert last change, as it's no longer needed. (Bug#32987) --- lisp/replace.el | 14 +------------- 1 file changed, 1 insertion(+), 13 deletions(-) diff --git a/lisp/replace.el b/lisp/replace.el index 7d313842c04..a134e4e3e58 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1207,19 +1207,7 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]." (defun occur-revert-function (_ignore1 _ignore2) "Handle `revert-buffer' for Occur mode buffers." - (if (cdr (nth 2 occur-revert-arguments)) ; multi-occur - (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))) - (pcase-let ((`(,region-start ,region-end ,orig-line ,buffer) - (occur--parse-occur-buffer)) - (regexp (car occur-revert-arguments))) - (if (not (or region-start region-end)) - (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))) - (with-current-buffer buffer - (when (wholenump orig-line) - (goto-char (point-min)) - (forward-line (1- orig-line))) - (save-excursion - (occur regexp nil (list (cons region-start region-end))))))))) + (apply #'occur-1 (append occur-revert-arguments (list (buffer-name))))) (defun occur-mode-find-occurrence () (let ((pos (get-text-property (point) 'occur-target))) From bd013a448b152a84cff9b18292d8272faf265447 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 9 Oct 2018 11:57:22 -0400 Subject: [PATCH 62/72] * lisp/replace.el (occur--garbage-collect-revert-args): New function (occur-mode, occur-1): Use it. (occur--region-start, occur--region-end, occur--region-start-line) (occur--orig-line): Remove vars. (occur-engine): Fix left over use of occur--region-start-line. --- lisp/replace.el | 56 ++++++++++++++++++++++++++----------------------- 1 file changed, 30 insertions(+), 26 deletions(-) diff --git a/lisp/replace.el b/lisp/replace.el index a134e4e3e58..ecb47936e7b 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1121,6 +1121,11 @@ for this is to reveal context in an outline-mode when the occurrence is hidden." :type 'hook :group 'matching) +(defun occur--garbage-collect-revert-args () + (dolist (boo (nth 2 occur-revert-arguments)) + (when (overlayp boo) (delete-overlay boo))) + (kill-local-variable 'occur-revert-arguments)) + (put 'occur-mode 'mode-class 'special) (define-derived-mode occur-mode special-mode "Occur" "Major mode for output from \\[occur]. @@ -1130,6 +1135,7 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. \\{occur-mode-map}" (setq-local revert-buffer-function #'occur-revert-function) + (add-hook 'kill-buffer-hook #'occur--garbage-collect-revert-args nil t) (setq next-error-function #'occur-next-error)) @@ -1411,10 +1417,6 @@ invoke `occur'." (or unique-p (not interactive-p))))) ;; Region limits when `occur' applies on a region. -(defvar occur--region-start nil) -(defvar occur--region-end nil) -(defvar occur--region-start-line nil) -(defvar occur--orig-line nil) (defvar occur--final-pos nil) (defun occur (regexp &optional nlines region) @@ -1624,6 +1626,7 @@ See also `multi-occur'." 42) (window-width)) "" (occur-regexp-descr regexp)))) + (occur--garbage-collect-revert-args) (setq occur-revert-arguments (list regexp nlines bufs)) (if (= count 0) (kill-buffer occur-buf) @@ -1659,26 +1662,27 @@ See also `multi-occur'." ;; begin searching in the buffer (goto-char (if (overlayp boo) (overlay-start boo) (point-min))) (forward-line 0) - (let ((limit (if (overlayp boo) (overlay-end boo) (point-max))) - (curr-line (line-number-at-pos)) ; line count - (orig-line (if (not (overlayp boo)) 1 - (line-number-at-pos - (overlay-get boo 'occur--orig-point)))) - (orig-line-shown-p) - (prev-line nil) ; line number of prev match endpt - (prev-after-lines nil) ; context lines of prev match - (matchbeg 0) - (origpt nil) - (begpt nil) - (endpt nil) - (marker nil) - (curstring "") - (ret nil) - ;; The following binding is for when case-fold-search - ;; has a local binding in the original buffer, in which - ;; case we cannot bind it globally and let that have - ;; effect in every buffer we search. - (case-fold-search case-fold)) + (let* ((limit (if (overlayp boo) (overlay-end boo) (point-max))) + (start-line (line-number-at-pos)) + (curr-line start-line) ; line count + (orig-line (if (not (overlayp boo)) 1 + (line-number-at-pos + (overlay-get boo 'occur--orig-point)))) + (orig-line-shown-p) + (prev-line nil) ; line number of prev match endpt + (prev-after-lines nil) ; context lines of prev match + (matchbeg 0) + (origpt nil) + (begpt nil) + (endpt nil) + (marker nil) + (curstring "") + (ret nil) + ;; The following binding is for when case-fold-search + ;; has a local binding in the original buffer, in which + ;; case we cannot bind it globally and let that have + ;; effect in every buffer we search. + (case-fold-search case-fold)) (or coding ;; Set CODING only if the current buffer locally ;; binds buffer-file-coding-system. @@ -1792,7 +1796,7 @@ See also `multi-occur'." (setq orig-line-shown-p t) (save-excursion (goto-char (point-min)) - (forward-line (- orig-line (or occur--region-start-line 1))) + (forward-line (- orig-line start-line 1)) (occur-engine-line (line-beginning-position) (line-end-position) keep-props))))) ;; Actually insert the match display data @@ -1830,7 +1834,7 @@ See also `multi-occur'." (let ((orig-line-str (save-excursion (goto-char (point-min)) - (forward-line (- orig-line (or occur--region-start-line 1))) + (forward-line (- orig-line start-line 1)) (occur-engine-line (line-beginning-position) (line-end-position) keep-props)))) (add-face-text-property From 1f88943924d4e5c98e209790ee8c69b8ab8621d0 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 9 Oct 2018 09:47:28 -0700 Subject: [PATCH 63/72] Fix malfunctioning cursor display on 32-bit Gtk MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This bug on 32-bit platforms was caused by the timespec_hz definition going haywire because the C expression FIXNUM_OVERFLOW_P (MOST_POSITIVE_FIXNUM) did not work in #if. Eventually the numeric problem showed up as a malfunctioning cursor (Bug#32992). Fix the problem with MOST_POSITIVE_FIXNUM. By the way, make_fixnum should check for integer overflow when debugging; this would have made it easier to track this bug down. But one fix at a time. * src/lisp.h (INTTYPEBITS): Now a macro, so usable in #if. (MOST_POSITIVE_FIXNUM): Mention it’s used in #if. --- src/lisp.h | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index ae329268dc4..2c20b483cad 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -236,13 +236,15 @@ enum Lisp_Bits /* Number of bits in a Lisp_Object value, not counting the tag. */ VALBITS = EMACS_INT_WIDTH - GCTYPEBITS, - /* Number of bits in a Lisp fixnum tag. */ - INTTYPEBITS = GCTYPEBITS - 1, - /* Number of bits in a Lisp fixnum value, not counting the tag. */ FIXNUM_BITS = VALBITS + 1 }; +/* Number of bits in a Lisp fixnum tag; can be used in #if. */ +DEFINE_GDB_SYMBOL_BEGIN (int, INTTYPEBITS) +#define INTTYPEBITS (GCTYPEBITS - 1) +DEFINE_GDB_SYMBOL_END (INTTYPEBITS) + /* The maximum value that can be stored in a EMACS_INT, assuming all bits other than the type bits contribute to a nonnegative signed value. This can be used in #if, e.g., '#if USE_LSB_TAG' below expands to an @@ -1034,7 +1036,7 @@ enum More_Lisp_Bits that cons. */ /* Largest and smallest representable fixnum values. These are the C - values. They are macros for use in static initializers. */ + values. They are macros for use in #if and static initializers. */ #define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS) #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM) From 7f1beabfcdcb58d90aa78db22b9a123faf298749 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 9 Oct 2018 11:16:00 -0700 Subject: [PATCH 64/72] Port --enable-gcc-warnings to recent clang * configure.ac: Disable -Wnull-pointer-arithmetic if clang (Bug#32924). --- configure.ac | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 6f3d7338c35..df910280b43 100644 --- a/configure.ac +++ b/configure.ac @@ -1019,9 +1019,10 @@ AS_IF([test $gl_gcc_warnings = no], gl_WARN_ADD([-Wno-unused-parameter]) # Too many warnings for now gl_WARN_ADD([-Wno-format-nonliteral]) - # clang is unduly picky about braces. + # clang is unduly picky about some things. if test "$emacs_cv_clang" = yes; then gl_WARN_ADD([-Wno-missing-braces]) + gl_WARN_ADD([-Wno-null-pointer-arithmetic]) fi # This causes too much noise in the MinGW build From 86b53729c0fda525a7c0a050fcdc8dea81c8eff1 Mon Sep 17 00:00:00 2001 From: "Charles A. Roelli" Date: Tue, 9 Oct 2018 20:24:45 +0200 Subject: [PATCH 65/72] * lisp/vc/vc.el (vc-retrieve-tag-hook): Remove autoload cookie. See https://lists.gnu.org/r/emacs-devel/2018-10/msg00108.html. --- lisp/vc/vc.el | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 7707999636a..57bc3c2fc73 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -834,7 +834,6 @@ See `run-hooks'." :type 'hook :group 'vc) -;;;###autoload (defcustom vc-retrieve-tag-hook nil "Normal hook (list of functions) run after retrieving a tag." :type 'hook From 7212bf41a92f14401751e9891c402f67b5ce6846 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 10 Oct 2018 09:20:19 -0400 Subject: [PATCH 66/72] * lisp/emacs-lisp/lisp-mnt.el: Use lexical-binding Remove redundant :group --- lisp/emacs-lisp/lisp-mnt.el | 36 +++++++++++++++--------------------- 1 file changed, 15 insertions(+), 21 deletions(-) diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index 127d71ae6ca..5c623a3ab8c 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el @@ -1,4 +1,4 @@ -;;; lisp-mnt.el --- utility functions for Emacs Lisp maintainers +;;; lisp-mnt.el --- utility functions for Emacs Lisp maintainers -*- lexical-binding:t -*- ;; Copyright (C) 1992, 1994, 1997, 2000-2018 Free Software Foundation, ;; Inc. @@ -137,34 +137,28 @@ in your Lisp package: The @(#) construct is used by unix what(1) and then $identifier: doc string $ is used by GNU ident(1)" - :type 'regexp - :group 'lisp-mnt) + :type 'regexp) (defcustom lm-copyright-prefix "^\\(;+[ \t]\\)+Copyright (C) " "Prefix that is ignored before the dates in a copyright. Leading comment characters and whitespace should be in regexp group 1." - :type 'regexp - :group 'lisp-mnt) + :type 'regexp) (defcustom lm-comment-column 16 "Column used for placing formatted output." - :type 'integer - :group 'lisp-mnt) + :type 'integer) (defcustom lm-any-header ".*" "Regexp which matches start of any section." - :type 'regexp - :group 'lisp-mnt) + :type 'regexp) (defcustom lm-commentary-header "Commentary\\|Documentation" "Regexp which matches start of documentation section." - :type 'regexp - :group 'lisp-mnt) + :type 'regexp) (defcustom lm-history-header "Change ?Log\\|History" "Regexp which matches the start of code log section." - :type 'regexp - :group 'lisp-mnt) + :type 'regexp) ;;; Functions: @@ -236,26 +230,26 @@ a section." (while (forward-comment 1)) (point)))))))) -(defsubst lm-code-start () +(defun lm-code-start () "Return the buffer location of the `Code' start marker." (lm-section-start "Code")) (defalias 'lm-code-mark 'lm-code-start) -(defsubst lm-commentary-start () +(defun lm-commentary-start () "Return the buffer location of the `Commentary' start marker." (lm-section-start lm-commentary-header)) (defalias 'lm-commentary-mark 'lm-commentary-start) -(defsubst lm-commentary-end () +(defun lm-commentary-end () "Return the buffer location of the `Commentary' section end." (lm-section-end lm-commentary-header)) -(defsubst lm-history-start () +(defun lm-history-start () "Return the buffer location of the `History' start marker." (lm-section-start lm-history-header)) (defalias 'lm-history-mark 'lm-history-start) -(defsubst lm-copyright-mark () +(defun lm-copyright-mark () "Return the buffer location of the `Copyright' line." (save-excursion (let ((case-fold-search t)) @@ -385,7 +379,7 @@ Each element of the list is a cons; the car is the full name, the cdr is an email address." (lm-with-file file (let ((authorlist (lm-header-multiline "author"))) - (mapcar 'lm-crack-address authorlist)))) + (mapcar #'lm-crack-address authorlist)))) (defun lm-maintainer (&optional file) "Return the maintainer of file FILE, or current buffer if FILE is nil. @@ -453,7 +447,7 @@ each line." (lm-with-file file (let ((keywords (lm-header-multiline "keywords"))) (and keywords - (mapconcat 'downcase keywords " "))))) + (mapconcat #'downcase keywords " "))))) (defun lm-keywords-list (&optional file) "Return list of keywords given in file FILE." @@ -507,7 +501,7 @@ absent, return nil." "Insert, at column COL, list of STRINGS." (if (> (current-column) col) (insert "\n")) (move-to-column col t) - (apply 'insert strings)) + (apply #'insert strings)) (defun lm-verify (&optional file showok verbose non-fsf-ok) "Check that the current buffer (or FILE if given) is in proper format. From fd3a48fcd8bb212ec12b9b10a79de0ae605ee93b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 10 Oct 2018 09:45:09 -0400 Subject: [PATCH 67/72] * lisp/auth-source.el: Minor simplification Remove redundant :group args. (auth-source-backend-parse): Use run-hook-with-args-until-success. --- lisp/auth-source.el | 27 +++++++++------------------ 1 file changed, 9 insertions(+), 18 deletions(-) diff --git a/lisp/auth-source.el b/lisp/auth-source.el index eb262a13df4..fd529b392ab 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -83,7 +83,6 @@ expiring. Overrides `password-cache-expiry' through a let-binding." :version "24.1" - :group 'auth-source :type '(choice (const :tag "Never" nil) (const :tag "All Day" 86400) (const :tag "2 Hours" 7200) @@ -139,7 +138,6 @@ let-binding." (smtp "smtp" "25")) "List of authentication protocols and their names" - :group 'auth-source :version "23.2" ;; No Gnus :type '(repeat :tag "Authentication Protocols" (cons :tag "Protocol Entry" @@ -168,7 +166,6 @@ let-binding." (defcustom auth-source-save-behavior 'ask "If set, auth-source will respect it for save behavior." - :group 'auth-source :version "23.2" ;; No Gnus :type `(choice :tag "auth-source new token save behavior" @@ -183,7 +180,6 @@ let-binding." "Set this to tell auth-source when to create GPG password tokens in netrc files. It's either an alist or `never'. Note that if EPA/EPG is not available, this should NOT be used." - :group 'auth-source :version "23.2" ;; No Gnus :type `(choice (const :tag "Always use GPG password tokens" (t gpg)) @@ -203,7 +199,6 @@ Note that if EPA/EPG is not available, this should NOT be used." (defcustom auth-source-do-cache t "Whether auth-source should cache information with `password-cache'." - :group 'auth-source :version "23.2" ;; No Gnus :type `boolean) @@ -218,7 +213,6 @@ for passwords). If the value is a function, debug messages are logged by calling that function using the same arguments as `message'." - :group 'auth-source :version "23.2" ;; No Gnus :type `(choice :tag "auth-source debugging mode" @@ -241,7 +235,6 @@ for details. It's best to customize this with `\\[customize-variable]' because the choices can get pretty complex." - :group 'auth-source :version "26.1" ; neither new nor changed default :type `(repeat :tag "Authentication Sources" (choice @@ -311,7 +304,6 @@ can get pretty complex." (defcustom auth-source-gpg-encrypt-to t "List of recipient keys that `authinfo.gpg' encrypted to. If the value is not a list, symmetric encryption will be used." - :group 'auth-source :version "24.1" ;; No Gnus :type '(choice (const :tag "Symmetric encryption" t) (repeat :tag "Recipient public keys" @@ -363,10 +355,9 @@ soon as a function returns non-nil.") (defun auth-source-backend-parse (entry) "Create an auth-source-backend from an ENTRY in `auth-sources'." - (let (backend) - (cl-dolist (f auth-source-backend-parser-functions) - (when (setq backend (funcall f entry)) - (cl-return))) + (let ((backend + (run-hook-with-args-until-success 'auth-source-backend-parser-functions + entry))) (unless backend ;; none of the parsers worked @@ -416,7 +407,7 @@ soon as a function returns non-nil.") :create-function #'auth-source-netrc-create)))))) ;; Note this function should be last in the parser functions, so we add it first -(add-hook 'auth-source-backend-parser-functions 'auth-source-backends-parser-file) +(add-hook 'auth-source-backend-parser-functions #'auth-source-backends-parser-file) (defun auth-source-backends-parser-macos-keychain (entry) ;; take macos-keychain-{internet,generic}:XYZ and use it as macOS @@ -463,7 +454,7 @@ soon as a function returns non-nil.") :search-function #'auth-source-macos-keychain-search :create-function #'auth-source-macos-keychain-create))))) -(add-hook 'auth-source-backend-parser-functions 'auth-source-backends-parser-macos-keychain) +(add-hook 'auth-source-backend-parser-functions #'auth-source-backends-parser-macos-keychain) (defun auth-source-backends-parser-secrets (entry) ;; take secrets:XYZ and use it as Secrets API collection "XYZ" @@ -510,7 +501,7 @@ soon as a function returns non-nil.") :source "" :type 'ignore)))))) -(add-hook 'auth-source-backend-parser-functions 'auth-source-backends-parser-secrets) +(add-hook 'auth-source-backend-parser-functions #'auth-source-backends-parser-secrets) (defun auth-source-backend-parse-parameters (entry backend) "Fills in the extra auth-source-backend parameters of ENTRY. @@ -528,7 +519,7 @@ parameters." (oset backend port val))) backend) -;; (mapcar 'auth-source-backend-parse auth-sources) +;; (mapcar #'auth-source-backend-parse auth-sources) (cl-defun auth-source-search (&rest spec &key max require create delete @@ -2176,8 +2167,8 @@ entries for git.gnus.org: (plstore-save (oref backend data))))) ;;; Backend specific parsing: JSON backend -;;; (auth-source-search :max 1 :machine "imap.gmail.com") -;;; (auth-source-search :max 1 :host '("my-gmail" "imap.gmail.com") :port '(993 "imaps" "imap" "993" "143") :user nil :require '(:user :secret)) +;; (auth-source-search :max 1 :machine "imap.gmail.com") +;; (auth-source-search :max 1 :host '("my-gmail" "imap.gmail.com") :port '(993 "imaps" "imap" "993" "143") :user nil :require '(:user :secret)) (defun auth-source-json-check (host user port require item) (and item From 5bd8cfc14d4b0c78c07e65a583f42a10c4cbc06d Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 10 Oct 2018 23:17:18 -0700 Subject: [PATCH 68/72] Fix mishandling of symbols that look like numbers * src/bignum.c (make_neg_biguint): New function. * src/lread.c (read1): Do not mishandle an unquoted symbol with name equal to something like "1\0x", i.e., a string of numeric form followed by a NUL byte. Formerly these symbols were misread as numbers. (string_to_number): Change last argument from an integer flag to a pointer to the length. This lets the caller figure out how much of the prefix was used. All callers changed. Add a fast path if the integer (sans sign) fits in uintmax_t. Update comments and simplify now that bignums are present. * src/print.c (print_object): Fix quoting of symbols that look like numbers, by relying on string_to_number for the tricky cases rather than trying to redo its logic, incorrectly. For example, (read (prin1-to-string '\1e+NaN)) formerly returned "1e+NaN", which was wrong: a backslash is needed in the output to prevent it from being read as a NaN. Escape NO_BREAK_SPACE too, since lread.c treats it like SPACE. * test/src/print-tests.el (print-read-roundtrip): Add tests illustrating the abovementioned bugs. --- src/bignum.c | 10 ++++ src/data.c | 2 +- src/lisp.h | 5 +- src/lread.c | 100 ++++++++++++++++++++-------------------- src/print.c | 47 ++++++------------- src/process.c | 7 ++- test/src/print-tests.el | 16 ++++++- 7 files changed, 98 insertions(+), 89 deletions(-) diff --git a/src/bignum.c b/src/bignum.c index 0ab8de3ab7a..e3db0377a53 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -117,6 +117,16 @@ make_biguint (uintmax_t n) return make_bignum (); } +/* Return a Lisp integer equal to -N, which must not be in fixnum range. */ +Lisp_Object +make_neg_biguint (uintmax_t n) +{ + eassert (-MOST_NEGATIVE_FIXNUM < n); + mpz_set_uintmax (mpz[0], n); + mpz_neg (mpz[0], mpz[0]); + return make_bignum (); +} + /* Return a Lisp integer with value taken from mpz[0]. Set mpz[0] to a junk value. */ Lisp_Object diff --git a/src/data.c b/src/data.c index 5f1d059512d..538081e5c9b 100644 --- a/src/data.c +++ b/src/data.c @@ -2796,7 +2796,7 @@ If the base used is not 10, STRING is always parsed as an integer. */) while (*p == ' ' || *p == '\t') p++; - Lisp_Object val = string_to_number (p, b, S2N_IGNORE_TRAILING); + Lisp_Object val = string_to_number (p, b, 0); return NILP (val) ? make_fixnum (0) : val; } diff --git a/src/lisp.h b/src/lisp.h index 2c20b483cad..5ecc48b025c 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2506,7 +2506,7 @@ INTEGERP (Lisp_Object x) return FIXNUMP (x) || BIGNUMP (x); } -/* Return a Lisp integer with value taken from n. */ +/* Return a Lisp integer with value taken from N. */ INLINE Lisp_Object make_int (intmax_t n) { @@ -3329,6 +3329,7 @@ extern ptrdiff_t bignum_bufsize (Lisp_Object, int); extern ptrdiff_t bignum_to_c_string (char *, ptrdiff_t, Lisp_Object, int); extern Lisp_Object bignum_to_string (Lisp_Object, int); extern Lisp_Object make_bignum_str (char const *, int); +extern Lisp_Object make_neg_biguint (uintmax_t); extern Lisp_Object double_to_integer (double); /* Converthe integer NUM to *N. Return true if successful, false @@ -3839,7 +3840,7 @@ LOADHIST_ATTACH (Lisp_Object x) extern int openp (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object *, Lisp_Object, bool); enum { S2N_IGNORE_TRAILING = 1 }; -extern Lisp_Object string_to_number (char const *, int, int); +extern Lisp_Object string_to_number (char const *, int, ptrdiff_t *); extern void map_obarray (Lisp_Object, void (*) (Lisp_Object, Lisp_Object), Lisp_Object); extern void dir_warning (const char *, Lisp_Object); diff --git a/src/lread.c b/src/lread.c index 73e38d89954..62616cb6819 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2354,12 +2354,14 @@ character_name_to_code (char const *name, ptrdiff_t name_len) { /* For "U+XXXX", pass the leading '+' to string_to_number to reject monstrosities like "U+-0000". */ + ptrdiff_t len = name_len - 1; Lisp_Object code = (name[0] == 'U' && name[1] == '+' - ? string_to_number (name + 1, 16, 0) + ? string_to_number (name + 1, 16, &len) : call2 (Qchar_from_name, make_unibyte_string (name, name_len), Qt)); if (! RANGED_FIXNUMP (0, code, MAX_UNICODE_CHAR) + || len != name_len - 1 || char_surrogate_p (XFIXNUM (code))) { AUTO_STRING (format, "\\N{%s}"); @@ -3531,12 +3533,14 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) || strchr ("\"';()[]#`,", c) == NULL)); *p = 0; + ptrdiff_t nbytes = p - read_buffer; UNREAD (c); if (!quoted && !uninterned_symbol) { - Lisp_Object result = string_to_number (read_buffer, 10, 0); - if (! NILP (result)) + ptrdiff_t len; + Lisp_Object result = string_to_number (read_buffer, 10, &len); + if (! NILP (result) && len == nbytes) return unbind_to (count, result); } if (!quoted && multibyte) @@ -3548,7 +3552,6 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) } { Lisp_Object result; - ptrdiff_t nbytes = p - read_buffer; ptrdiff_t nchars = (multibyte ? multibyte_chars_in_text ((unsigned char *) read_buffer, @@ -3700,18 +3703,18 @@ substitute_in_interval (INTERVAL interval, void *arg) } -/* Convert STRING to a number, assuming base BASE. When STRING has - floating point syntax and BASE is 10, return a nearest float. When - STRING has integer syntax, return a fixnum if the integer fits, or - else a bignum. Otherwise, return nil. If FLAGS & - S2N_IGNORE_TRAILING is nonzero, consider just the longest prefix of - STRING that has valid syntax. */ +/* Convert the initial prefix of STRING to a number, assuming base BASE. + If the prefix has floating point syntax and BASE is 10, return a + nearest float; otherwise, if the prefix has integer syntax, return + the integer; otherwise, return nil. If PLEN, set *PLEN to the + length of the numeric prefix if there is one, otherwise *PLEN is + unspecified. */ Lisp_Object -string_to_number (char const *string, int base, int flags) +string_to_number (char const *string, int base, ptrdiff_t *plen) { char const *cp = string; - bool float_syntax = 0; + bool float_syntax = false; double value = 0; /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on @@ -3797,49 +3800,46 @@ string_to_number (char const *string, int base, int flags) || (state & ~INTOVERFLOW) == (LEAD_INT|E_EXP)); } - /* Return nil if the number uses invalid syntax. If FLAGS & - S2N_IGNORE_TRAILING, accept any prefix that matches. Otherwise, - the entire string must match. */ - if (! (flags & S2N_IGNORE_TRAILING - ? ((state & LEAD_INT) != 0 || float_syntax) - : (!*cp && ((state & ~(INTOVERFLOW | DOT_CHAR)) == LEAD_INT - || float_syntax)))) - return Qnil; + if (plen) + *plen = cp - string; - /* If the number uses integer and not float syntax, and is in C-language - range, use its value, preferably as a fixnum. */ - if (leading_digit >= 0 && ! float_syntax) + /* Return a float if the number uses float syntax. */ + if (float_syntax) { - if ((state & INTOVERFLOW) == 0 - && n <= (negative ? -MOST_NEGATIVE_FIXNUM : MOST_POSITIVE_FIXNUM)) - { - EMACS_INT signed_n = n; - return make_fixnum (negative ? -signed_n : signed_n); - } - - /* Trim any leading "+" and trailing nondigits, then convert to - bignum. */ - string += positive; - if (!*after_digits) - return make_bignum_str (string, base); - ptrdiff_t trimmed_len = after_digits - string; - USE_SAFE_ALLOCA; - char *trimmed = SAFE_ALLOCA (trimmed_len + 1); - memcpy (trimmed, string, trimmed_len); - trimmed[trimmed_len] = '\0'; - Lisp_Object result = make_bignum_str (trimmed, base); - SAFE_FREE (); - return result; + /* Convert to floating point, unless the value is already known + because it is infinite or a NaN. */ + if (! value) + value = atof (string + signedp); + return make_float (negative ? -value : value); } - /* Either the number uses float syntax, or it does not fit into a fixnum. - Convert it from string to floating point, unless the value is already - known because it is an infinity, a NAN, or its absolute value fits in - uintmax_t. */ - if (! value) - value = atof (string + signedp); + /* Return nil if the number uses invalid syntax. */ + if (! (state & LEAD_INT)) + return Qnil; - return make_float (negative ? -value : value); + /* Fast path if the integer (san sign) fits in uintmax_t. */ + if (! (state & INTOVERFLOW)) + { + if (!negative) + return make_uint (n); + if (-MOST_NEGATIVE_FIXNUM < n) + return make_neg_biguint (n); + EMACS_INT signed_n = n; + return make_fixnum (-signed_n); + } + + /* Trim any leading "+" and trailing nondigits, then return a bignum. */ + string += positive; + if (!*after_digits) + return make_bignum_str (string, base); + ptrdiff_t trimmed_len = after_digits - string; + USE_SAFE_ALLOCA; + char *trimmed = SAFE_ALLOCA (trimmed_len + 1); + memcpy (trimmed, string, trimmed_len); + trimmed[trimmed_len] = '\0'; + Lisp_Object result = make_bignum_str (trimmed, base); + SAFE_FREE (); + return result; } diff --git a/src/print.c b/src/print.c index c0c90bc7e9a..d15ff97b00c 100644 --- a/src/print.c +++ b/src/print.c @@ -1993,39 +1993,17 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) case Lisp_Symbol: { - bool confusing; - unsigned char *p = SDATA (SYMBOL_NAME (obj)); - unsigned char *end = p + SBYTES (SYMBOL_NAME (obj)); - int c; - ptrdiff_t i, i_byte; - ptrdiff_t size_byte; - Lisp_Object name; + Lisp_Object name = SYMBOL_NAME (obj); + ptrdiff_t size_byte = SBYTES (name); - name = SYMBOL_NAME (obj); - - if (p != end && (*p == '-' || *p == '+')) p++; - if (p == end) - confusing = 0; - /* If symbol name begins with a digit, and ends with a digit, - and contains nothing but digits and `e', it could be treated - as a number. So set CONFUSING. - - Symbols that contain periods could also be taken as numbers, - but periods are always escaped, so we don't have to worry - about them here. */ - else if (*p >= '0' && *p <= '9' - && end[-1] >= '0' && end[-1] <= '9') - { - while (p != end && ((*p >= '0' && *p <= '9') - /* Needed for \2e10. */ - || *p == 'e' || *p == 'E')) - p++; - confusing = (end == p); - } - else - confusing = 0; - - size_byte = SBYTES (name); + /* Set CONFUSING if NAME looks like a number, calling + string_to_number for non-obvious cases. */ + char *p = SSDATA (name); + bool signedp = *p == '-' || *p == '+'; + ptrdiff_t len; + bool confusing = ((c_isdigit (p[signedp]) || p[signedp] == '.') + && !NILP (string_to_number (p, 10, &len)) + && len == size_byte); if (! NILP (Vprint_gensym) && !SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (obj)) @@ -2036,10 +2014,12 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) break; } - for (i = 0, i_byte = 0; i_byte < size_byte;) + ptrdiff_t i = 0; + for (ptrdiff_t i_byte = 0; i_byte < size_byte; ) { /* Here, we must convert each multi-byte form to the corresponding character code before handing it to PRINTCHAR. */ + int c; FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte); maybe_quit (); @@ -2049,6 +2029,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) || c == ';' || c == '#' || c == '(' || c == ')' || c == ',' || c == '.' || c == '`' || c == '[' || c == ']' || c == '?' || c <= 040 + || c == NO_BREAK_SPACE || confusing || (i == 1 && confusable_symbol_character_p (c))) { diff --git a/src/process.c b/src/process.c index a9638dfc2df..6cda4f27acc 100644 --- a/src/process.c +++ b/src/process.c @@ -6852,7 +6852,12 @@ SIGCODE may be an integer, or a symbol whose name is a signal name. */) { Lisp_Object tem = Fget_process (process); if (NILP (tem)) - tem = string_to_number (SSDATA (process), 10, 0); + { + ptrdiff_t len; + tem = string_to_number (SSDATA (process), 10, &len); + if (NILP (tem) || len != SBYTES (process)) + return Qnil; + } process = tem; } else if (!NUMBERP (process)) diff --git a/test/src/print-tests.el b/test/src/print-tests.el index 091f1aa1afb..78e769f50e9 100644 --- a/test/src/print-tests.el +++ b/test/src/print-tests.el @@ -95,8 +95,20 @@ otherwise, use a different charset." "--------\n")))) (ert-deftest print-read-roundtrip () - (let ((sym '\’bar)) - (should (eq (read (prin1-to-string sym)) sym)))) + (let ((syms (list '## '& '* '+ '- '/ '0E '0e '< '= '> 'E 'E0 'NaN '\" + '\# '\#x0 '\' '\'\' '\( '\) '\+00 '\, '\-0 '\. '\.0 + '\0 '\0.0 '\0E0 '\0e0 '\1E+ '\1E+NaN '\1e+ '\1e+NaN + '\; '\? '\[ '\\ '\] '\` '_ 'a 'e 'e0 'x + '{ '| '} '~ : '\’ '\’bar + (intern "\t") (intern "\n") (intern " ") + (intern "\N{NO-BREAK SPACE}") + (intern "\N{ZERO WIDTH SPACE}") + (intern "\0")))) + (dolist (sym syms) + (should (eq (read (prin1-to-string sym)) sym)) + (dolist (sym1 syms) + (let ((sym2 (intern (concat (symbol-name sym) (symbol-name sym1))))) + (should (eq (read (prin1-to-string sym2)) sym2))))))) (ert-deftest print-bignum () (let* ((str "999999999999999999999999999999999") From f5896e2cbf0e537ec6b79ba139220239f934c840 Mon Sep 17 00:00:00 2001 From: Allen Li Date: Sat, 29 Sep 2018 15:19:04 -0700 Subject: [PATCH 69/72] Rework empty abbrev table omitting There were two problems with the original implementation: 1. It changed the behavior of insert-abbrev-table-description when READABLE is nil to sometimes insert one Emacs Lisp expression and sometimes insert nothing. 2. It broke the tests. This commit reworks this so that insert-abbrev-table-description always inserts an expressions even if no abbrevs need to be saved and making only write-abbrev-file check that a table has any abbrevs to save before calling insert-abbrev-table-description. This duplicates the work of filtering the table for savable abbrevs, but the benefit of keeping the API is worth it. * doc/lispref/abbrevs.texi (Abbrev Tables): Update documentation. * lisp/abbrev.el (write-abbrev-file): Skip tables without user abbrevs (insert-abbrev-table-description): Always insert the define expression. (abbrev--table-symbols): New function. * test/lisp/abbrev-tests.el (abbrev--table-symbols-test): Add test for abbrev--table-symbols. --- doc/lispref/abbrevs.texi | 7 +++--- etc/NEWS | 7 +++--- lisp/abbrev.el | 52 ++++++++++++++++++++++----------------- test/lisp/abbrev-tests.el | 8 ++++++ 4 files changed, 43 insertions(+), 31 deletions(-) diff --git a/doc/lispref/abbrevs.texi b/doc/lispref/abbrevs.texi index 4c9e653cb19..1e9471ba27a 100644 --- a/doc/lispref/abbrevs.texi +++ b/doc/lispref/abbrevs.texi @@ -122,9 +122,7 @@ System abbrevs are listed and identified as such. Otherwise the description is a Lisp expression---a call to @code{define-abbrev-table} that would define @var{name} as it is currently defined, but without the system abbrevs. (The mode or package using @var{name} is supposed -to add these to @var{name} separately.) If the Lisp expression would -not define any abbrevs (i.e.@: it defines an empty abbrev table), this -function inserts nothing. +to add these to @var{name} separately.) @end defun @node Defining Abbrevs @@ -234,7 +232,8 @@ Emacs commands to offer to save your abbrevs. Save all abbrev definitions (except system abbrevs), for all abbrev tables listed in @code{abbrev-table-name-list}, in the file @var{filename}, in the form of a Lisp program that when loaded will -define the same abbrevs. If @var{filename} is @code{nil} or omitted, +define the same abbrevs. Tables that do not have any abbrevs to save +are omitted. If @var{filename} is @code{nil} or omitted, @code{abbrev-file-name} is used. This function returns @code{nil}. @end deffn diff --git a/etc/NEWS b/etc/NEWS index ee74e86f40f..946a823173a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -258,10 +258,9 @@ case does not match. for abbrevs that have them. +++ -** 'insert-abbrev-table-description' skips empty tables. -'insert-abbrev-table-description' skips inserting empty tables when -inserting non-readable tables. By extension, this makes -'write-abbrev-file' skip writing empty tables. +** 'write-abbrev-file' skips empty tables. +'write-abbrev-file' now skips inserting a 'define-abbrev-table' form for +tables which do not have any non-system abbrevs to save. +++ ** The new functions and commands 'text-property-search-forward' and diff --git a/lisp/abbrev.el b/lisp/abbrev.el index e1fd366ba9e..20a967d7d61 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -251,7 +251,8 @@ have been saved." (lambda (s1 s2) (string< (symbol-name s1) (symbol-name s2))))) - (insert-abbrev-table-description table nil)) + (if (abbrev--table-symbols table) + (insert-abbrev-table-description table nil))) (when (unencodable-char-position (point-min) (point-max) 'utf-8) (setq coding-system-for-write (if (> emacs-major-version 24) @@ -937,33 +938,38 @@ is inserted. If READABLE is nil, an expression is inserted. The expression is a call to `define-abbrev-table' that when evaluated will define the abbrev table NAME exactly as it is currently defined. -Abbrevs marked as \"system abbrevs\" are ignored. If the -resulting expression would not define any abbrevs, nothing is -inserted." +Abbrevs marked as \"system abbrevs\" are ignored." + (let ((table (symbol-value name)) + (symbols (abbrev--table-symbols name readable))) + (setq symbols (sort symbols 'string-lessp)) + (let ((standard-output (current-buffer))) + (if readable + (progn + (insert "(") + (prin1 name) + (insert ")\n\n") + (mapc 'abbrev--describe symbols) + (insert "\n\n")) + (insert "(define-abbrev-table '") + (prin1 name) + (if (null symbols) + (insert " '())\n\n") + (insert "\n '(\n") + (mapc 'abbrev--write symbols) + (insert " ))\n\n"))) + nil))) + +(defun abbrev--table-symbols (name &optional system) + "Return the user abbrev symbols in the abbrev table named NAME. +NAME is a symbol whose value is an abbrev table. System abbrevs +are omitted unless SYSTEM is non-nil." (let ((table (symbol-value name)) (symbols ())) (mapatoms (lambda (sym) - (if (and (symbol-value sym) (or readable (not (abbrev-get sym :system)))) + (if (and (symbol-value sym) (or system (not (abbrev-get sym :system)))) (push sym symbols))) table) - (when symbols - (setq symbols (sort symbols 'string-lessp)) - (let ((standard-output (current-buffer))) - (if readable - (progn - (insert "(") - (prin1 name) - (insert ")\n\n") - (mapc 'abbrev--describe symbols) - (insert "\n\n")) - (insert "(define-abbrev-table '") - (prin1 name) - (if (null symbols) - (insert " '())\n\n") - (insert "\n '(\n") - (mapc 'abbrev--write symbols) - (insert " ))\n\n"))) - nil)))) + symbols)) (defun define-abbrev-table (tablename definitions &optional docstring &rest props) diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el index facf097815e..e50f931cef5 100644 --- a/test/lisp/abbrev-tests.el +++ b/test/lisp/abbrev-tests.el @@ -64,6 +64,14 @@ (should (= (length table) obarray-default-size)) (should (eq (abbrev-table-get table 'foo) 'bar)))) +(ert-deftest abbrev--table-symbols-test () + (let ((ert-test-abbrevs (setup-test-abbrev-table))) + (define-abbrev ert-test-abbrevs "sys" "system abbrev" nil :system t) + (should (equal (mapcar #'symbol-name (abbrev--table-symbols 'ert-test-abbrevs)) + '("a-e-t"))) + (should (equal (mapcar #'symbol-name (abbrev--table-symbols 'ert-test-abbrevs t)) + '("a-e-t" "sys"))))) + (ert-deftest abbrev-table-get-put-test () (let ((table (make-abbrev-table))) (should-not (abbrev-table-get table 'foo)) From 10cd2500afcad1c6d7ab01c8b8c336e69e9add96 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 12 Oct 2018 13:41:12 +0200 Subject: [PATCH 70/72] Fix error in Tramp loading, uncovered by tramp-test43-* * lisp/net/tramp-archive.el (tramp-archive-autoload-file-name-handler): New defalias. (tramp-register-archive-file-name-handler): Use it. * lisp/net/tramp.el (tramp-file-name-for-operation): Change it for `expand-file-name'. (tramp-file-name-handler): Unset `file-name-handler-alist' when autoloading a Tramp file name handler. (tramp-autoload-file-name-handler): Always unload Tramp file name handlers. (tramp-register-file-name-handlers) (tramp-unload-file-name-handlers): Simplify. --- lisp/net/tramp-archive.el | 8 ++++++-- lisp/net/tramp.el | 37 ++++++++++++++++++------------------- 2 files changed, 24 insertions(+), 21 deletions(-) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 5d7562f707e..bb87a83f10f 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -331,14 +331,18 @@ pass to the OPERATION." (save-match-data (apply (cdr fn) args)) (tramp-archive-run-real-handler operation args))))))) +;;;###autoload +(defalias + 'tramp-archive-autoload-file-name-handler 'tramp-autoload-file-name-handler) + ;;;###autoload (progn (defun tramp-register-archive-file-name-handler () "Add archive file name handler to `file-name-handler-alist'." (when tramp-archive-enabled (add-to-list 'file-name-handler-alist (cons (tramp-archive-autoload-file-name-regexp) - 'tramp-autoload-file-name-handler)) - (put 'tramp-archive-file-name-handler 'safe-magic t)))) + 'tramp-archive-autoload-file-name-handler)) + (put 'tramp-archive-autoload-file-name-handler 'safe-magic t)))) ;;;###autoload (progn diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 08a225602aa..e629ce17315 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2138,7 +2138,7 @@ ARGS are the arguments OPERATION has been called with." default-directory)) ;; FILE DIRECTORY resp FILE1 FILE2. ((member operation - '(add-name-to-file copy-directory copy-file expand-file-name + '(add-name-to-file copy-directory copy-file file-equal-p file-in-directory-p file-name-all-completions file-name-completion ;; Starting with Emacs 26.1, just the 2nd argument of @@ -2152,6 +2152,13 @@ ARGS are the arguments OPERATION has been called with." ((tramp-tramp-file-p (nth 0 args)) (nth 0 args)) ((tramp-tramp-file-p (nth 1 args)) (nth 1 args)) (t default-directory)))) + ;; FILE DIRECTORY resp FILE1 FILE2. + ((eq operation 'expand-file-name) + (save-match-data + (cond + ((file-name-absolute-p (nth 0 args)) (nth 0 args)) + ((tramp-tramp-file-p (nth 1 args)) (nth 1 args)) + (t default-directory)))) ;; START END FILE. ((eq operation 'write-region) (if (file-name-absolute-p (nth 2 args)) @@ -2255,7 +2262,8 @@ Falls back to normal file name handler if no Tramp file name handler exists." ;; Tramp packages locally. (when (autoloadp sf) (let ((default-directory - (tramp-compat-temporary-file-directory))) + (tramp-compat-temporary-file-directory)) + file-name-handler-alist) (load (cadr sf) 'noerror 'nomessage))) ;; (tramp-message ;; v 4 "Running `%s'..." (cons operation args)) @@ -2349,10 +2357,10 @@ Falls back to normal file name handler if no Tramp file name handler exists." ;;;###autoload (progn (defun tramp-autoload-file-name-handler (operation &rest args) "Load Tramp file name handler, and perform OPERATION." + (tramp-unload-file-name-handlers) (if tramp-mode (let ((default-directory temporary-file-directory)) - (load "tramp" 'noerror 'nomessage)) - (tramp-unload-file-name-handlers)) + (load "tramp" 'noerror 'nomessage))) (apply operation args))) ;; `tramp-autoload-file-name-handler' must be registered before @@ -2396,15 +2404,8 @@ remote file names." (defun tramp-register-file-name-handlers () "Add Tramp file name handlers to `file-name-handler-alist'." ;; Remove autoloaded handlers from file name handler alist. Useful, - ;; if `tramp-syntax' has been changed. We cannot call - ;; `tramp-unload-file-name-handlers', this would result in recursive - ;; loading of Tramp. - (dolist (fnh '(tramp-file-name-handler - tramp-completion-file-name-handler - tramp-archive-file-name-handler - tramp-autoload-file-name-handler)) - (let ((a1 (rassq fnh file-name-handler-alist))) - (setq file-name-handler-alist (delq a1 file-name-handler-alist)))) + ;; if `tramp-syntax' has been changed. + (tramp-unload-file-name-handlers) ;; Add the handlers. We do not add anything to the `operations' ;; property of `tramp-file-name-handler' and @@ -2479,12 +2480,10 @@ Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'." ;;;###autoload (progn (defun tramp-unload-file-name-handlers () "Unload Tramp file name handlers from `file-name-handler-alist'." - (dolist (fnh '(tramp-file-name-handler - tramp-completion-file-name-handler - tramp-archive-file-name-handler - tramp-autoload-file-name-handler)) - (let ((a1 (rassq fnh file-name-handler-alist))) - (setq file-name-handler-alist (delq a1 file-name-handler-alist)))))) + (dolist (fnh file-name-handler-alist) + (when (and (symbolp (cdr fnh)) + (string-prefix-p "tramp-" (symbol-name (cdr fnh)))) + (setq file-name-handler-alist (delq fnh file-name-handler-alist)))))) (add-hook 'tramp-unload-hook 'tramp-unload-file-name-handlers) From ac2a04e88855d7929bccf58f7585aa5126591870 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 12 Oct 2018 13:42:07 +0200 Subject: [PATCH 71/72] * lisp/net/trampver.el (customize-package-emacs-version-alist): Adapt Tramp version integrated in Emacs 26.2. --- lisp/net/trampver.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index f17129a402b..de76788cc0e 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -67,7 +67,7 @@ ("2.2.9-24.4" . "24.4") ("2.2.11-24.5" . "24.5") ("2.2.13.25.1" . "25.1") ("2.2.13.25.2" . "25.2") ("2.2.13.25.2" . "25.3") - ("2.3.3.26.1" . "26.1") ("2.3.4.26.2" . "26.2"))) + ("2.3.3.26.1" . "26.1") ("2.3.5.26.2" . "26.2"))) (add-hook 'tramp-unload-hook (lambda () From 9c231a447014823ed1955e16b6693adbe041ca99 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 12 Oct 2018 13:42:34 +0200 Subject: [PATCH 72/72] * test/lisp/net/tramp-tests.el (tramp--test-timeout-handler): Add docstring. Remove `interactive' call. --- test/lisp/net/tramp-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 523c7afada8..6a08cbb5ab2 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4884,7 +4884,7 @@ Use the `ls' command." (numberp (nth 2 fsi)))))) (defun tramp--test-timeout-handler () - (interactive) + "Timeout handler, reporting a failed test." (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test))))) ;; This test is inspired by Bug#16928.