;;; zenirc-fill.el --- fill messages in zenirc

;; Copyright (C) 1995 Noah S. Friedman

;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
;; Maintainer: friedman@prep.ai.mit.edu
;; Keywords: extensions
;; Created: 1995-03-16

;; $Id: zenirc-fill.el,v 1.4 1997/02/05 04:26:06 friedman Exp $

;; This program 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 program 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 this program; if not, you can either send email to this
;; program's maintainer or write to: The Free Software Foundation,
;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.

;;; Commentary:
;;; Code:

(require 'zenirc)

(defvar zenirc-fill-mode nil
  "*If non-nil, then fill messages fitting `zenirc-fill-message-categories'.
This is buffer-local.")
(make-variable-buffer-local 'zenirc-fill-mode)

(defvar zenirc-fill-region-function 'zenirc-wrap-region
  "*Function to use for filling.")

(defvar zenirc-fill-prefix " | "
  "*String for filling to insert at front of new lines, or nil for none.")

(defvar zenirc-fill-column (- (window-width) 2)
  "*Column beyond which line-wrapping should happen in zenirc buffers.")

(defvar zenirc-fill-message-categories
  '(privmsg privmsg_you notice notice_you ctcp_action)
  "*ZenIRC message categories to fill as paragraphs.
This should be a list consisting of symbols corresponding to the type of
messages in the message catalog which should be filled as paragraphs.
For example, private messages (`privmsg') and notices (`notice') are good
choices.

If this variable is set to `t', then all messages are filled.
If this variable is set to `nil', then no messages are filled.")

(defvar zenirc-fill-nonstandard-message-categories-p nil
  "If non-nil, then fill messages that are not in a standard category.
That is, fill messages which did not originate from the message catalog,
and thus have no category symbol.")


(defun zenirc-fill-mode (&optional prefix)
  "Enable or disable line wrapping of irc messages.

A negative prefix argument disables this mode.
A non-negative prefix argument enables it.
If no prefix argument is given, toggle the current state of the mode.

The user may also enable or disable this mode simply by setting the
variable of the same name."
  (interactive "P")
  (cond
   ((null prefix)
    (setq zenirc-fill-mode (not zenirc-fill-mode)))
   ((>= (prefix-numeric-value prefix) 0)
    (setq zenirc-fill-mode t))
   (t
    (setq zenirc-fill-mode nil)))
  (cond ((not (interactive-p)))
        (zenirc-fill-mode
         (message "zenirc-fill-mode is enabled"))
        (t
         (message "zenirc-fill-mode is disabled")))
  zenirc-fill-mode)

;; "normal" filling function.
(defun zenirc-fill-region (beg end)
  (let* ((fill-prefix zenirc-fill-prefix)
         (fill-column zenirc-fill-column))
    (fill-region-as-paragraph (point-min) (1- (point-max))))
    ;; this filling function adds an unnecessary newline.
    (goto-char (point-max))
    (delete-char -1))

;; This is like the normal filling routines except that it doesn't squash
;; whitespace (except at line breaks).  This will make ascii barphics and
;; other random spaced crap easier to see.
(defun zenirc-wrap-region (beg end)
  (interactive "r")
  (save-match-data
    (save-excursion
      (save-restriction
        (narrow-to-region beg end)
        (let* ((ws "[ \t]")
               (prefix-length (length zenirc-fill-prefix))
               (fill-column (max (or zenirc-fill-column
                                     (- (window-width) 2))
                                 prefix-length))
               line-beg)
          (goto-char beg)
          (while (< (point) (point-max))
            (beginning-of-line)
            (setq line-beg (+ (point) prefix-length))
            (cond ((< fill-column (- (point-max) (point)))
                   (forward-char fill-column)
                   (cond ((or (memq (char-after (point)) '(32 ?\t))
                              (re-search-backward ws line-beg t)
                              (re-search-forward ws (point-max) t))
                          (just-one-space)
                          (delete-char -1)
                          (insert "\n" (or zenirc-fill-prefix "")))
                         (t
                          (goto-char (point-max)))))
                  (t
                   (goto-char (point-max))))))))))

(defun zenirc-fill-message (proc sym string)
  (and zenirc-fill-mode
       (cond ((eq zenirc-fill-message-categories t))
             ((null sym)
              zenirc-fill-nonstandard-message-categories-p)
             ((memq sym zenirc-fill-message-categories))
             (t nil))
       (funcall zenirc-fill-region-function (point-min) (point-max))))


(provide 'zenirc-fill)

(zenirc-add-hook 'zenirc-message-hook 'zenirc-fill-message)

(or (assq 'zenirc-fill-mode minor-mode-alist)
    (setq minor-mode-alist
          (cons (list 'zenirc-fill-mode " Zfill") minor-mode-alist)))

;;; zenirc-fill.el ends here
