summaryrefslogtreecommitdiff
path: root/lisp/bbdb-mhe.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/bbdb-mhe.el')
-rw-r--r--lisp/bbdb-mhe.el225
1 files changed, 0 insertions, 225 deletions
diff --git a/lisp/bbdb-mhe.el b/lisp/bbdb-mhe.el
deleted file mode 100644
index ee7187d..0000000
--- a/lisp/bbdb-mhe.el
+++ /dev/null
@@ -1,225 +0,0 @@
-;;; -*- Mode:Emacs-Lisp -*-
-
-;;; This file is part of the Insidious Big Brother Database (aka BBDB),
-;;; copyright (c) 1991 Todd Kaufmann <toad@cs.cmu.edu>
-;;; Interface to mh-e version 3.7 or later (modeled after bbdb-rmail).
-;;; Created 5-Mar-91;
-;;; Modified: 28-Jul-94 by Fritz Knabe <knabe@ecrc.de>
-;;; Jack Repenning <jackr@dblues.wpd.sgi.com>
-
-;;; The Insidious Big Brother Database 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 1, or (at your
-;;; option) any later version.
-;;;
-;;; BBDB 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 GNU Emacs; see the file COPYING. If not, write to
-;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-(eval-and-compile
- (require 'bbdb)
- (require 'bbdb-com)
- (require 'mail-utils)
- ;; We advise several mh-e functions
- (require 'mh-e)
- (if (fboundp 'mh-version)
- (require 'mh-comp)) ; For mh-e 4.x
- (require 'advice))
-
-(defmacro bbdb/mh-cache-key (message)
- "Return a (numeric) key for MESSAGE"
- `(let* ((attrs (file-attributes , message))
- (status-time (nth 6 attrs))
- (status-time-2 (cdr status-time))
- (inode (nth 10 attrs)))
- (logxor (if (integerp inode) ;; if inode is larger than an emacs int,
- inode ;; it's returned as a dotted pair
- (car inode))
- (car status-time)
- ;; We need the following test because XEmacs returns the
- ;; status time as a dotted pair, whereas FSF and Epoch
- ;; return it as list.
- (if (integerp status-time-2)
- status-time-2
- (car status-time-2)))))
-
-;;;###autoload
-(defun bbdb/mh-update-record (&optional offer-to-create)
- "Returns the record corresponding to the current MH message, creating or
-modifying it as necessary. A record will be created if
-bbdb/mail-auto-create-p is non-nil, or if OFFER-TO-CREATE is true and
-the user confirms the creation."
- (save-excursion
- (and mh-show-buffer (set-buffer mh-show-buffer))
- (if bbdb-use-pop-up
- (bbdb/mh-pop-up-bbdb-buffer offer-to-create)
- (let ((msg (bbdb/mh-cache-key buffer-file-name))
- records record)
- (if (eq msg 0) (setq msg nil)) ; 0 could mean trouble; be safe.
- (setq records (bbdb-message-cache-lookup msg))
- (if records
- (car records)
- (let ((from (bbdb/mh-get-field "^From[ \t]*:")))
- (if (or (string= "" from)
- (string-match (bbdb-user-mail-names)
- (mail-strip-quoted-names from)))
- ;; if logged-in user sent this, use recipients.
- (progn
- (setq from (bbdb/mh-get-field "^To[ \t]*:"))
- (if (or (string= "" from)
- (string-match (bbdb-user-mail-names)
- (mail-strip-quoted-names from)))
- (setq from nil))))
- (if from
- (setq record
- (bbdb-annotate-message-sender
- from t
- (or (bbdb-invoke-hook-for-value bbdb/mail-auto-create-p)
- offer-to-create)
- ;; ugh. what the hell?
- (or offer-to-create
- (bbdb-invoke-hook-for-value bbdb/mail-auto-create-p)))))
- (if (and msg record) (bbdb-encache-message msg (list record)))
- ;; return one record
- record))))))
-
-;;;###autoload
-(defun bbdb/mh-annotate-sender (string &optional replace)
- "Add a line to the end of the Notes field of the BBDB record
-corresponding to the sender of this message. If REPLACE is non-nil,
-replace the existing notes entry (if any)."
- (interactive (list (if bbdb-readonly-p
- (error "The Insidious Big Brother Database is read-only.")
- (read-string "Comments: "))))
- (mh-show)
- (let ((b (current-buffer))
- (p (point)))
- (set-buffer mh-show-buffer)
- (bbdb-annotate-notes (bbdb/mh-update-record t) string 'notes replace)
- (set-buffer b)
- (goto-char p)))
-
-
-(defun bbdb/mh-edit-notes (&optional arg)
- "Edit the notes field or (with a prefix arg) a user-defined field
-of the BBDB record corresponding to the sender of this message."
- (interactive "P")
- (mh-show)
- (let ((b (current-buffer))
- (p (point)))
- (set-buffer mh-show-buffer)
- (let (bbdb-electric-p (record (or (bbdb/mh-update-record t) (error ""))))
- (bbdb-display-records (list record))
- (if arg
- (bbdb-record-edit-property record nil t)
- (bbdb-record-edit-notes record t)))
- (set-buffer b)
- (goto-char p)))
-
-
-;;;###autoload
-(defun bbdb/mh-show-sender ()
- "Display the contents of the BBDB for the sender of this message.
-This buffer will be in bbdb-mode, with associated keybindings."
- (interactive)
- (mh-show)
- (let ((b (current-buffer))
- (p (point)))
- (set-buffer mh-show-buffer)
- (let ((record (bbdb/mh-update-record t)))
- (if record
- (bbdb-display-records (list record))
- (error "unperson")))
- (set-buffer b)
- (goto-char p)))
-
-
-(defun bbdb/mh-pop-up-bbdb-buffer (&optional offer-to-create)
- "Make the *BBDB* buffer be displayed along with the MH window,
-displaying the record corresponding to the sender of the current message."
- (bbdb-pop-up-bbdb-buffer
- (function (lambda (w)
- (let ((b (current-buffer)))
- (set-buffer (window-buffer w))
- (prog1 (eq major-mode 'mh-show-mode)
- (set-buffer b))))))
- (let ((bbdb-gag-messages t)
- (bbdb-use-pop-up nil)
- (bbdb-electric-p nil))
- (let ((record (bbdb/mh-update-record offer-to-create)))
- (bbdb-display-records (if record (list record) nil)
- bbdb-pop-up-display-layout)
- record)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; this is a more strict version of mh-get-field which takes an regexp
-
-(defun bbdb/mh-get-field (field)
- ;; Find and return the value of field FIELD (regexp) in the current buffer.
- ;; Returns the empty string if the field is not in the message.
- (let ((case-fold-search nil))
- (goto-char (point-min))
- (cond ((not (re-search-forward field nil t)) "")
- ((looking-at "[\t ]*$") "")
- (t (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t)
- (let ((field (buffer-substring (match-beginning 1) (match-end 1)))
- (end-of-match (point)))
- (forward-line)
- (while (looking-at "[ \t]") (forward-line 1))
- (backward-char 1)
- (if (<= (point) end-of-match)
- field
- (format "%s%s" field
- (buffer-substring end-of-match (point)))))))))
-
-(defadvice mh-process-commands (after mh-bbdb-process act)
- (bbdb-offer-save))
-
-(defadvice mh-send (before mh-bbdb-send act)
- (interactive (list
- (bbdb-read-addresses-with-completion "To: ")
- (bbdb-read-addresses-with-completion "Cc: ")
- (read-string "Subject: "))))
-
-(defadvice mh-send-other-window (before mh-bbdb-send-other act)
- (interactive (list
- (bbdb-read-addresses-with-completion "To: ")
- (bbdb-read-addresses-with-completion "Cc: ")
- (read-string "Subject: "))))
-
-(defadvice mh-forward (before mh-bbdb-forward act)
- (interactive (list (bbdb-read-addresses-with-completion "To: ")
- (bbdb-read-addresses-with-completion "Cc: ")
- (if current-prefix-arg
- (mh-read-seq-default "Forward" t)
- (mh-get-msg-num t)))))
-
-(defadvice mh-redistribute (before mh-bbdb-redist act)
- (interactive (list
- (bbdb-read-addresses-with-completion "Redist-To: ")
- (bbdb-read-addresses-with-completion "Redist-Cc: ")
- (mh-get-msg-num t))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; mail from bbdb-mode using mh
-
-;; these redefine the bbdb-send-mail functions to use mh-send.
-
-;;; Install bbdb into mh-e's show-message function
-
-;;;###autoload
-(defun bbdb-insinuate-mh ()
- "Call this function to hook BBDB into MH-E."
- (define-key mh-folder-mode-map ":" 'bbdb/mh-show-sender)
- (define-key mh-folder-mode-map ";" 'bbdb/mh-edit-notes)
- (define-key mh-letter-mode-map "\M-;" 'bbdb-complete-name)
- (add-hook 'mh-show-hook 'bbdb/mh-update-record)
- (define-key mh-letter-mode-map "\e\t" 'bbdb-complete-name))
-
-(provide 'bbdb-mhe)
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-11 12:15:57 +0000