*** pub/sgnus/lisp/gnus-msg.el Wed Mar 27 05:21:17 1996 --- sgnus/lisp/gnus-msg.el Wed Mar 27 06:41:25 1996 *************** *** 432,445 **** (current-buffer))) nil))))) - (defun gnus-article-checksum () - (let ((sum 0)) - (save-excursion - (while (not (eobp)) - (setq sum (logxor sum (following-char))) - (forward-char 1))) - sum)) - ;; Dummy to avoid byte-compile warning. --- 432,437 ---- *** pub/sgnus/lisp/gnus.el Wed Mar 27 05:21:23 1996 --- sgnus/lisp/gnus.el Wed Mar 27 06:57:40 1996 *************** *** 1688,1694 **** "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version "September Gnus v0.58" "Version number for this version of Gnus.") (defvar gnus-info-nodes --- 1688,1694 ---- "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version "September Gnus v0.59" "Version number for this version of Gnus.") (defvar gnus-info-nodes *** pub/sgnus/lisp/message.el Wed Mar 27 05:21:25 1996 --- sgnus/lisp/message.el Wed Mar 27 06:57:38 1996 *************** *** 61,67 **** '(subject-cmsg multiple-headers sendsys message-id from long-lines control-chars size new-text redirected-followup signature approved sender ! empty empty-headers) "In non-nil, message will attempt to run some checks on outgoing posts. If this variable is t, message will check everything it can. If it is a list, then those elements in that list will be checked.") --- 61,67 ---- '(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) "In non-nil, message will attempt to run some checks on outgoing posts. If this variable is t, message will check everything it can. If it is a list, then those elements in that list will be checked.") *************** *** 135,141 **** "*All headers that match this regexp will be deleted when resending a message.") ;;;###autoload ! (defvar message-ignored-cited-headers ":" "Delete these headers from the messages you yank.") ;; Useful to set in site-init.el --- 135,141 ---- "*All headers that match this regexp will be deleted when resending a message.") ;;;###autoload ! (defvar message-ignored-cited-headers "." "Delete these headers from the messages you yank.") ;; Useful to set in site-init.el *************** *** 273,278 **** --- 273,279 ---- (defvar message-newsreader nil) (defvar message-mailer nil) (defvar message-sent-message-via nil) + (defvar message-checksum nil) (defvar message-send-actions nil "A list of actions to be performed upon successful sending of a message.") *************** *** 429,435 **** (substring subject (match-end 0)) subject)) ! (defun message-remove-header (header &optional is-regexp first) "Remove HEADER in the narrowed buffer. If REGEXP, HEADER is a regular expression. If FIRST, only remove the first instance of the header. --- 430,436 ---- (substring subject (match-end 0)) subject)) ! (defun message-remove-header (header &optional is-regexp first reverse) "Remove HEADER in the narrowed buffer. If REGEXP, HEADER is a regular expression. If FIRST, only remove the first instance of the header. *************** *** 439,456 **** (number 0) (case-fold-search t) last) ! (while (and (re-search-forward regexp nil t) (not last)) ! (incf number) ! (when first ! (setq last t)) ! (delete-region ! (message-point-at-bol) ! ;; There might be a continuation header, so we have to search ! ;; until we find a new non-continuation line. ! (if (re-search-forward "^[^ \t]" nil t) ! (goto-char (match-beginning 0)) ! (point-max)))) number)) (defun message-narrow-to-headers () --- 440,467 ---- (number 0) (case-fold-search t) last) ! (while (and (not (eobp)) (not last)) ! (if (if reverse ! (not (looking-at regexp)) ! (looking-at regexp)) ! (progn ! (incf number) ! (when first ! (setq last t)) ! (delete-region ! (point) ! ;; There might be a continuation header, so we have to search ! ;; until we find a new non-continuation line. ! (progn ! (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)) ! (point-max)))) number)) (defun message-narrow-to-headers () *************** *** 476,489 **** (defun message-news-p () "Say whether the current buffer contains a news message." ! (mail-fetch-field "newsgroups")) (defun message-mail-p () "Say whether the current buffer contains a mail message." ! (or (mail-fetch-field "to") ! (mail-fetch-field "cc") ! (mail-fetch-field "bcc"))) ! ;;; --- 487,506 ---- (defun message-news-p () "Say whether the current buffer contains a news message." ! (save-excursion ! (save-restriction ! (message-narrow-to-headers) ! (mail-fetch-field "newsgroups")))) (defun message-mail-p () "Say whether the current buffer contains a mail message." ! (save-excursion ! (save-restriction ! (message-narrow-to-headers) ! (or (mail-fetch-field "to") ! (mail-fetch-field "cc") ! (mail-fetch-field "bcc"))))) ! ;;; *************** *** 564,573 **** --- 581,594 ---- "$\\|[ \t]*[-_][-_][-_]+$\\|" paragraph-separate)) (make-local-variable 'message-reply-headers) + (setq message-reply-headers nil) (make-local-variable 'message-newsreader) (make-local-variable 'message-mailer) (make-local-variable 'message-post-method) (make-local-variable 'message-sent-message-via) + (setq message-sent-message-via nil) + (make-local-variable 'message-checksum) + (setq message-checksum nil) (run-hooks 'text-mode-hook 'message-mode-hook)) *************** *** 795,801 **** (when message-indent-citation-function (if (listp message-indent-citation-function) message-indent-citation-function ! (list message-indent-citation-function))))) ;; If the original message is in another window in the same frame, ;; delete that window to save screen space. ;; t means don't alter other frames. --- 816,823 ---- (when message-indent-citation-function (if (listp message-indent-citation-function) message-indent-citation-function ! (list message-indent-citation-function)))) ! (modified (buffer-modified-p))) ;; If the original message is in another window in the same frame, ;; delete that window to save screen space. ;; t means don't alter other frames. *************** *** 818,824 **** (goto-char (prog1 (mark t) (set-marker (mark-marker) (point) (current-buffer)))) (unless (bolp) ! (insert ?\n))))) (defun message-insert-citation-line () "Function that inserts a simple citation line." --- 840,848 ---- (goto-char (prog1 (mark t) (set-marker (mark-marker) (point) (current-buffer)))) (unless (bolp) ! (insert ?\n)) ! (unless modified ! (setq message-checksum (message-checksum)))))) (defun message-insert-citation-line () "Function that inserts a simple citation line." *************** *** 919,925 **** (if (message-news-p) "main and news" "news") "news"))) (or (buffer-modified-p) ! (y-or-n-p "Message already sent; resend? "))) ;; Make it possible to undo the coming changes. (undo-boundary) (run-hooks 'message-send-hook) --- 943,949 ---- (if (message-news-p) "main and news" "news") "news"))) (or (buffer-modified-p) ! (y-or-n-p "No changes in the buffer; really send? "))) ;; Make it possible to undo the coming changes. (undo-boundary) (run-hooks 'message-send-hook) *************** *** 1052,1082 **** (message-generate-headers message-required-news-headers) ;; Let the user do all of the above. (run-hooks 'message-header-hook)) ! ;; Insert the proper mail headers. ! (unwind-protect ! (save-excursion ! (set-buffer tembuf) ! (buffer-disable-undo (current-buffer)) ! (erase-buffer) ! (insert-buffer-substring messbuf) ! (goto-char (point-max)) ! ;; require one newline at the end. ! (or (= (preceding-char) ?\n) ! (insert ?\n)) ! (let ((case-fold-search t)) ! ;; Remove the delimeter. ! (goto-char (point-min)) ! (re-search-forward ! (concat "^" (regexp-quote message-header-separator) "\n")) ! (replace-match "\n") ! (backward-char 1)) ! (require (car method)) ! (funcall (intern (format "%s-open-server" (car method))) ! (cadr method) (cddr method)) ! (funcall (intern (format "%s-request-post" ! (car method))))) ! (kill-buffer tembuf)) ! (push 'news message-sent-message-via))) ;;; ;;; Header generation & syntax checking. --- 1076,1106 ---- (message-generate-headers message-required-news-headers) ;; Let the user do all of the above. (run-hooks 'message-header-hook)) ! (when (message-check-news-syntax) ! (unwind-protect ! (save-excursion ! (set-buffer tembuf) ! (buffer-disable-undo (current-buffer)) ! (erase-buffer) ! (insert-buffer-substring messbuf) ! (goto-char (point-max)) ! ;; require one newline at the end. ! (or (= (preceding-char) ?\n) ! (insert ?\n)) ! (let ((case-fold-search t)) ! ;; Remove the delimeter. ! (goto-char (point-min)) ! (re-search-forward ! (concat "^" (regexp-quote message-header-separator) "\n")) ! (replace-match "\n") ! (backward-char 1)) ! (require (car method)) ! (funcall (intern (format "%s-open-server" (car method))) ! (cadr method) (cddr method)) ! (funcall (intern (format "%s-request-post" ! (car method))))) ! (kill-buffer tembuf)) ! (push 'news message-sent-message-via)))) ;;; ;;; Header generation & syntax checking. *************** *** 1152,1158 **** (if (re-search-forward "^Approved:" nil t) (y-or-n-p "The article contains an Approved header. Really post? ") ! t)))))) ;; Check for long lines. (or (message-check-element 'long-lines) (save-excursion --- 1176,1226 ---- (if (re-search-forward "^Approved:" nil t) (y-or-n-p "The article contains an Approved header. Really post? ") ! t))) ! ;; Check the Message-Id header. ! (or (message-check-element 'message-id) ! (save-excursion ! (let* ((case-fold-search t) ! (message-id (mail-fetch-field "message-id"))) ! (or (not message-id) ! (and (string-match "@" message-id) ! (string-match "@[^\\.]*\\." message-id)) ! (y-or-n-p ! (format ! "The Message-ID looks strange: \"%s\". Really post? " ! message-id)))))) ! ;; Check the Subject header. ! (or ! (message-check-element 'subject) ! (save-excursion ! (let* ((case-fold-search t) ! (subject (mail-fetch-field "subject"))) ! (or ! (and subject ! (not (string-match "\\`[ \t]*\\'" subject))) ! (progn ! (message ! "The subject field is empty or missing. Posting is denied.") ! nil))))) ! ;; Check the From header. ! (or (message-check-element 'from) ! (save-excursion ! (let* ((case-fold-search t) ! (from (mail-fetch-field "from"))) ! (cond ! ((not from) ! (message "There is no From line. Posting is denied.") ! nil) ! ((not (string-match "@[^\\.]*\\." from)) ! (message ! "Denied posting -- the From looks strange: \"%s\"." from) ! nil) ! ((string-match "(.*).*(.*)" from) ! (message ! "Denied posting -- the From header looks strange: \"%s\"." ! from) ! nil) ! (t t)))))))) ;; Check for long lines. (or (message-check-element 'long-lines) (save-excursion *************** *** 1191,1196 **** --- 1259,1270 ---- (format "The article is %d octets long. Really post? " (buffer-size))) t)) + ;; Check whether any new text has been added. + (or (message-check-element 'new-text) + (not message-checksum) + (not (eq (message-checksum) message-checksum)) + (y-or-n-p + "It looks like no new text has been added. Really post? ")) ;; Check the length of the signature. (or (message-check-element 'signature) (progn *************** *** 1212,1217 **** --- 1286,1300 ---- (memq type message-syntax-checks) t)))) + (defun message-checksum () + "Return a \"checksum\" for the current buffer." + (let ((sum 0)) + (save-excursion + (while (not (eobp)) + (setq sum (logxor sum (following-char))) + (forward-char 1))) + sum)) + (defun message-do-fcc () "Process Fcc headers in the current buffer." (let ((case-fold-search t) *************** *** 1530,1539 **** (goto-char (point-min)) (setq elem (pop headers)) (if (consp elem) ! (setq header (car elem)) (setq header elem)) (when (or (not (re-search-forward ! (concat "^" (downcase (symbol-name header)) ":") nil t)) (progn ;; The header was found. We insert a space after the ;; colon, if there is none. --- 1613,1625 ---- (goto-char (point-min)) (setq elem (pop headers)) (if (consp elem) ! (if (eq (car elem) 'optional) ! (setq header (cdr elem)) ! (setq header (car elem))) (setq header elem)) (when (or (not (re-search-forward ! (concat "^" (downcase (symbol-name header)) ":") ! nil t)) (progn ;; The header was found. We insert a space after the ;; colon, if there is none. *************** *** 1593,1599 **** (when (and from (not (message-check-element 'sender)) (not (string= ! (downcase (cadr (mail-extract-address-components from))) (downcase secure-sender))) (or (null sender) (not --- 1679,1686 ---- (when (and from (not (message-check-element 'sender)) (not (string= ! (downcase ! (cadr (mail-extract-address-components from))) (downcase secure-sender))) (or (null sender) (not *************** *** 1632,1638 **** ": " (if (consp value) (car value) value) "\n") ! (fill-region-as-paragraph begin (1- (point))))) (defun sendmail-synch-aliases () (let ((modtime (nth 5 (file-attributes message-personal-alias-file)))) --- 1719,1725 ---- ": " (if (consp value) (car value) value) "\n") ! (fill-region-as-paragraph begin (point)))) (defun sendmail-synch-aliases () (let ((modtime (nth 5 (file-attributes message-personal-alias-file)))) *************** *** 1714,1720 **** (run-hooks 'message-header-setup-hook)) (set-buffer-modified-p nil) (run-hooks 'message-setup-hook) ! (message-position-point)) (defun message-set-auto-save-file-name () "Associate the message buffer with a file in the drafts directory." --- 1801,1808 ---- (run-hooks 'message-header-setup-hook)) (set-buffer-modified-p nil) (run-hooks 'message-setup-hook) ! (message-position-point) ! (undo-boundary)) (defun message-set-auto-save-file-name () "Associate the message buffer with a file in the drafts directory." *************** *** 2047,2053 **** (1- (point)) (point))) (goto-char (point-min)) ! (message-remove-header message-included-forward-headers t) (widen) (message-position-point))) --- 2135,2141 ---- (1- (point)) (point))) (goto-char (point-min)) ! (message-remove-header message-included-forward-headers t nil t) (widen) (message-position-point))) *** pub/sgnus/lisp/ChangeLog Wed Mar 27 05:21:32 1996 --- sgnus/lisp/ChangeLog Wed Mar 27 06:57:41 1996 *************** *** 1,4 **** --- 1,18 ---- + Wed Mar 27 05:06:16 1996 Lars Magne Ingebrigtsen + + * message.el (message-remove-header): Allow reverse removal. + (message-news-p): Narrow to headers first. + (message-checksum): New function. + (message-check-news-syntax): Check for new text. + (message-check-news-syntax): Do more checking. + (message-check-news-syntax): Deny posting of articles with empty + Subject lines or mangled From headers. + (message-generate-headers): Didn't treat optional headers + properly. + Tue Mar 26 05:15:15 1996 Lars Magne Ingebrigtsen + + * gnus.el: September Gnus v0.58 is released. * gnus-cache.el (gnus-cache-retrieve-headers): Would bug out on empty groups.