X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmessage.el;h=99e645d38abac670b799b7b3a7e8f3e242afd41c;hb=refs%2Ftags%2Ft-gnus-6_10_070-00;hp=9a6917899e1cd74360c4e9872a9f212dc703e392;hpb=688636e75e02be0a1c319f546ec388ed9ec10a85;p=elisp%2Fgnus.git- diff --git a/lisp/message.el b/lisp/message.el index 9a69178..99e645d 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -202,7 +202,8 @@ Don't touch this variable unless you really know what you're doing. Checks include subject-cmsg multiple-headers sendsys message-id from long-lines control-chars size new-text redirected-followup signature approved sender empty empty-headers message-id from subject -shorten-followup-to existing-newsgroups buffer-file-name unchanged." +shorten-followup-to existing-newsgroups buffer-file-name unchanged +newsgroups." :group 'message-news) (defcustom message-required-news-headers @@ -604,7 +605,7 @@ The function `message-supersede' runs this hook." :group 'message-various :type 'hook) -(defcustom message-header-hook '(eword-encode-header) +(defcustom message-header-hook '((lambda () (eword-encode-header t))) "Hook run in a message mode buffer narrowed to the headers." :group 'message-various :type 'hook) @@ -1047,7 +1048,9 @@ The cdr of ech entry is a function for applying the face to a region.") (defvar message-draft-coding-system (cond ((not (fboundp 'find-coding-system)) nil) - ((find-coding-system 'emacs-mule) 'emacs-mule) + ((find-coding-system 'emacs-mule) + (if (string-match "nt\\|windows" system-configuration) + 'emacs-mule-dos 'emacs-mule)) ((find-coding-system 'escape-quoted) 'escape-quoted) ((find-coding-system 'no-conversion) 'no-conversion) (t nil)) @@ -1330,11 +1333,14 @@ Return the number of headers removed." ;; There might be a continuation header, so we have to search ;; until we find a new non-continuation line. (progn - (while (and (zerop (forward-line 1)) - (memq (char-after) '(?\t ?\ )))) - (point)))) - (while (and (zerop (forward-line 1)) - (memq (char-after) '(?\t ?\ )))))) + (forward-line 1) + (if (re-search-forward "^[^ \t]" nil t) + (goto-char (match-beginning 0)) + (point-max))))) + (forward-line 1) + (if (re-search-forward "^[^ \t]" nil t) + (goto-char (match-beginning 0)) + (goto-char (point-max))))) number)) (defun message-remove-first-header (header) @@ -1409,9 +1415,11 @@ Point is left at the beginning of the narrowed-to region." (defun message-next-header () "Go to the beginning of the next header." - (while (and (zerop (forward-line 1)) - (memq (char-after) '(?\t ?\ )))) - (not (eobp))) + (beginning-of-line) + (or (eobp) (forward-char 1)) + (not (if (re-search-forward "^[^ \t]" nil t) + (beginning-of-line) + (goto-char (point-max))))) (defun message-sort-headers-1 () "Sort the buffer as headers using `message-rank' text props." @@ -1979,7 +1987,7 @@ Numeric argument means justify as well." (goto-char (point-min)) (search-forward (concat "\n" mail-header-separator "\n") nil t) (let ((fill-prefix message-yank-prefix)) - (fill-individual-paragraphs (point) (point-max) justifyp t)))) + (fill-individual-paragraphs (point) (point-max) justifyp)))) (defun message-indent-citation () "Modify text just inserted from a message to be cited. @@ -2353,6 +2361,8 @@ the user from the mailer." (car elem)))) (setq success (funcall (caddr elem) arg))))) (setq sent t)))) + (unless sent + (error "No methods specified to send by")) (prog1 (when (and success sent) (message-do-fcc) @@ -2494,11 +2504,15 @@ This sub function is for exclusive use of `message-send-mail'." ;; Remove some headers. (save-restriction (message-narrow-to-headers) +;; We Semi-gnus people have no use for it. +;; ;; We (re)generate the Lines header. +;; (when (memq 'Lines message-required-mail-headers) +;; (message-generate-headers '(Lines))) ;; Remove some headers. (message-remove-header message-ignored-mail-headers t)) (goto-char (point-max)) ;; require one newline at the end. - (or (bolp) + (or (= (preceding-char) ?\n) (insert ?\n)) (when (and news (or (message-fetch-field "cc") @@ -2528,7 +2542,7 @@ This sub function is for exclusive use of `message-send-mail'." (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n")) (replace-match "\n") - (forward-char -1) + (backward-char 1) (setq delimline (point-marker)) (run-hooks 'message-send-mail-hook) ;; Insert an extra newline if we need it to work around @@ -2586,7 +2600,7 @@ to find out how to use this." (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n")) (replace-match "\n") - (forward-char -1) + (backward-char 1) (run-hooks 'message-send-mail-hook) ;; send the message (case @@ -2656,7 +2670,7 @@ to find out how to use this." (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n")) (replace-match "\n") - (forward-char -1) + (backward-char 1) (run-hooks 'message-send-mail-hook) (if recipients (let ((result (smtp-via-smtp user-mail-address @@ -2728,11 +2742,15 @@ This sub function is for exclusive use of `message-send-news'." ;; Remove some headers. (save-restriction (message-narrow-to-headers) +;; We Semi-gnus people have no use for it. +;; ;; We (re)generate the Lines header. +;; (when (memq 'Lines message-required-mail-headers) +;; (message-generate-headers '(Lines))) ;; Remove some headers. (message-remove-header message-ignored-news-headers t)) (goto-char (point-max)) ;; require one newline at the end. - (or (bolp) + (or (= (preceding-char) ?\n) (insert ?\n)) (setq result (message-maybe-split-and-send-news method))) (kill-buffer tembuf)) @@ -2752,7 +2770,7 @@ This sub function is for exclusive use of `message-send-news'." (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n")) (replace-match "\n") - (forward-char -1) + (backward-char 1) (run-hooks 'message-send-news-hook) (gnus-open-server method) (gnus-request-post method) @@ -2788,6 +2806,15 @@ This sub function is for exclusive use of `message-send-news'." (defun message-check-news-header-syntax () (and + ;; Check Newsgroups header. + (message-check 'newsgroyps + (let ((group (message-fetch-field "newsgroups"))) + (or + (and group + (not (string-match "\\`[ \t]*\\'" group))) + (ignore + (message + "The newsgroups field is empty or missing. Posting is denied."))))) ;; Check the Subject header. (message-check 'subject (let* ((case-fold-search t) @@ -2950,12 +2977,15 @@ This sub function is for exclusive use of `message-send-news'." (message-check 'from (let* ((case-fold-search t) (from (message-fetch-field "from")) - (ad (nth 1 (std11-extract-address-components from)))) + ad) (cond ((not from) (message "There is no From line. Posting is denied.") nil) - ((or (not (string-match "@[^\\.]*\\." ad)) ;larsi@ifi + ((or (not (string-match + "@[^\\.]*\\." + (setq ad (nth 1 (mail-extract-address-components + from))))) ;larsi@ifi (string-match "\\.\\." ad) ;larsi@ifi..uio (string-match "@\\." ad) ;larsi@.ifi.uio (string-match "\\.$" ad) ;larsi@ifi.uio. @@ -3275,7 +3305,7 @@ If NOW, use that time instead." (while (re-search-forward "[\t\n]+" nil t) (replace-match "" t t)) (unless (zerop (buffer-size)) - (buffer-substring (point-min) (point-max)))))) + (buffer-string))))) (defun message-make-lines () "Count the number of lines and return numeric string." @@ -3388,7 +3418,7 @@ If NOW, use that time instead." (replace-match "\\1(\\3)" t) (goto-char fullname-start))) (insert ")"))) - (buffer-substring (point-min) (point-max))))) + (buffer-string)))) (defun message-make-sender () "Return the \"real\" user address. @@ -3938,6 +3968,7 @@ OTHER-HEADERS is an alist of header/value pairs." from subject date to cc references message-id follow-to (inhibit-point-motion-hooks t) + (message-this-is-mail t) mct never-mct mft mrt gnus-warning in-reply-to) (save-restriction (message-narrow-to-head) @@ -4054,8 +4085,7 @@ that further discussion should take place only in " (while (re-search-forward "[ \t]+" nil t) (replace-match " " t t)) ;; Remove addresses that match `rmail-dont-reply-to-names'. - (insert (prog1 (rmail-dont-reply-to (buffer-substring - (point-min) (point-max))) + (insert (prog1 (rmail-dont-reply-to (buffer-string)) (erase-buffer))) (goto-char (point-min)) ;; Perhaps Mail-Copies-To: never removed the only address? @@ -4065,8 +4095,7 @@ that further discussion should take place only in " (mapcar (lambda (addr) (cons (mail-strip-quoted-names addr) addr)) - (message-tokenize-header (buffer-substring - (point-min) (point-max))))) + (message-tokenize-header (buffer-string)))) (let ((s ccalist)) (while s (setq ccalist (delq (assoc (car (pop s)) s) ccalist))))) @@ -4404,7 +4433,7 @@ header line with the old Message-ID." (while (re-search-backward "[ \t]+$" nil t) (replace-match "")) - (buffer-substring (point-min) (point-max)))) + (buffer-string))) ;;; Forwarding messages.