Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
567 lines (495 sloc) 20.6 KB
;;;_ , Gnus
(load "gnus-settings")
(require 'gnus)
(require 'starttls)
(require 'nnmairix)
(require 'message)
(require 'spam)
(require 'spam-report)
(require 'bbdb)
(require 'bbdb-gnus)
(require 'bbdb-message)
(require 'async)
;; (gnus-compile)
(bbdb-initialize 'gnus 'message)
;; Override definition from spam.el to use async.el
(defun spam-spamassassin-register-with-sa-learn (articles spam
&optional unregister)
"Register articles with spamassassin's sa-learn as spam or non-spam."
(if articles
(let ((action (if unregister spam-sa-learn-unregister-switch
(if spam spam-sa-learn-spam-switch
(summary-buffer-name (buffer-name)))
;; group the articles into mbox format
(dolist (article articles)
(let (article-string)
(with-current-buffer summary-buffer-name
(setq article-string (spam-get-article-as-string article)))
(when (stringp article-string)
;; mbox separator
(insert (concat "From nobody " (current-time-string) "\n"))
(insert article-string)
(insert "\n"))))
;; call sa-learn on all messages at the same time, and also report
;; them as SPAM to the Internet
`(lambda ()
(insert ,(buffer-substring-no-properties
(point-min) (point-max)))
(call-process-region (point-min) (point-max)
nil nil nil "--mbox"
,@(if spam-sa-learn-rebuild
(list action)
(list "--no-rebuild" action)))
(if ,spam
(call-process-region (point-min) (point-max)
,(executable-find "spamassassin-5.12")
nil nil nil "--mbox" "-r"))))
`(lambda (&optional ignore)
(message "Finished learning messsages as %s"
,(if spam "spam" "ham"))))))))
(defvar switch-to-gnus-unplugged nil)
(defvar switch-to-gnus-run nil)
(defun switch-to-gnus (&optional arg)
(interactive "P")
(let* ((alist '("\\`\\*unsent" "\\`\\*Article"
"\\`\\*Summary" "\\`\\*Group"))
(catch 'found
(dolist (regexp alist)
(dolist (buf (buffer-list))
(if (string-match regexp (buffer-name buf))
(throw 'found buf)))))))
(if (and switch-to-gnus-run candidate)
(if (featurep 'ido)
(ido-visit-buffer candidate ido-default-buffer-method)
(switch-to-buffer candidate))
(if (string-match "Group" (buffer-name candidate))
(let ((switch-to-gnus-unplugged arg))
(gnus-group-list-groups gnus-activate-level)
(setq switch-to-gnus-run t)))))
(use-package fetchmail-ctl
(defun maybe-start-fetchmail-and-news ()
(when (and (not switch-to-gnus-unplugged)
(quickping ""))
(do-applescript "tell application \"Notify\" to run")
(add-hook 'gnus-startup-hook 'maybe-start-fetchmail-and-news)
(defadvice shutdown-fetchmail (after stop-mail-after-fetchmail activate)
(lambda ()
(call-process (expand-file-name "~/Messages/manage-mail/stop-mail")))
(lambda (ret)
(do-applescript "tell application \"Notify\" to quit"))))))
(add-hook 'gnus-group-mode-hook 'gnus-topic-mode)
(add-hook 'gnus-group-mode-hook 'hl-line-mode)
(add-hook 'gnus-summary-mode-hook 'hl-line-mode)
(defun my-message-header-setup-hook ()
(message-remove-header "From")
(let ((gcc (message-field-value "Gcc")))
(when (or (null gcc)
(string-match "nnfolder\\+archive:" gcc))
(message-remove-header "Gcc")
(format "Gcc: %s"
(if (string-match "\\`list\\." (or gnus-newsgroup-name ""))
(add-hook 'message-header-setup-hook 'my-message-header-setup-hook)
(defadvice gnus-summary-resend-message-edit (after call-my-mhs-hook activate)
(defun my-gnus-summary-save-parts (&optional arg)
(interactive "P")
(let ((directory "~/Downloads"))
(message "Saving all MIME parts to %s..." directory)
(gnus-summary-save-parts ".*" directory arg)
(message "Saving all MIME parts to %s...done" directory)))
(bind-key "X m" 'my-gnus-summary-save-parts gnus-summary-mode-map)
(defun queue-message-if-not-connected ()
(set (make-local-variable 'gnus-agent-queue-mail)
(if (quickping "") t 'always)))
(add-hook 'message-send-hook 'queue-message-if-not-connected)
(defun kick-postfix-if-needed ()
(if (and (quickping "")
(= 0 (call-process "/usr/bin/sudo" nil nil nil
"/opt/local/libexec/postfix/master" "-t")))
(start-process "postfix" nil "/usr/bin/sudo"
"/opt/local/libexec/postfix/master" "-e" "60")))
(add-hook 'message-sent-hook 'kick-postfix-if-needed)
(defun exit-gnus-on-exit ()
(if (and (fboundp 'gnus-group-exit)
(with-current-buffer (get-buffer "*Group*")
(let (gnus-interactive-exit)
(add-hook 'kill-emacs-hook 'exit-gnus-on-exit)
(defun open-mail-logs ()
(flet ((switch-in-other-buffer
(when buf
(switch-to-buffer-other-window buf))))
(loop initially (delete-other-windows)
with first = t
for log in (directory-files "~/Messages/" t "\\.log\\'")
for buf = (find-file-noselect log)
do (if first
(switch-to-buffer buf)
(setf first nil))
(switch-in-other-buffer buf))
(with-current-buffer buf
(goto-char (point-max))))))
(defun my-gnus-trash-article (arg)
(interactive "P")
(if (string-match "\\(drafts\\|queue\\|delayed\\)" gnus-newsgroup-name)
(gnus-summary-delete-article arg)
(gnus-summary-move-article arg "mail.trash")))
(define-key gnus-summary-mode-map [(meta ?q)] 'gnus-article-fill-long-lines)
(define-key gnus-summary-mode-map [?B delete] 'gnus-summary-delete-article)
(define-key gnus-summary-mode-map [?B backspace] 'my-gnus-trash-article)
(define-key gnus-article-mode-map [(meta ?q)] 'gnus-article-fill-long-lines)
(defface gnus-summary-expirable-face
'((((class color) (background dark))
(:foreground "grey50" :italic t :strike-through t))
(((class color) (background light))
(:foreground "grey55" :italic t :strike-through t)))
"Face used to highlight articles marked as expirable."
:group 'gnus-summary-visual)
(push '((eq mark gnus-expirable-mark) . gnus-summary-expirable-face)
(if window-system
gnus-sum-thread-tree-false-root ""
gnus-sum-thread-tree-single-indent ""
gnus-sum-thread-tree-root ""
gnus-sum-thread-tree-vertical "|"
gnus-sum-thread-tree-leaf-with-other "+-> "
gnus-sum-thread-tree-single-leaf "\\-> "
gnus-sum-thread-tree-indent " "))
(defsubst dot-gnus-tos (time)
"Convert TIME to a floating point number."
(+ (* (car time) 65536.0)
(cadr time)
(/ (or (car (cdr (cdr time))) 0) 1000000.0)))
(defun gnus-user-format-function-S (header)
"Return how much time it's been since something was sent."
(condition-case err
(let ((date (mail-header-date header)))
(if (> (length date) 0)
((then (dot-gnus-tos
(apply 'encode-time (parse-time-string date))))
(now (dot-gnus-tos (current-time)))
(diff (- now then))
((>= diff (* 86400.0 7.0 52.0))
(if (>= diff (* 86400.0 7.0 52.0 10.0))
(format "%3dY" (floor (/ diff (* 86400.0 7.0 52.0))))
(format "%3.1fY" (/ diff (* 86400.0 7.0 52.0)))))
((>= diff (* 86400.0 30.0))
(if (>= diff (* 86400.0 30.0 10.0))
(format "%3dM" (floor (/ diff (* 86400.0 30.0))))
(format "%3.1fM" (/ diff (* 86400.0 30.0)))))
((>= diff (* 86400.0 7.0))
(if (>= diff (* 86400.0 7.0 10.0))
(format "%3dw" (floor (/ diff (* 86400.0 7.0))))
(format "%3.1fw" (/ diff (* 86400.0 7.0)))))
((>= diff 86400.0)
(if (>= diff (* 86400.0 10.0))
(format "%3dd" (floor (/ diff 86400.0)))
(format "%3.1fd" (/ diff 86400.0))))
((>= diff 3600.0)
(if (>= diff (* 3600.0 10.0))
(format "%3dh" (floor (/ diff 3600.0)))
(format "%3.1fh" (/ diff 3600.0))))
((>= diff 60.0)
(if (>= diff (* 60.0 10.0))
(format "%3dm" (floor (/ diff 60.0)))
(format "%3.1fm" (/ diff 60.0))))
(format "%3ds" (floor diff)))))
(replace-regexp-in-string "\\.0" "" str)))
(concat (cond
((= 2 (length stripped)) " ")
((= 3 (length stripped)) " ")
(t ""))
(error " ")))
(defvar gnus-count-recipients-threshold 5
"*Number of recipients to consider as large.")
(defun gnus-user-format-function-r (header)
"Given a Gnus message header, returns priority mark.
Here are the meanings:
The first column represent my relationship to the To: field. It can be:
I didn't appear (and the letter had one recipient)
: I didn't appear (and the letter had more than one recipient)
< I was the sole recipient
+ I was among a few recipients
* There were many recipients
The second column represents the Cc: field:
. I wasn't mentioned, but one other was
: I wasn't mentioned, but others were
^ I was the only Cc mentioned
& I was among a few Cc recipients
% I was among many Cc recipients
These can combine in some ways to tell you at a glance how visible the message
>. Someone wrote to me and one other
& I was copied along with several other people
*: Mail to lots of people in both the To and Cc!"
(let* ((to (or (cdr (assoc 'To (mail-header-extra header))) ""))
(cc (or (cdr (assoc 'Cc (mail-header-extra header))) ""))
(to-len (length (split-string to "\\s-*,\\s-*")))
(cc-len (length (split-string cc "\\s-*,\\s-*")))
(to-char (cond )))
(cond ((string-match gnus-ignored-from-addresses to)
(cond ((= to-len 1)
(cond ((string= cc "") "< ")
((= cc-len 1) "<.")
(t "<:")))
((< to-len gnus-count-recipients-threshold)
(cond ((string= cc "") "+ ")
((= cc-len 1) "+.")
(t "+:")))
(cond ((string= cc "") "* ")
((= cc-len 1) "*.")
(t "*:")))))
((string-match gnus-ignored-from-addresses cc)
(cond ((= cc-len 1)
(cond ((= to-len 1) " ^")
(t ":^")))
((< cc-len gnus-count-recipients-threshold)
(cond ((= to-len 1) " &")
(t ":&")))
(cond ((= to-len 1) " %")
(t ":%")))))
(t " "))))
(use-package message-x)
(use-package gnus-dired
:commands gnus-dired-mode
(add-hook 'dired-mode-hook 'gnus-dired-mode))
(use-package my-gnus-score
(defun gnus-group-get-all-new-news ()
(gnus-group-get-new-news 5)
(gnus-group-list-groups 4)
(gnus-group-list-groups 4))
(define-key gnus-group-mode-map [?v ?g] 'gnus-group-get-all-new-news)))
(use-package gnus-demon
(defun gnus-demon-scan-news-2 ()
(when gnus-plugged
(let ((win (current-window-configuration))
(gnus-read-active-file nil)
(gnus-check-new-newsgroups nil)
(gnus-verbose 2)
(gnus-verbose-backends 5))
(when (gnus-alive-p)
(with-current-buffer gnus-group-buffer
(gnus-group-get-new-news gnus-activate-level))))
(set-window-configuration win)))))
;; (gnus-demon-add-handler 'gnus-demon-scan-news-2 5 2)
(defun save-gnus-newsrc ()
(if (and (fboundp 'gnus-group-exit)
(with-current-buffer (get-buffer "*Group*")
(gnus-demon-add-handler 'save-gnus-newsrc nil 1)
(gnus-demon-add-handler 'gnus-demon-close-connections nil 3)))
(use-package nnir
(defun activate-gnus ()
(unless (get-buffer "*Group*") (gnus)))
(defun gnus-goto-article (message-id)
(gnus-summary-read-group "INBOX" 15 t)
(gnus-summary-refer-article message-id))
(defvar gnus-query-history nil)
(defun gnus-query (query &optional arg)
(list (read-string (format "IMAP Query %s: "
(if current-prefix-arg "All" "Mail"))
(format-time-string "SENTSINCE %d-%b-%Y "
(time-subtract (current-time)
(days-to-time 90)))
(let ((nnir-imap-default-search-key "imap")
(if arg
(concat (regexp-opt
"Sent Messages"))
(concat "\\(\\(list\\|archive\\)\\.\\|"
nil `((query . ,query)
(criteria . "")
(server . "nnimap:Local")))))
(define-key global-map [(alt meta ?f)] 'gnus-query)))
(use-package gnus-harvest
(if (featurep 'message-x)
(gnus-harvest-install 'message-x)
(use-package gnus-alias
:commands (gnus-alias-determine-identity
(add-hook 'message-setup-hook 'gnus-alias-determine-identity)
(if (featurep 'message-x)
(add-hook 'message-x-after-completion-functions
(define-key message-mode-map "\C-c\C-f\C-p" 'gnus-alias-select-identity)))
(use-package rs-gnus-summary
(defalias 'gnus-user-format-function-size
(setq gnus-balloon-face-0 'rs-gnus-balloon-0)
(setq gnus-balloon-face-1 'rs-gnus-balloon-1)))
(use-package supercite
:commands sc-cite-original
(add-hook 'mail-citation-hook 'sc-cite-original)
(defun sc-remove-existing-signature ()
(goto-char (region-beginning))
(when (re-search-forward message-signature-separator (region-end) t)
(delete-region (match-beginning 0) (region-end)))))
(add-hook 'mail-citation-hook 'sc-remove-existing-signature))
(defun sc-fill-if-different (&optional prefix)
"Fill the region bounded by `sc-fill-begin' and point.
Only fill if optional PREFIX is different than
`sc-fill-line-prefix'. If `sc-auto-fill-region-p' is nil, do not
fill region. If PREFIX is not supplied, initialize fill
variables. This is useful for a regi `begin' frame-entry."
(if (not prefix)
(setq sc-fill-line-prefix ""
sc-fill-begin (line-beginning-position))
(if (and sc-auto-fill-region-p
(not (string= prefix sc-fill-line-prefix)))
(let ((fill-prefix sc-fill-line-prefix))
(unless (or (string= fill-prefix "")
(goto-char sc-fill-begin)
(or (looking-at ">+ +")
(< (length
(buffer-substring (point)
(fill-region sc-fill-begin (line-beginning-position)))
(setq sc-fill-line-prefix prefix
sc-fill-begin (line-beginning-position)))))
(use-package browse-url
:commands browse-url
(defun gnus-article-get-urls-region (min max)
"Return a list of urls found in the region between MIN and MAX"
(let (url-list)
(narrow-to-region min max)
(goto-char (point-min))
(while (re-search-forward gnus-button-url-regexp nil t)
(let ((match-string (match-string-no-properties 0)))
(if (and (not (equal (substring match-string 0 4) "file"))
(not (member match-string url-list)))
(setq url-list (cons match-string url-list)))))))
(defun gnus-article-get-current-urls ()
"Return a list of the urls found in the current `gnus-article-buffer'"
(let (url-list)
(with-current-buffer gnus-article-buffer
(setq url-list
(gnus-article-get-urls-region (point-min) (point-max))))
(defun gnus-article-browse-urls ()
"Visit a URL from the `gnus-article-buffer' by showing a
buffer with the list of URLs found with the `gnus-button-url-regexp'."
(gnus-configure-windows 'article)
(gnus-summary-select-article nil nil 'pseudo)
(let ((temp-buffer (generate-new-buffer " *Article URLS*"))
(urls (gnus-article-get-current-urls))
(this-window (selected-window))
(browse-window (get-buffer-window gnus-article-buffer))
(count 0))
(with-current-buffer temp-buffer
(mapc (lambda (string)
(insert (format "\t%d: %s\n" count string))
(setq count (1+ count))) urls)
(pop-to-buffer temp-buffer)
(setq count
(char-to-string (if (fboundp
(kill-buffer temp-buffer)))
(if browse-window
(progn (select-window browse-window)
(browse-url (nth count urls)))))
(select-window this-window)))
(define-key gnus-summary-mode-map [(control ?c) (control ?o)]
(define-key gnus-article-mode-map [(control ?c) (control ?o)]
(provide 'dot-gnus)
;; Local Variables:
;; mode: emacs-lisp
;; mode: allout
;; outline-regexp: "^;;;_\\([,. ]+\\)"
;; End:
;;; dot-gnus.el ends here
Jump to Line
Something went wrong with that request. Please try again.