*** empty log message ***
[gnus] / lisp / message.el
index 3e32a9a..63e37b5 100644 (file)
@@ -112,7 +112,7 @@ RFC822 required that From, Date, To, Subject and Message-ID be
 included.  Organization, Lines and X-Mailer are optional.")
 
 ;;;###autoload
-(defvar message-deletable-headers '(Message-ID Date)
+(defvar message-deletable-headers '(Message-ID Date Lines)
   "*Headers to be deleted if they already exist and were generated by message previously.")
 
 ;;;###autoload
@@ -193,6 +193,9 @@ If nil, message won't autosave.")
 (defvar message-ignored-cited-headers "."
   "Delete these headers from the messages you yank.")
 
+(defvar message-cancel-message "I am canceling my own article."
+  "Message to be inserted in the cancel message.")
+
 ;; Useful to set in site-init.el
 ;;;###autoload
 (defvar message-send-mail-function 'message-send-mail-with-sendmail
@@ -200,8 +203,8 @@ If nil, message won't autosave.")
 The headers should be delimited by a line whose contents match the
 variable `mail-header-separator'.
 
-Legal values include `message-send-mail-with-mh' and
-`message-send-mail-with-sendmail', which is the default.")
+Legal values include `message-send-mail-with-sendmail' (the default),
+`message-send-mail-with-mh' and `message-send-mail-with-qmail'.")
 
 ;;;###autoload
 (defvar message-send-news-function 'message-send-news
@@ -235,6 +238,18 @@ using the \"poster\" value.  If it is the symbol `ask', query the user
 whether to ignore the \"poster\" value.  If it is the symbol `use',
 always use the value.")
 
+;; qmail-related stuff
+(defvar message-qmail-inject-program "/var/qmail/bin/qmail-inject"
+  "Location of the qmail-inject program.")
+
+(defvar message-qmail-inject-args nil
+  "Arguments passed to qmail-inject programs.
+This should be a list of strings, one string for each argument.
+
+For e.g., if you wish to set the envelope sender address so that bounces
+go to the right place or to deal with listserv's usage of that address, you
+might set this variable to '(\"-f\" \"you@some.where\").")
+
 (defvar gnus-post-method)
 (defvar gnus-select-method)
 ;;;###autoload
@@ -370,6 +385,9 @@ these lines.")
 The value should be an expression to test whether the problem will
 actually occur.")
 
+;;; Internal variables.
+;;; Well, not really internal.
+
 (defvar message-mode-syntax-table 
   (let ((table (copy-syntax-table text-mode-syntax-table)))
     (modify-syntax-entry ?% ". " table)
@@ -512,6 +530,10 @@ The cdr of ech entry is a function for applying the face to a region.")
        (point)
       (goto-char p))))
 
+(defmacro message-y-or-n-p (question show &rest text)
+  "Ask QUESTION, displaying the rest of the arguments in a temp. buffer if SHOW"
+  `(message-talkative-question 'y-or-n-p ,question ,show ,@text))
+
 ;; Delete the current line (and the next N lines.);
 (defmacro message-delete-line (&optional n)
   `(delete-region (progn (beginning-of-line) (point))
@@ -523,7 +545,7 @@ The cdr of ech entry is a function for applying the face to a region.")
   (let ((regexp (format "[%s]+" (or separator ",")))
        (beg 1)
        (first t)
-       quoted elems)
+       quoted elems paren)
     (save-excursion
       (message-set-work-buffer)
       (insert header)
@@ -535,11 +557,18 @@ The cdr of ech entry is a function for applying the face to a region.")
        (cond ((and (> (point) beg)
                    (or (eobp)
                        (and (looking-at regexp)
-                            (not quoted))))
+                            (not quoted)
+                            (not paren))))
               (push (buffer-substring beg (point)) elems)
               (setq beg (match-end 0)))
              ((= (following-char) ?\")
-              (setq quoted (not quoted)))))
+              (setq quoted (not quoted)))
+             ((and (= (following-char) ?\()
+                   (not quoted))
+              (setq paren t))
+             ((and (= (following-char) ?\))
+                   (not quoted))
+              (setq paren nil))))
       (nreverse elems))))
 
 (defun message-fetch-field (header)
@@ -1054,12 +1083,10 @@ name, rather than giving an automatic name."
             (name-default (concat "*message* " mail-trimmed-to))
             (name (if enter-string
                       (read-string "New buffer name: " name-default)
-                    name-default)))
-       (rename-buffer name t)
-       (setq buffer-auto-save-file-name
-             (format "%s%s"
-                     (file-name-as-directory message-autosave-directory)
-                     (file-name-nondirectory buffer-auto-save-file-name)))))))
+                    name-default))
+            (default-directory
+              (file-name-as-directory message-autosave-directory)))
+         (rename-buffer name t)))))
 
 (defun message-fill-yanked-message (&optional justifyp)
   "Fill the paragraphs of a message yanked into this one.
@@ -1087,7 +1114,19 @@ However, if `message-yank-prefix' is non-nil, insert that prefix on each line."
         (if (search-forward "\n\n" nil t)
             (1- (point))
           (point)))
-       (message-remove-header message-ignored-cited-headers t)))
+       (message-remove-header message-ignored-cited-headers t)
+       (goto-char (point-max))))
+    ;; Delete blank lines at the start of the buffer.
+    (while (and (point-min)
+               (eolp))
+      (message-delete-line))
+    ;; Delete blank lines at the end of the buffer.
+    (goto-char (point-max))
+    (unless (eolp)
+      (insert "\n"))
+    (while (and (zerop (forward-line -1))
+               (looking-at "$"))
+      (message-delete-line))
     ;; Do the indentation.
     (if (null message-yank-prefix)
        (indent-rigidly start (mark t) message-indentation-spaces)
@@ -1121,7 +1160,8 @@ prefix, and don't delete any headers."
       (unless modified
        (setq message-checksum (cons (message-checksum) (buffer-size)))))))
 
-(defun message-cite-original ()    
+(defun message-cite-original ()
+  "Cite function in the standard Message manner."
   (let ((start (point))
        (functions 
         (when message-indent-citation-function
@@ -1409,6 +1449,47 @@ the user from the mailer."
       (when (bufferp errbuf)
        (kill-buffer errbuf)))))
 
+(defun message-send-mail-with-qmail ()
+  "Pass the prepared message buffer to qmail-inject.
+Refer to the documentation for the variable `message-send-mail-function'
+to find out how to use this."
+  ;; replace the header delimiter with a blank line
+  (goto-char (point-min))
+  (re-search-forward
+   (concat "^" (regexp-quote mail-header-separator) "\n"))
+  (replace-match "\n")
+  ;; send the message
+  (case
+      (apply
+       'call-process-region 1 (point-max) message-qmail-inject-program
+       nil nil nil
+       ;; qmail-inject's default behaviour is to look for addresses on the
+       ;; command line; if there're none, it scans the headers.
+       ;; yes, it does The Right Thing w.r.t. Resent-To and it's kin.
+       ;;
+       ;; in general, ALL of qmail-inject's defaults are perfect for simply
+       ;; reading a formatted (i.e., at least a To: or Resent-To header)
+       ;; message from stdin.
+       ;;
+       ;; qmail also has the advantage of not having being raped by
+       ;; various vendors, so we don't have to allow for that, either --
+       ;; compare this with message-send-mail-with-sendmail and weep 
+       ;; for sendmail's lost innocence.
+       ;;
+       ;; all this is way cool coz it lets us keep the arguments entirely
+       ;; free for -inject-arguments -- a big win for the user and for us
+       ;; since we don't have to play that double-guessing game and the user
+       ;; gets full control (no gestapo'ish -f's, for instance). --sj
+       message-qmail-inject-args)
+    ;; qmail-inject doesn't say anything on it's stdout/stderr,
+    ;; we have to look at the retval instead
+    (0 nil)
+    (1   (error "qmail-inject reported permanent failure."))
+    (111 (error "qmail-inject reported transient failure."))
+    ;; should never happen
+    (t   (error "qmail-inject reported unknown failure."))))
+
+
 (defun message-send-mail-with-mh ()
   "Send the prepared message buffer with mh."
   (let ((mh-previous-window-config nil)
@@ -1416,10 +1497,17 @@ the user from the mailer."
               (concat (file-name-as-directory message-autosave-directory)
                       "msg."))))
     (setq buffer-file-name name)
