code.delx.au - gnu-emacs-elpa/blob - packages/adaptive-wrap/adaptive-wrap.el

   1 ;;; adaptive-wrap.el --- Smart line-wrapping with wrap-prefix
   2
   3 ;; Copyright (C) 2011-2013  Free Software Foundation, Inc.
   4
   5 ;; Author: Stephen Berman <stephen.berman@gmx.net>
   6 ;;         Stefan Monnier <monnier@iro.umontreal.ca>
   7 ;; Version: 0.5
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; This package provides the `adaptive-wrap-prefix-mode' minor mode which sets
  25 ;; the wrap-prefix property on the fly so that single-long-line paragraphs get
  26 ;; word-wrapped in a way similar to what you'd get with M-q using
  27 ;; adaptive-fill-mode, but without actually changing the buffer's text.
  28
  29 ;;; Code:
  30
  31 (require 'easymenu)
  32
  33 (defcustom adaptive-wrap-extra-indent 0
  34   "Number of extra spaces to indent in `adaptive-wrap-prefix-mode'.
  35
  36 `adaptive-wrap-prefix-mode' indents the visual lines to
  37 the level of the actual line plus `adaptive-wrap-extra-indent'.
  38 A negative value will do a relative de-indent.
  39
  40 Examples:
  41
  42 actual indent = 2
  43 extra indent = -1
  44
  45   Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do
  46  eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut
  47  enim ad minim veniam, quis nostrud exercitation ullamco laboris
  48  nisi ut aliquip ex ea commodo consequat.
  49
  50 actual indent = 2
  51 extra indent = 2
  52
  53   Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do
  54     eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut
  55     enim ad minim veniam, quis nostrud exercitation ullamco laboris
  56     nisi ut aliquip ex ea commodo consequat."
  57   :type 'integer
  58   :group 'visual-line)
  59 (make-variable-buffer-local 'adaptive-wrap-extra-indent)
  60
  61 (defun adaptive-wrap-fill-context-prefix (beg en)
  62   "Like `fill-context-prefix', but with length adjusted by `adaptive-wrap-extra-indent'."
  63   ;; Note: fill-context-prefix may return nil; See:
  64   ;; http://article.gmane.org/gmane.emacs.devel/156285
  65   (let* ((fcp (or (fill-context-prefix beg en) ""))
  66          (fcp-len (string-width fcp))
  67          (fill-char (if (< 0 fcp-len)
  68                         (string-to-char (substring fcp -1))
  69                       ?\ )))
  70     (cond
  71      ((= 0 adaptive-wrap-extra-indent)
  72       fcp)
  73      ((< 0 adaptive-wrap-extra-indent)
  74       (concat fcp
  75               (make-string adaptive-wrap-extra-indent fill-char)))
  76      ((< 0 (+ adaptive-wrap-extra-indent fcp-len))
  77       (substring fcp
  78                  0
  79                  (+ adaptive-wrap-extra-indent fcp-len)))
  80      (t
  81       ""))))
  82
  83 (defun adaptive-wrap-prefix-function (beg end)
  84   "Indent the region between BEG and END with adaptive filling."
  85   (goto-char beg)
  86   (while (< (point) end)
  87     (let ((lbp (line-beginning-position)))
  88       (put-text-property (point)
  89                          (progn (search-forward "\n" end 'move) (point))
  90                          'wrap-prefix
  91                          (adaptive-wrap-fill-context-prefix lbp (point))))))
  92
  93 ;;;###autoload
  94 (define-minor-mode adaptive-wrap-prefix-mode
  95   "Wrap the buffer text with adaptive filling."
  96   :lighter ""
  97   :group 'visual-line
  98   (if adaptive-wrap-prefix-mode
  99       (progn
 100         ;; HACK ATTACK!  We need to run after font-lock, but jit-lock-register
 101         ;; doesn't accept an `append' argument, so we add ourselves beforehand,
 102         ;; to make sure we're at the end of the hook (bug#15155).
 103         (add-hook 'jit-lock-functions
 104                   #'adaptive-wrap-prefix-function 'append t)
 105         (jit-lock-register #'adaptive-wrap-prefix-function))
 106     (jit-lock-unregister #'adaptive-wrap-prefix-function)
 107     (with-silent-modifications
 108       (save-restriction
 109         (widen)
 110         (remove-text-properties (point-min) (point-max) '(wrap-prefix nil))))))
 111
 112 (define-key-after (lookup-key menu-bar-options-menu [line-wrapping])
 113   [adaptive-wrap]
 114   '(menu-item "Adaptive Wrap" adaptive-wrap-prefix-mode
 115               :visible (menu-bar-menu-frame-live-and-visible-p)
 116               :help "Show wrapped long lines with an adjustable prefix"
 117               :button (:toggle . (bound-and-true-p adaptive-wrap-prefix-mode)))
 118   word-wrap)
 119
 120 (provide 'adaptive-wrap)
 121 ;;; adaptive-wrap.el ends here