(require 'gnus)
(require 'sendmail)
+(require 'gnus-ems)
+(require 'rmail)
(defvar gnus-organization-file "/usr/lib/news/organization"
"*Local news organization file.")
Message-ID. Organization, Lines and X-Newsreader are optional. If
you want Gnus not to insert some header, remove it from this list.")
-(defvar gnus-deletable-headers '(Message-ID)
+(defvar gnus-deletable-headers '(Message-ID Date)
"*Headers to be deleted if they already exists.")
(defvar gnus-check-before-posting
;;; 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)
(defun gnus-group-mail ()
"Start composing a mail."
(interactive)
- (funcall gnus-mail-other-window-method)
- (gnus-configure-windows 'group-mail)
- (run-hooks 'gnus-mail-hook))
+ (funcall gnus-mail-other-window-method))
(defun gnus-group-post-news ()
"Post an article."
(gnus-set-global-variables)
(if yank-articles (gnus-summary-goto-subject (car yank-articles)))
(save-window-excursion
- (gnus-summary-select-article t))
- (let ((headers gnus-current-headers)
+ (gnus-summary-select-article))
+ (let ((headers (gnus-get-header-by-number (gnus-summary-article-number)))
(gnus-newsgroup-name gnus-newsgroup-name))
;; Check Followup-To: poster.
(set-buffer gnus-article-buffer)
(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)))))
(interactive)
(gnus-set-global-variables)
(gnus-summary-select-article t)
- (if (or
+ (if (not
(string-equal
(downcase (mail-strip-quoted-names
(header-from gnus-current-headers)))
(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)
+ (gnus-configure-windows 'post 'force)
(if yank
- (gnus-configure-windows 'followup-yank)
- (gnus-configure-windows 'followup)))
+ (gnus-configure-windows 'followup-yank 'force)
+ (gnus-configure-windows 'followup 'force)))
(gnus-overload-functions)
(make-local-variable 'gnus-article-reply)
(make-local-variable 'gnus-article-check-size)
(interactive "P")
(let* ((case-fold-search nil)
(server-running (gnus-server-opened gnus-select-method))
- (reply gnus-article-reply))
+ (reply gnus-article-reply)
+ error post-result)
(save-excursion
;; Connect to default NNTP server if necessary.
;; Suggested by yuki@flab.fujitsu.junet.
;; Send to server.
(gnus-message 5 "Posting to USENET...")
- (if (funcall gnus-inews-article-function use-group-method)
- (progn
- (gnus-message 5 "Posting to USENET...done")
- (if (gnus-buffer-exists-p (car-safe reply))
- (progn
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-summary-mark-article-as-replied
- (cdr reply))))))
- ;; We cannot signal an error.
- (ding) (gnus-message 1 "Article rejected: %s"
- (gnus-status-message gnus-select-method)))
- (set-buffer-modified-p nil))
+ (setq post-result (funcall gnus-inews-article-function use-group-method))
+ (cond ((eq post-result 'illegal)
+ (setq error t)
+ (ding))
+ (post-result
+ (gnus-message 5 "Posting to USENET...done")
+ (if (gnus-buffer-exists-p (car-safe reply))
+ (progn
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-mark-article-as-replied
+ (cdr reply)))))
+ (set-buffer-modified-p nil))
+ (t
+ ;; We cannot signal an error.
+ (setq error t)
+ (ding)
+ (gnus-message 1 "Article rejected: %s"
+ (gnus-status-message gnus-select-method)))))
;; If NNTP server is opened by gnus-inews-news, close it by myself.
(or server-running
(gnus-close-server (gnus-find-method-for-group gnus-newsgroup-name)))
(let ((conf gnus-prev-winconf))
- (bury-buffer)
- ;; Restore last window configuration.
- (and conf (set-window-configuration conf)))))
+ (if (not error)
+ (progn
+ (bury-buffer)
+ ;; Restore last window configuration.
+ (and conf (set-window-configuration conf)))))))
(defun gnus-inews-check-post ()
"Check whether the post looks ok."
(goto-char (point-min))
(narrow-to-region
(point)
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$")))
+ (progn
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ (match-beginning 0)))
(goto-char (point-min))
(and
;; Check for commands in Subject.
- (or (gnus-check-before-posting 'subject-cmsg)
- (save-excursion
- (if (string-match "^cmsg " (mail-fetch-field "subject"))
- (gnus-y-or-n-p
- "The control code \"cmsg \" is in the subject. Really post? ")
- t)))
+ (or
+ (gnus-check-before-posting 'subject-cmsg)
+ (save-excursion
+ (if (string-match "^cmsg " (mail-fetch-field "subject"))
+ (gnus-y-or-n-p
+ "The control code \"cmsg \" is in the subject. Really post? ")
+ t)))
;; Check for multiple identical headers.
(or (gnus-check-before-posting 'multiple-headers)
(save-excursion
(let (found)
- (while (and (not found) (re-search-forward "^[^ \t:]+: " nil t))
+ (while (and (not found) (re-search-forward "^[^ \t:]+: "
+ nil t))
(save-excursion
(or (re-search-forward
(concat "^" (setq found
(save-excursion
(let* ((case-fold-search t)
(from (mail-fetch-field "from")))
- (or (not from)
- (and (string-match "@" from)
- (string-match "@[^\\.]*\\." from))
- (gnus-yes-or-no-p
- (format "The From looks strange: \"%s\". Really post? "
- from)))))))))
+ (cond
+ ((not from)
+ (gnus-yes-or-no-p "There is no From line. Really post? "))
+ ((not (string-match "@[^\\.]*\\." from))
+ (gnus-yes-or-no-p
+ (format
+ "The address looks strange: \"%s\". Really post? " from)))
+ ((string-match "(.*).*(.*)" from)
+ (gnus-yes-or-no-p
+ (format
+ "The From header looks strange: \"%s\". Really post? "
+ from)))
+ (t t)))))
+ )))
;; Check for long lines.
(or (gnus-check-before-posting 'long-lines)
(save-excursion
t))
;; Use the (size . checksum) variable to see whether the
;; article is empty or has only quoted text.
- (or (gnus-check-before-posting 'new-text)
- (if (and (= (buffer-size) (car gnus-article-check-size))
- (= (gnus-article-checksum) (cdr gnus-article-check-size)))
- (gnus-yes-or-no-p
- "It looks like there's no new text in your article. Really post? ")
- t))
+ (or
+ (gnus-check-before-posting 'new-text)
+ (if (and (= (buffer-size) (car gnus-article-check-size))
+ (= (gnus-article-checksum) (cdr gnus-article-check-size)))
+ (gnus-yes-or-no-p
+ "It looks like there's no new text in your article. Really post? ")
+ t))
;; Check the length of the signature.
(or (gnus-check-before-posting 'signature)
(progn
;; Returns non-nil if this type is not to be checked.
(defun gnus-check-before-posting (type)
- (or (not gnus-check-before-posting)
- (if (listp gnus-check-before-posting)
- (memq type gnus-check-before-posting)
- t)))
+ (not
+ (or (not gnus-check-before-posting)
+ (if (listp gnus-check-before-posting)
+ (memq type gnus-check-before-posting)
+ t))))
(defun gnus-cancel-news ()
"Cancel an article you posted."
(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
(if (and gnus-article-check-size
(not (gnus-inews-check-post)))
;; Aber nein!
- ()
+ 'illegal
;; Looks ok, so we do the nasty.
(save-excursion
(set-buffer tmpbuf)
(goto-char (point-min))
(and (re-search-forward
(concat "^" (symbol-name (car headers)) ": *") nil t)
- (get-text-property (1+ (match-end 0)) 'gnus-deletable)
+ (get-text-property (1+ (match-beginning 0)) 'gnus-deletable)
(gnus-delete-line))
(setq headers (cdr headers))))
- ;; Insert new Sender if the From is strange.
- (let ((from (mail-fetch-field "from")))
- (if (and from (not (string= (downcase from) (downcase From))))
- (progn
- (goto-char (point-min))
- (and (re-search-forward "^Sender:" nil t)
- (delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point))))
- (insert "Sender: " From "\n"))))
;; If there are References, and no "Re: ", then the thread has
;; changed name. See Son-of-1036.
(if (and (mail-fetch-field "references")
;; 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"))
- (replace-match value t t))))
- (setq headers (cdr headers)))))
+ (save-excursion
+ (if (bolp)
+ (progn
+ (goto-char (point-max))
+ (insert (symbol-name header) ": " value "\n")
+ (forward-line -1))
+ (replace-match value t t))
+ ;; Add the deletable property to the headers that require it.
+ (and (memq header gnus-deletable-headers)
+ (progn (beginning-of-line) (looking-at "[^:]+: "))
+ (add-text-properties
+ (point) (match-end 0)
+ '(gnus-deletable t face italic) (current-buffer))))))
+ (setq headers (cdr headers)))
+ ;; Insert new Sender if the From is strange.
+ (let ((from (mail-fetch-field "from")))
+ (if (and from (not (string=
+ (downcase (car (gnus-extract-address-components
+ from)))
+ (downcase (gnus-inews-real-user-address)))))
+ (progn
+ (goto-char (point-min))
+ (and (re-search-forward "^Sender:" nil t)
+ (delete-region (progn (beginning-of-line) (point))
+ (progn (forward-line 1) (point))))
+ (insert "Sender: " (gnus-inews-real-user-address) "\n"))))))
+
(defun gnus-inews-insert-signature ()
"Insert a signature file.
(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)
()
;; Delete any previous signatures.
(if (search-backward "\n-- \n" nil t)
- (delete-region (1+ (point)) (point-max)))
- (insert "\n-- \n")
+ (delete-region (point) (point-max)))
+ (or (eolp) (insert "\n"))
+ (insert "-- \n")
(if (file-exists-p signature)
(insert-file-contents signature)
(insert signature))
(goto-char (point-max))
(or (bolp) (insert "\n"))))))))
+;; Written by "Mr. Per Persson" <pp@solace.mh.se>.
+(defun gnus-inews-insert-mime-headers ()
+ (let ((mail-header-separator ""))
+ (or (mail-position-on-field "Mime-Version")
+ (insert "1.0")
+ (cond ((save-excursion
+ (beginning-of-buffer)
+ (re-search-forward "[\200-\377]" nil t))
+ (or (mail-position-on-field "Content-Type")
+ (insert "text/plain; charset=ISO-8859-1"))
+ (or (mail-position-on-field "Content-Transfer-Encoding")
+ (insert "8bit")))
+ (t (or (mail-position-on-field "Content-Type")
+ (insert "text/plain; charset=US-ASCII"))
+ (or (mail-position-on-field "Content-Transfer-Encoding")
+ (insert "7bit")))))))
+
(defun gnus-inews-do-fcc ()
"Process FCC: fields in current article buffer.
Unless the first character of the field is `|', the article is saved
(t
(concat " (" full-name ")")))))))
+(defun gnus-inews-real-user-address ()
+ "Return the \"real\" user address.
+This function tries to ignore all user modifications, and
+give as trustworthy answer as possible."
+ (concat (user-login-name) "@" (gnus-inews-full-address)))
+
(defun gnus-inews-login-name ()
"Return login name."
(or gnus-user-login-name (getenv "LOGNAME") (user-login-name)))
;; 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."
"Really send a nastygram to the author of the current article? "))
(let ((group gnus-newsgroup-name))
(gnus-summary-reply-with-original n)
- (set-buffer "*mail*")
+ (set-buffer gnus-mail-buffer)
(insert (format gnus-nastygram-message group))
(gnus-mail-send-and-exit))))
(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))
(concat "^" (regexp-quote mail-header-separator) "$"))
(forward-line 1)
(if (not yank)
- (gnus-configure-windows 'reply)
+ (gnus-configure-windows 'reply 'force)
(let ((last (point))
end)
(if (not (listp yank))
(goto-char end)
(setq yank (cdr yank))))
(goto-char last))
- (gnus-configure-windows 'reply-yank))
+ (gnus-configure-windows 'reply-yank 'force))
(run-hooks 'gnus-mail-hook)))))
(defun gnus-mail-yank-original ()
(gnus-forward-insert-buffer forward-buffer)
(goto-char (point-min))
(re-search-forward "^To: " nil t)
- (gnus-configure-windows 'mail-forward)
+ (gnus-configure-windows 'mail-forward 'force)
;; You have a chance to arrange the message.
(run-hooks 'gnus-mail-forward-hook)
(run-hooks 'gnus-mail-hook)))
(local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf)
- (run-hooks 'gnus-mail-hook)))
+ (run-hooks 'gnus-mail-hook)
+ (gnus-configure-windows 'summary-mail 'force)))
(defun gnus-article-mail (yank)
"Send a reply to the address near point.
(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-bug-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-bug-mail-send-and-exit ()
+ "Send the bug message and exit."
+ (interactive)
+ (and (get-buffer "*Gnus Help Bug*")
+ (kill-buffer "*Gnus Help Bug*"))
+ (gnus-mail-send-and-exit))
+
+(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)
+ (message "Please wait while we snoop your variables...")
+ (sit-for 0)
+ (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)
+ (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)))
+ (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)))
+ (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