lisp/longlines.el

   1 ;;; longlines.el --- automatically wrap long lines   -*- coding:utf-8 -*-
   2
   3 ;; Copyright (C) 2000-2001, 2004-2013 Free Software Foundation, Inc.
   4
   5 ;; Authors:    Kai Grossjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
   6 ;;             Alex Schroeder <alex@gnu.org>
   7 ;;             Chong Yidong <cyd@stupidchicken.com>
   8 ;; Maintainer: Chong Yidong <cyd@stupidchicken.com>
   9 ;; Keywords: convenience, wp
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27
  28 ;; Some text editors save text files with long lines, and they
  29 ;; automatically break these lines at whitespace, without actually
  30 ;; inserting any newline characters.  When doing `M-q' in Emacs, you
  31 ;; are inserting newline characters.  Longlines mode provides a file
  32 ;; format which wraps the long lines when reading a file and unwraps
  33 ;; the lines when saving the file.  It can also wrap and unwrap
  34 ;; automatically as editing takes place.
  35
  36 ;; Special thanks to Rod Smith for many useful bug reports.
  37
  38 ;;; Code:
  39
  40 (defgroup longlines nil
  41   "Automatic wrapping of long lines when loading files."
  42   :group 'fill)
  43
  44 (defcustom longlines-auto-wrap t
  45   "Non-nil means long lines are automatically wrapped after each command.
  46 Otherwise, you can perform filling using `fill-paragraph' or
  47 `auto-fill-mode'.  In any case, the soft newlines will be removed
  48 when the file is saved to disk."
  49   :group 'longlines
  50   :type 'boolean)
  51
  52 (defcustom longlines-wrap-follows-window-size nil
  53   "Non-nil means wrapping and filling happen at the edge of the window.
  54 Otherwise, `fill-column' is used, regardless of the window size.  This
  55 does not work well when the buffer is displayed in multiple windows
  56 with differing widths.
  57
  58 If the value is an integer, that specifies the distance from the
  59 right edge of the window at which wrapping occurs.  For any other
  60 non-nil value, wrapping occurs 2 characters from the right edge."
  61   :group 'longlines
  62   :type 'boolean)
  63
  64 (defcustom longlines-show-hard-newlines nil
  65   "Non-nil means each hard newline is marked on the screen.
  66 \(The variable `longlines-show-effect' controls what they look like.)
  67 You can also enable the display temporarily, using the command
  68 `longlines-show-hard-newlines'."
  69   :group 'longlines
  70   :type 'boolean)
  71
  72 (defcustom longlines-show-effect (propertize "¶\n" 'face 'escape-glyph)
  73   "A string to display when showing hard newlines.
  74 This is used when `longlines-show-hard-newlines' is on."
  75   :group 'longlines
  76   :type 'string)
  77
  78 ;; Internal variables
  79
  80 (defvar longlines-wrap-beg nil)
  81 (defvar longlines-wrap-end nil)
  82 (defvar longlines-wrap-point nil)
  83 (defvar longlines-showing nil)
  84 (defvar longlines-decoded nil)
  85
  86 (make-variable-buffer-local 'longlines-wrap-beg)
  87 (make-variable-buffer-local 'longlines-wrap-end)
  88 (make-variable-buffer-local 'longlines-wrap-point)
  89 (make-variable-buffer-local 'longlines-showing)
  90 (make-variable-buffer-local 'longlines-decoded)
  91
  92 ;; Mode
  93
  94 (defvar message-indent-citation-function)
  95
  96 ;;;###autoload
  97 (define-minor-mode longlines-mode
  98   "Toggle Long Lines mode in this buffer.
  99 With a prefix argument ARG, enable Long Lines mode if ARG is
 100 positive, and disable it otherwise.  If called from Lisp, enable
 101 the mode if ARG is omitted or nil.
 102
 103 When Long Lines mode is enabled, long lines are wrapped if they
 104 extend beyond `fill-column'.  The soft newlines used for line
 105 wrapping will not show up when the text is yanked or saved to
 106 disk.
 107
 108 If the variable `longlines-auto-wrap' is non-nil, lines are
 109 automatically wrapped whenever the buffer is changed.  You can
 110 always call `fill-paragraph' to fill individual paragraphs.
 111
 112 If the variable `longlines-show-hard-newlines' is non-nil, hard
 113 newlines are indicated with a symbol."
 114   :group 'longlines :lighter " ll"
 115   (if longlines-mode
 116       ;; Turn on longlines mode
 117       (progn
 118         (use-hard-newlines 1 'never)
 119         (set (make-local-variable 'require-final-newline) nil)
 120         (add-to-list 'buffer-file-format 'longlines)
 121         (add-hook 'change-major-mode-hook 'longlines-mode-off nil t)
 122         (add-hook 'before-revert-hook 'longlines-before-revert-hook nil t)
 123         (make-local-variable 'buffer-substring-filters)
 124         (make-local-variable 'longlines-auto-wrap)
 125         (set (make-local-variable 'isearch-search-fun-function)
 126              'longlines-search-function)
 127         (set (make-local-variable 'replace-search-function)
 128              'longlines-search-forward)
 129         (set (make-local-variable 'replace-re-search-function)
 130              'longlines-re-search-forward)
 131         (add-to-list 'buffer-substring-filters 'longlines-encode-string)
 132         (when longlines-wrap-follows-window-size
 133           (let ((dw (if (and (integerp longlines-wrap-follows-window-size)
 134                              (>= longlines-wrap-follows-window-size 0)
 135                              (< longlines-wrap-follows-window-size
 136                                 (window-width)))
 137                         longlines-wrap-follows-window-size
 138                       2)))
 139             (set (make-local-variable 'fill-column)
 140                  (- (window-width) dw)))
 141           (add-hook 'window-configuration-change-hook
 142                     'longlines-window-change-function nil t))
 143         (let ((buffer-undo-list t)
 144               (inhibit-read-only t)
 145               (after-change-functions nil)
 146               (mod (buffer-modified-p))
 147               buffer-file-name buffer-file-truename)
 148           ;; Turning off undo is OK since (spaces + newlines) is
 149           ;; conserved, except for a corner case in
 150           ;; longlines-wrap-lines that we'll never encounter from here
 151           (save-restriction
 152             (widen)
 153             (unless longlines-decoded
 154               (longlines-decode-buffer)
 155               (setq longlines-decoded t))
 156             (longlines-wrap-region (point-min) (point-max)))
 157           (set-buffer-modified-p mod))
 158         (when (and longlines-show-hard-newlines
 159                    (not longlines-showing))
 160           (longlines-show-hard-newlines))
 161
 162         ;; Hacks to make longlines play nice with various modes.
 163         (cond ((eq major-mode 'mail-mode)
 164                (add-hook 'mail-setup-hook 'longlines-decode-buffer nil t)
 165                (or mail-citation-hook
 166                    (add-hook 'mail-citation-hook 'mail-indent-citation nil t))
 167                (add-hook 'mail-citation-hook 'longlines-decode-region nil t))
 168               ((eq major-mode 'message-mode)
 169                (add-hook 'message-setup-hook 'longlines-decode-buffer nil t)
 170                (make-local-variable 'message-indent-citation-function)
 171                (if (not (listp message-indent-citation-function))
 172                    (setq message-indent-citation-function
 173                          (list message-indent-citation-function)))
 174                (add-to-list 'message-indent-citation-function
 175                             'longlines-decode-region t)))
 176
 177         (add-hook 'after-change-functions 'longlines-after-change-function nil t)
 178         (add-hook 'post-command-hook 'longlines-post-command-function nil t)
 179         (when longlines-auto-wrap
 180           (auto-fill-mode 0)))
 181     ;; Turn off longlines mode
 182     (setq buffer-file-format (delete 'longlines buffer-file-format))
 183     (if longlines-showing
 184         (longlines-unshow-hard-newlines))
 185     (let ((buffer-undo-list t)
 186           (after-change-functions nil)
 187           (inhibit-read-only t)
 188           buffer-file-name buffer-file-truename)
 189       (if longlines-decoded
 190           (save-restriction
 191             (widen)
 192             (longlines-encode-region (point-min) (point-max))
 193             (setq longlines-decoded nil))))
 194     (remove-hook 'change-major-mode-hook 'longlines-mode-off t)
 195     (remove-hook 'after-change-functions 'longlines-after-change-function t)
 196     (remove-hook 'post-command-hook 'longlines-post-command-function t)
 197     (remove-hook 'before-revert-hook 'longlines-before-revert-hook t)
 198     (remove-hook 'window-configuration-change-hook
 199                  'longlines-window-change-function t)
 200     (when longlines-wrap-follows-window-size
 201       (kill-local-variable 'fill-column))
 202     (kill-local-variable 'isearch-search-fun-function)
 203     (kill-local-variable 'replace-search-function)
 204     (kill-local-variable 'replace-re-search-function)
 205     (kill-local-variable 'require-final-newline)
 206     (kill-local-variable 'buffer-substring-filters)
 207     (kill-local-variable 'use-hard-newlines)))
 208
 209 (defun longlines-mode-off ()
 210   "Turn off longlines mode.
 211 This function exists to be called by `change-major-mode-hook' when the
 212 major mode changes."
 213   (longlines-mode 0))
 214
 215 ;; Showing the effect of hard newlines in the buffer
 216
 217 (defun longlines-show-hard-newlines (&optional arg)
 218   "Make hard newlines visible by adding a face.
 219 With optional argument ARG, make the hard newlines invisible again."
 220   (interactive "P")
 221     (if arg
 222         (longlines-unshow-hard-newlines)
 223       (setq longlines-showing t)
 224       (longlines-show-region (point-min) (point-max))))
 225
 226 (defun longlines-show-region (beg end)
 227   "Make hard newlines between BEG and END visible."
 228   (let* ((pmin (min beg end))
 229          (pmax (max beg end))
 230          (pos (text-property-not-all pmin pmax 'hard nil))
 231          (mod (buffer-modified-p))
 232          (buffer-undo-list t)
 233          (inhibit-read-only t)
 234          (inhibit-modification-hooks t)
 235          buffer-file-name buffer-file-truename)
 236     (while pos
 237       (put-text-property pos (1+ pos) 'display
 238                          (copy-sequence longlines-show-effect))
 239       (setq pos (text-property-not-all (1+ pos) pmax 'hard nil)))
 240     (restore-buffer-modified-p mod)))
 241
 242 (defun longlines-unshow-hard-newlines ()
 243   "Make hard newlines invisible again."
 244   (interactive)
 245   (setq longlines-showing nil)
 246   (let ((pos (text-property-not-all (point-min) (point-max) 'hard nil))
 247         (mod (buffer-modified-p))
 248         (buffer-undo-list t)
 249         (inhibit-read-only t)
 250         (inhibit-modification-hooks t)
 251         buffer-file-name buffer-file-truename)
 252     (while pos
 253       (remove-text-properties pos (1+ pos) '(display))
 254       (setq pos (text-property-not-all (1+ pos) (point-max) 'hard nil)))
 255     (restore-buffer-modified-p mod)))
 256
 257 ;; Wrapping the paragraphs.
 258
 259 (defun longlines-wrap-region (beg end)
 260   "Wrap each successive line, starting with the line before BEG.
 261 Stop when we reach lines after END that don't need wrapping, or the
 262 end of the buffer."
 263   (let ((mod (buffer-modified-p)))
 264     (setq longlines-wrap-point (point))
 265     (goto-char beg)
 266     (forward-line -1)
 267     ;; Two successful longlines-wrap-line's in a row mean successive
 268     ;; lines don't need wrapping.
 269     (while (null (and (longlines-wrap-line)
 270                       (or (eobp)
 271                           (and (>= (point) end)
 272                                (longlines-wrap-line))))))
 273     (goto-char longlines-wrap-point)
 274     (set-buffer-modified-p mod)))
 275
 276 (defun longlines-wrap-line ()
 277   "If the current line needs to be wrapped, wrap it and return nil.
 278 If wrapping is performed, point remains on the line.  If the line does
 279 not need to be wrapped, move point to the next line and return t."
 280   (if (longlines-set-breakpoint)
 281       (progn (insert-before-markers ?\n)
 282              (backward-char 1)
 283              (delete-char -1)
 284              (forward-char 1)
 285              nil)
 286     (if (longlines-merge-lines-p)
 287         (progn (end-of-line)
 288      ;; After certain commands (e.g. kill-line), there may be two
 289      ;; successive soft newlines in the buffer.  In this case, we
 290      ;; replace these two newlines by a single space.  Unfortunately,
 291      ;; this breaks the conservation of (spaces + newlines), so we
 292      ;; have to fiddle with longlines-wrap-point.
 293                (if (or (prog1 (bolp) (forward-char 1)) (eolp))
 294                    (progn
 295                      (delete-char -1)
 296                      (if (> longlines-wrap-point (point))
 297                          (setq longlines-wrap-point
 298                                (1- longlines-wrap-point))))
 299                  (insert-before-markers-and-inherit ?\s)
 300                  (backward-char 1)
 301                  (delete-char -1)
 302                  (forward-char 1))
 303                nil)
 304       (forward-line 1)
 305       t)))
 306
 307 (defun longlines-set-breakpoint ()
 308   "Place point where we should break the current line, and return t.
 309 If the line should not be broken, return nil; point remains on the
 310 line."
 311   (move-to-column fill-column)
 312   (if (and (re-search-forward "[^ ]" (line-end-position) 1)
 313            (> (current-column) fill-column))
 314       ;; This line is too long.  Can we break it?
 315       (or (longlines-find-break-backward)
 316           (progn (move-to-column fill-column)
 317                  (longlines-find-break-forward)))))
 318
 319 (defun longlines-find-break-backward ()
 320   "Move point backward to the first available breakpoint and return t.
 321 If no breakpoint is found, return nil."
 322   (and (search-backward " " (line-beginning-position) 1)
 323        (save-excursion
 324          (skip-chars-backward " " (line-beginning-position))
 325          (null (bolp)))
 326        (progn (forward-char 1)
 327               (if (and fill-nobreak-predicate
 328                        (run-hook-with-args-until-success
 329                         'fill-nobreak-predicate))
 330                   (progn (skip-chars-backward " " (line-beginning-position))
 331                          (longlines-find-break-backward))
 332                 t))))
 333
 334 (defun longlines-find-break-forward ()
 335   "Move point forward to the first available breakpoint and return t.
 336 If no break point is found, return nil."
 337   (and (search-forward " " (line-end-position) 1)
 338        (progn (skip-chars-forward " " (line-end-position))
 339               (null (eolp)))
 340        (if (and fill-nobreak-predicate
 341                 (run-hook-with-args-until-success
 342                  'fill-nobreak-predicate))
 343            (longlines-find-break-forward)
 344          t)))
 345
 346 (defun longlines-merge-lines-p ()
 347   "Return t if part of the next line can fit onto the current line.
 348 Otherwise, return nil.  Text cannot be moved across hard newlines."
 349   (save-excursion
 350     (end-of-line)
 351     (and (null (eobp))
 352          (null (get-text-property (point) 'hard))
 353          (let ((space (- fill-column (current-column))))
 354            (forward-line 1)
 355            (if (eq (char-after) ? )
 356                t ; We can always merge some spaces
 357              (<= (if (search-forward " " (line-end-position) 1)
 358                      (current-column)
 359                    (1+ (current-column)))
 360                  space))))))
 361
 362 (defun longlines-decode-region (&optional beg end)
 363   "Turn all newlines between BEG and END into hard newlines.
 364 If BEG and END are nil, the point and mark are used."
 365   (if (null beg) (setq beg (point)))
 366   (if (null end) (setq end (mark t)))
 367   (save-excursion
 368     (let ((reg-max (max beg end)))
 369       (goto-char (min beg end))
 370       (while (search-forward "\n" reg-max t)
 371         (set-hard-newline-properties
 372          (match-beginning 0) (match-end 0))))))
 373
 374 (defun longlines-decode-buffer ()
 375   "Turn all newlines in the buffer into hard newlines."
 376   (longlines-decode-region (point-min) (point-max)))
 377
 378 (defun longlines-encode-region (beg end &optional _buffer)
 379   "Replace each soft newline between BEG and END with exactly one space.
 380 Hard newlines are left intact.  The optional argument BUFFER exists for
 381 compatibility with `format-alist', and is ignored."
 382   (save-excursion
 383     (let ((reg-max (max beg end))
 384           (mod (buffer-modified-p)))
 385       (goto-char (min beg end))
 386       (while (search-forward "\n" reg-max t)
 387         (unless (get-text-property (match-beginning 0) 'hard)
 388           (replace-match " ")))
 389       (set-buffer-modified-p mod)
 390       end)))
 391
 392 (defun longlines-encode-string (string)
 393   "Return a copy of STRING with each soft newline replaced by a space.
 394 Hard newlines are left intact."
 395   (let* ((str (copy-sequence string))
 396          (pos (string-match "\n" str)))
 397     (while pos
 398       (if (null (get-text-property pos 'hard str))
 399           (aset str pos ? ))
 400       (setq pos (string-match "\n" str (1+ pos))))
 401     str))
 402
 403 ;; Auto wrap
 404
 405 (defun longlines-auto-wrap (&optional arg)
 406   "Toggle automatic line wrapping.
 407 With optional argument ARG, turn on line wrapping if and only if ARG is positive.
 408 If automatic line wrapping is turned on, wrap the entire buffer."
 409   (interactive "P")
 410   (setq arg (if arg
 411                 (> (prefix-numeric-value arg) 0)
 412               (not longlines-auto-wrap)))
 413   (if arg
 414       (progn
 415         (setq longlines-auto-wrap t)
 416         (longlines-wrap-region (point-min) (point-max))
 417         (message "Auto wrap enabled."))
 418     (setq longlines-auto-wrap nil)
 419     (message "Auto wrap disabled.")))
 420
 421 (defun longlines-after-change-function (beg end _len)
 422   "Update `longlines-wrap-beg' and `longlines-wrap-end'.
 423 This is called by `after-change-functions' to keep track of the region
 424 that has changed."
 425   (when (and longlines-auto-wrap (not undo-in-progress))
 426     (setq longlines-wrap-beg
 427           (if longlines-wrap-beg (min longlines-wrap-beg beg) beg))
 428     (setq longlines-wrap-end
 429           (if longlines-wrap-end (max longlines-wrap-end end) end))))
 430
 431 (defun longlines-post-command-function ()
 432   "Perform line wrapping on the parts of the buffer that have changed.
 433 This is called by `post-command-hook' after each command."
 434   (when (and longlines-auto-wrap longlines-wrap-beg)
 435     (if (or (eq this-command 'yank)
 436             (eq this-command 'yank-pop))
 437         (longlines-decode-region (point) (mark t)))
 438     (if longlines-showing
 439         (longlines-show-region longlines-wrap-beg longlines-wrap-end))
 440     (unless (or (eq this-command 'fill-paragraph)
 441                 (eq this-command 'fill-region))
 442       (longlines-wrap-region longlines-wrap-beg longlines-wrap-end))
 443     (setq longlines-wrap-beg nil)
 444     (setq longlines-wrap-end nil)))
 445
 446 (defun longlines-window-change-function ()
 447   "Re-wrap the buffer if the window width has changed.
 448 This is called by `window-configuration-change-hook'."
 449   (let ((dw (if (and (integerp longlines-wrap-follows-window-size)
 450                      (>= longlines-wrap-follows-window-size 0)
 451                      (< longlines-wrap-follows-window-size (window-width)))
 452                 longlines-wrap-follows-window-size
 453               2)))
 454     (when (/= fill-column (- (window-width) dw))
 455       (setq fill-column (- (window-width) dw))
 456       (longlines-wrap-region (point-min) (point-max)))))
 457
 458 ;; Isearch
 459
 460 (defun longlines-search-function ()
 461   (cond
 462    (isearch-word
 463     (if isearch-forward 'word-search-forward 'word-search-backward))
 464    (isearch-regexp
 465     (if isearch-forward 're-search-forward 're-search-backward))
 466    (t
 467     (if isearch-forward
 468         'longlines-search-forward
 469       'longlines-search-backward))))
 470
 471 (defun longlines-search-forward (string &optional bound noerror count)
 472   (let ((search-spaces-regexp " *[ \n]"))
 473     (re-search-forward (regexp-quote string) bound noerror count)))
 474
 475 (defun longlines-search-backward (string &optional bound noerror count)
 476   (let ((search-spaces-regexp " *[ \n]"))
 477     (re-search-backward (regexp-quote string) bound noerror count)))
 478
 479 (defun longlines-re-search-forward (string &optional bound noerror count)
 480   (let ((search-spaces-regexp " *[ \n]"))
 481     (re-search-forward string bound noerror count)))
 482
 483 ;; Loading and saving
 484
 485 (defun longlines-before-revert-hook ()
 486   (add-hook 'after-revert-hook 'longlines-after-revert-hook nil t)
 487   (longlines-mode 0))
 488
 489 (defun longlines-after-revert-hook ()
 490   (remove-hook 'after-revert-hook 'longlines-after-revert-hook t)
 491   (longlines-mode 1))
 492
 493 (add-to-list
 494  'format-alist
 495  (list 'longlines "Automatically wrap long lines." nil nil
 496        'longlines-encode-region t nil))
 497
 498 ;; Unloading
 499
 500 (defun longlines-unload-function ()
 501   "Unload the longlines library."
 502   (save-current-buffer
 503     (dolist (buffer (buffer-list))
 504       (set-buffer buffer)
 505       (longlines-mode-off)))
 506   ;; continue standard unloading
 507   nil)
 508
 509 (provide 'longlines)
 510
 511 ;;; longlines.el ends here