annotate lisp/=gnuspost.el @ 267:d83efd759350

Initial revision
author Jim Blandy <jimb@redhat.com>
date Mon, 13 May 1991 21:21:58 +0000
parents
children 4cd7543be581
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
267
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1 ;;; Post news commands for GNUS newsreader
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2 ;; Copyright (C) 1989 Fujitsu Laboratories LTD.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3 ;; Copyright (C) 1989, 1990 Masanobu UMEDA
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4 ;; $Header: gnuspost.el,v 1.2 90/03/23 13:25:16 umerin Locked $
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6 ;; This file is part of GNU Emacs.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
7
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
8 ;; GNU Emacs is distributed in the hope that it will be useful,
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
9 ;; but WITHOUT ANY WARRANTY. No author or distributor
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
10 ;; accepts responsibility to anyone for the consequences of using it
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
11 ;; or for whether it serves any particular purpose or works at all,
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
12 ;; unless he says so in writing. Refer to the GNU Emacs General Public
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
13 ;; License for full details.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
14
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
15 ;; Everyone is granted permission to copy, modify and redistribute
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
16 ;; GNU Emacs, but only under the conditions described in the
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
17 ;; GNU Emacs General Public License. A copy of this license is
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
18 ;; supposed to have been given to you along with GNU Emacs so you
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
19 ;; can know your rights and responsibilities. It should be in a
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
20 ;; file named COPYING. Among other things, the copyright notice
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
21 ;; and this notice must be preserved on all copies.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
22
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
23 (provide 'gnuspost)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
24 (require 'gnus)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
25
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
26 (defvar gnus-organization-file "/usr/lib/news/organization"
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
27 "*Local news organization file.")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
28
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
29 (defvar gnus-post-news-buffer "*post-news*")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
30 (defvar gnus-winconf-post-news nil)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
31
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
32 (autoload 'news-reply-mode "rnewspost")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
33
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
34 ;;; Post news commands of GNUS Group Mode and Subject Mode
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
35
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
36 (defun gnus-Group-post-news ()
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
37 "Post an article."
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
38 (interactive)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
39 ;; Save window configuration.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
40 (setq gnus-winconf-post-news (current-window-configuration))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
41 (unwind-protect
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
42 (gnus-post-news)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
43 (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
44 (not (zerop (buffer-size))))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
45 ;; Restore last window configuration.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
46 (set-window-configuration gnus-winconf-post-news)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
47 ;; We don't want to return to Subject buffer nor Article buffer later.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
48 (if (get-buffer gnus-Subject-buffer)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
49 (bury-buffer gnus-Subject-buffer))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
50 (if (get-buffer gnus-Article-buffer)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
51 (bury-buffer gnus-Article-buffer)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
52
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
53 (defun gnus-Subject-post-news ()
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
54 "Post an article."
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
55 (interactive)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
56 (gnus-Subject-select-article t nil)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
57 ;; Save window configuration.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
58 (setq gnus-winconf-post-news (current-window-configuration))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
59 (unwind-protect
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
60 (progn
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
61 (switch-to-buffer gnus-Article-buffer)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
62 (widen)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
63 (delete-other-windows)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
64 (gnus-post-news))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
65 (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
66 (not (zerop (buffer-size))))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
67 ;; Restore last window configuration.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
68 (set-window-configuration gnus-winconf-post-news)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
69 ;; We don't want to return to Article buffer later.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
70 (bury-buffer gnus-Article-buffer))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
71
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
72 (defun gnus-Subject-post-reply (yank)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
73 "Post a reply article.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
74 If prefix argument YANK is non-nil, original article is yanked automatically."
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
75 (interactive "P")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
76 (gnus-Subject-select-article t nil)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
77 ;; Check Followup-To: poster.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
78 (set-buffer gnus-Article-buffer)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
79 (if (and gnus-use-followup-to
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
80 (string-equal "poster" (gnus-fetch-field "followup-to"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
81 (or (not (eq gnus-use-followup-to t))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
82 (not (y-or-n-p "Do you want to ignore `Followup-To: poster'? "))))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
83 ;; Mail to the poster. GNUS is now RFC1036 compliant.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
84 (gnus-Subject-mail-reply yank)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
85 ;; Save window configuration.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
86 (setq gnus-winconf-post-news (current-window-configuration))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
87 (unwind-protect
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
88 (progn
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
89 (switch-to-buffer gnus-Article-buffer)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
90 (widen)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
91 (delete-other-windows)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
92 (gnus-news-reply yank))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
93 (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
94 (not (zerop (buffer-size))))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
95 ;; Restore last window configuration.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
96 (set-window-configuration gnus-winconf-post-news)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
97 ;; We don't want to return to Article buffer later.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
98 (bury-buffer gnus-Article-buffer)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
99
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
100 (defun gnus-Subject-post-reply-with-original ()
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
101 "Post a reply article with original article."
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
102 (interactive)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
103 (gnus-Subject-post-reply t))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
104
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
105 (defun gnus-Subject-cancel-article ()
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
106 "Cancel an article you posted."
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
107 (interactive)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
108 (gnus-Subject-select-article t nil)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
109 (gnus-eval-in-buffer-window gnus-Article-buffer
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
110 (gnus-cancel-news)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
111
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
112
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
113 ;;; Post a News using NNTP
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
114
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
115 ;;;###autoload
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
116 (fset 'sendnews 'gnus-post-news)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
117 ;;;###autoload
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
118 (fset 'postnews 'gnus-post-news)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
119 ;;;###autoload
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
120 (defun gnus-post-news ()
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
121 "Begin editing a new USENET news article to be posted.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
122 Type \\[describe-mode] once editing the article to get a list of commands."
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
123 (interactive)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
124 (if (or (not gnus-novice-user)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
125 (y-or-n-p "Are you sure you want to post to all of USENET? "))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
126 (let ((artbuf (current-buffer))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
127 (newsgroups ;Default newsgroup.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
128 (if (eq major-mode 'gnus-Article-mode) gnus-newsgroup-name))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
129 (subject nil)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
130 (distribution nil))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
131 (save-restriction
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
132 (and (not (zerop (buffer-size)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
133 ;;(equal major-mode 'news-mode)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
134 (equal major-mode 'gnus-Article-mode)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
135 (progn
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
136 ;;(news-show-all-headers)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
137 (gnus-Article-show-all-headers)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
138 (narrow-to-region (point-min)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
139 (progn (goto-char (point-min))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
140 (search-forward "\n\n")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
141 (point)))))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
142 (setq news-reply-yank-from (mail-fetch-field "from"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
143 (setq news-reply-yank-message-id (mail-fetch-field "message-id")))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
144 (pop-to-buffer gnus-post-news-buffer)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
145 (news-reply-mode)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
146 (gnus-overload-functions)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
147 (if (and (buffer-modified-p)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
148 (> (buffer-size) 0)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
149 (not (y-or-n-p "Unsent article being composed; erase it? ")))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
150 ;; Continue composition.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
151 ;; Make news-reply-yank-original work on the current article.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
152 (setq mail-reply-buffer artbuf)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
153 (erase-buffer)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
154 (if gnus-interactive-post
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
155 ;; Newsgroups, subject and distribution are asked for.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
156 ;; Suggested by yuki@flab.fujitsu.junet.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
157 (progn
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
158 ;; Subscribed newsgroup names are required for
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
159 ;; completing read of newsgroup.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
160 (or gnus-newsrc-assoc
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
161 (gnus-read-newsrc-file))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
162 ;; Which do you like? (UMERIN)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
163 ;; (setq newsgroups (read-string "Newsgroups: " "general"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
164 (or newsgroups ;Use the default newsgroup.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
165 (setq newsgroups
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
166 (completing-read "Newsgroup: " gnus-newsrc-assoc
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
167 nil 'require-match
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
168 newsgroups ;Default newsgroup.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
169 )))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
170 (setq subject (read-string "Subject: "))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
171 (setq distribution
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
172 (substring newsgroups 0 (string-match "\\." newsgroups)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
173 (if (string-equal distribution newsgroups)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
174 ;; Newsgroup may be general or control. In this
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
175 ;; case, use default distribution.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
176 (setq distribution gnus-default-distribution))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
177 (setq distribution
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
178 (read-string "Distribution: " distribution))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
179 ;; An empty string is ok to ignore gnus-default-distribution.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
180 ;;(if (string-equal distribution "")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
181 ;; (setq distribution nil))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
182 ))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
183 (news-setup () subject () newsgroups artbuf)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
184 ;; Make sure the article is posted by GNUS.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
185 ;;(mail-position-on-field "Posting-Software")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
186 ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
187 ;; Insert Distribution: field.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
188 ;; Suggested by ichikawa@flab.fujitsu.junet.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
189 (mail-position-on-field "Distribution")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
190 (insert (or distribution gnus-default-distribution ""))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
191 ;; Handle author copy using FCC field.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
192 (if gnus-author-copy
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
193 (progn
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
194 (mail-position-on-field "FCC")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
195 (insert gnus-author-copy)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
196 (if gnus-interactive-post
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
197 ;; All fields are filled in.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
198 (goto-char (point-max))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
199 ;; Move point to Newsgroup: field.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
200 (goto-char (point-min))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
201 (end-of-line))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
202 ))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
203 (message "")))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
204
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
205 (defun gnus-news-reply (&optional yank)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
206 "Compose and post a reply (aka a followup) to the current article on USENET.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
207 While composing the followup, use \\[news-reply-yank-original] to yank the
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
208 original message into it."
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
209 (interactive)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
210 (if (or (not gnus-novice-user)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
211 (y-or-n-p "Are you sure you want to followup to all of USENET? "))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
212 (let (from cc subject date to followup-to newsgroups message-of
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
213 references distribution message-id
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
214 (artbuf (current-buffer)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
215 (save-restriction
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
216 (and (not (zerop (buffer-size)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
217 ;;(equal major-mode 'news-mode)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
218 (equal major-mode 'gnus-Article-mode)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
219 (progn
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
220 ;; (news-show-all-headers)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
221 (gnus-Article-show-all-headers)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
222 (narrow-to-region (point-min)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
223 (progn (goto-char (point-min))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
224 (search-forward "\n\n")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
225 (point)))))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
226 (setq from (mail-fetch-field "from"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
227 (setq news-reply-yank-from from)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
228 (setq subject (mail-fetch-field "subject"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
229 (setq date (mail-fetch-field "date"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
230 (setq followup-to (mail-fetch-field "followup-to"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
231 ;; Ignore Followup-To: poster.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
232 (if (or (null gnus-use-followup-to) ;Ignore followup-to: field.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
233 (string-equal "" followup-to) ;Bogus header.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
234 (string-equal "poster" followup-to))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
235 (setq followup-to nil))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
236 (setq newsgroups (or followup-to (mail-fetch-field "newsgroups")))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
237 (setq references (mail-fetch-field "references"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
238 (setq distribution (mail-fetch-field "distribution"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
239 (setq message-id (mail-fetch-field "message-id"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
240 (setq news-reply-yank-message-id message-id))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
241 (pop-to-buffer gnus-post-news-buffer)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
242 (news-reply-mode)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
243 (gnus-overload-functions)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
244 (if (and (buffer-modified-p)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
245 (> (buffer-size) 0)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
246 (not (y-or-n-p "Unsent article being composed; erase it? ")))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
247 ;; Continue composition.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
248 ;; Make news-reply-yank-original work on current article.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
249 (setq mail-reply-buffer artbuf)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
250 (erase-buffer)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
251 (and subject
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
252 (setq subject
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
253 (concat "Re: " (gnus-simplify-subject subject 're-only))))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
254 (and from
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
255 (progn
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
256 (let ((stop-pos
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
257 (string-match " *at \\| *@ \\| *(\\| *<" from)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
258 (setq message-of
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
259 (concat
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
260 (if stop-pos (substring from 0 stop-pos) from)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
261 "'s message of "
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
262 date)))))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
263 (news-setup nil subject message-of newsgroups artbuf)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
264 (if followup-to
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
265 (progn (news-reply-followup-to)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
266 (insert followup-to)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
267 ;; Fold long references line to follow RFC1036.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
268 (mail-position-on-field "References")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
269 (let ((begin (point))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
270 (fill-column 79)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
271 (fill-prefix "\t"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
272 (if references
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
273 (insert references))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
274 (if (and references message-id)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
275 (insert " "))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
276 (if message-id
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
277 (insert message-id))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
278 ;; The region must end with a newline to fill the region
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
279 ;; without inserting extra newline.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
280 (fill-region-as-paragraph begin (1+ (point))))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
281 ;; Make sure the article is posted by GNUS.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
282 ;;(mail-position-on-field "Posting-Software")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
283 ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
284 ;; Distribution must be the same as original article.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
285 (mail-position-on-field "Distribution")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
286 (insert (or distribution ""))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
287 ;; Handle author copy using FCC field.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
288 (if gnus-author-copy
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
289 (progn
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
290 (mail-position-on-field "FCC")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
291 (insert gnus-author-copy)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
292 (goto-char (point-max)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
293 ;; Yank original article automatically.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
294 (if yank
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
295 (let ((last (point)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
296 (goto-char (point-max))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
297 (news-reply-yank-original nil)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
298 (goto-char last)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
299 )
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
300 (message "")))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
301
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
302 (defun gnus-inews-news ()
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
303 "Send a news message."
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
304 (interactive)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
305 (let* ((case-fold-search nil)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
306 (server-running (gnus-server-opened)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
307 (save-excursion
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
308 ;; It is possible to post a news without reading news using
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
309 ;; `gnus' before.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
310 ;; Suggested by yuki@flab.fujitsu.junet.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
311 (gnus-start-news-server) ;Use default server.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
312 ;; NNTP server must be opened before current buffer is modified.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
313 (widen)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
314 (goto-char (point-min))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
315 (run-hooks 'news-inews-hook)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
316 (goto-char (point-min))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
317 (search-forward (concat "\n" mail-header-separator "\n"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
318 (replace-match "\n\n")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
319 (goto-char (point-max))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
320 ;; require a newline at the end for inews to append .signature to
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
321 (or (= (preceding-char) ?\n)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
322 (insert ?\n))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
323 (message "Posting to USENET...")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
324 ;; Post to NNTP server.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
325 (if (gnus-inews-article)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
326 (message "Posting to USENET... done")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
327 ;; We cannot signal an error.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
328 (ding) (message "Article rejected: %s" (gnus-status-message)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
329 (goto-char (point-min)) ;restore internal header separator
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
330 (search-forward "\n\n")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
331 (replace-match (concat "\n" mail-header-separator "\n"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
332 (set-buffer-modified-p nil))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
333 ;; If NNTP server is opened by gnus-inews-news, close it by myself.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
334 (or server-running
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
335 (gnus-close-server))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
336 (and (fboundp 'bury-buffer) (bury-buffer))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
337 ;; Restore last window configuration.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
338 (and gnus-winconf-post-news
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
339 (set-window-configuration gnus-winconf-post-news))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
340 (setq gnus-winconf-post-news nil)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
341 ))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
342
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
343 (defun gnus-cancel-news ()
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
344 "Cancel an article you posted."
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
345 (interactive)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
346 (if (yes-or-no-p "Do you really want to cancel this article? ")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
347 (let ((from nil)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
348 (newsgroups nil)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
349 (message-id nil)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
350 (distribution nil))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
351 (save-excursion
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
352 ;; Get header info. from original article.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
353 (save-restriction
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
354 (gnus-Article-show-all-headers)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
355 (goto-char (point-min))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
356 (search-forward "\n\n")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
357 (narrow-to-region (point-min) (point))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
358 (setq from (mail-fetch-field "from"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
359 (setq newsgroups (mail-fetch-field "newsgroups"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
360 (setq message-id (mail-fetch-field "message-id"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
361 (setq distribution (mail-fetch-field "distribution")))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
362 ;; Verify if the article is absolutely user's by comparing
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
363 ;; user id with value of its From: field.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
364 (if (not
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
365 (string-equal
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
366 (downcase (mail-strip-quoted-names from))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
367 (downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
368 (progn
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
369 (ding) (message "This article is not yours"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
370 ;; Make control article.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
371 (set-buffer (get-buffer-create " *GNUS-posting*"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
372 (buffer-flush-undo (current-buffer))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
373 (erase-buffer)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
374 (insert "Newsgroups: " newsgroups "\n"
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
375 "Subject: cancel " message-id "\n"
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
376 "Control: cancel " message-id "\n"
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
377 ;; We should not use the value of
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
378 ;; `gnus-default-distribution' as default value,
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
379 ;; because distribution must be as same as original
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
380 ;; article.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
381 "Distribution: " (or distribution "") "\n"
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
382 )
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
383 ;; Prepare article headers.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
384 (gnus-inews-insert-headers)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
385 (goto-char (point-max))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
386 ;; Insert empty line.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
387 (insert "\n")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
388 ;; Send the control article to NNTP server.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
389 (message "Canceling your article...")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
390 (if (gnus-request-post)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
391 (message "Canceling your article... done")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
392 (ding) (message "Failed to cancel your article"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
393 (kill-buffer (current-buffer))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
394 )))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
395 ))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
396
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
397
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
398 ;;; Lowlevel inews interface
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
399
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
400 (defun gnus-inews-article ()
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
401 "NNTP inews interface."
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
402 (let ((signature
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
403 (if gnus-signature-file
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
404 (expand-file-name gnus-signature-file nil)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
405 (distribution nil)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
406 (artbuf (current-buffer))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
407 (tmpbuf (get-buffer-create " *GNUS-posting*")))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
408 (save-excursion
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
409 (set-buffer tmpbuf)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
410 (buffer-flush-undo (current-buffer))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
411 (erase-buffer)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
412 (insert-buffer-substring artbuf)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
413 ;; Get distribution.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
414 (save-restriction
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
415 (goto-char (point-min))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
416 (search-forward "\n\n")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
417 (narrow-to-region (point-min) (point))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
418 (setq distribution (mail-fetch-field "distribution")))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
419 (widen)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
420 (if signature
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
421 (progn
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
422 ;; Change signature file by distribution.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
423 ;; Suggested by hyoko@flab.fujitsu.junet.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
424 (if (file-exists-p (concat signature "-" distribution))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
425 (setq signature (concat signature "-" distribution)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
426 ;; Insert signature.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
427 (if (file-exists-p signature)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
428 (progn
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
429 (goto-char (point-max))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
430 (insert "--\n")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
431 (insert-file-contents signature)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
432 ))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
433 ;; Prepare article headers.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
434 (save-restriction
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
435 (goto-char (point-min))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
436 (search-forward "\n\n")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
437 (narrow-to-region (point-min) (point))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
438 (gnus-inews-insert-headers)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
439 ;; Save author copy of posted article. The article must be
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
440 ;; copied before being posted because `gnus-request-post'
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
441 ;; modifies the buffer.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
442 (let ((case-fold-search t))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
443 ;; Find and handle any FCC fields.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
444 (goto-char (point-min))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
445 (if (re-search-forward "^FCC:" nil t)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
446 (gnus-inews-do-fcc))))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
447 (widen)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
448 ;; Run final inews hooks.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
449 (run-hooks 'gnus-Inews-article-hook)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
450 ;; Post an article to NNTP server.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
451 ;; Return NIL if post failed.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
452 (prog1
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
453 (gnus-request-post)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
454 (kill-buffer (current-buffer)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
455 )))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
456
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
457 (defun gnus-inews-do-fcc ()
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
458 "Process FCC: fields."
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
459 (let ((fcc-list nil)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
460 (fcc-file nil)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
461 (case-fold-search t)) ;Should ignore case.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
462 (save-excursion
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
463 (save-restriction
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
464 (goto-char (point-min))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
465 (while (re-search-forward "^FCC:[ \t]*" nil t)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
466 (setq fcc-list (cons (buffer-substring (point)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
467 (progn
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
468 (end-of-line)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
469 (skip-chars-backward " \t")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
470 (point)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
471 fcc-list))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
472 (delete-region (match-beginning 0)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
473 (progn (forward-line 1) (point))))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
474 ;; Process FCC operations.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
475 (widen)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
476 (while fcc-list
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
477 (setq fcc-file (car fcc-list))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
478 (setq fcc-list (cdr fcc-list))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
479 (cond ((string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" fcc-file)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
480 (let ((program (substring fcc-file
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
481 (match-beginning 1) (match-end 1))))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
482 ;; Suggested by yuki@flab.fujitsu.junet.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
483 ;; Send article to named program.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
484 (call-process-region (point-min) (point-max) shell-file-name
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
485 nil nil nil "-c" program)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
486 ))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
487 (t
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
488 ;; Suggested by hyoko@flab.fujitsu.junet.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
489 ;; Save article in Unix mail format by default.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
490 (funcall (or gnus-author-copy-saver 'rmail-output) fcc-file)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
491 ))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
492 )
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
493 ))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
494 ))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
495
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
496 (defun gnus-inews-insert-headers ()
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
497 "Prepare article headers.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
498 Path:, From:, Subject: and Distribution: are generated.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
499 Message-ID:, Date: and Organization: are optional."
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
500 (save-excursion
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
501 (let ((date (gnus-inews-date))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
502 (message-id (gnus-inews-message-id))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
503 (organization (gnus-inews-organization)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
504 ;; Insert from the top of headers.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
505 (goto-char (point-min))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
506 (insert "Path: " (gnus-inews-path) "\n")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
507 (insert "From: " (gnus-inews-user-name) "\n")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
508 ;; If there is no subject, make Subject: field.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
509 (or (mail-fetch-field "subject")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
510 (insert "Subject: \n"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
511 ;; Insert random headers.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
512 (if message-id
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
513 (insert "Message-ID: " message-id "\n"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
514 (if date
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
515 (insert "Date: " date "\n"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
516 (if organization
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
517 (let ((begin (point))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
518 (fill-column 79)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
519 (fill-prefix "\t"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
520 (insert "Organization: " organization "\n")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
521 (fill-region-as-paragraph begin (point))))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
522 (or (mail-fetch-field "distribution")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
523 (insert "Distribution: \n"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
524 )))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
525
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
526 (defun gnus-inews-path ()
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
527 "Return uucp path."
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
528 (let ((login-name (gnus-inews-login-name)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
529 (cond ((null gnus-use-generic-path)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
530 (concat gnus-nntp-server "!" login-name))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
531 ((stringp gnus-use-generic-path)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
532 ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
533 (concat gnus-use-generic-path "!" login-name))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
534 (t login-name))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
535 ))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
536
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
537 (defun gnus-inews-user-name ()
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
538 "Return user's network address as `NAME@DOMAIN (FULL NAME)'."
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
539 (let ((login-name (gnus-inews-login-name))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
540 (full-name (gnus-inews-full-name)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
541 (concat login-name "@" (gnus-inews-domain-name gnus-use-generic-from)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
542 ;; User's full name.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
543 (cond ((string-equal full-name "") "")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
544 ((string-equal full-name "&") ;Unix hack.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
545 (concat " (" login-name ")"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
546 (t
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
547 (concat " (" full-name ")")))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
548 )))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
549
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
550 (defun gnus-inews-login-name ()
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
551 "Return user login name.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
552 Got from the variable `gnus-user-login-name', the environment variables
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
553 USER and LOGNAME, and the function `user-login-name'."
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
554 (or gnus-user-login-name
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
555 (getenv "USER") (getenv "LOGNAME") (user-login-name)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
556
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
557 (defun gnus-inews-full-name ()
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
558 "Return user full name.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
559 Got from the variable `gnus-user-full-name', the environment variable
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
560 NAME, and the function `user-full-name'."
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
561 (or gnus-user-full-name
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
562 (getenv "NAME") (user-full-name)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
563
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
564 (defun gnus-inews-domain-name (&optional genericfrom)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
565 "Return user's domain name.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
566 If optional argument GENERICFROM is a string, use it as the domain
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
567 name; if it is non-nil, strip of local host name from the domain name.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
568 If the function `system-name' returns full internet name and the
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
569 domain is undefined, the domain name is got from it."
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
570 (let ((domain (or (if (stringp genericfrom) genericfrom)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
571 (getenv "DOMAINNAME")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
572 gnus-your-domain
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
573 ;; Function `system-name' may return full internet name.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
574 ;; Suggested by Mike DeCorte <mrd@sun.soe.clarkson.edu>.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
575 (if (string-match "\\." (system-name))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
576 (substring (system-name) (match-end 0)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
577 (read-string "Domain name (no host): ")))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
578 (host (or (if (string-match "\\." (system-name))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
579 (substring (system-name) 0 (match-beginning 0)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
580 (system-name))))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
581 (if (string-equal "." (substring domain 0 1))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
582 (setq domain (substring domain 1)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
583 (if (null gnus-your-domain)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
584 (setq gnus-your-domain domain))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
585 ;; Support GENERICFROM as same as standard Bnews system.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
586 ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
587 (cond ((null genericfrom)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
588 (concat host "." domain))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
589 ;;((stringp genericfrom) genericfrom)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
590 (t domain))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
591 ))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
592
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
593 (defun gnus-inews-message-id ()
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
594 "Generate unique Message-ID for user."
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
595 ;; Message-ID should not contain a slash and should be terminated by
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
596 ;; a number. I don't know the reason why it is so.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
597 (concat "<" (gnus-inews-unique-id) "@" (gnus-inews-domain-name) ">"))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
598
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
599 (defun gnus-inews-unique-id ()
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
600 "Generate unique ID from user name and current time."
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
601 (let ((date (current-time-string))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
602 (name (gnus-inews-login-name)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
603 (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) [0-9][0-9]\\([0-9][0-9]\\)"
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
604 date)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
605 (concat (upcase name) "."
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
606 (substring date (match-beginning 6) (match-end 6)) ;Year
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
607 (substring date (match-beginning 1) (match-end 1)) ;Month
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
608 (substring date (match-beginning 2) (match-end 2)) ;Day
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
609 (substring date (match-beginning 3) (match-end 3)) ;Hour
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
610 (substring date (match-beginning 4) (match-end 4)) ;Minute
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
611 (substring date (match-beginning 5) (match-end 5)) ;Second
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
612 )
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
613 (error "Cannot understand current-time-string: %s." date))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
614 ))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
615
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
616 (defun gnus-inews-date ()
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
617 "Bnews date format string of today. Time zone is ignored."
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
618 ;; Insert buggy date (time zone is ignored), but I don't worry about
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
619 ;; it since inews will rewrite it.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
620 (let ((date (current-time-string)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
621 (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9:]+\\) [0-9][0-9]\\([0-9][0-9]\\)"
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
622 date)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
623 (concat (substring date (match-beginning 2) (match-end 2)) ;Day
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
624 " "
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
625 (substring date (match-beginning 1) (match-end 1)) ;Month
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
626 " "
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
627 (substring date (match-beginning 4) (match-end 4)) ;Year
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
628 " "
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
629 (substring date (match-beginning 3) (match-end 3))) ;Time
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
630 (error "Cannot understand current-time-string: %s." date))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
631 ))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
632
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
633 (defun gnus-inews-organization ()
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
634 "Return user's organization.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
635 The ORGANIZATION environment variable is used if defined.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
636 If not, the variable `gnus-your-organization' is used instead.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
637 If the value begins with a slash, it is taken as the name of a file
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
638 containing the organization."
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
639 ;; The organization must be got in this order since the ORGANIZATION
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
640 ;; environment variable is intended for user specific while
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
641 ;; gnus-your-organization is for machine or organization specific.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
642 (let ((organization (or (getenv "ORGANIZATION")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
643 gnus-your-organization
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
644 (expand-file-name "~/.organization" nil))))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
645 (and (stringp organization)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
646 (string-equal (substring organization 0 1) "/")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
647 ;; Get it from the user and system file.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
648 ;; Suggested by roland@wheaties.ai.mit.edu (Roland McGrath).
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
649 (let ((dist (mail-fetch-field "distribution")))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
650 (setq organization
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
651 (cond ((file-exists-p (concat organization "-" dist))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
652 (concat organization "-" dist))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
653 ((file-exists-p organization) organization)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
654 ((file-exists-p gnus-organization-file)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
655 gnus-organization-file)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
656 (t organization)))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
657 ))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
658 (cond ((not (stringp organization)) nil)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
659 ((and (string-equal (substring organization 0 1) "/")
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
660 (file-exists-p organization))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
661 ;; If the first character is `/', assume it is the name of
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
662 ;; a file containing the organization.
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
663 (save-excursion
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
664 (let ((tmpbuf (get-buffer-create " *GNUS organization*")))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
665 (set-buffer tmpbuf)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
666 (erase-buffer)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
667 (insert-file-contents organization)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
668 (prog1 (buffer-string)
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
669 (kill-buffer tmpbuf))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
670 )))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
671 (t organization))
d83efd759350 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
672 ))