lisp/longlines.el

   1 ;;; longlines.el --- automatically wrap long lines   -*- coding:utf-8 -*-
   2
   3 ;; Copyright (C) 2000, 2001, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 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.
  99 In Long Lines mode, long lines are wrapped if they extend beyond
 100 `fill-column'.  The soft newlines used for line wrapping will not
 101 show up when the text is yanked or saved to disk.
 102
 103 If the variable `longlines-auto-wrap' is non-nil, lines are automatically
 104 wrapped whenever the buffer is changed.  You can always call
 105 `fill-paragraph' to fill individual paragraphs.
 106
 107 If the variable `longlines-show-hard-newlines' is non-nil, hard newlines
 108 are indicated with a symbol."
 109   :group 'longlines :lighter " ll"
 110   (if longlines-mode
 111       ;; Turn on longlines mode
 112       (progn
 113         (use-hard-newlines 1 'never)
 114         (set (make-local-variable 'require-final-newline) nil)
 115         (add-to-list 'buffer-file-format 'longlines)
 116         (add-hook 'change-major-mode-hook 'longlines-mode-off nil t)
 117         (add-hook 'before-revert-hook 'longlines-before-revert-hook nil t)
 118         (make-local-variable 'buffer-substring-filters)
 119         (make-local-variable 'longlines-auto-wrap)
 120         (set (make-local-variable 'isearch-search-fun-function)
 121              'longlines-search-function)
 122         (set (make-local-variable 'replace-search-function)
 123              'longlines-search-forward)
 124         (set (make-local-variable 'replace-re-search-function)
 125              'longlines-re-search-forward)
 126         (add-to-list 'buffer-substring-filters 'longlines-encode-string)
 127         (when longlines-wrap-follows-window-size
 128           (let ((dw (if (and (integerp longlines-wrap-follows-window-size)
 129                              (>= longlines-wrap-follows-window-size 0)
 130                              (< longlines-wrap-follows-window-size
 131                                 (window-width)))
 132                         longlines-wrap-follows-window-size
 133                       2)))
 134             (set (make-local-variable 'fill-column)
 135                  (- (window-width) dw)))
 136           (add-hook 'window-configuration-change-hook
 137                     'longlines-window-change-function nil t))
 138         (let ((buffer-undo-list t)
 139               (inhibit-read-only t)
 140               (after-change-functions nil)
 141               (mod (buffer-modified-p))
 142               buffer-file-name buffer-file-truename)
 143           ;; Turning off undo is OK since (spaces + newlines) is
 144           ;; conserved, except for a corner case in
 145           ;; longlines-wrap-lines that we'll never encounter from here
 146           (save-restriction
 147             (widen)
 148             (unless longlines-decoded
 149               (longlines-decode-buffer)
 150               (setq longlines-decoded t))
 151             (longlines-wrap-region (point-min) (point-max)))
 152           (set-buffer-modified-p mod))
 153         (when (and longlines-show-hard-newlines
 154                    (not longlines-showing))
 155           (longlines-show-hard-newlines))
 156
 157         ;; Hacks to make longlines play nice with various modes.
 158         (cond ((eq major-mode 'mail-mode)
 159                (add-hook 'mail-setup-hook 'longlines-decode-buffer nil t)
 160                (or mail-citation-hook
 161                    (add-hook 'mail-citation-hook 'mail-indent-citation nil t))
 162                (add-hook 'mail-citation-hook 'longlines-decode-region nil t))
 163               ((eq major-mode 'message-mode)
 164                (add-hook 'message-setup-hook 'longlines-decode-buffer nil t)
 165                (make-local-variable 'message-indent-citation-function)
 166                (if (not (listp message-indent-citation-function))
 167                    (setq message-indent-citation-function
 168                          (list message-indent-citation-function)))
 169                (add-to-list 'message-indent-citation-function
 170                             'longlines-decode-region t)))
 171
 172         (add-hook 'after-change-functions 'longlines-after-change-function nil t)
 173         (add-hook 'post-command-hook 'longlines-post-command-function nil t)
 174         (when longlines-auto-wrap
 175           (auto-fill-mode 0)))
 176     ;; Turn off longlines mode
 177     (setq buffer-file-format (delete 'longlines buffer-file-format))
 178     (if longlines-showing
 179         (longlines-unshow-hard-newlines))
 180     (let ((buffer-undo-list t)
 181           (after-change-functions nil)
 182           (inhibit-read-only t)
 183           buffer-file-name buffer-file-truename)
 184       (if longlines-decoded
 185           (save-restriction
 186             (widen)
 187             (longlines-encode-region (point-min) (point-max))
 188             (setq longlines-decoded nil))))
 189     (remove-hook 'change-major-mode-hook 'longlines-mode-off t)
 190     (remove-hook 'after-change-functions 'longlines-after-change-function t)
 191     (remove-hook 'post-command-hook 'longlines-post-command-function t)
 192     (remove-hook 'before-revert-hook 'longlines-before-revert-hook t)
 193     (remove-hook 'window-configuration-change-hook
 194                  'longlines-window-change-function t)
 195     (when longlines-wrap-follows-window-size
 196       (kill-local-variable 'fill-column))
 197     (kill-local-variable 'isearch-search-fun-function)
 198     (kill-local-variable 'replace-search-function)
 199     (kill-local-variable 'replace-re-search-function)
 200     (kill-local-variable 'require-final-newline)
 201     (kill-local-variable 'buffer-substring-filters)
 202     (kill-local-variable 'use-hard-newlines)))
 203
 204 (defun longlines-mode-off ()
 205   "Turn off longlines mode.
 206 This function exists to be called by `change-major-mode-hook' when the
 207 major mode changes."
 208   (longlines-mode 0))
 209
 210 ;; Showing the effect of hard newlines in the buffer
 211
 212 (defun longlines-show-hard-newlines (&optional arg)
 213   "Make hard newlines visible by adding a face.
 214 With optional argument ARG, make the hard newlines invisible again."
 215   (interactive "P")
 216     (if arg
 217         (longlines-unshow-hard-newlines)
 218       (setq longlines-showing t)
 219       (longlines-show-region (point-min) (point-max))))
 220
 221 (defun longlines-show-region (beg end)
 222   "Make hard newlines between BEG and END visible."
 223   (let* ((pmin (min beg end))
 224          (pmax (max beg end))
 225          (pos (text-property-not-all pmin pmax 'hard nil))
 226          (mod (buffer-modified-p))
 227          (buffer-undo-list t)
 228          (inhibit-read-only t)
 229          (inhibit-modification-hooks t)
 230          buffer-file-name buffer-file-truename)
 231     (while pos
 232       (put-text-property pos (1+ pos) 'display
 233                          (copy-sequence longlines-show-effect))
 234       (setq pos (text-property-not-all (1+ pos) pmax 'hard nil)))
 235     (restore-buffer-modified-p mod)))
 236
 237 (defun longlines-unshow-hard-newlines ()
 238   "Make hard newlines invisible again."
 239   (interactive)
 240   (setq longlines-showing nil)
 241   (let ((pos (text-property-not-all (point-min) (point-max) 'hard nil))
 242         (mod (buffer-modified-p))
 243         (buffer-undo-list t)
 244         (inhibit-read-only t)
 245         (inhibit-modification-hooks t)
 246         buffer-file-name buffer-file-truename)
 247     (while pos
 248       (remove-text-properties pos (1+ pos) '(display))
 249       (setq pos (text-property-not-all (1+ pos) (point-max) 'hard nil)))
 250     (restore-buffer-modified-p mod)))
 251
 252 ;; Wrapping the paragraphs.
 253
 254 (defun longlines-wrap-region (beg end)
 255   "Wrap each successive line, starting with the line before BEG.
 256 Stop when we reach lines after END that don't need wrapping, or the
 257 end of the buffer."
 258   (let ((mod (buffer-modified-p)))
 259     (setq longlines-wrap-point (point))
 260     (goto-char beg)
 261     (forward-line -1)
 262     ;; Two successful longlines-wrap-line's in a row mean successive
 263     ;; lines don't need wrapping.
 264     (while (null (and (longlines-wrap-line)
 265                       (or (eobp)
 266                           (and (>= (point) end)
 267                                (longlines-wrap-line))))))
 268     (goto-char longlines-wrap-point)
 269     (set-buffer-modified-p mod)))
 270
 271 (defun longlines-wrap-line ()
 272   "If the current line needs to be wrapped, wrap it and return nil.
 273 If wrapping is performed, point remains on the line.  If the line does
 274 not need to be wrapped, move point to the next line and return t."
 275   (if (longlines-set-breakpoint)
 276       (progn (insert-before-markers ?\n)
 277              (backward-char 1)
 278              (delete-char -1)
 279              (forward-char 1)
 280              nil)
 281     (if (longlines-merge-lines-p)
 282         (progn (end-of-line)
 283      ;; After certain commands (e.g. kill-line), there may be two
 284      ;; successive soft newlines in the buffer.  In this case, we
 285      ;; replace these two newlines by a single space.  Unfortunately,
 286      ;; this breaks the conservation of (spaces + newlines), so we
 287      ;; have to fiddle with longlines-wrap-point.
 288                (if (or (prog1 (bolp) (forward-char 1)) (eolp))
 289                    (progn
 290                      (delete-char -1)
 291                      (if (> longlines-wrap-point (point))
 292                          (setq longlines-wrap-point
 293                                (1- longlines-wrap-point))))
 294                  (insert-before-markers-and-inherit ?\s)
 295                  (backward-char 1)
 296                  (delete-char -1)
 297                  (forward-char 1))
 298                nil)
 299       (forward-line 1)
 300       t)))
 301
 302 (defun longlines-set-breakpoint ()
 303   "Place point where we should break the current line, and return t.
 304 If the line should not be broken, return nil; point remains on the
 305 line."
 306   (move-to-column fill-column)
 307   (if (and (re-search-forward "[^ ]" (line-end-position) 1)
 308            (> (current-column) fill-column))
 309       ;; This line is too long.  Can we break it?
 310       (or (longlines-find-break-backward)
 311           (progn (move-to-column fill-column)
 312                  (longlines-find-break-forward)))))
 313
 314 (defun longlines-find-break-backward ()
 315   "Move point backward to the first available breakpoint and return t.
 316 If no breakpoint is found, return nil."
 317   (and (search-backward " " (line-beginning-position) 1)
 318        (save-excursion
 319          (skip-chars-backward " " (line-beginning-position))
 320          (null (bolp)))
 321        (progn (forward-char 1)
 322               (if (and fill-nobreak-predicate
 323                        (run-hook-with-args-until-success
 324                         'fill-nobreak-predicate))
 325                   (progn (skip-chars-backward " " (line-beginning-position))
 326                          (longlines-find-break-backward))
 327                 t))))
 328
 329 (defun longlines-find-break-forward ()
 330   "Move point forward to the first available breakpoint and return t.
 331 If no break point is found, return nil."
 332   (and (search-forward " " (line-end-position) 1)
 333        (progn (skip-chars-forward " " (line-end-position))
 334               (null (eolp)))
 335        (if (and fill-nobreak-predicate
 336                 (run-hook-with-args-until-success
 337                  'fill-nobreak-predicate))
 338            (longlines-find-break-forward)
 339          t)))
 340
 341 (defun longlines-merge-lines-p ()
 342   "Return t if part of the next line can fit onto the current line.
 343 Otherwise, return nil.  Text cannot be moved across hard newlines."
 344   (save-excursion
 345     (end-of-line)
 346     (and (null (eobp))
 347          (null (get-text-property (point) 'hard))
 348          (let ((space (- fill-column (current-column))))
 349            (forward-line 1)
 350            (if (eq (char-after) ? )
 351                t ; We can always merge some spaces
 352              (<= (if (search-forward " " (line-end-position) 1)
 353                      (current-column)
 354                    (1+ (current-column)))
 355                  space))))))
 356
 357 (defun longlines-decode-region (&optional beg end)
 358   "Turn all newlines between BEG and END into hard newlines.
 359 If BEG and END are nil, the point and mark are used."
 360   (if (null beg) (setq beg (point)))
 361   (if (null end) (setq end (mark t)))
 362   (save-excursion
 363     (let ((reg-max (max beg end)))
 364       (goto-char (min beg end))
 365       (while (search-forward "\n" reg-max t)
 366         (set-hard-newline-properties
 367          (match-beginning 0) (match-end 0))))))
 368
 369 (defun longlines-decode-buffer ()
 370   "Turn all newlines in the buffer into hard newlines."
 371   (longlines-decode-region (point-min) (point-max)))
 372
 373 (defun longlines-encode-region (beg end &optional buffer)
 374   "Replace each soft newline between BEG and END with exactly one space.
 375 Hard newlines are left intact.  The optional argument BUFFER exists for
 376 compatibility with `format-alist', and is ignored."
 377   (save-excursion
 378     (let ((reg-max (max beg end))
 379           (mod (buffer-modified-p)))
 380       (goto-char (min beg end))
 381       (while (search-forward "\n" reg-max t)
 382         (unless (get-text-property (match-beginning 0) 'hard)
 383           (replace-match " ")))
 384       (set-buffer-modified-p mod)
 385       end)))
 386
 387 (defun longlines-encode-string (string)
 388   "Return a copy of STRING with each soft newline replaced by a space.
 389 Hard newlines are left intact."
 390   (let* ((str (copy-sequence string))
 391          (pos (string-match "\n" str)))
 392     (while pos
 393       (if (null (get-text-property pos 'hard str))
 394           (aset str pos ? ))
 395       (setq pos (string-match "\n" str (1+ pos))))
 396     str))
 397
 398 ;; Auto wrap
 399
 400 (defun longlines-auto-wrap (&optional arg)
 401   "Toggle automatic line wrapping.
 402 With optional argument ARG, turn on line wrapping if and only if ARG is positive.
 403 If automatic line wrapping is turned on, wrap the entire buffer."
 404   (interactive "P")
 405   (setq arg (if arg
 406                 (> (prefix-numeric-value arg) 0)
 407               (not longlines-auto-wrap)))
 408   (if arg
 409       (progn
 410         (setq longlines-auto-wrap t)
 411         (longlines-wrap-region (point-min) (point-max))
 412         (message "Auto wrap enabled."))
 413     (setq longlines-auto-wrap nil)
 414     (message "Auto wrap disabled.")))
 415
 416 (defun longlines-after-change-function (beg end len)
 417   "Update `longlines-wrap-beg' and `longlines-wrap-end'.
 418 This is called by `after-change-functions' to keep track of the region
 419 that has changed."
 420   (when (and longlines-auto-wrap (not undo-in-progress))
 421     (setq longlines-wrap-beg
 422           (if longlines-wrap-beg (min longlines-wrap-beg beg) beg))
 423     (setq longlines-wrap-end
 424           (if longlines-wrap-end (max longlines-wrap-end end) end))))
 425
 426 (defun longlines-post-command-function ()
 427   "Perform line wrapping on the parts of the buffer that have changed.
 428 This is called by `post-command-hook' after each command."
 429   (when (and longlines-auto-wrap longlines-wrap-beg)
 430     (if (or (eq this-command 'yank)
 431             (eq this-command 'yank-pop))
 432         (longlines-decode-region (point) (mark t)))
 433     (if longlines-showing
 434         (longlines-show-region longlines-wrap-beg longlines-wrap-end))
 435     (unless (or (eq this-command 'fill-paragraph)
 436                 (eq this-command 'fill-region))
 437       (longlines-wrap-region longlines-wrap-beg longlines-wrap-end))
 438     (setq longlines-wrap-beg nil)
 439     (setq longlines-wrap-end nil)))
 440
 441 (defun longlines-window-change-function ()
 442   "Re-wrap the buffer if the window width has changed.
 443 This is called by `window-configuration-change-hook'."
 444   (let ((dw (if (and (integerp longlines-wrap-follows-window-size)
 445                      (>= longlines-wrap-follows-window-size 0)
 446                      (< longlines-wrap-follows-window-size (window-width)))
 447                 longlines-wrap-follows-window-size
 448               2)))
 449     (when (/= fill-column (- (window-width) dw))
 450       (setq fill-column (- (window-width) dw))
 451       (longlines-wrap-region (point-min) (point-max)))))
 452
 453 ;; Isearch
 454
 455 (defun longlines-search-function ()
 456   (cond
 457    (isearch-word
 458     (if isearch-forward 'word-search-forward 'word-search-backward))
 459    (isearch-regexp
 460     (if isearch-forward 're-search-forward 're-search-backward))
 461    (t
 462     (if isearch-forward
 463         'longlines-search-forward
 464       'longlines-search-backward))))
 465
 466 (defun longlines-search-forward (string &optional bound noerror count)
 467   (let ((search-spaces-regexp " *[ \n]"))
 468     (re-search-forward (regexp-quote string) bound noerror count)))
 469
 470 (defun longlines-search-backward (string &optional bound noerror count)
 471   (let ((search-spaces-regexp " *[ \n]"))
 472     (re-search-backward (regexp-quote string) bound noerror count)))
 473
 474 (defun longlines-re-search-forward (string &optional bound noerror count)
 475   (let ((search-spaces-regexp " *[ \n]"))
 476     (re-search-forward string bound noerror count)))
 477
 478 ;; Loading and saving
 479
 480 (defun longlines-before-revert-hook ()
 481   (add-hook 'after-revert-hook 'longlines-after-revert-hook nil t)
 482   (longlines-mode 0))
 483
 484 (defun longlines-after-revert-hook ()
 485   (remove-hook 'after-revert-hook 'longlines-after-revert-hook t)
 486   (longlines-mode 1))
 487
 488 (add-to-list
 489  'format-alist
 490  (list 'longlines "Automatically wrap long lines." nil nil
 491        'longlines-encode-region t nil))
 492
 493 ;; Unloading
 494
 495 (defun longlines-unload-function ()
 496   "Unload the longlines library."
 497   (save-current-buffer
 498     (dolist (buffer (buffer-list))
 499       (set-buffer buffer)
 500       (longlines-mode-off)))
 501   ;; continue standard unloading
 502   nil)
 503
 504 (provide 'longlines)
 505
 506 ;; arch-tag: 3489d225-5506-47b9-8659-d8807b77c624
 507 ;;; longlines.el ends here