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

;; Copyright (C) 1995 Noah S. Friedman
;; Copyright (C) 1995, 1996 Per Persson

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

;; $Id: zenirc-fill.el,v 1.3 1995/03/30 04:28:10 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 t
  "*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-type 'prefix
  "*If 'prefix, fill with a given string.
If 'dynamic, fill depending on length of first word in string.
If 'static, add spaces in front of first word and then fill as with 'dynamic")
(make-variable-buffer-local 'zenirc-fill-type)

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

(defvar zenirc-fill-static 26
  "*How many chars into first the line the first word should end.
This will look totally ridicolous if you don't strip away !user@host from
PRIVMSG and NOTICE")

(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
vmessages 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.
No argument or any non-negative argument enables it.

The user may also enable or disable this mode simply by setting the
variable of the same name."
  (interactive "P")
  (setq zenirc-fill-mode (>= (prefix-numeric-value prefix) 0))
  (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)
	(goto-char beg)
        (let* ((ws "[ \t]")
	       ; set the length of the prefix
               (prefix-length 
		; if 'prefix, set this to the length of zenirc-fill-prefix
		(cond ((string-equal zenirc-fill-type 'prefix)
		       (length zenirc-fill-prefix))
		      ; else, set it to length of first word
		      ((or (string-equal zenirc-fill-type 'dynamic)
			   (string-equal zenirc-fill-type 'static))
		       (search-forward " " end t)
		       (- (match-end 0) beg))))
	       ; how many columns zenirc-wrap-region should keep inside
	       (fill-column (max (or zenirc-fill-column
                                     (- (window-width) 2))
                                 prefix-length))
               line-beg)
          (goto-char beg)
	  ; if 'static, fill out the first line with spaces before first word
	  (if (and (string-equal zenirc-fill-type 'static)
		   (<= prefix-length zenirc-fill-static))
	      (progn
		(insert (make-string 
			 (- zenirc-fill-static prefix-length)
			 (string-to-char " ")))
		; update the length of the prefix, as it is static
		(setq prefix-length zenirc-fill-static)))
	  ; start wrapping of the actual message, after first word
          (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))
			  ; remove all spaces before adding newline
			  (just-one-space)
			  (delete-char -1)
			  (cond
			   ((string-equal zenirc-fill-type 'prefix)
			    (insert "\n" (or zenirc-fill-prefix "")))

			   ((or (string-equal zenirc-fill-type 'static)
				(string-equal zenirc-fill-type 'dynamic))
			    (insert 
			     "\n"
			     (make-string (if (string-equal
					       zenirc-fill-type
					       'static)
					      zenirc-fill-static
					    prefix-length)
					  (string-to-char " "))))))
			 (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))))


(defvar zenirc-command-resize-hook '(zenirc-command-resize))

;; /resize [width]
(defun zenirc-command-resize (proc cmd)
  (if (string= (cdr cmd) "")
      (setq zenirc-fill-column (- (window-width) 2))
    (setq zenirc-fill-column (cdr cmd))))

(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
