;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; this file is: emacs lisp
;;
;;
;;
;;    Join the fight against Header Over-Population!
;;    This code will permit civil disobedience within each message
;;    sent from RMAIL
;;
;;
;; Don't you hate it when you get mail with headers like
;; "X-um-er-bo-di-oh-this-is-my-Mailer: Elm or pine or plain old emacs"
;; well...now you can be part of the problem...
;;            (dramatic pause...)
;;
;; With new, improved, automatically generated headers like:
;;
;; "X-teaspoonful-circumflex:  Boastful gaugeable Roman"?
;;
;;
;;  by brd@cs.dartmouth.edu
;; this is SO silly, do I really want to sign my name?
;
; INSTALLATION:
; to make these headers automatic,
; put this command on the mail-setup-hook...
; like this:
;
; (if (boundp 'mail-setup-hook)
;     (setq mail-setup-hook (append  '(mail-hack-x-headers)
;                                     mail-setup-hook))
;   (setq mail-setup-hook '(mail-hack-x-headers)))
;
;    to Modify headers:
;;   this is my key binding:
;;   (define-key mail-mode-map "\C-cx" 'mail-delete-x-hack-header)

(defvar dict-size 24474) ; magic number: number of words in dictionary
(defvar dictionary "/usr/dict/words")

(defun sgi-p ()
  (equal (getenv "OSTYPE") "irix"))

(cond ((sgi-p)
       (setq dict-size 23788) 
       (setq dictionary "/usr/share/lib/dict/words")))

(random t)

(defun get-random-word ()
  (goto-char (point-min))
  (forward-line (random dict-size))
  (beginning-of-line)
  (let ((b (point)))
    (end-of-line)
    (buffer-substring b (point))))

(defun get-random-words (arg)
  "Get random words from the dictionary."
  (interactive "p")
  (save-excursion
    (let ((buf (get-buffer-create "*Random Word Dictionaary*"))
	  (words nil))
      (set-buffer buf)
      (erase-buffer)
      (insert-file dictionary)
      (while (> arg 0)
	(setq words (cons (get-random-word) words))
	(setq arg (- arg 1)))
      (kill-buffer buf)
      words)))

(defvar last-x-hack-header "EXXEXXOOEX1")
(defvar last-x-hack-contents "EXXEXXOOEX2")

; put this command on the mail-setup-hook...

(defun mail-hack-x-headers ()
  "Put in hack X-headers."
  (interactive)
;this is a total kludge
  (mail-delete-in-reply-to-from-message)
  (let ((words (get-random-words 5)))
    (save-excursion
      (let* ((pre-header (mail-hack-header-type))
	     (head (car pre-header))
	     (incomplete-p (car (cdr pre-header))))
	(let ((header  (cond (incomplete-p 
			      (concat head (nth 0 words)
				      "-" (nth 1 words)))
			     (t
			      (concat head "/" (nth 0 words)))))
	      (contents (concat " " (nth 2 words) " "
				(nth 3 words) " "
				(nth 4 words) ".")))
	  (mail-position-on-field header)
	  (end-of-line)
	  (insert contents)
	  (backward-word 3)
	  (capitalize-word 1)
	  (setq last-x-hack-header header)
	  (setq last-x-hack-contents contents))))))
	 
(setq *mail-hack-header-types*
  '(("X-" t)
    ("Mime-" t)
    ("Content-" t)
    ("Encoding" nil)
    ("Resent-" t)
    ("Conversation-Id" nil)
    ("Original-" t)
    ("Posting-" t)
    ("Return-" t)
    ("summary-line" nil)
    ("Importance" nil)
    ("Priority" nil)
    ))

(defvar x-hack-headers-only '("X-" t) "Just this header.")

(defun set-stupid-header (arg)
  "Call this to set the Stupid header."
  (interactive "sHeader: ")
  (setq x-hack-headers-only (list arg t)))

(defun mail-hack-header-type ()
  (cond (x-hack-headers-only )
	(t
	 (let* ((headers *mail-hack-header-types*)
		(n (length headers))
		(header (nth (random n) headers)))
	   header))))

(defun X-mail-hack-x-headers (arg)
  "Put in hack X-headers. The argument is how many."
  (interactive "p")
  (while (> arg 0)
    (mail-hack-x-headers)
    (setq arg (- arg 1))))

(defun mail-delete-x-hack-header (arg)
  "With no argument, Delete the last X-hack header.
   With an argument C-U, substitute a new one.
   With an argument of N C-U's add 4^(N-1) X-hack headers.
   With an argument of N, add (floor N/4) X-hack headers."
  (interactive "p")
  (save-excursion
    (cond ((= arg 1)
	   (mail-position-on-field last-x-hack-header)
	   (delete-region
	    (progn (beginning-of-line 1) (point))
	    (progn (next-line 1) (point))))
	  ((= arg 4)
	   (mail-delete-x-hack-header 1)
	   (mail-hack-x-headers))
	  (t
	   (X-mail-hack-x-headers (/ arg 4))))))

(defvar mail-include-in-reply-to nil
  "*If true, then include the in-reply-to field in replies; if false,
							   kill it.")  
(defun mail-delete-in-reply-to-from-message ()
  (cond ((not mail-include-in-reply-to)
	 (save-excursion
	   (mail-position-on-field "In-Reply-To")
	   (delete-region
	    (progn (beginning-of-line 1) (point))
	    (progn (next-line 1) (point))))
	 (save-excursion ; different capitalization (ugh!)
	   (mail-position-on-field "In-reply-to")
	   (delete-region
	    (progn (beginning-of-line 1) (point))
	    (progn (next-line 1) (point)))))))