-    (mh-send-letter)
-    (condition-case ()
-       (delete-file name)
-      (error nil))))
+    ;; MH wants to generate these headers itself.
+    (let ((headers message-deletable-headers))
+      (while headers
+       (goto-char (point-min)) 
+       ;;(message "Deleting header %s" (car headers)) (sit-for 5)
+       (and (re-search-forward 
+             (concat "^" (symbol-name (car headers)) ": *") nil t)
+            (message-delete-line))
+       (pop headers)))
+    ;; Pass it on to mh.
+    (mh-send-letter)))
 
 (defun message-send-news (&optional arg)
   (let ((tembuf (generate-new-buffer " *message temp*"))
@@ -1441,7 +1529,10 @@ the user from the mailer."
       ;; Let the user do all of the above.
       (run-hooks 'message-header-hook))
     (message-cleanup-headers)
-    (when (message-check-news-syntax)
+    (if (not (message-check-news-syntax))
+       (progn
+         (message "Posting nor performed")
+         nil)
       (unwind-protect
          (save-excursion
            (set-buffer tembuf)
@@ -1627,7 +1718,7 @@ the user from the mailer."
               (if (or
                    (not 
                     (string-match
-                     "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-.a-zA-Z0-9]+\\)*\\'"
+                     "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-+_&.a-zA-Z0-9]+\\)*\\'"
                      header))
                    (memq 
                     nil (mapcar 
@@ -1726,7 +1817,7 @@ the user from the mailer."
            (y-or-n-p
             (format
              "Your .sig is %d lines; it should be max 4.  Really post? "
-             (count-lines (point) (point-max))))
+             (1- (count-lines (point) (point-max)))))
          t))))))
 
 (defun message-check-element (type)
@@ -2192,7 +2283,8 @@ Headers already prepared in the buffer are not modified."
          (goto-char (point-max))
          (insert "Posted-To: " newsgroups "\n"))))
     (forward-line 1)
-    (insert message-courtesy-message)))
+    (when message-courtesy-message
+      (insert message-courtesy-message))))
     
 ;;;
 ;;; Setting up a message buffer
