source: trunk/athena/bin/discuss/edsc/discuss-misc.el @ 12350

Revision 12350, 7.1 KB checked in by ghudson, 25 years ago (diff)
Some RCS ID cleanup: delete $Log$ and replace other RCS keywords with $Id$.
Line 
1;;;
2;;;     Copyright (C) 1990 by the Massachusetts Institute of Technology
3;;;     Developed by the MIT Student Information Processing Board (SIPB).
4;;;     For copying information, see the file mit-copyright.h in this release.
5;;;
6;;;     $Id: discuss-misc.el,v 1.11 1999-01-22 23:09:43 ghudson Exp $
7;;;
8;;;  Emacs lisp code with random parts of the emacs discuss user interface
9;;;  We may want to split out the mail functions into a separate file if
10;;;  if they grow much more....
11;;;  Written by Theodore Ts'o, Barry Jaspan, and Mark Eichin
12;;;
13
14; We use mail-fetch-field
15(require 'mail-utils)
16
17;;
18;; Here is the add and delete meetings code....
19;;
20(defun discuss-parse-meeting-announcement ()
21  (let (host pathname arg-start)
22    (save-excursion
23      (goto-char (point-min))
24      (if (not (search-forward "  Meeting Name:  " nil t))
25          (error "Not a meeting announcement."))
26      (forward-line 1)
27      (if (not (search-forward "  Host:          " nil t))
28          (error "Not a meeting announcement."))
29      (setq arg-start (point))
30      (end-of-line)
31      (setq host (buffer-substring arg-start (point)))
32      (forward-line 1)
33      (if (not (search-forward "  Pathname:      " nil t))
34          (error "Not a meeting announcement."))
35      (setq arg-start (point))
36      (end-of-line)
37      (setq pathname (buffer-substring arg-start (point)))
38      (list host pathname))))
39
40(defun discuss-add-mtg (host pathname)
41  "Add a discuss meeting."
42  (interactive
43   (if (or current-prefix-arg
44           (not (eq (current-buffer) discuss-cur-mtg-buf)))
45       (list (read-input "Host Name: ")
46             (read-input "Pathname: " "/var/spool/discuss/"))
47     (discuss-parse-meeting-announcement)))
48  (message "Trying to add meeting....")
49  (discuss-send-cmd (format "(am %s %s)\n"
50                            host pathname)
51                    'discuss-end-add-mtg 'discuss-read-form))
52
53(defun discuss-end-add-mtg ()
54  (setq discuss-meeting-list (vconcat discuss-meeting-list
55                                     (list discuss-form)))
56  (save-excursion
57    (set-buffer discuss-main-buffer)
58    (goto-char (point-max))
59     (let ((buffer-read-only nil))
60       (insert "\n")
61       (discuss-lsm-1 discuss-form)
62       (goto-char (point-max))
63       (backward-delete-char 1)))
64  ;; A hack so added meetings show up on the completion list.
65  (setq discuss-meeting-completion-list
66        (append (list (cons (cadr discuss-form) 0)
67                      (cons (caddr discuss-form) 0))
68                discuss-meeting-completion-list))
69  (message "%s meeting added." (cadr discuss-form)))
70
71(defun discuss-del-mtg (&optional meeting)
72  "Delete a discuss meeting"
73  (interactive (list (if (eq (current-buffer) discuss-cur-mtg-buf)
74                         (progn
75                           (discuss-leave-mtg)
76                           discuss-current-meeting)
77                       (if (or current-prefix-arg
78                               (not (equal (buffer-name) discuss-main-buffer))
79                               (= (point) 1))
80                         (completing-read "Meeting name:  "
81                                          discuss-meeting-completion-list
82                                          nil t "")))))
83  (if (not meeting)
84      (let ((curline (- (count-lines 1 (min (1+ (point)) (point-max))) 3)))
85        (if (< curline 0)
86            (error "Not looking at a meeting."))
87        (setq meeting (cadr (aref discuss-meeting-list
88                                  curline)))
89        (if (not (yes-or-no-p (format "Are you sure you want to delete %s? "
90                                      meeting)))
91            (error "Delete cancelled."))
92        ))
93  (message "Deleting meeting %s...." meeting)
94  (discuss-send-cmd (format "(dm %s)\n" meeting)
95                    'discuss-end-del-mtg 'discuss-read-form))
96
97(defun discuss-end-del-mtg ()
98  (save-excursion
99    (set-buffer discuss-main-buffer)
100    (goto-char (point-min))
101    (if (not (re-search-forward (concat " " (regexp-quote (car discuss-form))
102                                        "\\(,\\|$\\)")
103                             nil t))
104        (error "Can't find meeting %s." (car discuss-form)))
105    (beginning-of-line)
106    (forward-char 1)
107    (let ((buffer-read-only nil))
108      (insert-char 32 1)
109      (delete-char 1)
110      (forward-char 2)
111      (insert-char 68 1)
112      (delete-char 1)))
113  (message "Meeting %s deleted." (car discuss-form)))
114
115
116;;
117;; Here follows the mail-within discuss code....
118;;
119
120(defun discuss-get-from-addr ()
121 (save-excursion
122   (save-restriction
123     (widen)
124     (goto-char (point-min))
125     (skip-chars-forward "[0-9] ")
126      (let* ((point-from-1 (point))
127             (point-from-2 (progn (re-search-forward " ") (point))))
128        (buffer-substring point-from-1 point-from-2)))))
129
130(defun discuss-forward ()
131  (interactive)
132      (let* ((forward-buffer (current-buffer))
133             (subject (concat "[" (discuss-get-from-addr)
134                              ": " (or (mail-fetch-field "Subject") "") "]")))
135        ;; If only one window, use it for the mail buffer.
136        ;; Otherwise, use another window for the mail buffer
137        ;; so that the Rmail buffer remains visible
138        ;; and sending the mail will get back to it.
139        (if (if (one-window-p t)
140                (mail nil nil subject)
141              (mail-other-window nil nil subject))
142            (save-excursion
143              (goto-char (point-max))
144              (forward-line 1)
145              (insert
146               (format "\n\n------- Forwarded transaction\n\n"))
147              (save-excursion
148                (insert "\n------- End forwarded transaction\n"))
149              (insert-buffer forward-buffer)))))
150
151(defun discuss-forward-to-meeting ()
152  "Forward a transaction to another discuss meeting."
153  (interactive)
154  (if (not discuss-cur-mtg-buf)
155      (error "Not looking at a meeting."))
156 
157  (let ((subject (concat "[" (discuss-get-from-addr)
158                         ": " (or (mail-fetch-field "Subject") "") "]"))
159        (meeting (completing-read "Forward to meeting: "
160                                  discuss-meeting-completion-list
161                                  nil t ""))
162        (trn-txt (concat "\n\n------- Forwarded transaction\n\n"
163                         (buffer-substring (point-min) (point-max))
164                         "\n------- End forwarded transaction\n")))
165    (discuss-enter meeting 0 subject nil trn-txt)
166    ))
167
168(defun discuss-reply-by-mail ()
169  "Reply to the current discuss transaction with Emacs sendmail."
170  (interactive)
171  (let ((to (discuss-fetch-mail-field "To"))
172        (from (discuss-fetch-mail-field "From"))
173        (cc (discuss-fetch-mail-field "Cc"))
174        (msg-id (discuss-fetch-mail-field "Message-Id"))
175        (subject (nth 11 discuss-current-transaction-info))
176        (author (nth 12 discuss-current-transaction-info))
177        (in-reply (concat "\"[" (int-to-string
178                               (car discuss-current-transaction-info))
179                          "] in "
180                          (nth 1 discuss-current-meeting-info)
181                          "\""))
182        (mail-default-reply-to (or (cdr (assoc discuss-current-meeting
183                                               discuss-auto-reply-to-alist))
184                                   mail-default-reply-to)))
185   
186    (if (equal from "")
187        (setq from author))
188   
189    (if (and discuss-reply-by-mail-with-message-id
190             (not (equal msg-id "")))
191        (setq in-reply msg-id))
192
193    (if (and (> (length subject) 3)
194             (not (string-match "[Rr]e: " (substring subject 0 4))))
195        (setq subject (concat "Re: " subject)))
196
197    (mail-other-window nil from subject in-reply
198                       (cond ((equal to "") nil)
199                             ((equal cc "") to)
200                             (t (concat to ", " cc)))
201                       discuss-cur-mtg-buf)
202    ))
203
204(defun discuss-fetch-mail-field (field)
205  (let (p)
206    (save-excursion
207      (save-restriction
208        (goto-char (point-min))
209        (if (re-search-forward "^[a-z]+:" nil t) nil
210          (error "Not looking at a mail-fed transaction!"))
211        (beginning-of-line)
212        (setq p (point))
213        (goto-char (point-max))
214        (re-search-backward "^[a-z]+:")
215        (re-search-forward "^$")
216        (narrow-to-region p (point))
217        (or (mail-fetch-field field nil t)
218            "")
219        ))))
Note: See TracBrowser for help on using the repository browser.