code.delx.au - gnu-emacs/blob - lisp/erc/erc-fill.el

   1 ;;; erc-fill.el --- Filling IRC messages in various ways
   2
   3 ;; Copyright (C) 2001-2004, 2006-2011 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 3 of the License, or
  14 ;; (at your option) 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.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; This package implements filling of messages sent and received.  Use
  27 ;; `erc-fill-mode' to switch it on.  Customize `erc-fill-function' to
  28 ;; change the style.
  29
  30 ;;; Code:
  31
  32 (require 'erc)
  33 (require 'erc-stamp); for the timestamp stuff
  34
  35 (defgroup erc-fill nil
  36   "Filling means to reformat long lines in different ways."
  37   :group 'erc)
  38
  39 ;;;###autoload (autoload 'erc-fill-mode "erc-fill" nil t)
  40 (erc-define-minor-mode erc-fill-mode
  41   "Toggle ERC fill mode.
  42 With numeric arg, turn ERC fill mode on if and only if arg is
  43 positive.  In ERC fill mode, messages in the channel buffers are
  44 filled."
  45   nil nil nil
  46   :global t :group 'erc-fill
  47   (if erc-fill-mode
  48       (erc-fill-enable)
  49     (erc-fill-disable)))
  50
  51 (defun erc-fill-enable ()
  52   "Setup hooks for `erc-fill-mode'."
  53   (interactive)
  54   (add-hook 'erc-insert-modify-hook 'erc-fill)
  55   (add-hook 'erc-send-modify-hook 'erc-fill))
  56
  57 (defun erc-fill-disable ()
  58   "Cleanup hooks, disable `erc-fill-mode'."
  59   (interactive)
  60   (remove-hook 'erc-insert-modify-hook 'erc-fill)
  61   (remove-hook 'erc-send-modify-hook 'erc-fill))
  62
  63 (defcustom erc-fill-prefix nil
  64   "Values used as `fill-prefix' for `erc-fill-variable'.
  65 nil means fill with space, a string means fill with this string."
  66   :group 'erc-fill
  67   :type '(choice (const nil) string))
  68
  69 (defcustom erc-fill-function 'erc-fill-variable
  70   "Function to use for filling messages.
  71
  72 Variable Filling with an `erc-fill-prefix' of nil:
  73
  74 <shortnick> this is a very very very long message with no
  75             meaning at all
  76
  77 Variable Filling with an `erc-fill-prefix' of four spaces:
  78
  79 <shortnick> this is a very very very long message with no
  80     meaning at all
  81
  82 Static Filling with `erc-fill-static-center' of 27:
  83
  84                 <shortnick> foo bar baz
  85          <a-very-long-nick> foo bar baz quuuuux
  86                 <shortnick> this is a very very very long message with no
  87                             meaning at all
  88
  89 These two styles are implemented using `erc-fill-variable' and
  90 `erc-fill-static'.  You can, of course, define your own filling
  91 function.  Narrowing to the region in question is in effect while your
  92 function is called."
  93   :group 'erc-fill
  94   :type '(choice (const :tag "Variable Filling" erc-fill-variable)
  95                  (const :tag "Static Filling" erc-fill-static)
  96                  function))
  97
  98 (defcustom erc-fill-static-center 27
  99   "Column around which all statically filled messages will be
 100 centered.  This column denotes the point where the ' ' character
 101 between <nickname> and the entered text will be put, thus aligning
 102 nick names right and text left."
 103   :group 'erc-fill
 104   :type 'integer)
 105
 106 (defcustom erc-fill-variable-maximum-indentation 17
 107   "If we indent a line after a long nick, don't indent more then this
 108 characters. Set to nil to disable."
 109   :group 'erc-fill
 110   :type 'integer)
 111
 112 (defcustom erc-fill-column 78
 113   "The column at which a filled paragraph is broken."
 114   :group 'erc-fill
 115   :type 'integer)
 116
 117 ;;;###autoload
 118 (defun erc-fill ()
 119   "Fill a region using the function referenced in `erc-fill-function'.
 120 You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'."
 121   (unless (erc-string-invisible-p (buffer-substring (point-min) (point-max)))
 122     (when erc-fill-function
 123       ;; skip initial empty lines
 124       (goto-char (point-min))
 125       (save-match-data
 126         (while (and (looking-at "[ \t\n]*$")
 127                     (= (forward-line 1) 0))))
 128       (unless (eobp)
 129         (save-restriction
 130           (narrow-to-region (point) (point-max))
 131           (funcall erc-fill-function))))))
 132
 133 (defun erc-fill-static ()
 134   "Fills a text such that messages start at column `erc-fill-static-center'."
 135   (save-match-data
 136     (goto-char (point-min))
 137     (looking-at "^\\(\\S-+\\)")
 138     (let ((nick (match-string 1)))
 139         (let ((fill-column (- erc-fill-column (erc-timestamp-offset)))
 140               (fill-prefix (make-string erc-fill-static-center 32)))
 141           (insert (make-string (max 0 (- erc-fill-static-center
 142                                          (length nick) 1))
 143                                32))
 144           (erc-fill-regarding-timestamp))
 145         (erc-restore-text-properties))))
 146
 147 (defun erc-fill-variable ()
 148   "Fill from `point-min' to `point-max'."
 149   (let ((fill-prefix erc-fill-prefix)
 150         (fill-column (or erc-fill-column fill-column)))
 151     (goto-char (point-min))
 152     (if fill-prefix
 153         (let ((first-line-offset (make-string (erc-timestamp-offset) 32)))
 154           (insert first-line-offset)
 155           (fill-region (point-min) (point-max) t t)
 156           (goto-char (point-min))
 157           (delete-char (length first-line-offset)))
 158       (save-match-data
 159         (let* ((nickp (looking-at "^\\(\\S-+\\)"))
 160                (nick (if nickp
 161                          (match-string 1)
 162                        ""))
 163                (fill-column (- erc-fill-column (erc-timestamp-offset)))
 164                (fill-prefix (make-string (min (+ 1 (length nick))
 165                                               (- fill-column 1)
 166                                               (or erc-fill-variable-maximum-indentation
 167                                                   fill-column))
 168                                          32)))
 169           (erc-fill-regarding-timestamp))))
 170     (erc-restore-text-properties)))
 171
 172 (defun erc-fill-regarding-timestamp ()
 173   "Fills a text such that messages start at column `erc-fill-static-center'."
 174   (fill-region (point-min) (point-max) t t)
 175   (goto-char (point-min))
 176   (forward-line)
 177   (indent-rigidly (point) (point-max) (erc-timestamp-offset)))
 178
 179 (defun erc-timestamp-offset ()
 180   "Get length of timestamp if inserted left."
 181   (if (and (boundp 'erc-timestamp-format)
 182            erc-timestamp-format
 183            (eq erc-insert-timestamp-function 'erc-insert-timestamp-left)
 184            (not erc-hide-timestamps))
 185       (length (format-time-string erc-timestamp-format))
 186     0))
 187
 188 (provide 'erc-fill)
 189
 190 ;;; erc-fill.el ends here
 191 ;; Local Variables:
 192 ;; indent-tabs-mode: nil
 193 ;; End:
 194