;;; gnus-select-method and bbdb-ignore-some-messages-alist are set
;;; separately.
(setq mail-sources nil)
(setq gnus-nntp-server nil
gnus-read-active-file nil
gnus-save-newsrc-file nil
gnus-read-newsrc-file nil
gnus-check-new-newsgroups nil)
(setq gnus-thread-sort-functions
'(gnus-thread-sort-by-number
gnus-thread-sort-by-date
gnus-thread-sort-by-total-score))
(setq gnus-permanently-visible-groups "INBOX")
(defun wl-mail-get-new-news-daemon-1 (time idle)
(require 'gnus-demon)
(setq gnus-use-demon t)
(gnus-demon-add-handler 'gnus-group-get-new-news time idle)
(gnus-demon-init))
(defun wl-mail-get-new-news-daemon ()
(wl-mail-get-new-news-daemon-1 30 t))
(add-hook 'gnus-started-hook 'wl-mail-get-new-news-daemon)
(defun mimedown-region (beg end)
(interactive "r")
(save-excursion
(let ((orig-txt (buffer-substring-no-properties beg end)))
(shell-command-on-region beg end markdown-command nil t)
(insert "<#multipart type=alternative>\n")
(insert orig-txt)
(insert "<#part type=text/html>\n\n\n HTML version of email\n\n")
(exchange-point-and-mark)
(insert "\n\n\n<#/multipart>\n"))))
(defun wl-message-goto-body-end ()
"Go to the end of message body. Before attachment part."
(or (save-excursion
(when (re-search-forward
"^<#part .+ filename=.+ disposition=attachment>$"
nil
t)
(forward-line -1)
(end-of-line)
(point)))
(point-max)))
(defun mimedown-message-body ()
(interactive)
(save-excursion
(message-goto-body)
(mimedown-region (point) (wl-message-goto-body-end))))
(defun wl-mail-mimedown-setup ()
(define-key
message-mode-map (kbd "C-c p") 'mimedown-message-body-preview)
(add-hook 'message-send-hook 'mimedown-message-body))
(add-hook 'message-setup-hook 'turn-on-flyspell)
(add-hook 'message-setup-hook 'wl-turn-on-orgtbl-mode)
(add-hook 'message-setup-hook 'wl-turn-on-orgstruct++-mode)
(defun remove-message-send-hook ()
(interactive)
(remove-hook 'message-send-hook 'mimedown-message-body))
(defun mimedown-region-preview (beg end)
(interactive "r")
(save-excursion
(shell-command-on-region beg end markdown-command "*Mail-Preview*")
(with-current-buffer "*Mail-Preview*"
(goto-char (point-min))
(insert "\n\n HTML version of email\n\n")
(goto-char (point-max))
(insert "\n\n\n"))
(browse-url-of-buffer "*Mail-Preview*")))
(defun mimedown-message-body-preview ()
(interactive)
(save-excursion
(message-goto-body)
(mimedown-region-preview (point) (wl-message-goto-body-end))))
;;; org2html can only be used in org major mode.
(defun wl-mail-org2html-string (beg end)
(save-excursion
(let ((region-content (buffer-substring-no-properties beg end)))
(with-temp-buffer
(insert "# -*- org -*-\n")
(insert "#+OPTIONS: ^:nil\n")
(insert "#+TITLE: HTML version of email\n")
(org-mode)
(insert region-content)
(wl-org-export-region-as-html-string (point-min) (point-max))))))
(defun wl-mail-org2html-region (beg end)
(interactive "r")
(save-excursion
(let ((html-txt (wl-mail-org2html-string beg end)))
(goto-char end)
(insert "\n\nThanks,\nLiang.\n<#part type=text/html>\n\n\nHTML version of email\n\n")
(insert html-txt)
(insert "\n\nThanks,
Liang.
\n\n<#/multipart>\n")
(goto-char beg)
(insert "<#multipart type=alternative>\n"))))
(defun wl-mail-org2html-message-body ()
(interactive)
(save-excursion
(message-goto-body)
(wl-mail-org2html-region (point) (wl-message-goto-body-end))))
(defun wl-mail-test-message-body ()
(interactive)
(save-excursion
(message-goto-body)
(wl-mail-org2html-string (point) (wl-message-goto-body-end))))
(add-hook 'message-send-hook 'wl-mail-org2html-message-body)
(defun wl-mail-clear-message-hook ()
(interactive)
(setq message-setup-hook nil)
(setq message-send-hook nil))
(defadvice mml-attach-file (after remove-mimedown-message-body
(file &optional type description disposition))
(message "%s attached" file)
;; (remove-message-send-hook)
)
(defadvice mml-attach-file (around goto-end-of-buffer
(file &optional type description disposition))
(save-excursion
(goto-char (point-max))
(unless (bolp)
(insert "\n"))
ad-do-it))
(ad-activate 'mml-attach-file)
(defadvice gnus-summary-reply (after goto-message-body
(&optional yank wide very-wide))
(message-goto-body)
(insert "\n\nThanks, \nLiang.\n\n----\n\n")
(message-goto-body))
(ad-activate 'gnus-summary-reply)
(defvar wl-message-attachment-word-regex "attached\\|attachment"
"List of words indicates the existence of attachment.")
(defun wl-message-attachment-mentioned-p ()
"If attachment is mentioned is message body"
(save-excursion
(message-goto-body)
(let ((end (or (and message-reply-headers
(re-search-forward
(concat (mail-header-from message-reply-headers)
" writes:")
nil
t))
(point-max))))
(message-goto-body)
(re-search-forward wl-message-attachment-word-regex end t))))
(defun wl-message-attachment-found-p ()
"If there is really attachment"
(save-excursion
(message-goto-body)
(re-search-forward "^<#part .+ filename=.+ disposition=attachment>$" nil t)))
(defadvice message-fix-before-sending (after attachment-reminder
())
(message-check 'attachment
(when (and (wl-message-attachment-mentioned-p)
(not (wl-message-attachment-found-p)))
(unless (y-or-n-p "Attachment not found; continue sending? ")
(error "Attachment not found")))))
(ad-activate 'message-fix-before-sending)
(require-maybe 'bbdb)
(eval-after-load 'bbdb
'(progn
(setq bbdb-file "~/edata/bbdb.gpg")
(setq bbdb-north-american-phone-numbers-p nil)
(bbdb-initialize 'message)
(add-hook 'message-setup-hook 'bbdb-define-all-aliases)
(setq bbdb-use-pop-up nil)
(setq bbdb-default-country "China")))
;;; for anything-c-source-bbdb
(require-maybe 'bbdb-com)
(require-maybe 'boxquote)
;;; Google Contacts
(unless (string-lessp emacs-version "24")
(defvar wl-google-contacts-load-path
"~/elisp/3rd-party-lib/google-contacts.el")
(when (file-exists-p wl-google-contacts-load-path)
(add-to-list 'load-path wl-google-contacts-load-path)
(when (require-maybe 'google-contacts)
(require 'json)
(defadvice google-contacts (around
wl-google-contacts-use-default-browser)
"Use default browser to get code."
(let ((browse-url-browser-function 'browse-url-default-browser))
ad-do-it))
(ad-activate 'google-contacts))))
(provide 'wl-mail)