I found another problem in the MH interface which could cause an
integer-or-markerp error (for example, when displaying a draft message
that has no From: field). Basically, one function returns "" on failure,
and the function using it expects nil instead. Here's a new set of
patches for the original BBDB 1.48 version of bbdb-mhe.el. It
incorporates the earlier patches I've made to this file.
Fritz
*** bbdb-mhe.el.orig Sat Jul 24 11:16:29 1993
--- bbdb-mhe.el Tue Nov 30 14:00:57 1993
***************
*** 4,9 ****
--- 4,10 ----
;;; copyright (c) 1991 Todd Kaufmann <[EMAIL PROTECTED]>
;;; Interface to mh-e version 3.7 or later (modeled after bbdb-rmail).
;;; Created 5-Mar-91; Last modified: 24-jul-93. by jwz.
+ ;;; Modified 30-Nov-93 by [EMAIL PROTECTED]
;;; 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
***************
*** 20,34 ****
;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(require 'bbdb)
! (require 'mh-e) ; Note- we later redefine a function in this file.
(defmacro bbdb/mh-cache-key (message)
"Return a (numeric) key for MESSAGE"
! ;; assumes message is a buffer-file-name like /usr/celine/Mail/inbox/2323,
! ;; and gets the 2323 from it.
! (list 'string-to-int (list 'file-name-nondirectory message)))
-
;;;% Currently assumes msg buffer is the current buffer,
;;;% as usually (always?) is when called from the hook.
--- 21,35 ----
;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(require 'bbdb)
! (require 'mh-e) ; Note- we advise several functions in this file.
! (require 'advice)
(defmacro bbdb/mh-cache-key (message)
"Return a (numeric) key for MESSAGE"
! (`(let* ((attrs (file-attributes (, message)))
! (status-time (nth 6 attrs)))
! (logxor (nth 10 attrs) (car status-time) (car (cdr status-time))))))
;;;% Currently assumes msg buffer is the current buffer,
;;;% as usually (always?) is when called from the hook.
***************
*** 39,61 ****
the user confirms the creation."
(if bbdb-use-pop-up
(bbdb/mh-pop-up-bbdb-buffer offer-to-create)
- (if (and (boundp 'mh-show-buffer)
- (bufferp mh-show-buffer)
- (buffer-name mh-show-buffer)) ; not killed; gnus messes this up
- (set-buffer mh-show-buffer))
(let ((msg (bbdb/mh-cache-key buffer-file-name)))
! (if (eq msg 0) (setq msg nil)) ; 0 could mean trouble; be safe.
! (or (bbdb-message-cache-lookup msg nil) ; nil = current-buffer
! (let ((from (bbdb/mh-get-field "^From[ \t]*:"))
! name net)
! (if (or (null from)
! (string-match (bbdb-user-mail-names)
! (mail-strip-quoted-names from)))
! ;; if logged-in user sent this, use recipients.
! (setq from (or (bbdb/mh-get-field "^To[ \t]*:") from)))
! (if from
! (bbdb-encache-message msg
! (bbdb-annotate-message-sender from t
(or (bbdb-invoke-hook-for-value bbdb/mail-auto-create-p)
offer-to-create)
offer-to-create))))))))
--- 40,63 ----
the user confirms the creation."
(if bbdb-use-pop-up
(bbdb/mh-pop-up-bbdb-buffer offer-to-create)
(let ((msg (bbdb/mh-cache-key buffer-file-name)))
! (if (eq msg 0) (setq msg nil)) ; 0 could mean trouble; be safe.
! (or (bbdb-message-cache-lookup msg nil) ; nil = current-buffer
! (let ((from (bbdb/mh-get-field "^From[ \t]*:"))
! name net)
! (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
! (bbdb-encache-message msg
! (bbdb-annotate-message-sender from t
(or (bbdb-invoke-hook-for-value bbdb/mail-auto-create-p)
offer-to-create)
offer-to-create))))))))
***************
*** 67,75 ****
(interactive (list (if bbdb-readonly-p
(error "The Insidious Big Brother Database is read-only.")
(read-string "Comments: "))))
! (if (and (boundp 'mh-show-buffer) mh-show-buffer)
! (set-buffer mh-show-buffer))
! (bbdb-annotate-notes (bbdb/mh-update-record t) string))
(defun bbdb/mh-edit-notes (&optional arg)
--- 69,81 ----
(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)
! (set-buffer b)
! (goto-char p)))
(defun bbdb/mh-edit-notes (&optional arg)
***************
*** 76,97 ****
"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")
! (let ((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))))
(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)
! (if (and (boundp 'mh-show-buffer) mh-show-buffer)
! (set-buffer mh-show-buffer))
! (let ((record (bbdb/mh-update-record t)))
! (if record
! (bbdb-display-records (list record))
! (error "unperson"))))
(defun bbdb/mh-pop-up-bbdb-buffer (&optional offer-to-create)
--- 82,114 ----
"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)))
+
(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)
***************
*** 101,122 ****
(function (lambda (w)
(let ((b (current-buffer)))
(set-buffer (window-buffer w))
! ;; I don't understand what this is supposed to do - tk
! ; (prog1 (eq major-mode 'rmail-mode) ; no such mode for show buffers...
(match "^show" ..) ?
! ; (set-buffer b))
! ))))
(let ((bbdb-gag-messages t)
(bbdb-use-pop-up nil)
! (bbdb-electric-p nil)
! (saved-point (point)))
(let ((record (bbdb/mh-update-record offer-to-create))
! (bbdb-elided-display (bbdb-pop-up-elided-display))
! (b (current-buffer)))
(bbdb-display-records (if record (list record) nil))
! (set-buffer b)
! (goto-char saved-point)
! record)
! ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
--- 118,132 ----
(function (lambda (w)
(let ((b (current-buffer)))
(set-buffer (window-buffer w))
! (prog1 (eq major-mode 'mh-folder-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-elided-display (bbdb-pop-up-elided-display)))
(bbdb-display-records (if record (list record) nil))
! record)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
***************
*** 128,183 ****
(defvar mh-show-message-hook ()
"Invoked after message is displayed in buffer.")
! ;;; This has been modified to call mh-show-message-hook after setting up the message
! ;;;
! (defun mh-display-msg (msg-num folder)
! ;; Display message NUMBER of FOLDER.
! (set-buffer folder)
! ;; Bind variables in folder buffer in case they are local
! (let ((formfile mhl-formfile)
! (clean-message-header mh-clean-message-header)
! (invisible-headers mh-invisible-headers)
! (visible-headers mh-visible-headers)
! (msg-filename (mh-msg-filename msg-num))
! (show-buffer mh-show-buffer)
! (folder mh-current-folder))
! (if (not (file-exists-p msg-filename))
! (error "Message %d does not exist" msg-num))
! (switch-to-buffer show-buffer)
! (if mh-bury-show-buffer (bury-buffer (current-buffer)))
! (mh-when (not (equal msg-filename buffer-file-name))
! ;; Buffer does not yet contain message.
! (clear-visited-file-modtime)
! (unlock-buffer)
! (setq buffer-file-name nil) ; no locking during setup
! (erase-buffer)
! (if formfile
! (if (stringp formfile)
! (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
! "-form" formfile msg-filename)
! (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
! msg-filename))
! (insert-file-contents msg-filename))
! (goto-char (point-min))
! (cond (clean-message-header
! (mh-clean-msg-header (point-min)
! invisible-headers
! visible-headers)
! (goto-char (point-min)))
! (t
! (let ((case-fold-search t))
! (re-search-forward
! "^To:\\|^From:\\|^Subject:\\|^Date:" nil t)
! (beginning-of-line)
! (mh-recenter 0))))
! (set-buffer-modified-p nil)
! (setq buffer-file-name msg-filename)
! (set-mark nil)
! (setq mode-line-buffer-identification
! (list (format mh-show-buffer-mode-line-buffer-id
! folder msg-num)))))
! (run-hooks 'mh-show-message-hook)
! )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; this is a more strict version of mh-get-field which takes an regexp
--- 138,147 ----
(defvar mh-show-message-hook ()
"Invoked after message is displayed in buffer.")
! ;; Modify mh-display-msg to call mh-show-message-hook after setting up
! ;; the message
! (defadvice mh-display-msg (after mh-bbdb-display-msg act)
! (run-hooks 'mh-show-message-hook))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; this is a more strict version of mh-get-field which takes an regexp
***************
*** 200,278 ****
(format "%s%s" field
(buffer-substring end-of-match (point)))))))))
! (defun bbdb/mh-execute-commands ()
! "Process outstanding delete and refile requests."
! (interactive)
! (save-excursion
! (set-buffer mh-show-buffer)
! (setq bbdb-message-cache nil))
! (bbdb-orig-mh-execute-commands))
! (defun mh-send (to cc subject)
! "Compose and send a letter."
(interactive (list
(bbdb-read-addresses-with-completion "To: ")
(bbdb-read-addresses-with-completion "Cc: ")
! (read-string "Subject: ")))
! (let ((config (current-window-configuration)))
! (delete-other-windows)
! (mh-send-sub to cc subject config)))
! ;; from [EMAIL PROTECTED]
! (defun mh-send-other-window (to cc subject)
! "Compose and send a letter in another window.."
(interactive (list
(bbdb-read-addresses-with-completion "To: ")
(bbdb-read-addresses-with-completion "Cc: ")
! (read-string "Subject: ")))
! (let ((pop-up-windows t))
! (mh-send-sub to cc subject (current-window-configuration))))
! ;; from [EMAIL PROTECTED]
! (defun mh-forward (prefix-provided msg-or-seq to cc)
! "Forward MESSAGE(s) (default: displayed message).
! If optional prefix argument provided, then prompt for the message sequence."
(interactive (list current-prefix-arg
(if current-prefix-arg
(mh-read-seq-default "Forward" t)
(mh-get-msg-num t))
(bbdb-read-addresses-with-completion "To: ")
! (bbdb-read-addresses-with-completion "Cc: ")))
! (let* ((folder mh-current-folder)
! (config (current-window-configuration))
! ;; forw always leaves file in "draft" since it doesn't have -draft
! (draft-name (expand-file-name "draft" mh-user-path))
! (draft (cond ((or (not (file-exists-p draft-name))
! (y-or-n-p "The file 'draft' exists. Discard it? "))
! (mh-exec-cmd "forw"
! "-build" mh-current-folder msg-or-seq)
! (prog1
! (mh-read-draft "" draft-name t)
! (mh-insert-fields "To:" to "Cc:" cc)
! (set-buffer-modified-p nil)))
! (t
! (mh-read-draft "" draft-name nil)))))
! (goto-char (point-min))
! (re-search-forward "^------- Forwarded Message")
! (forward-line -1)
! (narrow-to-region (point) (point-max))
! (let* ((subject (save-excursion (mh-get-field "From:")))
! (trim (string-match "<" subject))
! (forw-subject (save-excursion (mh-get-field "Subject:"))))
! (if trim
! (setq subject (substring subject 0 (1- trim))))
! (widen)
! (save-excursion
! (mh-insert-fields "Subject:" (format "[%s: %s]" subject forw-subject)))
! (delete-other-windows)
! (if prefix-provided
! (mh-add-msgs-to-seq (mh-seq-to-msgs msg-or-seq) 'forwarded t)
! (mh-add-msgs-to-seq msg-or-seq 'forwarded t))
! (mh-compose-and-send-mail draft "" folder msg-or-seq
! to subject cc
! mh-note-forw "Forwarded:"
! config))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; mail from bbdb-mode using mh
--- 164,198 ----
(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 current-prefix-arg
(if current-prefix-arg
(mh-read-seq-default "Forward" t)
(mh-get-msg-num t))
(bbdb-read-addresses-with-completion "To: ")
! (bbdb-read-addresses-with-completion "Cc: "))))
+ (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
***************
*** 285,297 ****
(define-key mh-folder-mode-map ":" 'bbdb/mh-show-sender)
(define-key mh-folder-mode-map ";" 'bbdb/mh-edit-notes)
(bbdb-add-hook 'mh-show-message-hook 'bbdb/mh-update-record)
-
- ;; We must patch into the "expunge" command to clear the cache, since
- ;; expunging a message invalidates the cache (which is based on msg numbers).
- (or (fboundp 'bbdb-orig-mh-execute-commands)
- (fset 'bbdb-orig-mh-execute-commands
- (symbol-function 'mh-execute-commands)))
- (fset 'mh-execute-commands 'bbdb/mh-execute-commands)
)
(provide 'bbdb-mhe)
--- 205,210 ----
