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

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

;; Author: Arne Jørgensen <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ørgensen")
         (x-face-file "~/.xface")
         (eval (setq ispell-local-dictionary "dansk"))
         )
        ("BS04.*"
         (organization "Det Danske Spejderkorps / Blå Sommer 2004 / Kloden")
         )
        ("PLan"
         (organization "Det Danske Spejderkorps / Plan Røddinglund")
         )
        ("Bellahoej"
         (organization "Det Danske Spejderkorps / Bellahøj -- 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æft\\|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