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