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

   1 ;;; hrmail.el --- Support for Hyperbole buttons in mail reader: Rmail.
   2
   3 ;; Copyright (C) 1991-1995 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 ;;   Automatically configured for use in "hyperbole.el".
  30 ;;   If hsite loading fails prior to initializing Hyperbole Rmail support,
  31 ;;
  32 ;;       {M-x Rmail-init RTN}
  33 ;;
  34 ;;   will do it.
  35 ;;
  36
  37 ;;; Code:
  38
  39 ;;;
  40 ;;; Other required Elisp libraries
  41 ;;;
  42
  43 (require 'hmail)
  44 (require 'hact)
  45 (load "hsmail")
  46 (require 'rmail)
  47 (load "rmailedit")
  48 (provide 'rmailedit)
  49
  50 ;;;
  51 ;;; Public variables
  52 ;;;
  53
  54 ;;;
  55 ;;; Public functions
  56 ;;;
  57
  58 (defun Rmail-init ()
  59   "Initializes Hyperbole support for Rmail mail reading."
  60   (interactive)
  61   (setq hmail:composer  'mail-mode
  62         hmail:lister    'rmail-summary-mode
  63         hmail:modifier  'rmail-edit-mode
  64         hmail:reader    'rmail-mode)
  65   (var:append 'rmail-show-message-hook '(hmail:msg-narrow))
  66   ;;
  67   ;;
  68   ;; Setup public abstract interface to Hyperbole defined mail
  69   ;; reader-specific functions used in "hmail.el".
  70   ;;
  71   (rmail:init)
  72   ;;
  73   ;; Setup private abstract interface to mail reader-specific functions
  74   ;; used in "hmail.el".
  75   ;;
  76   (fset 'rmail:get-new       'rmail-get-new-mail)
  77   (fset 'rmail:msg-forward   'rmail-forward)
  78   (fset 'rmail:summ-msg-to   'rmail-summary-goto-msg)
  79   (fset 'rmail:summ-new      'rmail-new-summary)
  80   (if (interactive-p)
  81       (message "Hyperbole RMAIL mail reader support initialized."))
  82   )
  83
  84 (defun Rmail-msg-hdrs-full (toggled)
  85   "If TOGGLED is non-nil, toggle full/hidden headers, else show full headers."
  86   (save-excursion
  87     (if (or toggled
  88             (let ((tog nil))
  89               (save-excursion
  90                 (save-restriction
  91                   (rmail-maybe-set-message-counters)
  92                   (narrow-to-region (rmail-msgbeg rmail-current-message)
  93                                     (point-max))
  94                   (let ((buffer-read-only nil))
  95                     (goto-char (point-min))
  96                     (forward-line 1)
  97                     ;; Need to show full header
  98                     (if (= (following-char) ?1)
  99                         (setq tog t)))))
 100               tog))
 101         (progn (rmail-toggle-header)
 102                (setq toggled t)))
 103     toggled))
 104
 105 (defun Rmail-msg-narrow ()
 106   "Narrows mail reader buffer to current message.
 107 This includes Hyperbole button data."
 108   (let ((beg (rmail-msgbeg rmail-current-message))
 109         (end (rmail-msgend rmail-current-message)))
 110     (narrow-to-region beg end)))
 111
 112 (defun Rmail-msg-next ()        (rmail-next-undeleted-message 1))
 113
 114 (defun Rmail-msg-num ()
 115   "Returns number of Rmail message that point is within."
 116   (interactive)
 117   (let ((count 0) opoint)
 118     (save-excursion
 119      (while (and (not (eobp))
 120                  (progn (setq opoint (point))
 121                         (re-search-backward "^\^_" nil t)))
 122        (if (= opoint (point))
 123            (backward-char 1)
 124          (setq count (1+ count)))))
 125     count))
 126
 127 (defun Rmail-msg-prev ()        (rmail-previous-undeleted-message 1))
 128
 129 (defun Rmail-msg-to-p (mail-msg-id mail-file)
 130   "Sets current buffer to start of msg with MAIL-MSG-ID in MAIL-FILE.
 131 Returns t if successful, else nil."
 132   (if (not (file-readable-p mail-file))
 133       nil
 134     (let ((buf (get-file-buffer mail-file)))
 135       (cond (buf
 136              (switch-to-buffer buf)
 137              (or (eq major-mode 'rmail-mode)
 138                  (rmail mail-file)))
 139             (t (rmail mail-file))))
 140     (widen)
 141     (goto-char 1)
 142     (if (re-search-forward (concat rmail:msg-hdr-prefix
 143                                    (regexp-quote mail-msg-id)) nil t)
 144         ;; Found matching msg
 145         (progn
 146           (setq buffer-read-only t)
 147           (rmail-show-message (Rmail-msg-num))
 148           t))))
 149
 150
 151 (defun Rmail-msg-widen ()
 152   "Widens buffer to full current message including Hyperbole button data."
 153   (let ((start (point-min))
 154         (end (point-max)))
 155     (unwind-protect
 156         (save-excursion
 157           (widen)
 158           (if (re-search-forward "^\^_" nil t)
 159               (progn (forward-char -1)
 160                      (setq end (point)))))
 161       (narrow-to-region start end))))
 162
 163 (defun Rmail-to ()
 164   "Sets current buffer to a mail reader buffer."
 165   (and (eq major-mode 'rmail-summary-mode) (set-buffer rmail-buffer)))
 166
 167 (fset 'Rmail-Summ-delete        'rmail-summary-delete-forward)
 168
 169 (fset 'Rmail-Summ-expunge       'rmail-summary-expunge)
 170
 171 (fset 'Rmail-Summ-goto          'rmail-summary-goto-msg)
 172
 173 (defun Rmail-Summ-to ()
 174   "Sets current buffer to a mail listing buffer."
 175   (and (eq major-mode 'rmail-mode) (set-buffer rmail-summary-buffer)))
 176
 177 (fset 'Rmail-Summ-undelete-all  'rmail-summary-undelete-many)
 178
 179 ;;;
 180 ;;; Private functions
 181 ;;;
 182
 183 ;;;
 184 ;;; Overlay version of this function from "rmailedit.el" to include any
 185 ;;; hidden Hyperbole button data when computing message length.
 186 (defun rmail-cease-edit ()
 187   "Finish editing message; switch back to Rmail proper."
 188   (interactive)
 189   ;; Make sure buffer ends with a newline.
 190   (save-excursion
 191     (Rmail-msg-widen)
 192     (goto-char (point-max))
 193     (if (/= (preceding-char) ?\n)
 194         (insert "\n"))
 195     ;; Adjust the marker that points to the end of this message.
 196     (set-marker (aref rmail-message-vector (1+ rmail-current-message))
 197                 (point))
 198     (hmail:msg-narrow)
 199     )
 200   (let ((old rmail-old-text))
 201     ;; Update the mode line.
 202     (set-buffer-modified-p (buffer-modified-p))
 203     (rmail-mode-1)
 204     (if (and (= (length old) (- (point-max) (point-min)))
 205              (string= old (buffer-substring (point-min) (point-max))))
 206         ()
 207       (setq old nil)
 208       (rmail-set-attribute "edited" t)
 209       (if (boundp 'rmail-summary-vector)
 210           (progn
 211             (aset rmail-summary-vector (1- rmail-current-message) nil)
 212             (save-excursion
 213               (rmail-widen-to-current-msgbeg
 214                 (function (lambda ()
 215                             (forward-line 2)
 216                             (if (looking-at "Summary-line: ")
 217                                 (let ((buffer-read-only nil))
 218                                   (delete-region (point)
 219                                                  (progn (forward-line 1)
 220                                                         (point))))))))
 221               (rmail-show-message))))))
 222   (setq buffer-read-only t))
 223
 224
 225 ;;; Overlay version of this function from "rmail.el" to include any
 226 ;;; Hyperbole button data.
 227 (defun rmail-forward (&optional resend)
 228   "Forward the current message to another user."
 229   (interactive)
 230   ;; Resend argument is ignored but for now but is there for Emacs V19 call
 231   ;; compatibility.
 232   ;;>> this gets set even if we abort. Can't do anything about it, though.
 233   (rmail-set-attribute "forwarded" t)
 234   (let ((forward-buffer (current-buffer))
 235         (subject (concat "["
 236                          (mail-strip-quoted-names (mail-fetch-field "From"))
 237                          ": " (or (mail-fetch-field "Subject") "") "]")))
 238     (save-restriction
 239       (Rmail-msg-widen)
 240       ;; If only one window, use it for the mail buffer.
 241       ;; Otherwise, use another window for the mail buffer
 242       ;; so that the Rmail buffer remains visible
 243       ;; and sending the mail will get back to it.
 244       (if (if (one-window-p t)
 245               (mail nil nil subject)
 246             (mail-other-window nil nil subject))
 247           (save-excursion
 248             (goto-char (point-max))
 249             (forward-line 1)
 250             (insert-buffer forward-buffer)
 251             (hmail:msg-narrow)
 252             )))))
 253
 254 ;;; Overlay version of 'rmail-get-new-mail' from "rmail.el" to highlight
 255 ;;; Hyperbole buttons when possible.
 256 ;;;
 257 (hypb:function-overload 'rmail-get-new-mail nil
 258                         '(if (fboundp 'hproperty:but-create)
 259                              (progn (widen) (hproperty:but-create)
 260                                     (rmail-show-message))))
 261
 262 ;;; Overlay version of 'rmail-new-summary' from "rmailsum.el" to
 263 ;;; highlight Hyperbole buttons when possible.
 264 ;;;
 265 (or (fboundp 'rmail-new-summary) (load "rmailsum"))
 266 (hypb:function-overload 'rmail-new-summary nil
 267                         '(if (fboundp 'hproperty:but-create)
 268                              (hproperty:but-create)))
 269
 270 ;;;
 271 ;;; Private variables
 272 ;;;
 273
 274 (provide 'hrmail)
 275
 276 ;;; hrmail.el ends here