adaptive-wrap-0.8.tar

adaptive-wrap-0.8/0000775000175000017500000000000014051364140012613 5ustar  kimrkimradaptive-wrap-0.8/adaptive-wrap-pkg.el0000664000175000017500000000060314051364140016457 0ustar  kimrkimr;; Generated package description from adaptive-wrap.el  -*- no-byte-compile: t -*-
(define-package "adaptive-wrap" "0.8" "Smart line-wrapping with wrap-prefix" 'nil :url "https://elpa.gnu.org/packages/adaptive-wrap.html" :authors '(("Stephen Berman" . "stephen.berman@gmx.net") ("Stefan Monnier" . "monnier@iro.umontreal.ca")) :maintainer '("Stephen Berman" . "stephen.berman@gmx.net"))
adaptive-wrap-0.8/adaptive-wrap.el0000664000175000017500000001746514023021756015720 0ustar  kimrkimr;;; adaptive-wrap.el --- Smart line-wrapping with wrap-prefix

;; Copyright (C) 2011-2021  Free Software Foundation, Inc.

;; Author: Stephen Berman <stephen.berman@gmx.net>
;;         Stefan Monnier <monnier@iro.umontreal.ca>
;; Version: 0.8

;; 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 `adaptive-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
;; adaptive-fill-mode, but without actually changing the buffer's text.

;;; Code:

(defcustom adaptive-wrap-extra-indent 0
  "Number of extra spaces to indent in `adaptive-wrap-prefix-mode'.

`adaptive-wrap-prefix-mode' indents the visual lines to
the level of the actual line plus `adaptive-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 adaptive-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 adaptive-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 (adaptive-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 (adaptive-wrap--face-extend-p f) f))
                               eol-face)))))))

(defun adaptive-wrap--prefix (fcp)
  (let ((fcp-len (string-width fcp)))
    (cond
     ((= 0 adaptive-wrap-extra-indent)
      fcp)
     ((< 0 adaptive-wrap-extra-indent)
      (concat fcp (make-string adaptive-wrap-extra-indent ?\s)))
     ((< 0 (+ adaptive-wrap-extra-indent fcp-len))
      (substring fcp
                 0
                 (+ adaptive-wrap-extra-indent fcp-len)))
     (t
      ""))))

(defun adaptive-wrap-fill-context-prefix (beg end)
  "Like `fill-context-prefix', but with length adjusted by `adaptive-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 (adaptive-wrap--prefix fcp))
         (face (adaptive-wrap--prefix-face fcp beg end)))
    (if face
        (propertize prefix 'face face)
      prefix)))

(defun adaptive-wrap-prefix-function (beg end)
  "Indent the region between BEG and END with adaptive 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 (adaptive-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 adaptive-wrap-prefix-mode
  "Wrap the buffer text with adaptive filling."
  :lighter ""
  :group 'visual-line
  (if adaptive-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
                  #'adaptive-wrap-prefix-function 'append t)
        (jit-lock-register #'adaptive-wrap-prefix-function))
    (jit-lock-unregister #'adaptive-wrap-prefix-function)
    (with-silent-modifications
      (save-restriction
        (widen)
        (remove-text-properties (point-min) (point-max) '(wrap-prefix nil))))))

(define-key-after (lookup-key menu-bar-options-menu [line-wrapping])
  [adaptive-wrap]
  '(menu-item "Adaptive Wrap" adaptive-wrap-prefix-mode
	      :visible (menu-bar-menu-frame-live-and-visible-p)
	      :help "Show wrapped long lines with an adjustable prefix"
	      :button (:toggle . (bound-and-true-p adaptive-wrap-prefix-mode)))
  word-wrap)

(provide 'adaptive-wrap)
;;; adaptive-wrap.el ends here