X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmessage.el;h=63e37b59754db49f0bea642d02442a8677148b9c;hb=1866e8307d0f95ac3fa5fefaa6dba11852474ac7;hp=3e32a9a17d3c67e7283b2da33aba30ecda06908f;hpb=03551fdba7d496a4ff418d39f289057921bfe4e4;p=gnus diff --git a/lisp/message.el b/lisp/message.el index 3e32a9a17..63e37b597 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -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."