If the function returns nil, the `gnus-signature-file' variable will
be used instead.")
+(defvar gnus-forward-start-separator
+ "------- Start of forwarded message -------\n"
+ "*Delimiter inserted before forwarded messages.")
+
+(defvar gnus-forward-end-separator
+ "------- End of forwarded message -------\n"
+ "*Delimiter inserted after forwarded messages.")
+
+(defvar gnus-signature-before-forwarded-message t
+ "*If non-nil, put the signature before any included forwarded message.")
+
(defvar gnus-required-headers
'(From Date Newsgroups Subject Message-ID Organization Lines X-Newsreader)
"*Headers to be generated or prompted for when posting an article.
RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
-Message-ID. Organization, Lines, In-Reply-To and X-Newsreader are
-optional. If you want Gnus not to insert some header, remove it from
-this list.")
+Message-ID. Organization, Lines, In-Reply-To, Expires, and
+X-Newsreader are optional. If you want Gnus not to insert some
+header, remove it from this list.")
(defvar gnus-required-mail-headers
'(From Date To Subject (optional . In-Reply-To) Message-ID Organization Lines)
(defvar gnus-removable-headers '(NNTP-Posting-Host Bcc Xref)
"*Headers to be removed unconditionally before posting.")
+(defvar gnus-article-expires 14
+ "*Number of days before your article expires.
+This variable isn't used unless you have the `Expires' element in
+`gnus-required-headers'.")
+
+(defvar gnus-distribution-function nil
+ "*Function that should return the Distribution header for outgoing articles.
+It will be called from the buffer where the outgoing article
+is being prepared with the group name as the only parameter.
+It should return a valid distribution.
+
+The function will only be called if you have the `Distribution' header in
+`gnus-required-headers'.")
+
(defvar gnus-check-before-posting
'(subject-cmsg multiple-headers sendsys message-id from
long-lines control-chars size new-text
(defvar gnus-post-news-buffer "*post-news*")
(defvar gnus-mail-buffer "*mail*")
(defvar gnus-summary-send-map nil)
+(defvar gnus-send-bounce-map nil)
(defvar gnus-article-copy nil)
(defvar gnus-reply-subject nil)
(defvar gnus-add-to-address nil)
(define-key gnus-summary-send-map "r" 'gnus-summary-reply)
(define-key gnus-summary-send-map "R" 'gnus-summary-reply-with-original)
(define-key gnus-summary-send-map "m" 'gnus-summary-mail-other-window)
-(define-key gnus-summary-send-map "Db" 'gnus-summary-resend-bounced-mail)
-(define-key gnus-summary-send-map "Dc" 'gnus-summary-send-draft)
(define-key gnus-summary-send-map "u" 'gnus-uu-post-news)
(define-key gnus-summary-send-map "om" 'gnus-summary-mail-forward)
(define-key gnus-summary-send-map "op" 'gnus-summary-post-forward)
(define-key gnus-summary-send-map "Om" 'gnus-uu-digest-mail-forward)
(define-key gnus-summary-send-map "Op" 'gnus-uu-digest-post-forward)
+(define-prefix-command 'gnus-send-bounce-map)
+(define-key gnus-summary-send-map "D" 'gnus-send-bounce-map)
+(define-key gnus-send-bounce-map "b" 'gnus-summary-resend-bounced-mail)
+(define-key gnus-send-bounce-map "c" 'gnus-summary-send-draft)
+(define-key gnus-send-bounce-map "r" 'gnus-summary-resend-message)
+
;;; Internal functions.
(defun gnus-number-base36 (num len)
(setq gnus-newsgroup-name
(setq group
(completing-read "Group: " gnus-active-hashtb nil nil
- (cons group 0)))))
+ (cons (or group "") 0)))))
(gnus-post-news 'post group nil gnus-article-buffer)))
(defun gnus-summary-post-news ()
"Cancel an article you posted."
(interactive "P")
(gnus-set-global-variables)
- (let ((articles (gnus-summary-work-articles n)))
- (while articles
- (gnus-summary-select-article t nil nil (car articles))
- (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-article-hide-headers-if-wanted)
- (setq articles (cdr articles)))))
+ (let ((articles (gnus-summary-work-articles n))
+ 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 (gnus-cancel-news))
+ (gnus-summary-mark-as-read article gnus-canceled-mark))
+ (gnus-article-hide-headers-if-wanted))
+ (gnus-summary-remove-process-mark article))))
(defun gnus-summary-supersede-article ()
"Compose an article that will supersede a previous article.
(interactive (list t))
(let* ((group (or group gnus-newsgroup-name))
(pgroup group)
- (to-address
- (when group
- (gnus-group-get-parameter group 'to-address)))
- (to-group
- (when group
- (gnus-group-get-parameter group 'to-group)))
- (mailing-list
- (and group gnus-mailing-list-groups
- (string-match gnus-mailing-list-groups group))))
+ to-address to-group mailing-list to-list)
(when group
- (setq group (gnus-group-real-name 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)
+ mailing-list (when gnus-mailing-list-groups
+ (string-match gnus-mailing-list-groups group))
+ group (gnus-group-real-name group)))
(if (or to-group
- (and (gnus-member-of-valid 'post (or pgroup gnus-newsgroup-name))
+ (and (gnus-news-group-p
+ (or pgroup gnus-newsgroup-name)
+ (if header (mail-header-number header) gnus-current-article))
(not mailing-list)
+ (not to-list)
(not to-address)))
;; This is news.
(if post
;; The is mail.
(if post
(progn
- (gnus-new-mail to-address)
+ (gnus-new-mail (or to-address to-list))
;; Arrange for mail groups that have no `to-address' to
;; get that when the user sends off the mail.
- (or to-address
- (progn
- (make-local-variable 'gnus-add-to-address)
- (setq gnus-add-to-address group))))
+ (unless to-address
+ (make-local-variable 'gnus-add-to-address)
+ (setq gnus-add-to-address group)))
(gnus-mail-reply yank to-address 'followup)))))
+(defun gnus-news-group-p (group &optional article)
+ "Return non-nil if GROUP (and ARTICLE) come from a news server."
+ (or (gnus-member-of-valid 'post group) ; Ordinary news group.
+ (and (gnus-member-of-valid 'post-mail group) ; Combined group.
+ (eq (gnus-request-type group article) 'news))))
+
(defun gnus-inews-news (&optional use-group-method)
"Send a news message.
If given a prefix, and the group is a foreign group, this function
(newsgroups nil)
(message-id nil)
(distribution nil))
- (or (gnus-member-of-valid 'post gnus-newsgroup-name)
+ (or (gnus-news-group-p gnus-newsgroup-name)
(error "This backend does not support canceling"))
(save-excursion
;; Get header info. from original article.
(buffer-disable-undo (current-buffer))
(erase-buffer)
(insert "Newsgroups: " newsgroups "\n"
- "From: " (gnus-inews-real-user-address) "\n"
+ "From: " (gnus-inews-user-name) "\n"
"Subject: cancel " message-id "\n"
"Control: cancel " message-id "\n"
(if distribution
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$"))
(replace-match "" t t)
+ ;; Remove X- prefixes to headers.
+ (gnus-inews-dex-headers)
;; Run final inews hooks. This hook may do FCC.
;; The article must be saved before being posted because
;; `gnus-request-post' modifies the buffer.
(run-hooks 'gnus-inews-article-hook)
- ;; Remove X- prefixes to headers.
- (gnus-inews-dex-headers)
;; Copy the article over to some group, possibly.
(and gcc (gnus-inews-do-gcc gcc))
;; Post the article.
(delete-region (progn (beginning-of-line) (point))
(progn (forward-line 1) (point))))
(setq headers (cdr headers)))))
-
+
+;;; Since the X-Newsreader/X-Mailer are ``vanity'' headers, they might
+;;; as well include the Emacs version as well.
+;;; The following function works with later GNU Emacs, and XEmacs.
+(defun gnus-extended-version ()
+ "Stringified Gnus version and Emacs version"
+ (interactive)
+ (concat
+ gnus-version
+ "/"
+ (cond
+ ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version)
+ (concat "Emacs " (substring emacs-version
+ (match-beginning 1)
+ (match-end 1))))
+ ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)" emacs-version)
+ (concat (substring emacs-version
+ (match-beginning 1)
+ (match-end 1))
+ (format " %d.%d" emacs-major-version emacs-minor-version)))
+ (t emacs-version))))
+
(defun gnus-inews-insert-headers (&optional headers)
"Prepare article headers.
Headers already prepared in the buffer are not modified.
Headers in `gnus-required-headers' will be generated."
- (let ((Date (gnus-inews-date))
- (Message-ID (gnus-inews-message-id))
- (Organization (gnus-inews-organization))
- (From (gnus-inews-user-name))
- (Path (gnus-inews-path))
- (Subject nil)
- (Newsgroups nil)
- (In-Reply-To (gnus-inews-in-reply-to))
- (To nil)
- (Distribution nil)
- (Lines (gnus-inews-lines))
- (X-Newsreader gnus-version)
- (X-Mailer gnus-version)
- (headers (or headers gnus-required-headers))
- (case-fold-search t)
- header value elem)
+ (let* ((Date (gnus-inews-date))
+ (Message-ID (gnus-inews-message-id))
+ (Organization (gnus-inews-organization))
+ (From (gnus-inews-user-name))
+ (Path (gnus-inews-path))
+ (Subject nil)
+ (Newsgroups nil)
+ (In-Reply-To (gnus-inews-in-reply-to))
+ (To nil)
+ (Distribution (gnus-inews-distribution))
+ (Lines (gnus-inews-lines))
+ (X-Newsreader (gnus-extended-version))
+ (X-Mailer X-Newsreader)
+ (Expires (gnus-inews-expires))
+ (headers (or headers gnus-required-headers))
+ (case-fold-search t)
+ header value elem)
;; First we remove any old generated headers.
(let ((headers gnus-deletable-headers))
(while headers
(forward-line -1))
;; The value of this header was empty, so we clear
;; totally and insert the new value.
- (delete-region (point) (gnus-point-at-bol))
+ (delete-region (point) (gnus-point-at-eol))
(insert value))
;; Add the deletable property to the headers that require it.
(and (memq header gnus-deletable-headers)
'(gnus-deletable t face italic) (current-buffer)))))))
;; Insert new Sender if the From is strange.
(let ((from (mail-fetch-field "from"))
- (sender (mail-fetch-field "sender")))
- (if (and from
- (not (gnus-check-before-posting 'sender))
- (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)
- (progn
- (beginning-of-line)
- (insert "Original-")
- (beginning-of-line)))
- (insert "Sender: " (gnus-inews-real-user-address) "\n"))))))
-
+ (sender (mail-fetch-field "sender"))
+ (secure-sender (gnus-inews-real-user-address)))
+ (when (and from
+ (not (gnus-check-before-posting 'sender))
+ (not (string=
+ (downcase (car (cdr (gnus-extract-address-components
+ from))))
+ (downcase (gnus-inews-real-user-address))))
+ (or (null sender)
+ (not
+ (string=
+ (downcase (car (cdr (gnus-extract-address-components
+ sender))))
+ (downcase secure-sender)))))
+ (goto-char (point-min))
+ ;; Rename any old Sender headers to Original-Sender.
+ (when (re-search-forward "^Sender:" nil t)
+ (beginning-of-line)
+ (insert "Original-")
+ (beginning-of-line))
+ (insert "Sender: " secure-sender "\n")))))
(defun gnus-inews-insert-signature ()
"Insert a signature file.
(funcall gnus-author-copy-saver file)
(if (and (file-readable-p file) (mail-file-babyl-p file))
(gnus-output-to-rmail file)
- (rmail-output file 1 t t)))))))))
+ (let ((mail-use-rfc822 t))
+ (rmail-output file 1 t t))))))))))
(defun gnus-inews-path ()
"Return uucp path."
(t domain)))
(if (string-match "\\." (system-name))
(system-name)
- (substring user-mail-address
- (1+ (string-match "@" user-mail-address))))))
+ (if (string-match "@\\([^ ]+\\)\\($\\| \\)" user-mail-address)
+ (substring user-mail-address
+ (match-beginning 1) (match-end 1))
+ "bogus-domain"))))
(defun gnus-inews-full-address ()
(let ((domain (gnus-inews-domain-name))
(if (string-match (concat "^" (regexp-quote system)) domain) domain
(concat system "." domain)))))
+(defun gnus-inews-expires ()
+ "Return an Expires header based on `gnus-article-expires'."
+ (let ((current (current-time))
+ (future (* 1.0 gnus-article-expires 60 60 24)))
+ ;; Add the future to current.
+ (setcar current (+ (car current) (round (/ future (expt 2 16)))))
+ (setcar (cdr current) (+ (nth 1 current) (% (round future) (expt 2 16))))
+ ;; Return the date in the future in UT.
+ (timezone-make-date-arpa-standard
+ (current-time-string current) (current-time-zone) '(0 "UT"))))
+
+(defun gnus-inews-distribution ()
+ "Return the current Distribution header, if any."
+ (when (and gnus-distribution-function
+ (fboundp gnus-distribution-function))
+ (funcall gnus-distribution-function (or gnus-newsgroup-name ""))))
+
(defun gnus-inews-message-id ()
"Generate unique Message-ID for user."
;; Message-ID should not contain a slash and should be terminated by
(let* ((organization
(or (getenv "ORGANIZATION")
(if gnus-local-organization
- (if (and (symbolp gnus-local-organization)
- (fboundp gnus-local-organization))
+ (if (gnus-functionp gnus-local-organization)
(funcall gnus-local-organization gnus-newsgroup-name)
gnus-local-organization))
gnus-organization-file
(gnus-forward-using-post gnus-article-copy)
(gnus-mail-forward gnus-article-copy)))
+(defun gnus-summary-resend-message (address)
+ "Resend the current article to ADDRESS."
+ (interactive "sResend message to: ")
+ (gnus-summary-select-article)
+ (save-excursion
+ (let (resent beg)
+ ;; We first set up a normal mail buffer.
+ (nnheader-set-temp-buffer " *Gnus resend*")
+ ;; This code from sendmail.el
+ (insert "To: ")
+ (let ((fill-prefix "\t")
+ (address-start (point)))
+ (insert address "\n")
+ (fill-region-as-paragraph address-start (point-max)))
+ (insert mail-header-separator "\n")
+ ;; Insert our usual headers.
+ (gnus-inews-narrow-to-headers)
+ (gnus-inews-insert-headers '(From Date To))
+ (goto-char (point-min))
+ ;; Rename them all to "Resent-*".
+ (while (re-search-forward "^[A-Za-z]" nil t)
+ (forward-char -1)
+ (insert "Resent-"))
+ (widen)
+ (forward-line)
+ (delete-region (point) (point-max))
+ (setq beg (point))
+ ;; Insert the message to be resent.
+ (insert-buffer-substring gnus-original-article-buffer)
+ (goto-char (point-min))
+ (search-forward "\n\n")
+ (forward-char -1)
+ (insert mail-header-separator)
+ ;; Rename all old ("Also-")Resent headers.
+ (while (re-search-backward "^\\(Also-\\)?Resent-" beg t)
+ (beginning-of-line)
+ (insert "Also-"))
+ ;; Send it.
+ (mail-send)
+ (kill-buffer (current-buffer)))))
+
(defun gnus-summary-post-forward ()
"Forward the current article to a newsgroup."
(interactive)
mailer."
(interactive)
(gnus-set-global-variables)
- (gnus-new-mail))
+ (gnus-new-mail
+ ;; We might want to prompt here.
+ (when (and gnus-interactive-post
+ (not gnus-expert-user))
+ (read-string "To: ")))
+ (gnus-configure-windows 'summary-mail 'force))
(defun gnus-new-mail (&optional to)
(let (subject)
(pop-to-buffer gnus-mail-buffer)
(erase-buffer)
(gnus-mail-setup 'new to subject)
+ (gnus-inews-insert-gcc)
(run-hooks 'gnus-mail-hook)))
(defun gnus-mail-reply (&optional yank to-address followup)
(cur (cons (current-buffer) (cdr gnus-article-current)))
(winconf (current-window-configuration))
from subject date reply-to message-of to cc
- references message-id sender follow-to sendto elt new-cc)
+ references message-id sender follow-to sendto elt new-cc new-to
+ mct mctdo)
(set-buffer (get-buffer-create gnus-mail-buffer))
(mail-mode)
(if (and (buffer-modified-p)
(gnus-narrow-to-headers)
(if (not followup)
;; This is a regular reply.
- (if (and (symbolp gnus-reply-to-function)
- (fboundp gnus-reply-to-function))
+ (if (gnus-functionp gnus-reply-to-function)
(setq follow-to (funcall gnus-reply-to-function group)))
;; This is a followup.
- (if (and (symbolp gnus-followup-to-function)
- (fboundp gnus-followup-to-function))
+ (if (gnus-functionp gnus-followup-to-function)
(save-excursion
(setq follow-to
(funcall gnus-followup-to-function group)))))
(setq subject (concat "Re: " subject))
(setq to (mail-fetch-field "to"))
(setq cc (mail-fetch-field "cc"))
+ (setq mct (mail-fetch-field "mail-copies-to"))
(setq reply-to (mail-fetch-field "reply-to"))
(setq references (mail-fetch-field "references"))
(setq message-id (mail-fetch-field "message-id"))
+
+ (setq mctdo (not (equal mct "never")))
- (if (not followup)
- ()
- ;; When we followup, we want all the headers, I would think.
- (setq new-cc (rmail-dont-reply-to
- (concat (or to "")
- (if cc (concat (if to ", " "") cc) ""))))
- (let ((rmail-dont-reply-to-names
- (regexp-quote (mail-strip-quoted-names
- (or to-address reply-to from "")))))
- (setq new-cc (rmail-dont-reply-to new-cc))))
-
+ (if (not (and followup (not to-address)))
+ (setq new-to (or reply-to from))
+ (let (ccalist)
+ (save-excursion
+ (gnus-set-work-buffer)
+ (unless (equal mct "never")
+ (insert (or reply-to from "")))
+ (insert (if (bolp) "" ", ")
+ (or to "")
+ (if (or (not mct) (not mctdo)) ""
+ (concat (if (bolp) "" ", ") mct))
+ (if cc (concat (if (bolp) "" ", ") cc) ""))
+ (goto-char (point-min))
+ (setq ccalist
+ (mapcar
+ (lambda (addr)
+ (cons (mail-strip-quoted-names addr) addr))
+ (nreverse (mail-parse-comma-list))))
+ (let ((s ccalist))
+ (while s
+ (setq ccalist (delq (assoc (car (pop s)) s) ccalist)))))
+ (setq new-to (cdr (pop ccalist)))
+ (setq new-cc
+ (mapconcat
+ (lambda (addr) (cdr addr))
+ ccalist ", "))))
(widen)))
(setq news-reply-yank-from (or from "(nobody)"))
(if followup 'followup 'reply)
(or to-address
(if (and follow-to (not (stringp follow-to))) sendto
- (or follow-to reply-to from sender "")))
+ (or follow-to new-to sender "")))
subject message-of
(if (zerop (length new-cc)) nil new-cc)
gnus-article-copy)
(setq gnus-in-reply-to message-of)
(auto-save-mode auto-save-default)
+ (gnus-inews-insert-gcc)
(if (and follow-to (listp follow-to))
(progn
end)
(if (not (listp yank))
(progn
+ ;; Just a single article being yanked.
(save-excursion
(mail-yank-original nil))
(or mail-yank-hooks mail-citation-hook
(gnus-summary-select-article nil nil nil (car yank))
(gnus-summary-remove-process-mark (car yank)))
(save-excursion
+ (setq end (point))
(gnus-copy-article-buffer)
(mail-yank-original nil)
- (setq end (point)))
- (or mail-yank-hooks mail-citation-hook
- (run-hooks 'news-reply-header-hook))
+ (save-restriction
+ (narrow-to-region (point-min) (point))
+ (goto-char (mark t))
+ (let ((news-reply-yank-from
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (or (mail-fetch-field "from") "(nobody)")))
+ (news-reply-yank-message-id
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (or (mail-fetch-field "message-id")
+ "(unknown Message-ID)"))))
+ (or mail-yank-hooks mail-citation-hook
+ (run-hooks 'news-reply-header-hook))
+ (setq end (point-max)))))
(goto-char end)
(setq yank (cdr yank))))
(goto-char last))
(forward-line 2)
(gnus-configure-windows 'reply-yank 'force))
- (run-hooks 'gnus-mail-hook)))))
+ (run-hooks 'gnus-mail-hook)
+ ;; Mark this buffer as unchanged.
+ (set-buffer-modified-p nil)))))
(defun gnus-new-news (&optional group inhibit-prompt)
"Set up a *post-news* buffer that points to GROUP.
;; Let posting styles be configured.
(gnus-configure-posting-styles)
(news-setup nil subject nil (and group (gnus-group-real-name group)) nil)
+ ;; Associate this buffer with the draft group.
+ (gnus-associate-buffer-with-draft)
(goto-char (point-min))
(unless (re-search-forward
(insert "\n\n")
(gnus-inews-insert-bfcc)
+ (gnus-inews-insert-gcc)
(gnus-inews-insert-signature)
(and gnus-post-prepare-function
- (symbolp gnus-post-prepare-function)
- (fboundp gnus-post-prepare-function)
+ (gnus-functionp gnus-post-prepare-function)
(funcall gnus-post-prepare-function group))
(goto-char (point-min))
(if group
followup-to distribution newsgroups)
(set-buffer (get-buffer-create gnus-post-news-buffer))
(news-reply-mode)
+ ;; Associate this buffer with the draft group.
+ (gnus-associate-buffer-with-draft)
(if (and (buffer-modified-p)
(> (buffer-size) 0)
(not (gnus-y-or-n-p
(save-restriction
(set-buffer gnus-article-copy)
(gnus-narrow-to-headers)
- (if (and (symbolp gnus-followup-to-function)
- (fboundp gnus-followup-to-function))
+ (if (gnus-functionp gnus-followup-to-function)
(save-excursion
(setq follow-to
(funcall gnus-followup-to-function group))))
(gnus-inews-insert-signature)
(and gnus-post-prepare-function
- (symbolp gnus-post-prepare-function)
- (fboundp gnus-post-prepare-function)
+ (gnus-functionp gnus-post-prepare-function)
(funcall gnus-post-prepare-function group))
(run-hooks 'gnus-post-prepare-hook)
(insert to))))
(gnus-inews-insert-bfcc)
-
+ (gnus-inews-insert-gcc)
+
;; Now the headers should be ok, so we do the yanking.
(goto-char (point-min))
(re-search-forward
(to-address (and address-group
(mail-fetch-field "to"))))
(setq gnus-add-to-address nil)
- (or dont-send (gnus-mail-send))
+ (let ((buffer-file-name nil))
+ (or dont-send (gnus-mail-send)))
(bury-buffer)
;; This mail group doesn't have a `to-address', so we add one
;; here. Magic!
(cdr reply)))))
(and winconf (set-window-configuration winconf))))))
-
(defun gnus-forward-make-subject (buffer)
(save-excursion
(set-buffer buffer)
"] " (or (gnus-fetch-field "Subject") ""))))
(defun gnus-forward-insert-buffer (buffer)
- (let ((beg (goto-char (point-max))))
- (insert "------- Start of forwarded message -------\n")
- (insert-buffer-substring buffer)
- (goto-char (point-max))
- (insert "------- End of forwarded message -------\n")
- ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
- (goto-char beg)
- (while (setq beg (next-single-property-change (point) 'invisible))
- (goto-char beg)
- (delete-region beg (or (next-single-property-change
- (point) 'invisible)
- (point-max))))))
+ (save-excursion
+ (save-restriction
+ (if gnus-signature-before-forwarded-message
+ (goto-char (point-max))
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ (forward-line 1))
+ ;; Narrow to the area we are to insert.
+ (narrow-to-region (point) (point))
+ ;; Insert the separators and the forwarded buffer.
+ (insert gnus-forward-start-separator)
+ (insert-buffer-substring buffer)
+ (goto-char (point-max))
+ (insert gnus-forward-end-separator)
+ ;; Delete any invisible text.
+ (goto-char (point-min))
+ (let (beg)
+ (while (setq beg (next-single-property-change (point) 'invisible))
+ (goto-char beg)
+ (delete-region beg (or (next-single-property-change
+ (point) 'invisible)
+ (point-max))))))))
(defun gnus-mail-forward (&optional buffer)
"Forward the current message to another user using mail."
"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"))
+ (let ((files '("gnus.el" "gnus-msg.el" "gnus-score.el" "nnmail.el"))
file dirs expr olist sym)
(message "Please wait while we snoop your variables...")
(sit-for 0)
(setq files (cdr files)))
(kill-buffer (current-buffer)))
(insert "------------------- Environment follows -------------------\n\n")
+ (setq olist (nreverse olist))
(while olist
(if (boundp (car olist))
(insert "(setq " (symbol-name (car olist))
(use-local-map (copy-keymap (current-local-map)))
(local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
(local-set-key "\C-c\C-p" 'gnus-put-message)
- (local-set-key "\C-c\C-d" 'gnus-enter-into-draft-group))
+ (local-set-key "\C-c\C-d" 'gnus-put-draft-group))
(defun gnus-mail-setup (type &optional to subject in-reply-to cc
replybuffer actions)
'gnus-mail-other-window-using-vm)))
'gnus-vm-mail-setup)
(t 'gnus-sendmail-mail-setup))
- to subject in-reply-to cc replybuffer actions))
+ to subject in-reply-to cc replybuffer actions)
+ ;; Associate this mail buffer with the draft group.
+ (gnus-associate-buffer-with-draft))
(defun gnus-sendmail-mail-setup (to subject in-reply-to cc replybuffer actions)
(mail-mode)
(concat "^" (regexp-quote mail-header-separator) "$") nil t)
(forward-line 1)
(goto-char (point-max)))
-; (insert "\n\n")
(gnus-inews-modify-mail-mode-map))
;;; Gcc handling.
(insert gnus-author-copy))))
(defun gnus-inews-insert-gcc ()
- (let* ((group gnus-outgoing-message-group)
- (gcc (cond
- ((and (symbolp group) (fboundp group))
- (funcall group))
- ((or (stringp group) (list group))
- group))))
- (when gcc
- (insert "Gcc: "
- (if (stringp group) group
- (mapconcat 'identity group " "))
- "\n"))))
+ (save-excursion
+ (save-restriction
+ (gnus-inews-narrow-to-headers)
+ (let* ((group gnus-outgoing-message-group)
+ (gcc (cond
+ ((gnus-functionp group)
+ (funcall group))
+ ((or (stringp group) (list group))
+ group))))
+ (when gcc
+ (insert "Gcc: "
+ (if (stringp group) group
+ (mapconcat 'identity group " "))
+ "\n"))))))
;;; Handling rejected (and postponed) news.
"Return the name of the draft group."
(gnus-group-prefixed-name
(file-name-nondirectory gnus-draft-group-directory)
- (list 'nndir gnus-draft-group-directory)))
+ (list 'nndraft gnus-draft-group-directory)))
(defun gnus-make-draft-group ()
"Make the draft group or die trying."
- (let* ((method (` (nndir "private"
- (nndir-directory (, gnus-draft-group-directory)))))
- (group (gnus-group-prefixed-name
- (file-name-nondirectory gnus-draft-group-directory)
- method)))
+ (let* ((method (` (nndraft "private"
+ (nndraft-directory
+ (, gnus-draft-group-directory)))))
+ (group (gnus-draft-group)))
(or (gnus-gethash group gnus-newsrc-hashtb)
(gnus-group-make-group (gnus-group-real-name group) method)
(error "Can't create the draft group"))
+ (gnus-check-server method)
group))
-(defun gnus-enter-into-draft-group ()
+(defun gnus-put-in-draft-group (&optional generate silent)
"Enter the current buffer into the draft group."
(interactive)
- (gnus-put-in-draft-group t))
-
-(defun gnus-put-in-draft-group (&optional generate silent)
- "Does the actual putting."
- (let ((group (gnus-make-draft-group))
- (type (list major-mode (buffer-name) gnus-newsgroup-name
- (point)))
- (mode major-mode)
- (buf (current-buffer)))
- (widen)
- (save-excursion
- (nnheader-set-temp-buffer " *enter-draft*")
- (insert-buffer-substring buf)
- (save-restriction
- (widen)
- (gnus-inews-narrow-to-headers)
- (let (gnus-deletable-headers)
- (if (eq mode 'mail-mode)
- (gnus-inews-insert-headers gnus-required-mail-headers)
- (gnus-inews-insert-headers)))
- (widen))
-
- (goto-char (point-min))
- ;; We have to store whether we are in a mail group or news group.
- (insert (format "X-Gnus-Draft-Type: %S\n" type))
- (and (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$") nil t)
- (replace-match "" t t))
- (if (prog1
- (gnus-request-accept-article group t)
- (kill-buffer (current-buffer)))
- (or silent
- (gnus-mail-send-and-exit 'dont-send))))
+ (when (gnus-request-accept-article (gnus-make-draft-group) t)
+ (unless silent
+ ;; This function does the proper marking of articles.
+ (gnus-mail-send-and-exit 'dont-send))
(set-buffer-modified-p nil)))
+(defun gnus-associate-buffer-with-draft ()
+ (save-excursion
+ ;; Make sure the draft group exists.
+ (gnus-make-draft-group)
+ ;; Associate the buffer with the draft group.
+ (let ((article (gnus-request-associate-buffer (gnus-draft-group))))
+ ;; Arrange for deletion of the draft after successful sending.
+ (make-local-variable 'gnus-message-sent-hook)
+ (setq gnus-message-sent-hook
+ (list
+ `(lambda ()
+ (let ((gnus-verbose-backends nil))
+ (gnus-request-expire-articles
+ (quote ,(list article))
+ ,(gnus-draft-group) t))))))))
+
(defun gnus-summary-send-draft ()
"Enter a mail/post buffer to edit and send the draft."
(interactive)
(gnus-set-global-variables)
- (gnus-summary-select-article t)
- ;; First we find the draft type.
- (let (type)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (widen)
- (gnus-narrow-to-headers)
- (setq type (condition-case ()
- (read (mail-fetch-field "x-gnus-draft-type"))
- (error nil)))
- (widen))
- (or type
- (error "Unknown draft type"))
- ;; Get to the proper buffer.
- (set-buffer (get-buffer-create (nth 1 type)))
- ;; It might be modified.
- (and (buffer-modified-p)
- (or (gnus-yes-or-no-p "Unsent message being composed; discard it? ")
- (error "Break")))
- (setq buffer-read-only nil)
- (buffer-enable-undo (current-buffer))
- (erase-buffer)
- ;; Set proper mode.
- (funcall (car type))
- (and (eq major-mode 'mail-mode)
- (gnus-inews-modify-mail-mode-map))
- ;; Arrange for deletion of the draft after successful sending.
- (make-local-variable 'gnus-message-sent-hook)
- (setq gnus-message-sent-hook
- (list
- (`
- (lambda ()
- (gnus-request-expire-articles
- (quote (, (list (cdr gnus-article-current))))
- (, gnus-newsgroup-name) t)))))
- ;; Insert the draft.
- (insert-buffer-substring gnus-article-buffer)
- ;; Insert the separator.
- (goto-char (point-min))
- (search-forward "\n\n")
- (forward-char -1)
- (insert mail-header-separator)
- ;; Remove the draft header.
- (gnus-inews-narrow-to-headers)
- (nnheader-remove-header "x-gnus-draft-type")
- (widen)
- ;; Configure windows.
- (let ((gnus-draft-buffer (current-buffer)))
- (gnus-configure-windows 'draft))
- ;; Put point where you left it.
- (goto-char (nth 3 type))))
+ (unless (equal gnus-newsgroup-name (gnus-draft-group))
+ (error "This function can only be used in the draft buffer"))
+ (let (buf point)
+ (if (not (setq buf (gnus-request-restore-buffer
+ (gnus-summary-article-number) gnus-newsgroup-name)))
+ (error "Couldn't restore the article")
+ (setq point (point))
+ (switch-to-buffer buf)
+ (gnus-inews-modify-mail-mode-map)
+ (when (eq major-mode 'news-reply-mode)
+ (local-set-key "\C-c\C-c" 'gnus-inews-news))
+ (gnus-associate-buffer-with-draft)
+ ;; Insert the separator.
+ (goto-char (point-min))
+ (search-forward "\n\n")
+ (forward-char -1)
+ (insert mail-header-separator)
+ ;; Configure windows.
+ (let ((gnus-draft-buffer (current-buffer)))
+ (gnus-configure-windows 'draft)
+ (goto-char (point))))))
(defun gnus-configure-posting-styles ()
"Configure posting styles according to `gnus-posting-styles'."
(when (cond ((stringp match)
;; Regexp string match on the group name.
(string-match match gnus-newsgroup-name))
- ((symbolp match)
- (cond ((fboundp match)
+ ((or (symbolp match)
+ (gnus-functionp match))
+ (cond ((gnus-functionp match)
;; Function to be called.
(funcall match))
((boundp match)
(setq value-value
(cond ((stringp value)
value)
- ((symbolp value)
- (cond ((fboundp value)
+ ((or (symbolp value)
+ (gnus-functionp value))
+ (cond ((gnus-functionp value)
(funcall value))
((boundp value)
(symbol-value value))))
projects / gnus / blobdiff