| 1 | ;;; bbdb-mhe.el --- BBDB interface to mh-e -*- lexical-binding: t -*- |
| 2 | |
| 3 | ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; This file is part of the Insidious Big Brother Database (aka BBDB), |
| 6 | |
| 7 | ;; BBDB is free software: you can redistribute it and/or modify |
| 8 | ;; it under the terms of the GNU General Public License as published by |
| 9 | ;; the Free Software Foundation, either version 3 of the License, or |
| 10 | ;; (at your option) any later version. |
| 11 | |
| 12 | ;; BBDB is distributed in the hope that it will be useful, |
| 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 15 | ;; GNU General Public License for more details. |
| 16 | |
| 17 | ;; You should have received a copy of the GNU General Public License |
| 18 | ;; along with BBDB. If not, see <http://www.gnu.org/licenses/>. |
| 19 | |
| 20 | ;;; Commentary: |
| 21 | ;;; This file contains the BBDB interface to mh-e. |
| 22 | ;;; See the BBDB info manual for documentation. |
| 23 | |
| 24 | ;;; Code: |
| 25 | |
| 26 | (require 'bbdb) |
| 27 | (require 'bbdb-com) |
| 28 | (require 'bbdb-mua) |
| 29 | (require 'mh-e) |
| 30 | (if (fboundp 'mh-version) |
| 31 | (require 'mh-comp)) ; For mh-e 4.x |
| 32 | (require 'advice) |
| 33 | |
| 34 | ;; A simplified `mail-fetch-field'. We could use instead (like rmail): |
| 35 | ;; (mail-header (intern-soft (downcase header)) (mail-header-extract)) |
| 36 | ;;;###autoload |
| 37 | (defun bbdb/mh-header (header) |
| 38 | "Find and return the value of HEADER in the current buffer. |
| 39 | Returns the empty string if HEADER is not in the message." |
| 40 | (let ((case-fold-search t)) |
| 41 | (goto-char (point-min)) |
| 42 | ;; This will be fooled if HEADER appears in the body of the message. |
| 43 | ;; Also, it fails if HEADER appears more than once. |
| 44 | (cond ((not (re-search-forward header nil t)) "") |
| 45 | ((looking-at "[\t ]*$") "") |
| 46 | (t (re-search-forward "[ \t]*\\([^ \t\n].*\\)$" nil t) |
| 47 | (let ((start (match-beginning 1))) |
| 48 | (while (progn (forward-line 1) |
| 49 | (looking-at "[ \t]"))) |
| 50 | (backward-char 1) |
| 51 | (buffer-substring-no-properties start (point))))))) |
| 52 | |
| 53 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 54 | ;; Use BBDB for interactive spec of MH-E commands |
| 55 | |
| 56 | (defadvice mh-send (before mh-bbdb-send act) |
| 57 | (interactive |
| 58 | (list (bbdb-completing-read-mails "To: ") |
| 59 | (bbdb-completing-read-mails "Cc: ") |
| 60 | (read-string "Subject: ")))) |
| 61 | |
| 62 | (defadvice mh-send-other-window (before mh-bbdb-send-other act) |
| 63 | (interactive |
| 64 | (list (bbdb-completing-read-mails "To: ") |
| 65 | (bbdb-completing-read-mails "Cc: ") |
| 66 | (read-string "Subject: ")))) |
| 67 | |
| 68 | (defadvice mh-forward (before mh-bbdb-forward act) |
| 69 | (interactive |
| 70 | (list (bbdb-completing-read-mails "To: ") |
| 71 | (bbdb-completing-read-mails "Cc: ") |
| 72 | (if current-prefix-arg |
| 73 | (mh-read-seq-default "Forward" t) |
| 74 | (mh-get-msg-num t))))) |
| 75 | |
| 76 | (defadvice mh-redistribute (before mh-bbdb-redist act) |
| 77 | (interactive |
| 78 | (list (bbdb-completing-read-mails "Redist-To: ") |
| 79 | (bbdb-completing-read-mails "Redist-Cc: ") |
| 80 | (mh-get-msg-num t)))) |
| 81 | |
| 82 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 83 | |
| 84 | ;;;###autoload |
| 85 | (defun bbdb-insinuate-mh () |
| 86 | "Call this function to hook BBDB into MH-E. |
| 87 | Do not call this in your init file. Use `bbdb-initialize'." |
| 88 | (define-key mh-folder-mode-map ":" 'bbdb-mua-display-sender) |
| 89 | (define-key mh-folder-mode-map ";" 'bbdb-mua-edit-field-sender) |
| 90 | ;; Do we need keybindings for more commands? Suggestions welcome. |
| 91 | ;; (define-key mh-folder-mode-map ":" 'bbdb-mua-display-records) |
| 92 | ;; (define-key mh-folder-mode-map "'" 'bbdb-mua-display-recipients) |
| 93 | ;; (define-key mh-folder-mode-map ";" 'bbdb-mua-edit-field-recipients) |
| 94 | (when bbdb-complete-mail |
| 95 | (define-key mh-letter-mode-map "\M-;" 'bbdb-complete-mail) |
| 96 | (define-key mh-letter-mode-map "\e\t" 'bbdb-complete-mail))) |
| 97 | |
| 98 | (provide 'bbdb-mhe) |
| 99 | |
| 100 | ;;; bbdb-mhe.el ends here |