Source

erc / erc-fill.el

;;; erc-fill.el --- Filling IRC messages in various ways

;; Copyright (C) 2002  Alex Schroeder

;; Author: Andreas Fuchs <asf@void.at>
;;         Mario Lang <mlang@delysid.org>
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcFilling

;; This file is not part of GNU Emacs.

;; This is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;; This file is not part of GNU Emacs.

;;; Commentary:

;; This package implements filling of messages sent and received.  Use
;; `erc-fill-mode' to switch it on.  Customize `erc-fill-function' to
;; change the style.

;;; Code:

(require 'erc)
(require 'erc-stamp); for the timestamp stuff

(defconst erc-fill-version "$Revision$"
  "ERC fill revision.")

(defgroup erc-fill nil
  "Filling means to reformat long lines in different ways."
  :group 'erc)

;;;###autoload (autoload 'erc-fill-mode "erc-fill" nil t)
(erc-define-minor-mode erc-fill-mode
  "Toggle ERC fill mode.
With numeric arg, turn ERC fill mode on if and only if arg is
positive.  In ERC fill mode, messages in the channel buffers are
filled."
  nil nil nil
  :global t :group 'erc-fill
  (if erc-fill-mode
      (erc-fill-enable)
    (erc-fill-disable)))

(defun erc-fill-enable ()
  "Setup hooks for `erc-fill-mode'."
  (interactive)
  (add-hook 'erc-insert-modify-hook 'erc-fill)
  (add-hook 'erc-send-modify-hook 'erc-fill))

(defun erc-fill-disable ()
  "Cleanup hooks, disable `erc-fill-mode'."
  (interactive)
  (remove-hook 'erc-insert-modify-hook 'erc-fill)
  (remove-hook 'erc-send-modify-hook 'erc-fill))

(defcustom erc-fill-prefix nil
  "Values used as `fill-prefix' for `erc-fill-variable'.
nil means fill with space, a string means fill with this string."
  :group 'erc-fill
  :type '(choice (const nil) string))

(defcustom erc-fill-function 'erc-fill-variable
  "Function to use for filling messages.

Variable Filling with an `erc-fill-prefix' of nil:

<shortnick> this is a very very very long message with no
	    meaning at all

Variable Filling with an `erc-fill-prefix' of four spaces:

<shortnick> this is a very very very long message with no
    meaning at all

Static Filling with `erc-fill-static-center' of 27:

		<shortnick> foo bar baz
	 <a-very-long-nick> foo bar baz quuuuux
		<shortnick> this is a very very very long message with no
			    meaning at all

These two styles are implemented using `erc-fill-variable' and
`erc-fill-static'.  You can, of course, define your own filling
function.  Narrowing to the region in question is in effect while your
function is called."
  :group 'erc-fill
  :type '(choice (const :tag "Variable Filling" erc-fill-variable)
		 (const :tag "Static Filling" erc-fill-static)
		 function))

(defcustom erc-fill-static-center 27
  "Column around which all statically filled messages will be
centered.  This column denotes the point where the ' ' character
between <nickname> and the entered text will be put, thus aligning
nick names right and text left."
  :group 'erc-fill
  :type 'integer)

(defcustom erc-fill-column 78
  "The column at which a filled paragraph is broken."
  :group 'erc-fill
  :type 'integer)

;;;###autoload
(defun erc-fill ()
  "Fill a region using the function referenced in `erc-fill-function'.
You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'."
  (unless (erc-string-invisible-p (buffer-substring (point-min) (point-max)))
    (when erc-fill-function
      (funcall erc-fill-function))))

(defun erc-fill-static ()
  "Fills a text such that messages start at column `erc-fill-static-center'."
  (save-match-data
    (let* ((white-space-str " \t")
	   (white-space-lst (string-to-list white-space-str))
	   (white-space-re  (concat "[" white-space-str "]")))
      (goto-char (point-min))
      (let* ((nick (when (looking-at "^\\(\\S-+\\)\\( .*\\)$")
		     (match-string 1)))
	     (message-text (and nick (match-string 2)))
	     (text-start   (max 0 (- erc-fill-static-center (length nick)))))
	(when (and nick message-text)
	  (insert (make-string text-start ? ))
	  (let ((fill-column erc-fill-column)
		(erc-fill-prefix (make-string text-start ? )))
	    (erc-fill-variable)
	    (goto-char (point-min))
	    (let ((lines-to-go (erc-count-lines)))
	      (when (>= lines-to-go 1) ; we have more than one line to fill
		(save-restriction
		  (narrow-to-region (progn (forward-line)
					   (point))
				    (point-max))
		  (let ((fill-column (- fill-column (string-width nick))))
		    (erc-fill-variable)) ; first re-fill for
					; "smaller" margin
		  (goto-char (point-min)) ; now indent behind nick
		  (while (> lines-to-go 0)
		    (insert (make-string (1+ (length nick)) ? ))
		    (forward-line)
		    (setq lines-to-go (1- lines-to-go))))))
	    (let* ((parsed-posn (text-property-not-all (point-min) (point-max) 'erc-parsed nil))
		   (parsed-prop (when parsed-posn
				  (get-text-property parsed-posn 'erc-parsed))))
	      (put-text-property (point-min) (point-max) 'erc-parsed parsed-prop))))))))

(defun erc-count-lines ()
  "Count the lines that lie between (point) and the end of the buffer."
  (let ((i 0)
	(point-before (point)))
    (while (not (= 1 (forward-line)))
      (setq i (1+ i)))
    (goto-char point-before)
    (max 0 (1- i))))

(defun erc-fill-variable ()
  "Fill region from START to END. START and END should be markers."
  (let ((fill-prefix erc-fill-prefix)
        (fill-column (or erc-fill-column fill-column)))
    (unless fill-prefix
      (goto-char (point-min))
      (when (looking-at "\\(\\S-+ \\)")
	(let ((len (length (match-string 1))))
      (if (and (boundp 'erc-timestamp-format)
               erc-timestamp-format
               (eq erc-insert-timestamp-function 'erc-insert-timestamp-left)
               (not erc-hide-timestamps))
          (setq len (+ len 
                       (length (format-time-string erc-timestamp-format)))))
	  (setq fill-prefix (make-string len ? )))))
    (fill-region (point-min) (point-max) t t)))

(provide 'erc-fill)

;;; erc-fill.el ends here