(require 'gnus)
(require 'sendmail)
(require 'gnus-ems)
-(require 'rmail)
(defvar gnus-organization-file "/usr/lib/news/organization"
"*Local news organization file.")
+(defvar gnus-prepare-article-hook (list 'gnus-inews-insert-signature)
+ "*A hook called after preparing body, but before preparing header headers.
+The default hook (`gnus-inews-insert-signature') inserts a signature
+file specified by the variable `gnus-signature-file'.")
+
(defvar gnus-post-prepare-function nil
"*Function that is run after a post buffer has been prepared.
It is called with the name of the newsgroup that is posted to. It
If you want to insert the signature, you might put
`gnus-inews-insert-signature' in this hook.")
-(defvar gnus-use-followup-to 'use
+(defvar gnus-use-followup-to t
"*Specifies what to do with Followup-To header.
If nil, ignore the header. If it is t, use its value, but ignore
-`poster'. If it is neither nil nor t, which is the default, always use
-the value.")
+`poster'. If it is the symbol `ask', query the user before posting.
+If it is the symbol `use', always use the value.")
(defvar gnus-followup-to-function nil
"*A variable that contains a function that returns a followup address.
you want Gnus not to insert some header, remove it from this list.")
(defvar gnus-deletable-headers '(Message-ID Date)
- "*Headers to be deleted if they already exists.")
+ "*Headers to be deleted if they already exists and were generated by Gnus previously.")
+
+(defvar gnus-removable-headers '(NNTP-Posting-Host Bcc Xref)
+ "*Headers to be removed unconditionally before posting.")
(defvar gnus-check-before-posting
'(subject-cmsg multiple-headers sendsys message-id from
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:"
+(defvar gnus-delete-supersedes-headers
+ "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Supersedes:"
"*Header lines matching this regexp will be deleted before posting.
-It's best to delete old Path and Date headers before psoting to avoid
+It's best to delete old Path and Date headers before posting to avoid
any confusion.")
(defvar gnus-auto-mail-to-author nil
(defvar gnus-article-copy nil)
(defvar gnus-reply-subject nil)
+(eval-and-compile
+ (autoload 'gnus-uu-post-news "gnus-uu" nil t)
+ (autoload 'rmail-output "rmailout"))
+
\f
;;;
;;; Gnus Posting Functions
(set-buffer gnus-article-buffer)
(if (and gnus-use-followup-to
(string-equal "poster" (gnus-fetch-field "followup-to"))
- (or (not (eq gnus-use-followup-to t))
+ (or (not (memq gnus-use-followup-to '(t ask)))
(not (gnus-y-or-n-p
"Do you want to ignore `Followup-To: poster'? "))))
;; Mail to the poster.
(if (not
(string-equal
(downcase (mail-strip-quoted-names
- (header-from gnus-current-headers)))
+ (mail-header-from gnus-current-headers)))
(downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
(error "This article is not yours."))
(save-excursion
(progn
(erase-buffer)
(insert-buffer gnus-article-buffer)
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
- (if (not (re-search-backward "^Message-ID: " nil t))
- (error "No Message-ID in this article")
- (replace-match "Supersedes: " t t))
- (search-forward "\n\n")
- (forward-line -1)
- (insert mail-header-separator)
-
- (forward-line -1)
+ (if (search-forward "\n\n" nil t)
+ (forward-char -1)
+ (goto-char (point-max)))
(narrow-to-region (point-min) (point))
(goto-char (point-min))
(and gnus-delete-supersedes-headers
(delete-matching-lines gnus-delete-supersedes-headers))
- (widen))))
+ (goto-char (point-min))
+ (if (not (re-search-forward "^Message-ID: " nil t))
+ (error "No Message-ID in this article")
+ (replace-match "Supersedes: " t t))
+ (goto-char (point-max))
+ (insert mail-header-separator)
+ (widen)
+ (forward-line 1))))
\f
;;;###autoload
(save-excursion
(set-buffer gnus-summary-buffer)
(cons (current-buffer) gnus-current-article))))
- (from (and header (header-from header)))
+ (from (and header (mail-header-from header)))
(winconf (current-window-configuration))
real-group)
(and gnus-interactive-post
(not gnus-expert-user)
post (not group)
(progn
- (setq group
- (completing-read "Group: " gnus-active-hashtb))
+ (setq gnus-newsgroup-name
+ (setq group
+ (completing-read "Group: " gnus-active-hashtb)))
(or subject
(setq subject (read-string "Subject: ")))))
(setq mail-reply-buffer gnus-article-copy)
(make-local-variable 'gnus-article-reply)
(make-local-variable 'gnus-article-check-size)
(make-local-variable 'gnus-reply-subject)
- (setq gnus-reply-subject (and header (header-subject header)))
+ (setq gnus-reply-subject (and header (mail-header-subject header)))
(setq gnus-article-reply sumart)
;; Handle `gnus-auto-mail-to-author'.
;; Suggested by Daniel Quinlan <quinlan@best.com>.
- (let ((to (and (not post)
- (if (eq gnus-auto-mail-to-author 'ask)
- (and (y-or-n-p "Also send mail to author? ") from)
- (and gnus-auto-mail-to-author from)))))
+ ;; Revised to respect Reply-To by Ulrik Dickow <dickow@nbi.dk>.
+ (let ((to (and (not post)
+ (if (if (eq gnus-auto-mail-to-author 'ask)
+ (y-or-n-p "Also send mail to author? ")
+ gnus-auto-mail-to-author)
+ (or (save-excursion
+ (set-buffer gnus-article-copy)
+ (gnus-fetch-field "reply-to"))
+ from)))))
(if to
- (progn
- (if (mail-fetch-field "To")
- (progn
- (beginning-of-line)
- (insert "Cc: " to "\n"))
- (mail-position-on-field "To")
- (insert to)))))
+ (if (mail-fetch-field "To")
+ (progn
+ (beginning-of-line)
+ (insert "Cc: " to "\n"))
+ (mail-position-on-field "To")
+ (insert to))))
;; Handle author copy using BCC field.
(if (and gnus-mail-self-blind
(not (mail-fetch-field "bcc")))
If given a prefix, and the group is a foreign group, this function
will attempt to use the foreign server to post the article."
(interactive "P")
+ (or gnus-current-select-method
+ (setq gnus-current-select-method gnus-select-method))
(let* ((case-fold-search nil)
- (server-running (gnus-server-opened gnus-select-method))
+ (server-running (gnus-server-opened gnus-current-select-method))
(reply gnus-article-reply)
error post-result)
(save-excursion
;; Correct newsgroups field: change sequence of spaces to comma and
;; eliminate spaces around commas. Eliminate imbedded line breaks.
(goto-char (point-min))
- (if (search-forward-regexp "^Newsgroups: +" nil t)
+ (if (re-search-forward "^Newsgroups: +" nil t)
(save-restriction
(narrow-to-region
(point)
- (if (re-search-forward "^[^ \t]" nil 'end)
+ (if (re-search-forward "^[^ \t]" nil t)
(match-beginning 0)
- (point-max)))
+ (forward-line 1)
+ (point)))
(goto-char (point-min))
- (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing)
+ (while (re-search-forward "\n[ \t]+" nil t)
+ (replace-match " " t t)) ;No line breaks (too confusing)
(goto-char (point-min))
- (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ",")))
+ (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t)
+ (replace-match "," t t))
+ (goto-char (point-min))
+ ;; Remove a trailing comma.
+ (if (re-search-forward ",$" nil t)
+ (replace-match "" t t))))
;; Added by Per Abrahamsen <abraham@iesd.auc.dk>.
;; Help save the the world!
(let ((newsgroups (mail-fetch-field "newsgroups"))
(followup-to (mail-fetch-field "followup-to"))
groups to)
- (if (and (string-match "," newsgroups) (not followup-to))
+ (if (and newsgroups
+ (string-match "," newsgroups) (not followup-to))
(progn
(while (string-match "," newsgroups)
(setq groups
;; We generate a Message-ID so that the mail and the
;; news copy of the message both get the same ID.
(or (mail-fetch-field "message-id")
+ (not (memq 'Message-ID gnus-required-headers))
(progn
(goto-char (point-max))
(insert "Message-ID: " (gnus-inews-message-id) "\n")))
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$")))
(goto-char (point-min))
- (delete-matching-lines "^BCC:"))
+ (while (re-search-forward "^BCC:" nil t)
+ (delete-region (match-beginning 0)
+ ;; There might be continuation headers.
+ (if (re-search-forward "^[^ \t]" nil t)
+ (match-beginning 0)
+ ;; Uhm... or something like this.
+ (forward-line 1)
+ (point)))))
(if fcc-line
(progn
(goto-char (point-max))
(goto-char (point-max))
(if (not (re-search-backward gnus-signature-separator nil t))
t
- (if (> (count-lines (point) (point-max)) 4)
+ (if (> (count-lines (point) (point-max)) 5)
(gnus-y-or-n-p
(format
"Your .sig is %d lines; it should be max 4. Really post? "
(match-beginning 0)))
(gnus-inews-remove-headers)
(gnus-inews-insert-headers)
- (run-hooks gnus-inews-article-header-hook)
+ (run-hooks 'gnus-inews-article-header-hook)
(widen))
;; Check whether the article is a good Net Citizen.
(if (and gnus-article-check-size
(concat "^" (regexp-quote mail-header-separator) "$"))
(replace-match "" t t)
;; This hook may insert a signature.
- (run-hooks 'gnus-prepare-article-hook)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((gnus-newsgroup-name (or (mail-fetch-field "newsgroups")
+ gnus-newsgroup-name)))
+ (run-hooks 'gnus-prepare-article-hook)))
;; Run final inews hooks. This hook may do FCC.
;; The article must be saved before being posted because
;; `gnus-request-post' modifies the buffer.
(kill-buffer (current-buffer)))))))
(defun gnus-inews-remove-headers ()
- (let ((case-fold-search t))
- ;; Remove NNTP-posting-host.
- (goto-char (point-min))
- (and (re-search-forward "^nntp-posting-host:" nil t)
- (delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point))))
- ;; Remove Bcc.
- (goto-char (point-min))
- (and (re-search-forward "^bcc:" nil t)
- (delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point))))))
+ (let ((case-fold-search t)
+ (headers gnus-removable-headers))
+ ;; Remove toxic headers.
+ (while headers
+ (goto-char (point-min))
+ (and (re-search-forward
+ (concat "^" (downcase (format "%s" (car headers))))
+ nil t)
+ (delete-region (progn (beginning-of-line) (point))
+ (progn (forward-line 1) (point))))
+ (setq headers (cdr headers)))))
(defun gnus-inews-insert-headers ()
"Prepare article headers.
(if (or (not (re-search-forward
(concat "^" (downcase (symbol-name header)) ":") nil t))
(progn
- (if (= (following-char) ? ) (forward-char 1) (insert " "))
+ ;; The header was found. We insert a space after the
+ ;; colon, if there is none.
+ (if (/= (following-char) ? ) (insert " "))
+ ;; Find out whether the header is empty...
(looking-at "[ \t]*$")))
+ ;; So we find out what value we should insert.
(progn
(setq value
(or (if (consp elem)
'(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)))))
+ (let ((from (mail-fetch-field "from"))
+ (sender (mail-fetch-field "sender")))
+ (if (and from
+ (not (string=
+ (downcase (car (gnus-extract-address-components from)))
+ (downcase (gnus-inews-real-user-address))))
+ (or (null sender)
+ (not
+ (string=
+ (downcase (car (gnus-extract-address-components sender)))
+ (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))))
+ (progn
+ (beginning-of-line)
+ (insert "Original-")
+ (beginning-of-line)))
(insert "Sender: " (gnus-inews-real-user-address) "\n"))))))
In either case, if the string is a file name, this file is
inserted. If the string is not a file name, the string itself is
inserted.
-If you never want any signature inserted, set both those variables to
+
+If you never want any signature inserted, set both of these variables to
nil."
(save-excursion
(let ((signature
(if (and gnus-author-copy-saver
(not (eq gnus-author-copy-saver 'rmail-output)))
(funcall gnus-author-copy-saver fcc-file)
- (if (and (file-readable-p fcc-file) (rmail-file-p fcc-file))
+ (if (and (file-readable-p fcc-file)
+ (mail-file-babyl-p fcc-file))
(gnus-output-to-rmail fcc-file)
(rmail-output fcc-file 1 t t))))))))))
(defun gnus-inews-user-name ()
"Return user's network address as \"NAME@DOMAIN (FULL-NAME)\"."
- (let ((full-name (gnus-inews-full-name)))
+ (let ((full-name (gnus-inews-full-name))
+ (address (if (or gnus-user-login-name gnus-use-generic-from
+ gnus-local-domain (getenv "DOMAINNAME"))
+ (concat (gnus-inews-login-name) "@"
+ (gnus-inews-domain-name gnus-use-generic-from))
+ user-mail-address)))
(or gnus-user-from-line
- (concat (if (or gnus-user-login-name gnus-use-generic-from
- gnus-local-domain (getenv "DOMAINNAME"))
- (concat (gnus-inews-login-name) "@"
- (gnus-inews-domain-name gnus-use-generic-from))
- user-mail-address)
+ (concat address
;; User's full name.
- (cond ((string-equal full-name "") "")
- ((string-equal full-name "&") ;Unix hack.
+ (cond ((string-equal full-name "&") ;Unix hack.
(concat " (" (user-login-name) ")"))
+ ((string-match "[^ ]+@[^ ]+ +(.*)" address)
+ "")
(t
(concat " (" full-name ")")))))))
(setq follow-to (funcall gnus-reply-to-function group)))
(setq from (mail-fetch-field "from"))
(setq date (or (mail-fetch-field "date")
- (header-date gnus-current-headers)))
+ (mail-header-date gnus-current-headers)))
(and from
(let ((stop-pos
(string-match " *at \\| *@ \\| *(\\| *<" from)))
(or follow-to reply-to from sender "")))
subject message-of nil gnus-article-copy nil)
+ (auto-save-mode auto-save-default)
(use-local-map (copy-keymap mail-mode-map))
(local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
(while follow-to
(insert (car (car follow-to)) ": " (cdr (car follow-to)) "\n")
(setq follow-to (cdr follow-to)))))
- ;; Fold long references line to follow RFC1036.
- (mail-position-on-field "References")
- (let ((begin (- (point) (length "References: ")))
- (fill-column 78)
- (fill-prefix "\t"))
- (if references (insert references))
- (if (and references message-id) (insert " "))
- (if message-id (insert message-id))
- ;; The region must end with a newline to fill the region
- ;; without inserting extra newline.
- (fill-region-as-paragraph begin (1+ (point))))
+ (nnheader-insert-references references message-id)
(goto-char (point-min))
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$"))
(defun gnus-mail-yank-original ()
(interactive)
(save-excursion
- (mail-yank-original nil))
+ (mail-yank-original nil))
(or mail-yank-hooks mail-citation-hook
(run-hooks 'news-reply-header-hook)))
gnus-newsgroup-name)))
gnus-valid-select-methods))
(gnus-fetch-field "From")
- gnus-newsgroup-name)
+ gnus-newsgroup-name)
"] " (or (gnus-fetch-field "Subject") ""))))
(defun gnus-forward-insert-buffer (buffer)
(switch-to-buffer gnus-summary-buffer)
(funcall gnus-mail-reply-method yank address)))))
-(defun gnus-article-mail-with-original ()
- "Send a reply to the address near point and include the original article."
- (interactive)
- (gnus-article-mail 'yank))
-
(defun gnus-bug ()
"Send a bug report to the Gnus maintainers."
(interactive)
(erase-buffer)
(mail-mode)
(mail-setup gnus-maintainer nil nil nil nil nil)
+ (auto-save-mode auto-save-default)
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf)
(use-local-map (copy-keymap mail-mode-map))
(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)))
+ (gnus-debug)
+ (goto-char (point-min))
+ (search-forward "Subject: " nil t)
(message "")))
(defun gnus-bug-mail-send-and-exit ()
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)
+ file dirs expr olist sym)
(message "Please wait while we snoop your variables...")
(sit-for 0)
(save-excursion
(while olist
(if (boundp (car olist))
(insert "(setq " (symbol-name (car olist))
- (if (or (consp (symbol-value (car olist)))
- (symbolp (symbol-value (car olist))))
+ (if (or (consp (setq sym (symbol-value (car olist))))
+ (and (symbolp sym)
+ (not (or (eq sym nil)
+ (eq sym t)))))
" '" " ")
(prin1-to-string (symbol-value (car olist))) ")\n")
(insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
projects / gnus / blobdiff