commit e080d019f41d2738ba0db721c1b89ea57413439b (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Thu Feb 2 21:28:45 2017 -0800 Re-port alloc.c to Solaris sparc and simplify alloc.c had bitrotted a bit, and used an undefined symbol stack_base when Emacs was built on Solaris sparc, leading to compilation failures. Also, code related to __builtin_unwind_init was unnecessarily duplicated. Fix the bitrot and remove some duplication. * src/alloc.c: Remove uses of GC_SAVE_REGISTERS_ON_STACK, since it is never defined. (test_setjmp) [!HAVE___BUILTIN_UNWIND_INIT && GC_SETJMP_WORKS]: Define a no-op dummy, to simplify use. (test_setjmp) [!GC_SETJMP_WORKS]: Test setjmp_tested_p here rather than in the caller, to simplify use. (stacktop_sentry): New type. (__builtin_unwind_init) [!HAVE___BUILTIN_UNWIND_INIT]: New macro. (SET_STACK_TOP_ADDRESS): New macro, containing code that was duplicated. (flush_stack_call_func, Fgarbage_collect): Use it. (init_alloc): Omit unnecessary initialization. After dumping, Emacs need not re-test setjmp. diff --git a/src/alloc.c b/src/alloc.c index e909d312c4..62f43669f2 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4887,12 +4887,19 @@ mark_memory (void *start, void *end) } } -#if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS +#ifndef HAVE___BUILTIN_UNWIND_INIT + +# ifdef GC_SETJMP_WORKS +static void +test_setjmp (void) +{ +} +# else static bool setjmp_tested_p; static int longjmps_done; -#define SETJMP_WILL_LIKELY_WORK "\ +# define SETJMP_WILL_LIKELY_WORK "\ \n\ Emacs garbage collector has been changed to use conservative stack\n\ marking. Emacs has determined that the method it uses to do the\n\ @@ -4905,7 +4912,7 @@ verify that the methods used are appropriate for your system.\n\ Please mail the result to .\n\ " -#define SETJMP_WILL_NOT_WORK "\ +# define SETJMP_WILL_NOT_WORK "\ \n\ Emacs garbage collector has been changed to use conservative stack\n\ marking. Emacs has determined that the default method it uses to do the\n\ @@ -4931,6 +4938,9 @@ Please mail the result to .\n\ static void test_setjmp (void) { + if (setjmp_tested_p) + return; + setjmp_tested_p = true; char buf[10]; register int x; sys_jmp_buf jbuf; @@ -4967,9 +4977,60 @@ test_setjmp (void) if (longjmps_done == 1) sys_longjmp (jbuf, 1); } +# endif /* ! GC_SETJMP_WORKS */ +#endif /* ! HAVE___BUILTIN_UNWIND_INIT */ -#endif /* not GC_SAVE_REGISTERS_ON_STACK && not GC_SETJMP_WORKS */ +/* The type of an object near the stack top, whose address can be used + as a stack scan limit. */ +typedef union +{ + /* Align the stack top properly. Even if !HAVE___BUILTIN_UNWIND_INIT, + jmp_buf may not be aligned enough on darwin-ppc64. */ + max_align_t o; +#ifndef HAVE___BUILTIN_UNWIND_INIT + sys_jmp_buf j; + char c; +#endif +} stacktop_sentry; + +/* Force callee-saved registers and register windows onto the stack. + Use the platform-defined __builtin_unwind_init if available, + obviating the need for machine dependent methods. */ +#ifndef HAVE___BUILTIN_UNWIND_INIT +# ifdef __sparc__ + /* This trick flushes the register windows so that all the state of + the process is contained in the stack. + FreeBSD does not have a ta 3 handler, so handle it specially. + FIXME: Code in the Boehm GC suggests flushing (with 'flushrs') is + needed on ia64 too. See mach_dep.c, where it also says inline + assembler doesn't work with relevant proprietary compilers. */ +# if defined __sparc64__ && defined __FreeBSD__ +# define __builtin_unwind_init() asm ("flushw") +# else +# define __builtin_unwind_init() asm ("ta 3") +# endif +# else +# define __builtin_unwind_init() ((void) 0) +# endif +#endif +/* Set *P to the address of the top of the stack. This must be a + macro, not a function, so that it is executed in the caller’s + environment. It is not inside a do-while so that its storage + survives the macro. */ +#ifdef HAVE___BUILTIN_UNWIND_INIT +# define SET_STACK_TOP_ADDRESS(p) \ + stacktop_sentry sentry; \ + __builtin_unwind_init (); \ + *(p) = &sentry +#else +# define SET_STACK_TOP_ADDRESS(p) \ + stacktop_sentry sentry; \ + __builtin_unwind_init (); \ + test_setjmp (); \ + sys_setjmp (sentry.j); \ + *(p) = &sentry + (stack_bottom < &sentry.c) +#endif /* Mark live Lisp objects on the C stack. @@ -4981,12 +5042,7 @@ test_setjmp (void) We have to mark Lisp objects in CPU registers that can hold local variables or are used to pass parameters. - If GC_SAVE_REGISTERS_ON_STACK is defined, it should expand to - something that either saves relevant registers on the stack, or - calls mark_maybe_object passing it each register's contents. - - If GC_SAVE_REGISTERS_ON_STACK is not defined, the current - implementation assumes that calling setjmp saves registers we need + This code assumes that calling setjmp saves registers we need to see in a jmp_buf which itself lies on the stack. This doesn't have to be true! It must be verified for each system, possibly by taking a look at the source code of setjmp. @@ -5050,62 +5106,9 @@ flush_stack_call_func (void (*func) (void *arg), void *arg) { void *end; struct thread_state *self = current_thread; - -#ifdef HAVE___BUILTIN_UNWIND_INIT - /* Force callee-saved registers and register windows onto the stack. - This is the preferred method if available, obviating the need for - machine dependent methods. */ - __builtin_unwind_init (); - end = &end; -#else /* not HAVE___BUILTIN_UNWIND_INIT */ -#ifndef GC_SAVE_REGISTERS_ON_STACK - /* jmp_buf may not be aligned enough on darwin-ppc64 */ - union aligned_jmpbuf { - Lisp_Object o; - sys_jmp_buf j; - } j; - volatile bool stack_grows_down_p = (char *) &j > (char *) stack_bottom; -#endif - /* This trick flushes the register windows so that all the state of - the process is contained in the stack. */ - /* Fixme: Code in the Boehm GC suggests flushing (with `flushrs') is - needed on ia64 too. See mach_dep.c, where it also says inline - assembler doesn't work with relevant proprietary compilers. */ -#ifdef __sparc__ -#if defined (__sparc64__) && defined (__FreeBSD__) - /* FreeBSD does not have a ta 3 handler. */ - asm ("flushw"); -#else - asm ("ta 3"); -#endif -#endif - - /* Save registers that we need to see on the stack. We need to see - registers used to hold register variables and registers used to - pass parameters. */ -#ifdef GC_SAVE_REGISTERS_ON_STACK - GC_SAVE_REGISTERS_ON_STACK (end); -#else /* not GC_SAVE_REGISTERS_ON_STACK */ - -#ifndef GC_SETJMP_WORKS /* If it hasn't been checked yet that - setjmp will definitely work, test it - and print a message with the result - of the test. */ - if (!setjmp_tested_p) - { - setjmp_tested_p = 1; - test_setjmp (); - } -#endif /* GC_SETJMP_WORKS */ - - sys_setjmp (j.j); - end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j; -#endif /* not GC_SAVE_REGISTERS_ON_STACK */ -#endif /* not HAVE___BUILTIN_UNWIND_INIT */ - + SET_STACK_TOP_ADDRESS (&end); self->stack_top = end; - (*func) (arg); - + func (arg); eassert (current_thread == self); } @@ -6047,58 +6050,7 @@ See Info node `(elisp)Garbage Collection'. */) (void) { void *end; - -#ifdef HAVE___BUILTIN_UNWIND_INIT - /* Force callee-saved registers and register windows onto the stack. - This is the preferred method if available, obviating the need for - machine dependent methods. */ - __builtin_unwind_init (); - end = &end; -#else /* not HAVE___BUILTIN_UNWIND_INIT */ -#ifndef GC_SAVE_REGISTERS_ON_STACK - /* jmp_buf may not be aligned enough on darwin-ppc64 */ - union aligned_jmpbuf { - Lisp_Object o; - sys_jmp_buf j; - } j; - volatile bool stack_grows_down_p = (char *) &j > (char *) stack_base; -#endif - /* This trick flushes the register windows so that all the state of - the process is contained in the stack. */ - /* Fixme: Code in the Boehm GC suggests flushing (with `flushrs') is - needed on ia64 too. See mach_dep.c, where it also says inline - assembler doesn't work with relevant proprietary compilers. */ -#ifdef __sparc__ -#if defined (__sparc64__) && defined (__FreeBSD__) - /* FreeBSD does not have a ta 3 handler. */ - asm ("flushw"); -#else - asm ("ta 3"); -#endif -#endif - - /* Save registers that we need to see on the stack. We need to see - registers used to hold register variables and registers used to - pass parameters. */ -#ifdef GC_SAVE_REGISTERS_ON_STACK - GC_SAVE_REGISTERS_ON_STACK (end); -#else /* not GC_SAVE_REGISTERS_ON_STACK */ - -#ifndef GC_SETJMP_WORKS /* If it hasn't been checked yet that - setjmp will definitely work, test it - and print a message with the result - of the test. */ - if (!setjmp_tested_p) - { - setjmp_tested_p = 1; - test_setjmp (); - } -#endif /* GC_SETJMP_WORKS */ - - sys_setjmp (j.j); - end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j; -#endif /* not GC_SAVE_REGISTERS_ON_STACK */ -#endif /* not HAVE___BUILTIN_UNWIND_INIT */ + SET_STACK_TOP_ADDRESS (&end); return garbage_collect_1 (end); } @@ -7408,9 +7360,6 @@ init_alloc_once (void) void init_alloc (void) { -#if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS - setjmp_tested_p = longjmps_done = 0; -#endif Vgc_elapsed = make_float (0.0); gcs_done = 0; commit ce88155d83ba84e84321ed69a39c82f40117dd1f Merge: 604724e49d da515a0d8e Author: Noam Postavsky Date: Thu Feb 2 21:35:51 2017 -0500 ; Merge: fixes and updates to scroll margin (Bug#5718) - add new option `maximum-sroll-margin' - refactor and fix scroll margin calculation commit da515a0d8e97d89a1c7e60faea190174a8c72618 Author: Noam Postavsky Date: Sat Jan 28 16:54:33 2017 -0500 Add tests for scrolling * test/manual/scroll-tests.el: New tests for scroll-margin behavior. diff --git a/test/manual/scroll-tests.el b/test/manual/scroll-tests.el new file mode 100644 index 0000000000..1167efd6a6 --- /dev/null +++ b/test/manual/scroll-tests.el @@ -0,0 +1,130 @@ +;;; scroll-tests.el -- tests for scrolling -*- lexical-binding: t -*- + +;; Copyright (C) 2017 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 . + +;;; Commentary: + +;; These are mostly automated ert tests, but they don't work in batch +;; mode which is why they are under test/manual. + +;;; Code: + +(require 'ert) +(eval-when-compile (require 'cl-lib)) + +(defun scroll-tests-up-and-down (margin &optional effective-margin) + (unless effective-margin + (setq effective-margin margin)) + (erase-buffer) + (insert (mapconcat #'number-to-string + (number-sequence 1 200) "\n")) + (goto-char 1) + (sit-for 0) + (let ((scroll-margin margin) + (wstart (window-start))) + ;; Stopping before `scroll-margin' so we shouldn't have + ;; scrolled. + (let ((current-prefix-arg (- (window-text-height) 1 effective-margin))) + (call-interactively 'next-line)) + (sit-for 0) + (should (= wstart (window-start))) + ;; Passing `scroll-margin' should trigger scrolling. + (call-interactively 'next-line) + (sit-for 0) + (should (/= wstart (window-start))) + ;; Scroll back to top. + (let ((current-prefix-arg (window-start))) + (call-interactively 'scroll-down-command)) + (sit-for 0) + (should (= 1 (window-start))))) + +(defmacro scroll-tests-with-buffer-window (&rest body) + (declare (debug t)) + `(with-temp-buffer + (with-selected-window (display-buffer (current-buffer)) + ,@body))) + +(ert-deftest scroll-tests-scroll-margin-0 () + (skip-unless (not noninteractive)) + (scroll-tests-with-buffer-window + (scroll-tests-up-and-down 0))) + +(ert-deftest scroll-tests-scroll-margin-negative () + "A negative `scroll-margin' should be the same as 0." + (skip-unless (not noninteractive)) + (scroll-tests-with-buffer-window + (scroll-tests-up-and-down -10 0))) + +(ert-deftest scroll-tests-scroll-margin-max () + (skip-unless (not noninteractive)) + (scroll-tests-with-buffer-window + (let ((max-margin (/ (window-text-height) 4))) + (scroll-tests-up-and-down max-margin)))) + +(ert-deftest scroll-tests-scroll-margin-over-max () + "A `scroll-margin' more than max should be the same as max." + (skip-unless (not noninteractive)) + (scroll-tests-with-buffer-window + (set-window-text-height nil 7) + (let ((max-margin (/ (window-text-height) 4))) + (scroll-tests-up-and-down (+ max-margin 1) max-margin) + (scroll-tests-up-and-down (+ max-margin 2) max-margin)))) + +(defun scroll-tests--point-in-middle-of-window-p () + (= (count-lines (window-start) (window-point)) + (/ (1- (window-text-height)) 2))) + +(cl-defun scroll-tests--scroll-margin-whole-window (&key with-line-spacing) + "Test `maximum-scroll-margin' at 0.5. +With a high `scroll-margin', this should keep cursor in the +middle of the window." + (let ((maximum-scroll-margin 0.5) + (scroll-margin 100)) + (scroll-tests-with-buffer-window + (setq-local line-spacing with-line-spacing) + ;; Choose an odd number, so there is one line in the middle. + (set-window-text-height nil 7) + ;; `set-window-text-height' doesn't count `line-spacing'. + (when with-line-spacing + (window-resize nil (* line-spacing 7) nil nil 'pixels)) + (erase-buffer) + (insert (mapconcat #'number-to-string + (number-sequence 1 200) "\n")) + (goto-char 1) + (sit-for 0) + (call-interactively 'scroll-up-command) + (sit-for 0) + (should (scroll-tests--point-in-middle-of-window-p)) + (call-interactively 'scroll-up-command) + (sit-for 0) + (should (scroll-tests--point-in-middle-of-window-p)) + (call-interactively 'scroll-down-command) + (sit-for 0) + (should (scroll-tests--point-in-middle-of-window-p))))) + +(ert-deftest scroll-tests-scroll-margin-whole-window () + (skip-unless (not noninteractive)) + (scroll-tests--scroll-margin-whole-window)) + +(ert-deftest scroll-tests-scroll-margin-whole-window-line-spacing () + ;; `line-spacing' has no effect on tty displays. + (skip-unless (display-graphic-p)) + (scroll-tests--scroll-margin-whole-window :with-line-spacing 3)) + + +;;; scroll-tests.el ends here commit b9be4c14e89f5cec08a7a0f0d24033e0e6ff5ef0 Author: Noam Postavsky Date: Sat Jan 21 13:24:47 2017 -0500 Fix scrolling with partial lines * src/xdisp.c (partial_line_height): New function. (try_scrolling): * src/window.c (window_scroll_pixel_based): Use it for calculating the pixel scroll margin correctly in a window with partial lines. diff --git a/src/dispextern.h b/src/dispextern.h index 51222e636b..eb71a82311 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -3263,6 +3263,7 @@ void move_it_past_eol (struct it *); void move_it_in_display_line (struct it *it, ptrdiff_t to_charpos, int to_x, enum move_operation_enum op); +int partial_line_height (struct it *it_origin); bool in_display_vector_p (struct it *); int frame_mode_line_height (struct frame *); extern bool redisplaying_p; diff --git a/src/window.c b/src/window.c index ba03780f3d..95690443f8 100644 --- a/src/window.c +++ b/src/window.c @@ -5147,7 +5147,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) in the scroll margin at the bottom. */ move_it_to (&it, PT, -1, (it.last_visible_y - WINDOW_HEADER_LINE_HEIGHT (w) - - this_scroll_margin - 1), + - partial_line_height (&it) - this_scroll_margin - 1), -1, MOVE_TO_POS | MOVE_TO_Y); diff --git a/src/xdisp.c b/src/xdisp.c index 134ef6c619..0e329dfe6e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -9859,6 +9859,32 @@ move_it_by_lines (struct it *it, ptrdiff_t dvpos) } } +int +partial_line_height (struct it *it_origin) +{ + int partial_height; + void *it_data = NULL; + struct it it; + SAVE_IT (it, *it_origin, it_data); + move_it_to (&it, ZV, -1, it.last_visible_y, -1, + MOVE_TO_POS | MOVE_TO_Y); + if (it.what == IT_EOB) + { + int vis_height = it.last_visible_y - it.current_y; + int height = it.ascent + it.descent; + partial_height = (vis_height < height) ? vis_height : 0; + } + else + { + int last_line_y = it.current_y; + move_it_by_lines (&it, 1); + partial_height = (it.current_y > it.last_visible_y) + ? it.last_visible_y - last_line_y : 0; + } + RESTORE_IT (&it, &it, it_data); + return partial_height; +} + /* Return true if IT points into the middle of a display vector. */ bool @@ -15368,7 +15394,8 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, /* Compute the pixel ypos of the scroll margin, then move IT to either that ypos or PT, whichever comes first. */ start_display (&it, w, startp); - scroll_margin_y = it.last_visible_y - this_scroll_margin + scroll_margin_y = it.last_visible_y - partial_line_height (&it) + - this_scroll_margin - frame_line_height * extra_scroll_margin_lines; move_it_to (&it, PT, -1, scroll_margin_y - 1, -1, (MOVE_TO_POS | MOVE_TO_Y)); commit e27a91cddc1a66c25e09d3929c5625637ec34a49 Author: Noam Postavsky Date: Sun Sep 11 11:09:57 2016 -0400 Make limit on scroll-margin variable * src/xdisp.c (maximum-scroll-margin): New variable. * lisp/cus-start.el: Make it customizable. * etc/NEWS: Mention it. * doc/emacs/display.texi (Auto Scrolling): * doc/lispref/windows.texi (Textual Scrolling): Document it. * src/window.c (window_scroll_pixel_based): Use it instead of hardcoding division by 4 (Bug #5718). diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index c6e990d908..15c700892b 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -285,13 +285,17 @@ multiple variables, the order of priority is: @code{scroll-up-aggressively} / @code{scroll-down-aggressively}. @vindex scroll-margin +@vindex maximum-scroll-margin The variable @code{scroll-margin} restricts how close point can come to the top or bottom of a window (even if aggressive scrolling specifies a fraction @var{f} that is larger than the window portion -between the top and the bottom margins). Its value is a number of screen -lines; if point comes within that many lines of the top or bottom of -the window, Emacs performs automatic scrolling. By default, -@code{scroll-margin} is 0. +between the top and the bottom margins). Its value is a number of +screen lines; if point comes within that many lines of the top or +bottom of the window, Emacs performs automatic scrolling. By default, +@code{scroll-margin} is 0. The effective margin size is limited to a +quarter of the window height by default, but this limit can be +increased up to half (or decreased down to zero) by customizing +@code{maximum-scroll-margin}. @node Horizontal Scrolling @section Horizontal Scrolling diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 6f3de0c8a0..affa28c920 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -3924,6 +3924,21 @@ redisplay scrolls the text automatically (if possible) to move point out of the margin, closer to the center of the window. @end defopt +@defopt maximum-scroll-margin +This variable limits the effective value of @code{scroll-margin} to a +fraction of the current window line height. For example, if the +current window has 20 lines and @code{maximum-scroll-margin} is 0.1, +then the scroll margins will never be larger than 2 lines, no matter +how big @code{scroll-margin} is. + +@code{maximum-scroll-margin} itself has a maximum value of 0.5, which +allows setting margins large to keep the cursor at the middle line of +the window (or two middle lines if the window has an even number of +lines). If it's set to a larger value (or any value other than a +float between 0.0 and 0.5) then the default value of 0.25 will be used +instead. +@end defopt + @defopt scroll-conservatively This variable controls how scrolling is done automatically when point moves off the screen (or into the scroll margin). If the value is a diff --git a/etc/NEWS b/etc/NEWS index ddd40fa853..617f39f9b4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -307,6 +307,11 @@ local part of a remote file name. Thus, if you have a directory named "/~" on the remote host "foo", you can prevent it from being substituted by a home directory by writing it as "/foo:/:/~/file". ++++ +** The new variable 'maximum-scroll-margin' allows having effective +settings of 'scroll-margin' up to half the window size, instead of +always restricting the margin to a quarter of the window. + * Editing Changes in Emacs 26.1 diff --git a/lisp/cus-start.el b/lisp/cus-start.el index a790419b86..51c43c7d21 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -511,6 +511,7 @@ since it could result in memory overflow and make Emacs crash." (scroll-step windows integer) (scroll-conservatively windows integer) (scroll-margin windows integer) + (maximum-scroll-margin windows float "26.1") (hscroll-margin windows integer "22.1") (hscroll-step windows number "22.1") (truncate-partial-width-windows diff --git a/src/window.c b/src/window.c index 235c3c1ade..ba03780f3d 100644 --- a/src/window.c +++ b/src/window.c @@ -4801,11 +4801,20 @@ window_scroll_margin (struct window *window, enum margin_unit unit) { int frame_line_height = default_line_pixel_height (window); int window_lines = window_box_height (window) / frame_line_height; - int margin = min (scroll_margin, window_lines / 4); - if (unit == MARGIN_IN_PIXELS) - return margin * frame_line_height; - else - return margin; + + double ratio = 0.25; + if (FLOATP (Vmaximum_scroll_margin)) + { + ratio = XFLOAT_DATA (Vmaximum_scroll_margin); + ratio = max (0.0, ratio); + ratio = min (ratio, 0.5); + } + int max_margin = min ((window_lines - 1)/2, + (int) (window_lines * ratio)); + int margin = clip_to_bounds (0, scroll_margin, max_margin); + return (unit == MARGIN_IN_PIXELS) + ? margin * frame_line_height + : margin; } else return 0; diff --git a/src/xdisp.c b/src/xdisp.c index 8a450b7a8a..134ef6c619 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -31520,6 +31520,14 @@ Recenter the window whenever point gets within this many lines of the top or bottom of the window. */); scroll_margin = 0; + DEFVAR_LISP ("maximum-scroll-margin", Vmaximum_scroll_margin, + doc: /* Maximum effective value of `scroll-margin'. +Given as a fraction of the current window's lines. The value should +be a floating point number between 0.0 and 0.5. The effective maximum +is limited to (/ (1- window-lines) 2). Non-float values for this +variable are ignored and the default 0.25 is used instead. */); + Vmaximum_scroll_margin = make_float (0.25); + DEFVAR_LISP ("display-pixels-per-inch", Vdisplay_pixels_per_inch, doc: /* Pixels per inch value for non-window system displays. Value is a number or a cons (WIDTH-DPI . HEIGHT-DPI). */); commit c92fc7a2156a5939439b7236452d4dfcfc13cc89 Author: Noam Postavsky Date: Sun Aug 28 17:23:04 2016 -0400 Don't count mode line for scroll-margin limit * src/window.c (window_scroll_margin): Use window_box_height to avoid counting header line, scrollbars for scroll-margin limit (Bug #5718). diff --git a/src/window.c b/src/window.c index 1c83d989aa..235c3c1ade 100644 --- a/src/window.c +++ b/src/window.c @@ -4800,10 +4800,8 @@ window_scroll_margin (struct window *window, enum margin_unit unit) if (scroll_margin > 0) { int frame_line_height = default_line_pixel_height (window); - int window_total_lines - = window->total_lines * WINDOW_FRAME_LINE_HEIGHT (window) - / frame_line_height; - int margin = min (scroll_margin, window_total_lines / 4); + int window_lines = window_box_height (window) / frame_line_height; + int margin = min (scroll_margin, window_lines / 4); if (unit == MARGIN_IN_PIXELS) return margin * frame_line_height; else commit d17e92da064cabf376597f5de2a8d5a6484bfea6 Author: Noam Postavsky Date: Sun Aug 28 16:38:04 2016 -0400 Refactor uses of scroll_margin to a function Its effective range needs to be clamped between 0 and (window height / 4), so it's better to have this constraint in a single place. * src/window.c (window_scroll_margin): New function. (window_scroll_pixel_based, window_scroll_line_based): (Frecenter, Fmove_to_window_line): * src/xdisp.c (try_scrolling, try_cursor_movement): (redisplay_window, try_window, try_window_id): Use it. diff --git a/src/window.c b/src/window.c index bc3f488f37..1c83d989aa 100644 --- a/src/window.c +++ b/src/window.c @@ -4790,6 +4790,29 @@ window_scroll (Lisp_Object window, EMACS_INT n, bool whole, bool noerror) XWINDOW (window)->window_end_valid = false; } +/* Compute scroll margin for WINDOW. + We scroll when point is within this distance from the top or bottom + of the window. The result is measured in lines or in pixels + depending on the second parameter. */ +int +window_scroll_margin (struct window *window, enum margin_unit unit) +{ + if (scroll_margin > 0) + { + int frame_line_height = default_line_pixel_height (window); + int window_total_lines + = window->total_lines * WINDOW_FRAME_LINE_HEIGHT (window) + / frame_line_height; + int margin = min (scroll_margin, window_total_lines / 4); + if (unit == MARGIN_IN_PIXELS) + return margin * frame_line_height; + else + return margin; + } + else + return 0; +} + /* Implementation of window_scroll that works based on pixel line heights. See the comment of window_scroll for parameter @@ -4806,7 +4829,6 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) bool vscrolled = false; int x, y, rtop, rbot, rowh, vpos; void *itdata = NULL; - int window_total_lines; int frame_line_height = default_line_pixel_height (w); bool adjust_old_pointm = !NILP (Fequal (Fwindow_point (window), Fwindow_old_point (window))); @@ -5062,12 +5084,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) /* Move PT out of scroll margins. This code wants current_y to be zero at the window start position even if there is a header line. */ - window_total_lines - = w->total_lines * WINDOW_FRAME_LINE_HEIGHT (w) / frame_line_height; - this_scroll_margin = max (0, scroll_margin); - this_scroll_margin - = min (this_scroll_margin, window_total_lines / 4); - this_scroll_margin *= frame_line_height; + this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); if (n > 0) { @@ -5290,9 +5307,7 @@ window_scroll_line_based (Lisp_Object window, int n, bool whole, bool noerror) if (pos < ZV) { - /* Don't use a scroll margin that is negative or too large. */ - int this_scroll_margin = - max (0, min (scroll_margin, w->total_lines / 4)); + int this_scroll_margin = window_scroll_margin (w, MARGIN_IN_LINES); set_marker_restricted_both (w->start, w->contents, pos, pos_byte); w->start_at_line_beg = !NILP (bolp); @@ -5722,8 +5737,7 @@ and redisplay normally--don't erase and redraw the frame. */) /* Do this after making BUF current in case scroll_margin is buffer-local. */ - this_scroll_margin - = max (0, min (scroll_margin, w->total_lines / 4)); + this_scroll_margin = window_scroll_margin (w, MARGIN_IN_LINES); /* Don't use redisplay code for initial frames, as the necessary data structures might not be set up yet then. */ @@ -5962,10 +5976,6 @@ from the top of the window. */) lines = displayed_window_lines (w); -#if false - this_scroll_margin = max (0, min (scroll_margin, lines / 4)); -#endif - if (NILP (arg)) XSETFASTINT (arg, lines / 2); else @@ -5981,6 +5991,8 @@ from the top of the window. */) it is probably better not to install it. However, it is here inside #if false so as not to lose it. -- rms. */ + this_scroll_margin = window_scroll_margin (w, MARGIN_IN_LINES); + /* Don't let it get into the margin at either top or bottom. */ iarg = max (iarg, this_scroll_margin); iarg = min (iarg, lines - this_scroll_margin - 1); diff --git a/src/window.h b/src/window.h index 061cf24494..acb8a5cabf 100644 --- a/src/window.h +++ b/src/window.h @@ -1120,6 +1120,8 @@ extern bool compare_window_configurations (Lisp_Object, Lisp_Object, bool); extern void mark_window_cursors_off (struct window *); extern int window_internal_height (struct window *); extern int window_body_width (struct window *w, bool); +enum margin_unit { MARGIN_IN_LINES, MARGIN_IN_PIXELS }; +extern int window_scroll_margin (struct window *, enum margin_unit); extern void temp_output_buffer_show (Lisp_Object); extern void replace_buffer_in_windows (Lisp_Object); extern void replace_buffer_in_windows_safely (Lisp_Object); diff --git a/src/xdisp.c b/src/xdisp.c index 33661c882c..8a450b7a8a 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -15316,7 +15316,6 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, bool temp_scroll_step, bool last_line_misfit) { struct window *w = XWINDOW (window); - struct frame *f = XFRAME (w->frame); struct text_pos pos, startp; struct it it; int this_scroll_margin, scroll_max, rc, height; @@ -15327,8 +15326,6 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, /* We will never try scrolling more than this number of lines. */ int scroll_limit = SCROLL_LIMIT; int frame_line_height = default_line_pixel_height (w); - int window_total_lines - = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height; #ifdef GLYPH_DEBUG debug_method_add (w, "try_scrolling"); @@ -15336,13 +15333,7 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, SET_TEXT_POS_FROM_MARKER (startp, w->start); - /* Compute scroll margin height in pixels. We scroll when point is - within this distance from the top or bottom of the window. */ - if (scroll_margin > 0) - this_scroll_margin = min (scroll_margin, window_total_lines / 4) - * frame_line_height; - else - this_scroll_margin = 0; + this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); /* Force arg_scroll_conservatively to have a reasonable value, to avoid scrolling too far away with slow move_it_* functions. Note @@ -15816,23 +15807,12 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, { int this_scroll_margin, top_scroll_margin; struct glyph_row *row = NULL; - int frame_line_height = default_line_pixel_height (w); - int window_total_lines - = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height; #ifdef GLYPH_DEBUG debug_method_add (w, "cursor movement"); #endif - /* Scroll if point within this distance from the top or bottom - of the window. This is a pixel value. */ - if (scroll_margin > 0) - { - this_scroll_margin = min (scroll_margin, window_total_lines / 4); - this_scroll_margin *= frame_line_height; - } - else - this_scroll_margin = 0; + this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); top_scroll_margin = this_scroll_margin; if (WINDOW_WANTS_HEADER_LINE_P (w)) @@ -16280,7 +16260,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) int centering_position = -1; bool last_line_misfit = false; ptrdiff_t beg_unchanged, end_unchanged; - int frame_line_height; + int frame_line_height, margin; bool use_desired_matrix; void *itdata = NULL; @@ -16310,6 +16290,8 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) restart: reconsider_clip_changes (w); frame_line_height = default_line_pixel_height (w); + margin = window_scroll_margin (w, MARGIN_IN_LINES); + /* Has the mode line to be updated? */ update_mode_line = (w->update_mode_line @@ -16614,10 +16596,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) /* Some people insist on not letting point enter the scroll margin, even though this part handles windows that didn't scroll at all. */ - int window_total_lines - = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height; - int margin = min (scroll_margin, window_total_lines / 4); - int pixel_margin = margin * frame_line_height; + int pixel_margin = margin * frame_line_height; bool header_line = WINDOW_WANTS_HEADER_LINE_P (w); /* Note: We add an extra FRAME_LINE_HEIGHT, because the loop @@ -16901,12 +16880,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) it.current_y = it.last_visible_y; if (centering_position < 0) { - int window_total_lines - = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height; - int margin - = scroll_margin > 0 - ? min (scroll_margin, window_total_lines / 4) - : 0; ptrdiff_t margin_pos = CHARPOS (startp); Lisp_Object aggressive; bool scrolling_up; @@ -17150,10 +17123,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) { int window_total_lines = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height; - int margin = - scroll_margin > 0 - ? min (scroll_margin, window_total_lines / 4) - : 0; bool move_down = w->cursor.vpos >= window_total_lines / 2; move_it_by_lines (&it, move_down ? margin + 1 : -(margin + 1)); @@ -17359,7 +17328,6 @@ try_window (Lisp_Object window, struct text_pos pos, int flags) struct it it; struct glyph_row *last_text_row = NULL; struct frame *f = XFRAME (w->frame); - int frame_line_height = default_line_pixel_height (w); /* Make POS the new window start. */ set_marker_both (w->start, Qnil, CHARPOS (pos), BYTEPOS (pos)); @@ -17385,17 +17353,7 @@ try_window (Lisp_Object window, struct text_pos pos, int flags) if ((flags & TRY_WINDOW_CHECK_MARGINS) && !MINI_WINDOW_P (w)) { - int this_scroll_margin; - int window_total_lines - = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height; - - if (scroll_margin > 0) - { - this_scroll_margin = min (scroll_margin, window_total_lines / 4); - this_scroll_margin *= frame_line_height; - } - else - this_scroll_margin = 0; + int this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); if ((w->cursor.y >= 0 /* not vscrolled */ && w->cursor.y < this_scroll_margin @@ -18679,15 +18637,8 @@ try_window_id (struct window *w) /* Don't let the cursor end in the scroll margins. */ { - int this_scroll_margin, cursor_height; - int frame_line_height = default_line_pixel_height (w); - int window_total_lines - = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (it.f) / frame_line_height; - - this_scroll_margin = - max (0, min (scroll_margin, window_total_lines / 4)); - this_scroll_margin *= frame_line_height; - cursor_height = MATRIX_ROW (w->desired_matrix, w->cursor.vpos)->height; + int this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); + int cursor_height = MATRIX_ROW (w->desired_matrix, w->cursor.vpos)->height; if ((w->cursor.y < this_scroll_margin && CHARPOS (start) > BEGV) commit 604724e49d7b44dc663ad941998a0a44aa4fc178 Author: Dmitry Gutov Date: Fri Feb 3 03:10:30 2017 +0200 (xref-collect-matches): Use '-E' together with '-e' * lisp/progmodes/xref.el (xref-collect-matches): Use '-E' together with '-e', as suggested by Noam Postavsky (http://lists.gnu.org/archive/html/emacs-devel/2017-01/msg00780.html). diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index a507755d42..a8933b0103 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -918,11 +918,7 @@ IGNORES is a list of glob patterns." (grep-compute-defaults) (defvar grep-find-template) (defvar grep-highlight-matches) - ;; 'grep -E -foo' results in 'grep: oo: No such file or directory'. - ;; while 'grep -e -foo' inexplicably doesn't. - (when (eq (aref regexp 0) ?-) - (setq regexp (concat "\\" regexp))) - (let* ((grep-find-template (replace-regexp-in-string "-e " "-E " + (let* ((grep-find-template (replace-regexp-in-string "" " -E" grep-find-template t t)) (grep-highlight-matches nil) (command (xref--rgrep-command (xref--regexp-to-extended regexp) commit 53c16c75a57aa486dfc1f46ef5aa538264e6ad47 Author: Paul Eggert Date: Thu Feb 2 15:52:59 2017 -0800 Pacify Oracle Studio 12.5 * src/emacs.c (main): Do not silently convert char * to bool. diff --git a/src/emacs.c b/src/emacs.c index 28b395c4fb..3083d0df30 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -688,7 +688,7 @@ main (int argc, char **argv) dumping = !initialized && (strcmp (argv[argc - 1], "dump") == 0 || strcmp (argv[argc - 1], "bootstrap") == 0 ); - generating_ldefs_boot = getenv ("GENERATE_LDEFS_BOOT"); + generating_ldefs_boot = !!getenv ("GENERATE_LDEFS_BOOT"); /* True if address randomization interferes with memory allocation. */ commit df915775bc4ead095aa37d2b098de748e1821027 Author: Eli Zaretskii Date: Thu Feb 2 23:06:48 2017 +0200 ; Fix recent documentation changes * doc/emacs/search.texi (Other Repeating Search): Index recently introduced variables and faces. diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index a6cb1a4c9f..fa69ba48f6 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1715,6 +1715,8 @@ a multi-file incremental search is activated automatically. @cindex mode, Occur @cindex match (face name) @vindex list-matching-lines-default-context-lines +@vindex list-matching-lines-jump-to-current-line +@cindex list-matching-lines-current-line-face (face name) @kindex M-s o @item M-x occur @itemx M-s o commit eee537267f8d6a2f5a48f0c26c14546ac922936c Author: Paul Eggert Date: Thu Feb 2 09:52:20 2017 -0800 Fix lisp.h underparenthesization * src/lisp.h (STACK_CONS, AUTO_STRING_WITH_LEN): Parenthesize compound literals that are function call args. Although this does not fix any bugs, it is the proper style for macro parenthesization as it means this code will continue to work even if make_lisp_ptr is changed to a macro. diff --git a/src/lisp.h b/src/lisp.h index 1ac38164c2..a9011b4a8b 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4535,7 +4535,7 @@ enum use these only in macros like AUTO_CONS that declare a local variable whose lifetime will be clear to the programmer. */ #define STACK_CONS(a, b) \ - make_lisp_ptr (&(union Aligned_Cons) { { a, { b } } }.s, Lisp_Cons) + make_lisp_ptr (&((union Aligned_Cons) { { a, { b } } }).s, Lisp_Cons) #define AUTO_CONS_EXPR(a, b) \ (USE_STACK_CONS ? STACK_CONS (a, b) : Fcons (a, b)) @@ -4581,8 +4581,7 @@ enum Lisp_Object name = \ (USE_STACK_STRING \ ? (make_lisp_ptr \ - ((&(union Aligned_String) \ - {{len, -1, 0, (unsigned char *) (str)}}.s), \ + ((&((union Aligned_String) {{len, -1, 0, (unsigned char *) (str)}}).s), \ Lisp_String)) \ : make_unibyte_string (str, len)) commit f5372d411d149e8a34def18074891454ebc47730 Author: Stefan Monnier Date: Thu Feb 2 10:57:37 2017 -0500 * lisp/doc-view.el (doc-view-mode): Don't require a final newline (doc-view-revert-buffer): Silence overflow warnings. diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 2c11cd23a7..172ea163c1 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -442,6 +442,9 @@ Typically \"page-%s.png\".") (defun doc-view-revert-buffer (&optional ignore-auto noconfirm) "Like `revert-buffer', but preserves the buffer's current modes." (interactive (list (not current-prefix-arg))) + (if (< undo-outer-limit (* 2 (buffer-size))) + ;; It's normal for this operation to result in a very large undo entry. + (setq-local undo-outer-limit (* 2 (buffer-size)))) (cl-labels ((revert () (let (revert-buffer-function) (revert-buffer ignore-auto noconfirm 'preserve-modes)))) @@ -1763,6 +1766,8 @@ toggle between displaying the document or editing it as text. (unless doc-view-doc-type (doc-view-set-doc-type)) (doc-view-set-up-single-converter) + (unless (memq doc-view-doc-type '(ps)) + (setq-local require-final-newline nil)) (doc-view-make-safe-dir doc-view-cache-directory) ;; Handle compressed files, remote files, files inside archives commit 46aa9a30095241cabef463fd01f71ce9ee50c4dc Author: Paul Eggert Date: Thu Feb 2 07:49:55 2017 -0800 Merge from gnulib 2017-01-30 Port to PGI 16.10 x86-64 2017-01-20 time_rz: fix comment typo 2017-01-14 strftime: %z is -00 if unknown This incorporates: * doc/misc/texinfo.tex, lib/c-ctype.h, lib/strftime.c: * lib/time-internal.h, lib/verify.h: Copy from gnulib. diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index c8913ab918..338bcf6504 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{2016-09-18.18} +\def\texinfoversion{2017-01-14.15} % % Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, % 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, @@ -165,6 +165,9 @@ % Give the space character the catcode for a space. \def\spaceisspace{\catcode`\ =10\relax} +% Likewise for ^^M, the end of line character. +\def\endlineisspace{\catcode13=10\relax} + \chardef\dashChar = `\- \chardef\slashChar = `\/ \chardef\underChar = `\_ @@ -950,21 +953,14 @@ % @comment ...line which is ignored... % @c is the same as @comment % @ignore ... @end ignore is another way to write a comment -% -\def\comment{\begingroup \catcode`\^^M=\active% -\catcode`\@=\other \catcode`\{=\other \catcode`\}=\other\commentxxx}% -{\catcode`\^^M=\active% -\gdef\commentxxx#1^^M{\endgroup% -\futurelet\nexttoken\commentxxxx}% -\gdef\commentxxxx{\ifx\nexttoken\aftermacro\expandafter\comment\fi}% -} \def\c{\begingroup \catcode`\^^M=\active% \catcode`\@=\other \catcode`\{=\other \catcode`\}=\other% \cxxx} {\catcode`\^^M=\active \gdef\cxxx#1^^M{\endgroup}} -% See comment in \scanmacro about why the definitions of @c and @comment differ +% +\let\comment\c % @paragraphindent NCHARS % We'll use ems for NCHARS, close enough. @@ -8031,9 +8027,6 @@ } \fi -\let\aftermacroxxx\relax -\def\aftermacro{\aftermacroxxx} - % alias because \c means cedilla in @tex or @math \let\texinfoc=\c @@ -8055,18 +8048,13 @@ \catcode`\\=\active % % Process the macro body under the current catcode regime. - \scantokens{#1@texinfoc}\aftermacro% + \scantokens{#1@texinfoc}% % \catcode`\@=\savedcatcodeone \catcode`\\=\savedcatcodetwo % % The \texinfoc is to remove the \newlinechar added by \scantokens, and % can be noticed by \parsearg. - % The \aftermacro allows a \comment at the end of the macro definition - % to duplicate itself past the final \newlinechar added by \scantokens: - % this is used in the definition of \group to comment out a newline. We - % don't do the same for \c to support Texinfo files with macros that ended - % with a @c, which should no longer be necessary. % We avoid surrounding the call to \scantokens with \bgroup and \egroup % to allow macros to open or close groups themselves. } @@ -8538,6 +8526,13 @@ \ifcase\paramno % 0 \expandafter\xdef\csname\the\macname\endcsname{% + \bgroup + \noexpand\spaceisspace + \noexpand\endlineisspace + \noexpand\expandafter % skip any whitespace after the macro name. + \expandafter\noexpand\csname\the\macname @@@\endcsname}% + \expandafter\xdef\csname\the\macname @@@\endcsname{% + \egroup \noexpand\scanmacro{\macrobody}}% \or % 1 \expandafter\xdef\csname\the\macname\endcsname{% diff --git a/lib/c-ctype.h b/lib/c-ctype.h index faf21581ca..bcdba6b996 100644 --- a/lib/c-ctype.h +++ b/lib/c-ctype.h @@ -115,16 +115,16 @@ extern "C" { /* Cases for lowercase hex letters, and lowercase letters, all offset by N. */ -#define _C_CTYPE_LOWER_A_THRU_F_N(n) \ - case 'a' + (n): case 'b' + (n): case 'c' + (n): case 'd' + (n): \ - case 'e' + (n): case 'f' + (n) -#define _C_CTYPE_LOWER_N(n) \ - _C_CTYPE_LOWER_A_THRU_F_N(n): \ - case 'g' + (n): case 'h' + (n): case 'i' + (n): case 'j' + (n): \ - case 'k' + (n): case 'l' + (n): case 'm' + (n): case 'n' + (n): \ - case 'o' + (n): case 'p' + (n): case 'q' + (n): case 'r' + (n): \ - case 's' + (n): case 't' + (n): case 'u' + (n): case 'v' + (n): \ - case 'w' + (n): case 'x' + (n): case 'y' + (n): case 'z' + (n) +#define _C_CTYPE_LOWER_A_THRU_F_N(N) \ + case 'a' + (N): case 'b' + (N): case 'c' + (N): case 'd' + (N): \ + case 'e' + (N): case 'f' + (N) +#define _C_CTYPE_LOWER_N(N) \ + _C_CTYPE_LOWER_A_THRU_F_N(N): \ + case 'g' + (N): case 'h' + (N): case 'i' + (N): case 'j' + (N): \ + case 'k' + (N): case 'l' + (N): case 'm' + (N): case 'n' + (N): \ + case 'o' + (N): case 'p' + (N): case 'q' + (N): case 'r' + (N): \ + case 's' + (N): case 't' + (N): case 'u' + (N): case 'v' + (N): \ + case 'w' + (N): case 'x' + (N): case 'y' + (N): case 'z' + (N) /* Cases for hex letters, digits, lower, punct, and upper. */ diff --git a/lib/strftime.c b/lib/strftime.c index 9aabcc6748..e4d78ef701 100644 --- a/lib/strftime.c +++ b/lib/strftime.c @@ -739,11 +739,10 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) /* The mask is not what you might think. When the ordinal i'th bit is set, insert a colon before the i'th digit of the time zone representation. */ -#define DO_TZ_OFFSET(d, negative, mask, v) \ +#define DO_TZ_OFFSET(d, mask, v) \ do \ { \ digits = d; \ - negative_number = negative; \ tz_colon_mask = mask; \ u_number_value = v; \ goto do_tz_offset; \ @@ -1444,6 +1443,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) } #endif + negative_number = diff < 0 || (diff == 0 && *zone == '-'); hour_diff = diff / 60 / 60; min_diff = diff / 60 % 60; sec_diff = diff % 60; @@ -1451,13 +1451,13 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) switch (colons) { case 0: /* +hhmm */ - DO_TZ_OFFSET (5, diff < 0, 0, hour_diff * 100 + min_diff); + DO_TZ_OFFSET (5, 0, hour_diff * 100 + min_diff); case 1: tz_hh_mm: /* +hh:mm */ - DO_TZ_OFFSET (6, diff < 0, 04, hour_diff * 100 + min_diff); + DO_TZ_OFFSET (6, 04, hour_diff * 100 + min_diff); case 2: tz_hh_mm_ss: /* +hh:mm:ss */ - DO_TZ_OFFSET (9, diff < 0, 024, + DO_TZ_OFFSET (9, 024, hour_diff * 10000 + min_diff * 100 + sec_diff); case 3: /* +hh if possible, else +hh:mm, else +hh:mm:ss */ @@ -1465,7 +1465,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) goto tz_hh_mm_ss; if (min_diff != 0) goto tz_hh_mm; - DO_TZ_OFFSET (3, diff < 0, 0, hour_diff); + DO_TZ_OFFSET (3, 0, hour_diff); default: goto bad_format; diff --git a/lib/time-internal.h b/lib/time-internal.h index 79cb562199..bf22834b2e 100644 --- a/lib/time-internal.h +++ b/lib/time-internal.h @@ -38,8 +38,8 @@ struct tm_zone /* A sequence of null-terminated strings packed next to each other. The strings are followed by an extra null byte. If TZ_IS_SET, there must be at least one string and the first string (which is - actually a TZ environment value value) may be empty. Otherwise - all strings must be nonempty. + actually a TZ environment value) may be empty. Otherwise all + strings must be nonempty. Abbreviations are stored here because otherwise the values of tm_zone and/or tzname would be dead after changing TZ and calling diff --git a/lib/verify.h b/lib/verify.h index dcaf7cab93..dcba9c8cb0 100644 --- a/lib/verify.h +++ b/lib/verify.h @@ -248,7 +248,12 @@ template /* Verify requirement R at compile-time, as a declaration without a trailing ';'. */ -#define verify(R) _GL_VERIFY (R, "verify (" #R ")") +#ifdef __GNUC__ +# define verify(R) _GL_VERIFY (R, "verify (" #R ")") +#else +/* PGI barfs if R is long. Play it safe. */ +# define verify(R) _GL_VERIFY (R, "verify (...)") +#endif #ifndef __has_builtin # define __has_builtin(x) 0 commit a362b56b51f49963dbb63cd318967bca9b9fef74 Author: Tino Calancha Date: Thu Feb 2 22:27:33 2017 +0900 Check if there are hunks before kill or refine a hunk * lisp/vc/diff-mode.el (diff--some-hunks-p): New predicate. (diff-hunk-kill, diff-file-kill, diff-refine-hunk): Use it (Bug#25571). diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index a7ac53953d..31c33e6a72 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -650,28 +650,36 @@ If the prefix ARG is given, restrict the view to the current file instead." (if arg (diff-bounds-of-file) (diff-bounds-of-hunk))) (set (make-local-variable 'diff-narrowed-to) (if arg 'file 'hunk))) +(defun diff--some-hunks-p () + (save-excursion + (goto-char (point-min)) + (re-search-forward diff-hunk-header-re nil t))) + (defun diff-hunk-kill () "Kill the hunk at point." (interactive) - (let* ((hunk-bounds (diff-bounds-of-hunk)) - (file-bounds (ignore-errors (diff-bounds-of-file))) - ;; If the current hunk is the only one for its file, kill the - ;; file header too. - (bounds (if (and file-bounds - (progn (goto-char (car file-bounds)) - (= (progn (diff-hunk-next) (point)) - (car hunk-bounds))) - (progn (goto-char (cadr hunk-bounds)) - ;; bzr puts a newline after the last hunk. - (while (looking-at "^\n") - (forward-char 1)) - (= (point) (cadr file-bounds)))) - file-bounds - hunk-bounds)) - (inhibit-read-only t)) - (apply 'kill-region bounds) - (goto-char (car bounds)) - (ignore-errors (diff-beginning-of-hunk t)))) + (if (not (diff--some-hunks-p)) + (error "No hunks") + (diff-beginning-of-hunk t) + (let* ((hunk-bounds (diff-bounds-of-hunk)) + (file-bounds (ignore-errors (diff-bounds-of-file))) + ;; If the current hunk is the only one for its file, kill the + ;; file header too. + (bounds (if (and file-bounds + (progn (goto-char (car file-bounds)) + (= (progn (diff-hunk-next) (point)) + (car hunk-bounds))) + (progn (goto-char (cadr hunk-bounds)) + ;; bzr puts a newline after the last hunk. + (while (looking-at "^\n") + (forward-char 1)) + (= (point) (cadr file-bounds)))) + file-bounds + hunk-bounds)) + (inhibit-read-only t)) + (apply 'kill-region bounds) + (goto-char (car bounds)) + (ignore-errors (diff-beginning-of-hunk t))))) (defun diff-beginning-of-file-and-junk () "Go to the beginning of file-related diff-info. @@ -723,10 +731,12 @@ data such as \"Index: ...\" and such." (defun diff-file-kill () "Kill current file's hunks." (interactive) - (diff-beginning-of-hunk t) - (let ((inhibit-read-only t)) - (apply 'kill-region (diff-bounds-of-file))) - (ignore-errors (diff-beginning-of-hunk t))) + (if (not (diff--some-hunks-p)) + (error "No hunks") + (diff-beginning-of-hunk t) + (let ((inhibit-read-only t)) + (apply 'kill-region (diff-bounds-of-file))) + (ignore-errors (diff-beginning-of-hunk t)))) (defun diff-kill-junk () "Kill spurious empty diffs." @@ -2009,57 +2019,58 @@ Return new point, if it was moved." "Highlight changes of hunk at point at a finer granularity." (interactive) (require 'smerge-mode) - (save-excursion - (diff-beginning-of-hunk t) - (let* ((start (point)) - (style (diff-hunk-style)) ;Skips the hunk header as well. - (beg (point)) - (props-c '((diff-mode . fine) (face diff-refine-changed))) - (props-r '((diff-mode . fine) (face diff-refine-removed))) - (props-a '((diff-mode . fine) (face diff-refine-added))) - ;; Be careful to go back to `start' so diff-end-of-hunk gets - ;; to read the hunk header's line info. - (end (progn (goto-char start) (diff-end-of-hunk) (point)))) - - (remove-overlays beg end 'diff-mode 'fine) - - (goto-char beg) - (pcase style - (`unified - (while (re-search-forward "^-" end t) - (let ((beg-del (progn (beginning-of-line) (point))) - beg-add end-add) - (when (and (diff--forward-while-leading-char ?- end) - ;; Allow for "\ No newline at end of file". - (progn (diff--forward-while-leading-char ?\\ end) - (setq beg-add (point))) - (diff--forward-while-leading-char ?+ end) - (progn (diff--forward-while-leading-char ?\\ end) - (setq end-add (point)))) - (smerge-refine-subst beg-del beg-add beg-add end-add - nil 'diff-refine-preproc props-r props-a))))) - (`context - (let* ((middle (save-excursion (re-search-forward "^---"))) - (other middle)) - (while (re-search-forward "^\\(?:!.*\n\\)+" middle t) - (smerge-refine-subst (match-beginning 0) (match-end 0) - (save-excursion - (goto-char other) - (re-search-forward "^\\(?:!.*\n\\)+" end) - (setq other (match-end 0)) - (match-beginning 0)) - other - (if diff-use-changed-face props-c) - 'diff-refine-preproc - (unless diff-use-changed-face props-r) - (unless diff-use-changed-face props-a))))) - (_ ;; Normal diffs. - (let ((beg1 (1+ (point)))) - (when (re-search-forward "^---.*\n" end t) - ;; It's a combined add&remove, so there's something to do. - (smerge-refine-subst beg1 (match-beginning 0) - (match-end 0) end - nil 'diff-refine-preproc props-r props-a)))))))) + (when (diff--some-hunks-p) + (save-excursion + (diff-beginning-of-hunk t) + (let* ((start (point)) + (style (diff-hunk-style)) ;Skips the hunk header as well. + (beg (point)) + (props-c '((diff-mode . fine) (face diff-refine-changed))) + (props-r '((diff-mode . fine) (face diff-refine-removed))) + (props-a '((diff-mode . fine) (face diff-refine-added))) + ;; Be careful to go back to `start' so diff-end-of-hunk gets + ;; to read the hunk header's line info. + (end (progn (goto-char start) (diff-end-of-hunk) (point)))) + + (remove-overlays beg end 'diff-mode 'fine) + + (goto-char beg) + (pcase style + (`unified + (while (re-search-forward "^-" end t) + (let ((beg-del (progn (beginning-of-line) (point))) + beg-add end-add) + (when (and (diff--forward-while-leading-char ?- end) + ;; Allow for "\ No newline at end of file". + (progn (diff--forward-while-leading-char ?\\ end) + (setq beg-add (point))) + (diff--forward-while-leading-char ?+ end) + (progn (diff--forward-while-leading-char ?\\ end) + (setq end-add (point)))) + (smerge-refine-subst beg-del beg-add beg-add end-add + nil 'diff-refine-preproc props-r props-a))))) + (`context + (let* ((middle (save-excursion (re-search-forward "^---"))) + (other middle)) + (while (re-search-forward "^\\(?:!.*\n\\)+" middle t) + (smerge-refine-subst (match-beginning 0) (match-end 0) + (save-excursion + (goto-char other) + (re-search-forward "^\\(?:!.*\n\\)+" end) + (setq other (match-end 0)) + (match-beginning 0)) + other + (if diff-use-changed-face props-c) + 'diff-refine-preproc + (unless diff-use-changed-face props-r) + (unless diff-use-changed-face props-a))))) + (_ ;; Normal diffs. + (let ((beg1 (1+ (point)))) + (when (re-search-forward "^---.*\n" end t) + ;; It's a combined add&remove, so there's something to do. + (smerge-refine-subst beg1 (match-beginning 0) + (match-end 0) end + nil 'diff-refine-preproc props-r props-a))))))))) (defun diff-undo (&optional arg) "Perform `undo', ignoring the buffer's read-only status." commit 01d87bf846b478dea0bfe824678e76089f5af2c7 Author: Tino Calancha Date: Thu Feb 2 22:27:18 2017 +0900 Ignore error after kill last file or hunk * lisp/vc/diff-mode.el (diff-hunk-kill): Go to beginning of hunk before kill. Ignore error after kill last hunk (Bug#25570). (diff-file-kill): Idem. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 7ffa115bde..a7ac53953d 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -671,7 +671,7 @@ If the prefix ARG is given, restrict the view to the current file instead." (inhibit-read-only t)) (apply 'kill-region bounds) (goto-char (car bounds)) - (diff-beginning-of-hunk t))) + (ignore-errors (diff-beginning-of-hunk t)))) (defun diff-beginning-of-file-and-junk () "Go to the beginning of file-related diff-info. @@ -723,9 +723,10 @@ data such as \"Index: ...\" and such." (defun diff-file-kill () "Kill current file's hunks." (interactive) + (diff-beginning-of-hunk t) (let ((inhibit-read-only t)) (apply 'kill-region (diff-bounds-of-file))) - (diff-beginning-of-hunk t)) + (ignore-errors (diff-beginning-of-hunk t))) (defun diff-kill-junk () "Kill spurious empty diffs." commit e280b94dcd6ed42439718ddf9dd704169f6bb536 Author: Tino Calancha Date: Thu Feb 2 19:13:27 2017 +0900 Show current line highlighted in *Occur* buffer * lisp/replace.el (list-matching-lines-current-line-face) (list-matching-lines-jump-to-current-line): New user options. (occur--orig-line, occur--orig-line-str): New variables. (occur, occur-engine): Use them. (occur--final-pos): New variable. (occur-1): Use it. (occur-engine): Idem. Show the current line with 'list-matching-lines-current-line-face'. Set point on the first matching line after the current one. * etc/NEWS: Add entry for the new option. diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 2a67619678..a6cb1a4c9f 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1726,6 +1726,10 @@ face. A numeric argument @var{n} specifies that @var{n} lines of context are to be displayed before and after each matching line. The default number of context lines is specified by the variable @code{list-matching-lines-default-context-lines}. +When @code{list-matching-lines-jump-to-current-line} is non-nil, +the current line is shown highlighted with face +@code{list-matching-lines-current-line-face} and the point is set +at the first match after such line. You can also run @kbd{M-s o} when an incremental search is active; this uses the current search string. diff --git a/etc/NEWS b/etc/NEWS index dcefb75fd5..ddd40fa853 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -311,6 +311,11 @@ substituted by a home directory by writing it as "/foo:/:/~/file". * Editing Changes in Emacs 26.1 +++ +** Two new user options 'list-matching-lines-jump-to-current-line' and +'list-matching-lines-current-line-face' to show highlighted the current +line in *Occur* buffer. + ++++ ** The 'occur' command can now operate on the region. +++ diff --git a/lisp/replace.el b/lisp/replace.el index 0a8e480485..a825040a97 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1304,6 +1304,19 @@ If the value is nil, don't highlight the buffer names specially." :type 'face :group 'matching) +(defcustom list-matching-lines-current-line-face 'lazy-highlight + "Face used by \\[list-matching-lines] to highlight the current line." + :type 'face + :group 'matching + :version "26.1") + +(defcustom list-matching-lines-jump-to-current-line nil + "If non-nil, \\[list-matching-lines] shows the current line highlighted. +Set the point right after such line when there are matches after it." +:type 'boolean +:group 'matching +:version "26.1") + (defcustom list-matching-lines-prefix-face 'shadow "Face used by \\[list-matching-lines] to show the prefix column. If the face doesn't differ from the default face, @@ -1364,6 +1377,9 @@ invoke `occur'." (defvar occur--region-start nil) (defvar occur--region-end nil) (defvar occur--matches-threshold nil) +(defvar occur--orig-line nil) +(defvar occur--orig-line-str nil) +(defvar occur--final-pos nil) (defun occur (regexp &optional nlines region) "Show all lines in the current buffer containing a match for REGEXP. @@ -1382,6 +1398,9 @@ REGION must be a list of (START . END) positions as returned by The lines are shown in a buffer named `*Occur*'. It serves as a menu to find any of the occurrences in this buffer. \\\\[describe-mode] in that buffer will explain how. +If `list-matching-lines-jump-to-current-line' is non-nil, then show +the current line highlighted with `list-matching-lines-current-line-face' +and set point at the first match after such line. If REGEXP contains upper case characters (excluding those preceded by `\\') and `search-upper-case' is non-nil, the matching is case-sensitive. @@ -1409,7 +1428,13 @@ is not modified." (occur--region-end end) (occur--matches-threshold (and in-region-p - (line-number-at-pos (min start end))))) + (line-number-at-pos (min start end)))) + (occur--orig-line + (line-number-at-pos (point))) + (occur--orig-line-str + (buffer-substring-no-properties + (line-beginning-position) + (line-end-position)))) (save-excursion ; If no matches `occur-1' doesn't restore the point. (and in-region-p (narrow-to-region start end)) (occur-1 regexp nlines (list (current-buffer))) @@ -1508,7 +1533,8 @@ See also `multi-occur'." (occur-mode)) (let ((inhibit-read-only t) ;; Don't generate undo entries for creation of the initial contents. - (buffer-undo-list t)) + (buffer-undo-list t) + (occur--final-pos nil)) (erase-buffer) (let ((count (if (stringp nlines) @@ -1560,6 +1586,10 @@ See also `multi-occur'." (if (= count 0) (kill-buffer occur-buf) (display-buffer occur-buf) + (when occur--final-pos + (set-window-point + (get-buffer-window occur-buf 'all-frames) + occur--final-pos)) (setq next-error-last-buffer occur-buf) (setq buffer-read-only t) (set-buffer-modified-p nil) @@ -1572,7 +1602,8 @@ See also `multi-occur'." (global-matches 0) ;; total count of matches (coding nil) (case-fold-search case-fold) - (in-region-p (and occur--region-start occur--region-end))) + (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) @@ -1580,12 +1611,16 @@ See also `multi-occur'." (matches 0) ;; count of matches (curr-line ;; line count (or occur--matches-threshold 1)) + (orig-line occur--orig-line) + (orig-line-str occur--orig-line-str) + (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) + (finalpt nil) (marker nil) (curstring "") (ret nil) @@ -1686,6 +1721,18 @@ See also `multi-occur'." (nth 0 ret)))) ;; Actually insert the match display data (with-current-buffer out-buf + (when (and list-matching-lines-jump-to-current-line + (not multi-occur-p) + (not orig-line-shown-p) + (>= curr-line orig-line)) + (insert + (concat + (propertize + (format "%7d:%s" orig-line orig-line-str) + 'face list-matching-lines-current-line-face + 'mouse-face 'mode-line-highlight + 'help-echo "Current line") "\n")) + (setq orig-line-shown-p t finalpt (point))) (insert data))) (goto-char endpt)) (if endpt @@ -1699,6 +1746,18 @@ See also `multi-occur'." (forward-line 1)) (goto-char (point-max))) (setq prev-line (1- curr-line))) + ;; Insert original line if haven't done yet. + (when (and list-matching-lines-jump-to-current-line + (not multi-occur-p) + (not orig-line-shown-p)) + (with-current-buffer out-buf + (insert + (concat + (propertize + (format "%7d:%s" orig-line orig-line-str) + 'face list-matching-lines-current-line-face + 'mouse-face 'mode-line-highlight + 'help-echo "Current line") "\n")))) ;; Flush remaining context after-lines. (when prev-after-lines (with-current-buffer out-buf @@ -1732,8 +1791,11 @@ See also `multi-occur'." (setq end (point)) (add-text-properties beg end `(occur-title ,buf)) (when title-face - (add-face-text-property beg end title-face))) - (goto-char (point-min))))))) + (add-face-text-property beg end title-face)) + (goto-char (if finalpt + (setq occur--final-pos + (cl-incf finalpt (- end beg))) + (point-min))))))))) ;; Display total match count and regexp for multi-buffer. (when (and (not (zerop global-lines)) (> (length buffers) 1)) (goto-char (point-min)) commit 8e871aef10455eefc34790a9ec011c6fec5e93fe Author: Tino Calancha Date: Thu Feb 2 19:13:05 2017 +0900 Allow occur command to operate on the region See discussion in: https://lists.gnu.org/archive/html/emacs-devel/2016-12/msg01084.html * lisp/replace.el (occur--region-start, occur--region-end) (occur--matches-threshold): New variables. (occur-engine): Use them. (occur): Idem. Add optional arg REGION; if non-nil occur applies in that region. * doc/lispintro/emacs-lisp-intro.texi (Keybindings): Update manual * doc/emacs/search.texi (Other Repeating Search): Idem. ; etc/NEWS: Add entry for the new feature. diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index b728258973..2a67619678 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1670,8 +1670,9 @@ replacing regexp matches in file names. Here are some other commands that find matches for a regular expression. They all ignore case in matching, if the pattern contains no upper-case letters and @code{case-fold-search} is non-@code{nil}. -Aside from @code{occur} and its variants, all operate on the text from -point to the end of the buffer, or on the region if it is active. +Aside from @code{multi-occur} and @code{multi-occur-in-matching-buffers}, +which always search the whole buffer, all operate on the text from point +to the end of the buffer, or on the region if it is active. @findex list-matching-lines @findex occur @@ -1721,11 +1722,10 @@ Prompt for a regexp, and display a list showing each line in the buffer that contains a match for it. If you type @kbd{M-n} at the prompt, you can reuse search strings from previous incremental searches. The text that matched is highlighted using the @code{match} -face. To limit the search to part of the buffer, narrow to that part -(@pxref{Narrowing}). A numeric argument @var{n} specifies that -@var{n} lines of context are to be displayed before and after each -matching line. The default number of context lines is specified by -the variable @code{list-matching-lines-default-context-lines}. +face. A numeric argument @var{n} specifies that @var{n} lines of +context are to be displayed before and after each matching line. +The default number of context lines is specified by the variable +@code{list-matching-lines-default-context-lines}. You can also run @kbd{M-s o} when an incremental search is active; this uses the current search string. diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 830c072cf5..36d767737d 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -17151,9 +17151,11 @@ Here is another keybinding, with a comment: @findex occur The @code{occur} command shows all the lines in the current buffer -that contain a match for a regular expression. Matching lines are -shown in a buffer called @file{*Occur*}. That buffer serves as a menu -to jump to occurrences. +that contain a match for a regular expression. When the region is +active, @code{occur} restricts matches to such region. Otherwise it +uses the entire buffer. +Matching lines are shown in a buffer called @file{*Occur*}. +That buffer serves as a menu to jump to occurrences. @findex global-unset-key @cindex Unbinding key diff --git a/etc/NEWS b/etc/NEWS index 86a8385ae7..dcefb75fd5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -311,6 +311,9 @@ substituted by a home directory by writing it as "/foo:/:/~/file". * Editing Changes in Emacs 26.1 +++ +** The 'occur' command can now operate on the region. + ++++ ** New bindings for 'query-replace-map'. 'undo', undo the last replacement; bound to 'u'. 'undo-all', undo all replacements; bound to 'U'. diff --git a/lisp/replace.el b/lisp/replace.el index ff91734445..0a8e480485 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1360,7 +1360,12 @@ invoke `occur'." "*") (or unique-p (not interactive-p))))) -(defun occur (regexp &optional nlines) +;; Region limits when `occur' applies on a region. +(defvar occur--region-start nil) +(defvar occur--region-end nil) +(defvar occur--matches-threshold nil) + +(defun occur (regexp &optional nlines region) "Show all lines in the current buffer containing a match for REGEXP. If a match spreads across multiple lines, all those lines are shown. @@ -1369,6 +1374,11 @@ before if NLINES is negative. NLINES defaults to `list-matching-lines-default-context-lines'. Interactively it is the prefix arg. +Optional arg REGION, if non-nil, mean restrict search to the +specified region. Otherwise search the entire buffer. +REGION must be a list of (START . END) positions as returned by +`region-bounds'. + The lines are shown in a buffer named `*Occur*'. It serves as a menu to find any of the occurrences in this buffer. \\\\[describe-mode] in that buffer will explain how. @@ -1386,8 +1396,24 @@ For example, providing \"defun\\s +\\(\\S +\\)\" for REGEXP and program. When there is no parenthesized subexpressions in REGEXP the entire match is collected. In any case the searched buffer is not modified." - (interactive (occur-read-primary-args)) - (occur-1 regexp nlines (list (current-buffer)))) + (interactive + (nconc (occur-read-primary-args) + (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--matches-threshold + (and in-region-p + (line-number-at-pos (min start end))))) + (save-excursion ; If no matches `occur-1' doesn't restore the point. + (and in-region-p (narrow-to-region start end)) + (occur-1 regexp nlines (list (current-buffer))) + (and in-region-p (widen)))))) (defvar ido-ignore-item-temp-list) @@ -1545,13 +1571,15 @@ See also `multi-occur'." (let ((global-lines 0) ;; total count of matching lines (global-matches 0) ;; total count of matches (coding nil) - (case-fold-search case-fold)) + (case-fold-search case-fold) + (in-region-p (and occur--region-start occur--region-end))) ;; 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 1) ;; line count + (curr-line ;; line count + (or occur--matches-threshold 1)) (prev-line nil) ;; line number of prev match endpt (prev-after-lines nil) ;; context lines of prev match (matchbeg 0) @@ -1684,7 +1712,7 @@ See also `multi-occur'." (let ((beg (point)) end) (insert (propertize - (format "%d match%s%s%s in buffer: %s\n" + (format "%d match%s%s%s in buffer: %s%s\n" matches (if (= matches 1) "" "es") ;; Don't display the same number of lines ;; and matches in case of 1 match per line. @@ -1694,7 +1722,12 @@ See also `multi-occur'." ;; Don't display regexp for multi-buffer. (if (> (length buffers) 1) "" (occur-regexp-descr regexp)) - (buffer-name buf)) + (buffer-name buf) + (if in-region-p + (format " within region: %d-%d" + occur--region-start + occur--region-end) + "")) 'read-only t)) (setq end (point)) (add-text-properties beg end `(occur-title ,buf))