.gnus.el

;;; .gnus.el --- my .gnus file

;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;;     2006 Arne J,Ax(Brgensen

;; Author: Arne J,Ax(Brgensen <arne@arnested.dk>

;; This file 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 GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; This .gnus contains things that will only work with No Gnus.

;;; Code:

(require 'gnus-load)

;;; select methods
(require 'nnir)
(setq gnus-select-method
      '(nnimap "localhost"
	       (nnimap-server-address "arnested.dk")
	       (nnimap-stream tls)
	       (nnir-search-engine imap)))

(setq gnus-secondary-select-methods 
      '((nntp "daimi"
	      (nntp-address "localhost") ;; ssh port forward from news.daimi.au.dk
	      (nntp-connection-timeout 5))
	(nntp "gmane"
	      (nntp-address "news.gmane.org")
	      (nntp-connection-timeout 5))
	(nntp "dds"
	      (nntp-address "baggesen.net")
	      (nntp-connection-timeout 5))
	(nntp "sslug"
	      (nntp-address "news.sslug.dk")
	      (nntp-connection-timeout 5))))

;;; archival  of messages
(setq gnus-message-archive-method "")
(setq gnus-message-archive-group
      '((when (message-mail-p) "INBOX.Sent")))

(eval-when-compile
  (require 'ispell))

(add-hook 'message-mode-hook 
	  (lambda nil
	    (make-local-variable 'ispell-check-comments)
	    (setq ispell-check-comments nil)
	    (make-local-variable 'ispell-skip-region-alist)
	    (add-to-list 'ispell-skip-region-alist '("<#[^>]*>"))))

;;; Group buffer stuff
;(setq gnus-group-line-format "%M%S%p%P%5y:%B%(%g%)%l %O\n")    ; original
(setq gnus-group-line-format "%M%S%p%P%5y:%B%(%G%)%l %O\n")
(add-hook 'gnus-started-hook
	  (lambda nil
	    (remove-hook 'gnus-save-newsrc-hook 'bbdb-offer-save)))
(add-hook 'gnus-save-newsrc-hook 'bbdb-save-db)

;; Topics mode
(add-hook 'gnus-group-mode-hook 'gnus-topic-mode)
(setq gnus-topic-display-empty-topics nil)
(setq gnus-subscribe-newsgroup-method 'gnus-subscribe-topics)

;;; Summary
(setq gnus-thread-sort-functions '(gnus-thread-sort-by-date))
(set-default 'gnus-summary-expunge-below -900)
(eval-after-load "gnus-sum"
  (set-default 'gnus-summary-expunge-below -900))

(require 'spam-report)
;; (define-key gnus-summary-mode-map "$" 'gnus-summary-mark-as-spam)
(define-key gnus-summary-mode-map "$" 'spam-report-gmane)

(add-hook 'gnus-summary-mode-hook
          (lambda nil
            (when (string-match "nnrss:DR Nyheder Online" gnus-newsgroup-name)
	      (make-local-variable 'gnus-show-threads)
	      (make-local-variable 'gnus-article-sort-functions)
	      (make-local-variable 'gnus-use-adaptive-scoring)
	      (make-local-variable 'gnus-use-scoring)
	      (make-local-variable 'gnus-score-find-score-files-function)
	      (make-local-variable 'gnus-summary-line-format)
	      (setq gnus-show-threads nil)
	      (setq gnus-article-sort-functions 'gnus-article-sort-by-subject)
	      (setq gnus-use-adaptive-scoring nil)
	      (setq gnus-use-scoring t)
	      (setq gnus-score-find-score-files-function 'gnus-score-find-single)
	      (setq gnus-summary-line-format "%U%R%z%d: %I%(%[ %s %]%)\n"))))

;; Display To or Newsgroups in messages from myself
(setq gnus-extra-headers '(To Newsgroups))
(setq gnus-summary-line-format
      "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n")

;;; article mode
(require 'gnus-art)
(setq gnus-treat-body-boundary nil)
(setq gnus-article-emphasize t)
(setq gnus-treat-hide-boring-headers 'head)
(setq gnus-treat-strip-trailing-blank-lines 'last)
(setq gnus-treat-strip-leading-blank-lines 'first)
(setq mm-discouraged-alternatives '("text/html" "text/richtext"))
;; (setq mm-inline-override-types '("text/html"))
(setq gnus-ctan-url "http://www.dante.de/CTAN/")
(add-to-list 'gnus-newsgroup-variables 'gnus-list-identifiers)
(add-to-list 'gnus-newsgroup-variables '(gnus-button-tex-level . 5))
(add-to-list 'gnus-newsgroup-variables '(gnus-button-emacs-level . 5))

(add-to-list 'gnus-buttonized-mime-types "multipart/signed")
(add-to-list 'gnus-buttonized-mime-types "multipart/encrypted")
(add-to-list 'gnus-newsgroup-variables '(mm-verify-option . 'never))

(when (not (listp gnus-visible-headers))
    (setq gnus-visible-headers (list gnus-visible-headers)))
(add-to-list 'gnus-visible-headers "^User-Agent:")
(add-to-list 'gnus-visible-headers "^X-Greylist:.*at seamus")

(setq gnus-article-date-lapsed-new-header t)

(defun my-gnus-article-wash-quoted-from ()
  "Remove >From from the beginning of the lines in the article."
  (interactive)
  (save-excursion
    (let ((inhibit-point-motion-hooks t)
	  (inhibit-read-only t))
      (article-goto-body)
      (while (re-search-forward "^>From " nil t)
	(replace-match "From " t t)))))

(add-hook 'gnus-part-display-hook 'my-gnus-article-wash-quoted-from)

(defun my-gnus-article-wash-borring-address ()
  "Remove borring email adrress from the From: header."
  (interactive)
  (save-excursion
    (let ((inhibit-point-motion-hooks t)
	  (inhibit-read-only t))
      (goto-char (point-min))
      (while (re-search-forward "^\\(From: *\\)\"\\(.*\\)\" *<no_email@dds.dk>" nil t)
	(replace-match "\\1\\2" t nil)))))

(add-hook 'gnus-part-display-hook 'my-gnus-article-wash-borring-address)

;; Posting etc
(require 'message-x)
(setq gnus-confirm-mail-reply-to-news t)
(setq gnus-gcc-mark-as-read t)
(setq gnus-use-generic-from t)
(setq mm-coding-system-priorities '(iso-8859-1 iso-8859-15 utf-8))
(setq message-signature t)
(setq message-signature-file "~/.signatures/dk/normal")
(setq message-courtesy-message nil)
(setq message-from-style 'angles)
(setq message-cite-function 'message-cite-original-without-signature)
(add-hook 'message-sent-hook 'gnus-score-followup-article 100)
(add-hook 'message-sent-hook 'gnus-score-followup-thread 50)
(setq gnus-ignored-from-addresses (regexp-opt '("arne@arnested.dk"
						"arne.jorgensen@tug.dk"
						"kasserer@tug.dk"
						"treasurer@tug.dk"
						"arne@daimi.au.dk"
						"arne@mfsr.au.dk"
						"arne@sr.au.dk"
						"arnjor@niels.brock.dk"
						"dk-tug-kasserer@sunsite.dk"
						"dk-tug-kasserer@sunsite.auc.dk"
						"arne@seamus.arnested.dk"
						"arne@arnested.dyndns.dk"
						"arne@spejder.dk")))
(setq message-dont-reply-to-names gnus-ignored-from-addresses)
(setq message-subscribed-address-functions
      '(gnus-find-subscribed-addresses))
(add-to-list 'gnus-newsgroup-variables 'ispell-local-dictionary)
;; (add-to-list 'gnus-newsgroup-variables 'message-citation-line-function)
(add-hook 'message-setup-hook 'flyspell-mode)
(setq message-mail-alias-type 'ecomplete)

(defun my-message-insert-citation-line ()
  "Insert a simple citation line."
  (when message-reply-headers
    (insert (mail-header-from message-reply-headers))
    (if (string= ispell-local-dictionary "dansk")
	(insert " skriver:\n\n")
      (insert " writes:\n\n"))))
 
(defun my-simple-message-insert-citation-line ()
  "Insert a simple citation line without e-mail address."
  (insert (cdr-safe (ietf-drums-parse-address 
		     (mail-header-from message-reply-headers))))
  (insert " skriver:\n\n"))

(setq message-citation-line-function 'my-message-insert-citation-line)

;; The line below enables completion from BBDB in resending a message
(define-key message-minibuffer-local-map [(tab)]
  'bbdb-complete-name)

;; Posting style
(setq gnus-posting-styles 
      '((".*"
	 (organization "Arne Joergensen -- http://arnested.dk/")
	 (address "arne@arnested.dk")
	 (name "Arne J,Ax(Brgensen")
	 (x-face-file "~/.xface")
	 (eval (setq ispell-local-dictionary "dansk"))
	 )
	("BS04.*"
	 (organization "Det Danske Spejderkorps / Bl,Ae(B Sommer 2004 / Kloden")
	 )
	("PLan"
	 (organization "Det Danske Spejderkorps / Plan R,Ax(Bddinglund")
	 )
	("Bellahoej"
	 (organization "Det Danske Spejderkorps / Bellah,Ax(Bj -- 21st Barking")
	 )
	("^RSS.*"
	 (eval (setq gnus-treat-fill-long-lines t))
	 )
	("\\(gmane\\|gnu\\|comp\\|alt\\|OpenOCES\\|INBOX.Emacs\\).*"
	 (eval (setq ispell-local-dictionary "american"))
	 )
	("\\(gmane.comp.tex.danish\\).*"
	 (eval (setq ispell-local-dictionary "dansk"))
	 )
	("dds\\..*"
	 (organization "Det Danske Spejderkorps")
	 (eval (set (make-local-variable 'message-citation-line-function)
		    'my-simple-message-insert-citation-line))
	 )
	))

;; Gnus Alias
(require 'gnus-alias)
(gnus-alias-init)

(defun my-gnus-alias-set-default nil
  (if (string= ispell-local-dictionary "american")
      (setq gnus-alias-default-identity "Normal (en)")
    (setq gnus-alias-default-identity "Normal (da)")))

(add-hook 'gnus-summary-exit-hook 'my-gnus-alias-set-default)
(add-hook 'gnus-summary-prepare-hook 'my-gnus-alias-set-default)

(defadvice gnus-alias-use-identity (around my-gnus-alias-save-excursion activate)
  "Save excursion when `gnus-alias-use-identity'."
  (save-excursion
    ad-do-it))

(add-to-list 'gnus-newsgroup-variables 'gnus-alias-default-identity)

;; The following code may be useful to open an nnrss url directly from
;; the summary buffer
(require 'nnrss)

(defun browse-nnrss-url (&optional arg)
  (interactive)
  (let ((url (assq nnrss-url-field
                   (mail-header-extra
                    (gnus-data-header
                     (assq (gnus-summary-article-number)
                           gnus-newsgroup-data))))))
    (if url
        (browse-url (cdr url))
      (gnus-summary-scroll-up arg))))

(add-hook 'gnus-summary-mode-hook
	  (lambda ()
	    (when (string-match "nnrss" gnus-newsgroup-name)
	      (define-key gnus-summary-mode-map (kbd "C-c <RET>") 'browse-nnrss-url))))

(add-to-list 'nnmail-extra-headers nnrss-url-field)

;; Article address banners
(setq gnus-article-address-banner-alist
      '(("@yahoo\\.com" . "^__________________+\nDo you Yahoo!\\?\n.*\n.*\n")
	("@hotmail\\.com\\|@msn.com" . "^_________________________________________________________________\n.*MSN .*\n.*\n")
      ("@hotmail\\.com\\|@hotmail.dk\\|@msn.com\\|@msn\\.dk)" . "^_________________________________________________________________\n.*http://messenger.msn.dk")))

;; Non-Gnus download RSS by Jesper Harder
(setq nnrss-use-local t)

(defvar my-nnrss-check-group-interval 300
  "*Number of seconds between retrieval of RSS feeds.")

(defvar my-nnrss-check-group-time
  (- (time-to-seconds (current-time))
     my-nnrss-check-group-interval)
  "Time of last RSS retrieval.")

(defadvice nnrss-check-group (before my-nnrss-check-group activate)
  "Maybe call shell script to fetch RSS feeds.
Feeds are fetched every `my-nnrss-check-group-interval' seconds."
  (when (> (- (time-to-seconds (current-time))
              my-nnrss-check-group-time)
           my-nnrss-check-group-interval)
    (call-process "~/usr/bin/nnrss.sh")
    (setq my-nnrss-check-group-time (float-time))))

;; Gnus Registry
(require 'gnus-registry)
(setq gnus-registry-use-long-group-names t)

(setq gnus-registry-unfollowed-groups '("delayed" "drafts" "queue" 
					"Arkiv"
					"INBOX.Drafts"
					"INBOX.Sent"
					"INBOX.Trash"
					"Spam"
					"Virus"
					;; mailingslists
					"BS04.kloden"
					"BS04.nyhedsbrev"
					"DK-TUG.aarhus"
					"DK-TUG.bib"
					"DK-TUG.foredrag"
					"DK-TUG.konference"
					"DK-TUG.list"
					"DK-TUG.lug-boards"
					"DSF.alle"
					"DSF.dis-rg"
					"DSF.iu"
					"DSF.kons"
					"DSF.levkoo"
					"DSF.natkoo"
					"DSF.oeu"
					"DSF.org"
					"DSF.politik"
					"DSF.unilov"
					"DSF.upu"
					"MFSR.list"
					"Misc."
					"OpenOCES."
					"SRAU.fr"
					"SRAU.kgb"
					"SRAU.lpu"
					"SSLUG."
					"TeX."
					;; other backends (does this work?)
					"nntp+"
					"nnrss:"
					))

(gnus-registry-initialize)

(setq nnimap-split-crosspost t
      nnimap-split-rule 'nnimap-split-fancy
      nnimap-split-fancy '(: gnus-registry-split-fancy-with-parent))

(setq nnimap-split-inbox
      '("INBOX" "INBOX.maildaemon"))

(setq message-subject-re-regexp "^[ \t]*\\(\\([Rr][Ee]\\(\\((\\|\\[\\)[0123456789]\\(\\]\\|)\\)\\)?\\|[Aa][Ww]\\|[Ss][Vv]\\|[Vv][Ss]\\|Vedr\\):[ \t]*\\)*[ \t]*")

(setq gnus-picon-style 'right)

;; spam
(setq spam-report-gmane-use-article-number nil)
(spam-initialize)

(require 'gnus-auto-subscribe)
(add-hook 'gnus-get-new-news-hook 'gnus-auto-subscribe-groups)

;; Try not to send a message without an attachement
(defvar my-message-attachment-regexp "\\(vedh,Af(Bft\\|attach\\)")

(defun my-message-check-attachment nil
  "Check if there is an attachment in the message if I claim it."
  (save-excursion
    (message-goto-body)
    (when (search-forward-regexp my-message-attachment-regexp nil t nil)
      (message-goto-body)
      (unless (or (search-forward "<#part" nil t nil)
		  (message-y-or-n-p
		   "Do you want to send the message without an attachment? " nil nil))
	(error "You forgot an attachment.")))))

(add-hook 'message-send-hook 'my-message-check-attachment)

;; Update .procmailrc
(defadvice gnus-edit-form-done (around my-procmail-edit-update activate)
  "Update Procmail recipes if `procmail' group parameter is changed."
  (let* ((group (save-excursion
		  (set-buffer gnus-group-buffer)
		  (gnus-group-group-name)))
	 (value (gnus-group-find-parameter group 'procmail t)))
    ad-do-it
    (unless (equal value
		   (gnus-group-find-parameter group 'procmail t))
      (gnus-procmail-update))))

(defadvice gnus-procmail-article-add-rule (around my-procmail-add-update activate)
  "Update Procmail recipes if `procmail' group parameter is added."
  (let* (msg
	 (group (save-excursion
		  (set-buffer gnus-group-buffer)
		  (gnus-group-group-name)))
	 (value (gnus-group-find-parameter group 'procmail t)))
    ad-do-it
    (setq msg (current-message))
    (unless (equal value
		   (gnus-group-find-parameter group 'procmail t))
      (gnus-procmail-update)
      (message (concat msg ". " (current-message))))))

(defadvice gnus-group-rename-group (after my-procmail-rename-update activate)
  "Update Procmail recipes when a group is renamed."
  (let ((msg (current-message)))
    (when (gnus-group-find-parameter (ad-get-arg 1) 'procmail t)
      (gnus-procmail-update)
      (message (concat msg ". " (current-message))))))

(defadvice gnus-procmail-update (around my-procmail-update activate)
  "Kill the .procmailrc buffer after an update if it wasn't present before."
  (let ((buf (get-file-buffer gnus-procmail-file)))
    ad-do-it
    (when (and (null buf)
	       (get-file-buffer gnus-procmail-file))
      (kill-buffer (get-file-buffer gnus-procmail-file)))))

(defadvice gnus-group-rename-group (after my-replace-groupnname activate)
  "Update mail-notification settings on group rename."
  (let ((case-fold-search nil))
    (with-temp-buffer
      (call-process "gconftool-2" nil t nil 
		    "--get" "/apps/mail-notification/mailboxes")
      (goto-char (point-min))
      (when (re-search-forward 
	     (concat "\\(/.\\)\\(" (ad-get-arg 0) "\\)\\(,\\|]\\)") nil t)
	(replace-match (concat "\\1" (ad-get-arg 1) "\\3") nil nil)
	(call-process "gconftool-2" nil nil nil 
		      "--type" "list" "--list-type" "string"
		      "--set" "/apps/mail-notification/mailboxes"
		      (buffer-substring-no-properties 
		       (point-min) (1- (point-max))))))))

;; Use "modern" icons in the tool-bar
;; (setq message-tool-bar 'message-tool-bar-gnome
;;       gnus-group-tool-bar 'gnus-group-tool-bar-gnome
;;       gnus-summary-tool-bar 'gnus-summary-tool-bar-gnome)
;; (message-tool-bar-update)
;; (gnus-group-tool-bar-update)
;; (gnus-summary-tool-bar-update)

(gnus-compile)



;; Local Variables:
;; coding: iso-2022-7bit
;; eval: (add-hook 'after-save-hook 'emacs-lisp-byte-compile t t)
;; End:

;;; gnus.el ends here