;;; msgflags.el  facility for placing flags in the mode line
;;; Copyright (C) 1994 Nick Thompson (nix+@cs.cmu.edu)
;;;
;;; 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 of the License, 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, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

;;; this package allows you to set up flags for certain buffers in the
;;; mode line.  when you insert into the buffer, you set the flag,
;;; causing a character to appear in the modeline.  a key sequence
;;; will take you to the first message buffer with new messages -
;;; repeatedly doing this should cycle through buffers with new
;;; messages.  another keystroke will clear the new message flag and
;;; (by default) bury the message buffer.

;;; I've found this to be very nice for zephyr - it's in a separate
;;; package now so that I can use it for IRC too.

;;; To use, modify the following lines to taste and put in .emacs:
;;; 
;;; (setq msgflags-buffers
;;;   '(("*zephyr-personal*" . "P")
;;; 	("*zephyr*" . "Z")
;;;     ("*IRC*" . "I")))
;;; (define-key global-map "\C-xx" 'msgflags-mark-viewed)
;;; (define-key global-map "\C-xz" 'msgflags-show-new)

;;; should probably be more general and handle arbitrary conditions -
;;; using buffer-local variables to store the flags would then be
;;; impractical.

(defvar msgflags-buffers
  "*Alist of (BUFFER-NAME . FLAG-STRING) pairs.  FLAG-STRING will be
placed in the mode line when buffer BUFFER-NAME has new messages"
  '())

(make-variable-buffer-local 'msgflags-new-messages)
(set-default 'msgflags-new-messages nil)

;;; find a buffer in the buffer list with its flag set
(defun msgflags-find-flagged (msgbufs)
  (let ((the-buf nil)
	(bufs msgbufs))
    (save-excursion
      (while (and (not the-buf) bufs)
	(if (get-buffer (car (car bufs)))
	    (progn
	      (set-buffer (car (car bufs)))
	      (if msgflags-new-messages (setq the-buf (car (car bufs))))))
	(setq bufs (cdr bufs))))
    the-buf))

;; pop any buffers with new messages
(defun msgflags-show-new ()
  "Jump to the first buffer with new messages in it"
  ;; could try to complete for msgbuf buffer names if there's an arg?
  (interactive)
  ;; we want to make this function rotate through all buffers with
  ;; valid output.  therefore, first find the current buffer in the
  ;; list of buffers
  (let ((msgbufs-remaining msgflags-buffers)
	(msgbufs msgflags-buffers))
    (while msgbufs
      (cond
       ((equal (buffer-name (current-buffer)) (car (car msgbufs)))
	(setq msgbufs-remaining (cdr msgbufs))
	(setq msgbufs '()))
       (t (setq msgbufs (cdr msgbufs)))))

    ;; first go through the buffers in msgbufs-remaining - this
    ;; allows us to keep rotating
    (let ((newbuf (or (msgflags-find-flagged msgbufs-remaining)
		      (msgflags-find-flagged msgflags-buffers))))
      (if newbuf
	  (switch-to-buffer newbuf)
	(beep)))))

;; mark all messages in the current message buffer as read
(defun msgflags-mark-viewed (keep)
  "Mark all messages in the current buffer as read"
  (interactive "P")
  (setq msgflags-new-messages nil)
  (msgflags-update-mode-line)
  (if (not keep) (bury-buffer)))

;; update the mode line to reflect new messages
(defun msgflags-update-mode-line ()
  (save-excursion
    (let ((flagstring "")
	  (flags msgflags-buffers))
      (while flags
	(cond
	 ((get-buffer (car (car flags)))
	  (set-buffer (car (car flags)))
	  (if msgflags-new-messages
	      (setq flagstring (concat flagstring (cdr (car flags))))
	    (setq flagstring (concat flagstring "-"))))
	 (t (setq flagstring (concat flagstring "-"))))
	(setq flags (cdr flags)))
      (setq global-mode-string flagstring)))
  ;;; trigger a screen update
  (set-buffer-modified-p (buffer-modified-p)))