;;; ivan-gnus --- e-mail, rss and news

(eval-when-compile
  (require 'ivan-load)
  (require 'ivan-var)
  (require 'ivan-face)
  (require 'bbdb-com)
  (require 'ivan-bbdb)
  (require 'ivan-fun)
  (require 'ivan-keymap)
  (require 'nnml)
  (require 'gnus)
  (require 'gnus-topic)
  (require 'gnus-art)
  (require 'gnus-cache)
  (require 'gnus-score)
  (require 'gnus-msg))

(defvar ivan-gnus-archive "nnml:sent"
  "Default mailbox where outgoing messages are saved")

;; internal var
(defvar ivan-gnus-init nil)
(defvar ivan-gnus-reply-from nil)
(defvar ivan-gnus-treat-job '("job$"))
(defvar ivan-gnus-treat-report '("report"))

(defun ivan-gnus ()
  "Start Gnus or switch to buffer if it's already running"
  (interactive)
  (if ivan-gnus-init
      (when (not (ivan-gnus-open-article))
        (ivan-fun-start-or-switch 'gnus "*Group*"))
    (setq ivan-gnus-init t)
    (run-hooks 'ivan-gnus-init-hook)
    (require 'gnus-art)
    ;; Windows layout
    (gnus-add-configuration
     '(article (vertical 1.0
                         (summary .50 point)
                         (article 1.0))))

    ;; prevent moving cursor to colon in summary
    (defalias 'gnus-summary-position-point 'beginning-of-line)

    ;; Fix a couple of annoyances when moving to next group
    (defadvice gnus-summary-next-group (before ivan-gnus-next-group activate)
      "Go to next group without selecting the first article"
      (ad-set-arg 0 t))

    (defadvice gnus-summary-next-group
      (after ivan-gnus-next-group-after activate)
      "Go to next group hide first thread"
      (gnus-summary-hide-thread))

    ;; hook to run before quitting emacs
    (add-hook 'before-kill-emacs-hook 'gnus-group-exit)

    (require 'gnus-util)

    ;; Hack alert: prevents all interactive prompt at startup I use
    ;; it for reading mail without news
    (defalias 'gnus-y-or-n-p 'ivan-gnus-yes)
    (gnus)
    (defalias 'gnus-y-or-n-p 'y-or-n-p)))

(defun ivan-gnus-open-article ()
  "Open article buffer if it exists.
If buffer exists returns t"
  (let ((buffers (buffer-list))
        (ret nil))
    (while buffers
      (when (eq (buffer-local-value 'major-mode (car buffers))
                'gnus-article-mode)
        (switch-to-buffer (car buffers))
        (setq ret t
              buffers nil))
      (setq buffers (cdr buffers)))
    ret))

(defun ivan-gnus-article-mode()
  "Article hook function"
  (ivan-keymap-keep-global gnus-article-mode-map)
  (ivan-keymap-keep-global gnus-mime-button-map)
  (ivan-keymap-define gnus-article-mode-map
                      "h" gnus-summary-toggle-header))

(add-hook 'gnus-article-mode-hook 'ivan-gnus-article-mode)

(defun ivan-gnus-get-to ()
  "Guess address from the envelope header."
  (let ((continue t)
        (search (concat "@" mail-host-address))
        line from)
    (with-current-buffer gnus-article-buffer
      (save-excursion
        (gnus-summary-toggle-header 1)
        (goto-char (point-min))
        (while (and (re-search-forward search nil t) continue)
          (setq line (buffer-substring-no-properties
                      (line-beginning-position) (point)))
          (if (string-match "\tfor \\(.*\\)@" line)
              (setq from (match-string 1 line)
                    continue nil)))
        (gnus-summary-toggle-header -1)))
    (if from
        (progn
          (setq ivan-gnus-reply-from from)
          (make-local-variable 'ivan-gnus-reply-from)
          (setq-default ivan-gnus-reply-from nil)))))

(defun ivan-gnus-group-mode ()
  "Function ran when entering group buffer."

  ;; topic mode outlines different groups
  (gnus-topic-mode)

  (ivan-keymap-keep-global gnus-topic-mode-map)

  ;; Redefine keys
  (ivan-keymap-define gnus-topic-mode-map
                      "<backtab>" gnus-topic-unindent
                      "M-g" gnus-group-get-new-news
                      "p" gnus-group-post-news)
  (ivan-keymap-keep-global gnus-group-mode-map))

(add-hook 'gnus-group-mode-hook 'ivan-gnus-group-mode)

;; Summary mode hook function
(defun ivan-gnus-mail ()
  "Start composing an e-mail"
  (interactive)
  (let* ((gnus-buf "*Group*")
         (buffer-exist (get-buffer gnus-buf)))
    (gnus-msg-mail)
    (if (and (not buffer-exist)
             (get-buffer gnus-buf))
        (kill-buffer gnus-buf))))

(defun ivan-gnus-reply-citation-line ()
  "Insert a simple citation line."
  (when message-reply-headers
    (insert (mail-header-from message-reply-headers)
            (if (string= ivan-var-reply-lang "french")
                " a écrit" " wrote:"))
    (newline)
    (newline)))

(setq message-citation-line-function 'ivan-gnus-reply-citation-line)

(defun ivan-gnus-score-filename (group)
  (concat gnus-kill-files-directory group ".score"))

(defun ivan-gnus-summary-mode ()
  "Handle key bindings in summary mode."

  ;; Wrap long subject line
  (setq truncate-lines nil)

  (ivan-keymap-keep-global gnus-summary-mode-map)

  ;; Summary binding
  (ivan-keymap-define gnus-summary-mode-map
                      ":" bbdb/gnus-show-sender
                      ";" bbdb/gnus-edit-notes
                      "<delete>" gnus-summary-delete-article
                      "R" ivan-gnus-reply-with-original
                      "T" ivan-gnus-reply-top-wide
                      "c" ivan-gnus-catchup-and-goto-next-group
                      "h" gnus-summary-toggle-header
                      "p" gnus-summary-post-news
                      "r" ivan-gnus-reply
                      "t" ivan-gnus-reply-top
                      "v" ivan-gnus-reply-wide
                      "z" gnus-summary-mail-forward))

(add-hook 'gnus-summary-mode-hook 'ivan-gnus-summary-mode)

(defun ivan-gnus-catchup-and-goto-next-group (&optional all)
  "Mark all articles in this group as read and select the next group.
If given a prefix, mark all articles, unread as well as ticked, as
read. Don't ask to confirm."
  (interactive "P")
  (save-excursion
    (gnus-summary-catchup all t))
  (gnus-summary-next-group))

;;; wrappers around reply functions
(defun ivan-gnus-reply ()
  (interactive)
  (gnus-summary-reply)
  (ivan-gnus-get-to))

(defun ivan-gnus-reply-with-original (n)
  (interactive "P")
  (gnus-summary-reply-with-original n)
  (ivan-gnus-get-to))

(defun ivan-gnus-reply-top (n &optional wide)
  (interactive "P")
  (setq message-cite-reply-above 'is-evil)
  (gnus-summary-reply (gnus-summary-work-articles n) wide)
  (setq message-cite-reply-above nil)
  (ivan-gnus-get-to))

(defun ivan-gnus-reply-top-wide (n)
  (interactive "P")
  (ivan-gnus-reply-top n t)
  (ivan-gnus-get-to))

(defun ivan-gnus-reply-wide ()
  (interactive)
  (gnus-summary-very-wide-reply)
  (ivan-gnus-get-to))

(defun ivan-gnus-yes (prompt)
  "What do you want to become when you grow up? A yes man"
  t)

(defun ivan-gnus-save-summaries ()
  "Save all active summary buffers.
Copy of gnus-offer-save-summaries minus the prompt."
  ;; Go through all buffers and find all summaries.
  (dolist (buffer (buffer-list))
    (when (and (setq buffer (buffer-name buffer))
               (string-match "Summary" buffer)
               (with-current-buffer buffer
                 ;; We check that this is, indeed, a summary buffer.
                 (and (eq major-mode 'gnus-summary-mode)
                      ;; Also make sure this isn't bogus.
                      gnus-newsgroup-prepared
                      ;; Also make sure that this isn't a
                      ;; dead summary buffer.
                      (not gnus-dead-summary-mode))))
      (save-excursion
        (switch-to-buffer buffer)
        (gnus-summary-exit)))))

(add-hook 'nnmail-prepare-incoming-header-hook
          'nnmail-remove-list-identifiers)

(setq
 ;; set buttons to normal
 gnus-article-button-face 'widget-button

 ;; Sort unthreaded article by date
 gnus-article-sort-functions  '(gnus-article-sort-by-date)

 ;; always read dribble file
 gnus-always-read-dribble-file t

 ;; turn off cache
 gnus-cacheable-groups "off"

 ;; Prettier line format
 gnus-group-line-format "%p%M%B%S%P%(%G: %y%)\n"

 ;; Use function to deduce score file name
 gnus-home-score-file 'ivan-gnus-score-filename

 ;; quit quietly
 gnus-interactive-exit nil

 gnus-large-newsgroup 10000

 ;; Save outgoing message
 gnus-outgoing-message-group ivan-gnus-archive

 ;; I don't use .newsrsc
 gnus-read-newsrc-file nil
 gnus-save-newsrc-file nil

 ;; I prefer lower case suffix
 gnus-score-file-suffix "score"

 ;; Go offline withouth asking
 gnus-server-unopen-status 'offline

 ;; put group name in full in mode line
 gnus-summary-mode-line-format "Gnus: %G %Z"

 ;; defaut summary line format
 gnus-summary-line-format "%(%U%R%z%&user-date; %-20,20f %B%s%)\n"

 ;; Suppress duplicate article
 gnus-suppress-duplicates t

 ;; Makes presentation more compact by hiding thread subtree
 gnus-thread-hide-subtree t

 ;; Default thread sorting
 gnus-thread-sort-functions '(gnus-thread-sort-by-total-score)

 ;; Headers in the groups buffer
 gnus-topic-line-format "%i%(%{%n%}%)%v\n"

 ;; Cache ticked and dormant articles
 gnus-use-cache t

 ;; prevent save dribble file message
 gnus-use-dribble-file nil

 ;; Fancy date format
 gnus-user-date-format-alist '(((gnus-seconds-today) . "%k:%M    ")
                               (604800 . "%a %k:%M") ; one week
                               ((gnus-seconds-month) . "%a %d   ")
                               ((gnus-seconds-year) . "%b %d   ")
                               (t . "%b %d '%y")) ; fail through

 ;; html renderer
 mm-text-html-renderer 'w3m

 ;; display picture
 mm-inline-text-html-with-images t
 mm-w3m-safe-url-regexp "\\(\\.*cid\\|\\.\\(jpg\\|gif\\|png\\)\\)$")

;; Gradient face for citations
(ivan-face-gradient "gnus-cite-" 11 "light blue" "blue")

(ivan-face
 gnus-cite-attribution normal
 gnus-cite-attribution-face normal
 gnus-emphasis-bold yellow
 gnus-emphasis-bold-italic yellow
 gnus-emphasis-italic yellow
 gnus-emphasis-underline-bold underline
 gnus-emphasis-underline-bold-italic underline
 gnus-emphasis-underline-italic underline
 gnus-group-mail-1 normal
 gnus-group-mail-1-empty normal
 gnus-group-mail-2 normal
 gnus-group-mail-2-empty normal
 gnus-group-mail-3 normal
 gnus-group-mail-3-empty normal
 gnus-group-mail-4 normal
 gnus-group-mail-5 normal
 gnus-group-mail-6 normal
 gnus-group-mail-low normal
 gnus-group-mail-low-empty normal
 gnus-group-news-1 normal
 gnus-group-news-1-empty normal
 gnus-group-news-2 normal
 gnus-group-news-2-empty normal
 gnus-group-news-3 normal
 gnus-group-news-3-empty normal
 gnus-group-news-4 normal
 gnus-group-news-4-empty normal
 gnus-group-news-5 normal
 gnus-group-news-5-empty normal
 gnus-group-news-6 normal
 gnus-group-news-6-empty normal
 gnus-group-news-low normal
 gnus-group-news-low-empty normal
 gnus-header-content normal
 gnus-header-from blue
 gnus-header-name normal
 gnus-header-newsgroups normal
 gnus-header-subject yellow
 gnus-server-agent blue
 gnus-server-closed purple
 gnus-server-denied yellow
 gnus-server-offline yellow
 gnus-server-opened green
 gnus-signature green
 gnus-summary-cancelled orange
 gnus-summary-high-ancient blue
 gnus-summary-high-read green
 gnus-summary-high-ticked red
 gnus-summary-high-undownloaded purple
 gnus-summary-high-unread normal
 gnus-summary-low-ancient green
 gnus-summary-low-read green
 gnus-summary-low-ticked normal
 gnus-summary-low-undownloaded normal
 gnus-summary-low-unread normal
 gnus-summary-normal-ticked pink
 gnus-summary-selected underline
 message-cited-text green
 message-header-cc blue
 message-header-content normal
 message-header-name normal
 message-header-newsgroups yellow
 message-header-other normal
 message-header-subject yellow
 message-header-to blue
 message-header-xheader blue
 message-highlighted-header-contents blue
 message-mml green
 message-separator normal
 mm-uu-extract normal)

(provide 'ivan-gnus)

;; Copyright (C) 2007 Ivan Kanis
;; Author: Ivan Kanis
;;
;;
;; 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA