diff lisp/hyperbole/hmail.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 4103f0995bd7
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/hyperbole/hmail.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,289 @@
+;;!emacs
+;;
+;; FILE:         hmail.el
+;; SUMMARY:      Support for Hyperbole buttons embedded in e-mail messages.
+;; USAGE:        GNU Emacs Lisp Library
+;; KEYWORDS:     hypermedia, mail
+;;
+;; AUTHOR:       Bob Weiner
+;; ORG:          Brown U.
+;;
+;; ORIG-DATE:     9-Oct-91 at 18:38:05
+;; LAST-MOD:      4-Nov-95 at 04:37:50 by Bob Weiner
+;;
+;; This file is part of Hyperbole.
+;; Available for use and distribution under the same terms as GNU Emacs.
+;;
+;; Copyright (C) 1991-1995, Free Software Foundation, Inc.
+;; Developed with support from Motorola Inc.
+;;
+;; DESCRIPTION:  
+;;
+;;   The 'hmail' class provides an abstract interface for connecting
+;;   GNU Emacs-based mail readers and composers to Hyperbole.  Its
+;;   public variables together with supporting classes determine the
+;;   mail tools that Hyperbole will support.
+;;
+;;   The 'rmail' and 'lmail' classes provide a set of feature names
+;;   that Hyperbole packages can call to interface to a user's selected
+;;   mail reader.  Eventually, a full abstract calling interface may be
+;;   developed.  The public features (the ones above the line of dashes)
+;;   must be redefined for any mail reader.  The private features are
+;;   used only by a particular mail reader.
+;;
+;;   The 'smail' class is similar; it connects a mail composer for use
+;;   with Hyperbole.
+;;
+;; DESCRIP-END.
+
+;;; ************************************************************************
+;;; Public variables
+;;; ************************************************************************
+
+(defvar hnews:composer  'news-reply-mode
+ "Major mode for composing USENET news to be sent with Hyperbole buttons.")
+(defvar hnews:lister    'gnus-summary-mode
+ "Major mode for listing USENET news header summaries with Hyperbole buttons.")
+(defvar hnews:reader    'gnus-article-mode
+ "Major mode for reading USENET news with Hyperbole buttons.")
+
+(defvar hmail:init-function nil
+  "*Function (a symbol) to run to initialize Hyperbole support for a mail reader/composer.
+Valid values are: nil, Rmail-init, Vm-init, Mh-init, or Pm-init.")
+
+(defvar hmail:composer  'mail-mode
+ "Major mode for composing mail to be sent with Hyperbole buttons.")
+(defvar hmail:lister    nil
+ "Major mode for listing mail header summaries with Hyperbole buttons.")
+(defvar hmail:modifier  nil
+ "Major mode for editing received mail with Hyperbole buttons.")
+(defvar hmail:reader    nil
+ "Major mode for reading mail with Hyperbole buttons.")
+
+;;; ************************************************************************
+;;; Public functions
+;;; ************************************************************************
+
+;;; ========================================================================
+;;; hmail class - abstract
+;;; ========================================================================
+
+(defun hmail:hbdata-start (&optional msg-start msg-end)
+  "Returns point immediately before any Hyperbole button data in current msg.
+Returns message end point when no button data is found.
+Has side-effect of widening buffer. 
+Message's displayable part begins at optional MSG-START and ends at or before
+MSG-END."
+  (widen)
+  (or msg-end (setq msg-end (point-max)))
+  (save-excursion
+    (goto-char msg-end)
+    (if (search-backward hmail:hbdata-sep msg-start t) (1- (point)) msg-end)))
+
+(defun hmail:hbdata-to-p ()
+  "Moves point to Hyperbole but data start in an e-mail msg.
+Returns t if button data is found."
+  (and (cond ((memq major-mode (list hmail:reader hmail:modifier))
+	      (rmail:msg-narrow) t)
+	     ((or (hmail:lister-p) (hnews:lister-p)) t)
+	     ((memq major-mode (list hmail:composer hnews:reader
+				     hnews:composer))
+	      (widen) t))
+       (progn
+	 (goto-char (point-max))
+	 (if (search-backward hmail:hbdata-sep nil t)
+	     (progn (forward-line 1) t)))))
+
+(defun hmail:browser-p ()
+  "Returns t iff current major mode helps browse received e-mail messages."
+  (memq major-mode (list hmail:reader hmail:lister)))
+
+(defun hmail:buffer (&optional buf invisible-flag)
+  "Start composing mail with the contents of optional BUF as the message body.
+Invisible text is expanded and included in the mail only if INVISIBLE-FLAG is
+non-nil.  BUF defaults to the current buffer and may be a buffer or buffer
+name."
+  (interactive (list (current-buffer) (y-or-n-p "Include invisible text? ")))
+  (or buf (setq buf (current-buffer)))
+  (if (stringp buf) (setq buf (get-buffer buf)))
+  (set-buffer buf)
+  (hmail:region (point-min) (point-max) buf invisible-flag))
+
+;;;###autoload
+(defun hmail:compose (address expr &optional subject help)
+  "Compose mail with ADDRESS and evaluation of EXPR.
+Optional SUBJECT and HELP message may also be given."
+  (interactive "sDeliver e-mail to: \nSubject: ")
+  (require 'hactypes) ;; Needed in case EXPR calls 'hact.
+  (if (or (stringp help) (stringp subject))
+      nil
+    (setq subject "Be explicit here.  Make a statement or ask a question."))
+  (hmail:invoke address nil subject)
+  (eval expr)
+  (if (re-search-backward "^Subject: " nil t)
+      (goto-char (match-end 0)))
+  (message (if (stringp help)
+	       help
+	     "Replace subject, compose message, and then mail.")))
+
+(defun hmail:composing-dir (key-src)
+  "If button KEY-SRC is a mail/news composure buffer, returns composure directory, else nil."
+  (save-excursion
+    (and (bufferp key-src)
+	 (progn (set-buffer key-src)
+		(or (eq major-mode hmail:composer)
+		    (eq major-mode hnews:composer)))
+	 default-directory)))
+
+(defun hmail:editor-p ()
+  "Returns t iff current major mode edits Hyperbole e-mail/news messages."
+  (memq major-mode (list hmail:composer hnews:composer hmail:modifier)))
+
+(defun hmail:init (class-prefix func-suffix-list)
+  "Sets up CLASS-PREFIX functions with aliases for FUNC-SUFFIX-LIST.
+'hmail:reader' should be set appropriately before this is called."
+  (if (null hmail:reader)
+      nil
+    (let* ((reader-name (symbol-name hmail:reader))
+	   (reader-prefix (capitalize
+			   (substring reader-name
+				      0 (string-match "-" reader-name))))
+	   hmail-func)
+      (mapcar (function
+	       (lambda (func-suffix)
+		 (setq hmail-func (hypb:replace-match-string
+				   "Summ-" func-suffix "" t))
+		 (fset (intern (concat class-prefix hmail-func))
+		       (intern (concat reader-prefix "-" func-suffix)))))
+	      func-suffix-list))))
+
+(defun hmail:invoke (&optional address cc subject)
+  "Invoke user preferred mail composer: vm-mail, mh-send or mail.
+Optional arguments are ADDRESS, CC list and SUBJECT of mail."
+  (or address (setq address ""))
+  (or cc (setq cc ""))
+  (or subject (setq subject ""))
+  (cond ((and (featurep 'vm) (fboundp 'vm-mail))
+	 (vm-mail)
+	 (insert address)
+	 (cond ((re-search-forward "^CC: " nil t)
+		(end-of-line)
+		(insert cc))
+	       ((not (equal cc ""))
+		(forward-line 1)
+		(insert "CC: " cc)))
+	 (if (re-search-forward "^Subject: " nil t)
+	     (progn (end-of-line)
+		    (save-excursion
+		      (insert subject)))))
+	((and (featurep 'mh-e) (fboundp 'mh-send))
+	 (mh-send address cc subject))
+	(t
+	 ;; Next 3 lines prevent blank lines between fields due to
+	 ;; fill-region-as-paragraph within mail-setup.
+	 (if (equal address "") (setq address nil))
+	 (if (equal cc "") (setq cc nil))
+	 (if (equal subject "") (setq subject nil))
+	 (mail nil address subject nil cc))))
+
+(defun hmail:lister-p ()
+  "Returns t iff current major mode is a Hyperbole e-mail lister mode."
+  (eq major-mode hmail:lister))
+
+(defun hnews:lister-p ()
+  "Returns t iff current major mode is a Hyperbole news summary lister mode."
+  (eq major-mode hnews:lister))
+
+(defun hmail:mode-is-p ()
+  "Returns current major mode if a Hyperbole e-mail or news mode, else nil."
+  (car (memq major-mode
+	     (list hmail:reader hmail:composer hmail:lister hmail:modifier
+		   hnews:reader hnews:composer hnews:lister)
+	     )))
+
+(defun hmail:msg-narrow (&optional msg-start msg-end)
+  "Narrows buffer to displayable part of current message.
+Its displayable part begins at optional MSG-START and ends at or before
+MSG-END."
+  (if (hmail:reader-p) (rmail:msg-widen))
+  (setq msg-start (or msg-start (point-min))
+	msg-end (or msg-end (point-max)))
+  (narrow-to-region msg-start (hmail:hbdata-start msg-start msg-end)))
+
+(defun hmail:reader-p ()
+  "Returns t iff current major mode shows received Hyperbole e-mail messages."
+  (memq major-mode (list hmail:reader hmail:modifier)))
+
+(defun hmail:region (start end &optional buf invisible-flag)
+  "Start composing mail with region between START and END included in message.
+Invisible text is expanded and included in the mail only if INVISIBLE-FLAG is
+non-nil.  Optional BUF contains the region and defaults to the current
+buffer.  It may be a buffer or buffer name."
+  (interactive (list (region-beginning) (region-end) (current-buffer)
+		     (y-or-n-p "Include invisible text? ")))
+  (or buf (setq buf (current-buffer)))
+  (if (stringp buf) (setq buf (get-buffer buf)))
+  (let (mail-buf)
+    (hmail:invoke)
+    (setq mail-buf (current-buffer))
+    (save-excursion
+      (if (search-forward mail-header-separator nil t)
+	  ;; Within header, so move to body
+	  (goto-char (point-max)))
+      (set-buffer buf)
+      (hypb:insert-region mail-buf start end invisible-flag))))
+
+;;; ========================================================================
+;;; rmail class - mail reader interface - abstract
+;;; ========================================================================
+
+(defun rmail:init ()
+  "Initializes Hyperbole abstract mail interface for a particular mail reader.
+'hmail:reader' should be set appropriately before this is called."
+  (hmail:init "rmail:" '("msg-hdrs-full" "msg-narrow" "msg-num"
+			 "msg-prev" "msg-next"
+			 "msg-to-p"  ;; 2 args: (mail-msg-id mail-file)
+			 "msg-widen" "to"))
+  (hmail:init "lmail:" '("Summ-delete" "Summ-expunge" "Summ-goto" "Summ-to"
+			 "Summ-undelete-all")))
+
+(defvar rmail:msg-hdr-prefix "\\(^Date: \\|\n\nFrom [^ \n]+ \\)"
+  "String header preceding an e-mail received message-id.")
+
+(defun rmail:msg-id-get ()
+  "Returns current msg id for an 'hmail:reader' buffer as a string, else nil.
+Signals error when current mail reader is not supported."
+  (let* ((reader (symbol-name hmail:reader))
+	 ;; (toggled)
+	 )
+    (or (fboundp 'rmail:msg-hdrs-full)
+	(error "(rmail:msg-id-get): Invalid mail reader: %s" reader))
+    (save-excursion
+      (unwind-protect
+	  (progn
+	    ;; (setq toggled (rmail:msg-hdrs-full nil))
+	    (goto-char (point-min))
+	    (if (re-search-forward (concat rmail:msg-hdr-prefix
+					   "\\(.+\\)"))
+		;; Found matching msg
+		(buffer-substring (match-beginning 2) (match-end 2))))
+	;; (rmail:msg-hdrs-full toggled)
+	()
+	))))
+
+;;; ------------------------------------------------------------------------
+;;; Each mail reader-specific Hyperbole support module must also define
+;;; the following functions, commonly aliased to existing mail reader
+;;; functions within the "-init" function of the Hyperbole module.
+;;; See "hrmail.el" for examples.
+;;;
+;;; rmail:get-new, rmail:msg-forward, rmail:summ-msg-to, rmail:summ-new
+
+;;; ************************************************************************
+;;; Private variables
+;;; ************************************************************************
+
+(defvar hmail:hbdata-sep "\^Lbd"
+  "Text separating e-mail msg from any trailing Hyperbole button data.")
+
+(provide 'hmail)