(require 'gnus)
(require 'sendmail)
+(require 'gnus-ems)
(defvar gnus-organization-file "/usr/lib/news/organization"
"*Local news organization file.")
If this variable is t, Gnus will check everything it can. If it is a
list, then those elements in that list will be checked.")
+(defvar gnus-delete-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:"
+ "*Header lines matching this regexp will be deleted before posting.
+It's best to delete old Path and Date headers before psoting to avoid
+any confusion.")
+
(defvar gnus-auto-mail-to-author nil
"*If non-nil, mail the authors of articles a copy of your follow-ups.
If this variable is `ask', the user will be prompted for whether to
;;; Internal variables.
(defvar gnus-post-news-buffer "*post-news*")
+(defvar gnus-mail-buffer "*mail*")
(defvar gnus-summary-send-map nil)
(defvar gnus-article-copy nil)
(defvar gnus-reply-subject nil)
(gnus-set-global-variables)
(if yank-articles (gnus-summary-goto-subject (car yank-articles)))
(save-window-excursion
- (gnus-summary-select-article t))
+ (gnus-summary-select-article))
(let ((headers gnus-current-headers)
(gnus-newsgroup-name gnus-newsgroup-name))
;; Check Followup-To: poster.
(or (not (eq gnus-use-followup-to t))
(not (gnus-y-or-n-p
"Do you want to ignore `Followup-To: poster'? "))))
- ;; Mail to the poster. Gnus is now RFC1036 compliant.
+ ;; Mail to the poster.
(gnus-summary-reply yank)
(gnus-post-news nil gnus-newsgroup-name
headers gnus-article-buffer
- (or yank-articles (not (not yank))))))
- (gnus-article-hide-headers-if-wanted))
+ (or yank-articles (not (not yank)))))))
(defun gnus-summary-followup-with-original (n)
"Compose a followup to an article and include the original article."
(let ((articles (gnus-summary-work-articles n)))
(while articles
(gnus-summary-select-article t nil nil (car articles))
- (gnus-eval-in-buffer-window gnus-article-buffer (gnus-cancel-news))
+ (and (gnus-eval-in-buffer-window gnus-article-buffer (gnus-cancel-news))
+ (gnus-summary-mark-as-read (car articles) gnus-canceled-mark))
(gnus-summary-remove-process-mark (car articles))
- (gnus-summary-mark-as-read (car articles) gnus-canceled-mark)
(gnus-article-hide-headers-if-wanted)
(setq articles (cdr articles)))))
header line with the old Message-ID."
(interactive)
(gnus-set-global-variables)
- (if (not
+ (gnus-summary-select-article t)
+ (if (or
(string-equal
(downcase (mail-strip-quoted-names
(header-from gnus-current-headers)))
(downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
(error "This article is not yours."))
- (gnus-summary-select-article t)
(save-excursion
(set-buffer gnus-article-buffer)
(let ((buffer-read-only nil))
(replace-match "Supersedes: " t t))
(search-forward "\n\n")
(forward-line -1)
- (insert mail-header-separator))))
+ (insert mail-header-separator)
+
+ (forward-line -1)
+ (narrow-to-region (point-min) (point))
+ (goto-char (point-min))
+ (and gnus-delete-supersedes-headers
+ (delete-matching-lines gnus-delete-supersedes-headers))
+ (widen))))
\f
;;;###autoload
(cons (current-buffer) gnus-current-article))))
(from (and header (header-from header)))
(winconf (current-window-configuration))
- follow-to real-group)
+ real-group)
(and gnus-interactive-post
(not gnus-expert-user)
post (not group)
(if (and (boundp 'gnus-followup-to-function)
gnus-followup-to-function
gnus-article-copy)
- (setq follow-to
- (save-excursion
- (set-buffer gnus-article-copy)
- (funcall gnus-followup-to-function group)))))
+ (save-excursion
+ (set-buffer gnus-article-copy)
+ (funcall gnus-followup-to-function group))))
gnus-use-followup-to))
(if post
(gnus-configure-windows 'post)
(interactive "P")
(let* ((case-fold-search nil)
(server-running (gnus-server-opened gnus-select-method))
- (reply gnus-article-reply))
+ (reply gnus-article-reply)
+ error)
(save-excursion
;; Connect to default NNTP server if necessary.
;; Suggested by yuki@flab.fujitsu.junet.
(gnus-summary-mark-article-as-replied
(cdr reply))))))
;; We cannot signal an error.
+ (setq error t)
(ding) (gnus-message 1 "Article rejected: %s"
(gnus-status-message gnus-select-method)))
(set-buffer-modified-p nil))
(let ((conf gnus-prev-winconf))
(bury-buffer)
;; Restore last window configuration.
- (and conf (set-window-configuration conf)))))
+ (and conf (not error) (set-window-configuration conf)))))
(defun gnus-inews-check-post ()
"Check whether the post looks ok."
(message-id nil)
(distribution nil))
(or (gnus-member-of-valid 'post gnus-newsgroup-name)
- (error "This backend does not support cancelling"))
+ (error "This backend does not support canceling"))
(save-excursion
;; Get header info. from original article.
(save-restriction
(downcase (mail-strip-quoted-names from))
(downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
(progn
- (ding) (gnus-message 3 "This article is not yours."))
+ (ding) (gnus-message 3 "This article is not yours.")
+ nil)
;; Make control article.
(set-buffer (get-buffer-create " *Gnus-canceling*"))
(buffer-disable-undo (current-buffer))
(insert "Newsgroups: " newsgroups "\n"
"Subject: cancel " message-id "\n"
"Control: cancel " message-id "\n"
+ (if distribution
+ (concat "Distribution: " distribution "\n")
+ "")
mail-header-separator "\n"
"This is a cancel message from " from ".\n")
;; Send the control article to NNTP server.
(gnus-message 5 "Canceling your article...")
- (if (funcall gnus-inews-article-function)
- (gnus-message 5 "Canceling your article...done")
- (ding)
- (gnus-message 1 "Cancel failed; %s"
- (gnus-status-message gnus-newsgroup-name)))
- ;; Kill the article buffer.
- (kill-buffer (current-buffer)))))))
+ (prog1
+ (if (funcall gnus-inews-article-function)
+ (gnus-message 5 "Canceling your article...done")
+ (progn
+ (ding)
+ (gnus-message 1 "Cancel failed; %s"
+ (gnus-status-message gnus-newsgroup-name))
+ nil)
+ t)
+ ;; Kill the article buffer.
+ (kill-buffer (current-buffer))))))))
\f
;;; Lowlevel inews interface
(goto-char (point-min))
(and (re-search-forward
(concat "^" (symbol-name (car headers)) ": *") nil t)
- (get-text-property 'gnus-delete (match-end 0))
+ (get-text-property (1+ (match-end 0)) 'gnus-deletable)
(gnus-delete-line))
(setq headers (cdr headers))))
;; Insert new Sender if the From is strange.
;; so we just ask the user.
(read-from-minibuffer
(format "Empty header for %s; enter value: " header))))
- ;; Add the deletable property to the headers that require it.
- (and (memq header gnus-deletable-headers)
- (add-text-properties
- 0 (length value) '(gnus-deletable t) value))
;; Finally insert the header.
(if (bolp)
(save-excursion
(goto-char (point-max))
- (insert (symbol-name header) ": " value "\n"))
+ (insert (symbol-name header) ": ")
+ ;; Add the deletable property to the headers that require it.
+ (if (memq header gnus-deletable-headers)
+ (add-text-properties
+ (point) (progn (insert value) (point))
+ '(gnus-deletable t) (current-buffer))
+ (insert value))
+ (insert "\n"))
(replace-match value t t))))
(setq headers (cdr headers)))))
(save-excursion
(let ((signature
(or (and gnus-signature-function
- (fboundp gnus-signature-function)
(funcall gnus-signature-function gnus-newsgroup-name))
- gnus-signature-file))
- b)
+ gnus-signature-file)))
(if (and signature
(or (file-exists-p signature)
(string-match " " signature)
"~/.organization")))
(and (stringp organization)
(> (length organization) 0)
+ (or (file-exists-p organization)
+ (string-match " " organization)
+ (not (string-match "^/usr/lib/" organization)))
(save-excursion
(gnus-set-work-buffer)
(if (file-exists-p organization)
;; Stripping headers should be specified with mail-yank-ignored-headers.
(gnus-set-global-variables)
(if yank-articles (gnus-summary-goto-subject (car yank-articles)))
- (gnus-summary-select-article t)
+ (gnus-summary-select-article)
(let ((gnus-newsgroup-name gnus-newsgroup-name))
(bury-buffer gnus-article-buffer)
- (funcall gnus-mail-reply-method (or yank-articles (not (not yank)))))
- (gnus-article-hide-headers-if-wanted))
+ (funcall gnus-mail-reply-method (or yank-articles (not (not yank))))))
(defun gnus-summary-reply-with-original (n)
"Reply mail to news author with original article.
Customize the variable gnus-mail-forward-method to use another mailer."
(interactive "P")
(gnus-set-global-variables)
- (gnus-summary-select-article t)
+ (gnus-summary-select-article)
(gnus-copy-article-buffer)
(let ((gnus-newsgroup-name gnus-newsgroup-name))
(if post
(gnus-forward-using-post gnus-article-copy)
- (funcall gnus-mail-forward-method gnus-article-copy)))
- (gnus-article-hide-headers-if-wanted))
+ (funcall gnus-mail-forward-method gnus-article-copy))))
(defun gnus-summary-post-forward ()
"Forward the current article to a newsgroup."
(interactive)
(gnus-summary-mail-forward t))
+(defvar gnus-nastygram-message
+ "The following article was inappropriately posted to %s.\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-mail-buffer)
+ (insert (format gnus-nastygram-message group))
+ (gnus-mail-send-and-exit))))
+
(defun gnus-summary-mail-other-window ()
"Compose mail in other window.
Customize the variable `gnus-mail-other-window-method' to use another
(defun gnus-mail-reply-using-mail (&optional yank to-address)
(save-excursion
(set-buffer gnus-summary-buffer)
- (let ((info (nth 2 (gnus-gethash gnus-newsgroup-name gnus-newsrc-hashtb)))
- (group (gnus-group-real-name gnus-newsgroup-name))
+ (let ((group (gnus-group-real-name gnus-newsgroup-name))
(cur (cons (current-buffer) (cdr gnus-article-current)))
(winconf (current-window-configuration))
- from subject date to reply-to message-of
- references message-id sender follow-to cc sendto elt)
- (set-buffer (get-buffer-create "*mail*"))
+ from subject date reply-to message-of
+ references message-id sender follow-to sendto elt)
+ (set-buffer (get-buffer-create gnus-mail-buffer))
(mail-mode)
(make-local-variable 'gnus-article-reply)
(setq gnus-article-reply cur)
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf)
- (use-local-map (copy-keymap mail-mode-map))
- (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
(if (and (buffer-modified-p)
(> (buffer-size) 0)
(not (gnus-y-or-n-p
"Re: none"))
(or (string-match "^[Rr][Ee]:" subject)
(setq subject (concat "Re: " subject)))
- (setq cc (mail-fetch-field "cc"))
(setq reply-to (mail-fetch-field "reply-to"))
(setq references (mail-fetch-field "references"))
(setq message-id (mail-fetch-field "message-id"))
(or follow-to reply-to from sender "")))
subject message-of nil gnus-article-copy nil)
+ (use-local-map (copy-keymap mail-mode-map))
+ (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
+
(if (and follow-to (listp follow-to))
(progn
(goto-char (point-min))
(interactive)
(gnus-article-mail 'yank))
+(defun gnus-bug ()
+ "Send a bug report to the Gnus maintainers."
+ (interactive)
+ (let ((winconf (current-window-configuration)))
+ (delete-other-windows)
+ (switch-to-buffer "*Gnus Help Bug*")
+ (erase-buffer)
+ (insert gnus-bug-message)
+ (goto-char (point-min))
+ (pop-to-buffer "*Gnus Bug*")
+ (erase-buffer)
+ (mail-mode)
+ (mail-setup gnus-maintainer nil nil nil nil nil)
+ (make-local-variable 'gnus-prev-winconf)
+ (setq gnus-prev-winconf winconf)
+ (use-local-map (copy-keymap mail-mode-map))
+ (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
+ (goto-char (point-min))
+ (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
+ (forward-line 1)
+ (insert (format "%s\n%s\n\n\n\n\n" (gnus-version) (emacs-version)))
+ (let ((b (point)))
+ (gnus-debug)
+ (goto-char (- b 3)))
+ (message "")))
+
+(defun gnus-debug ()
+ "Attemps 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"))
+ file dirs expr olist)
+ (save-excursion
+ (set-buffer (get-buffer-create " *gnus bug info*"))
+ (buffer-disable-undo (current-buffer))
+ (message "Please wait while we snoop your variables...")
+ (sit-for 0)
+ (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)
+ (goto-char (point-min))
+ (or (re-search-forward "^;;* Internal variables" nil t)
+ (error "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)))
+ (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))))))
+ (setq files (cdr files)))
+ (kill-buffer (current-buffer)))
+ (insert "------------------- Environment follows -------------------\n\n")
+ (while olist
+ (if (boundp (car olist))
+ (insert "(setq " (symbol-name (car olist)) " '"
+ (prin1-to-string (symbol-value (car olist))) ")\n")
+ (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
+ (setq olist (cdr olist)))
+ (insert "\n\n")))
+
+(gnus-ems-redefine)
+
(provide 'gnus-msg)
;;; gnus-msg.el ends here
projects / gnus / blobdiff