cgit.sxemacs.org Git - gnus/blob - lisp/gnus-msg.el

   1 ;;; gnus-msg.el --- mail and post interface for Gnus
   2 ;; Copyright (C) 1995 Free Software Foundation, Inc.
   3
   4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
   5 ;;      Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
   6 ;; Keywords: news
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 (require 'gnus)
  29 (require 'sendmail)
  30 (require 'gnus-ems)
  31 (require 'rmail)
  32
  33 (defvar gnus-organization-file "/usr/lib/news/organization"
  34   "*Local news organization file.")
  35
  36 (defvar gnus-prepare-article-hook (list 'gnus-inews-insert-signature)
  37   "*A hook called after preparing body, but before preparing header headers.
  38 The default hook (`gnus-inews-insert-signature') inserts a signature
  39 file specified by the variable `gnus-signature-file'.")
  40
  41 (defvar gnus-post-prepare-function nil
  42   "*Function that is run after a post buffer has been prepared.
  43 It is called with the name of the newsgroup that is posted to. It
  44 might be used, for instance, for inserting signatures based on the
  45 newsgroup name. (In that case, `gnus-signature-file' and
  46 `mail-signature' should both be set to nil).")
  47
  48 (defvar gnus-post-prepare-hook nil
  49   "*Hook that is run after a post buffer has been prepared.
  50 If you want to insert the signature, you might put
  51 `gnus-inews-insert-signature' in this hook.")
  52
  53 (defvar gnus-use-followup-to t
  54   "*Specifies what to do with Followup-To header.
  55 If nil, ignore the header. If it is t, use its value, but ignore
  56 `poster'.  If it is the symbol `ask', query the user before posting.
  57 If it is the symbol `use', always use the value.")
  58
  59 (defvar gnus-followup-to-function nil
  60   "*A variable that contains a function that returns a followup address.
  61 The function will be called in the buffer of the article that is being
  62 followed up. The buffer will be narrowed to the headers of the
  63 article. To pick header headers, one might use `mail-fetch-field'.  The
  64 function will be called with the name of the current newsgroup as the
  65 argument.
  66
  67 Here's an example `gnus-followup-to-function':
  68
  69 (setq gnus-followup-to-function
  70       (lambda (group)
  71         (cond ((string= group \"mail.list\")
  72                (or (mail-fetch-field \"sender\")
  73                    (mail-fetch-field \"from\")))
  74               (t
  75                (or (mail-fetch-field \"reply-to\")
  76                    (mail-fetch-field \"from\"))))))")
  77
  78 (defvar gnus-reply-to-function nil
  79   "*A variable that contains a function that returns a reply address.
  80 See the `gnus-followup-to-function' variable for an explanation of how
  81 this variable is used.
  82
  83 This function should return a string that will be used to fill in the
  84 header.  This function may also return a list.  In that case, every
  85 list element should be a cons where the first car should be a string
  86 with the header name, and the cdr should be a string with the header
  87 value.")
  88
  89 (defvar gnus-author-copy (getenv "AUTHORCOPY")
  90   "*Save outgoing articles in this file.
  91 Initialized from the AUTHORCOPY environment variable.
  92
  93 If this variable begins with the character \"|\", outgoing articles
  94 will be piped to the named program. It is possible to save an article
  95 in an MH folder as follows:
  96
  97 \(setq gnus-author-copy \"|/usr/local/lib/mh/rcvstore +Article\")
  98
  99 If the first character is not a pipe, articles are saved using the
 100 function specified by the `gnus-author-copy-saver' variable.")
 101
 102 (defvar gnus-mail-self-blind nil
 103   "*Non-nil means insert a BCC header in all outgoing articles.
 104 This will result in having a copy of the article mailed to yourself.
 105 The BCC header is inserted when the post buffer is initialized, so you
 106 can remove or alter the BCC header to override the default.")
 107
 108 (defvar gnus-author-copy-saver (function rmail-output)
 109   "*A function called to save outgoing articles.
 110 This function will be called with the same of the file to store the
 111 article in. The default function is `rmail-output' which saves in Unix
 112 mailbox format.")
 113
 114 (defvar gnus-outgoing-message-group nil
 115   "*All outgoing messages will be put in this group.
 116 If you want to store all your outgoing mail and articles in the group
 117 \"nnml:archive\", you set this variable to that value. This variable
 118 can also be a list of group names.
 119
 120 If you want to have greater control over what group to put each
 121 message in, you can set this variable to a function that checks the
 122 current newsgroup name and then returns a suitable group name (or list
 123 of names).")
 124
 125 (defvar gnus-draft-group-directory
 126   (expand-file-name
 127    (concat (file-name-as-directory gnus-article-save-directory)
 128            "drafts"))
 129   "*The directory where draft messages will be stored.")
 130
 131 (defvar gnus-user-login-name nil
 132   "*The login name of the user.
 133 Got from the function `user-login-name' if undefined.")
 134
 135 (defvar gnus-user-full-name nil
 136   "*The full name of the user.
 137 Got from the NAME environment variable if undefined.")
 138
 139 (defvar gnus-user-from-line nil
 140   "*Your full, complete e-mail address.
 141 Overrides the other Gnus variables if it is non-nil.
 142
 143 Here are two example values of this variable:
 144
 145  \"Lars Magne Ingebrigtsen <larsi@ifi.uio.no>\"
 146
 147 and
 148
 149  \"larsi@ifi.uio.no (Lars Magne Ingebrigtsen)\"
 150
 151 The first version is recommended, but the name has to be quoted if it
 152 contains non-alphanumerical characters.")
 153
 154 (defvar gnus-signature-file "~/.signature"
 155   "*Your signature file.
 156 If the variable is a string that doesn't correspond to a file, the
 157 string itself is inserted.")
 158
 159 (defvar gnus-signature-function nil
 160   "*A function that should return a signature file name.
 161 The function will be called with the name of the newsgroup being
 162 posted to.
 163 If the function returns a string that doesn't correspond to a file, the
 164 string itself is inserted.
 165 If the function returns nil, the `gnus-signature-file' variable will
 166 be used instead.")
 167
 168 (defvar gnus-required-headers
 169   '(From Date Newsgroups Subject Message-ID Organization Lines X-Newsreader)
 170   "*Headers to be generated or prompted for when posting an article.
 171 RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
 172 Message-ID.  Organization, Lines and X-Newsreader are optional.  If
 173 you want Gnus not to insert some header, remove it from this list.")
 174
 175 (defvar gnus-required-mail-headers
 176   '(From Date To Subject Message-ID Organization Lines)
 177   "*Headers to be generated or prompted for when mailing a message.
 178 RFC822 required that From, Date, To, Subject and Message-ID be
 179 included.  Organization, Lines and X-Mailer are optional.")
 180
 181 (defvar gnus-deletable-headers '(Message-ID Date)
 182   "*Headers to be deleted if they already exists and were generated by Gnus previously.")
 183
 184 (defvar gnus-removable-headers '(NNTP-Posting-Host Bcc Xref)
 185   "*Headers to be removed unconditionally before posting.")
 186
 187 (defvar gnus-check-before-posting
 188   '(subject-cmsg multiple-headers sendsys message-id from
 189                  long-lines control-chars size new-text
 190                  signature approved)
 191   "In non-nil, Gnus will attempt to run some checks on outgoing posts.
 192 If this variable is t, Gnus will check everything it can.  If it is a
 193 list, then those elements in that list will be checked.")
 194
 195 (defvar gnus-delete-supersedes-headers
 196   "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Supersedes:"
 197   "*Header lines matching this regexp will be deleted before posting.
 198 It's best to delete old Path and Date headers before psoting to avoid
 199 any confusion.")
 200
 201 (defvar gnus-auto-mail-to-author nil
 202   "*If non-nil, mail the authors of articles a copy of your follow-ups.
 203 If this variable is `ask', the user will be prompted for whether to
 204 mail a copy.  The string given by `gnus-mail-courtesy-message' will be
 205 inserted at the beginning of the mail copy.
 206
 207 Mail is sent using the function specified by the
 208 `gnus-mail-send-method' variable.")
 209
 210 ;; Added by Ethan Bradford <ethanb@ptolemy.astro.washington.edu>.
 211 (defvar gnus-mail-courtesy-message
 212   "The following message is a courtesy copy of an article\nthat has been posted as well.\n\n"
 213   "*This is inserted at the start of a mailed copy of a posted message.
 214 If this variable is nil, no such courtesy message will be added.")
 215
 216 (defvar gnus-mail-reply-method (function gnus-mail-reply-using-mail)
 217   "*Function to compose a reply.
 218 Three pre-made functions are `gnus-mail-reply-using-mail' (sendmail);
 219 `gnus-mail-reply-using-mhe' (MH-E); and `gnus-mail-reply-using-vm'.")
 220
 221 (defvar gnus-mail-forward-method (function gnus-mail-forward-using-mail)
 222   "*Function to forward the current message to another user.
 223 Three pre-made functions are `gnus-mail-forward-using-mail' (sendmail);
 224 `gnus-mail-forward-using-mhe' (MH-E); and `gnus-mail-forward-using-vm'.")
 225
 226 (defvar gnus-mail-other-window-method 'gnus-mail-other-window-using-mail
 227   "*Function to compose mail in the other window.
 228 Three pre-made functions are `gnus-mail-other-window-using-mail'
 229 (sendmail); `gnus-mail-other-window-using-mhe' (MH-E); and
 230 `gnus-mail-other-window-using-vm'.")
 231
 232 (defvar gnus-mail-send-method send-mail-function
 233   "*Function to mail a message which is also being posted as an article.
 234 The message must have To or Cc header.  The default is copied from
 235 the variable `send-mail-function'.")
 236
 237 (defvar gnus-inews-article-function 'gnus-inews-article
 238   "*Function to post an article.")
 239
 240 (defvar gnus-bounced-headers-junk "^\\(Received\\):"
 241   "*Regexp that matches headers to be removed in resent bounced mail.")
 242
 243 (defvar gnus-inews-article-hook (list 'gnus-inews-do-fcc)
 244   "*A hook called before finally posting an article.
 245 The default hook (`gnus-inews-do-fcc') does FCC processing (ie. saves
 246 the article to a file).")
 247
 248 (defvar gnus-inews-article-header-hook nil
 249   "*A hook called after inserting the headers in an article to be posted.
 250 The hook is called from the *post-news* buffer, narrowed to the
 251 headers.")
 252
 253 (defvar gnus-mail-hook nil
 254   "*A hook called as the last thing after setting up a mail buffer.")
 255
 256 (defvar gnus-message-sent-hook nil
 257   "*A hook run after an article has been sent (or attempted sent).")
 258
 259 ;;; Internal variables.
 260
 261 (defvar gnus-post-news-buffer "*post-news*")
 262 (defvar gnus-mail-buffer "*mail*")
 263 (defvar gnus-summary-send-map nil)
 264 (defvar gnus-article-copy nil)
 265 (defvar gnus-reply-subject nil)
 266
 267 (eval-and-compile
 268   (autoload 'gnus-uu-post-news "gnus-uu" nil t))
 269
 270 \f
 271 ;;;
 272 ;;; Gnus Posting Functions
 273 ;;;
 274
 275 (define-prefix-command 'gnus-summary-send-map)
 276 (define-key gnus-summary-mode-map "S" 'gnus-summary-send-map)
 277 (define-key gnus-summary-send-map "p" 'gnus-summary-post-news)
 278 (define-key gnus-summary-send-map "f" 'gnus-summary-followup)
 279 (define-key gnus-summary-send-map "F" 'gnus-summary-followup-with-original)
 280 (define-key gnus-summary-send-map "b" 'gnus-summary-followup-and-reply)
 281 (define-key gnus-summary-send-map "B" 'gnus-summary-followup-and-reply-with-original)
 282 (define-key gnus-summary-send-map "c" 'gnus-summary-cancel-article)
 283 (define-key gnus-summary-send-map "s" 'gnus-summary-supersede-article)
 284 (define-key gnus-summary-send-map "r" 'gnus-summary-reply)
 285 (define-key gnus-summary-send-map "R" 'gnus-summary-reply-with-original)
 286 (define-key gnus-summary-send-map "m" 'gnus-summary-mail-other-window)
 287 (define-key gnus-summary-send-map "Db" 'gnus-summary-resend-bounced-mail)
 288 (define-key gnus-summary-send-map "Dc" 'gnus-summary-send-draft)
 289 (define-key gnus-summary-send-map "u" 'gnus-uu-post-news)
 290 (define-key gnus-summary-send-map "om" 'gnus-summary-mail-forward)
 291 (define-key gnus-summary-send-map "op" 'gnus-summary-post-forward)
 292 (define-key gnus-summary-send-map "Om" 'gnus-uu-digest-mail-forward)
 293 (define-key gnus-summary-send-map "Op" 'gnus-uu-digest-post-forward)
 294
 295 ;;; Internal functions.
 296
 297 (defun gnus-number-base36 (num len)
 298   (if (if (< len 0) (<= num 0) (= len 0))
 299       ""
 300     (concat (gnus-number-base36 (/ num 36) (1- len))
 301             (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
 302                                   (% num 36))))))
 303
 304 ;;; Post news commands of Gnus group mode and summary mode
 305
 306 (defun gnus-group-mail ()
 307   "Start composing a mail."
 308   (interactive)
 309   (funcall gnus-mail-other-window-method))
 310
 311 (defun gnus-group-post-news ()
 312   "Post an article."
 313   (interactive)
 314   (let ((gnus-newsgroup-name nil))
 315     (gnus-post-news 'post nil nil gnus-article-buffer)))
 316
 317 (defun gnus-summary-post-news ()
 318   "Post an article."
 319   (interactive)
 320   (gnus-set-global-variables)
 321   (gnus-post-news 'post gnus-newsgroup-name))
 322
 323 (defun gnus-summary-followup (yank &optional yank-articles)
 324   "Compose a followup to an article.
 325 If prefix argument YANK is non-nil, original article is yanked automatically."
 326   (interactive "P")
 327   (gnus-set-global-variables)
 328   (if yank-articles (gnus-summary-goto-subject (car yank-articles)))
 329   (save-window-excursion
 330     (gnus-summary-select-article))
 331   (let ((headers (gnus-summary-article-header (gnus-summary-article-number)))
 332         (gnus-newsgroup-name gnus-newsgroup-name))
 333     ;; Check Followup-To: poster.
 334     (set-buffer gnus-article-buffer)
 335     (if (and gnus-use-followup-to
 336              (string-equal "poster" (gnus-fetch-field "followup-to"))
 337              (or (not (memq gnus-use-followup-to '(t ask)))
 338                  (not (gnus-y-or-n-p
 339                        "Do you want to ignore `Followup-To: poster'? "))))
 340         ;; Mail to the poster.
 341         (gnus-summary-reply yank)
 342       (gnus-post-news nil gnus-newsgroup-name
 343                       headers gnus-article-buffer
 344                       (or yank-articles (not (not yank)))))))
 345
 346 (defun gnus-summary-followup-with-original (n)
 347   "Compose a followup to an article and include the original article."
 348   (interactive "P")
 349   (gnus-summary-followup t (gnus-summary-work-articles n)))
 350
 351 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
 352 (defun gnus-summary-followup-and-reply (yank &optional yank-articles)
 353   "Compose a followup and do an auto mail to author."
 354   (interactive "P")
 355   (gnus-set-global-variables)
 356   (let ((gnus-auto-mail-to-author t))
 357     (gnus-summary-followup yank yank-articles)))
 358
 359 (defun gnus-summary-followup-and-reply-with-original (n)
 360   "Compose a followup, include the original, and do an auto mail to author."
 361   (interactive "P")
 362   (gnus-summary-followup-and-reply t (gnus-summary-work-articles n)))
 363
 364 (defun gnus-summary-cancel-article (n)
 365   "Cancel an article you posted."
 366   (interactive "P")
 367   (gnus-set-global-variables)
 368   (let ((articles (gnus-summary-work-articles n)))
 369     (while articles
 370       (gnus-summary-select-article t nil nil (car articles))
 371       (and (gnus-eval-in-buffer-window gnus-article-buffer (gnus-cancel-news))
 372            (gnus-summary-mark-as-read (car articles) gnus-canceled-mark))
 373       (gnus-summary-remove-process-mark (car articles))
 374       (gnus-article-hide-headers-if-wanted)
 375       (setq articles (cdr articles)))))
 376
 377 (defun gnus-summary-supersede-article ()
 378   "Compose an article that will supersede a previous article.
 379 This is done simply by taking the old article and adding a Supersedes
 380 header line with the old Message-ID."
 381   (interactive)
 382   (gnus-set-global-variables)
 383   (gnus-summary-select-article t)
 384   (if (not
 385        (string-equal
 386         (downcase (mail-strip-quoted-names
 387                    (mail-header-from gnus-current-headers)))
 388         (downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
 389       (error "This article is not yours."))
 390   (save-excursion
 391     (set-buffer gnus-article-buffer)
 392     (let ((buffer-read-only nil))
 393       (goto-char (point-min))
 394       (search-forward "\n\n" nil t)
 395       (if (not (re-search-backward "^Message-ID: " nil t))
 396           (error "No Message-ID in this article"))))
 397   (if (gnus-post-news 'post gnus-newsgroup-name)
 398       (progn
 399         (erase-buffer)
 400         (insert-buffer gnus-article-buffer)
 401         (if (search-forward "\n\n" nil t)
 402             (forward-char -1)
 403           (goto-char (point-max)))
 404         (narrow-to-region (point-min) (point))
 405         (goto-char (point-min))
 406         (and gnus-delete-supersedes-headers
 407              (delete-matching-lines gnus-delete-supersedes-headers))
 408         (goto-char (point-min))
 409         (if (not (re-search-forward "^Message-ID: " nil t))
 410             (error "No Message-ID in this article")
 411           (replace-match "Supersedes: " t t))
 412         (goto-char (point-max))
 413         (insert mail-header-separator)
 414         (widen)
 415         (forward-line 1))))
 416
 417 \f
 418 ;;;###autoload
 419 (defalias 'sendnews 'gnus-post-news)
 420
 421 ;;;###autoload
 422 (defalias 'postnews 'gnus-post-news)
 423
 424 (defun gnus-copy-article-buffer (&optional article-buffer)
 425   ;; make a copy of the article buffer with all text properties removed
 426   ;; this copy is in the buffer gnus-article-copy.
 427   ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
 428   ;; this buffer should be passed to all mail/news reply/post routines.
 429   (setq gnus-article-copy (get-buffer-create " *gnus article copy*"))
 430   (buffer-disable-undo gnus-article-copy)
 431   (or (memq gnus-article-copy gnus-buffer-list)
 432       (setq gnus-buffer-list (cons gnus-article-copy gnus-buffer-list)))
 433   (let ((article-buffer (or article-buffer gnus-article-buffer)))
 434     (if (and (get-buffer article-buffer)
 435              (buffer-name (get-buffer article-buffer)))
 436         (save-excursion
 437           (set-buffer article-buffer)
 438           (widen)
 439           (copy-to-buffer gnus-article-copy (point-min) (point-max))
 440           (set-text-properties (point-min) (point-max)
 441                                nil gnus-article-copy)))))
 442
 443 (defun gnus-post-news (post &optional group header article-buffer yank subject)
 444   "Begin editing a new USENET news article to be posted.
 445 Type \\[describe-mode] in the buffer to get a list of commands."
 446   (interactive (list t))
 447   (gnus-copy-article-buffer article-buffer)
 448   (if (or (not gnus-novice-user)
 449           gnus-expert-user
 450           (not (eq 'post
 451                    (nth 1 (assoc
 452                            (format "%s" (car (gnus-find-method-for-group
 453                                               gnus-newsgroup-name)))
 454                            gnus-valid-select-methods))))
 455           (and group
 456                (assq 'to-address
 457                      (nth 5 (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))))
 458           (gnus-y-or-n-p "Are you sure you want to post to all of USENET? "))
 459       (let ((sumart (if (not post)
 460                         (save-excursion
 461                           (set-buffer gnus-summary-buffer)
 462                           (cons (current-buffer) gnus-current-article))))
 463             (from (and header (mail-header-from header)))
 464             (winconf (current-window-configuration))
 465             real-group)
 466         (and gnus-interactive-post
 467              (not gnus-expert-user)
 468              post (not group)
 469              (progn
 470                (setq gnus-newsgroup-name
 471                      (setq group
 472                            (completing-read "Group: " gnus-active-hashtb)))
 473                (or subject
 474                    (setq subject (read-string "Subject: ")))))
 475         (setq mail-reply-buffer gnus-article-copy)
 476
 477         (let ((newsgroup-name (or group gnus-newsgroup-name "")))
 478           (setq real-group (and group (gnus-group-real-name group)))
 479           (setq gnus-post-news-buffer
 480                 (gnus-request-post-buffer
 481                  post real-group subject header gnus-article-copy
 482                  (nth 2 (and group (gnus-gethash group gnus-newsrc-hashtb)))
 483                  (or (cdr (assq 'to-group
 484                                 (nth 5 (nth 2 (gnus-gethash
 485                                                newsgroup-name
 486                                                gnus-newsrc-hashtb)))))
 487                      (if (and (boundp 'gnus-followup-to-function)
 488                               gnus-followup-to-function
 489                               gnus-article-copy)
 490                          (save-excursion
 491                            (set-buffer gnus-article-copy)
 492                            (funcall gnus-followup-to-function group))))
 493                  gnus-use-followup-to))
 494           (if post
 495               (gnus-configure-windows 'post 'force)
 496             (if yank
 497                 (gnus-configure-windows 'followup-yank 'force)
 498               (gnus-configure-windows 'followup 'force)))
 499           (gnus-overload-functions)
 500           (make-local-variable 'gnus-article-reply)
 501           (make-local-variable 'gnus-article-check-size)
 502           (make-local-variable 'gnus-reply-subject)
 503           (setq gnus-reply-subject (and header (mail-header-subject header)))
 504           (setq gnus-article-reply sumart)
 505           ;; Handle `gnus-auto-mail-to-author'.
 506           ;; Suggested by Daniel Quinlan <quinlan@best.com>.
 507           ;; Revised to respect Reply-To by Ulrik Dickow <dickow@nbi.dk>.
 508           (let ((to (and (not post)
 509                          (if (if (eq gnus-auto-mail-to-author 'ask)
 510                                  (y-or-n-p "Also send mail to author? ")
 511                                gnus-auto-mail-to-author)
 512                              (or (save-excursion
 513                                    (set-buffer gnus-article-copy)
 514                                    (gnus-fetch-field "reply-to"))
 515                                  from)))))
 516             (if to
 517                 (if (mail-fetch-field "To")
 518                     (progn
 519                       (beginning-of-line)
 520                       (insert "Cc: " to "\n"))
 521                   (mail-position-on-field "To")
 522                   (insert to))))
 523           ;; Handle author copy using BCC field.
 524           (if (and gnus-mail-self-blind
 525                    (not (mail-fetch-field "bcc")))
 526               (progn
 527                 (mail-position-on-field "Bcc")
 528                 (insert (if (stringp gnus-mail-self-blind)
 529                             gnus-mail-self-blind
 530                           (user-login-name)))))
 531           ;; Handle author copy using FCC field.
 532           (if gnus-author-copy
 533               (progn
 534                 (mail-position-on-field "Fcc")
 535                 (insert gnus-author-copy)))
 536           (goto-char (point-min))
 537           (if post
 538               (cond ((not group)
 539                      (re-search-forward "^Newsgroup:" nil t)
 540                      (end-of-line))
 541                     ((not subject)
 542                      (re-search-forward "^Subject:" nil t)
 543                      (end-of-line))
 544                     (t
 545                      (re-search-forward
 546                       (concat "^" (regexp-quote mail-header-separator) "$"))
 547                      (forward-line 1)))
 548             (re-search-forward
 549              (concat "^" (regexp-quote mail-header-separator) "$"))
 550             (forward-line 1)
 551             (if (not yank)
 552                 ()
 553               (save-excursion
 554                 (if (not (listp yank))
 555                     (news-reply-yank-original nil)
 556                   (setq yank (reverse yank))
 557                   (while yank
 558                     (save-excursion
 559                       (save-window-excursion
 560                         (set-buffer gnus-summary-buffer)
 561                         (gnus-summary-select-article nil nil nil (car yank))
 562                         (gnus-summary-remove-process-mark (car yank)))
 563                       (let ((mail-reply-buffer gnus-article-copy))
 564                         (gnus-copy-article-buffer)
 565                         (let ((news-reply-yank-message-id
 566                                (save-excursion
 567                                  (set-buffer gnus-article-copy)
 568                                  (mail-fetch-field "message-id")))
 569                               (news-reply-yank-from
 570                                (save-excursion
 571                                  (set-buffer gnus-article-copy)
 572                                  (mail-fetch-field "from"))))
 573                           (news-reply-yank-original nil))
 574                         (setq yank (cdr yank)))))))))
 575           (if gnus-post-prepare-function
 576               (funcall gnus-post-prepare-function group))
 577           (run-hooks 'gnus-post-prepare-hook)
 578           (make-local-variable 'gnus-prev-winconf)
 579           (setq gnus-prev-winconf winconf))))
 580   (setq gnus-article-check-size (cons (buffer-size) (gnus-article-checksum)))
 581   (message "")
 582   t)
 583
 584 (defun gnus-inews-news (&optional use-group-method)
 585   "Send a news message.
 586 If given a prefix, and the group is a foreign group, this function
 587 will attempt to use the foreign server to post the article."
 588   (interactive "P")
 589   (let* ((case-fold-search nil)
 590          (server-running (gnus-server-opened gnus-current-select-method))
 591          (reply gnus-article-reply)
 592          error post-result)
 593     (save-excursion
 594       (gnus-start-news-server)          ;Use default server.
 595       (widen)
 596       (goto-char (point-min))
 597       (run-hooks 'news-inews-hook)
 598
 599       ;; Send to server.
 600       (gnus-message 5 "Posting to USENET...")
 601       (setq post-result (funcall gnus-inews-article-function use-group-method))
 602       (cond ((eq post-result 'illegal)
 603              (setq error t)
 604              (ding))
 605             (post-result
 606              (gnus-message 5 "Posting to USENET...done")
 607              (if (gnus-buffer-exists-p (car-safe reply))
 608                  (progn
 609                    (save-excursion
 610                      (set-buffer gnus-summary-buffer)
 611                      (gnus-summary-mark-article-as-replied
 612                       (cdr reply)))))
 613              (set-buffer-modified-p nil))
 614             (t
 615              ;; We cannot signal an error.
 616              (setq error t)
 617              (ding)
 618              (gnus-message 1 "Article rejected: %s"
 619                            (gnus-status-message gnus-select-method)))))
 620
 621     (let ((conf gnus-prev-winconf))
 622       (if (not error)
 623           (progn
 624             (bury-buffer)
 625             ;; Restore last window configuration.
 626             (and conf (set-window-configuration conf)))))))
 627
 628 (defun gnus-inews-narrow-to-headers ()
 629   (widen)
 630   (narrow-to-region
 631    (goto-char (point-min))
 632    (or (and (re-search-forward
 633              (concat "^" (regexp-quote mail-header-separator) "$") nil t)
 634             (match-beginning 0))
 635        (point-max))))
 636
 637 (defun gnus-inews-send-mail-copy ()
 638   ;; Mail the message if To, Bcc or Cc exists.
 639   (let* ((types '("to" "bcc" "cc"))
 640          (ty types)
 641          (buffer (current-buffer))
 642          fcc)
 643     (save-restriction
 644       (widen)
 645       (gnus-inews-narrow-to-headers)
 646
 647       (while ty
 648         (or (mail-fetch-field (car ty) nil t)
 649             (setq types (delete (car ty) types)))
 650         (setq ty (cdr ty)))
 651
 652       (if (not types)
 653           ;; We do not want to send mail.
 654           ()
 655         (gnus-message 5 "Sending via mail...")
 656         (widen)
 657         (save-excursion
 658           ;; We copy the article over to a temp buffer since we are
 659           ;; going to modify it a little.
 660           (nnheader-set-temp-buffer " *Gnus-mailing*")
 661           (insert-buffer buffer)
 662           ;; We remove Fcc, because we don't want the mailer to see
 663           ;; that header.
 664           (gnus-inews-narrow-to-headers)
 665           (nnheader-remove-header "fcc")
 666
 667           (widen)
 668
 669           (if (and gnus-mail-courtesy-message
 670                    (or (member "to" types)
 671                        (member "cc" types)))
 672               ;; We only want to insert the courtesy mail message if
 673               ;; we use To or Cc; Bcc should not have one. Well, if
 674               ;; both Bcc and To are present, it will get one
 675               ;; anyway.
 676               (progn
 677                 ;; Insert "courtesy" mail message.
 678                 (goto-char (point-min))
 679                 (re-search-forward
 680                  (concat "^" (regexp-quote mail-header-separator) "$"))
 681                 (forward-line 1)
 682                 (insert gnus-mail-courtesy-message)))
 683
 684           (gnus-mail-send)
 685           (kill-buffer (current-buffer))
 686           (gnus-message 5 "Sending via mail...done"))))))
 687
 688 (defun gnus-inews-remove-headers-after-mail ()
 689   (save-excursion
 690     (save-restriction
 691       (gnus-inews-narrow-to-headers)
 692       (nnheader-remove-header "bcc"))))
 693
 694 (defun gnus-inews-check-post ()
 695   "Check whether the post looks ok."
 696   (or
 697    (not gnus-check-before-posting)
 698    (and
 699     ;; We narrow to the headers and check them first.
 700     (save-excursion
 701       (save-restriction
 702         (goto-char (point-min))
 703         (narrow-to-region
 704          (point)
 705          (progn
 706            (re-search-forward
 707             (concat "^" (regexp-quote mail-header-separator) "$"))
 708            (match-beginning 0)))
 709         (goto-char (point-min))
 710         (and
 711          ;; Check for commands in Subject.
 712          (or
 713           (gnus-check-before-posting 'subject-cmsg)
 714           (save-excursion
 715             (if (string-match "^cmsg " (mail-fetch-field "subject"))
 716                 (gnus-y-or-n-p
 717                  "The control code \"cmsg \" is in the subject. Really post? ")
 718               t)))
 719          ;; Check for multiple identical headers.
 720          (or (gnus-check-before-posting 'multiple-headers)
 721              (save-excursion
 722                (let (found)
 723                  (while (and (not found) (re-search-forward "^[^ \t:]+: "
 724                                                             nil t))
 725                    (save-excursion
 726                      (or (re-search-forward
 727                           (concat "^" (setq found
 728                                             (buffer-substring
 729                                              (match-beginning 0)
 730                                              (- (match-end 0) 2))))
 731                           nil t)
 732                          (setq found nil))))
 733                  (if found
 734                      (gnus-y-or-n-p
 735                       (format "Multiple %s headers. Really post? " found))
 736                    t))))
 737          ;; Check for Version and Sendsys.
 738          (or (gnus-check-before-posting 'sendsys)
 739              (save-excursion
 740                (if (re-search-forward "^Sendsys:\\|^Version:" nil t)
 741                    (gnus-y-or-n-p
 742                     (format "The article contains a %s command. Really post? "
 743                             (buffer-substring (match-beginning 0)
 744                                               (1- (match-end 0)))))
 745                  t)))
 746          ;; Check for Approved.
 747          (or (gnus-check-before-posting 'approved)
 748              (save-excursion
 749                (if (re-search-forward "^Approved:" nil t)
 750                    (gnus-y-or-n-p
 751                     "The article contains an Approved header. Really post? ")
 752                  t)))
 753          ;; Check the Message-ID header.
 754          (or (gnus-check-before-posting 'message-id)
 755              (save-excursion
 756                (let* ((case-fold-search t)
 757                       (message-id (mail-fetch-field "message-id")))
 758                  (or (not message-id)
 759                      (and (string-match "@" message-id)
 760                           (string-match "@[^\\.]*\\." message-id))
 761                      (gnus-y-or-n-p
 762                       (format
 763                        "The Message-ID looks strange: \"%s\". Really post? "
 764                        message-id))))))
 765          ;; Check the From header.
 766          (or (gnus-check-before-posting 'from)
 767              (save-excursion
 768                (let* ((case-fold-search t)
 769                       (from (mail-fetch-field "from")))
 770                  (cond
 771                   ((not from)
 772                    (gnus-y-or-n-p "There is no From line. Really post? "))
 773                   ((not (string-match "@[^\\.]*\\." from))
 774                    (gnus-y-or-n-p
 775                     (format
 776                      "The address looks strange: \"%s\". Really post? " from)))
 777                   ((string-match "(.*).*(.*)" from)
 778                    (gnus-y-or-n-p
 779                     (format
 780                      "The From header looks strange: \"%s\". Really post? "
 781                      from)))
 782                   (t t)))))
 783          )))
 784     ;; Check for long lines.
 785     (or (gnus-check-before-posting 'long-lines)
 786         (save-excursion
 787           (goto-char (point-min))
 788           (re-search-forward
 789            (concat "^" (regexp-quote mail-header-separator) "$"))
 790           (while (and
 791                   (progn
 792                     (end-of-line)
 793                     (< (current-column) 80))
 794                   (zerop (forward-line 1))))
 795           (or (bolp)
 796               (eobp)
 797               (gnus-y-or-n-p
 798                (format
 799                 "You have lines longer than 79 characters.  Really post? ")))))
 800     ;; Check for control characters.
 801     (or (gnus-check-before-posting 'control-chars)
 802         (save-excursion
 803           (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t)
 804               (gnus-y-or-n-p
 805                "The article contains control characters. Really post? ")
 806             t)))
 807     ;; Check excessive size.
 808     (or (gnus-check-before-posting 'size)
 809         (if (> (buffer-size) 60000)
 810             (gnus-y-or-n-p
 811              (format "The article is %d octets long. Really post? "
 812                      (buffer-size)))
 813           t))
 814     ;; Use the (size . checksum) variable to see whether the
 815     ;; article is empty or has only quoted text.
 816     (or
 817      (gnus-check-before-posting 'new-text)
 818      (if (and (= (buffer-size) (car gnus-article-check-size))
 819               (= (gnus-article-checksum) (cdr gnus-article-check-size)))
 820          (gnus-y-or-n-p
 821           "It looks like there's no new text in your article. Really post? ")
 822        t))
 823     ;; Check the length of the signature.
 824     (or (gnus-check-before-posting 'signature)
 825         (progn
 826           (goto-char (point-max))
 827           (if (not (re-search-backward gnus-signature-separator nil t))
 828               t
 829             (if (> (count-lines (point) (point-max)) 4)
 830                 (gnus-y-or-n-p
 831                  (format
 832                   "Your .sig is %d lines; it should be max 4.  Really post? "
 833                   (count-lines (point) (point-max))))
 834               t)))))))
 835
 836 (defun gnus-article-checksum ()
 837   (let ((sum 0))
 838     (save-excursion
 839       (while (not (eobp))
 840         (setq sum (logxor sum (following-char)))
 841         (forward-char 1)))
 842     sum))
 843
 844 ;; Returns non-nil if this type is not to be checked.
 845 (defun gnus-check-before-posting (type)
 846   (not
 847    (or (not gnus-check-before-posting)
 848        (if (listp gnus-check-before-posting)
 849            (memq type gnus-check-before-posting)
 850          t))))
 851
 852 (defun gnus-cancel-news ()
 853   "Cancel an article you posted."
 854   (interactive)
 855   (if (or gnus-expert-user
 856           (gnus-yes-or-no-p "Do you really want to cancel this article? "))
 857       (let ((from nil)
 858             (newsgroups nil)
 859             (message-id nil)
 860             (distribution nil))
 861         (or (gnus-member-of-valid 'post gnus-newsgroup-name)
 862             (error "This backend does not support canceling"))
 863         (save-excursion
 864           ;; Get header info. from original article.
 865           (save-restriction
 866             (gnus-article-show-all-headers)
 867             (goto-char (point-min))
 868             (search-forward "\n\n" nil 'move)
 869             (narrow-to-region (point-min) (point))
 870             (setq from (mail-fetch-field "from"))
 871             (setq newsgroups (mail-fetch-field "newsgroups"))
 872             (setq message-id (mail-fetch-field "message-id"))
 873             (setq distribution (mail-fetch-field "distribution")))
 874           ;; Verify if the article is absolutely user's by comparing
 875           ;; user id with value of its From: field.
 876           (if (not
 877                (string-equal
 878                 (downcase (mail-strip-quoted-names from))
 879                 (downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
 880               (progn
 881                 (ding) (gnus-message 3 "This article is not yours.")
 882                 nil)
 883             ;; Make control article.
 884             (set-buffer (get-buffer-create " *Gnus-canceling*"))
 885             (buffer-disable-undo (current-buffer))
 886             (erase-buffer)
 887             (insert "Newsgroups: " newsgroups "\n"
 888                     "From: " (gnus-inews-real-user-address) "\n"
 889                     "Subject: cancel " message-id "\n"
 890                     "Control: cancel " message-id "\n"
 891                     (if distribution
 892                         (concat "Distribution: " distribution "\n")
 893                       "")
 894                     mail-header-separator "\n"
 895                     "This is a cancel message from " from ".\n")
 896             ;; Send the control article to NNTP server.
 897             (gnus-message 5 "Canceling your article...")
 898             (prog1
 899                 (if (funcall gnus-inews-article-function)
 900                     (gnus-message 5 "Canceling your article...done")
 901                   (progn
 902                     (ding)
 903                     (gnus-message 1 "Cancel failed; %s"
 904                                   (gnus-status-message gnus-newsgroup-name))
 905                     nil)
 906                   t)
 907               ;; Kill the article buffer.
 908               (kill-buffer (current-buffer))))))))
 909
 910 \f
 911 ;;; Lowlevel inews interface.
 912
 913 ;; Dummy to avoid byte-compile warning.
 914 (defvar nnspool-rejected-article-hook)
 915
 916 (defun gnus-inews-article (&optional use-group-method)
 917   "Post an article in current buffer using NNTP protocol."
 918   (let ((artbuf (current-buffer))
 919         gcc result)
 920     (widen)
 921     (goto-char (point-max))
 922     ;; Require a newline at the end of the buffer since inews may
 923     ;; append a .signature.
 924     (or (= (preceding-char) ?\n)
 925         (insert ?\n))
 926     ;; Prepare article headers.  All message body such as signature
 927     ;; must be inserted before Lines: field is prepared.
 928     (save-restriction
 929       (gnus-inews-narrow-to-headers)
 930       ;; Fix some headers.
 931       (gnus-inews-cleanup-headers)
 932       ;; Remove some headers.
 933       (gnus-inews-remove-headers)
 934       ;; Insert some headers.
 935       (gnus-inews-insert-headers)
 936       ;; Let the user do all of the above.
 937       (run-hooks 'gnus-inews-article-header-hook)
 938       ;; Copy the Gcc header, if any.
 939       (setq gcc (mail-fetch-field "gcc"))
 940       (widen))
 941     ;; Check whether the article is a good Net Citizen.
 942     (if (and gnus-article-check-size
 943              (not (gnus-inews-check-post)))
 944         ;; Aber nein!
 945         'illegal
 946       ;; We fudge a hook for nnspool.
 947       (setq nnspool-rejected-article-hook
 948             (`
 949              (list
 950               (lambda ()
 951                 (condition-case ()
 952                     (save-excursion
 953                       (set-buffer (, (buffer-name)))
 954                       (gnus-put-in-draft-group nil 'silent))
 955                   (error
 956                    (ding)
 957                    (gnus-message
 958                     1 "Couldn't enter rejected article into draft group")))))))
 959
 960       ;; Looks ok, so we do the nasty.
 961       (save-excursion
 962         ;; This hook may insert a signature.
 963         (save-excursion
 964           (goto-char (point-min))
 965           (let ((gnus-newsgroup-name (or (mail-fetch-field "newsgroups")
 966                                          gnus-newsgroup-name)))
 967             (run-hooks 'gnus-prepare-article-hook)))
 968         ;; Send off copies using mail, if that is wanted.
 969         (gnus-inews-send-mail-copy)
 970         ;; Remove more headers.
 971         (gnus-inews-remove-headers-after-mail)
 972         ;; Copy the article over to a temp buffer.
 973         (nnheader-set-temp-buffer " *Gnus-posting*")
 974         (insert-buffer-substring artbuf)
 975         ;; Remove the header separator.
 976         (goto-char (point-min))
 977         (re-search-forward
 978          (concat "^" (regexp-quote mail-header-separator) "$"))
 979         (replace-match "" t t)
 980         ;; Run final inews hooks.  This hook may do FCC.
 981         ;; The article must be saved before being posted because
 982         ;; `gnus-request-post' modifies the buffer.
 983         (run-hooks 'gnus-inews-article-hook)
 984         ;; Copy the article over to some group, possibly.
 985         (and gcc (gnus-inews-do-gcc gcc))
 986         ;; Post the article.
 987         (setq result
 988               (gnus-request-post
 989                (if use-group-method
 990                    (gnus-find-method-for-group gnus-newsgroup-name)
 991                  gnus-select-method) use-group-method))
 992         (kill-buffer (current-buffer)))
 993       (run-hooks 'gnus-message-sent-hook)
 994       ;; We remove To and Cc headers to avoid re-mailing if the user
 995       ;; accidentally (or purposefully) leans on the `C-c C-c' keys
 996       ;; and the news server rejects the posting.
 997       (gnus-inews-narrow-to-headers)
 998       (nnheader-remove-header "^\\(to\\|[bcf]cc\\|cc\\):" t)
 999       (widen)
1000       ;; If the posting was unsuccessful (that it, it was rejected) we
1001       ;; put it into the draft group.
1002       (or result (gnus-put-in-draft-group))
1003       result)))
1004
1005 (defun gnus-inews-cleanup-headers ()
1006   ;; Correct newsgroups field: change sequence of spaces to comma and
1007   ;; eliminate spaces around commas.  Eliminate imbedded line breaks.
1008   (goto-char (point-min))
1009   (if (re-search-forward "^Newsgroups: +" nil t)
1010       (save-restriction
1011         (narrow-to-region
1012          (point)
1013          (if (re-search-forward "^[^ \t]" nil t)
1014              (match-beginning 0)
1015            (forward-line 1)
1016            (point)))
1017         (goto-char (point-min))
1018         (while (re-search-forward "\n[ \t]+" nil t)
1019           (replace-match " " t t))      ;No line breaks (too confusing)
1020         (goto-char (point-min))
1021         (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t)
1022           (replace-match "," t t))
1023         (goto-char (point-min))
1024         ;; Remove a trailing comma.
1025         (if (re-search-forward ",$" nil t)
1026             (replace-match "" t t))))
1027
1028   ;; Added by Per Abrahamsen <abraham@iesd.auc.dk>.
1029   ;; Help save the the world!
1030   (or
1031    gnus-expert-user
1032    (let ((newsgroups (mail-fetch-field "newsgroups"))
1033          (followup-to (mail-fetch-field "followup-to"))
1034          groups to)
1035      (if (and newsgroups
1036               (string-match "," newsgroups) (not followup-to))
1037          (progn
1038            (while (string-match "," newsgroups)
1039              (setq groups
1040                    (cons (list (substring newsgroups 0 (match-beginning 0)))
1041                          groups))
1042              (setq newsgroups (substring newsgroups (match-end 0))))
1043            (setq groups (nreverse (cons (list newsgroups) groups)))
1044
1045            (setq to (completing-read
1046                      "Followups to: (default all groups) " groups))
1047            (if (> (length to) 0)
1048                (progn
1049                  (goto-char (point-min))
1050                  (insert "Followup-To: " to "\n")))))))
1051
1052   ;; Cleanup Followup-To.
1053   (goto-char (point-min))
1054   (if (search-forward-regexp "^Followup-To: +" nil t)
1055       (save-restriction
1056         (narrow-to-region
1057          (point)
1058          (if (re-search-forward "^[^ \t]" nil 'end)
1059              (match-beginning 0)
1060            (point-max)))
1061         (goto-char (point-min))
1062         (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing)
1063         (goto-char (point-min))
1064         (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ","))))
1065
1066
1067 (defun gnus-inews-remove-headers ()
1068   (let ((case-fold-search t)
1069         (headers gnus-removable-headers))
1070     ;; Remove toxic headers.
1071     (while headers
1072       (goto-char (point-min))
1073       (and (re-search-forward
1074             (concat "^" (downcase (format "%s" (car headers))))
1075             nil t)
1076            (delete-region (progn (beginning-of-line) (point))
1077                           (progn (forward-line 1) (point))))
1078       (setq headers (cdr headers)))))
1079
1080 (defun gnus-inews-insert-headers (&optional headers)
1081   "Prepare article headers.
1082 Headers already prepared in the buffer are not modified.
1083 Headers in `gnus-required-headers' will be generated."
1084   (let ((Date (gnus-inews-date))
1085         (Message-ID (gnus-inews-message-id))
1086         (Organization (gnus-inews-organization))
1087         (From (gnus-inews-user-name))
1088         (Path (gnus-inews-path))
1089         (Subject nil)
1090         (Newsgroups nil)
1091         (To nil)
1092         (Distribution nil)
1093         (Lines (gnus-inews-lines))
1094         (X-Newsreader gnus-version)
1095         (X-Mailer gnus-version)
1096         (headers (or headers gnus-required-headers))
1097         (case-fold-search t)
1098         header value elem)
1099     ;; First we remove any old generated headers.
1100     (let ((headers gnus-deletable-headers))
1101       (while headers
1102         (goto-char (point-min))
1103         (and (re-search-forward
1104               (concat "^" (symbol-name (car headers)) ": *") nil t)
1105              (get-text-property (1+ (match-beginning 0)) 'gnus-deletable)
1106              (gnus-delete-line))
1107         (setq headers (cdr headers))))
1108     ;; If there are References, and no "Re: ", then the thread has
1109     ;; changed name. See Son-of-1036.
1110     (if (and (mail-fetch-field "references")
1111              (get-buffer gnus-article-buffer))
1112         (let ((psubject (gnus-simplify-subject-re
1113                          (mail-fetch-field "subject"))))
1114           (or (and psubject gnus-reply-subject
1115                    (string= (gnus-simplify-subject-re gnus-reply-subject)
1116                             psubject))
1117               (progn
1118                 (string-match "@" Message-ID)
1119                 (setq Message-ID
1120                       (concat (substring Message-ID 0 (match-beginning 0))
1121                               "_-_"
1122                               (substring Message-ID (match-beginning 0))))))))
1123     ;; Go through all the required headers and see if they are in the
1124     ;; articles already. If they are not, or are empty, they are
1125     ;; inserted automatically - except for Subject, Newsgroups and
1126     ;; Distribution.
1127     (while headers
1128       (goto-char (point-min))
1129       (setq elem (car headers))
1130       (if (consp elem)
1131           (setq header (car elem))
1132         (setq header elem))
1133       (if (or (not (re-search-forward
1134                     (concat "^" (downcase (symbol-name header)) ":") nil t))
1135               (progn
1136                 ;; The header was found. We insert a space after the
1137                 ;; colon, if there is none.
1138                 (if (/= (following-char) ? ) (insert " "))
1139                 ;; Find out whether the header is empty...
1140                 (looking-at "[ \t]*$")))
1141           ;; So we find out what value we should insert.
1142           (progn
1143             (setq value
1144                   (or (if (consp elem)
1145                           ;; The element is a cons.  Either the cdr is
1146                           ;; a string to be inserted verbatim, or it
1147                           ;; is a function, and we insert the value
1148                           ;; returned from this function.
1149                           (or (and (stringp (cdr elem)) (cdr elem))
1150                               (and (fboundp (cdr elem)) (funcall (cdr elem))))
1151                         ;; The element is a symbol.  We insert the
1152                         ;; value of this symbol, if any.
1153                         (and (boundp header) (symbol-value header)))
1154                       ;; We couldn't generate a value for this header,
1155                       ;; so we just ask the user.
1156                       (read-from-minibuffer
1157                        (format "Empty header for %s; enter value: " header))))
1158             ;; Finally insert the header.
1159             (save-excursion
1160               (if (bolp)
1161                   (progn
1162                     (goto-char (point-max))
1163                     (insert (symbol-name header) ": " value "\n")
1164                     (forward-line -1))
1165                 (replace-match value t t))
1166               ;; Add the deletable property to the headers that require it.
1167               (and (memq header gnus-deletable-headers)
1168                    (progn (beginning-of-line) (looking-at "[^:]+: "))
1169                    (add-text-properties
1170                     (point) (match-end 0)
1171                     '(gnus-deletable t face italic) (current-buffer))))))
1172       (setq headers (cdr headers)))
1173     ;; Insert new Sender if the From is strange.
1174     (let ((from (mail-fetch-field "from"))
1175           (sender (mail-fetch-field "sender")))
1176       (if (and from
1177                (not (string=
1178                      (downcase (car (gnus-extract-address-components from)))
1179                      (downcase (gnus-inews-real-user-address))))
1180                (or (null sender)
1181                    (not
1182                     (string=
1183                      (downcase (car (gnus-extract-address-components sender)))
1184                      (downcase (gnus-inews-real-user-address))))))
1185           (progn
1186             (goto-char (point-min))
1187             (and (re-search-forward "^Sender:" nil t)
1188                  (progn
1189                    (beginning-of-line)
1190                    (insert "Original-")
1191                    (beginning-of-line)))
1192             (insert "Sender: " (gnus-inews-real-user-address) "\n"))))))
1193
1194
1195 (defun gnus-inews-insert-signature ()
1196   "Insert a signature file.
1197 If `gnus-signature-function' is bound and returns a string, this
1198 string is used instead of the variable `gnus-signature-file'.
1199 In either case, if the string is a file name, this file is
1200 inserted. If the string is not a file name, the string itself is
1201 inserted.
1202
1203 If you never want any signature inserted, set both of these variables to
1204 nil."
1205   (save-excursion
1206     (let ((signature
1207            (or (and gnus-signature-function
1208                     (funcall gnus-signature-function gnus-newsgroup-name))
1209                gnus-signature-file)))
1210       (if (and signature
1211                (or (file-exists-p signature)
1212                    (string-match " " signature)
1213                    (not (string-match
1214                          "^/[^/]+/" (expand-file-name signature)))))
1215           (progn
1216             (goto-char (point-max))
1217             (if (and mail-signature (search-backward "\n-- \n" nil t))
1218                 ()
1219               ;; Delete any previous signatures.
1220               (if (search-backward "\n-- \n" nil t)
1221                   (delete-region (point) (point-max)))
1222               (or (eolp) (insert "\n"))
1223               (insert "-- \n")
1224               (if (file-exists-p signature)
1225                   (insert-file-contents signature)
1226                 (insert signature))
1227               (goto-char (point-max))
1228               (or (bolp) (insert "\n"))))))))
1229
1230 ;; Written by "Mr. Per Persson" <pp@solace.mh.se>.
1231 (defun gnus-inews-insert-mime-headers ()
1232   (let ((mail-header-separator ""))
1233     (or (mail-position-on-field "Mime-Version")
1234         (insert "1.0")
1235         (cond ((save-excursion
1236                  (beginning-of-buffer)
1237                  (re-search-forward "[\200-\377]" nil t))
1238                (or (mail-position-on-field "Content-Type")
1239                    (insert "text/plain; charset=ISO-8859-1"))
1240                (or (mail-position-on-field "Content-Transfer-Encoding")
1241                    (insert "8bit")))
1242               (t (or (mail-position-on-field "Content-Type")
1243                      (insert "text/plain; charset=US-ASCII"))
1244                  (or (mail-position-on-field "Content-Transfer-Encoding")
1245                      (insert "7bit")))))))
1246
1247 (defun gnus-inews-do-fcc ()
1248   "Process FCC: fields in current article buffer.
1249 Unless the first character of the field is `|', the article is saved
1250 to the specified file using the function specified by the variable
1251 gnus-author-copy-saver.  The default function rmail-output saves in
1252 Unix mailbox format.
1253 If the first character is `|', the contents of the article is send to
1254 a program specified by the rest of the value."
1255   (let ((fcc-list nil)
1256         (fcc-file nil)
1257         (case-fold-search t))           ;Should ignore case.
1258     (save-excursion
1259       (save-restriction
1260         (goto-char (point-min))
1261         (search-forward "\n\n")
1262         (narrow-to-region (point-min) (point))
1263         (goto-char (point-min))
1264         (while (re-search-forward "^FCC:[ \t]*" nil t)
1265           (setq fcc-list
1266                 (cons (buffer-substring
1267                        (point)
1268                        (progn
1269                          (end-of-line)
1270                          (skip-chars-backward " \t")
1271                          (point)))
1272                       fcc-list))
1273           (delete-region (match-beginning 0)
1274                          (progn (forward-line 1) (point))))
1275         ;; Process FCC operations.
1276         (widen)
1277         (while fcc-list
1278           (setq fcc-file (car fcc-list))
1279           (setq fcc-list (cdr fcc-list))
1280           (cond ((string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" fcc-file)
1281                  (let ((program (substring fcc-file
1282                                            (match-beginning 1) (match-end 1))))
1283                    ;; Suggested by yuki@flab.fujitsu.junet.
1284                    ;; Send article to named program.
1285                    (call-process-region (point-min) (point-max) shell-file-name
1286                                         nil nil nil "-c" program)))
1287                 (t
1288                  ;; Suggested by hyoko@flab.fujitsu.junet.
1289                  ;; Save article in Unix mail format by default.
1290                  (gnus-make-directory (file-name-directory fcc-file))
1291                  (if (and gnus-author-copy-saver
1292                           (not (eq gnus-author-copy-saver 'rmail-output)))
1293                      (funcall gnus-author-copy-saver fcc-file)
1294                    (if (and (file-readable-p fcc-file) (rmail-file-p fcc-file))
1295                        (gnus-output-to-rmail fcc-file)
1296                      (rmail-output fcc-file 1 t t))))))))))
1297
1298 (defun gnus-inews-path ()
1299   "Return uucp path."
1300   (let ((login-name (gnus-inews-login-name)))
1301     (cond ((null gnus-use-generic-path)
1302            (concat (nth 1 gnus-select-method) "!" login-name))
1303           ((stringp gnus-use-generic-path)
1304            ;; Support GENERICPATH.  Suggested by vixie@decwrl.dec.com.
1305            (concat gnus-use-generic-path "!" login-name))
1306           (t login-name))))
1307
1308 (defun gnus-inews-user-name ()
1309   "Return user's network address as \"NAME@DOMAIN (FULL-NAME)\"."
1310   (let ((full-name (gnus-inews-full-name))
1311         (address (if (or gnus-user-login-name gnus-use-generic-from
1312                          gnus-local-domain (getenv "DOMAINNAME"))
1313                      (concat (gnus-inews-login-name) "@"
1314                              (gnus-inews-domain-name gnus-use-generic-from))
1315                    user-mail-address)))
1316     (or gnus-user-from-line
1317         (concat address
1318                 ;; User's full name.
1319                 (cond ((string-equal full-name "&") ;Unix hack.
1320                        (concat " (" (user-login-name) ")"))
1321                       ((string-match "[^ ]+@[^ ]+ +(.*)" address)
1322                        "")
1323                       (t
1324                        (concat " (" full-name ")")))))))
1325
1326 (defun gnus-inews-real-user-address ()
1327   "Return the \"real\" user address.
1328 This function tries to ignore all user modifications, and
1329 give as trustworthy answer as possible."
1330   (concat (user-login-name) "@" (gnus-inews-full-address)))
1331
1332 (defun gnus-inews-login-name ()
1333   "Return login name."
1334   (or gnus-user-login-name (getenv "LOGNAME") (user-login-name)))
1335
1336 (defun gnus-inews-full-name ()
1337   "Return full user name."
1338   (or gnus-user-full-name (getenv "NAME") (user-full-name)))
1339
1340 (defun gnus-inews-domain-name (&optional genericfrom)
1341   "Return user's domain name.
1342 If optional argument GENERICFROM is a string, use it as the domain
1343 name; if it is non-nil, strip off local host name from the domain name.
1344 If the function `system-name' returns full internet name and the
1345 domain is undefined, the domain name is got from it."
1346   (if (or genericfrom gnus-local-domain (getenv "DOMAINNAME"))
1347       (let* ((system-name (system-name))
1348              (domain
1349               (or (if (stringp genericfrom) genericfrom)
1350                   (getenv "DOMAINNAME")
1351                   gnus-local-domain
1352                   ;; Function `system-name' may return full internet name.
1353                   ;; Suggested by Mike DeCorte <mrd@sun.soe.clarkson.edu>.
1354                   (if (string-match "\\." system-name)
1355                       (substring system-name (match-end 0)))
1356                   (read-string "Domain name (no host): ")))
1357              (host (or (if (string-match "\\." system-name)
1358                            (substring system-name 0 (match-beginning 0)))
1359                        system-name)))
1360         (if (string-equal "." (substring domain 0 1))
1361             (setq domain (substring domain 1)))
1362         ;; Support GENERICFROM as same as standard Bnews system.
1363         ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com.
1364         (cond ((null genericfrom)
1365                (concat host "." domain))
1366               ;;((stringp genericfrom) genericfrom)
1367               (t domain)))
1368     (if (string-match "\\." (system-name))
1369         (system-name)
1370       (substring user-mail-address
1371                  (1+ (string-match "@" user-mail-address))))))
1372
1373 (defun gnus-inews-full-address ()
1374   (let ((domain (gnus-inews-domain-name))
1375         (system (system-name))
1376         (case-fold-search t))
1377     (if (string-match "\\." system) system
1378       (if (string-match (concat "^" (regexp-quote system)) domain) domain
1379         (concat system "." domain)))))
1380
1381 (defun gnus-inews-message-id ()
1382   "Generate unique Message-ID for user."
1383   ;; Message-ID should not contain a slash and should be terminated by
1384   ;; a number.  I don't know the reason why it is so.
1385   (concat "<" (gnus-inews-unique-id) "@" (gnus-inews-full-address) ">"))
1386
1387 (defvar gnus-unique-id-char nil)
1388
1389 ;; If you ever change this function, make sure the new version
1390 ;; cannot generate IDs that the old version could.
1391 ;; You might for example insert a "." somewhere (not next to another dot
1392 ;; or string boundary), or modify the newsreader name to "Ding".
1393 (defun gnus-inews-unique-id ()
1394   ;; Dont use microseconds from (current-time), they may be unsupported.
1395   ;; Instead we use this randomly inited counter.
1396   (setq gnus-unique-id-char
1397         (% (1+ (or gnus-unique-id-char (logand (random t) (1- (lsh 1 20)))))
1398            ;; (current-time) returns 16-bit ints,
1399            ;; and 2^16*25 just fits into 4 digits i base 36.
1400            (* 25 25)))
1401   (let ((tm (if (fboundp 'current-time)
1402                 (current-time) '(12191 46742 287898))))
1403     (concat
1404      (if (memq system-type '(ms-dos emx vax-vms))
1405          (let ((user (downcase (gnus-inews-login-name))))
1406            (while (string-match "[^a-z0-9_]" user)
1407              (aset user (match-beginning 0) ?_))
1408            user)
1409        (gnus-number-base36 (user-uid) -1))
1410      (gnus-number-base36 (+ (car   tm) (lsh (% gnus-unique-id-char 25) 16)) 4)
1411      (gnus-number-base36 (+ (nth 1 tm) (lsh (/ gnus-unique-id-char 25) 16)) 4)
1412      ;; Append the newsreader name, because while the generated
1413      ;; ID is unique to this newsreader, other newsreaders might
1414      ;; otherwise generate the same ID via another algorithm.
1415      ".fsf")))
1416
1417
1418 (defun gnus-inews-date ()
1419   "Current time string."
1420   (timezone-make-date-arpa-standard
1421    (current-time-string) (current-time-zone)))
1422
1423 (defun gnus-inews-organization ()
1424   "Return user's organization.
1425 The ORGANIZATION environment variable is used if defined.
1426 If not, the variable `gnus-local-organization' is used instead.
1427 If it is a function, the function will be called with the current
1428 newsgroup name as the argument.
1429 If this is a file name, the contents of this file will be used as the
1430 organization."
1431   (let* ((organization
1432           (or (getenv "ORGANIZATION")
1433               (if gnus-local-organization
1434                   (if (and (symbolp gnus-local-organization)
1435                            (fboundp gnus-local-organization))
1436                       (funcall gnus-local-organization gnus-newsgroup-name)
1437                     gnus-local-organization))
1438               gnus-organization-file
1439               "~/.organization")))
1440     (and (stringp organization)
1441          (> (length organization) 0)
1442          (or (file-exists-p organization)
1443              (string-match " " organization)
1444              (not (string-match "^/usr/lib/" organization)))
1445          (save-excursion
1446            (gnus-set-work-buffer)
1447            (if (file-exists-p organization)
1448                (insert-file-contents organization)
1449              (insert organization))
1450            (goto-char (point-min))
1451            (while (re-search-forward " *\n *" nil t)
1452              (replace-match " " t t))
1453            (buffer-substring (point-min) (point-max))))))
1454
1455 (defun gnus-inews-lines ()
1456   "Count the number of lines and return numeric string."
1457   (save-excursion
1458     (save-restriction
1459       (widen)
1460       (goto-char (point-min))
1461       (re-search-forward
1462        (concat "^" (regexp-quote mail-header-separator) "$"))
1463       (forward-line 1)
1464       (int-to-string (count-lines (point) (point-max))))))
1465
1466 \f
1467 ;;;
1468 ;;; Gnus Mail Functions
1469 ;;;
1470
1471 ;;; Mail reply commands of Gnus summary mode
1472
1473 (defun gnus-summary-reply (yank &optional yank-articles)
1474   "Reply mail to news author.
1475 If prefix argument YANK is non-nil, original article is yanked automatically.
1476 Customize the variable gnus-mail-reply-method to use another mailer."
1477   (interactive "P")
1478   ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells)
1479   ;; Stripping headers should be specified with mail-yank-ignored-headers.
1480   (gnus-set-global-variables)
1481   (if yank-articles (gnus-summary-goto-subject (car yank-articles)))
1482   (gnus-summary-select-article)
1483   (let ((gnus-newsgroup-name gnus-newsgroup-name))
1484     (bury-buffer gnus-article-buffer)
1485     (funcall gnus-mail-reply-method (or yank-articles (not (not yank))))))
1486
1487 (defun gnus-summary-reply-with-original (n)
1488   "Reply mail to news author with original article.
1489 Customize the variable gnus-mail-reply-method to use another mailer."
1490   (interactive "P")
1491   (gnus-summary-reply t (gnus-summary-work-articles n)))
1492
1493 (defun gnus-summary-mail-forward (post)
1494   "Forward the current message to another user.
1495 Customize the variable gnus-mail-forward-method to use another mailer."
1496   (interactive "P")
1497   (gnus-set-global-variables)
1498   (gnus-summary-select-article)
1499   (gnus-copy-article-buffer)
1500   (let ((gnus-newsgroup-name gnus-newsgroup-name))
1501     (if post
1502         (gnus-forward-using-post gnus-article-copy)
1503       (funcall gnus-mail-forward-method gnus-article-copy))))
1504
1505 (defun gnus-summary-post-forward ()
1506   "Forward the current article to a newsgroup."
1507   (interactive)
1508   (gnus-summary-mail-forward t))
1509
1510 (defvar gnus-nastygram-message
1511   "The following article was inappropriately posted to %s.\n"
1512   "Format string to insert in nastygrams.
1513 The current group name will be inserted at \"%s\".")
1514
1515 (defun gnus-summary-mail-nastygram (n)
1516   "Send a nastygram to the author of the current article."
1517   (interactive "P")
1518   (if (or gnus-expert-user
1519           (gnus-y-or-n-p
1520            "Really send a nastygram to the author of the current article? "))
1521       (let ((group gnus-newsgroup-name))
1522         (gnus-summary-reply-with-original n)
1523         (set-buffer gnus-mail-buffer)
1524         (insert (format gnus-nastygram-message group))
1525         (gnus-mail-send-and-exit))))
1526
1527 (defun gnus-summary-mail-other-window ()
1528   "Compose mail in other window.
1529 Customize the variable `gnus-mail-other-window-method' to use another
1530 mailer."
1531   (interactive)
1532   (gnus-set-global-variables)
1533   (let ((gnus-newsgroup-name gnus-newsgroup-name))
1534     (funcall gnus-mail-other-window-method)))
1535
1536 (defun gnus-mail-reply-using-mail (&optional yank to-address)
1537   (save-excursion
1538     (set-buffer gnus-summary-buffer)
1539     (let ((group (gnus-group-real-name gnus-newsgroup-name))
1540           (cur (cons (current-buffer) (cdr gnus-article-current)))
1541           (winconf (current-window-configuration))
1542           from subject date reply-to message-of
1543           references message-id sender follow-to sendto elt)
1544       (set-buffer (get-buffer-create gnus-mail-buffer))
1545       (mail-mode)
1546       (make-local-variable 'gnus-article-reply)
1547       (setq gnus-article-reply cur)
1548       (make-local-variable 'gnus-prev-winconf)
1549       (setq gnus-prev-winconf winconf)
1550       (if (and (buffer-modified-p)
1551                (> (buffer-size) 0)
1552                (not (gnus-y-or-n-p
1553                      "Unsent article being composed; erase it? ")))
1554           ()
1555         (erase-buffer)
1556         (save-excursion
1557           (gnus-copy-article-buffer)
1558           (save-restriction
1559             (set-buffer gnus-article-copy)
1560             (gnus-narrow-to-headers)
1561             (if (and (boundp 'gnus-reply-to-function)
1562                      gnus-reply-to-function)
1563                 (setq follow-to (funcall gnus-reply-to-function group)))
1564             (setq from (mail-fetch-field "from"))
1565             (setq date (or (mail-fetch-field "date")
1566                            (mail-header-date gnus-current-headers)))
1567             (and from
1568                  (let ((stop-pos
1569                         (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
1570                    (setq message-of
1571                          (concat (if stop-pos (substring from 0 stop-pos) from)
1572                                  "'s message of " date))))
1573             (setq sender (mail-fetch-field "sender"))
1574             (setq subject (or (mail-fetch-field "subject")
1575                               "Re: none"))
1576             (or (string-match "^[Rr][Ee]:" subject)
1577                 (setq subject (concat "Re: " subject)))
1578             (setq reply-to (mail-fetch-field "reply-to"))
1579             (setq references (mail-fetch-field "references"))
1580             (setq message-id (mail-fetch-field "message-id"))
1581             (widen))
1582           (setq news-reply-yank-from (or from "(nobody)")))
1583         (setq news-reply-yank-message-id
1584               (or message-id "(unknown Message-ID)"))
1585
1586         ;; Gather the "to" addresses out of the follow-to list and remove
1587         ;; them as we go.
1588         (if (and follow-to (listp follow-to))
1589             (while (setq elt (assoc "To" follow-to))
1590               (setq sendto (concat sendto (and sendto ", ") (cdr elt)))
1591               (setq follow-to (delq elt follow-to))))
1592
1593         (mail-setup (or to-address
1594                         (if (and follow-to (not (stringp follow-to))) sendto
1595                           (or follow-to reply-to from sender "")))
1596                     subject message-of nil gnus-article-copy nil)
1597
1598         (auto-save-mode auto-save-default)
1599         (gnus-inews-modify-mail-mode-map)
1600
1601         (if (and follow-to (listp follow-to))
1602             (progn
1603               (goto-char (point-min))
1604               (re-search-forward "^To:" nil t)
1605               (beginning-of-line)
1606               (forward-line 1)
1607               (while follow-to
1608                 (insert (car (car follow-to)) ": " (cdr (car follow-to)) "\n")
1609                 (setq follow-to (cdr follow-to)))))
1610         (nnheader-insert-references references message-id)
1611         (goto-char (point-min))
1612         (re-search-forward
1613          (concat "^" (regexp-quote mail-header-separator) "$"))
1614         (forward-line 1)
1615         (if (not yank)
1616             (gnus-configure-windows 'reply 'force)
1617           (let ((last (point))
1618                 end)
1619             (if (not (listp yank))
1620                 (progn
1621                   (save-excursion
1622                     (mail-yank-original nil))
1623                   (or mail-yank-hooks mail-citation-hook
1624                       (run-hooks 'news-reply-header-hook)))
1625               (while yank
1626                 (save-window-excursion
1627                   (set-buffer gnus-summary-buffer)
1628                   (gnus-summary-select-article nil nil nil (car yank))
1629                   (gnus-summary-remove-process-mark (car yank)))
1630                 (save-excursion
1631                   (gnus-copy-article-buffer)
1632                   (mail-yank-original nil)
1633                   (setq end (point)))
1634                 (or mail-yank-hooks mail-citation-hook
1635                     (run-hooks 'news-reply-header-hook))
1636                 (goto-char end)
1637                 (setq yank (cdr yank))))
1638             (goto-char last))
1639           (gnus-configure-windows 'reply-yank 'force))
1640         (run-hooks 'gnus-mail-hook)))))
1641
1642 (defun gnus-mail-yank-original ()
1643   (interactive)
1644   (save-excursion
1645     (mail-yank-original nil))
1646   (or mail-yank-hooks mail-citation-hook
1647       (run-hooks 'news-reply-header-hook)))
1648
1649 (defun gnus-mail-send-and-exit (&optional dont-send)
1650   "Send the current mail and return to Gnus."
1651   (interactive)
1652   (let ((reply gnus-article-reply)
1653         (winconf gnus-prev-winconf))
1654     (or dont-send (gnus-mail-send))
1655     (bury-buffer)
1656     (if (get-buffer gnus-group-buffer)
1657         (progn
1658           (if (gnus-buffer-exists-p (car-safe reply))
1659               (progn
1660                 (set-buffer (car reply))
1661                 (and (cdr reply)
1662                      (gnus-summary-mark-article-as-replied
1663                       (cdr reply)))))
1664           (and winconf (set-window-configuration winconf))))))
1665
1666 (defun gnus-put-message ()
1667   "Put the current message in some group and return to Gnus."
1668   (interactive)
1669   (let ((reply gnus-article-reply)
1670         (winconf gnus-prev-winconf)
1671         (group gnus-newsgroup-name)
1672         buf)
1673
1674     (or (and group (not (gnus-group-read-only-p group)))
1675         (setq group (read-string "Put in group: " nil
1676                                  (gnus-writable-groups))))
1677     (and (gnus-gethash group gnus-newsrc-hashtb)
1678          (error "No such group: %s" group))
1679
1680     (save-excursion
1681       (save-restriction
1682         (widen)
1683         (gnus-inews-narrow-to-headers)
1684         (let (gnus-deletable-headers)
1685           (if (eq major-mode 'mail-mode)
1686               (gnus-inews-insert-headers gnus-required-mail-headers)
1687             (gnus-inews-insert-headers)))
1688         (goto-char (point-max))
1689         (insert "Gcc: " group "\n")
1690         (widen)))
1691
1692     (gnus-inews-do-gcc)
1693
1694     (if (get-buffer gnus-group-buffer)
1695         (progn
1696           (if (gnus-buffer-exists-p (car-safe reply))
1697               (progn
1698                 (set-buffer (car reply))
1699                 (and (cdr reply)
1700                      (gnus-summary-mark-article-as-replied
1701                       (cdr reply)))))
1702           (and winconf (set-window-configuration winconf))))))
1703
1704
1705 (defun gnus-forward-make-subject (buffer)
1706   (save-excursion
1707     (set-buffer buffer)
1708     (concat "[" (if (memq 'mail (assoc (symbol-name
1709                                         (car (gnus-find-method-for-group
1710                                               gnus-newsgroup-name)))
1711                                        gnus-valid-select-methods))
1712                     (gnus-fetch-field "From")
1713                   gnus-newsgroup-name)
1714             "] " (or (gnus-fetch-field "Subject") ""))))
1715
1716 (defun gnus-forward-insert-buffer (buffer)
1717   (let ((beg (goto-char (point-max))))
1718     (insert "------- Start of forwarded message -------\n")
1719     (insert-buffer buffer)
1720     (goto-char (point-max))
1721     (insert "------- End of forwarded message -------\n")
1722     ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
1723     (goto-char beg)
1724     (while (setq beg (next-single-property-change (point) 'invisible))
1725       (goto-char beg)
1726       (delete-region beg (or (next-single-property-change
1727                               (point) 'invisible)
1728                              (point-max))))))
1729
1730 (defun gnus-mail-forward-using-mail (&optional buffer)
1731   "Forward the current message to another user using mail."
1732   ;; This is almost a carbon copy of rmail-forward in rmail.el.
1733   (let* ((forward-buffer (or buffer (current-buffer)))
1734          (winconf (current-window-configuration))
1735          (subject (gnus-forward-make-subject forward-buffer)))
1736     (set-buffer forward-buffer)
1737     (mail nil nil subject)
1738     (gnus-inews-modify-mail-mode-map)
1739     (make-local-variable 'gnus-prev-winconf)
1740     (setq gnus-prev-winconf winconf)
1741     (gnus-forward-insert-buffer forward-buffer)
1742     (goto-char (point-min))
1743     (re-search-forward "^To: " nil t)
1744     (gnus-configure-windows 'mail-forward 'force)
1745     ;; You have a chance to arrange the message.
1746     (run-hooks 'gnus-mail-forward-hook)
1747     (run-hooks 'gnus-mail-hook)))
1748
1749 (defun gnus-forward-using-post (&optional buffer)
1750   (save-excursion
1751     (let* ((forward-buffer (or buffer (current-buffer)))
1752            (subject (gnus-forward-make-subject forward-buffer))
1753            (gnus-newsgroup-name nil))
1754       (gnus-post-news 'post nil nil nil nil subject)
1755       (save-excursion
1756         (gnus-forward-insert-buffer forward-buffer)
1757         ;; You have a chance to arrange the message.
1758         (run-hooks 'gnus-mail-forward-hook)))))
1759
1760 (defun gnus-mail-other-window-using-mail ()
1761   "Compose mail other window using mail."
1762   (let ((winconf (current-window-configuration)))
1763     (mail-other-window nil nil nil nil nil (get-buffer gnus-article-buffer))
1764     (gnus-inews-modify-mail-mode-map)
1765     (make-local-variable 'gnus-prev-winconf)
1766     (setq gnus-prev-winconf winconf)
1767     (run-hooks 'gnus-mail-hook)
1768     (gnus-configure-windows 'summary-mail 'force)))
1769
1770 (defun gnus-article-mail (yank)
1771   "Send a reply to the address near point.
1772 If YANK is non-nil, include the original article."
1773   (interactive "P")
1774   (let ((address
1775          (buffer-substring
1776           (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
1777           (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
1778     (and address
1779          (progn
1780            (switch-to-buffer gnus-summary-buffer)
1781            (funcall gnus-mail-reply-method yank address)))))
1782
1783 (defun gnus-bug ()
1784   "Send a bug report to the Gnus maintainers."
1785   (interactive)
1786   (let ((winconf (current-window-configuration)))
1787     (delete-other-windows)
1788     (switch-to-buffer "*Gnus Help Bug*")
1789     (erase-buffer)
1790     (insert gnus-bug-message)
1791     (goto-char (point-min))
1792     (pop-to-buffer "*Gnus Bug*")
1793     (erase-buffer)
1794     (mail-mode)
1795     (mail-setup gnus-maintainer nil nil nil nil nil)
1796     (auto-save-mode auto-save-default)
1797     (make-local-variable 'gnus-prev-winconf)
1798     (setq gnus-prev-winconf winconf)
1799     (gnus-inews-modify-mail-mode-map)
1800     (local-set-key "\C-c\C-c" 'gnus-bug-mail-send-and-exit)
1801     (goto-char (point-min))
1802     (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
1803     (forward-line 1)
1804     (insert (format "%s\n%s\n\n\n\n\n" (gnus-version) (emacs-version)))
1805     (gnus-debug)
1806     (goto-char (point-min))
1807     (search-forward "Subject: " nil t)
1808     (message "")))
1809
1810 (defun gnus-bug-mail-send-and-exit ()
1811   "Send the bug message and exit."
1812   (interactive)
1813   (and (get-buffer "*Gnus Help Bug*")
1814        (kill-buffer "*Gnus Help Bug*"))
1815   (gnus-mail-send-and-exit))
1816
1817 (defun gnus-debug ()
1818   "Attemps to go through the Gnus source file and report what variables have been changed.
1819 The source file has to be in the Emacs load path."
1820   (interactive)
1821   (let ((files '("gnus.el" "gnus-msg.el" "gnus-score.el"))
1822         file dirs expr olist sym)
1823     (message "Please wait while we snoop your variables...")
1824     (sit-for 0)
1825     (save-excursion
1826       (set-buffer (get-buffer-create " *gnus bug info*"))
1827       (buffer-disable-undo (current-buffer))
1828       (while files
1829         (erase-buffer)
1830         (setq dirs load-path)
1831         (while dirs
1832           (if (or (not (car dirs))
1833                   (not (stringp (car dirs)))
1834                   (not (file-exists-p
1835                         (setq file (concat (file-name-as-directory
1836                                             (car dirs)) (car files))))))
1837               (setq dirs (cdr dirs))
1838             (setq dirs nil)
1839             (insert-file-contents file)
1840             (goto-char (point-min))
1841             (or (re-search-forward "^;;* *Internal variables" nil t)
1842                 (error "Malformed sources in file %s" file))
1843             (narrow-to-region (point-min) (point))
1844             (goto-char (point-min))
1845             (while (setq expr (condition-case ()
1846                                   (read (current-buffer)) (error nil)))
1847               (condition-case ()
1848                   (and (eq (car expr) 'defvar)
1849                        (stringp (nth 3 expr))
1850                        (or (not (boundp (nth 1 expr)))
1851                            (not (equal (eval (nth 2 expr))
1852                                        (symbol-value (nth 1 expr)))))
1853                        (setq olist (cons (nth 1 expr) olist)))
1854                 (error nil)))))
1855         (setq files (cdr files)))
1856       (kill-buffer (current-buffer)))
1857     (insert "------------------- Environment follows -------------------\n\n")
1858     (while olist
1859       (if (boundp (car olist))
1860           (insert "(setq " (symbol-name (car olist))
1861                   (if (or (consp (setq sym (symbol-value (car olist))))
1862                           (and (symbolp sym)
1863                                (not (or (eq sym nil)
1864                                         (eq sym t)))))
1865                       " '" " ")
1866                   (prin1-to-string (symbol-value (car olist))) ")\n")
1867         (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
1868       (setq olist (cdr olist)))
1869     (insert "\n\n")
1870     ;; Remove any null chars - they seem to cause trouble for some
1871     ;; mailers. (Byte-compiled output from the stuff above.)
1872     (goto-char (point-min))
1873     (while (re-search-forward "[\000\200]" nil t)
1874       (replace-match "" t t))))
1875
1876
1877 ;;; Treatment of rejected articles.
1878
1879
1880 ;;; Bounced mail.
1881
1882 (defun gnus-summary-resend-bounced-mail (fetch)
1883   "Re-mail the current message.
1884 This only makes sense if the current message is a bounce message than
1885 contains some mail you have written which has been bounced back to
1886 you.
1887 If FETCH, try to fetch the article that this is a reply to, if indeed
1888 this is a reply."
1889   (interactive)
1890   (gnus-summary-select-article t)
1891   ;; Create a mail buffer.
1892   (funcall gnus-mail-other-window-method)
1893   (erase-buffer)
1894   (insert-buffer gnus-article-buffer)
1895   (goto-char (point-min))
1896   (search-forward "\n\n")
1897   ;; We remove everything before the bounced mail.
1898   (delete-region
1899    (point-min)
1900    (if (re-search-forward "[^ \t]*:" nil t)
1901        (match-beginning 0)
1902      (point)))
1903   (let (references)
1904     (save-excursion
1905       (save-restriction
1906         (gnus-narrow-to-headers)
1907         (nnheader-remove-header gnus-bounced-headers-junk t)
1908         (setq references (mail-fetch-field "references"))
1909         (goto-char (point-max))
1910         (insert mail-header-separator)))
1911     ;; If there are references, we fetch the article we answered to.
1912     (and fetch
1913          references
1914          (string-match "\\(<[^]+>\\)[ \t]*$" references)
1915          (gnus-summary-refer-article
1916           (substring references (match-beginning 1) (match-end 1)))
1917          (progn
1918            (gnus-summary-show-all-headers)
1919            (gnus-configure-windows 'compose-bounce))))
1920   (goto-char (point-min)))
1921
1922 ;;; Sending mail.
1923
1924 (defun gnus-mail-send ()
1925   "Send the current buffer as mail.
1926 Headers will be generated before sending."
1927   (interactive)
1928   (save-excursion
1929     (save-restriction
1930       (widen)
1931       (gnus-inews-narrow-to-headers)
1932       (let (gnus-deletable-headers)
1933         (gnus-inews-insert-headers gnus-required-mail-headers))
1934       (widen)))
1935   ;; Run final inews hooks.  This hook may do FCC.
1936   (run-hooks 'gnus-inews-article-hook)
1937   (gnus-inews-do-gcc)
1938   (gnus-inews-narrow-to-headers)
1939   (nnheader-remove-header "^[gf]cc:" t)
1940   (widen)
1941   (mail-send)
1942   (run-hooks 'gnus-message-sent-hook))
1943
1944 (defun gnus-inews-modify-mail-mode-map ()
1945   (use-local-map (copy-keymap (current-local-map)))
1946   (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
1947   (local-set-key "\C-c\C-p" 'gnus-put-message)
1948   (local-set-key "\C-c\C-d" 'gnus-enter-into-draft-group))
1949
1950 ;;; Gcc handling.
1951
1952 ;; Do Gcc handling, which copied the message over to some group.
1953 (defun gnus-inews-do-gcc (&optional gcc)
1954   (save-excursion
1955     (save-restriction
1956       (gnus-narrow-to-headers)
1957       (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
1958             end)
1959         (if (not gcc)
1960             () ; Nothing to be done.
1961           (nnheader-remove-header "gcc")
1962           ;; Copy the article over to some group(s).
1963           (while (string-match
1964                   "^[ \t]*\\([^ \t]+\\)\\([ \t]+\\|$\\)" gcc)
1965             (setq end (match-end 0))
1966             (condition-case ()
1967                 (gnus-request-accept-article
1968                  (substring gcc (match-beginning 1) (match-end 1)) t)
1969               (error nil))
1970             (setq gcc (substring gcc end))))))))
1971
1972 (defun gnus-inews-insert-gcc ()
1973   (let* ((group gnus-outgoing-message-group)
1974          (gcc (cond
1975                ((and (symbolp group) (fboundp group))
1976                 (funcall group))
1977                ((or (stringp group) (list group))
1978                 group))))
1979     (if (not gcc)
1980         () ; Insert no Gcc.
1981       (insert "Gcc: "
1982               (if (stringp group) group
1983                 (mapconcat 'identity group " "))
1984               "\n"))))
1985
1986 ;;; Handling rejected (and postponed) news.
1987
1988 (defun gnus-draft-group ()
1989   "Return the name of the draft group."
1990   (gnus-group-prefixed-name
1991    (file-name-nondirectory gnus-draft-group-directory)
1992    (list 'nndir gnus-draft-group-directory)))
1993
1994 (defun gnus-make-draft-group ()
1995   "Make the draft group or die trying."
1996   (let* ((method (` (nndir "private"
1997                            (nndir-directory (, gnus-draft-group-directory)))))
1998          (group (gnus-group-prefixed-name
1999                  (file-name-nondirectory gnus-draft-group-directory)
2000                  method)))
2001     (or (gnus-gethash group gnus-newsrc-hashtb)
2002         (gnus-group-make-group (gnus-group-real-name group) method)
2003         (error "Can't create the draft group"))
2004     group))
2005
2006 (defun gnus-enter-into-draft-group ()
2007   "Enter the current buffer into the draft group."
2008   (interactive)
2009   (gnus-put-in-draft-group t))
2010
2011 (defun gnus-put-in-draft-group (&optional generate silent)
2012   "Does the actual putting."
2013   (let ((group (gnus-make-draft-group))
2014         (type (list major-mode (buffer-name) gnus-newsgroup-name
2015                     (point)))
2016         (mode major-mode)
2017         (buf (current-buffer)))
2018     (widen)
2019     (save-excursion
2020       (nnheader-set-temp-buffer " *enter-draft*")
2021       (insert-buffer buf)
2022       (save-restriction
2023         (widen)
2024         (gnus-inews-narrow-to-headers)
2025         (let (gnus-deletable-headers)
2026           (if (eq mode 'mail-mode)
2027               (gnus-inews-insert-headers gnus-required-mail-headers)
2028             (gnus-inews-insert-headers)))
2029         (widen))
2030
2031       (goto-char (point-min))
2032       ;; We have to store whether we are in a mail group or news group.
2033       (insert (format "X-Gnus-Draft-Type: %S\n" type))
2034       (and (re-search-forward
2035             (concat "^" (regexp-quote mail-header-separator) "$") nil t)
2036            (replace-match "" t t))
2037       (if (prog1
2038               (gnus-request-accept-article group t)
2039             (kill-buffer (current-buffer)))
2040           (or silent
2041               (gnus-mail-send-and-exit 'dont-send))))
2042     (set-buffer-modified-p nil)))
2043
2044 (defun gnus-summary-send-draft ()
2045   "Enter a mail/post buffer to edit and send the draft."
2046   (interactive)
2047   (gnus-set-global-variables)
2048   (gnus-summary-select-article t)
2049   ;; First we find the draft type.
2050   (let (type)
2051     (save-excursion
2052       (set-buffer gnus-article-buffer)
2053       (widen)
2054       (gnus-narrow-to-headers)
2055       (setq type (condition-case ()
2056                      (read (mail-fetch-field "x-gnus-draft-type"))
2057                    (error nil)))
2058       (widen))
2059     (or type
2060         (error "Unknown draft type"))
2061     ;; Get to the proper buffer.
2062     (set-buffer (get-buffer-create (nth 1 type)))
2063     ;; It might be modified.
2064     (and (buffer-modified-p)
2065          (or (gnus-yes-or-no-p "Unsent message being composed; discard it? ")
2066              (error "Break")))
2067     (setq buffer-read-only nil)
2068     (buffer-enable-undo (current-buffer))
2069     (erase-buffer)
2070     ;; Set proper mode.
2071     (funcall (car type))
2072     (and (eq major-mode 'mail-mode)
2073          (gnus-inews-modify-mail-mode-map))
2074     ;; Arrange for deletion of the draft after successful sending.
2075     (make-local-variable 'gnus-message-sent-hook)
2076     (setq gnus-message-sent-hook
2077           (list
2078            (`
2079             (lambda ()
2080               (gnus-request-expire-articles
2081                (, (list (cdr gnus-article-current)))
2082                (, gnus-newsgroup-name) t)))))
2083     ;; Insert the draft.
2084     (insert-buffer gnus-article-buffer)
2085     ;; Insert the separator.
2086     (goto-char (point-min))
2087     (search-forward "\n\n")
2088     (forward-char -1)
2089     (insert mail-header-separator)
2090     ;; Remove the draft header.
2091     (gnus-inews-narrow-to-headers)
2092     (nnheader-remove-header "x-gnus-draft-type")
2093     (widen)
2094     ;; Configure windows.
2095     (let ((gnus-draft-buffer (current-buffer)))
2096       (gnus-configure-windows 'draft))
2097     ;; Put point where you left it.
2098     (goto-char (nth 3 type))))
2099
2100
2101 ;;; Allow redefinition of functions.
2102
2103 (gnus-ems-redefine)
2104
2105 (provide 'gnus-msg)
2106
2107 ;;; gnus-msg.el ends here