Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/hmh.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 4103f0995bd7
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;!emacs
2 ;;
3 ;; FILE: hmh.el
4 ;; SUMMARY: Support for Hyperbole buttons in mail reader: Mh.
5 ;; USAGE: GNU Emacs Lisp Library
6 ;; KEYWORDS: hypermedia, mail
7 ;;
8 ;; AUTHOR: Bob Weiner
9 ;; ORG: Brown U.
10 ;;
11 ;; ORIG-DATE: 21-May-91 at 17:06:36
12 ;; LAST-MOD: 19-May-95 at 15:09:30 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 "hsite.el".
23 ;; If hsite loading fails prior to initializing Hyperbole Mh support,
24 ;;
25 ;; {M-x Mh-init RTN}
26 ;;
27 ;; will do it.
28 ;;
29 ;;
30 ;; Have not yet overloaded 'mh-yank-cur-msg' to yank and hide
31 ;; button data from mail reader buffer.
32 ;; Have not yet overloaded 'mh-insert-letter' to highlight buttons
33 ;; and to merge its button data.
34 ;;
35 ;; DESCRIP-END.
36
37 ;;; ************************************************************************
38 ;;; Other required Elisp libraries
39 ;;; ************************************************************************
40 (require 'hmail)
41 (load "hsmail")
42 (require 'mh-e)
43
44 ;;; ************************************************************************
45 ;;; Public variables
46 ;;; ************************************************************************
47
48
49 ;;; ************************************************************************
50 ;;; Public functions
51 ;;; ************************************************************************
52
53 (defun Mh-init ()
54 "Initializes Hyperbole support for Mh mail reading."
55 (interactive)
56 (setq hmail:composer 'mh-letter-mode
57 hmail:lister 'mh-folder-mode
58 hmail:modifier 'mh-letter-mode
59 hmail:reader 'mh-show-mode)
60 (var:append 'mh-show-hook '(hmail:msg-narrow Mh-hbut-highlight))
61 ;;
62 ;;
63 ;; Setup public abstract interface to Hyperbole defined mail
64 ;; reader-specific functions used in "hmail.el".
65 ;;
66 (rmail:init)
67 ;;
68 ;; Setup private abstract interface to mail reader-specific functions
69 ;; used in "hmail.el".
70 ;;
71 (fset 'rmail:get-new 'mh-inc-folder)
72 (fset 'rmail:msg-forward 'mh-redistribute)
73 (fset 'rmail:summ-msg-to 'mh-goto-msg)
74 (fset 'rmail:summ-new 'mh-rescan-folder)
75 (if (interactive-p)
76 (message "Hyperbole MH mail reader support initialized."))
77 )
78
79 (defun Mh-hbut-highlight ()
80 "Highlight any Hyperbole buttons in buffer for which display support exists."
81 (if (fboundp 'hproperty:but-create) (hproperty:but-create)))
82
83 (defun Mh-msg-hdrs-full (toggled)
84 "If TOGGLED is non-nil, toggle full/hidden headers, else show full headers.
85 For now, a no-op."
86 )
87
88 (defun Mh-msg-narrow ()
89 "Narrows mail reader buffer to current message.
90 This includes Hyperbole button data."
91 (Mh-msg-widen))
92
93 (defun Mh-msg-next () (mh-next-undeleted-msg 1))
94
95 (defun Mh-msg-num ()
96 "Returns number of mail message that point is within."
97 (interactive)
98 (mh-get-msg-num nil))
99
100 (defun Mh-msg-prev () (mh-previous-undeleted-msg 1))
101
102 (defun Mh-msg-to-p (mail-msg-id mail-file)
103 "Sets current buffer to start of msg with MAIL-MSG-ID in MAIL-FILE.
104 Returns t if successful, else nil."
105 (if (not (file-readable-p mail-file))
106 nil
107 (find-file mail-file)
108 (hmail:msg-narrow)
109 (goto-char 1)
110 t))
111
112 (defun Mh-msg-widen ()
113 "Widens buffer to full current message including Hyperbole button data."
114 (Mh-to) (widen))
115
116 (defun Mh-to ()
117 "Sets current buffer to a mail reader buffer."
118 (and (eq major-mode 'Mh-folder-mode)
119 (set-buffer (Mh-get-buffer Mh-show-buffer))))
120
121 (defun Mh-Summ-delete () (mh-delete-msg (mh-get-msg-num t)))
122
123 (fset 'Mh-Summ-expunge 'mh-execute-commands)
124
125 (defun Mh-Summ-goto ()
126 (let ((msg-num (mh-get-msg-num nil)))
127 (mh-goto-msg msg-num nil t)
128 (mh-show msg-num)))
129
130 (defun Mh-Summ-to ()
131 "Sets current buffer to a mail listing buffer."
132 (let ((summ-buf))
133 (save-excursion
134 (mapcar (function
135 (lambda (window)
136 (if summ-buf
137 nil
138 (set-buffer (window-buffer window))
139 (if (eq major-mode 'Mh-folder-mode)
140 (setq summ-buf (current-buffer))))))
141 (hypb:window-list 'no-mini)))
142 (if summ-buf (set-buffer summ-buf))))
143
144 (defun Mh-Summ-undelete-all ()
145 (message
146 "(Mh-Summ-undelete-all: I don't think mh-e has an undelete operator."))
147
148 ;;; ************************************************************************
149 ;;; Private functions
150 ;;; ************************************************************************
151 ;;;
152 ;;; Overlay version of this function from mh-e.el to run mh-show-hook at end.
153 ;;; This hook may already be run, depending on the version of mh-e you are
154 ;;; running, but running it twice shouldn't do any harm. Comment this out if
155 ;;; you know that your mh-e.el already runs the hook.
156 (hypb:function-overload 'mh-display-msg nil
157 '(run-hooks 'mh-show-hook))
158
159 ;;;
160 ;;; Overlay version of 'mh-regenerate-headers' to highlight Hyperbole
161 ;;; buttons when possible.
162 ;;;
163 (hypb:function-overload 'mh-regenerate-headers nil
164 '(if (fboundp 'hproperty:but-create)
165 (hproperty:but-create)))
166
167 ;;;
168 ;;; Set 'mh-send-letter' hook to widen to include button data before sending.
169 ;;;
170 (var:append 'mh-before-send-letter-hook '(widen))
171
172 ;;; ************************************************************************
173 ;;; Private variables
174 ;;; ************************************************************************
175
176 (provide 'hmh)
177