@@ -2435,11 +2527,7 @@ Headers already prepared in the buffer are not modified."
        (inhibit-point-motion-hooks t)
        mct never-mct gnus-warning)
     (save-restriction
-      (narrow-to-region
-       (goto-char (point-min))
-       (if (search-forward "\n\n" nil t)
-          (1- (point))
-        (point-max)))
+      (message-narrow-to-head)
       ;; Allow customizations to have their say.
       (if (not wide)
          ;; This is a regular reply.
@@ -2504,9 +2592,11 @@ Headers already prepared in the buffer are not modified."
                  (setq ccalist (delq (assoc (car (pop s)) s) ccalist)))))
            (setq follow-to (list (cons 'To (cdr (pop ccalist)))))
            (when ccalist
-             (push (cons 'Cc
-                         (mapconcat (lambda (addr) (cdr addr)) ccalist ", "))
-                   follow-to)))))
+             (let ((ccs (cons 'Cc (mapconcat 
+                                   (lambda (addr) (cdr addr)) ccalist ", "))))
+               (when (string-match "^ +" (cdr ccs))
+                 (setcdr ccs (substring (cdr ccs) (match-end 0))))
+             (push ccs follow-to))))))
       (widen))
 
     (message-pop-to-buffer (message-buffer-name
@@ -2527,11 +2617,14 @@ Headers already prepared in the buffer are not modified."
 
 ;;;###autoload
 (defun message-wide-reply (&optional to-address)
+  "Make a \"wide\" reply to the message in the current buffer."
   (interactive)
   (message-reply to-address t))
 
 ;;;###autoload
-(defun message-followup ()
+(defun message-followup (&optional to-newsgroups)
+  "Follow up to the message in the current buffer.
+If TO-NEWSGROUPS, use that as the new Newsgroups line."
   (interactive)
   (let ((cur (current-buffer))
        from subject date reply-to mct
@@ -2576,6 +2669,8 @@ Headers already prepared in the buffer are not modified."
     (message-setup
      `((Subject . ,subject)
        ,@(cond 
+         (to-newsgroups
+          (list (cons 'Newsgroups to-newsgroups)))
          (follow-to follow-to)
          ((and followup-to message-use-followup-to)
           (list
@@ -2615,8 +2710,9 @@ responses here are directed to other newsgroups."))
          (t
           `((Newsgroups . ,newsgroups))))
        ,@(and distribution (list (cons 'Distribution distribution)))
-       (References . ,(concat (or references "") (and references " ")
-                             (or message-id "")))
+       ,@(if (or references message-id)
+            `((References . ,(concat (or references "") (and references " ")
+                                     (or message-id "")))))
        ,@(when (and mct
                    (not (equal (downcase mct) "never")))
           (list (cons 'Cc (if (equal (downcase mct) "always")
@@ -2662,7 +2758,7 @@ responses here are directed to other newsgroups."))
                    (concat "Distribution: " distribution "\n")
                  "")
                mail-header-separator "\n"
-               "This is a cancel message from " from ".\n")
+               message-cancel-message)
        (message "Canceling your article...")
        (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me))
          (funcall message-send-news-function))
@@ -2730,7 +2826,8 @@ header line with the old Message-ID."
 Optional NEWS will use news to forward instead of mail."
   (interactive "P")
   (let ((cur (current-buffer))
-       (subject (message-make-forward-subject)))
+       (subject (message-make-forward-subject))
+       art-beg)
     (if news (message-news nil subject) (message-mail nil subject))
     ;; Put point where we want it before inserting the forwarded
     ;; message. 
@@ -2744,13 +2841,13 @@ Optional NEWS will use news to forward instead of mail."
     (narrow-to-region (point) (point))
     ;; Insert the separators and the forwarded buffer.
     (insert message-forward-start-separator)
+    (setq art-beg (point))
     (insert-buffer-substring cur)
     (goto-char (point-max))
     (insert message-forward-end-separator)
     (set-text-properties (point-min) (point-max) nil)
     ;; Remove all unwanted headers.
-    (goto-char (point-min))
-    (forward-line 1)
+    (goto-char art-beg)
     (narrow-to-region (point) (if (search-forward "\n\n" nil t)
                                  (1- (point))
                                (point)))
@@ -2986,10 +3083,6 @@ Do a `tab-to-tab-stop' if not in those headers."
 
 ;;; Help stuff.
 
-(defmacro message-y-or-n-p (question show &rest text)
-  "Ask QUESTION, displaying the rest of the arguments in a temp. buffer if SHOW"
-  `(message-talkative-question 'y-or-n-p ,question ,show ,@text))
-
 (defun message-talkative-question (ask question show &rest text)
   "Call FUNCTION with argument QUESTION, displaying the rest of the arguments in a temporary buffer if SHOW.  
 The following arguments may contain lists of values."