(require 'gnus)
(require 'sendmail)
+(require 'gnus-ems)
+(require 'rmail)
(defvar gnus-organization-file "/usr/lib/news/organization"
"*Local news organization file.")
Message-ID. Organization, Lines and X-Newsreader are optional. If
you want Gnus not to insert some header, remove it from this list.")
-(defvar gnus-deletable-headers '(Message-ID)
+(defvar gnus-deletable-headers '(Message-ID Date)
"*Headers to be deleted if they already exists.")
(defvar gnus-check-before-posting
(defun gnus-group-mail ()
"Start composing a mail."
(interactive)
- (funcall gnus-mail-other-window-method)
- (gnus-configure-windows 'group-mail)
- (run-hooks 'gnus-mail-hook))
+ (funcall gnus-mail-other-window-method))
(defun gnus-group-post-news ()
"Post an article."
(if yank-articles (gnus-summary-goto-subject (car yank-articles)))
(save-window-excursion
(gnus-summary-select-article))
- (let ((headers gnus-current-headers)
+ (let ((headers (gnus-get-header-by-number (gnus-summary-article-number)))
(gnus-newsgroup-name gnus-newsgroup-name))
;; Check Followup-To: poster.
(set-buffer gnus-article-buffer)
(interactive)
(gnus-set-global-variables)
(gnus-summary-select-article t)
- (if (or
+ (if (not
(string-equal
(downcase (mail-strip-quoted-names
(header-from gnus-current-headers)))
(funcall gnus-followup-to-function group))))
gnus-use-followup-to))
(if post
- (gnus-configure-windows 'post)
+ (gnus-configure-windows 'post 'force)
(if yank
- (gnus-configure-windows 'followup-yank)
- (gnus-configure-windows 'followup)))
+ (gnus-configure-windows 'followup-yank 'force)
+ (gnus-configure-windows 'followup 'force)))
(gnus-overload-functions)
(make-local-variable 'gnus-article-reply)
(make-local-variable 'gnus-article-check-size)
(let* ((case-fold-search nil)
(server-running (gnus-server-opened gnus-select-method))
(reply gnus-article-reply)
- error)
+ error post-result)
(save-excursion
;; Connect to default NNTP server if necessary.
;; Suggested by yuki@flab.fujitsu.junet.
;; Send to server.
(gnus-message 5 "Posting to USENET...")
- (if (funcall gnus-inews-article-function use-group-method)
- (progn
- (gnus-message 5 "Posting to USENET...done")
- (if (gnus-buffer-exists-p (car-safe reply))
- (progn
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-summary-mark-article-as-replied
- (cdr reply))))))
- ;; We cannot signal an error.
- (setq error t)
- (ding) (gnus-message 1 "Article rejected: %s"
- (gnus-status-message gnus-select-method)))
- (set-buffer-modified-p nil))
+ (setq post-result (funcall gnus-inews-article-function use-group-method))
+ (cond ((eq post-result 'illegal)
+ (setq error t)
+ (ding))
+ (post-result
+ (gnus-message 5 "Posting to USENET...done")
+ (if (gnus-buffer-exists-p (car-safe reply))
+ (progn
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-mark-article-as-replied
+ (cdr reply)))))
+ (set-buffer-modified-p nil))
+ (t
+ ;; We cannot signal an error.
+ (setq error t)
+ (ding)
+ (gnus-message 1 "Article rejected: %s"
+ (gnus-status-message gnus-select-method)))))
;; If NNTP server is opened by gnus-inews-news, close it by myself.
(or server-running
(gnus-close-server (gnus-find-method-for-group gnus-newsgroup-name)))
(let ((conf gnus-prev-winconf))
- (bury-buffer)
- ;; Restore last window configuration.
- (and conf (not error) (set-window-configuration conf)))))
+ (if (not error)
+ (progn
+ (bury-buffer)
+ ;; Restore last window configuration.
+ (and conf (set-window-configuration conf)))))))
(defun gnus-inews-check-post ()
"Check whether the post looks ok."
(goto-char (point-min))
(narrow-to-region
(point)
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$")))
+ (progn
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ (match-beginning 0)))
(goto-char (point-min))
(and
;; Check for commands in Subject.
- (or (gnus-check-before-posting 'subject-cmsg)
- (save-excursion
- (if (string-match "^cmsg " (mail-fetch-field "subject"))
- (gnus-y-or-n-p
- "The control code \"cmsg \" is in the subject. Really post? ")
- t)))
+ (or
+ (gnus-check-before-posting 'subject-cmsg)
+ (save-excursion
+ (if (string-match "^cmsg " (mail-fetch-field "subject"))
+ (gnus-y-or-n-p
+ "The control code \"cmsg \" is in the subject. Really post? ")
+ t)))
;; Check for multiple identical headers.
(or (gnus-check-before-posting 'multiple-headers)
(save-excursion
(let (found)
- (while (and (not found) (re-search-forward "^[^ \t:]+: " nil t))
+ (while (and (not found) (re-search-forward "^[^ \t:]+: "
+ nil t))
(save-excursion
(or (re-search-forward
(concat "^" (setq found
(save-excursion
(let* ((case-fold-search t)
(from (mail-fetch-field "from")))
- (or (not from)
- (and (string-match "@" from)
- (string-match "@[^\\.]*\\." from))
- (gnus-yes-or-no-p
- (format "The From looks strange: \"%s\". Really post? "
- from)))))))))
+ (cond
+ ((not from)
+ (gnus-yes-or-no-p "There is no From line. Really post? "))
+ ((not (string-match "@[^\\.]*\\." from))
+ (gnus-yes-or-no-p
+ (format
+ "The address looks strange: \"%s\". Really post? " from)))
+ ((string-match "(.*).*(.*)" from)
+ (gnus-yes-or-no-p
+ (format
+ "The From header looks strange: \"%s\". Really post? "
+ from)))
+ (t t)))))
+ )))
;; Check for long lines.
(or (gnus-check-before-posting 'long-lines)
(save-excursion
t))
;; Use the (size . checksum) variable to see whether the
;; article is empty or has only quoted text.
- (or (gnus-check-before-posting 'new-text)
- (if (and (= (buffer-size) (car gnus-article-check-size))
- (= (gnus-article-checksum) (cdr gnus-article-check-size)))
- (gnus-yes-or-no-p
- "It looks like there's no new text in your article. Really post? ")
- t))
+ (or
+ (gnus-check-before-posting 'new-text)
+ (if (and (= (buffer-size) (car gnus-article-check-size))
+ (= (gnus-article-checksum) (cdr gnus-article-check-size)))
+ (gnus-yes-or-no-p
+ "It looks like there's no new text in your article. Really post? ")
+ t))
;; Check the length of the signature.
(or (gnus-check-before-posting 'signature)
(progn
;; Returns non-nil if this type is not to be checked.
(defun gnus-check-before-posting (type)
- (or (not gnus-check-before-posting)
- (if (listp gnus-check-before-posting)
- (memq type gnus-check-before-posting)
- t)))
+ (not
+ (or (not gnus-check-before-posting)
+ (if (listp gnus-check-before-posting)
+ (memq type gnus-check-before-posting)
+ t))))
(defun gnus-cancel-news ()
"Cancel an article you posted."
(if (and gnus-article-check-size
(not (gnus-inews-check-post)))
;; Aber nein!
- ()
+ 'illegal
;; Looks ok, so we do the nasty.
(save-excursion
(set-buffer tmpbuf)
(goto-char (point-min))
(and (re-search-forward
(concat "^" (symbol-name (car headers)) ": *") nil t)
- (get-text-property (1+ (match-end 0)) 'gnus-deletable)
+ (get-text-property (1+ (match-beginning 0)) 'gnus-deletable)
(gnus-delete-line))
(setq headers (cdr headers))))
- ;; Insert new Sender if the From is strange.
- (let ((from (mail-fetch-field "from")))
- (if (and from (not (string= (downcase from) (downcase From))))
- (progn
- (goto-char (point-min))
- (and (re-search-forward "^Sender:" nil t)
- (delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point))))
- (insert "Sender: " From "\n"))))
;; If there are References, and no "Re: ", then the thread has
;; changed name. See Son-of-1036.
(if (and (mail-fetch-field "references")
(read-from-minibuffer
(format "Empty header for %s; enter value: " header))))
;; Finally insert the header.
- (if (bolp)
- (save-excursion
- (goto-char (point-max))
- (insert (symbol-name header) ": ")
- ;; Add the deletable property to the headers that require it.
- (if (memq header gnus-deletable-headers)
- (add-text-properties
- (point) (progn (insert value) (point))
- '(gnus-deletable t) (current-buffer))
- (insert value))
- (insert "\n"))
- (replace-match value t t))))
- (setq headers (cdr headers)))))
+ (save-excursion
+ (if (bolp)
+ (progn
+ (goto-char (point-max))
+ (insert (symbol-name header) ": " value "\n")
+ (forward-line -1))
+ (replace-match value t t))
+ ;; Add the deletable property to the headers that require it.
+ (and (memq header gnus-deletable-headers)
+ (progn (beginning-of-line) (looking-at "[^:]+: "))
+ (add-text-properties
+ (point) (match-end 0)
+ '(gnus-deletable t face italic) (current-buffer))))))
+ (setq headers (cdr headers)))
+ ;; Insert new Sender if the From is strange.
+ (let ((from (mail-fetch-field "from")))
+ (if (and from (not (string=
+ (downcase (car (gnus-extract-address-components
+ from)))
+ (downcase (gnus-inews-real-user-address)))))
+ (progn
+ (goto-char (point-min))
+ (and (re-search-forward "^Sender:" nil t)
+ (delete-region (progn (beginning-of-line) (point))
+ (progn (forward-line 1) (point))))
+ (insert "Sender: " (gnus-inews-real-user-address) "\n"))))))
+
(defun gnus-inews-insert-signature ()
"Insert a signature file.
()
;; Delete any previous signatures.
(if (search-backward "\n-- \n" nil t)
- (delete-region (1+ (point)) (point-max)))
- (insert "\n-- \n")
+ (delete-region (point) (point-max)))
+ (or (eolp) (insert "\n"))
+ (insert "-- \n")
(if (file-exists-p signature)
(insert-file-contents signature)
(insert signature))
(goto-char (point-max))
(or (bolp) (insert "\n"))))))))
+;; Written by "Mr. Per Persson" <pp@solace.mh.se>.
+(defun gnus-inews-insert-mime-headers ()
+ (let ((mail-header-separator ""))
+ (or (mail-position-on-field "Mime-Version")
+ (insert "1.0")
+ (cond ((save-excursion
+ (beginning-of-buffer)
+ (re-search-forward "[\200-\377]" nil t))
+ (or (mail-position-on-field "Content-Type")
+ (insert "text/plain; charset=ISO-8859-1"))
+ (or (mail-position-on-field "Content-Transfer-Encoding")
+ (insert "8bit")))
+ (t (or (mail-position-on-field "Content-Type")
+ (insert "text/plain; charset=US-ASCII"))
+ (or (mail-position-on-field "Content-Transfer-Encoding")
+ (insert "7bit")))))))
+
(defun gnus-inews-do-fcc ()
"Process FCC: fields in current article buffer.
Unless the first character of the field is `|', the article is saved
(t
(concat " (" full-name ")")))))))
+(defun gnus-inews-real-user-address ()
+ "Return the \"real\" user address.
+This function tries to ignore all user modifications, and
+give as trustworthy answer as possible."
+ (concat (user-login-name) "@" (gnus-inews-full-address)))
+
(defun gnus-inews-login-name ()
"Return login name."
(or gnus-user-login-name (getenv "LOGNAME") (user-login-name)))
(concat "^" (regexp-quote mail-header-separator) "$"))
(forward-line 1)
(if (not yank)
- (gnus-configure-windows 'reply)
+ (gnus-configure-windows 'reply 'force)
(let ((last (point))
end)
(if (not (listp yank))
(goto-char end)
(setq yank (cdr yank))))
(goto-char last))
- (gnus-configure-windows 'reply-yank))
+ (gnus-configure-windows 'reply-yank 'force))
(run-hooks 'gnus-mail-hook)))))
(defun gnus-mail-yank-original ()
(gnus-forward-insert-buffer forward-buffer)
(goto-char (point-min))
(re-search-forward "^To: " nil t)
- (gnus-configure-windows 'mail-forward)
+ (gnus-configure-windows 'mail-forward 'force)
;; You have a chance to arrange the message.
(run-hooks 'gnus-mail-forward-hook)
(run-hooks 'gnus-mail-hook)))
(local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf)
- (run-hooks 'gnus-mail-hook)))
+ (run-hooks 'gnus-mail-hook)
+ (gnus-configure-windows 'summary-mail 'force)))
(defun gnus-article-mail (yank)
"Send a reply to the address near point.
(interactive)
(let ((winconf (current-window-configuration)))
(delete-other-windows)
- (switch-to-buffer "*Gnus Bug Help*")
+ (switch-to-buffer "*Gnus Help Bug*")
(erase-buffer)
(insert gnus-bug-message)
(goto-char (point-min))
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf)
(use-local-map (copy-keymap mail-mode-map))
- (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
+ (local-set-key "\C-c\C-c" 'gnus-bug-mail-send-and-exit)
(goto-char (point-min))
(re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
(forward-line 1)
(goto-char (- b 3)))
(message "")))
+(defun gnus-bug-mail-send-and-exit ()
+ "Send the bug message and exit."
+ (interactive)
+ (and (get-buffer "*Gnus Help Bug*")
+ (kill-buffer "*Gnus Help Bug*"))
+ (gnus-mail-send-and-exit))
+
(defun gnus-debug ()
"Attemps to go through the Gnus source file and report what variables have been changed.
The source file has to be in the Emacs load path."
(interactive)
(let ((files '("gnus.el" "gnus-msg.el" "gnus-score.el"))
file dirs expr olist)
+ (message "Please wait while we snoop your variables...")
+ (sit-for 0)
(save-excursion
(set-buffer (get-buffer-create " *gnus bug info*"))
(buffer-disable-undo (current-buffer))
- (message "Please wait while we snoop your variables...")
- (sit-for 0)
(while files
(erase-buffer)
(setq dirs load-path)
(setq dirs nil)
(insert-file-contents file)
(goto-char (point-min))
- (or (re-search-forward "^;;* Internal variables" nil t)
+ (or (re-search-forward "^;;* *Internal variables" nil t)
(error "Malformed sources in file %s" file))
(narrow-to-region (point-min) (point))
(goto-char (point-min))
(while (setq expr (condition-case ()
(read (current-buffer)) (error nil)))
- (and (eq (car expr) 'defvar)
- (stringp (nth 3 expr))
- (or (not (boundp (nth 1 expr)))
- (not (equal (eval (nth 2 expr))
- (symbol-value (nth 1 expr)))))
- (setq olist (cons (nth 1 expr) olist))))))
+ (condition-case ()
+ (and (eq (car expr) 'defvar)
+ (stringp (nth 3 expr))
+ (or (not (boundp (nth 1 expr)))
+ (not (equal (eval (nth 2 expr))
+ (symbol-value (nth 1 expr)))))
+ (setq olist (cons (nth 1 expr) olist)))
+ (error nil)))))
(setq files (cdr files)))
(kill-buffer (current-buffer)))
(insert "------------------- Environment follows -------------------\n\n")
(setq olist (cdr olist)))
(insert "\n\n")))
+(gnus-ems-redefine)
+
(provide 'gnus-msg)
;;; gnus-msg.el ends here
projects / gnus / blobdiff