cgit.sxemacs.org Git - packages/blob - xemacs-packages/erc/erc-fill.el

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