Commit | Line | Data |
---|---|---|
1a5de666 AB |
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 |