lisp/erc/erc-fill.el

   1 ;;; erc-fill.el --- Filling IRC messages in various ways
   2
   3 ;; Copyright (C) 2001, 2002, 2003, 2004, 2006, 2007 Free Software Foundation, Inc.
   4
   5 ;; Author: Andreas Fuchs <asf@void.at>
   6 ;;         Mario Lang <mlang@delysid.org>
   7 ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcFilling
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; This package implements filling of messages sent and received.  Use
  29 ;; `erc-fill-mode' to switch it on.  Customize `erc-fill-function' to
  30 ;; change the style.
  31
  32 ;;; Code:
  33
  34 (require 'erc)
  35 (require 'erc-stamp); for the timestamp stuff
  36
  37 (defgroup erc-fill nil
  38   "Filling means to reformat long lines in different ways."
  39   :group 'erc)
  40
  41 ;;;###autoload (autoload 'erc-fill-mode "erc-fill" nil t)
  42 (erc-define-minor-mode erc-fill-mode
  43   "Toggle ERC fill mode.
  44 With numeric arg, turn ERC fill mode on if and only if arg is
  45 positive.  In ERC fill mode, messages in the channel buffers are
  46 filled."
  47   nil nil nil
  48   :global t :group 'erc-fill
  49   (if erc-fill-mode
  50       (erc-fill-enable)
  51     (erc-fill-disable)))
  52
  53 (defun erc-fill-enable ()
  54   "Setup hooks for `erc-fill-mode'."
  55   (interactive)
  56   (add-hook 'erc-insert-modify-hook 'erc-fill)
  57   (add-hook 'erc-send-modify-hook 'erc-fill))
  58
  59 (defun erc-fill-disable ()
  60   "Cleanup hooks, disable `erc-fill-mode'."
  61   (interactive)
  62   (remove-hook 'erc-insert-modify-hook 'erc-fill)
  63   (remove-hook 'erc-send-modify-hook 'erc-fill))
  64
  65 (defcustom erc-fill-prefix nil
  66   "Values used as `fill-prefix' for `erc-fill-variable'.
  67 nil means fill with space, a string means fill with this string."
  68   :group 'erc-fill
  69   :type '(choice (const nil) string))
  70
  71 (defcustom erc-fill-function 'erc-fill-variable
  72   "Function to use for filling messages.
  73
  74 Variable Filling with an `erc-fill-prefix' of nil:
  75
  76 <shortnick> this is a very very very long message with no
  77             meaning at all
  78
  79 Variable Filling with an `erc-fill-prefix' of four spaces:
  80
  81 <shortnick> this is a very very very long message with no
  82     meaning at all
  83
  84 Static Filling with `erc-fill-static-center' of 27:
  85
  86                 <shortnick> foo bar baz
  87          <a-very-long-nick> foo bar baz quuuuux
  88                 <shortnick> this is a very very very long message with no
  89                             meaning at all
  90
  91 These two styles are implemented using `erc-fill-variable' and
  92 `erc-fill-static'.  You can, of course, define your own filling
  93 function.  Narrowing to the region in question is in effect while your
  94 function is called."
  95   :group 'erc-fill
  96   :type '(choice (const :tag "Variable Filling" erc-fill-variable)
  97                  (const :tag "Static Filling" erc-fill-static)
  98                  function))
  99
 100 (defcustom erc-fill-static-center 27
 101   "Column around which all statically filled messages will be
 102 centered.  This column denotes the point where the ' ' character
 103 between <nickname> and the entered text will be put, thus aligning
 104 nick names right and text left."
 105   :group 'erc-fill
 106   :type 'integer)
 107
 108 (defcustom erc-fill-variable-maximum-indentation 17
 109   "If we indent a line after a long nick, don't indent more then this
 110 characters. Set to nil to disable."
 111   :group 'erc-fill
 112   :type 'integer)
 113
 114 (defcustom erc-fill-column 78
 115   "The column at which a filled paragraph is broken."
 116   :group 'erc-fill
 117   :type 'integer)
 118
 119 ;;;###autoload
 120 (defun erc-fill ()
 121   "Fill a region using the function referenced in `erc-fill-function'.
 122 You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'."
 123   (unless (erc-string-invisible-p (buffer-substring (point-min) (point-max)))
 124     (when erc-fill-function
 125       ;; skip initial empty lines
 126       (goto-char (point-min))
 127       (save-match-data
 128         (while (and (looking-at "[ \t\n]*$")
 129                     (= (forward-line 1) 0))))
 130       (unless (eobp)
 131         (save-restriction
 132           (narrow-to-region (point) (point-max))
 133           (funcall erc-fill-function))))))
 134
 135 (defun erc-fill-static ()
 136   "Fills a text such that messages start at column `erc-fill-static-center'."
 137   (save-match-data
 138     (goto-char (point-min))
 139     (looking-at "^\\(\\S-+\\)")
 140     (let ((nick (match-string 1)))
 141         (let ((fill-column (- erc-fill-column (erc-timestamp-offset)))
 142               (fill-prefix (make-string erc-fill-static-center 32)))
 143           (insert (make-string (max 0 (- erc-fill-static-center
 144                                          (length nick) 1))
 145                                32))
 146           (erc-fill-regarding-timestamp))
 147         (erc-restore-text-properties))))
 148
 149 (defun erc-fill-variable ()
 150   "Fill from `point-min' to `point-max'."
 151   (let ((fill-prefix erc-fill-prefix)
 152         (fill-column (or erc-fill-column fill-column)))
 153     (goto-char (point-min))
 154     (if fill-prefix
 155         (let ((first-line-offset (make-string (erc-timestamp-offset) 32)))
 156           (insert first-line-offset)
 157           (fill-region (point-min) (point-max) t t)
 158           (goto-char (point-min))
 159           (delete-char (length first-line-offset)))
 160       (save-match-data
 161         (let* ((nickp (looking-at "^\\(\\S-+\\)"))
 162                (nick (if nickp
 163                          (match-string 1)
 164                        ""))
 165                (fill-column (- erc-fill-column (erc-timestamp-offset)))
 166                (fill-prefix (make-string (min (+ 1 (length nick))
 167                                               (- fill-column 1)
 168                                               (or erc-fill-variable-maximum-indentation
 169                                                   fill-column))
 170                                          32)))
 171           (erc-fill-regarding-timestamp))))
 172     (erc-restore-text-properties)))
 173
 174 (defun erc-fill-regarding-timestamp ()
 175   "Fills a text such that messages start at column `erc-fill-static-center'."
 176   (fill-region (point-min) (point-max) t t)
 177   (goto-char (point-min))
 178   (forward-line)
 179   (indent-rigidly (point) (point-max) (erc-timestamp-offset)))
 180
 181 (defun erc-timestamp-offset ()
 182   "Get length of timestamp if inserted left."
 183   (if (and (boundp 'erc-timestamp-format)
 184            erc-timestamp-format
 185            (eq erc-insert-timestamp-function 'erc-insert-timestamp-left)
 186            (not erc-hide-timestamps))
 187       (length (format-time-string erc-timestamp-format))
 188     0))
 189
 190 (defun erc-restore-text-properties ()
 191   "Restore the property 'erc-parsed for the region."
 192   (let* ((parsed-posn (text-property-not-all (point-min) (point-max)
 193                                              'erc-parsed nil))
 194          (parsed-prop (when parsed-posn
 195                         (get-text-property parsed-posn 'erc-parsed))))
 196     (put-text-property (point-min) (point-max) 'erc-parsed parsed-prop)))
 197
 198 (provide 'erc-fill)
 199
 200 ;;; erc-fill.el ends here
 201 ;; Local Variables:
 202 ;; indent-tabs-mode: nil
 203 ;; End:
 204
 205 ;; arch-tag: 89224581-c2c2-4e26-92e5-e3a390dc516a