From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Alan Mackenzie Newsgroups: gmane.emacs.devel Subject: Re: "... the window start at a meaningless point within a line." Date: Wed, 28 Oct 2015 13:15:05 +0000 Message-ID: <20151028131505.GB2538@acm.fritz.box> References: <83twpp51xz.fsf@gnu.org> <20151017115738.GA2522@acm.fritz.box> <83oafx4qsb.fsf@gnu.org> <83lhb14o6e.fsf@gnu.org> <83k2ql4lsy.fsf@gnu.org> <20151018150052.GD1639@acm.fritz.box> <83lhb0hy0h.fsf@gnu.org> <20151019102755.GB2438@acm.fritz.box> <20151027134025.GA2401@acm.fritz.box> <83fv0w41dg.fsf@gnu.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="rwEMma7ioTxnRzrJ" X-Trace: ger.gmane.org 1446038034 17229 80.91.229.3 (28 Oct 2015 13:13:54 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Wed, 28 Oct 2015 13:13:54 +0000 (UTC) Cc: emacs-devel@gnu.org To: Eli Zaretskii Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Oct 28 14:13:46 2015 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1ZrQXo-0007HM-2m for ged-emacs-devel@m.gmane.org; Wed, 28 Oct 2015 14:13:37 +0100 Original-Received: from localhost ([::1]:37907 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZrQXn-0000o7-Db for ged-emacs-devel@m.gmane.org; Wed, 28 Oct 2015 09:13:35 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:56968) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZrQXg-0000nw-89 for emacs-devel@gnu.org; Wed, 28 Oct 2015 09:13:32 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ZrQXb-0003QV-0k for emacs-devel@gnu.org; Wed, 28 Oct 2015 09:13:28 -0400 Original-Received: from mail.muc.de ([193.149.48.3]:19109) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZrQXa-0003PV-IZ for emacs-devel@gnu.org; Wed, 28 Oct 2015 09:13:22 -0400 Original-Received: (qmail 54888 invoked by uid 3782); 28 Oct 2015 13:13:21 -0000 Original-Received: from acm.muc.de (p579E8681.dip0.t-ipconnect.de [87.158.134.129]) by colin.muc.de (tmda-ofmipd) with ESMTP; Wed, 28 Oct 2015 14:13:20 +0100 Original-Received: (qmail 3701 invoked by uid 1000); 28 Oct 2015 13:15:05 -0000 Content-Disposition: inline In-Reply-To: <83fv0w41dg.fsf@gnu.org> User-Agent: Mutt/1.5.23 (2014-03-12) X-Delivery-Agent: TMDA/1.1.12 (Macallan) X-Primary-Address: acm@muc.de X-detected-operating-system: by eggs.gnu.org: FreeBSD 9.x X-Received-From: 193.149.48.3 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:192789 Archived-At: --rwEMma7ioTxnRzrJ Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Hello, Eli. On Tue, Oct 27, 2015 at 08:23:07PM +0200, Eli Zaretskii wrote: > > Date: Tue, 27 Oct 2015 13:40:25 +0000 > > Cc: emacs-devel@gnu.org > > From: Alan Mackenzie > > I haven't managed to get anywhere with this. The code in > > Fvertical_motion is already quite complicated, due to the variable > > it_overshoot_count, and the various things that make it necessary, like > > `before-string' or `after-string' overlays with LFs in them. If we add > > in code to correct for "actual" WS into the melee, the code could not > > help becoming even more difficult to understand. > > What makes me less enthusiastic about the approach is that it only > > covers one case, that with (nlines > 0) where point is already within > > the first text line in the window (not before it). > In that case, it probably means I will have to do this. Please send > the smallest patch that allows window-start to be where you want it, > and doesn't involve vertical-motion, together with some simple test > case to show what doesn't work in the unmodified vertical-motion. I > will then come up with a fix for that function. [ .... ] The patch below isn't strictly the minimal one you asked for. The three new functions I wrote in xdisp.c I have left in, because you might be able to use them, and they do no harm, and are easily removed if they're not useful. In Fvertical_motion, I've left in the bit that preserves the w->exact_start flag when the window is "borrowed" by another buffer. In window.c, I've left in the diagnostic function Fwindow_test_dump, which is a way of checking whether the window's exact_start flag is set. The patch applies cleanly to the master repository as of yesterday evening. If you really do want that minimal patch instead, get back to me and I will create it. I've included a small elisp file, utilities.el, which contains things I found useful whilst testing. In particular, the commands which scroll the buffer by 1 or 6 lines, the ones which move point to the top and bottom of the window, and those which scroll point to the top and bottom of the window are very helpful. The commands which enable Follow Mode in several side by side windows are probably more useful on a tty than in a GUI. I've also included a command which just calls `vertical-motion', and bound it to C-c m. The file fragment.el is an elisp fragment which contains some long lines. There is a particularly long line at L162. After applying the patch, to test things, in X (?or windows) o - Start emacs -Q. o - Load utilities.el. o - Visit fragment.el. o - Using the mouse, make the frame wide enough for two side by side windows of width 79 and 80. o - C-x 3. o - Fiddle about with the mouse, M-{, M-}, until the windows are 79, and 80 wide (`window-body-width' is your friend, here). o - Scroll the buffer until L162 straddles window 1 and window 2, with two display lines in each window. (S-/, C-S-/ from utilies.el are handy, here). First of all, note that in L162, all characters are displayed exactly once. This is the purpose of this change. With point in W2, note that C- doesn't go to the beginning of the window, and C- doesn't go to the end. The actual end positions are a line out in both cases. With point in the split line, note that vertical-motion (C-u C-c m) doesn't go to the right places, even when the target line is below the split line. Typing and also produce interesting effects. Using M-{ or M-}, make W1 80 wide, and W2 79 wide. Scroll the windows up and down, back to the same place, to ensure that Follow Mode has resynchronised its windows[*]. Now repeat the experiments of the previous paragraph. If anything, the results now are even worse. [*] This is something in Follow Mode which still needs amending. Perhaps I should write a more formal test spec which covers all the various cases. Have fun! Here is the patch: Add functionality to inhibit redisplay from moving window start to a BOL. src/window.h (struct window): Add new field exact_start. src/window.c (Fset_window_start): Amend code and doc wrt new parameter `exactstart". (Fdelete_other_windows_internal, set_window_buffer, window_scroll_pixel_based) (window_scroll_line_based, Frecenter, Fmove_to_window_line): Set exact_start to false after certain window manipulations. (recenter): new variable non_exact_start. Use it to check whether a non-null recentering has occurred, and only when so, set window.start etc. (Fwindow_test_dump): A temporary diagnostic function which displays window.start and window.exact_start. (syms_of_window): Include Swindow_test_dump. src/dispextern.h (forward_to_next_display_line_start) (get_window_start_on_continuation_line, reseat_at_window_start): New declarations. src/xdisp.c (forward_to_next_display_line_start): New function. (reseat_at_window_start): New function. (get_window_start_on_continuation_line): New function, extracted from ... (compute_window_start_on_continuation_line): Now calls the above function. src/indent.c (Fvertical_motion): Save state of w->exact_start when "lending" the window to another buffer. lisp/follow.el (follow-select-if-visible-from-first, follow-redisplay): Call set-window-start with `exactstart' parameter set. diff --git a/lisp/follow.el b/lisp/follow.el index 938c59e..d2caf4b 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -993,7 +993,7 @@ follow-select-if-visible-from-first (save-window-excursion (let ((windows windows)) (while (and (not win) windows) - (set-window-start (car windows) (point) 'noforce) + (set-window-start (car windows) (point) 'noforce t) (setq end-pos-end-p (follow-calc-win-end (car windows))) (goto-char (car end-pos-end-p)) ;; Visible, if dest above end, or if eob is visible @@ -1046,7 +1046,7 @@ follow-redisplay windows try-first-start win old-win-start))))) (dolist (w windows) (unless (and preserve-win (eq w win)) - (set-window-start w start)) + (set-window-start w start nil t)) (setq start (car (follow-calc-win-end w)))))) (defun follow-estimate-first-window-start (windows win start) diff --git a/src/dispextern.h b/src/dispextern.h index e44b70b..a4477ed 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -3217,6 +3217,7 @@ void init_iterator (struct it *, struct window *, ptrdiff_t, void init_iterator_to_row_start (struct it *, struct window *, struct glyph_row *); void start_display (struct it *, struct window *, struct text_pos); +bool forward_to_next_display_line_start (struct it *it); void move_it_vertically (struct it *, int); void move_it_vertically_backward (struct it *, int); void move_it_by_lines (struct it *, ptrdiff_t); @@ -3224,6 +3225,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); +struct text_pos get_window_start_on_continuation_line (struct window *w); bool in_display_vector_p (struct it *); int frame_mode_line_height (struct frame *); extern bool redisplaying_p; @@ -3233,6 +3235,8 @@ extern Lisp_Object help_echo_object, previous_help_echo_string; extern ptrdiff_t help_echo_pos; extern int last_tool_bar_item; extern void reseat_at_previous_visible_line_start (struct it *); +extern void reseat_at_window_start (struct it *it); + extern Lisp_Object lookup_glyphless_char_display (int, struct it *); extern ptrdiff_t compute_display_string_pos (struct text_pos *, struct bidi_string_data *, diff --git a/src/indent.c b/src/indent.c index 04837f8..32597bb 100644 --- a/src/indent.c +++ b/src/indent.c @@ -1996,6 +1996,7 @@ whether or not it is currently displayed in some window. */) struct window *w; Lisp_Object old_buffer; EMACS_INT old_charpos IF_LINT (= 0), old_bytepos IF_LINT (= 0); + bool old_exact_start = false; Lisp_Object lcols; void *itdata = NULL; @@ -2017,9 +2018,11 @@ whether or not it is currently displayed in some window. */) old_buffer = w->contents; old_charpos = marker_position (w->pointm); old_bytepos = marker_byte_position (w->pointm); + old_exact_start = w->exact_start; wset_buffer (w, Fcurrent_buffer ()); set_marker_both (w->pointm, w->contents, BUF_PT (current_buffer), BUF_PT_BYTE (current_buffer)); + w->exact_start = false; } if (noninteractive) @@ -2039,8 +2042,10 @@ whether or not it is currently displayed in some window. */) double start_col; int start_x IF_LINT (= 0); int to_x = -1; + struct text_pos xdisp_ws; bool start_x_given = !NILP (cur_col); + if (start_x_given) { start_col = extract_float (cur_col); @@ -2242,6 +2247,7 @@ whether or not it is currently displayed in some window. */) wset_buffer (w, old_buffer); set_marker_both (w->pointm, w->contents, old_charpos, old_bytepos); + w->exact_start = old_exact_start; } return make_number (it.vpos); diff --git a/src/window.c b/src/window.c index 7c95ff9..b922511 100644 --- a/src/window.c +++ b/src/window.c @@ -1666,12 +1666,14 @@ Return POS. */) return pos; } -DEFUN ("set-window-start", Fset_window_start, Sset_window_start, 2, 3, 0, +DEFUN ("set-window-start", Fset_window_start, Sset_window_start, 2, 4, 0, doc: /* Make display in WINDOW start at position POS in WINDOW's buffer. WINDOW must be a live window and defaults to the selected one. Return POS. Optional third arg NOFORCE non-nil inhibits next redisplay from -overriding motion of point in order to display at this exact start. */) - (Lisp_Object window, Lisp_Object pos, Lisp_Object noforce) +overriding motion of point in order to display at this exact +start. Optional fourth argument EXACTSTART non-nil prevents Emacs from +repositioning the window to the beginning of a line. */) + (Lisp_Object window, Lisp_Object pos, Lisp_Object noforce, Lisp_Object exactstart) { register struct window *w = decode_live_window (window); @@ -1683,6 +1685,7 @@ overriding motion of point in order to display at this exact start. */) wset_update_mode_line (w); /* Bug#15957. */ w->window_end_valid = false; + w->exact_start = !NILP (exactstart); wset_redisplay (w); return pos; @@ -3090,7 +3093,8 @@ window-start value is reasonable when this function is called. */) set_marker_both (w->start, w->contents, pos.bufpos, pos.bytepos); w->window_end_valid = false; w->start_at_line_beg = (pos.bytepos == BEGV_BYTE - || FETCH_BYTE (pos.bytepos - 1) == '\n'); + || FETCH_BYTE (pos.bytepos - 1) == '\n'); + w->exact_start = false; /* We need to do this, so that the window-scroll-functions get called. */ w->optional_new_start = true; @@ -3279,6 +3283,7 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, set_marker_restricted (w->start, make_number (b->last_window_start), buffer); + w->exact_start = false; w->start_at_line_beg = false; w->force_start = false; } @@ -4836,7 +4841,8 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) spos = min (XINT (Fline_end_position (Qnil)) + 1, ZV); set_marker_restricted (w->start, make_number (spos), w->contents); - w->start_at_line_beg = true; + w->exact_start = false; + w->start_at_line_beg = true; wset_update_mode_line (w); /* Set force_start so that redisplay_window will run the window-scroll-functions. */ @@ -4889,7 +4895,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) dy) * n; /* Note that move_it_vertically always moves the iterator to the - start of a line. So, if the last line doesn't have a newline, + start of a line. So, if the last line doesn't have a newline, we would end up at the start of the line ending at ZV. */ if (dy <= 0) { @@ -4967,7 +4973,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) vscrolled = true; } - if (! vscrolled) + if (!vscrolled && n) { ptrdiff_t pos = IT_CHARPOS (it); ptrdiff_t bytepos; @@ -4983,6 +4989,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) /* Set the window start, and set up the window for redisplay. */ set_marker_restricted_both (w->start, w->contents, IT_CHARPOS (it), IT_BYTEPOS (it)); + w->exact_start = false; bytepos = marker_byte_position (w->start); w->start_at_line_beg = (pos == BEGV || FETCH_BYTE (bytepos - 1) == '\n'); wset_update_mode_line (w); @@ -5011,7 +5018,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) in the scroll margin at the top. */ move_it_to (&it, PT, -1, -1, -1, MOVE_TO_POS); if (IT_CHARPOS (it) == PT && it.current_y >= this_scroll_margin - && (NILP (Vscroll_preserve_screen_position) + && (NILP (Vscroll_preserve_screen_position) || EQ (Vscroll_preserve_screen_position, Qt))) /* We found PT at a legitimate height. Leave it alone. */ ; @@ -5096,7 +5103,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) } if (charpos == PT && !partial_p - && (NILP (Vscroll_preserve_screen_position) + && (NILP (Vscroll_preserve_screen_position) || EQ (Vscroll_preserve_screen_position, Qt))) /* We found PT before we found the display margin, so PT is ok. */ ; @@ -5218,6 +5225,7 @@ window_scroll_line_based (Lisp_Object window, int n, bool whole, bool noerror) max (0, min (scroll_margin, w->total_lines / 4)); set_marker_restricted_both (w->start, w->contents, pos, pos_byte); + if (n) w->exact_start = false; w->start_at_line_beg = !NILP (bolp); wset_update_mode_line (w); /* Set force_start so that redisplay_window will run @@ -5393,7 +5401,7 @@ specifies the window. This takes precedence over if (EQ (window, selected_window)) /* That didn't get us anywhere; look for a window on another - visible frame. */ + visible frame. */ do window = Fnext_window (window, Qnil, Qt); while (! FRAME_VISIBLE_P (XFRAME (WINDOW_FRAME (XWINDOW (window)))) @@ -5597,6 +5605,12 @@ and redisplay normally--don't erase and redraw the frame. */) ptrdiff_t charpos, bytepos; EMACS_INT iarg IF_LINT (= 0); int this_scroll_margin; + struct text_pos non_exact_start; + + if (w->exact_start) + non_exact_start = get_window_start_on_continuation_line (w); + else + SET_TEXT_POS_FROM_MARKER (non_exact_start, w->start); if (buf != current_buffer) error ("`recenter'ing a window that does not display current-buffer."); @@ -5778,16 +5792,20 @@ and redisplay normally--don't erase and redraw the frame. */) bytepos = pos.bytepos; } - /* Set the new window start. */ - set_marker_both (w->start, w->contents, charpos, bytepos); - w->window_end_valid = false; + /* Set the new window start if we actually scrolled. */ + if (charpos != CHARPOS (non_exact_start)) + { + set_marker_both (w->start, w->contents, charpos, bytepos); + w->exact_start = false; + w->window_end_valid = false; - w->optional_new_start = true; + w->optional_new_start = true; - w->start_at_line_beg = (bytepos == BEGV_BYTE - || FETCH_BYTE (bytepos - 1) == '\n'); + w->start_at_line_beg = (bytepos == BEGV_BYTE + || FETCH_BYTE (bytepos - 1) == '\n'); - wset_redisplay (w); + wset_redisplay (w); + } return Qnil; } @@ -5862,6 +5880,7 @@ zero means top of window, negative means relative to bottom of window. */) int height = window_internal_height (w); Fvertical_motion (make_number (- (height / 2)), window, Qnil); set_marker_both (w->start, w->contents, PT, PT_BYTE); + w->exact_start = false; w->start_at_line_beg = !NILP (Fbolp ()); w->force_start = true; } @@ -7127,6 +7146,22 @@ and scrolling positions. */) return Qnil; } + +DEFUN ("window-test-dump", Fwindow_test_dump, Swindow_test_dump, 0, 0, "", + doc: /* Dump some critical components of the selected window to `message'.*/) + () +{ + Lisp_Object window = Fselected_window (); + struct window *w = decode_live_window (window); + AUTO_STRING (format, "start: %s; exact_start: %s"); + + CALLN (Fmessage, format, + w->start, + w->exact_start ? Qt : Qnil); + return Qnil; +} + + void init_window_once (void) { @@ -7336,8 +7371,8 @@ pixelwise even if this option is nil. */); window_resize_pixelwise = false; DEFVAR_BOOL ("fast-but-imprecise-scrolling", - Vfast_but_imprecise_scrolling, - doc: /* When non-nil, accelerate scrolling operations. + Vfast_but_imprecise_scrolling, + doc: /* When non-nil, accelerate scrolling operations. This comes into play when scrolling rapidly over previously unfontified buffer regions. Only those portions of the buffer which are actually going to be displayed get fontified. @@ -7455,6 +7490,7 @@ displayed after a scrolling operation to be somewhat inaccurate. */); defsubr (&Swindow_parameters); defsubr (&Swindow_parameter); defsubr (&Sset_window_parameter); + defsubr (&Swindow_test_dump); } void diff --git a/src/window.h b/src/window.h index eaff57e..5084863 100644 --- a/src/window.h +++ b/src/window.h @@ -383,6 +383,10 @@ struct window window. */ bool_bf suspend_auto_hscroll : 1; + /* True when the position in ->start is the exact window start pos, and + is not to be rounded to a beginning of line. */ + bool_bf exact_start : 1; + /* Amount by which lines of this window are scrolled in y-direction (smooth scrolling). */ int vscroll; diff --git a/src/xdisp.c b/src/xdisp.c index bdf2d09..a8f38c9 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -6275,6 +6275,26 @@ forward_to_next_line_start (struct it *it, bool *skipped_p, return newline_found_p; } +/* Move IT to the start of the next display line. + The return value is true if the beginning of the next line was reached. +*/ + +bool +forward_to_next_display_line_start (struct it *it) +{ + enum move_it_result eres; + bool result = false; + eres = move_it_in_display_line_to (it, ZV, -1, MOVE_TO_POS); + if (eres != MOVE_POS_MATCH_OR_ZV) + { + if (eres != MOVE_LINE_CONTINUED) + set_iterator_to_next (it, false); + result = true; + it->current_x = it->hpos = 0; + } + return result; +} + /* Set IT's current position to the previous visible line start. Skip invisible text that is so either due to text properties or due to @@ -6378,6 +6398,17 @@ reseat_at_previous_visible_line_start (struct it *it) } +/* Reseat iterator IT at the beginning of IT's window. This is particularly + useful when the window's `exact_start' flag is set. */ + +void +reseat_at_window_start (struct it *it) +{ + SET_TEXT_POS_FROM_MARKER (it->current.pos, it->w->start); + reseat (it, it->current.pos, true); + CHECK_IT (it); +} + /* Reseat iterator IT on the next visible line start in the current buffer. ON_NEWLINE_P means position IT on the newline preceding the line start. Skip over invisible text that is so @@ -15341,13 +15372,13 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, from the start of the continued line. It is the start of the screen line with the minimum distance from the old start W->start. */ -static bool -compute_window_start_on_continuation_line (struct window *w) +struct text_pos +get_window_start_on_continuation_line (struct window *w) { struct text_pos pos, start_pos; - bool window_start_changed_p = false; SET_TEXT_POS_FROM_MARKER (start_pos, w->start); + pos = start_pos; /* If window start is on a continuation line... Window start may be < BEGV in case there's invisible text at the start of the @@ -15372,7 +15403,7 @@ compute_window_start_on_continuation_line (struct window *w) reseat_at_previous_visible_line_start (&it); /* If the line start is "too far" away from the window start, - say it takes too much time to compute a new window start. */ + say it takes too much time to compute a new window start. */ if (CHARPOS (start_pos) - IT_CHARPOS (it) /* PXW: Do we need upper bounds here? */ < WINDOW_TOTAL_LINES (w) * WINDOW_TOTAL_COLS (w)) @@ -15412,17 +15443,30 @@ compute_window_start_on_continuation_line (struct window *w) else move_it_by_lines (&it, 1); } + } + } - /* Set the window start there. */ + return pos; +} + +static bool +compute_window_start_on_continuation_line (struct window *w) +{ + struct text_pos pos; + bool window_start_changed_p = false; + + if (!w->exact_start) + { + pos = get_window_start_on_continuation_line (w); + if (CHARPOS (pos) != marker_position (w->start)) + { SET_MARKER_FROM_TEXT_POS (w->start, pos); window_start_changed_p = true; } } - return window_start_changed_p; } - /* Try cursor movement in case text has not changed in window WINDOW, with window start STARTP. Value is -- Alan Mackenzie (Nuremberg, Germany). --rwEMma7ioTxnRzrJ Content-Type: text/plain; charset=us-ascii Content-Disposition: attachment; filename="utilities.el" (defun scrollup-n (&optional n) "Scroll the text up n (default 1) lines." (interactive "p") (scroll-up (or n 1)) ) (global-set-key [S-down] 'scrollup-n) (defun scrolldown-n (&optional n) "Scroll the text down n (default 1) lines." (interactive "p") (scroll-down (or n 1)) ) (global-set-key [S-up] 'scrolldown-n) (defun scrollup-6n (&optional n) "Scroll the text up 6n (default 6) lines." (interactive "p") (scroll-up (* 6 (or n 1))) ) (global-set-key [C-S-down] 'scrollup-6n) (defun scrolldown-6n (&optional n) "Scroll the text down 6n (default 6) lines." (interactive "p") (scroll-down (* 6 (or n 1))) ) (global-set-key [C-S-up] 'scrolldown-6n) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun screen-top () "Move the point to the top of the screen." (interactive) (move-to-window-line 0) ) (global-set-key [C-left] 'screen-top) (defun screen-bottom () "Move the point to the bottom of the screen." (interactive) (move-to-window-line -1) ) (global-set-key [C-right] 'screen-bottom) (defun scroll-to-top (&optional n) "Scroll the current line to the top of the window" (interactive "P") (recenter (if n (prefix-numeric-value n) 0))) (global-set-key [C-S-right] 'scroll-to-top) (defun scroll-to-bottom (&optional n) "Scroll the current line to the bottom of the window. If given a numerical arg, leave point that many lines from the bottom." (interactive "p") (recenter (- (or n 1)))) (global-set-key [C-S-left] 'scroll-to-bottom) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun 4-column () "Disply the current buffer in 3 columns with follow-mode" (interactive) (follow-mode 1) (delete-other-windows) (split-window-horizontally) (split-window-horizontally) (split-window-horizontally) (balance-windows)) (global-set-key "\C-c4" '4-column) (defun 3-column () "Disply the current buffer in 3 columns with follow-mode" (interactive) (follow-mode 1) (delete-other-windows) (split-window-horizontally) (split-window-horizontally) (balance-windows)) (global-set-key "\C-c3" '3-column) (defun 2-column () "Disply the current buffer in 2 columns with follow-mode" (interactive) (follow-mode 1) (delete-other-windows) (split-window-horizontally) (balance-windows)) (global-set-key "\C-c2" '2-column) (global-set-key "\C-c0" (lambda () (interactive) (message "follow-mode disabled") (follow-mode 0))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun do-vm (arg) "Do (vertical-motion ARG), where ARG is a number, default of 0." (interactive "P") (vertical-motion (if arg (prefix-numeric-value arg) 0))) (global-set-key "\C-cm" 'do-vm) --rwEMma7ioTxnRzrJ Content-Type: text/plain; charset=us-ascii Content-Disposition: attachment; filename="fragment.el" (tRER (fix-re--do-R*ER*-transform (ast-a "R*E*R+") 'car 0 0 1) (ast-a "R*\\(?:E+R+\\|R\\)")) (tRER (fix-re--do-R*ER*-transform (ast-a "R*E*R*") 'car 0 0 1) (ast-a "R*\\(?:E+R*\\)?")) (tRER (fix-re--do-R*ER*-transform (ast-a "R*E*F*R+") 'car 0 1 2) (ast-a "R*\\(?:\\(?:E*F+\\|E+\\)R+\\|R\\)")) (tRER (fix-re--do-R*ER*-transform (ast-a "R*E*F*R*") 'car 0 1 2) (ast-a "R*\\(?:\\(?:E*F+\\|E+\\)R*\\)?")) (tRER (fix-re--do-R*ER*-transform (ast-a "R*E\\{0\\}R+") 'car 0 0 1) (ast-a "R+")) (tRER (fix-re--do-R*ER*-transform (ast-a "R*E\\{0\\}F\\{0\\}R*") 'car 0 1 2) (ast-a "R*")) (tRER (fix-re--do-R*ER*-transform (ast-a "AR*E*R+") 'cadr 1 1 2) (ast-a "AR*\\(?:E+R+\\|R\\)")) (tRER (fix-re--do-R*ER*-transform (ast-a "AR*E*R*") 'cadr 1 1 2) (ast-a "AR*\\(?:E+R*\\)?")) (tRER (fix-re--do-R*ER*-transform (ast-a "AR*E*F*R+") 'cadr 1 2 3) (ast-a "AR*\\(?:\\(?:E*F+\\|E+\\)R+\\|R\\)")) (tRER (fix-re--do-R*ER*-transform (ast-a "AR*E*F*R*") 'cadr 1 2 3) (ast-a "AR*\\(?:\\(?:E*F+\\|E+\\)R*\\)?")) (tRER (fix-re--do-R*ER*-transform (ast-a "AR*E\\{0\\}R+") 'cadr 1 1 2) (ast-a "AR+")) (tRER (fix-re--do-R*ER*-transform (ast-a "AR*E\\{0\\}F\\{0\\}R*") 'cadr 1 2 3) (ast-a "AR*")) (tRER (fix-re--do-R*ER*-transform (ast-a "R*E*R+?") 'car 0 0 1) (ast-a "R*\\(?:E+R+?\\|R\\)")) (tRER (fix-re--do-R*ER*-transform (ast-a "R*E*R*?") 'car 0 0 1) (ast-a "R*\\(?:E+R*?\\)??")) (tRER (fix-re--do-R*ER*-transform (ast-a "R*E*F*R+?") 'car 0 1 2) (ast-a "R*\\(?:\\(?:E*F+\\|E+\\)R+?\\|R\\)")) (tRER (fix-re--do-R*ER*-transform (ast-a "R*E*F*R*?") 'car 0 1 2) (ast-a "R*\\(?:\\(?:E*F+\\|E+\\)R*?\\)??")) (tRER (fix-re--do-R*ER*-transform (ast-a "R*E\\{0\\}R+?") 'car 0 0 1) (ast-a "R+")) (tRER (fix-re--do-R*ER*-transform (ast-a "R*E\\{0\\}F\\{0\\}R*?") 'car 0 1 2) (ast-a "R*")) (tRER (fix-re--do-R*ER*-transform (ast-a "R+?E*R+") 'car 0 0 1) (ast-a "\\(?:R+?E+\\|R\\)R+")) (tRER (fix-re--do-R*ER*-transform (ast-a "R*?E*R*") 'car 0 0 1) (ast-a "\\(?:R*?E+\\)??R*")) (tRER (fix-re--do-R*ER*-transform (ast-a "R+?E*F*R+") 'car 0 1 2) (ast-a "\\(?:R+?\\(?:E*F+\\|E+\\)\\|R\\)R+\\)")) (tRER (fix-re--do-R*ER*-transform (ast-a "R*?E*F*R*") 'car 0 1 2) (ast-a "\\(?:R*?\\(?:E*F+\\|E+\\)\\)??R*")) (tRER (fix-re--do-R*ER*-transform (ast-a "R+?E\\{0\\}R+") 'car 0 0 1) (ast-a "RR+")) (tRER (fix-re--do-R*ER*-transform (ast-a "R*?E\\{0\\}F\\{0\\}R*") 'car 0 1 2) (ast-a "R*")) (tRER (fix-re--do-R*ER*-transform (ast-a "R*?E*R+?") 'car 0 0 1) (ast-a "R*?\\(?:E+R+?\\|R\\)")) (tRER (fix-re--do-R*ER*-transform (ast-a "R*?E*R*?") 'car 0 0 1) (ast-a "R*?\\(?:E+R*?\\)??")) (tRER (fix-re--do-R*ER*-transform (ast-a "R*?E*F*R+?") 'car 0 1 2) (ast-a "R*?\\(?:\\(?:E*F+\\|E+\\)R+?\\|R\\)")) (tRER (fix-re--do-R*ER*-transform (ast-a "R*?E*F*R*?") 'car 0 1 2) (ast-a "R*?\\(?:\\(?:E*F+\\|E+\\)R*?\\)??")) (tRER (fix-re--do-R*ER*-transform (ast-a "R*?E\\{0\\}R+?") 'car 0 0 1) (ast-a "R+?")) (tRER (fix-re--do-R*ER*-transform (ast-a "R*?E\\{0\\}F\\{0\\}R*?") 'car 0 1 2) (ast-a "R*?")) (defun fix-re--R+ER*->R+\(E@R*\)\? (ptr ad) "Do R+ER* -> R+(E@R*)? or R+ER+ -> R+(E@R+|R) on the whole list. PTR/AD point at the first element of the sequential list. Here, E is a non-empty sequence of elements which are matched by the empty string, E@ is the \"de-emptified\" version of E." ;; We must perform the loop rightmost transformations first. To see this, ;; consider R*ER*FR* done leftmost first. The first transformation takes us ;; to R*(E@R*)?FR*. We're now stuck, as the middle R* is no longer ;; "exposed" to the last R*, and the end expression is still ill-formed. ;; Done rightmost first, R*ER*FR* -> R*ER*(F@R*)? -> R*(E@R*)?(F@R*)?, which ;; is well-formed. (let (res) (let ((ptr ptr) (ad ad)) (when (fix-re--ptr-next ptr ad) (setq res (fix-re--R+ER*->R+\(E@R*\)\? ptr ad)))) (let* ((elt-ptr ptr) (elt-ad ad) (elt (fix-re--ptr-get elt-ptr elt-ad)) R0-R empty0-ptr empty1-ptr) ; No need for ..-ad's, since ; these will always be 'cadr. (or ;; Is `elt' R+ or R*? (when (and (consp elt) (memq (car elt) '(+ *))) (setq R0-R (cdr elt)) ;; Is the next element one matching the empty string, and which ;; isn't R+ or R*? (setq elt (fix-re--ptr-next elt-ptr elt-ad)) (when (and elt (fix-re--matches-empty-p elt) (not (and (consp elt) (memq (car elt) '(+ *)) (equal (cdr elt) R0-R)))) (setq empty0-ptr elt-ptr ; Remember first empty. -ad is implicitly 'cadr empty1-ptr elt-ptr ) ; Remember last empty. ;; Read the elements which match empty, but aren't R+ or R*. (while (and (setq elt (fix-re--ptr-next elt-ptr elt-ad)) (fix-re--matches-empty-p elt) (not (and (consp elt) (memq (car elt) '(+ *)) (equal (cdr elt) R0-R)))) (setq empty1-ptr elt-ptr)) ;; Have we found the matching R+ or R*? (when (and elt (consp elt) (memq (car elt) '(+ *)) (equal (cdr elt) R0-R)) ;; Yes. We're in business. (fix-re--do-R*ER*-transform ptr ad empty0-ptr empty1-ptr elt-ptr) t))) res)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; R*(R*A|B) -> R*(A|B) (defun fix-re--\[R\]+\(\[S\]*\)-transform (ptr ad R*) "Attempt to transform an alternative which begins with [..]+. The entire construct we have looks like [R]*([S]*A|...), where CA1 is the \"outside\" char-alt, and PTR/AD points at the entire alternative. The *s on the char-alts may alternatively be +s. In the following \"[R-S]\" denotes the difference of the two character alteratives R and S. [R-S] is a new character alternative which matches any character which R does, but S doesn't. The transformation looks like: \(i) (with ^ operators) [^R]+([^S]*A|...) -> [^R]+(([R-S][^S]*)?A|...) [^R]+([^S]+A|...) -> [^R]+(([R-S][^S]*)?[^S]A|...) \(ii) (without ^ operators) [R]+([S]*A|...) -> [R]+(([S-R][S]*)?A|...) or [R]+([S]+A|...) -> [R]+(([S-R][S]*)?[S]A|...) or, if S-R is empty: [R]+([S]*A|...) -> [R]+(A|...) [R]+([S]+A|...) -> [R]+([S]A|...) FIXME!!! " (let* ((elt (fix-re--ptr-get ptr ad)) ; [S]*A,,, (S* (car elt)) ; [S]* (S (cdr S*)) ; [S] (R (cdr R*)) ; [R] S-R R-S new-S new-\( res subres ) (when (eq (cadr S) (cadr R)) ; Either both have or neither has ^ operator. (when ; Have R and S got any overlap? (if (cadr S) ; With ^ operator. (progn (setq R-S (copy-tree R)) (setcar (cdr R-S) nil) ; Remove the ^. (setq subres (fix-re--chalt-minus (cdr R-S) (caddr S) t))) ;; Transform [abc]+([cde]*R|...) to [abc]+(([de][cde]*)?R|...) (setq S-R (copy-tree S)) (setq subres (fix-re--chalt-minus (cdr S-R) (caddr R) nil))) (if (null (caddr (or S-R R-S))) (progn (if (eq (car S*) '+) (fix-re--chop-+* elt 'car) ; [abc]+([ab]+A|..) -> [abc]+([ab]A|..) (fix-re--ind-chop ptr ad 'car t)) ; [abc]+([ab]*A|..) -> [abc]+(A|..) (setq res t)) (fix-re--wrap-in-\( '\\\(\?: elt 'car) (setq new-\( (fix-re--ptr-get elt 'car)) (fix-re--insert (if (numberp subres) subres (or S-R R-S)) (cadr new-\() 'car) (fix-re--+*ify '\? elt 'car) (when (eq (car S*) '+) (setcar S* '*) (setq new-S (copy-tree S)) (fix-re--insert-after new-S elt 'car)) (setq res t)))) res)) (tp (fix-re--\[R\]+\(\[S\]*\)-transform (ast-aa "\\([cde]*G\\)") 'cadr (ast-aa "[abc]+")) 1 (ast-aa "\\(\\(?:[de][cde]*\\)?G\\)") t t) (tp (fix-re--\[R\]+\(\[S\]*\)-transform (ast-aa "\\([cde]+G\\)") 'cadr (ast-aa "[abc]+")) 1 (ast-aa "\\(\\(?:[de][cde]*\\)?[cde]G\\)") t t) (tp (fix-re--\[R\]+\(\[S\]*\)-transform (ast-aa "\\([ab]*G\\)") 'cadr (ast-aa "[abc]+")) 1 (ast-aa "\\(G\\)") t t) (tp (fix-re--\[R\]+\(\[S\]*\)-transform (ast-aa "\\([ab]+G\\)") 'cadr (ast-aa "[abc]+")) 1 (ast-aa "\\([ab]G\\)") t t) (tp (fix-re--\[R\]+\(\[S\]*\)-transform (ast-aa "\\([^cde]*G\\)") 'cadr (ast-aa "[^abc]+")) 1 (ast-aa "\\(\\(?:[ab][^cde]*\\)?G\\)") t t) (tp (fix-re--\[R\]+\(\[S\]*\)-transform (ast-aa "\\([^cde]+G\\)") 'cadr (ast-aa "[^abc]+")) 1 (ast-aa "\\(\\(?:[ab][^cde]*\\)?[^cde]G\\)") t t) (tp (fix-re--\[R\]+\(\[S\]*\)-transform (ast-aa "\\([^abc]*G\\)") 'cadr (ast-aa "[^ab]+")) 1 (ast-aa "\\(G\\)") t t) (tp (fix-re--\[R\]+\(\[S\]*\)-transform (ast-aa "\\([^abc]+G\\)") 'cadr (ast-aa "[^ab]+")) 1 (ast-aa "\\([^abc]G\\)") t t) (tp (fix-re--\[R\]+\(\[S\]*\)-transform (ast-aa "\\([cde]*G\\)") 'cadr (ast-aa "[^abc]")) 1 (ast-aa "\\([cde]*G\\)") 'nil t) (tp (fix-re--\[R\]+\(\[S\]*\)-transform (ast-aa "\\([^cde]*G\\)") 'cadr (ast-aa "[abc]")) 1 (ast-aa "\\([^cde]*G\\)") 'nil t) (tp (fix-re--\[R\]+\(\[S\]*\)-transform (ast-aa "\\([def]*G\\)") 'cadr (ast-aa "[abc]")) 1 (ast-aa "\\([def]*G\\)") 'nil t) (defun fix-re--do-R+\(R*A|B\)-transform (R-rep alt) "Attempt a R+(R*A|B) -> R+(A|B) transformation. R-REP is a cons representing either R+ or R*. ALT represents a form of the form \(..\|..\|...\). " (let* ((R-R (cdr R-rep)) (ptr alt) (ad 'cadr) ; Point to the second elt. of the list, the first being '\\\( (elt (fix-re--ptr-get ptr ad)) res car-elt elt-+*) (while elt ; (R*A) (when (and (consp elt) ; This should always be true (setq car-elt (car elt)) ; This is now R*A (consp car-elt) (memq (setq elt-+* (car car-elt)) '(+ *))) (cond ((equal (cdr car-elt) R-R) (if (eq elt-+* '+) (fix-re--chop-+* elt 'car) (fix-re--ind-chop ptr ad 'car t)) ; i.e. ~ (fix-re--chop elt 'car) (setq res t)) ((and (consp R-R) (eq (car R-R) '\[) (consp (cdr car-elt)) (eq (cadr car-elt) '\[)) (if (fix-re--\[R\]+\(\[S\]*\)-transform ptr ad R-rep) (setq res t))))) (setq elt (fix-re--ptr-next ptr ad))) res)) (defun fix-re--R+\(R*A|B\)->R*\(A|B\) (ptr ad) "Do the transition on every pertinent element pairs in the sequence. PTR/AD point to the first element in the sequential list." (let ((elt (fix-re--ptr-get ptr ad)) R-rep res) (while elt (if (and (consp elt) (memq (car elt) '(+ *))) (progn (setq R-rep elt elt (fix-re--ptr-next ptr ad)) (when (fix-re--is-\( elt) (if (fix-re--do-R+\(R*A|B\)-transform R-rep elt) (setq res t)) (setq elt (fix-re--ptr-next ptr ad)))) (setq elt (fix-re--ptr-next ptr ad)))) res)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; (defun fix-re--\(R|R\)->\(R\) (ptr ad) "Remove duplicate elements from the alternatives list. PTR/AD point to the first element of the list, which will be a symbol like '\\\(." (let* ((elt0-ptr ptr) (elt0-ad ad) (elt0 (fix-re--ptr-next elt0-ptr elt0-ad)) elt1-ptr elt1-ad elt1 res) (while elt0 (setq elt1-ptr elt0-ptr elt1-ad elt0-ad elt1 (fix-re--ptr-next elt1-ptr elt1-ad)) (while elt1 (while (equal elt1 elt0) (fix-re--chop elt1-ptr elt1-ad) (setq elt1 (fix-re--ptr-get elt1-ptr elt1-ad)) (setq res t)) (setq elt1 (fix-re--ptr-next elt1-ptr elt1-ad))) (setq elt0 (fix-re--ptr-next elt0-ptr elt0-ad))) res)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; --rwEMma7ioTxnRzrJ--