diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 5860bac..e7bd06e 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1719,6 +1719,12 @@ logical lines, so having a fringe indicator for each wrapped line would be visually distracting. You can change this by customizing the variable @code{visual-line-fringe-indicators}. +@vindex word-wrap-chars + Word boundaries and hence points at which word wrap can occur are, +by default, considered to occur on the space and tab characters. If +you prefer word-wrap to be permissible at other characters, you can +change the value of the char-table @code{word-wrap-chars}. + @node Display Custom @section Customization of Display diff --git a/etc/NEWS b/etc/NEWS index cbd50f0..a87eabc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -60,6 +60,12 @@ state to take effect (making a frame visible, for example). whether '"' is also replaced in 'electric-quote-mode'. If non-nil, '"' is replaced by a double typographic quote. ++++ +** The characters at which word-wrapping occurs can now be controlled +using the new `word-wrap-chars' char-table. If `word-wrap-chars' is +nil (the default), then word-wrapping will occur only on the space or +tab characters, as has been the case until now. + * Changes in Specialized Modes and Packages in Emacs 27.1 diff --git a/src/buffer.c b/src/buffer.c index 12a467d..3e260bb 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5730,7 +5730,11 @@ Instead of setting this variable directly, most users should use Visual Line mode. Visual Line mode, when enabled, sets `word-wrap' to t, and additionally redefines simple editing commands to act on visual lines rather than logical lines. See the documentation of -`visual-line-mode'. */); +`visual-line-mode'. + +If `word-wrap-chars' is non-nil and a char-table, continuation lines +are wrapped on the characters in `word-wrap-chars' whose value is t, +rather than the space and tab characters. */); DEFVAR_PER_BUFFER ("default-directory", &BVAR (current_buffer, directory), Qstringp, diff --git a/src/character.c b/src/character.c index c8ffa2b..fd1a9d3 100644 --- a/src/character.c +++ b/src/character.c @@ -1145,4 +1145,10 @@ All Unicode characters have one of the following values (symbol): See The Unicode Standard for the meaning of those values. */); /* The correct char-table is setup in characters.el. */ Vunicode_category_table = Qnil; + + DEFVAR_LISP ("word-wrap-chars", Vword_wrap_chars, + doc: /* A char-table for characters at which word-wrap occurs. +Such characters have value t in this table. If the char-table is nil, +word-wrap occurs only on space and tab. */); + Vword_wrap_chars = Qnil; } diff --git a/src/xdisp.c b/src/xdisp.c index 7e47c06..dca0726 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -348,20 +348,42 @@ static Lisp_Object list_of_error; #endif /* HAVE_WINDOW_SYSTEM */ /* Test if the display element loaded in IT, or the underlying buffer - or string character, is a space or a TAB character. This is used - to determine where word wrapping can occur. */ + or string character, is a space or tab (by default, to avoid the + unnecessary performance hit of char-table lookup). If + word-wrap-chars is a char-table, then instead check if the relevant + element or character belongs to the char-table. This is used to + determine where word wrapping can occur. */ #define IT_DISPLAYING_WHITESPACE(it) \ - ((it->what == IT_CHARACTER && (it->c == ' ' || it->c == '\t')) \ - || ((STRINGP (it->string) \ - && (SREF (it->string, IT_STRING_BYTEPOS (*it)) == ' ' \ - || SREF (it->string, IT_STRING_BYTEPOS (*it)) == '\t')) \ - || (it->s \ - && (it->s[IT_BYTEPOS (*it)] == ' ' \ - || it->s[IT_BYTEPOS (*it)] == '\t')) \ - || (IT_BYTEPOS (*it) < ZV_BYTE \ - && (*BYTE_POS_ADDR (IT_BYTEPOS (*it)) == ' ' \ - || *BYTE_POS_ADDR (IT_BYTEPOS (*it)) == '\t')))) \ + (!CHAR_TABLE_P (Vword_wrap_chars) \ + ? ((it->what == IT_CHARACTER && (it->c == ' ' || it->c == '\t')) \ + || ((STRINGP (it->string) \ + && (SREF (it->string, IT_STRING_BYTEPOS (*it)) == ' ' \ + || SREF (it->string, IT_STRING_BYTEPOS (*it)) == '\t')) \ + || (it->s \ + && (it->s[IT_BYTEPOS (*it)] == ' ' \ + || it->s[IT_BYTEPOS (*it)] == '\t')) \ + || (IT_BYTEPOS (*it) < ZV_BYTE \ + && (*BYTE_POS_ADDR (IT_BYTEPOS (*it)) == ' ' \ + || *BYTE_POS_ADDR (IT_BYTEPOS (*it)) == '\t')))) \ + : it_displaying_word_wrap_char(it)) \ + +static inline bool +char_is_word_wrap_char_p (int c) { + return !NILP (CHAR_TABLE_REF (Vword_wrap_chars, c)); +} + +static inline bool +it_displaying_word_wrap_char (struct it *it) { + return ((it->what == IT_CHARACTER && char_is_word_wrap_char_p (it->c)) + || (STRINGP (it->string) && char_is_word_wrap_char_p + (STRING_CHAR + (SDATA (it->string) + IT_STRING_BYTEPOS (*it)))) + || (it->s && char_is_word_wrap_char_p + (STRING_CHAR(it->s + IT_BYTEPOS (*it)))) + || (IT_BYTEPOS (*it) < ZV_BYTE && char_is_word_wrap_char_p + (FETCH_CHAR (IT_BYTEPOS (*it))))); +} /* True means print newline to stdout before next mini-buffer message. */ diff --git a/test/manual/word-wrap-test.el b/test/manual/word-wrap-test.el new file mode 100644 index 0000000..2df3886 --- /dev/null +++ b/test/manual/word-wrap-test.el @@ -0,0 +1,127 @@ +;;; word-wrap-test.el -- tests for word-wrap -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Run the tests M-x word-wrap-test-[1-4] which correspond to the four +;; combinations: +;; +;; i) whitespace-mode being enabled and disabled, +;; +;; ii) word-wrap-chars being nil and equal to a char-table that +;; specifies U-200B as the only word-wrap character. +;; +;; The tests with whitespace-mode are needed to help avoid a +;; regression on Bug#11341. + +;;; Code: + +(setq whitespace-display-mappings-for-zero-width-space + '((space-mark 32 + [183] + [46]) + (space-mark 160 + [164] + [95]) + (space-mark 8203 + [164] + [95]) + (newline-mark 10 + [36 10]) + (tab-mark 9 + [187 9] + [92 9]))) + +(defun word-wrap-test-1 () + "Check word-wrap for nil `word-wrap-chars'." + (interactive) + (let ((buf (get-buffer-create "*Word-wrap Test 1*"))) + (with-current-buffer buf + (erase-buffer) + (insert "Word wrap should occur for space.\n\n") + (dotimes (i 100) + (insert "1234567 ")) ; Space + (insert "\n\nWord wrap should NOT occur for U-200B.\n\n") + (dotimes (i 100) + (insert "1234567​")) ; U-200B + (setq word-wrap t) + (setq-local word-wrap-chars nil) + (whitespace-mode -1) + (display-buffer buf)))) + +(defun word-wrap-test-2 () + "Check word-wrap for nil `word-wrap-chars' with whitespace-mode." + (interactive) + (let ((buf (get-buffer-create "*Word-wrap Test 2*"))) + (with-current-buffer buf + (erase-buffer) + (insert "Word wrap should occur for space (displayed as `·').\n\n") + (dotimes (i 100) + (insert "1234567 ")) ; Space + (insert "\n\nWord wrap should NOT occur for U-200B (displayed as `¤').\n\n") + (dotimes (i 100) + (insert "1234567​")) ; U-200B + (setq word-wrap t) + (setq-local word-wrap-chars nil) + (setq-local whitespace-display-mappings + whitespace-display-mappings-for-zero-width-space) + (whitespace-mode) + (display-buffer buf)))) + +(defun word-wrap-test-3 () + "Check word-wrap if `word-wrap-chars' is a char-table." + (interactive) + (let ((buf (get-buffer-create "*Word-wrap Test 3*"))) + (with-current-buffer buf + (erase-buffer) + (insert "Word wrap should NOT occur for space.\n\n") + (dotimes (i 100) + (insert "1234567 ")) ; Space + (insert "\n\nWord wrap should occur for U-200B.\n\n") + (dotimes (i 100) + (insert "1234567​")) ; U-200B + (setq word-wrap t) + (setq-local word-wrap-chars + (let ((ct (make-char-table nil nil))) + (set-char-table-range ct 8203 t) + ct)) + (whitespace-mode -1) + (display-buffer buf)))) + +(defun word-wrap-test-4 () + "Check word-wrap if `word-wrap-chars' is a char-table, for whitespace-mode." + (interactive) + (let ((buf (get-buffer-create "*Word-wrap Test 4*"))) + (with-current-buffer buf + (erase-buffer) + (insert "Word wrap should NOT occur for space (displayed as `·').\n\n") + (dotimes (i 100) + (insert "1234567 ")) ; Space + (insert "\n\nWord wrap should occur for U-200B (displayed as `¤').\n\n") + (dotimes (i 100) + (insert "1234567​")) ; U-200B + (setq word-wrap t) + (setq-local word-wrap-chars + (let ((ct (make-char-table nil nil))) + (set-char-table-range ct 8203 t) + ct)) + (setq-local whitespace-display-mappings + whitespace-display-mappings-for-zero-width-space) + (whitespace-mode) + (display-buffer buf))))