cgit.sxemacs.org Git - packages/blob - xemacs-packages/hyperbole/hmail.el

   1 ;;; hmail.el --- Support for Hyperbole buttons embedded in e-mail messages.
   2
   3 ;; Copyright (C) 1991-1995, 2004 Free Software Foundation, Inc.
   4 ;; Developed with support from Motorola Inc.
   5
   6 ;; Author: Bob Weiner, Brown U.
   7 ;; Maintainer: Mats Lidell <matsl@contactor.se>
   8 ;; Keywords: hypermedia, mail
   9
  10 ;; This file is part of GNU Hyperbole.
  11
  12 ;; GNU Hyperbole is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 3, or (at
  15 ;; your option) any later version.
  16
  17 ;; GNU Hyperbole is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28 ;;
  29 ;;   The 'hmail' class provides an abstract interface for connecting
  30 ;;   GNU Emacs-based mail readers and composers to Hyperbole.  Its
  31 ;;   public variables together with supporting classes determine the
  32 ;;   mail tools that Hyperbole will support.
  33 ;;
  34 ;;   The 'rmail' and 'lmail' classes provide a set of feature names
  35 ;;   that Hyperbole packages can call to interface to a user's selected
  36 ;;   mail reader.  Eventually, a full abstract calling interface may be
  37 ;;   developed.  The public features (the ones above the line of dashes)
  38 ;;   must be redefined for any mail reader.  The private features are
  39 ;;   used only by a particular mail reader.
  40 ;;
  41 ;;   The 'smail' class is similar; it connects a mail composer for use
  42 ;;   with Hyperbole.
  43 ;;
  44
  45 ;;; Code:
  46
  47 ;;;
  48 ;;; Public variables
  49 ;;;
  50
  51 (defvar hnews:composer  'news-reply-mode
  52  "Major mode for composing USENET news to be sent with Hyperbole buttons.")
  53 (defvar hnews:lister    'gnus-summary-mode
  54  "Major mode for listing USENET news header summaries with Hyperbole buttons.")
  55 (defvar hnews:reader    'gnus-article-mode
  56  "Major mode for reading USENET news with Hyperbole buttons.")
  57
  58 (defvar hmail:init-function nil
  59   "*Function (a symbol) to run to initialize Hyperbole support for a mail reader/composer.
  60 Valid values are: nil, Rmail-init, Vm-init, Mh-init, or Pm-init.")
  61
  62 (defvar hmail:composer  'mail-mode
  63  "Major mode for composing mail to be sent with Hyperbole buttons.")
  64 (defvar hmail:lister    nil
  65  "Major mode for listing mail header summaries with Hyperbole buttons.")
  66 (defvar hmail:modifier  nil
  67  "Major mode for editing received mail with Hyperbole buttons.")
  68 (defvar hmail:reader    nil
  69  "Major mode for reading mail with Hyperbole buttons.")
  70
  71 ;;;
  72 ;;; Public functions
  73 ;;;
  74
  75 ;;;
  76 ;;; hmail class - abstract
  77 ;;;
  78
  79 (defun hmail:hbdata-start (&optional msg-start msg-end)
  80   "Returns point immediately before any Hyperbole button data in current msg.
  81 Returns message end point when no button data is found.
  82 Has side-effect of widening buffer.
  83 Message's displayable part begins at optional MSG-START and ends at or before
  84 MSG-END."
  85   (widen)
  86   (or msg-end (setq msg-end (point-max)))
  87   (save-excursion
  88     (goto-char msg-end)
  89     (if (search-backward hmail:hbdata-sep msg-start t) (1- (point)) msg-end)))
  90
  91 (defun hmail:hbdata-to-p ()
  92   "Moves point to Hyperbole but data start in an e-mail msg.
  93 Returns t if button data is found."
  94   (and (cond ((memq major-mode (list hmail:reader hmail:modifier))
  95               (rmail:msg-narrow) t)
  96              ((or (hmail:lister-p) (hnews:lister-p)) t)
  97              ((memq major-mode (list hmail:composer hnews:reader
  98                                      hnews:composer))
  99               (widen) t))
 100        (progn
 101          (goto-char (point-max))
 102          (if (search-backward hmail:hbdata-sep nil t)
 103              (progn (forward-line 1) t)))))
 104
 105 (defun hmail:browser-p ()
 106   "Returns t iff current major mode helps browse received e-mail messages."
 107   (memq major-mode (list hmail:reader hmail:lister)))
 108
 109 (defun hmail:buffer (&optional buf invisible-flag)
 110   "Start composing mail with the contents of optional BUF as the message body.
 111 Invisible text is expanded and included in the mail only if INVISIBLE-FLAG is
 112 non-nil.  BUF defaults to the current buffer and may be a buffer or buffer
 113 name."
 114   (interactive (list (current-buffer) (y-or-n-p "Include invisible text? ")))
 115   (or buf (setq buf (current-buffer)))
 116   (if (stringp buf) (setq buf (get-buffer buf)))
 117   (set-buffer buf)
 118   (hmail:region (point-min) (point-max) buf invisible-flag))
 119
 120 ;;;###autoload
 121 (defun hmail:compose (address expr &optional subject help)
 122   "Compose mail with ADDRESS and evaluation of EXPR.
 123 Optional SUBJECT and HELP message may also be given."
 124   (interactive "sDeliver e-mail to: \nSubject: ")
 125   (require 'hactypes) ;; Needed in case EXPR calls 'hact.
 126   (if (or (stringp help) (stringp subject))
 127       nil
 128     (setq subject "Be explicit here.  Make a statement or ask a question."))
 129   (hmail:invoke address nil subject)
 130   (eval expr)
 131   (if (re-search-backward "^Subject: " nil t)
 132       (goto-char (match-end 0)))
 133   (message (if (stringp help)
 134                help
 135              "Replace subject, compose message, and then mail.")))
 136
 137 (defun hmail:composing-dir (key-src)
 138   "If button KEY-SRC is a mail/news composure buffer, returns composure directory, else nil."
 139   (save-excursion
 140     (and (bufferp key-src)
 141          (progn (set-buffer key-src)
 142                 (or (eq major-mode hmail:composer)
 143                     (eq major-mode hnews:composer)))
 144          default-directory)))
 145
 146 (defun hmail:editor-p ()
 147   "Returns t iff current major mode edits Hyperbole e-mail/news messages."
 148   (memq major-mode (list hmail:composer hnews:composer hmail:modifier)))
 149
 150 (defun hmail:init (class-prefix func-suffix-list)
 151   "Sets up CLASS-PREFIX functions with aliases for FUNC-SUFFIX-LIST.
 152 'hmail:reader' should be set appropriately before this is called."
 153   (if (null hmail:reader)
 154       nil
 155     (let* ((reader-name (symbol-name hmail:reader))
 156            (reader-prefix (capitalize
 157                            (substring reader-name
 158                                       0 (string-match "-" reader-name))))
 159            hmail-func)
 160       (mapcar (function
 161                (lambda (func-suffix)
 162                  (setq hmail-func (hypb:replace-match-string
 163                                    "Summ-" func-suffix "" t))
 164                  (fset (intern (concat class-prefix hmail-func))
 165                        (intern (concat reader-prefix "-" func-suffix)))))
 166               func-suffix-list))))
 167
 168 (defun hmail:invoke (&optional address cc subject)
 169   "Invoke user preferred mail composer selected by the variable
 170 `mail-user-agent'. Optional arguments are ADDRESS, CC list and SUBJECT
 171 of mail."
 172   (compose-mail address subject (if cc (list (cons "CC" cc)))))
 173
 174 (defun hmail:lister-p ()
 175   "Returns t iff current major mode is a Hyperbole e-mail lister mode."
 176   (eq major-mode hmail:lister))
 177
 178 (defun hnews:lister-p ()
 179   "Returns t iff current major mode is a Hyperbole news summary lister mode."
 180   (eq major-mode hnews:lister))
 181
 182 (defun hmail:mode-is-p ()
 183   "Returns current major mode if a Hyperbole e-mail or news mode, else nil."
 184   (car (memq major-mode
 185              (list hmail:reader hmail:composer hmail:lister hmail:modifier
 186                    hnews:reader hnews:composer hnews:lister)
 187              )))
 188
 189 (defun hmail:msg-narrow (&optional msg-start msg-end)
 190   "Narrows buffer to displayable part of current message.
 191 Its displayable part begins at optional MSG-START and ends at or before
 192 MSG-END."
 193   (if (hmail:reader-p) (rmail:msg-widen))
 194   (setq msg-start (or msg-start (point-min))
 195         msg-end (or msg-end (point-max)))
 196   (narrow-to-region msg-start (hmail:hbdata-start msg-start msg-end)))
 197
 198 (defun hmail:reader-p ()
 199   "Returns t iff current major mode shows received Hyperbole e-mail messages."
 200   (memq major-mode (list hmail:reader hmail:modifier)))
 201
 202 (defun hmail:region (start end &optional buf invisible-flag)
 203   "Start composing mail with region between START and END included in message.
 204 Invisible text is expanded and included in the mail only if INVISIBLE-FLAG is
 205 non-nil.  Optional BUF contains the region and defaults to the current
 206 buffer.  It may be a buffer or buffer name."
 207   (interactive (list (region-beginning) (region-end) (current-buffer)
 208                      (y-or-n-p "Include invisible text? ")))
 209   (or buf (setq buf (current-buffer)))
 210   (if (stringp buf) (setq buf (get-buffer buf)))
 211   (let (mail-buf)
 212     (hmail:invoke)
 213     (setq mail-buf (current-buffer))
 214     (save-excursion
 215       (if (search-forward mail-header-separator nil t)
 216           ;; Within header, so move to body
 217           (goto-char (point-max)))
 218       (set-buffer buf)
 219       (hypb:insert-region mail-buf start end invisible-flag))))
 220
 221 ;;;
 222 ;;; rmail class - mail reader interface - abstract
 223 ;;;
 224
 225 (defun rmail:init ()
 226   "Initializes Hyperbole abstract mail interface for a particular mail reader.
 227 'hmail:reader' should be set appropriately before this is called."
 228   (hmail:init "rmail:" '("msg-hdrs-full" "msg-narrow" "msg-num"
 229                          "msg-prev" "msg-next"
 230                          "msg-to-p"  ;; 2 args: (mail-msg-id mail-file)
 231                          "msg-widen" "to"))
 232   (hmail:init "lmail:" '("Summ-delete" "Summ-expunge" "Summ-goto" "Summ-to"
 233                          "Summ-undelete-all")))
 234
 235 (defvar rmail:msg-hdr-prefix "\\(^Date: \\|\n\nFrom [^ \n]+ \\)"
 236   "String header preceding an e-mail received message-id.")
 237
 238 (defun rmail:msg-id-get ()
 239   "Returns current msg id for an 'hmail:reader' buffer as a string, else nil.
 240 Signals error when current mail reader is not supported."
 241   (let* ((reader (symbol-name hmail:reader))
 242          ;; (toggled)
 243          )
 244     (or (fboundp 'rmail:msg-hdrs-full)
 245         (error "(rmail:msg-id-get): Invalid mail reader: %s" reader))
 246     (save-excursion
 247       (unwind-protect
 248           (progn
 249             ;; (setq toggled (rmail:msg-hdrs-full nil))
 250             (goto-char (point-min))
 251             (if (re-search-forward (concat rmail:msg-hdr-prefix
 252                                            "\\(.+\\)"))
 253                 ;; Found matching msg
 254                 (buffer-substring (match-beginning 2) (match-end 2))))
 255         ;; (rmail:msg-hdrs-full toggled)
 256         ()
 257         ))))
 258
 259 ;;; Each mail reader-specific Hyperbole support module must also define
 260 ;;; the following functions, commonly aliased to existing mail reader
 261 ;;; functions within the "-init" function of the Hyperbole module.
 262 ;;; See "hrmail.el" for examples.
 263 ;;;
 264 ;;; rmail:get-new, rmail:msg-forward, rmail:summ-msg-to, rmail:summ-new
 265
 266 ;;;
 267 ;;; Private variables
 268 ;;;
 269
 270 (defvar hmail:hbdata-sep "\^Lbd"
 271   "Text separating e-mail msg from any trailing Hyperbole button data.")
 272
 273 (provide 'hmail)
 274
 275 ;;; hmail.el ends here