;;; Code:
-(require 'gnus)
+(require 'gnus-load)
(require 'gnus-ems)
(require 'message)
-(eval-when-compile (require 'cl))
+(require 'gnus-art)
+(require 'gnus)
;; Added by Sudish Joseph <joseph@cis.ohio-state.edu>.
(defvar gnus-post-method nil
(defvar gnus-outgoing-message-group nil
"*All outgoing messages will be put in this group.
If you want to store all your outgoing mail and articles in the group
-\"nnml:archive\", you set this variable to that value. This variable
+\"nnml:archive\", you set this variable to that value. This variable
can also be a list of group names.
If you want to have greater control over what group to put each
current newsgroup name and then returns a suitable group name (or list
of names).")
-(defvar gnus-message-archive-group
- '((if (message-news-p) "misc-news" "misc-mail"))
- "*Name of the group in which to save the messages you've written.
-This can either be a string, a list of strings; or an alist
-of regexps/functions/forms to be evaluated to return a string (or a list
-of strings). The functions are called with the name of the current
-group (or nil) as a parameter.
-
-Normally the group names returned by this variable should be
-unprefixed -- which implictly means \"store on the archive server\".
-However, you may wish to store the message on some other server. In
-that case, just return a fully prefixed name of the group --
-\"nnml+private:mail.misc\", for instance.")
-
(defvar gnus-mailing-list-groups nil
"*Regexp matching groups that are really mailing lists.
This is useful when you're reading a mailing list that has been
(defvar gnus-sent-message-ids-length 1000
"The number of sent Message-IDs to save.")
+(defvar gnus-crosspost-complaint
+ "Hi,
+
+You posted the article below with the following Newsgroups header:
+
+Newsgroups: %s
+
+The %s group, at least, was an inappropriate recipient
+of this message. Please trim your Newsgroups header to exclude this
+group before posting in the future.
+
+Thank you.
+
+"
+ "Format string to be inserted when complaining about crossposts.
+The first %s will be replaced by the Newsgroups header;
+the second with the current group name.")
+
;;; Internal variables.
(defvar gnus-message-buffer "*Mail Gnus*")
(defvar gnus-article-copy nil)
(defvar gnus-last-posting-server nil)
+(defconst gnus-bug-message
+ "Sending a bug report to the Gnus Towers.
+========================================
+
+The buffer below is a mail buffer. When you press `C-c C-c', it will
+be sent to the Gnus Bug Exterminators.
+
+At the bottom of the buffer you'll see lots of variable settings.
+Please do not delete those. They will tell the Bug People what your
+environment is, so that it will be easier to locate the bugs.
+
+If you have found a bug that makes Emacs go \"beep\", set
+debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET')
+and include the backtrace in your bug report.
+
+Please describe the bug in annoying, painstaking detail.
+
+Thank you for your help in stamping out bugs.
+")
+
(eval-and-compile
(autoload 'gnus-uu-post-news "gnus-uu" nil t)
(autoload 'news-setup "rnewspost")
;;; Gnus Posting Functions
;;;
-(gnus-define-keys
- (gnus-summary-send-map "S" gnus-summary-mode-map)
- "p" gnus-summary-post-news
- "f" gnus-summary-followup
- "F" gnus-summary-followup-with-original
- "c" gnus-summary-cancel-article
- "s" gnus-summary-supersede-article
- "r" gnus-summary-reply
- "R" gnus-summary-reply-with-original
- "m" gnus-summary-mail-other-window
- "u" gnus-uu-post-news
- "om" gnus-summary-mail-forward
- "op" gnus-summary-post-forward
- "Om" gnus-uu-digest-mail-forward
- "Op" gnus-uu-digest-post-forward)
-
-(gnus-define-keys
- (gnus-send-bounce-map "D" gnus-summary-send-map)
- "b" gnus-summary-resend-bounced-mail
-; "c" gnus-summary-send-draft
- "r" gnus-summary-resend-message)
+(gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map)
+ "p" gnus-summary-post-news
+ "f" gnus-summary-followup
+ "F" gnus-summary-followup-with-original
+ "c" gnus-summary-cancel-article
+ "s" gnus-summary-supersede-article
+ "r" gnus-summary-reply
+ "R" gnus-summary-reply-with-original
+ "m" gnus-summary-mail-other-window
+ "u" gnus-uu-post-news
+ "\M-c" gnus-summary-mail-crosspost-complaint
+ "om" gnus-summary-mail-forward
+ "op" gnus-summary-post-forward
+ "Om" gnus-uu-digest-mail-forward
+ "Op" gnus-uu-digest-post-forward)
+
+(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
+ "b" gnus-summary-resend-bounced-mail
+ ;; "c" gnus-summary-send-draft
+ "r" gnus-summary-resend-message)
;;; Internal functions.
,@forms
(gnus-inews-add-send-actions ,winconf ,buffer ,article)
(setq gnus-message-buffer (current-buffer))
+ (make-local-variable 'gnus-newsgroup-name)
(gnus-configure-windows ,config t))))
(defun gnus-inews-add-send-actions (winconf buffer article)
(defun gnus-inews-yank-articles (articles)
(let (beg article)
+ (message-goto-body)
(while (setq article (pop articles))
(save-window-excursion
(set-buffer gnus-summary-buffer)
(message-reply-headers gnus-current-headers))
(message-yank-original)
(setq beg (or beg (mark t))))
- (when articles (insert "\n")))
-
+ (when articles
+ (insert "\n")))
(push-mark)
(goto-char beg)))
article)
(while (setq article (pop articles))
(when (gnus-summary-select-article t nil nil article)
- (when (gnus-eval-in-buffer-window
- gnus-original-article-buffer (message-cancel-news))
+ (when (gnus-eval-in-buffer-window gnus-original-article-buffer
+ (message-cancel-news))
(gnus-summary-mark-as-read article gnus-canceled-mark)
(gnus-cache-remove-article 1))
(gnus-article-hide-headers-if-wanted))
(setq gnus-article-copy (get-buffer-create " *gnus article copy*"))
(buffer-disable-undo gnus-article-copy)
(or (memq gnus-article-copy gnus-buffer-list)
- (setq gnus-buffer-list (cons gnus-article-copy gnus-buffer-list)))
+ (push gnus-article-copy gnus-buffer-list))
(let ((article-buffer (or article-buffer gnus-article-buffer))
- end)
+ end beg contents)
(when (and (get-buffer article-buffer)
(buffer-name (get-buffer article-buffer)))
(save-excursion
(set-buffer article-buffer)
(save-restriction
+ ;; Copy over the (displayed) article buffer, delete
+ ;; hidden text and remove text properties.
(widen)
(copy-to-buffer gnus-article-copy (point-min) (point-max))
+ (set-buffer gnus-article-copy)
+ (article-delete-text-of-type 'annotation)
+ (insert
+ (prog1
+ (format "%s" (buffer-string))
+ (erase-buffer)))
+ ;; Find the original headers.
(set-buffer gnus-original-article-buffer)
(goto-char (point-min))
+ (while (looking-at message-unix-mail-delimiter)
+ (forward-line 1))
+ (setq beg (point))
(setq end (or (search-forward "\n\n" nil t) (point)))
+ ;; Delete the headers from the displayed articles.
(set-buffer gnus-article-copy)
- (gnus-set-text-properties (point-min) (point-max) nil)
(delete-region (goto-char (point-min))
(or (search-forward "\n\n" nil t) (point)))
- (insert-buffer-substring gnus-original-article-buffer 1 end)))
+ ;; Insert the original article headers.
+ (insert-buffer-substring gnus-original-article-buffer beg end)
+ (article-decode-rfc1522)))
gnus-article-copy)))
(defun gnus-post-news (post &optional group header article-buffer yank subject
(pgroup group)
to-address to-group mailing-list to-list)
(when group
- (setq to-address (gnus-group-get-parameter group 'to-address)
- to-group (gnus-group-get-parameter group 'to-group)
- to-list (gnus-group-get-parameter group 'to-list)
+ (setq to-address (gnus-group-find-parameter group 'to-address)
+ to-group (gnus-group-find-parameter group 'to-group)
+ to-list (gnus-group-find-parameter group 'to-list)
mailing-list (when gnus-mailing-list-groups
(string-match gnus-mailing-list-groups group))
group (gnus-group-real-name group)))
(if post
(message-news (or to-group group))
(set-buffer gnus-article-copy)
- (message-followup))
+ (message-followup to-group))
;; The is mail.
(if post
(progn
(cond
;; If the group-method is nil (which shouldn't happen) we use
;; the default method.
- ((null arg)
+ ((null group-method)
(or gnus-post-method gnus-select-method message-post-method))
;; We want this group's method.
((and arg (not (eq arg 0)))
(cons (or gnus-last-posting-server "") 0))))
method-alist))))
;; Override normal method.
- ((and gnus-post-method
- (or (gnus-method-option-p group-method 'post)
- (gnus-method-option-p group-method 'post-mail)))
+ (gnus-post-method
gnus-post-method)
- ;; Perhaps this is a mail group?
- ((and (not (gnus-member-of-valid 'post group))
- (not (gnus-method-option-p group-method 'post-mail)))
- group-method)
;; Use the normal select method.
(t gnus-select-method))))
gnus-inews-sent-ids))
(setcdr end nil))
(nnheader-temp-write gnus-sent-message-ids-file
- (prin1 `(setq gnus-inews-sent-ids ',gnus-inews-sent-ids)
- (current-buffer)))
+ (gnus-prin1 `(setq gnus-inews-sent-ids ',gnus-inews-sent-ids)))
nil)))))
\f
(format " %d.%d" emacs-major-version emacs-minor-version)))
(t emacs-version))))
-;; Written by "Mr. Per Persson" <pp@solace.mh.se>.
+;; Written by "Mr. Per Persson" <pp@gnu.ai.mit.edu>.
(defun gnus-inews-insert-mime-headers ()
(goto-char (point-min))
(let ((mail-header-separator
(gnus-setup-message (if yank 'reply-yank 'reply)
(gnus-summary-select-article)
(set-buffer (gnus-copy-article-buffer))
- (message-reply nil nil (gnus-group-get-parameter
+ (message-reply nil nil (gnus-group-find-parameter
gnus-newsgroup-name 'broken-reply-to))
(when yank
(gnus-inews-yank-articles yank)))))
(gnus-summary-mail-forward t))
(defvar gnus-nastygram-message
- "The following article was inappropriately posted to %s.\n"
+ "The following article was inappropriately posted to %s.\n\n"
"Format string to insert in nastygrams.
The current group name will be inserted at \"%s\".")
(defun gnus-summary-mail-nastygram (n)
"Send a nastygram to the author of the current article."
(interactive "P")
- (if (or gnus-expert-user
- (gnus-y-or-n-p
- "Really send a nastygram to the author of the current article? "))
- (let ((group gnus-newsgroup-name))
- (gnus-summary-reply-with-original n)
- (set-buffer gnus-message-buffer)
- (insert (format gnus-nastygram-message group))
- (message-send-and-exit))))
+ (when (or gnus-expert-user
+ (gnus-y-or-n-p
+ "Really send a nastygram to the author of the current article? "))
+ (let ((group gnus-newsgroup-name))
+ (gnus-summary-reply-with-original n)
+ (set-buffer gnus-message-buffer)
+ (message-goto-body)
+ (insert (format gnus-nastygram-message group))
+ (message-send-and-exit))))
+
+(defun gnus-summary-mail-crosspost-complaint (n)
+ "Send a complaint about crossposting to the current article(s)."
+ (interactive "P")
+ (let ((articles (gnus-summary-work-articles n))
+ article)
+ (while (setq article (pop articles))
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-goto-subject article)
+ (let ((group (gnus-group-real-name gnus-newsgroup-name))
+ newsgroups followup-to)
+ (gnus-summary-select-article)
+ (set-buffer gnus-original-article-buffer)
+ (if (and (<= (length (message-tokenize-header
+ (setq newsgroups (mail-fetch-field "newsgroups"))
+ ", "))
+ 1)
+ (or (not (setq followup-to (mail-fetch-field "followup-to")))
+ (not (member group (message-tokenize-header
+ followup-to ", ")))))
+ (if followup-to
+ (gnus-message 1 "Followup-to restricted")
+ (gnus-message 1 "Not a crossposted article"))
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-reply-with-original 1)
+ (set-buffer gnus-message-buffer)
+ (message-goto-body)
+ (insert (format gnus-crosspost-complaint newsgroups group))
+ (message-goto-subject)
+ (re-search-forward " *$")
+ (replace-match " (crosspost notification)" t t)
+ (when (gnus-y-or-n-p "Send this complaint? ")
+ (message-send-and-exit)))))))
(defun gnus-summary-mail-other-window ()
"Compose mail in other window."
(logand (progn
(while (search-forward "\"" nil t)
(incf i))
- (if (zerop i) 2 i)) 2)))))
+ (if (zerop i) 2 i))
+ 2)))))
(skip-chars-forward ",")
(skip-chars-forward "^,"))
(skip-chars-backward " ")
- (setq accumulated
- (cons (buffer-substring beg (point))
- accumulated))
+ (push (buffer-substring beg (point))
+ accumulated)
(skip-chars-forward "^,")
(skip-chars-forward ", "))
accumulated))
-(defun gnus-mail-yank-original ()
- (interactive)
- (save-excursion
- (mail-yank-original nil))
- (or mail-yank-hooks mail-citation-hook
- (run-hooks 'news-reply-header-hook)))
-
(defun gnus-inews-add-to-address (group)
(let ((to-address (mail-fetch-field "to")))
(when (and to-address
(or (and group (not (gnus-group-read-only-p group)))
(setq group (read-string "Put in group: " nil
(gnus-writable-groups))))
- (and (gnus-gethash group gnus-newsrc-hashtb)
- (error "No such group: %s" group))
+ (when (gnus-gethash group gnus-newsrc-hashtb)
+ (error "No such group: %s" group))
(save-excursion
(save-restriction
(gnus-inews-do-gcc)
- (if (get-buffer gnus-group-buffer)
- (progn
- (if (gnus-buffer-exists-p (car-safe reply))
- (progn
- (set-buffer (car reply))
- (and (cdr reply)
- (gnus-summary-mark-article-as-replied
- (cdr reply)))))
- (and winconf (set-window-configuration winconf))))))
+ (when (get-buffer gnus-group-buffer)
+ (when (gnus-buffer-exists-p (car-safe reply))
+ (set-buffer (car reply))
+ (and (cdr reply)
+ (gnus-summary-mark-article-as-replied
+ (cdr reply))))
+ (when winconf
+ (set-window-configuration winconf)))))
(defun gnus-article-mail (yank)
"Send a reply to the address near point.
(save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
(save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
(when address
- (switch-to-buffer gnus-summary-buffer)
(message-reply address)
(when yank
- (gnus-inews-yank-articles yank)))))
+ (gnus-inews-yank-articles (list (cdr gnus-article-current)))))))
(defun gnus-bug ()
"Send a bug report to the Gnus maintainers."
(interactive)
+ (unless (gnus-alive-p)
+ (error "Gnus has been shut down"))
(gnus-setup-message 'bug
(delete-other-windows)
(switch-to-buffer "*Gnus Help Bug*")
(message "")))
(defun gnus-bug-kill-buffer ()
- (and (get-buffer "*Gnus Help Bug*")
- (kill-buffer "*Gnus Help Bug*")))
+ (when (get-buffer "*Gnus Help Bug*")
+ (kill-buffer "*Gnus Help Bug*")))
(defun gnus-debug ()
- "Attemps to go through the Gnus source file and report what variables have been changed.
+ "Attempts to go through the Gnus source file and report what variables have been changed.
The source file has to be in the Emacs load path."
(interactive)
- (let ((files '("gnus.el" "gnus-msg.el" "gnus-score.el" "nnmail.el"
- "message.el"))
- file dirs expr olist sym)
+ (let ((files '("gnus-load.el" "gnus-sum.el" "gnus-group.el"
+ "gnus-art.el" "gnus-start.el"
+ "gnus-msg.el" "gnus-score.el" "gnus-win.el"
+ "nnmail.el" "message.el"))
+ file expr olist sym)
(gnus-message 4 "Please wait while we snoop your variables...")
(sit-for 0)
+ ;; Go through all the files looking for non-default values for variables.
(save-excursion
(set-buffer (get-buffer-create " *gnus bug info*"))
(buffer-disable-undo (current-buffer))
(while files
(erase-buffer)
- (setq dirs load-path)
- (while dirs
- (if (or (not (car dirs))
- (not (stringp (car dirs)))
- (not (file-exists-p
- (setq file (concat (file-name-as-directory
- (car dirs)) (car files))))))
- (setq dirs (cdr dirs))
- (setq dirs nil)
- (insert-file-contents file)
+ (when (file-exists-p (setq file (locate-library (pop files))))
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (if (not (re-search-forward "^;;* *Internal variables" nil t))
+ (gnus-message 4 "Malformed sources in file %s" file)
+ (narrow-to-region (point-min) (point))
(goto-char (point-min))
- (if (not (re-search-forward "^;;* *Internal variables" nil t))
- (gnus-message 4 "Malformed sources in file %s" file)
- (narrow-to-region (point-min) (point))
- (goto-char (point-min))
- (while (setq expr (condition-case ()
- (read (current-buffer)) (error nil)))
- (condition-case ()
- (and (eq (car expr) 'defvar)
- (stringp (nth 3 expr))
- (or (not (boundp (nth 1 expr)))
- (not (equal (eval (nth 2 expr))
- (symbol-value (nth 1 expr)))))
- (setq olist (cons (nth 1 expr) olist)))
- (error nil))))))
- (setq files (cdr files)))
+ (while (setq expr (condition-case ()
+ (read (current-buffer)) (error nil)))
+ (condition-case ()
+ (and (eq (car expr) 'defvar)
+ (stringp (nth 3 expr))
+ (or (not (boundp (nth 1 expr)))
+ (not (equal (eval (nth 2 expr))
+ (symbol-value (nth 1 expr)))))
+ (push (nth 1 expr) olist))
+ (error nil))))))
(kill-buffer (current-buffer)))
(when (setq olist (nreverse olist))
(insert "------------------ Environment follows ------------------\n\n"))
(setq olist (cdr olist)))
(insert "\n\n")
;; Remove any null chars - they seem to cause trouble for some
- ;; mailers. (Byte-compiled output from the stuff above.)
+ ;; mailers. (Byte-compiled output from the stuff above.)
(goto-char (point-min))
(while (re-search-forward "[\000\200]" nil t)
(replace-match "" t t))))
(let* ((var gnus-message-archive-group)
(group (or group gnus-newsgroup-name ""))
result
+ gcc-self-val
(groups
(cond
((null gnus-message-archive-method)
(gnus-inews-narrow-to-headers)
(goto-char (point-max))
(insert "Gcc: ")
- (while (setq name (pop groups))
- (insert (if (string-match ":" name)
- name
- (gnus-group-prefixed-name
- name gnus-message-archive-method)))
- (insert " "))
- (insert "\n"))))))
+ (if (and gnus-newsgroup-name
+ (setq gcc-self-val
+ (gnus-group-find-parameter
+ gnus-newsgroup-name 'gcc-self)))
+ (progn
+ (insert
+ (if (stringp gcc-self-val)
+ gcc-self-val
+ group))
+ (if (not (eq gcc-self-val 'none))
+ (insert "\n")
+ (progn
+ (beginning-of-line)
+ (kill-line))))
+ (while (setq name (pop groups))
+ (insert (if (string-match ":" name)
+ name
+ (gnus-group-prefixed-name
+ name gnus-message-archive-method)))
+ (when groups
+ (insert " ")))
+ (insert "\n")))))))
(defun gnus-summary-send-draft ()
"Enter a mail/post buffer to edit and send the draft."
projects / gnus / blobdiff