commit b5919771aea2d43c64be381b7d7b395eeb1191bd (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Tue Apr 14 00:58:07 2015 -0700 Assume C89 offsetof in xterm.c, xlwmenu.c * lwlib/xlwmenu.c (offset): * src/xterm.c (cvt_string_to_pixel_args): Use offsetof, not XtOffset. diff --git a/lwlib/xlwmenu.c b/lwlib/xlwmenu.c index 9317dea..61f175b 100644 --- a/lwlib/xlwmenu.c +++ b/lwlib/xlwmenu.c @@ -105,7 +105,7 @@ xlwMenuTranslations [] = /* FIXME: F10 should enter the menu, the first one in the menu-bar. */ -#define offset(field) XtOffset(XlwMenuWidget, field) +#define offset(field) offsetof (XlwMenuRec, field) static XtResource xlwMenuResources[] = { diff --git a/src/xterm.c b/src/xterm.c index e904343..48b250b 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1378,9 +1378,9 @@ x_alloc_lighter_color_for_widget (Widget widget, Display *display, Colormap cmap static XtConvertArgRec cvt_string_to_pixel_args[] = { - {XtWidgetBaseOffset, (XtPointer) XtOffset (Widget, core.screen), + {XtWidgetBaseOffset, (XtPointer) offsetof (WidgetRec, core.screen), sizeof (Screen *)}, - {XtWidgetBaseOffset, (XtPointer) XtOffset (Widget, core.colormap), + {XtWidgetBaseOffset, (XtPointer) offsetof (WidgetRec, core.colormap), sizeof (Colormap)} }; commit 96a858a442c1ed5774d11115613f50778117447b Author: Paul Eggert Date: Tue Apr 14 00:37:48 2015 -0700 Assume C89 offsetof in widget.c * src/widget.c (XtOffset): Remove; no longer needed. (offset): Implement via offsetof instead of via pre-C89 XtOffset hack. diff --git a/src/widget.c b/src/widget.c index acf559f..c45193f 100644 --- a/src/widget.c +++ b/src/widget.c @@ -61,10 +61,7 @@ static void EmacsFrameResize (Widget widget); static XtGeometryResult EmacsFrameQueryGeometry (Widget widget, XtWidgetGeometry *request, XtWidgetGeometry *result); -#undef XtOffset -#define XtOffset(p_type,field) \ - ((Cardinal) (((char *) (&(((p_type)0)->field))) - ((char *)0))) -#define offset(field) XtOffset (EmacsFrame, emacs_frame.field) +#define offset(field) offsetof (EmacsFrameRec, emacs_frame.field) static XtResource resources[] = { {XtNgeometry, XtCGeometry, XtRString, sizeof (String), commit 7744cc7e95bcae1df6911be5a9a941d73ea207f7 Author: Paul Eggert Date: Tue Apr 14 00:26:18 2015 -0700 Fix think-o in previous patch * src/window.c (count_windows, get_leaf_windows): Don't optimize count_windows incorrectly. diff --git a/src/window.c b/src/window.c index 461bb62..0fcf82d 100644 --- a/src/window.c +++ b/src/window.c @@ -6527,11 +6527,17 @@ delete_all_child_windows (Lisp_Object window) static ptrdiff_t count_windows (struct window *window) { - return get_leaf_windows (window, NULL, 0); + ptrdiff_t count = 1; + if (!NILP (window->next)) + count += count_windows (XWINDOW (window->next)); + if (WINDOWP (window->contents)) + count += count_windows (XWINDOW (window->contents)); + return count; } -/* If vector FLAT is non-null, fill it with leaf windows under W, - starting at index I. Value is last index + 1. */ + +/* Fill vector FLAT with leaf windows under W, starting at index I. + Value is last index + 1. */ static ptrdiff_t get_leaf_windows (struct window *w, struct window **flat, ptrdiff_t i) { @@ -6540,11 +6546,7 @@ get_leaf_windows (struct window *w, struct window **flat, ptrdiff_t i) if (WINDOWP (w->contents)) i = get_leaf_windows (XWINDOW (w->contents), flat, i); else - { - if (flat) - flat[i] = w; - i++; - } + flat[i++] = w; w = NILP (w->next) ? 0 : XWINDOW (w->next); } commit b80c5ebc4f6afd54597012583c6a1390db0ade9c Author: Paul Eggert Date: Mon Apr 13 23:26:13 2015 -0700 Avoid some int overflows in window.c * src/print.c (print_object): * src/window.c (sequence_number): * src/window.h (struct window.sequence_number): Don't assume window sequence number fits in int. * src/window.c (window_select_count): * src/window.h (struct window.use_time, window_select_count): Don't assume window use time fits in int. * src/window.c (Fsplit_window_internal): Don't assume user-supplied integer, or sum, fits in int. (Fset_window_configuration, count_windows, get_leaf_windows) (save_window_save, Fcurrent_window_configuration): Use ptrdiff_t for object counts. (Fset_window_configuration): Omit unused local 'n'. (count_windows): Simplify by writing in terms of get_leaf_windows. (get_leaf_windows): Don't store through FLAT if it's null. (extract_dimension): New static function. (set_window_margins, set_window_fringes, set_window_scroll_bars): Use it to avoid undefined behavior when converting user-supplied integer to 'int'. diff --git a/src/print.c b/src/print.c index 838d036..58b9c70 100644 --- a/src/print.c +++ b/src/print.c @@ -1774,9 +1774,8 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) } else if (WINDOWP (obj)) { - int len; - strout ("#sequence_number); + int len = sprintf (buf, "#sequence_number); strout (buf, len, len, printcharfun); if (BUFFERP (XWINDOW (obj)->contents)) { diff --git a/src/window.c b/src/window.c index eb68672..461bb62 100644 --- a/src/window.c +++ b/src/window.c @@ -45,8 +45,9 @@ along with GNU Emacs. If not, see . */ #include "msdos.h" #endif -static int count_windows (struct window *); -static int get_leaf_windows (struct window *, struct window **, int); +static ptrdiff_t count_windows (struct window *); +static ptrdiff_t get_leaf_windows (struct window *, struct window **, + ptrdiff_t); static void window_scroll_pixel_based (Lisp_Object, int, bool, bool); static void window_scroll_line_based (Lisp_Object, int, bool, bool); static void foreach_window (struct frame *, @@ -93,7 +94,7 @@ Lisp_Object minibuf_window; Lisp_Object minibuf_selected_window; /* Incremented for each window created. */ -static int sequence_number; +static EMACS_INT sequence_number; /* Used by the function window_scroll_pixel_based. */ static int window_scroll_pixel_based_preserve_x; @@ -451,7 +452,7 @@ selected windows appears and to which many commands apply. */) return selected_window; } -int window_select_count; +EMACS_INT window_select_count; /* If select_window is called with inhibit_point_swap true it will not store point of the old selected window's buffer back into that @@ -4275,7 +4276,7 @@ resize_frame_windows (struct frame *f, int size, bool horflag, bool pixelwise) DEFUN ("split-window-internal", Fsplit_window_internal, Ssplit_window_internal, 4, 4, 0, doc: /* Split window OLD. Second argument PIXEL-SIZE specifies the number of pixels of the -new window. In any case TOTAL-SIZE must be a positive integer. +new window. It must be a positive integer. Third argument SIDE nil (or `below') specifies that the new window shall be located below WINDOW. SIDE `above' means the new window shall be @@ -4315,7 +4316,7 @@ set correctly. See the code of `split-window' for how this is done. */) f = XFRAME (frame); CHECK_NUMBER (pixel_size); - int total_size + EMACS_INT total_size = XINT (pixel_size) / (horflag ? FRAME_COLUMN_WIDTH (f) : FRAME_LINE_HEIGHT (f)); @@ -4452,7 +4453,7 @@ set correctly. See the code of `split-window' for how this is done. */) /* Iso-coordinates and sizes are assigned by window_resize_apply, get them ready here. */ wset_new_pixel (n, pixel_size); - int sum = 0; + EMACS_INT sum = 0; c = XWINDOW (p->contents); while (c) { @@ -6204,14 +6205,12 @@ the return value is nil. Otherwise the value is t. */) { Lisp_Object window; Lisp_Object dead_windows = Qnil; - register Lisp_Object tem, par, pers; - register struct window *w; - register struct saved_window *p; + Lisp_Object tem, par, pers; + struct window *w; + struct saved_window *p; struct window *root_window; struct window **leaf_windows; - int n_leaf_windows; - ptrdiff_t k; - int i, n; + ptrdiff_t i, k, n_leaf_windows; /* Don't do this within the main loop below: This may call Lisp code and is thus potentially unsafe while input is blocked. */ @@ -6256,7 +6255,7 @@ the return value is nil. Otherwise the value is t. */) really like to do is to free only those matrices not reused below. */ root_window = XWINDOW (FRAME_ROOT_WINDOW (f)); - int nwindows = count_windows (root_window); + ptrdiff_t nwindows = count_windows (root_window); SAFE_NALLOCA (leaf_windows, 1, nwindows); n_leaf_windows = get_leaf_windows (root_window, leaf_windows, 0); @@ -6430,13 +6429,9 @@ the return value is nil. Otherwise the value is t. */) Fredirect_frame_focus (frame, data->focus_frame); /* Now, free glyph matrices in windows that were not reused. */ - for (i = n = 0; i < n_leaf_windows; ++i) - { - if (NILP (leaf_windows[i]->contents)) - free_window_matrices (leaf_windows[i]); - else if (EQ (leaf_windows[i]->contents, new_current_buffer)) - ++n; - } + for (i = 0; i < n_leaf_windows; i++) + if (NILP (leaf_windows[i]->contents)) + free_window_matrices (leaf_windows[i]); /* Allow x_set_window_size again and apply frame size changes if needed. */ @@ -6529,29 +6524,27 @@ delete_all_child_windows (Lisp_Object window) Vwindow_list = Qnil; } -static int -count_windows (register struct window *window) +static ptrdiff_t +count_windows (struct window *window) { - register int count = 1; - if (!NILP (window->next)) - count += count_windows (XWINDOW (window->next)); - if (WINDOWP (window->contents)) - count += count_windows (XWINDOW (window->contents)); - return count; + return get_leaf_windows (window, NULL, 0); } - -/* Fill vector FLAT with leaf windows under W, starting at index I. - Value is last index + 1. */ -static int -get_leaf_windows (struct window *w, struct window **flat, int i) +/* If vector FLAT is non-null, fill it with leaf windows under W, + starting at index I. Value is last index + 1. */ +static ptrdiff_t +get_leaf_windows (struct window *w, struct window **flat, ptrdiff_t i) { while (w) { if (WINDOWP (w->contents)) i = get_leaf_windows (XWINDOW (w->contents), flat, i); else - flat[i++] = w; + { + if (flat) + flat[i] = w; + i++; + } w = NILP (w->next) ? 0 : XWINDOW (w->next); } @@ -6598,12 +6591,12 @@ get_phys_cursor_glyph (struct window *w) } -static int -save_window_save (Lisp_Object window, struct Lisp_Vector *vector, int i) +static ptrdiff_t +save_window_save (Lisp_Object window, struct Lisp_Vector *vector, ptrdiff_t i) { - register struct saved_window *p; - register struct window *w; - register Lisp_Object tem, pers, par; + struct saved_window *p; + struct window *w; + Lisp_Object tem, pers, par; for (; !NILP (window); window = w->next) { @@ -6741,10 +6734,9 @@ redirection (see `redirect-frame-focus'). The variable saved by this function. */) (Lisp_Object frame) { - register Lisp_Object tem; - register int n_windows; - register struct save_window_data *data; - register int i; + Lisp_Object tem; + ptrdiff_t i, n_windows; + struct save_window_data *data; struct frame *f = decode_live_frame (frame); n_windows = count_windows (XWINDOW (FRAME_ROOT_WINDOW (f))); @@ -6794,17 +6786,22 @@ apply_window_adjustment (struct window *w) Marginal Areas ***********************************************************************/ +static int +extract_dimension (Lisp_Object dimension) +{ + if (NILP (dimension)) + return -1; + CHECK_RANGED_INTEGER (dimension, 0, INT_MAX); + return XINT (dimension); +} + static struct window * set_window_margins (struct window *w, Lisp_Object left_width, Lisp_Object right_width) { - int left, right; int unit = WINDOW_FRAME_COLUMN_WIDTH (w); - - left = (NILP (left_width) ? 0 - : (CHECK_NATNUM (left_width), XINT (left_width))); - right = (NILP (right_width) ? 0 - : (CHECK_NATNUM (right_width), XINT (right_width))); + int left = NILP (left_width) ? 0 : extract_dimension (left_width); + int right = NILP (right_width) ? 0 : extract_dimension (right_width); if (w->left_margin_cols != left || w->right_margin_cols != right) { @@ -6873,13 +6870,9 @@ static struct window * set_window_fringes (struct window *w, Lisp_Object left_width, Lisp_Object right_width, Lisp_Object outside_margins) { - int left, right; bool outside = !NILP (outside_margins); - - left = (NILP (left_width) ? -1 - : (CHECK_NATNUM (left_width), XINT (left_width))); - right = (NILP (right_width) ? -1 - : (CHECK_NATNUM (right_width), XINT (right_width))); + int left = extract_dimension (left_width); + int right = extract_dimension (right_width); /* Do nothing on a tty or if nothing to actually change. */ if (FRAME_WINDOW_P (WINDOW_XFRAME (w)) @@ -6959,7 +6952,7 @@ set_window_scroll_bars (struct window *w, Lisp_Object width, Lisp_Object vertical_type, Lisp_Object height, Lisp_Object horizontal_type) { - int iwidth = (NILP (width) ? -1 : (CHECK_NATNUM (width), XINT (width))); + int iwidth = extract_dimension (width); bool changed = false; if (iwidth == 0) @@ -6989,7 +6982,7 @@ set_window_scroll_bars (struct window *w, Lisp_Object width, #if USE_HORIZONTAL_SCROLL_BARS { - int iheight = (NILP (height) ? -1 : (CHECK_NATNUM (height), XINT (height))); + int iheight = extract_dimension (height); if (MINI_WINDOW_P (w) || iheight == 0) horizontal_type = Qnil; diff --git a/src/window.h b/src/window.h index 96e7438..eaff57e 100644 --- a/src/window.h +++ b/src/window.h @@ -195,10 +195,10 @@ struct window Lisp_Object next_buffers; /* Number saying how recently window was selected. */ - int use_time; + EMACS_INT use_time; /* Unique number of window assigned when it was created. */ - int sequence_number; + EMACS_INT sequence_number; /* The upper left corner pixel coordinates of this window, as integers relative to upper left corner of frame = 0, 0. */ @@ -990,7 +990,7 @@ extern Lisp_Object selected_window; recently used window. Its only users are Fselect_window, init_window_once, and make_frame. */ -extern int window_select_count; +extern EMACS_INT window_select_count; /* The minibuffer window of the selected frame. Note that you cannot test for minibufferness of an arbitrary window commit e84d1ca3c6a643370c4273ad569b618d8cd72b53 Author: Glenn Morris Date: Mon Apr 13 23:20:48 2015 -0700 Minor doc copyedits * doc/emacs/custom.texi (Init Examples): Tweak example, replace typo. * doc/lispintro/emacs-lisp-intro.texi (condition-case): Typo fix. diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 429567f..a2bea24 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -2440,9 +2440,7 @@ You can also simply disregard the errors that occur if the function is not defined. @example -(condition case () - (set-face-background 'region "grey75") - (error nil)) +(ignore-errors (set-face-background 'region "grey75")) @end example A @code{setq} on a variable which does not exist is generally diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 77d8ca8..46dc41a 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -8136,7 +8136,7 @@ However, if an error occurs, among its other actions, the function generating the error signal will define one or more error condition names. -An error handler is the third argument to @code{condition case}. +An error handler is the third argument to @code{condition-case}. An error handler has two parts, a @var{condition-name} and a @var{body}. If the @var{condition-name} part of an error handler matches a condition name generated by an error, then the @var{body} commit d4b44a07a75666177f8684876c7337c0b91a95da Author: Katsumi Yamaoka Date: Tue Apr 14 03:35:02 2015 +0000 [Gnus] Catch the invalid-operation that idna.el will issue * lisp/gnus/gnus-art.el (gnus-use-idna): * lisp/gnus/gnus-sum.el (gnus-summary-idna-message): * lisp/gnus/message.el (message-use-idna): Catch the invalid-operation that idna.el will issue. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index b238d65..14f9adc 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1627,8 +1627,11 @@ It is a string, such as \"PGP\". If nil, ask user." (defvar idna-program) -(defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error)) - (mm-coding-system-p 'utf-8) +(defcustom gnus-use-idna (and (mm-coding-system-p 'utf-8) + (condition-case nil + (require 'idna) + (file-error) + (invalid-operation)) idna-program (executable-find idna-program)) "Whether IDNA decoding of headers is used when viewing messages. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 73a0d4b..1d8ad8e 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -9870,9 +9870,11 @@ invalid IDNA string (`xn--bar' is invalid). You must have GNU Libidn (URL `http://www.gnu.org/software/libidn/') installed for this command to work." (interactive "P") - (if (not (and (condition-case nil (require 'idna) - (file-error)) - (mm-coding-system-p 'utf-8) + (if (not (and (mm-coding-system-p 'utf-8) + (condition-case nil + (require 'idna) + (file-error) + (invalid-operation)) (symbol-value 'idna-program) (executable-find (symbol-value 'idna-program)))) (gnus-message diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 3dc2908..1371e70 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1763,7 +1763,10 @@ no, only reply back to the author." (let (mucs-ignore-version-incompatibilities) (require 'un-define)) (error))) - (condition-case nil (require 'idna) (file-error)) + (condition-case nil + (require 'idna) + (file-error) + (invalid-operation)) idna-program (executable-find idna-program) (string= (idna-to-ascii "räksmörgås") "xn--rksmrgs-5wao1o") commit b16cdc2782ba4fbc019c8c6d1749f6eff16f6fce Author: Paul Eggert Date: Mon Apr 13 20:30:50 2015 -0700 * doc/lispref/processes.texi (Shell Arguments): Prefer diff -u. diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index f228921..2bc6a18 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -196,7 +196,7 @@ Here's an example of using @code{shell-quote-argument} to construct a shell command: @example -(concat "diff -c " +(concat "diff -u " (shell-quote-argument oldfile) " " (shell-quote-argument newfile)) commit 845cb4a2ce9e32b12f2a916e3f5812d96ea56c77 Author: Sam Steingold Date: Mon Apr 13 23:27:02 2015 -0400 package--ensure-init-file: widen before looking for "(package-initialize)" diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index f333375..dd1c5df 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1782,6 +1782,7 @@ using `package-compute-transaction'." (if buffer (with-current-buffer buffer (save-excursion + (widen) (goto-char (point-min)) (search-forward "(package-initialize)" nil 'noerror))) (with-temp-buffer commit a9ccfaefc1ca8fa5b0177101984f64b3b186339b Author: Dmitry Gutov Date: Tue Apr 14 05:03:32 2015 +0300 Change diff-switches default to `-u' Fixes: debbugs:20290 * doc/emacs/files.texi (Comparing Files): Document the new default value of `diff-switches'. * doc/emacs/trouble.texi (Sending Patches): Document the preference for unified diff format. Escape the plus in the suggested `-F' regexp value. * lisp/vc/diff.el (diff-switches): Change the default to `-u'. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index c4b0c11..3a281d2 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1272,7 +1272,7 @@ minibuffer, and displays the differences between the two files in a buffer named @file{*diff*}. This works by running the @command{diff} program, using options taken from the variable @code{diff-switches}. The value of @code{diff-switches} should be a string; the default is -@code{"-c"} to specify a context diff. +@code{"-u"} to specify a unified context diff. @c Note that the actual name of the info file is diffutils.info, @c but it adds a dir entry for diff too. @c On older systems, only "info diff" works, not "info diffutils". diff --git a/doc/emacs/trouble.texi b/doc/emacs/trouble.texi index 2c3de28..42022cd 100644 --- a/doc/emacs/trouble.texi +++ b/doc/emacs/trouble.texi @@ -743,7 +743,7 @@ unmodified Emacs. But if you've made modifications and you don't tell us, you are sending us on a wild goose chase.) Be precise about these changes. A description in English is not -enough---send a context diff for them. +enough---send a unified context diff for them. Adding files of your own, or porting to another machine, is a modification of the source. @@ -1131,13 +1131,12 @@ is important. @item The patch itself. -Use @samp{diff -c} to make your diffs. Diffs without context are hard +Use @samp{diff -u} to make your diffs. Diffs without context are hard to install reliably. More than that, they are hard to study; we must -always study a patch to decide whether we want to install it. Unidiff -format is better than contextless diffs, but not as easy to read as -@samp{-c} format. +always study a patch to decide whether we want to install it. Context +format is better than contextless diffs, but we prefer we unified format. -If you have GNU diff, use @samp{diff -c -F'^[_a-zA-Z0-9$]+ *('} when +If you have GNU diff, use @samp{diff -u -F'^[_a-zA-Z0-9$]\+ *('} when making diffs of C code. This shows the name of the function that each change occurs in. diff --git a/etc/NEWS b/etc/NEWS index 8a9fa7c..6d8b4c6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -690,6 +690,10 @@ now match multibyte characters using Unicode character properties. If you want the old behavior where they matched any character with word syntax, use `\sw' instead. ++++ +** The `diff' command uses the unified format now. To restore the old +behavior, set `diff-switches' to `-c'. + * Lisp Changes in Emacs 25.1 diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el index 062248c..2a973cf 100644 --- a/lisp/vc/diff.el +++ b/lisp/vc/diff.el @@ -38,7 +38,7 @@ :group 'tools) ;;;###autoload -(defcustom diff-switches (purecopy "-c") +(defcustom diff-switches (purecopy "-u") "A string or list of strings specifying switches to be passed to diff." :type '(choice string (repeat string)) :group 'diff) commit e192281baae377a8702f3c048fce988d63ccfc1a Author: Stefan Monnier Date: Mon Apr 13 21:30:27 2015 -0400 (gnus-group--setup-tool-bar-update): Fix last change * lisp/gnus/gnus-group.el (gnus-group--setup-tool-bar-update): cursor-sensor-functions should be a list of functions. diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 8e8d175..ff839d7 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -1625,7 +1625,7 @@ if it is a string, only list groups matching REGEXP." (unless (bound-and-true-p cursor-sensor-mode) (cursor-sensor-mode 1)) (gnus-put-text-property beg end 'cursor-sensor-functions - #'gnus-tool-bar-update)) + '(gnus-tool-bar-update))) (gnus-put-text-property beg end 'point-entered #'gnus-tool-bar-update) (gnus-put-text-property beg end 'point-left diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index 55a881c..f5d4495 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -875,8 +875,13 @@ When called interactively, prompt for REGEXP." (goto-char (setq beg (point-max))) (save-excursion (save-restriction + ;; FIXME: We save excursion and restriction in "*gnus-uu-body*", + ;; only to immediately move to another buffer? And we narrow in + ;; that buffer without save-restriction? And we finish the + ;; save-restriction with a call to `widen'? How can that + ;; make sense? (set-buffer buffer) - (let (buffer-read-only) + (let ((inhibit-read-only t)) (set-text-properties (point-min) (point-max) nil) ;; These two are necessary for XEmacs 19.12 fascism. (put-text-property (point-min) (point-max) 'invisible nil) commit 56dfd3de9c63dbb6325129de8e38c420808146c9 Author: Katsumi Yamaoka Date: Mon Apr 13 23:42:18 2015 +0000 Use gmm-called-interactively-p in Gnus * lisp/gnus/gnus-topic.el (gnus-topic-mode): Use gmm-called-interactively-p. diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index 47cdcbc..656ef80 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -1167,7 +1167,7 @@ articles in the topic and its subtopics." (remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist) (setq gnus-group-prepare-function 'gnus-group-prepare-flat) (setq gnus-group-sort-alist-function 'gnus-group-sort-flat)) - (when (called-interactively-p 'any) + (when (gmm-called-interactively-p 'any) (gnus-group-list-groups)))) (defun gnus-topic-select-group (&optional all) commit 40d67a3b0bf7ef48ec8dc3126206d2079f24cc0b Author: Stefan Monnier Date: Mon Apr 13 18:21:00 2015 -0400 * lisp/loadup.el ("cus-start"): Load it after loaddefs.el Fixes: debbugs:20321 * lisp/cus-start.el (read-buffer-function): Don't advertize iswitchb-read-buffer any more. (iswitchb): Don't tweak this obsolete group any more. diff --git a/lisp/cus-start.el b/lisp/cus-start.el index b96b817..05135b8 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -379,7 +379,6 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of ;; options property set at end (read-buffer-function minibuffer (choice (const nil) - (function-item iswitchb-read-buffer) function)) ;; msdos.c (dos-unsupported-char-glyph display integer) @@ -654,7 +653,6 @@ since it could result in memory overflow and make Emacs crash." ((eq prop :tag) (put symbol 'custom-tag propval)))))))) -(custom-add-to-group 'iswitchb 'read-buffer-function 'custom-variable) (custom-add-to-group 'font-lock 'open-paren-in-column-0-is-defun-start 'custom-variable) diff --git a/lisp/loadup.el b/lisp/loadup.el index 003b0db..5133925 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -103,7 +103,6 @@ (load "bindings") ;; This sets temporary-file-directory, used by eg ;; auto-save-file-name-transforms in files.el. -(load "cus-start") (load "window") ; Needed here for `replace-buffer-in-windows'. (setq load-source-file-function 'load-with-code-conversion) (load "files") @@ -144,6 +143,7 @@ ;; In case loaddefs hasn't been generated yet. (file-error (load "ldefs-boot.el"))) +(load "cus-start") ;After loaddefs to autoload pcase-dolist. (load "emacs-lisp/nadvice") (load "emacs-lisp/cl-preloaded") (load "minibuffer") ;After loaddefs, for define-minor-mode. commit 2bad549b954ccd659d8db58cf1e42e257496803b Author: Artur Malabarba Date: Mon Apr 13 20:50:33 2015 +0100 * lisp/emacs-lisp/package.el: Fix package--ensure-init-file diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 6fb5ba4..f333375 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1781,7 +1781,9 @@ using `package-compute-transaction'." (contains-init (if buffer (with-current-buffer buffer - (search-forward "(package-initialize)" nil 'noerror)) + (save-excursion + (goto-char (point-min)) + (search-forward "(package-initialize)" nil 'noerror))) (with-temp-buffer (insert-file-contents user-init-file) (goto-char (point-min)) commit 13634dec038d613c3b618d70cd64d6d63561f2eb Author: Artur Malabarba Date: Mon Apr 13 13:13:36 2015 +0100 * lisp/emacs-lisp/cl-macs.el (cl-defstruct): Implement docstrings Adding a string after a constructor's argument list will use that string as the constructor function docstring. If this string is absent but the struct itself was given a docstring, use that as the constructor's docstring. Fixes (bug#17284). diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 41435b8..5bab84e 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2726,12 +2726,16 @@ non-nil value, that slot cannot be set via `setf'. constrs)) (while constrs (let* ((name (caar constrs)) - (args (cadr (pop constrs))) + (rest (cdr (pop constrs))) + (args (car rest)) + (doc (cadr rest)) (anames (cl--arglist-args args)) (make (cl-mapcar (function (lambda (s d) (if (memq s anames) s d))) slots defaults))) (push `(cl-defsubst ,name (&cl-defs (nil ,@descs) ,@args) + ,@(if (stringp doc) (list doc) + (if (stringp docstring) (list docstring))) ,@(if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs))) '((declare (side-effect-free t)))) (,(or type #'vector) ,@make)) commit 84e0b7dad6f1a8e53261f9b96f5a9080fea681a4 Author: Stefan Monnier Date: Mon Apr 13 15:51:15 2015 -0400 Deprecate `intangible' and `point-entered' properties * lisp/emacs-lisp/cursor-sensor.el: New file. * lisp/simple.el (pre-redisplay-functions): New hook. (redisplay--pre-redisplay-functions): New function. (pre-redisplay-function): Use it. (minibuffer-avoid-prompt): Mark obsolete. (redisplay--update-region-highlight): Adapt it to work as a function on pre-redisplay-functions. * lisp/cus-start.el (minibuffer-prompt-properties--setter): New fun. (minibuffer-prompt-properties): Use it. Use cursor-intangible rather than point-entered to make the prompt intangible. * lisp/forms.el: Move `provide' calls to the end. (forms-mode): Don't use `run-hooks' on a local var. (forms--make-format, forms--make-format-elt-using-text-properties): Use cursor-intangible rather than `intangible'. (forms-mode): Enable cursor-intangible-mode. * lisp/isearch.el (isearch-mode): Use defvar-local. (cursor-sensor-inhibit): Declare. (isearch-mode): Set cursor-sensor-inhibit. (isearch-done): Set it back. (isearch-open-overlay-temporary, isearch-open-necessary-overlays) (isearch-close-unnecessary-overlays): Don't bother with `intangible' any more. * lisp/ses.el (ses-localvars): Remove `mode-line-process'. (ses-sym-rowcol, ses-cell-value, ses-col-width, ses-col-printer): Add Edebug spec. (ses-goto-print, ses-print-cell, ses-adjust-print-width) (ses-goto-data, ses-setup, ses-copy-region): Don't let-bind inhibit-point-motion-hooks any more. (ses--cell-at-pos, ses--curcell): New functions, extracted from ses-set-curcell. (ses-set-curcell): Use them. (ses-print-cell, ses-setup): Use cursor-intangible instead of `intangible'. Make sure cursor-intangible isn't sticky at BOB. (ses-print-cell-new-width, ses-reprint-all, ses-recalculate-all): Use ses--cell-at-pos. (ses--mode-line-process, ses--cursor-sensor-highlight): New functions, extracted from ses-command-hook. Make them work with multiple windows displaying the same buffer. (ses-mode): Use them via mode-line-process and pre-redisplay-functions. Enable cursor-intangible-mode. (ses-command-hook): Remove cell highlight and mode-line update code. (ses-forward-or-insert, ses-copy-region-helper, ses-sort-column): Update for new name of text-property holding the cell name. (ses-rename-cell): Don't mess with mode-line-process. * lisp/erc/erc-stamp.el (erc-add-timestamp): Use the new cursor-sensor-functions property instead of point-entered. (erc-insert-timestamp-right, erc-format-timestamp): Use cursor-intangible rather than `intangible'. (erc-munge-invisibility-spec): Use add-to-invisibility-spec and remove-from-invisibility-spec. Enable cursor-intangible-mode and cursor-sensor-mode if needed. (erc-echo-timestamp): Adapt to calling convention of cursor-sensor-functions. (erc-insert-timestamp-right): Remove unused vars `current-window' and `indent'. * lisp/gnus/gnus-group.el (gnus-tmp-*): Declare. (gnus-update-group-mark-positions): Remove unused `topic' var. (gnus-group-insert-group-line): Remove unused var `header'. (gnus-group--setup-tool-bar-update): New function. (gnus-group-insert-group-line): Use it. (gnus-group-update-eval-form): Declare local dynamically-bound variables. (gnus-group-unsubscribe-group): Use \` and \' to match string bounds. * lisp/gnus/gnus-topic.el (gnus-topic-jump-to-topic) (gnus-group-prepare-topics, gnus-topic-update-topic) (gnus-topic-change-level, gnus-topic-catchup-articles) (gnus-topic-remove-group, gnus-topic-delete, gnus-topic-indent): Use inhibit-read-only. (gnus-topic-prepare-topic): Use gnus-group--setup-tool-bar-update. (gnus-topic-mode): Use define-minor-mode and derived-mode-p. * lisp/textmodes/reftex-index.el (reftex-display-index): Use cursor-intangible-mode if available. (reftex-index-post-command-hook): Check cursor-intangible. * lisp/textmodes/reftex-toc.el (reftex-toc): Use cursor-intangible-mode if available. (reftex-toc-recenter, reftex-toc-post-command-hook): Check cursor-intangible. * lisp/textmodes/sgml-mode.el: Use lexical-binding. (sgml-tag): Use cursor-sensor-functions instead of point-entered. (sgml-tags-invisible): Use with-silent-modifications and inhibit-read-only. Enable cursor-sensor-mode. (sgml-cursor-sensor): Rename from sgml-point-entered and adjust to calling convention of cursor-sensor-functions. * lisp/textmodes/table.el (table-cell-map-hook, table-load-hook) (table-point-entered-cell-hook, table-point-left-cell-hook): Don't autoload. (table-cell-entered-state): Remove var. (table--put-cell-point-entered/left-property) (table--remove-cell-properties): Use cursor-sensor-functions rather than point-entered/left. (table--point-entered/left-cell-function): Merge table--point-entered-cell-function and table--point-left-cell-function and adjust to calling convention of cursor-sensor-functions. diff --git a/etc/NEWS b/etc/NEWS index caf6250..8a9fa7c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -693,6 +693,13 @@ word syntax, use `\sw' instead. * Lisp Changes in Emacs 25.1 +** New hook `pre-redisplay-functions', a bit easier to use than pre-redisplay-function. + +** Obsolete text properties `intangible', `point-entered', and `point-left'. +Replaced by properties `cursor-intangible' and `cursor-sensor-functions', +implemented by the new `cursor-intangible-mode' and +`cursor-sensor-mode' minor modes. + ** New process type `pipe', which can be used in combination with the `:stderr' keyword of make-process to handle standard error output of subprocess. diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 71506cb..b96b817 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -1,4 +1,4 @@ -;;; cus-start.el --- define customization properties of builtins +;;; cus-start.el --- define customization properties of builtins -*- lexical-binding:t -*- ;; Copyright (C) 1997, 1999-2015 Free Software Foundation, Inc. @@ -33,6 +33,14 @@ ;;; Code: +(defun minibuffer-prompt-properties--setter (symbol value) + (set-default symbol value) + (if (memq 'cursor-intangible value) + (add-hook 'minibuffer-setup-hook 'cursor-intangible-mode) + ;; Removing it is a bit trickier since it could have been added by someone + ;; else as well, so let's just not bother. + )) + ;; Elements of this list have the form: ;; SYMBOL GROUP TYPE VERSION REST... ;; SYMBOL is the name of the variable. @@ -46,7 +54,23 @@ ;; :risky - risky-local-variable property ;; :safe - safe-local-variable property ;; :tag - custom-tag property -(let ((all '(;; alloc.c +(let (standard native-p prop propval + ;; This function turns a value + ;; into an expression which produces that value. + (quoter (lambda (sexp) + ;; FIXME: We'd like to use macroexp-quote here, but cus-start + ;; is loaded too early in loadup.el for that. + (if (or (memq sexp '(t nil)) + (keywordp sexp) + (and (listp sexp) + (memq (car sexp) '(lambda))) + (stringp sexp) + (numberp sexp)) + sexp + (list 'quote sexp))))) + (pcase-dolist + (`(,symbol ,group ,type ,version . ,rest) + '(;; alloc.c (gc-cons-threshold alloc integer) (gc-cons-percentage alloc float) (garbage-collection-messages alloc boolean) @@ -269,10 +293,10 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (make-pointer-invisible mouse boolean "23.2") (menu-bar-mode frames boolean nil ;; FIXME? -; :initialize custom-initialize-default + ;; :initialize custom-initialize-default :set custom-set-minor-mode) (tool-bar-mode (frames mouse) boolean nil -; :initialize custom-initialize-default + ;; :initialize custom-initialize-default :set custom-set-minor-mode) (frame-resize-pixelwise frames boolean "24.4") (frame-inhibit-implied-resize frames @@ -342,14 +366,15 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of :doc "Prevent point from ever entering prompt" :format "%t%n%h" :inline t - (point-entered minibuffer-avoid-prompt))) + (cursor-intangible t))) (repeat :inline t :tag "Other Properties" (list :inline t :format "%v" (symbol :tag "Property") (sexp :tag "Value")))) - "21.1") + "21.1" + :set minibuffer-prompt-properties--setter) (minibuffer-auto-raise minibuffer boolean) ;; options property set at end (read-buffer-function minibuffer @@ -550,27 +575,7 @@ since it could result in memory overflow and make Emacs crash." (x-select-enable-clipboard-manager killing boolean "24.1") ;; xsettings.c (font-use-system-font font-selection boolean "23.2"))) - this symbol group type standard version native-p rest prop propval - ;; This function turns a value - ;; into an expression which produces that value. - (quoter (lambda (sexp) - (if (or (memq sexp '(t nil)) - (keywordp sexp) - (and (listp sexp) - (memq (car sexp) '(lambda))) - (stringp sexp) - (numberp sexp)) - sexp - (list 'quote sexp))))) - (while all - (setq this (car all) - all (cdr all) - symbol (nth 0 this) - group (nth 1 this) - type (nth 2 this) - version (nth 3 this) - rest (nthcdr 4 this) - ;; If we did not specify any standard value expression above, + (setq ;; If we did not specify any standard value expression above, ;; use the current value as the standard value. standard (if (setq prop (memq :standard rest)) (cadr prop) diff --git a/lisp/emacs-lisp/cursor-sensor.el b/lisp/emacs-lisp/cursor-sensor.el new file mode 100644 index 0000000..1d1780b --- /dev/null +++ b/lisp/emacs-lisp/cursor-sensor.el @@ -0,0 +1,180 @@ +;;; cursor-sensor.el --- React to cursor movement -*- lexical-binding: t; -*- + +;; Copyright (C) 2015 Free Software Foundation, Inc. + +;; Author: Stefan Monnier +;; Keywords: + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This package implements the `cursor-intangible' property, which is +;; meant to replace the old `intangible' property. To use it, just enable the +;; `cursor-intangible-mode', after which this package will move point away from +;; any position that has a non-nil `cursor-intangible' property. This is only +;; done just before redisplay happens, contrary to the old `intangible' +;; property which was done at a much lower level. + +;;; Code: + +(defvar cursor-sensor-inhibit nil) + +(defun cursor-sensor--intangible-p (pos) + (let ((p (get-pos-property pos 'cursor-intangible))) + (if p + (let (a b) + (if (and (setq a (get-char-property pos 'cursor-intangible)) + (setq b (if (> pos (point-min)) + (get-char-property (1- pos) 'cursor-intangible))) + (not (eq a b))) + ;; If we're right between two different intangible thingies, + ;; we can stop here. This is not quite consistent with the + ;; interpretation of "if it's sticky, then this boundary is + ;; itself intangible", but it's convenient (and it better matches + ;; the behavior of `intangible', making it easier to port code). + nil p)) + p))) + +(defun cursor-sensor-tangible-pos (curpos window &optional second-chance) + (let ((newpos curpos)) + (when (cursor-sensor--intangible-p newpos) + (let ((oldpos (window-parameter window 'cursor-intangible--last-point))) + (cond + ((or (and (integerp oldpos) (< oldpos newpos)) + (eq newpos (point-min))) + (while + (when (< newpos (point-max)) + (setq newpos + (if (get-char-property newpos 'cursor-intangible) + (next-single-char-property-change + newpos 'cursor-intangible nil (point-max)) + (1+ newpos))) + (cursor-sensor--intangible-p newpos)))) + (t ;; (>= oldpos newpos) + (while + (when (> newpos (point-min)) + (setq newpos + (if (get-char-property (1- newpos) 'cursor-intangible) + (previous-single-char-property-change + newpos 'cursor-intangible nil (point-min)) + (1- newpos))) + (cursor-sensor--intangible-p newpos))))) + (if (not (and (or (eq newpos (point-min)) (eq newpos (point-max))) + (cursor-sensor--intangible-p newpos))) + ;; All clear, we're good to go. + newpos + ;; We're still on an intangible position because we bumped + ;; into an intangible BOB/EOB: try to move in the other direction. + (if second-chance + ;; Actually, we tried already and that failed! + curpos + (cursor-sensor-tangible-pos newpos window 'second-chance))))))) + +(defun cursor-sensor-move-to-tangible (window) + (let* ((curpos (window-point window)) + (newpos (cursor-sensor-tangible-pos curpos window))) + (when newpos (set-window-point window newpos)) + (set-window-parameter window 'cursor-intangible--last-point + (or newpos curpos)))) + +(defun cursor-sensor--move-to-tangible (window) + (unless cursor-sensor-inhibit + (cursor-sensor-move-to-tangible window))) + +;;;###autoload +(define-minor-mode cursor-intangible-mode + "Keep cursor outside of any `cursor-intangible' text property." + nil nil nil + (if cursor-intangible-mode + (add-hook 'pre-redisplay-functions #'cursor-sensor--move-to-tangible + nil t) + (remove-hook 'pre-redisplay-functions #'cursor-sensor--move-to-tangible t))) + +;;; Detect cursor movement. + +(defun cursor-sensor--detect (window) + (unless cursor-sensor-inhibit + (let* ((point (window-point window)) + ;; It's often desirable to make the cursor-sensor-functions property + ;; non-sticky on both ends, but that means get-pos-property might + ;; never see it. + (new (or (get-char-property point 'cursor-sensor-functions) + (unless (bobp) + (get-char-property (1- point) 'cursor-sensor-functions)))) + (old (window-parameter window 'cursor-sensor--last-state)) + (oldposmark (car old)) + (oldpos (or (if oldposmark (marker-position oldposmark)) + (point-min))) + (start (min oldpos point)) + (end (max oldpos point))) + (unless (or (null old) (eq (marker-buffer oldposmark) (current-buffer))) + ;; `window' does not display the same buffer any more! + (setcdr old nil)) + (if (or (and (null new) (null (cdr old))) + (and (eq new (cdr old)) + (eq (next-single-property-change + start 'cursor-sensor-functions nil end) + end))) + ;; Clearly nothing to do. + nil + ;; Maybe something to do. Let's see exactly what needs to run. + (let* ((missing-p + (lambda (f) + "Non-nil if F is missing somewhere between START and END." + (let ((pos start) + (missing nil)) + (while (< pos end) + (setq pos (next-single-property-change + pos 'cursor-sensor-functions + nil end)) + (unless (memq f (get-char-property + pos 'cursor-sensor-functions)) + (setq missing t))) + missing)))) + (dolist (f (cdr old)) + (unless (and (memq f new) (not (funcall missing-p f))) + (funcall f window oldpos 'left))) + (dolist (f new) + (unless (and (memq f (cdr old)) (not (funcall missing-p f))) + (funcall f window oldpos 'entered))))) + + ;; Remember current state for next time. + ;; Re-read cursor-sensor-functions since the functions may have moved + ;; window-point! + (if old + (progn (move-marker (car old) point) + (setcdr old new)) + (set-window-parameter window 'cursor-sensor--last-state + (cons (copy-marker point) new)))))) + +;;;###autoload +(define-minor-mode cursor-sensor-mode + "Handle the `cursor-sensor-functions' text property. +This property should hold a list of functions which react to the motion +of the cursor. They're called with three arguments (WINDOW OLDPOS DIR) +where WINDOW is the affected window, OLDPOS is the last known position of +the cursor and DIR can be `left' or `entered' depending on whether the cursor is +entering the area covered by the text-property property or leaving it." + nil nil nil + (if cursor-sensor-mode + (add-hook 'pre-redisplay-functions #'cursor-sensor--detect + nil t) + (remove-hook 'pre-redisplay-functions #'cursor-sensor--detect + t))) + +(provide 'cursor-sensor) +;;; cursor-sensor.el ends here diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 1ec3f32..cbcd055 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -114,7 +114,7 @@ If `erc-timestamp-format' is set, this will not be used." (string))) (defcustom erc-insert-away-timestamp-function - 'erc-insert-timestamp-left-and-right + #'erc-insert-timestamp-left-and-right "Function to use to insert the away timestamp. See `erc-insert-timestamp-function' for details." @@ -161,12 +161,12 @@ from entering them and instead jump over them." ;;;###autoload (autoload 'erc-timestamp-mode "erc-stamp" nil t) (define-erc-module stamp timestamp "This mode timestamps messages in the channel buffers." - ((add-hook 'erc-mode-hook 'erc-munge-invisibility-spec) - (add-hook 'erc-insert-modify-hook 'erc-add-timestamp t) - (add-hook 'erc-send-modify-hook 'erc-add-timestamp t)) - ((remove-hook 'erc-mode-hook 'erc-munge-invisibility-spec) - (remove-hook 'erc-insert-modify-hook 'erc-add-timestamp) - (remove-hook 'erc-send-modify-hook 'erc-add-timestamp))) + ((add-hook 'erc-mode-hook #'erc-munge-invisibility-spec) + (add-hook 'erc-insert-modify-hook #'erc-add-timestamp t) + (add-hook 'erc-send-modify-hook #'erc-add-timestamp t)) + ((remove-hook 'erc-mode-hook #'erc-munge-invisibility-spec) + (remove-hook 'erc-insert-modify-hook #'erc-add-timestamp) + (remove-hook 'erc-send-modify-hook #'erc-add-timestamp))) (defun erc-add-timestamp () "Add timestamp and text-properties to message. @@ -188,7 +188,8 @@ or `erc-send-modify-hook'." (add-text-properties (point-min) (point-max) (list 'timestamp ct)) (add-text-properties (point-min) (point-max) - (list 'point-entered 'erc-echo-timestamp))))) + (list 'cursor-sensor-functions + (list #'erc-echo-timestamp)))))) (defvar erc-timestamp-last-inserted nil "Last timestamp inserted into the buffer.") @@ -289,8 +290,7 @@ be printed just before the window-width." (setq erc-timestamp-last-inserted string) (goto-char (point-max)) (forward-char -1);; before the last newline - (let* ((current-window (get-buffer-window (current-buffer))) - (str-width (string-width string)) + (let* ((str-width (string-width string)) (pos (cond (erc-timestamp-right-column erc-timestamp-right-column) ((and (boundp 'erc-fill-mode) @@ -303,8 +303,7 @@ be printed just before the window-width." (t (- (window-width) str-width 1)))) (from (point)) - (col (current-column)) - indent) + (col (current-column))) ;; The following is a kludge used to calculate whether to move ;; to the next line before inserting a stamp. It allows for ;; some margin of error if what is displayed on the line differs @@ -319,9 +318,9 @@ be printed just before the window-width." (erc-put-text-property from (point) 'field 'erc-timestamp) (erc-put-text-property from (point) 'rear-nonsticky t) (when erc-timestamp-intangible - (erc-put-text-property from (1+ (point)) 'intangible t))))) + (erc-put-text-property from (1+ (point)) 'cursor-intangible t))))) -(defun erc-insert-timestamp-left-and-right (string) +(defun erc-insert-timestamp-left-and-right (_string) "This is another function that can be assigned to `erc-insert-timestamp-function'. If the date is changed, it will print a blank line, the date, and another blank line. If the time is @@ -356,7 +355,7 @@ Return the empty string if FORMAT is nil." ;; inelegant, hack. -- BPT (and erc-timestamp-intangible (not erc-hide-timestamps) ; bug#11706 - (erc-put-text-property 0 (length ts) 'intangible t ts)) + (erc-put-text-property 0 (length ts) 'cursor-intangible t ts)) ts) "")) @@ -366,15 +365,13 @@ Return the empty string if FORMAT is nil." ;; please modify this function and move it to a more appropriate ;; location. (defun erc-munge-invisibility-spec () + (and erc-timestamp-intangible (not (bound-and-true-p cursor-intangible-mode)) + (cursor-intangible-mode 1)) + (and erc-echo-timestamps (not (bound-and-true-p cursor-sensor-mode)) + (cursor-sensor-mode 1)) (if erc-hide-timestamps - (setq buffer-invisibility-spec - (if (listp buffer-invisibility-spec) - (cons 'timestamp buffer-invisibility-spec) - (list 't 'timestamp))) - (setq buffer-invisibility-spec - (if (listp buffer-invisibility-spec) - (remove 'timestamp buffer-invisibility-spec) - (list 't))))) + (add-to-invisibility-spec 'timespec) + (remove-from-invisibility-spec 'timespec))) (defun erc-hide-timestamps () "Hide timestamp information from display." @@ -405,12 +402,11 @@ enabled when the message was inserted." (erc-munge-invisibility-spec))) (erc-buffer-list))) -(defun erc-echo-timestamp (before now) - "Print timestamp text-property of an IRC message. -Argument BEFORE is where point was before it got moved and -NOW is position of point currently." - (when erc-echo-timestamps - (let ((stamp (get-text-property now 'timestamp))) +(defun erc-echo-timestamp (window _before dir) + "Print timestamp text-property of an IRC message." + (when (and erc-echo-timestamps (eq 'entered dir)) + (let* ((now (window-point window)) + (stamp (get-text-property now 'timestamp))) (when stamp (message "%s" (format-time-string erc-echo-timestamp-format stamp)))))) diff --git a/lisp/forms.el b/lisp/forms.el index 22ddd65..aa57a66 100644 --- a/lisp/forms.el +++ b/lisp/forms.el @@ -297,9 +297,6 @@ ;;; Global variables and constants: -(provide 'forms) ;;; official -(provide 'forms-mode) ;;; for compatibility - (defcustom forms-mode-hook nil "Hook run upon entering Forms mode." :group 'forms @@ -443,6 +440,7 @@ Also, initial position is at last record." ;;;###autoload (defun forms-mode (&optional primary) + ;; FIXME: use define-derived-mode "Major mode to visit files in a field-structured manner using a form. Commands: Equivalent keys in read-only mode: @@ -637,6 +635,8 @@ Commands: Equivalent keys in read-only mode: (setq major-mode 'forms-mode) (setq mode-name "Forms") + (cursor-intangible-mode 1) + ;; find the data file (setq forms--file-buffer (find-file-noselect forms-file)) @@ -647,7 +647,7 @@ Commands: Equivalent keys in read-only mode: (with-current-buffer forms--file-buffer (let ((inhibit-read-only t) (file-modified (buffer-modified-p))) - (run-hooks 'read-file-filter) + (mapc #'funcall read-file-filter) (if (not file-modified) (set-buffer-modified-p nil))) (if write-file-filter (add-hook 'write-file-functions write-file-filter nil t))) @@ -921,7 +921,7 @@ Commands: Equivalent keys in read-only mode: ,@(if (numberp (car forms-format-list)) nil '((add-text-properties (point-min) (1+ (point-min)) - '(front-sticky (read-only intangible))))) + '(front-sticky (read-only cursor-intangible))))) ;; Prevent insertion after the last text. (remove-text-properties (1- (point)) (point) '(rear-nonsticky))) @@ -1005,10 +1005,10 @@ Commands: Equivalent keys in read-only mode: (point)) (list 'face forms--ro-face ; read-only appearance 'read-only ,@(list (1+ forms--marker)) - 'intangible ,@(list (1+ forms--marker)) + 'cursor-intangible ,@(list (1+ forms--marker)) 'insert-in-front-hooks '(forms--iif-hook) 'rear-nonsticky '(face read-only insert-in-front-hooks - intangible))))) + cursor-intangible))))) ((numberp el) `((let ((here (point))) @@ -1034,10 +1034,10 @@ Commands: Equivalent keys in read-only mode: (point)) (list 'face forms--ro-face 'read-only ,@(list (1+ forms--marker)) - 'intangible ,@(list (1+ forms--marker)) + 'cursor-intangible ,@(list (1+ forms--marker)) 'insert-in-front-hooks '(forms--iif-hook) 'rear-nonsticky '(read-only face insert-in-front-hooks - intangible))))) + cursor-intangible))))) ;; end of cond )) @@ -2055,4 +2055,6 @@ Usage: (setq forms-number-of-fields (goto-char (point-max)) (insert ret))))) +(provide 'forms-mode) ; for compatibility +(provide 'forms) ;;; forms.el ends here diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index e22138b..8e8d175 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -478,6 +478,26 @@ simple manner.") (defvar gnus-group-edit-buffer nil) +(defvar gnus-tmp-news-method) +(defvar gnus-tmp-colon) +(defvar gnus-tmp-news-server) +(defvar gnus-tmp-decoded-group) +(defvar gnus-tmp-header) +(defvar gnus-tmp-process-marked) +(defvar gnus-tmp-summary-live) +(defvar gnus-tmp-news-method-string) +(defvar gnus-tmp-group-icon) +(defvar gnus-tmp-moderated-string) +(defvar gnus-tmp-newsgroup-description) +(defvar gnus-tmp-comment) +(defvar gnus-tmp-qualified-group) +(defvar gnus-tmp-subscribed) +(defvar gnus-tmp-number-of-read) +(defvar gnus-inhibit-demon) +(defvar gnus-pick-mode) +(defvar gnus-tmp-marked-mark) +(defvar gnus-tmp-number-of-unread) + (defvar gnus-group-line-format-alist `((?M gnus-tmp-marked-mark ?c) (?S gnus-tmp-subscribed ?c) @@ -1140,8 +1160,7 @@ The following commands are available: (let ((gnus-process-mark ?\200) (gnus-group-update-hook nil) (gnus-group-marked '("dummy.group")) - (gnus-active-hashtb (make-vector 10 0)) - (topic "")) + (gnus-active-hashtb (make-vector 10 0))) (gnus-set-active "dummy.group" '(0 . 0)) (gnus-set-work-buffer) (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil) @@ -1574,7 +1593,7 @@ if it is a string, only list groups matching REGEXP." gnus-process-mark ? )) (buffer-read-only nil) beg end - header gnus-tmp-header) ; passed as parameter to user-funcs. + gnus-tmp-header) ; passed as parameter to user-funcs. (beginning-of-line) (setq beg (point)) (gnus-add-text-properties @@ -1592,20 +1611,31 @@ if it is a string, only list groups matching REGEXP." gnus-indentation ,gnus-group-indentation gnus-level ,gnus-tmp-level)) (setq end (point)) - (when gnus-group-update-tool-bar - (gnus-put-text-property beg end 'point-entered - 'gnus-tool-bar-update) - (gnus-put-text-property beg end 'point-left - 'gnus-tool-bar-update)) + (gnus-group--setup-tool-bar-update beg end) (forward-line -1) (when (inline (gnus-visual-p 'group-highlight 'highlight)) (gnus-group-highlight-line gnus-tmp-group beg end)) (gnus-run-hooks 'gnus-group-update-hook) (forward-line))) +(defun gnus-group--setup-tool-bar-update (beg end) + (when gnus-group-update-tool-bar + (if (fboundp 'cursor-sensor-mode) + (progn + (unless (bound-and-true-p cursor-sensor-mode) + (cursor-sensor-mode 1)) + (gnus-put-text-property beg end 'cursor-sensor-functions + #'gnus-tool-bar-update)) + (gnus-put-text-property beg end 'point-entered + #'gnus-tool-bar-update) + (gnus-put-text-property beg end 'point-left + #'gnus-tool-bar-update)))) + (defun gnus-group-update-eval-form (group list) "Eval `car' of each element of LIST, and return the first that return t. Some value are bound so the form can use them." + (defvar group-age) (defvar ticked) (defvar score) (defvar level) + (defvar mailp) (defvar total) (defvar unread) (when list (let* ((entry (gnus-group-entry group)) (unread (if (numberp (car entry)) (car entry) 0)) @@ -3107,8 +3137,8 @@ If SOLID (the prefix), create a solid group." (defvar nnrss-group-alist) (eval-when-compile - (defun nnrss-discover-feed (arg)) - (defun nnrss-save-server-data (arg))) + (defun nnrss-discover-feed (_arg)) + (defun nnrss-save-server-data (_arg))) (defun gnus-group-make-rss-group (&optional url) "Given a URL, discover if there is an RSS feed. If there is, use Gnus to create an nnrss group" @@ -3757,7 +3787,7 @@ group line." nil nil (gnus-read-active-file-p)))) (let ((newsrc (gnus-group-entry group))) (cond - ((string-match "^[ \t]*$" group) + ((string-match "\\`[ \t]*\\'" group) (error "Empty group name")) (newsrc ;; Toggle subscription flag. diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index f536a27..47cdcbc 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -154,7 +154,7 @@ See Info node `(gnus)Formatting Variables'." "Go to TOPIC." (interactive (list (gnus-completing-read "Go to topic" (gnus-topic-list) t))) - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (dolist (topic (gnus-current-topics topic)) (unless (gnus-topic-goto-topic topic) (gnus-topic-goto-missing-topic topic) @@ -427,7 +427,7 @@ If PREDICATE is a function, list groups that the function returns non-nil; if it is t, list groups that have no unread articles. If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." (set-buffer gnus-group-buffer) - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) (lowest (or lowest 1)) (not-in-list (and gnus-group-listed-groups @@ -582,11 +582,7 @@ articles in the topic and its subtopics." (not (eq (nth 2 type) 'hidden)) level all-entries unread)) (gnus-topic-update-unreads (car type) unread) - (when gnus-group-update-tool-bar - (gnus-put-text-property beg end 'point-entered - 'gnus-tool-bar-update) - (gnus-put-text-property beg end 'point-left - 'gnus-tool-bar-update)) + (gnus-group--setup-tool-bar-update beg end) (goto-char end) unread)) @@ -684,7 +680,7 @@ articles in the topic and its subtopics." gnus-topic-mode) (let ((group (gnus-group-group-name)) (m (point-marker)) - (buffer-read-only nil)) + (inhibit-read-only t)) (when (and group (gnus-get-info group) (gnus-topic-goto-topic (gnus-current-topic))) @@ -902,7 +898,7 @@ articles in the topic and its subtopics." (defun gnus-topic-change-level (group level oldlevel &optional previous) "Run when changing levels to enter/remove groups from topics." (with-current-buffer gnus-group-buffer - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (unless gnus-topic-inhibit-change-level (gnus-group-goto-group (or (car (nth 2 previous)) group)) (when (and gnus-topic-mode @@ -1131,22 +1127,17 @@ articles in the topic and its subtopics." ["Edit parameters" gnus-topic-edit-parameters t]) ["List active" gnus-topic-list-active t])))) -(defun gnus-topic-mode (&optional arg redisplay) +(define-minor-mode gnus-topic-mode "Minor mode for topicsifying Gnus group buffers." - ;; FIXME: Use define-minor-mode. - (interactive (list current-prefix-arg t)) - (when (eq major-mode 'gnus-group-mode) - (make-local-variable 'gnus-topic-mode) - (setq gnus-topic-mode - (if (null arg) (not gnus-topic-mode) - (> (prefix-numeric-value arg) 0))) + :lighter " Topic" :keymap gnus-topic-mode-map + (if (not (derived-mode-p 'gnus-group-mode)) + (setq gnus-topic-mode nil) ;; Infest Gnus with topics. (if (not gnus-topic-mode) (setq gnus-goto-missing-group-function nil) (when (gnus-visual-p 'topic-menu 'menu) (gnus-topic-make-menu-bar)) (gnus-set-format 'topic t) - (add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map) (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic) (set (make-local-variable 'gnus-group-prepare-function) 'gnus-group-prepare-topics) @@ -1168,8 +1159,7 @@ articles in the topic and its subtopics." (setq gnus-topology-checked-p nil) ;; We check the topology. (when gnus-newsrc-alist - (gnus-topic-check-topology)) - (gnus-run-hooks 'gnus-topic-mode-hook)) + (gnus-topic-check-topology))) ;; Remove topic infestation. (unless gnus-topic-mode (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) @@ -1177,7 +1167,7 @@ articles in the topic and its subtopics." (remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist) (setq gnus-group-prepare-function 'gnus-group-prepare-flat) (setq gnus-group-sort-alist-function 'gnus-group-sort-flat)) - (when redisplay + (when (called-interactively-p 'any) (gnus-group-list-groups)))) (defun gnus-topic-select-group (&optional all) @@ -1229,10 +1219,10 @@ Also see `gnus-group-catchup'." (call-interactively 'gnus-group-catchup-current) (save-excursion (let* ((groups - (mapcar (lambda (entry) (car (nth 2 entry))) - (gnus-topic-find-groups topic gnus-level-killed t - nil t))) - (buffer-read-only nil) + (mapcar (lambda (entry) (car (nth 2 entry))) + (gnus-topic-find-groups topic gnus-level-killed t + nil t))) + (inhibit-read-only t) (gnus-group-marked groups)) (gnus-group-catchup-current) (mapcar 'gnus-topic-update-topics-containing-group groups))))) @@ -1336,7 +1326,7 @@ If COPYP, copy the groups instead." (lambda (group) (gnus-group-remove-mark group use-marked) (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist)) - (buffer-read-only nil)) + (inhibit-read-only t)) (when (and topicl group) (gnus-delete-line) (gnus-delete-first group topicl)) @@ -1515,7 +1505,7 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics." (unless topic (error "No topic to be deleted")) (let ((entry (assoc topic gnus-topic-alist)) - (buffer-read-only nil)) + (inhibit-read-only t)) (when (cdr entry) (error "Topic not empty")) ;; Delete if visible. @@ -1560,7 +1550,7 @@ If UNINDENT, remove an indentation." (gnus-topic-unindent) (let* ((topic (gnus-current-topic)) (parent (gnus-topic-previous-topic topic)) - (buffer-read-only nil)) + (inhibit-read-only t)) (unless parent (error "Nothing to indent %s into" topic)) (when topic diff --git a/lisp/isearch.el b/lisp/isearch.el index 99ca73f..35fb060 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -578,7 +578,7 @@ variable by the command `isearch-toggle-lax-whitespace'.") "Stack of search status elements. Each element is an `isearch--state' struct where the slots are [STRING MESSAGE POINT SUCCESS FORWARD OTHER-END WORD - INVALID-REGEXP WRAPPED BARRIER WITHIN-BRACKETS CASE-FOLD-SEARCH]") + ERROR WRAPPED BARRIER CASE-FOLD-SEARCH]") (defvar isearch-string "") ; The current search string. (defvar isearch-message "") ; text-char-description version of isearch-string @@ -657,8 +657,7 @@ Each element is an `isearch--state' struct where the slots are (nconc minor-mode-alist (list '(isearch-mode isearch-mode)))) -(defvar isearch-mode nil) ;; Name of the minor mode, if non-nil. -(make-variable-buffer-local 'isearch-mode) +(defvar-local isearch-mode nil) ;; Name of the minor mode, if non-nil. (define-key global-map "\C-s" 'isearch-forward) (define-key esc-map "\C-s" 'isearch-forward-regexp) @@ -826,6 +825,7 @@ See the command `isearch-forward-symbol' for more information." (isearch-update))))) +(defvar cursor-sensor-inhibit) ;; isearch-mode only sets up incremental search for the minor mode. ;; All the work is done by the isearch-mode commands. @@ -932,6 +932,12 @@ convert the search string to a regexp used by regexp search functions." (add-hook 'post-command-hook 'isearch-post-command-hook) (add-hook 'mouse-leave-buffer-hook 'isearch-done) (add-hook 'kbd-macro-termination-hook 'isearch-done) + (make-local-variable 'cursor-sensor-inhibit) + (unless (boundp 'cursor-sensor-inhibit) + (setq cursor-sensor-inhibit nil)) + ;; Suspend things like cursor-intangible during Isearch so we can search even + ;; within intangible text. + (push 'isearch cursor-sensor-inhibit) ;; isearch-mode can be made modal (in the sense of not returning to ;; the calling function until searching is completed) by entering @@ -1020,6 +1026,7 @@ NOPUSH is t and EDIT is t." (remove-hook 'mouse-leave-buffer-hook 'isearch-done) (remove-hook 'kbd-macro-termination-hook 'isearch-done) (setq isearch-lazy-highlight-start nil) + (setq cursor-sensor-inhibit (delq 'isearch cursor-sensor-inhibit)) ;; Called by all commands that terminate isearch-mode. ;; If NOPUSH is non-nil, we don't push the string on the search ring. @@ -2717,17 +2724,12 @@ update the match data, and return point." ;; isearch in their own way, they should set the ;; `isearch-open-invisible-temporary' to a function doing this. (funcall (overlay-get ov 'isearch-open-invisible-temporary) ov nil) - ;; Store the values for the `invisible' and `intangible' - ;; properties, and then set them to nil. This way the text hidden - ;; by this overlay becomes visible. + ;; Store the values for the `invisible' property, and then set it to nil. + ;; This way the text hidden by this overlay becomes visible. - ;; Do we really need to set the `intangible' property to t? Can we - ;; have the point inside an overlay with an `intangible' property? ;; In 19.34 this does not exist so I cannot test it. (overlay-put ov 'isearch-invisible (overlay-get ov 'invisible)) - (overlay-put ov 'isearch-intangible (overlay-get ov 'intangible)) - (overlay-put ov 'invisible nil) - (overlay-put ov 'intangible nil))) + (overlay-put ov 'invisible nil))) ;; This is called at the end of isearch. It will open the overlays @@ -2741,12 +2743,9 @@ update the match data, and return point." ;; this function, not by us tweaking the overlay properties. (fct-temp (overlay-get ov 'isearch-open-invisible-temporary))) (when (or inside-overlay (not fct-temp)) - ;; restore the values for the `invisible' and `intangible' - ;; properties + ;; restore the values for the `invisible' properties. (overlay-put ov 'invisible (overlay-get ov 'isearch-invisible)) - (overlay-put ov 'intangible (overlay-get ov 'isearch-intangible)) - (overlay-put ov 'isearch-invisible nil) - (overlay-put ov 'isearch-intangible nil)) + (overlay-put ov 'isearch-invisible nil)) (if inside-overlay (funcall (overlay-get ov 'isearch-open-invisible) ov) (if fct-temp @@ -2784,9 +2783,7 @@ update the match data, and return point." ;; properties. (funcall fct-temp ov t) (overlay-put ov 'invisible (overlay-get ov 'isearch-invisible)) - (overlay-put ov 'intangible (overlay-get ov 'isearch-intangible)) - (overlay-put ov 'isearch-invisible nil) - (overlay-put ov 'isearch-intangible nil))))))) + (overlay-put ov 'isearch-invisible nil))))))) (defun isearch-range-invisible (beg end) diff --git a/lisp/ses.el b/lisp/ses.el index 47fe0d3..e986015 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -25,8 +25,18 @@ ;;; To-do list: +;; * M-w should deactivate the mark. +;; * offer some way to use absolute cell addressing. +;; * Maybe some way to copy a reference to a cell's formula rather than the +;; formula itself. ;; * split (catch 'cycle ...) call back into one or more functions ;; * Use $ or … for truncated fields +;; * M-t to transpose 2 columns. +;; * M-d should kill the cell under point. +;; * C-t to transpose 2 rows. +;; * C-k and M-k should be ses-kill-row and ses-kill-column. +;; * C-o should insert the row below point rather than above? +;; * rows inserted with C-o should inherit formulas from surrounding rows. ;; * Add command to make a range of columns be temporarily invisible. ;; * Allow paste of one cell to a range of cells -- copy formula to each. ;; * Do something about control characters & octal codes in cell print @@ -296,7 +306,7 @@ default printer and then modify its output.") ;; an area containing renamed cell is deleted. ses--renamed-cell-symb-list ;; Global variables that we override - mode-line-process next-line-add-newlines transient-mark-mode) + next-line-add-newlines transient-mark-mode) "Buffer-local variables used by SES.")) (defmacro ses--metaprogramming (exp) (declare (debug t)) (eval exp t)) @@ -421,6 +431,7 @@ functions refer to its value." (defmacro ses-sym-rowcol (sym) "From a cell-symbol SYM, gets the cons (row . col). A1 => (0 . 0). Result is nil if SYM is not a symbol that names a cell." + (declare (debug t)) `(let ((rc (and (symbolp ,sym) (get ,sym 'ses-cell)))) (if (eq rc :ses-named) (gethash ,sym ses--named-cell-hashmap) @@ -465,14 +476,17 @@ the corresponding cell with name PROPERTY-NAME." (defmacro ses-cell-value (row &optional col) "From a CELL or a pair (ROW,COL), get the current value for that cell." + (declare (debug t)) `(symbol-value (ses-cell-symbol ,row ,col))) (defmacro ses-col-width (col) "Return the width for column COL." + (declare (debug t)) `(aref ses--col-widths ,col)) (defmacro ses-col-printer (col) "Return the default printer for column COL." + (declare (debug t)) `(aref ses--col-printers ,col)) (defun ses-is-cell-sym-p (sym) @@ -1054,8 +1068,7 @@ if the cell's value is unchanged and FORCE is nil." ;; is called during a recursive ses-print-cell). (defun ses-goto-print (row col) "Move point to print area for cell (ROW,COL)." - (let ((inhibit-point-motion-hooks t) - (n 0)) + (let ((n 0)) (goto-char (point-min)) (forward-line row) ;; Calculate column position. @@ -1067,23 +1080,36 @@ if the cell's value is unchanged and FORCE is nil." ;; Move point to the bol of next line (for TAB at the last cell). (forward-char)))) -(defun ses-set-curcell () - "Set `ses--curcell' to the current cell symbol, or a cons (BEG,END) for a +(defun ses--cell-at-pos (pos &optional object) + (or (get-text-property pos 'cursor-intangible object) + ;; (when (> pos (if object 0 (point-min))) + ;; (get-text-property (1- pos) 'cursor-intangible object)) + )) + +(defun ses--curcell (&optional pos) + "Return the current cell symbol, or a cons (BEG,END) for a region, or nil if cursor is not at a cell." + (unless pos (setq pos (point))) (if (or (not mark-active) deactivate-mark - (= (region-beginning) (region-end))) + (= pos (mark t))) ;; Single cell. - (setq ses--curcell (get-text-property (point) 'intangible)) + (ses--cell-at-pos pos) ;; Range. - (let ((bcell (get-text-property (region-beginning) 'intangible)) - (ecell (get-text-property (1- (region-end)) 'intangible))) - (when (= (region-end) ses--data-marker) + (let* ((re (max pos (mark t))) + (bcell (ses--cell-at-pos (min pos (mark t)))) + (ecell (ses--cell-at-pos (1- re)))) + (when (= re ses--data-marker) ;; Correct for overflow. - (setq ecell (get-text-property (- (region-end) 2) 'intangible))) - (setq ses--curcell (if (and bcell ecell) - (cons bcell ecell) - nil)))) + (setq ecell (ses--cell-at-pos (- (region-end) 2)))) + (if (and bcell ecell) + (cons bcell ecell) + nil)))) + +(defun ses-set-curcell () + "Set `ses--curcell' to the current cell symbol, or a cons (BEG,END) for a +region, or nil if cursor is not at a cell." + (setq ses--curcell (ses--curcell)) nil) (defun ses-check-curcell (&rest args) @@ -1197,11 +1223,10 @@ preceding cell has spilled over." ;; Install the printed result. This is not interruptible. (let ((inhibit-read-only t) (inhibit-quit t)) - (let ((inhibit-point-motion-hooks t)) - (delete-region (point) (progn - (move-to-column (+ (current-column) - (string-width text))) - (1+ (point))))) + (delete-region (point) (progn + (move-to-column (+ (current-column) + (string-width text))) + (1+ (point)))) ;; We use concat instead of inserting separate strings in order to ;; reduce the number of cells in the undo list. (setq x (concat text (if (< maxcol ses--numcols) " " "\n"))) @@ -1211,13 +1236,15 @@ preceding cell has spilled over." ;; inherit from surrounding text?) (set-text-properties 0 (length x) nil x) (insert-and-inherit x) - (put-text-property startpos (point) 'intangible + (put-text-property startpos (point) 'cursor-intangible (ses-cell-symbol cell)) (when (and (zerop row) (zerop col)) ;; Reconstruct special beginning-of-buffer attributes. (put-text-property (point-min) (point) 'keymap 'ses-mode-print-map) (put-text-property (point-min) (point) 'read-only 'ses) - (put-text-property (point-min) (1+ (point-min)) 'front-sticky t))) + (put-text-property (point-min) (1+ (point-min)) + ;; `cursor-intangible' shouldn't be sticky at BOB. + 'front-sticky '(read-only keymap)))) (if (= row (1- ses--header-row)) ;; This line is part of the header --- force recalc. (ses-reset-header-string)) @@ -1284,8 +1311,7 @@ COL=NUMCOLS. Deletes characters if CHANGE < 0. Caller should bind (ses-goto-print row col) (when at-end ;; Insert new columns before newline. - (let ((inhibit-point-motion-hooks t)) - (backward-char 1))) + (backward-char 1)) (if blank (insert blank) (delete-char (- change)))))) @@ -1299,7 +1325,7 @@ when the width of cell (ROW,COL) has changed." ;;Cell was skipped over - reprint previous (ses-goto-print row col) (backward-char 1) - (let ((rowcol (ses-sym-rowcol (get-text-property (point) 'intangible)))) + (let ((rowcol (ses-sym-rowcol (ses--cell-at-pos (point))))) (ses-print-cell (car rowcol) (cdr rowcol))))) @@ -1319,17 +1345,16 @@ number, COL is the column number for a data cell -- otherwise DEF is one of the symbols ses--col-widths, ses--col-printers, ses--default-printer, ses--numrows, or ses--numcols." (ses-widen) - (let ((inhibit-point-motion-hooks t)) ; In case intangible attrs are wrong. - (if col - ;; It's a cell. - (progn - (goto-char ses--data-marker) - (forward-line (+ 1 (* def (1+ ses--numcols)) col))) - ;; Convert def-symbol to offset. - (setq def (plist-get ses-paramlines-plist def)) - (or def (signal 'args-out-of-range nil)) - (goto-char ses--params-marker) - (forward-line def)))) + (if col + ;; It's a cell. + (progn + (goto-char ses--data-marker) + (forward-line (+ 1 (* def (1+ ses--numcols)) col))) + ;; Convert def-symbol to offset. + (setq def (plist-get ses-paramlines-plist def)) + (or def (signal 'args-out-of-range nil)) + (goto-char ses--params-marker) + (forward-line def))) (defun ses-file-format-extend-parameter-list (new-file-format) "Extend the global parameters list when file format is updated @@ -1843,7 +1868,6 @@ Narrows the buffer to show only the print area. Gives it `read-only' and `intangible' properties. Sets up highlighting for current cell." (interactive) (let ((end (point-min)) - (inhibit-point-motion-hooks t) pos sym) (with-silent-modifications (ses-goto-data 0 0) ; Include marker between print-area and data-area. @@ -1855,7 +1879,9 @@ Narrows the buffer to show only the print area. Gives it `read-only' and (put-text-property (point-min) (1- (point)) 'keymap 'ses-mode-print-map) ;; For the beginning of the buffer, we want the read-only and keymap ;; attributes to be inherited from the first character. - (put-text-property (point-min) (1+ (point-min)) 'front-sticky t) + (put-text-property (point-min) (1+ (point-min)) + ;; `cursor-intangible' shouldn't be sticky at BOB. + 'front-sticky '(read-only keymap)) ;; Create intangible properties, which also indicate which cell the text ;; came from. (dotimes-with-progress-reporter (row ses--numrows) "Finding cells..." @@ -1878,7 +1904,7 @@ Narrows the buffer to show only the print area. Gives it `read-only' and (+ end (ses-col-width col) 1) (forward-char) (point)))) - (put-text-property pos end 'intangible sym)))))) + (put-text-property pos end 'cursor-intangible sym)))))) ;; Create the underlining overlay. It's impossible for (point) to be 2, ;; because column A must be at least 1 column wide. (setq ses--curcell-overlay (make-overlay (1+ (point-min)) (1+ (point-min)))) @@ -1968,6 +1994,11 @@ formula: (window-hscroll)) (ses-create-header-string)) ses--header-string))) + (setq-local mode-line-process '(:eval (ses--mode-line-process))) + (add-hook 'pre-redisplay-functions #'ses--cursor-sensor-highlight + ;; Highlight the cell after moving cursor out of intangible. + 'append t) + (cursor-intangible-mode 1) (let ((was-empty (zerop (buffer-size))) (was-modified (buffer-modified-p))) (save-excursion @@ -2032,32 +2063,7 @@ narrows the buffer now." ;; read the local variables at the end of the file. Now it's safe to ;; do the narrowing. (narrow-to-region (point-min) ses--data-marker) - (setq ses--deferred-narrow nil)) - ;; Update the mode line. - (let ((oldcell ses--curcell)) - (ses-set-curcell) - (unless (eq ses--curcell oldcell) - (cond - ((not ses--curcell) - (setq mode-line-process nil)) - ((atom ses--curcell) - (setq mode-line-process (list " cell " - (symbol-name ses--curcell)))) - (t - (setq mode-line-process (list " range " - (symbol-name (car ses--curcell)) - "-" - (symbol-name (cdr ses--curcell)))))) - (force-mode-line-update))) - ;; Use underline overlay for single-cells only, turn off otherwise. - (if (listp ses--curcell) - (move-overlay ses--curcell-overlay 2 2) - (let ((next (next-single-property-change (point) 'intangible))) - (move-overlay ses--curcell-overlay (point) (1- next)))) - (when (not (pos-visible-in-window-p)) - ;; Scrolling will happen later. - (run-with-idle-timer 0.01 nil 'ses-command-hook) - (setq ses--curcell t))) + (setq ses--deferred-narrow nil))) ;; Prevent errors in this post-command-hook from silently erasing the hook! (error (unless executing-kbd-macro @@ -2065,6 +2071,38 @@ narrows the buffer now." (message "%s" (error-message-string err)))) nil) ; Make coverage-tester happy. +(defun ses--mode-line-process () + (let ((cmlp (window-parameter nil 'ses--mode-line-process)) + (curcell (ses--curcell (window-point)))) + (if (equal curcell (car cmlp)) + (cdr cmlp) + (let ((mlp + (cond + ((not curcell) nil) + ((atom curcell) (list " cell " (symbol-name curcell))) + (t + (list " range " + (symbol-name (car curcell)) + "-" + (symbol-name (cdr curcell))))))) + (set-window-parameter nil 'ses--mode-line-process (cons curcell mlp)) + mlp)))) + +(defun ses--cursor-sensor-highlight (window) + (let ((curcell (ses--curcell)) + (ol (window-parameter window 'ses--curcell-overlay))) + (unless ol + (setq ol (make-overlay (point) (point))) + (overlay-put ol 'window window) + (overlay-put ol 'face 'underline) + (set-window-parameter window 'ses--curcell-overlay ol)) + ;; Use underline overlay for single-cells only, turn off otherwise. + (if (listp curcell) + (delete-overlay ol) + (let* ((pos (window-point window)) + (next (next-single-property-change pos 'cursor-intangible))) + (move-overlay ol pos (1- next)))))) + (defun ses-create-header-string () "Set up `ses--header-string' as the buffer's header line. Based on the current set of columns and `window-hscroll' position." @@ -2132,7 +2170,7 @@ print area if NONARROW is nil." (widen) (unless nonarrow (setq ses--deferred-narrow t)) - (let ((startcell (get-text-property (point) 'intangible)) + (let ((startcell (ses--cell-at-pos (point))) (inhibit-read-only t)) (ses-begin-change) (goto-char (point-min)) @@ -2222,7 +2260,7 @@ to are recalculated first." (defun ses-recalculate-all () "Recalculate and reprint all cells." (interactive "*") - (let ((startcell (get-text-property (point) 'intangible)) + (let ((startcell (ses--cell-at-pos (point))) (ses--curcell (cons 'A1 (ses-cell-symbol (1- ses--numrows) (1- ses--numcols))))) (ses-recalculate-cell) @@ -2730,7 +2768,7 @@ inserts a new row if at bottom of print area. Repeat COUNT times." (let ((col (cdr (ses-sym-rowcol ses--curcell)))) (when (/= 32 (char-before (next-single-property-change (point) - 'intangible))) + 'cursor-intangible))) ;; We're already in last nonskipped cell on line. Need to create a ;; new column. (barf-if-buffer-read-only) @@ -2811,12 +2849,11 @@ SES attributes recording the contents of the cell as of the time of copying." (when (= end ses--data-marker) ;;Avoid overflow situation (setq end (1- ses--data-marker))) - (let* ((inhibit-point-motion-hooks t) - (x (mapconcat #'ses-copy-region-helper + (let* ((x (mapconcat #'ses-copy-region-helper (extract-rectangle beg (1- end)) "\n"))) (remove-text-properties 0 (length x) '(read-only t - intangible t + cursor-intangible t keymap t front-sticky t) x) @@ -2832,8 +2869,8 @@ the corresponding data cell." (pos 0) mycell next sym rowcol) (while pos - (setq sym (get-text-property pos 'intangible line) - next (next-single-property-change pos 'intangible line) + (setq sym (ses--cell-at-pos pos line) + next (next-single-property-change pos 'cursor-intangible line) rowcol (ses-sym-rowcol sym) mycell (ses-get-cell (car rowcol) (cdr rowcol))) (put-text-property pos (or next (length line)) @@ -3229,7 +3266,7 @@ With prefix, sorts in REVERSE order." ;;Get key columns and sort them (dotimes (x (- maxrow minrow -1)) (ses-goto-print (+ minrow x) sorter) - (setq end (next-single-property-change (point) 'intangible)) + (setq end (next-single-property-change (point) 'cursor-intangible)) (push (cons (buffer-substring-no-properties (point) end) (+ minrow x)) keys)) @@ -3379,10 +3416,8 @@ highlighted range in the spreadsheet." (if (eolp) (+ pos (ses-col-width col) 1) (point))))) - (put-text-property pos end 'intangible new-name)) - ;; update mode line - (setq mode-line-process (list " cell " - (symbol-name new-name))) + (put-text-property pos end 'cursor-intangible new-name)) + ;; Update the cell name in the mode-line. (force-mode-line-update))) (defun ses-refresh-local-printer (name _compiled-value) ;FIXME: unused arg? @@ -3622,7 +3657,7 @@ Use `math-format-value' as a printer for Calc objects." "Return ARGS reversed, with the blank elements (nil and *skip*) removed." (let (result) (dolist (cur args) - (unless (memq cur '(nil *skip*)) + (unless (memq cur '(nil *skip* *error*)) (push cur result))) result)) diff --git a/lisp/simple.el b/lisp/simple.el index 5185607..cf1912a 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1776,6 +1776,7 @@ in this use of the minibuffer.") (defun minibuffer-avoid-prompt (_new _old) "A point-motion hook for the minibuffer, that moves point out of the prompt." + (declare (obsolete cursor-intangible-mode "25.1")) (constrain-to-field nil (point-max))) (defcustom minibuffer-history-case-insensitive-variables nil @@ -4908,7 +4909,7 @@ also checks the value of `use-empty-active-region'." ;; without the mark being set (e.g. bug#17324). We really should fix ;; that problem, but in the mean time, let's make sure we don't say the ;; region is active when there's no mark. - (mark))) + (progn (cl-assert (mark)) t))) (defvar redisplay-unhighlight-region-function @@ -4934,37 +4935,41 @@ also checks the value of `use-empty-active-region'." rol))) (defun redisplay--update-region-highlight (window) - (with-current-buffer (window-buffer window) - (let ((rol (window-parameter window 'internal-region-overlay))) - (if (not (region-active-p)) - (funcall redisplay-unhighlight-region-function rol) - (let* ((pt (window-point window)) - (mark (mark)) - (start (min pt mark)) - (end (max pt mark)) - (new - (funcall redisplay-highlight-region-function - start end window rol))) - (unless (equal new rol) - (set-window-parameter window 'internal-region-overlay - new))))))) - -(defun redisplay--update-region-highlights (windows) - (with-demoted-errors "redisplay--update-region-highlights: %S" + (let ((rol (window-parameter window 'internal-region-overlay))) + (if (not (and (region-active-p) + (or highlight-nonselected-windows + (eq window (selected-window)) + (and (window-minibuffer-p) + (eq window (minibuffer-selected-window)))))) + (funcall redisplay-unhighlight-region-function rol) + (let* ((pt (window-point window)) + (mark (mark)) + (start (min pt mark)) + (end (max pt mark)) + (new + (funcall redisplay-highlight-region-function + start end window rol))) + (unless (equal new rol) + (set-window-parameter window 'internal-region-overlay + new)))))) + +(defvar pre-redisplay-functions (list #'redisplay--update-region-highlight) + "Hook run just before redisplay. +It is called in each window that is to be redisplayed. It takes one argument, +which is the window that will be redisplayed. When run, the `current-buffer' +is set to the buffer displayed in that window.") + +(defun redisplay--pre-redisplay-functions (windows) + (with-demoted-errors "redisplay--pre-redisplay-functions: %S" (if (null windows) - (redisplay--update-region-highlight (selected-window)) - (unless (listp windows) (setq windows (window-list-1 nil nil t))) - (if highlight-nonselected-windows - (mapc #'redisplay--update-region-highlight windows) - (let ((msw (and (window-minibuffer-p) (minibuffer-selected-window)))) - (dolist (w windows) - (if (or (eq w (selected-window)) (eq w msw)) - (redisplay--update-region-highlight w) - (funcall redisplay-unhighlight-region-function - (window-parameter w 'internal-region-overlay))))))))) + (with-current-buffer (window-buffer (selected-window)) + (run-hook-with-args 'pre-redisplay-functions (selected-window))) + (dolist (win (if (listp windows) windows (window-list-1 nil nil t))) + (with-current-buffer (window-buffer win) + (run-hook-with-args 'pre-redisplay-functions win)))))) (add-function :before pre-redisplay-function - #'redisplay--update-region-highlights) + #'redisplay--pre-redisplay-functions) (defvar-local mark-ring nil @@ -7001,6 +7006,8 @@ More precisely, a char with closeparen syntax is self-inserted.") (not executing-kbd-macro) (not noninteractive) ;; Verify an even number of quoting characters precede the close. + ;; FIXME: Also check if this parenthesis closes a comment as + ;; can happen in Pascal and SML. (= 1 (logand 1 (- (point) (save-excursion (forward-char -1) diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index b1aff42..7e961e8 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -544,18 +544,28 @@ With prefix 3, restrict index to region." (setq buffer-read-only nil) (insert (format -"INDEX <%s> on %s + "INDEX <%s> on %s Restriction: <%s> SPC=view TAB=goto RET=goto+hide [e]dit [q]uit [r]escan [f]ollow [?]Help ------------------------------------------------------------------------------ -" index-tag (abbreviate-file-name master) -(if (eq (car (car reftex-index-restriction-data)) 'toc) - (nth 2 (car reftex-index-restriction-data)) - reftex-index-restriction-indicator))) +" + index-tag (abbreviate-file-name master) + (if (eq (car (car reftex-index-restriction-data)) 'toc) + (nth 2 (car reftex-index-restriction-data)) + reftex-index-restriction-indicator))) (if (reftex-use-fonts) - (put-text-property 1 (point) 'face reftex-index-header-face)) - (put-text-property 1 (point) 'intangible t) + (put-text-property (point-min) (point) + 'face reftex-index-header-face)) + (if (fboundp 'cursor-intangible-mode) + (cursor-intangible-mode 1) + ;; If `cursor-intangible' is not available, fallback on the old + ;; intrusive `intangible' property. + (put-text-property (point-min) (point) 'intangible t)) + (add-text-properties (point-min) (point) + '(cursor-intangible t + front-sticky (cursor-intangible) + rear-nonsticky (cursor-intangible))) (reftex-insert-index docstruct index-tag) (goto-char (point-min)) @@ -697,9 +707,10 @@ SPC=view TAB=goto RET=goto+hide [e]dit [q]uit [r]escan [f]ollow [?]Help (defun reftex-index-post-command-hook () ;; Used in the post-command-hook for the *Index* buffer + ;; FIXME: Lots of redundancy with reftex-toc-post-command-hook! (when (get-text-property (point) :data) - (and (> (point) 1) - (not (get-text-property (point) 'intangible)) + (and (> (point) 1) ;FIXME: Is this point-min or do we care about narrowing? + (not (get-text-property (point) 'cursor-intangible)) (memq reftex-highlight-selection '(cursor both)) (reftex-highlight 1 (or (previous-single-property-change (1+ (point)) :data) diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el index 69cab78..085f2d7 100644 --- a/lisp/textmodes/reftex-toc.el +++ b/lisp/textmodes/reftex-toc.el @@ -280,7 +280,15 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help (if (reftex-use-fonts) (put-text-property (point-min) (point) 'font-lock-face reftex-toc-header-face)) - (put-text-property (point-min) (point) 'intangible t) + (if (fboundp 'cursor-intangible-mode) + (cursor-intangible-mode 1) + ;; If `cursor-intangible' is not available, fallback on the old + ;; intrusive `intangible' property. + (put-text-property (point-min) (point) 'intangible t)) + (add-text-properties (point-min) (point) + '(cursor-intangible t + front-sticky (cursor-intangible) + rear-nonsticky (cursor-intangible))) (put-text-property (point-min) (1+ (point-min)) 'xr-alist xr-alist) (setq offset @@ -331,8 +339,8 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help (let ((current-prefix-arg nil)) (select-window (get-buffer-window buf frame)) (reftex-toc nil t))) - (and (> (point) 1) - (not (get-text-property (point) 'intangible)) + (and (> (point) 1) ;FIXME: Is this point-min or do we care about narrowing? + (not (get-text-property (point) 'cursor-intangible)) (memq reftex-highlight-selection '(cursor both)) (reftex-highlight 2 (or (previous-single-property-change @@ -349,10 +357,11 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help (defun reftex-toc-post-command-hook () ;; used in the post-command-hook for the *toc* buffer + ;; FIXME: Lots of redundancy with reftex-index-post-command-hook! (when (get-text-property (point) :data) (put 'reftex-toc :reftex-data (get-text-property (point) :data)) - (and (> (point) 1) - (not (get-text-property (point) 'intangible)) + (and (> (point) 1) ;FIXME: Is this point-min or do we care about narrowing? + (not (get-text-property (point) 'cursor-intangible)) (memq reftex-highlight-selection '(cursor both)) (reftex-highlight 2 (or (previous-single-property-change (1+ (point)) :data) diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 8266647..c71ecb4 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -1,4 +1,4 @@ -;;; sgml-mode.el --- SGML- and HTML-editing modes -*- coding: utf-8 -*- +;;; sgml-mode.el --- SGML- and HTML-editing modes -*- lexical-binding:t -*- ;; Copyright (C) 1992, 1995-1996, 1998, 2001-2015 Free Software ;; Foundation, Inc. @@ -442,7 +442,7 @@ an optional alist of possible values." (comment-style 'plain)) (comment-indent-new-line soft))) -(defun sgml-mode-facemenu-add-face-function (face end) +(defun sgml-mode-facemenu-add-face-function (face _end) (let ((tag-face (cdr (assq face sgml-face-tag-alist)))) (cond (tag-face (setq tag-face (funcall skeleton-transformation-function tag-face)) @@ -844,7 +844,7 @@ Return non-nil if we skipped over matched tags." (defvar sgml-electric-tag-pair-overlays nil) (defvar sgml-electric-tag-pair-timer nil) -(defun sgml-electric-tag-pair-before-change-function (beg end) +(defun sgml-electric-tag-pair-before-change-function (_beg end) (condition-case err (save-excursion (goto-char end) @@ -1012,7 +1012,7 @@ With prefix argument ARG, repeat this ARG times." (or (get 'sgml-tag 'invisible) (setplist 'sgml-tag (append '(invisible t - point-entered sgml-point-entered + cursor-sensor-functions (sgml-cursor-sensor) rear-nonsticky t read-only t) (symbol-plist 'sgml-tag)))) @@ -1020,63 +1020,59 @@ With prefix argument ARG, repeat this ARG times." (defun sgml-tags-invisible (arg) "Toggle visibility of existing tags." (interactive "P") - (let ((modified (buffer-modified-p)) - (inhibit-read-only t) - (inhibit-modification-hooks t) - ;; Avoid spurious the `file-locked' checks. - (buffer-file-name nil) - ;; This is needed in case font lock gets called, - ;; since it moves point and might call sgml-point-entered. - ;; How could it get called? -stef - (inhibit-point-motion-hooks t) + (let ((inhibit-read-only t) string) - (unwind-protect - (save-excursion - (goto-char (point-min)) - (if (setq-local sgml-tags-invisible - (if arg - (>= (prefix-numeric-value arg) 0) - (not sgml-tags-invisible))) - (while (re-search-forward sgml-tag-name-re nil t) - (setq string - (cdr (assq (intern-soft (downcase (match-string 1))) - sgml-display-text))) - (goto-char (match-beginning 0)) - (and (stringp string) - (not (overlays-at (point))) - (let ((ol (make-overlay (point) (match-beginning 1)))) - (overlay-put ol 'before-string string) - (overlay-put ol 'sgml-tag t))) - (put-text-property (point) - (progn (forward-list) (point)) - 'category 'sgml-tag)) - (let ((pos (point-min))) - (while (< (setq pos (next-overlay-change pos)) (point-max)) - (dolist (ol (overlays-at pos)) - (if (overlay-get ol 'sgml-tag) - (delete-overlay ol))))) - (remove-text-properties (point-min) (point-max) '(category nil)))) - (restore-buffer-modified-p modified)) + (with-silent-modifications + (save-excursion + (goto-char (point-min)) + (if (setq-local sgml-tags-invisible + (if arg + (>= (prefix-numeric-value arg) 0) + (not sgml-tags-invisible))) + (while (re-search-forward sgml-tag-name-re nil t) + (setq string + (cdr (assq (intern-soft (downcase (match-string 1))) + sgml-display-text))) + (goto-char (match-beginning 0)) + (and (stringp string) + (not (overlays-at (point))) + (let ((ol (make-overlay (point) (match-beginning 1)))) + (overlay-put ol 'before-string string) + (overlay-put ol 'sgml-tag t))) + (put-text-property (point) + (progn (forward-list) (point)) + 'category 'sgml-tag)) + (let ((pos (point-min))) + (while (< (setq pos (next-overlay-change pos)) (point-max)) + (dolist (ol (overlays-at pos)) + (if (overlay-get ol 'sgml-tag) + (delete-overlay ol))))) + (remove-text-properties (point-min) (point-max) '(category nil))))) + (cursor-sensor-mode (if sgml-tags-invisible 1 -1)) (run-hooks 'sgml-tags-invisible-hook) (message ""))) -(defun sgml-point-entered (x y) - ;; Show preceding or following hidden tag, depending of cursor direction. - (let ((inhibit-point-motion-hooks t)) - (save-excursion - (condition-case nil - (message "Invisible tag: %s" - ;; Strip properties, otherwise, the text is invisible. - (buffer-substring-no-properties - (point) - (if (or (and (> x y) - (not (eq (following-char) ?<))) - (and (< x y) - (eq (preceding-char) ?>))) - (backward-list) - (forward-list)))) - (error nil))))) - +(defun sgml-cursor-sensor (window x dir) + ;; Show preceding or following hidden tag, depending of cursor direction (and + ;; `dir' is not the direction in this sense). + (when (eq dir 'entered) + (ignore-errors + (let* ((y (window-point window)) + (otherend + (save-excursion + (goto-char y) + (cond + ((and (eq (char-before) ?>) + (or (not (eq (char-after) ?<)) + (> x y))) + (backward-sexp)) + ((eq (char-after y) ?<) + (forward-sexp))) + (point)))) + (message "Invisible tag: %s" + ;; Strip properties, otherwise, the text is invisible. + (buffer-substring-no-properties + y otherend)))))) (defun sgml-validate (command) @@ -1158,7 +1154,7 @@ If nil, start from a preceding tag at indentation." ((and state (> (nth 0 state) 0)) (cons 'tag (nth 1 state))) (t (cons 'text text-start)))))) -(defun sgml-beginning-of-tag (&optional top-level) +(defun sgml-beginning-of-tag (&optional only-immediate) "Skip to beginning of tag and return its name. If this can't be done, return nil." (let ((context (sgml-lexical-context))) @@ -1167,7 +1163,7 @@ If this can't be done, return nil." (goto-char (cdr context)) (when (looking-at sgml-tag-name-re) (match-string-no-properties 1))) - (if top-level nil + (if only-immediate nil (when (not (eq (car context) 'text)) (goto-char (cdr context)) (sgml-beginning-of-tag t)))))) @@ -1581,6 +1577,19 @@ LCON is the lexical context, if any." (skip-chars-forward " \t\n") (< (point) here) (sgml-at-indentation-p)) (current-column)) + ;; ;; If the parsing failed, try to recover. + ;; ((and (null context) (bobp) + ;; (not (eq (char-after here) ?<))) + ;; (goto-char here) + ;; (if (and (looking-at "--[ \t\n]*>") + ;; (re-search-backward "