3 files changed, 226 insertions, 0 deletions

diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi
index f64b3995d25..a6b71db4bea 100644
--- a/doc/emacs/basic.texi
+++ b/doc/emacs/basic.texi
@@ -630,6 +630,17 @@ before they get too long, by inserting newlines.  If you prefer, you
 can make Emacs insert a newline automatically when a line gets too
 long, by using Auto Fill mode.  @xref{Filling}.
 
+@cindex continuation lines, wrapping with prefix
+@findex visual-wrap-prefix-mode
+  Normally, the first character of each continuation line is
+positioned at the beginning of the screen line where it is displayed.
+The minor mode @code{visual-wrap-prefix-mode} arranges that
+continuation lines be prefixed by slightly adjusted versions of the
+fill prefixes (@pxref{Fill Prefix}) of their respective logical lines,
+so that indentation characters or the prefixes of source code comments
+are replicated across every continuation line, and the appearance of
+such comments or indentation is not broken.
+
   Sometimes, you may need to edit files containing many long logical
 lines, and it may not be practical to break them all up by adding
 newlines.  In that case, you can use Visual Line mode, which enables
diff --git a/etc/NEWS b/etc/NEWS
index 37264f2f1f1..37a017c4db1 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -318,6 +318,18 @@ name detection.
 * Editing Changes in Emacs 30.1
 
 +++
+** New minor mode 'visual-wrap-prefix-mode'.
+
+When enabled, continuation lines displayed for a folded long line will
+receive a 'wrap-prefix' automatically computed from the line's
+surrounding context by the function 'fill-context-prefix', which
+generally indents continuation lines as if the line were filled with
+'M-q', or similar.
+
+This minor mode is the 'adaptive-wrap' ELPA package renamed and
+lightly edited for inclusion in Emacs.
+
++++
 ** New user option 'gud-highlight-current-line'.
 When enabled, Gud will visually emphasize the line being executed upon
 pauses in the debugee's execution, such as those occasioned by
diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el
new file mode 100644
index 00000000000..9f52a1868c1
--- /dev/null
+++ b/lisp/visual-wrap.el
@@ -0,0 +1,203 @@
+;;; visual-wrap.el --- Smart line-wrapping with wrap-prefix
+
+;; Copyright (C) 2011-2021, 2024 Free Software Foundation, Inc.
+
+;; Author: Stephen Berman <stephen.berman@gmx.net>
+;;         Stefan Monnier <monnier@iro.umontreal.ca>
+;; Maintainer: emacs-devel@gnu.org
+;; Keywords: convenience
+;; Package: emacs
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package provides the `visual-wrap-prefix-mode' minor mode
+;; which sets the wrap-prefix property on the fly so that
+;; single-long-line paragraphs get word-wrapped in a way similar to
+;; what you'd get with M-q using visual-fill-mode, but without
+;; actually changing the buffer's text.
+
+;;; Code:
+
+(defcustom visual-wrap-extra-indent 0
+  "Number of extra spaces to indent in `visual-wrap-prefix-mode'.
+
+`visual-wrap-prefix-mode' indents the visual lines to the level
+of the actual line plus `visual-wrap-extra-indent'.  A negative
+value will do a relative de-indent.
+
+Examples:
+
+actual indent = 2
+extra indent = -1
+
+  Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed
+ do eiusmod tempor incididunt ut labore et dolore magna
+ aliqua. Ut enim ad minim veniam, quis nostrud exercitation
+ ullamco laboris nisi ut aliquip ex ea commodo consequat.
+
+actual indent = 2
+extra indent = 2
+
+  Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed
+    do eiusmod tempor incididunt ut labore et dolore magna
+    aliqua. Ut enim ad minim veniam, quis nostrud exercitation
+    ullamco laboris nisi ut aliquip ex ea commodo consequat."
+  :type 'integer
+  :safe 'integerp
+  :group 'visual-line)
+
+(defun visual-wrap--face-extend-p (face)
+  ;; Before Emacs 27, faces always extended beyond EOL, so we check
+  ;; for a non-default background instead.
+  (cond
+   ((listp face)
+    (plist-get face (if (fboundp 'face-extend-p) :extend :background)))
+   ((symbolp face)
+    (if (fboundp 'face-extend-p)
+        (face-extend-p face nil t)
+      (face-background face nil t)))))
+
+(defun visual-wrap--prefix-face (fcp _beg end)
+  ;; If the fill-context-prefix already specifies a face, just use that.
+  (cond ((get-text-property 0 'face fcp))
+        ;; Else, if the last character is a newline and has a face
+        ;; that extends beyond EOL, assume that this face spans the
+        ;; whole line and apply it to the prefix to preserve the
+        ;; "block" visual effect.
+        ;;
+        ;; NB: the face might not actually span the whole line: see
+        ;; for example removed lines in diff-mode, where the first
+        ;; character has the diff-indicator-removed face, while the
+        ;; rest of the line has the diff-removed face.
+        ((= (char-before end) ?\n)
+         (let ((eol-face (get-text-property (1- end) 'face)))
+           ;; `eol-face' can be a face, a "face value"
+           ;; (plist of face properties) or a list of one of those.
+           (if (or (not (consp eol-face)) (keywordp (car eol-face)))
+               ;; A single face.
+               (if (visual-wrap--face-extend-p eol-face) eol-face)
+             ;; A list of faces.  Keep the ones that extend beyond EOL.
+             (delq nil (mapcar (lambda (f)
+                                 (if (visual-wrap--face-extend-p f) f))
+                               eol-face)))))))
+
+(defun visual-wrap--prefix (fcp)
+  (let ((fcp-len (string-width fcp)))
+    (cond
+     ((= 0 visual-wrap-extra-indent)
+      fcp)
+     ((< 0 visual-wrap-extra-indent)
+      (concat fcp (make-string visual-wrap-extra-indent ?\s)))
+     ((< 0 (+ visual-wrap-extra-indent fcp-len))
+      (substring fcp
+                 0
+                 (+ visual-wrap-extra-indent fcp-len)))
+     (t
+      ""))))
+
+(defun visual-wrap-fill-context-prefix (beg end)
+  "Like `fill-context-prefix', but with length adjusted by
+`visual-wrap-extra-indent'."
+  (let* ((fcp
+          ;; `fill-context-prefix' ignores prefixes that look like
+          ;; paragraph starts, in order to avoid inadvertently
+          ;; creating a new paragraph while filling, but here we're
+          ;; only dealing with single-line "paragraphs" and we don't
+          ;; actually modify the buffer, so this restriction doesn't
+          ;; make much sense (and is positively harmful in
+          ;; taskpaper-mode where paragraph-start matches everything).
+          (or (let ((paragraph-start "\\`\\'a"))
+                    (fill-context-prefix beg end))
+                  ;; Note: fill-context-prefix may return nil; See:
+                  ;; http://article.gmane.org/gmane.emacs.devel/156285
+              ""))
+         (prefix (visual-wrap--prefix fcp))
+         (face (visual-wrap--prefix-face fcp beg end)))
+    (if face
+        (propertize prefix 'face face)
+      prefix)))
+
+(defun visual-wrap-prefix-function (beg end)
+  "Indent the region between BEG and END with visual filling."
+  ;; Any change at the beginning of a line might change its wrap
+  ;; prefix, which affects the whole line.  So we need to "round-up"
+  ;; `end' to the nearest end of line.  We do the same with `beg'
+  ;; although it's probably not needed.
+  (goto-char end)
+  (unless (bolp) (forward-line 1))
+  (setq end (point))
+  (goto-char beg)
+  (forward-line 0)
+  (setq beg (point))
+  (while (< (point) end)
+    (let ((lbp (point)))
+      (put-text-property
+       (point) (progn (search-forward "\n" end 'move) (point))
+       'wrap-prefix
+       (let ((pfx (visual-wrap-fill-context-prefix
+                   lbp (point))))
+         ;; Remove any `wrap-prefix' property that might have been
+         ;; added earlier.  Otherwise, we end up with a string
+         ;; containing a `wrap-prefix' string containing a
+         ;; `wrap-prefix' string ...
+         (remove-text-properties
+          0 (length pfx) '(wrap-prefix) pfx)
+         (let ((dp (get-text-property 0 'display pfx)))
+           (when (and dp (eq dp (get-text-property (1- lbp) 'display)))
+             ;; There's a `display' property which covers not just the
+             ;; prefix but also the previous newline.  So it's not
+             ;; just making the prefix more pretty and could interfere
+             ;; or even defeat our efforts (e.g. it comes from
+             ;; `visual-fill-mode').
+             (remove-text-properties
+              0 (length pfx) '(display) pfx)))
+         pfx))))
+  `(jit-lock-bounds ,beg . ,end))
+
+;;;###autoload
+(define-minor-mode visual-wrap-prefix-mode
+  "Wrap the buffer text with visual filling."
+  :lighter ""
+  :group 'visual-line
+  (if visual-wrap-prefix-mode
+      (progn
+        ;; HACK ATTACK!  We want to run after font-lock (so our
+        ;; wrap-prefix includes the faces applied by font-lock), but
+        ;; jit-lock-register doesn't accept an `append' argument, so
+        ;; we add ourselves beforehand, to make sure we're at the end
+        ;; of the hook (bug#15155).
+        (add-hook 'jit-lock-functions
+                  #'visual-wrap-prefix-function 'append t)
+        (jit-lock-register #'visual-wrap-prefix-function))
+    (jit-lock-unregister #'visual-wrap-prefix-function)
+    (with-silent-modifications
+      (save-restriction
+        (widen)
+        (remove-text-properties (point-min) (point-max) '(wrap-prefix nil))))))
+
+;;;###autoload
+(define-key-after (lookup-key menu-bar-options-menu [line-wrapping])
+  [visual-wrap]
+  '(menu-item "Visual Wrap" visual-wrap-prefix-mode
+              :visible (menu-bar-menu-frame-live-and-visible-p)
+              :help "Display continuation lines with prefix derived from context"
+              :button (:toggle . (bound-and-true-p visual-wrap-prefix-mode)))
+  word-wrap)
+
+(provide 'visual-wrap)
+;;; visual-wrap.el ends here