xemacs-beta: lisp/gnus/gnus-msg.el comparison

comparison lisp/gnus/gnus-msg.el @ 30:ec9a17fef872 r19-15b98

Import from CVS: tag r19-15b98

author	cvs
date	Mon, 13 Aug 2007 08:52:29 +0200
parents	8fc7fe29b841
children	e04119814345

comparison

equal deleted inserted replaced

-:7976500f47f9
+:ec9a17fef872
 (defvar gnus-outgoing-message-group nil
 "*All outgoing messages will be put in this group.
 If you want to store all your outgoing mail and articles in the group
 \"nnml:archive\", you set this variable to that value.  This variable
 can also be a list of group names.
 If you want to have greater control over what group to put each
 message in, you can set this variable to a function that checks the
 current newsgroup name and then returns a suitable group name (or list
 of names).")
 "*Regexp matching groups that are really mailing lists.
 This is useful when you're reading a mailing list that has been
 gatewayed to a newsgroup, and you want to followup to an article in
 the group.")
 (defvar gnus-sent-message-ids-file
 (nnheader-concat gnus-directory "Sent-Message-IDs")
 "File where Gnus saves a cache of sent message ids.")
 (defvar gnus-sent-message-ids-length 1000
 "The number of sent Message-IDs to save.")
 	 (gnus-inews-add-send-actions ,winconf ,buffer ,article)
 	 (setq gnus-message-buffer (current-buffer))
 	 (make-local-variable 'gnus-newsgroup-name)
 	 (run-hooks 'gnus-message-setup-hook))
 (gnus-configure-windows ,config t))))
 (defun gnus-inews-add-send-actions (winconf buffer article)
 (make-local-hook 'message-sent-hook)
 (gnus-add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t)
 (setq message-post-method
 	`(lambda (arg)
 (gnus-post-news 'post gnus-newsgroup-name))
 (defun gnus-summary-followup (yank &optional force-news)
 "Compose a followup to an article.
 If prefix argument YANK is non-nil, original article is yanked automatically."
 (interactive
 (list (and current-prefix-arg
 	      (gnus-summary-work-articles 1))))
 (gnus-set-global-variables)
 (when yank
 (gnus-summary-goto-subject (car yank)))
 (save-window-excursion
 (gnus-summary-select-article))
 (let ((headers (gnus-summary-article-header (gnus-summary-article-number)))
 	(gnus-newsgroup-name gnus-newsgroup-name))
 ;; Send a followup.
 (gnus-post-news nil gnus-newsgroup-name
 		    headers gnus-article-buffer
 		    yank nil force-news)))
 (defun gnus-summary-followup-with-original (n &optional force-news)
 "Compose a followup to an article and include the original article."
 (interactive "P")
 (gnus-summary-followup (gnus-summary-work-articles n) force-news))
 (defun gnus-summary-followup-to-mail (&optional arg)
 "Followup to the current mail message via news."
 (interactive
 (list (and current-prefix-arg
 	      (gnus-summary-work-articles 1))))
 (gnus-summary-followup arg t))
 (defun gnus-summary-followup-to-mail-with-original (&optional arg)
 "Followup to the current mail message via news."
 (gnus-setup-message (cond (yank 'reply-yank)
 			      (article-buffer 'reply)
 			      (t 'message))
 (let* ((group (or group gnus-newsgroup-name))
 	     (pgroup group)
 	     to-address to-group mailing-list to-list
 	     newsgroup-p)
 	(when group
 	  (setq to-address (gnus-group-find-parameter group 'to-address)
 		to-group (gnus-group-find-parameter group 'to-group)
 		to-list (gnus-group-find-parameter group 'to-list)
 		group (gnus-group-real-name group)))
 	(if (or (and to-group
 		     (gnus-news-group-p to-group))
 		newsgroup-p
 		force-news
 		(and (gnus-news-group-p
 		      (or pgroup gnus-newsgroup-name)
 		      (if header (mail-header-number header)
 			gnus-current-article))
 		     (not mailing-list)
 		     (not to-list)
 (defun gnus-post-method (arg group &optional silent)
 "Return the posting method based on GROUP and ARG.
 If SILENT, don't prompt the user."
 (let ((group-method (gnus-find-method-for-group group)))
 (cond
 ;; If the group-method is nil (which shouldn't happen) we use
 ;; the default method.
 ((null group-method)
 (or gnus-post-method gnus-select-method message-post-method))
 ;; We want this group's method.
 ((and arg (not (eq arg 0)))
 	  (when (or (gnus-method-option-p method 'post)
 		    (gnus-method-option-p method 'post-mail))
 	    (push method post-methods)))
 	;; Create a name-method alist.
 	(setq method-alist
 	      (mapcar
 	       (lambda (m)
 		 (list (concat (cadr m) " (" (symbol-name (car m)) ")") m))
 	       post-methods))
 	;; Query the user.
 	(cadr
 (defun gnus-inews-narrow-to-headers ()
 (widen)
 (narrow-to-region
 (goto-char (point-min))
 (or (and (re-search-forward
 	     (concat "^" (regexp-quote mail-header-separator) "$") nil t)
 	    (match-beginning 0))
 (point-max)))
 (goto-char (point-min)))
 	(unless gnus-inews-sent-ids
 	  (ignore-errors
 	    (load t t t)))
 	(if (member message-id gnus-inews-sent-ids)
 	    ;; Reject this message.
 	    (not (gnus-yes-or-no-p
 		  (format "Message %s already sent.  Send anyway? "
 			  message-id)))
 	  (push message-id gnus-inews-sent-ids)
 	  ;; Chop off the last Message-IDs.
 	  (when (setq end (nthcdr gnus-sent-message-ids-length
 				  gnus-inews-sent-ids))
 	    (setcdr end nil))
 	  (nnheader-temp-write gnus-sent-message-ids-file
 	    (gnus-prin1 `(setq gnus-inews-sent-ids ',gnus-inews-sent-ids)))
 	  nil)))))
 (t emacs-version))))
 ;; Written by "Mr. Per Persson" <pp@gnu.ai.mit.edu>.
 (defun gnus-inews-insert-mime-headers ()
 (goto-char (point-min))
 (let ((mail-header-separator
 	 (progn
 	   (goto-char (point-min))
 	   (if (and (search-forward (concat "\n" mail-header-separator "\n")
 				    nil t)
 		    (not (search-backward "\n\n" nil t)))
 	       mail-header-separator
 		 (or (mail-position-on-field "Content-Transfer-Encoding")
 		     (insert "7bit")))))))
 ;;;
 ;;; Gnus Mail Functions
 ;;;
 ;;; Mail reply commands of Gnus summary mode
 (defun gnus-summary-reply (&optional yank wide)
 "Start composing a reply mail to the current message.
 If prefix argument YANK is non-nil, the original article is yanked
 automatically."
 (interactive
 (list (and current-prefix-arg
 	      (gnus-summary-work-articles 1))))
 ;; Stripping headers should be specified with mail-yank-ignored-headers.
 (gnus-set-global-variables)
 (when yank
 (gnus-summary-goto-subject (car yank)))
 (let ((gnus-article-reply t))
 (gnus-setup-message (if yank 'reply-yank 'reply)
 (gnus-summary-select-article)
 (set-buffer (gnus-copy-article-buffer))
 (interactive "P")
 (gnus-summary-reply (gnus-summary-work-articles n) wide))
 (defun gnus-summary-wide-reply (&optional yank)
 "Start composing a wide reply mail to the current message.
 If prefix argument YANK is non-nil, the original article is yanked
 automatically."
 (interactive
 (list (and current-prefix-arg
 	      (gnus-summary-work-articles 1))))
 (gnus-summary-reply yank t))
 (defun gnus-summary-wide-reply-with-original (n)
 "Start composing a wide reply mail to the current message.
 "Forward the current article to a newsgroup.
 If FULL-HEADERS (the prefix), include full headers when forwarding."
 (interactive "P")
 (gnus-summary-mail-forward full-headers t))
 (defvar gnus-nastygram-message
 "The following article was inappropriately posted to %s.\n\n"
 "Format string to insert in nastygrams.
 The current group name will be inserted at \"%s\".")
 (defun gnus-summary-mail-nastygram (n)
 "Send a nastygram to the author of the current article."
 (interactive "P")
 (when (or gnus-expert-user
 	    (gnus-y-or-n-p
 	     "Really send a nastygram to the author of the current article? "))
 (let ((group gnus-newsgroup-name))
 (gnus-summary-reply-with-original n)
 (set-buffer gnus-message-buffer)
 (message-goto-body)
 (skip-chars-forward " ")
 (while (not (eobp))
 (setq beg (point))
 (skip-chars-forward "^,")
 (while (zerop
 	      (save-excursion
 		(save-restriction
 		  (let ((i 0))
 		    (narrow-to-region beg (point))
 		    (goto-char beg)
 		    (logand (progn
 (defun gnus-inews-add-to-address (group)
 (let ((to-address (mail-fetch-field "to")))
 (when (and to-address
 	       (gnus-alive-p))
 ;; This mail group doesn't have a `to-list', so we add one
 ;; here.  Magic!
 (gnus-group-add-parameter group (cons 'to-list to-address)))))
 (defun gnus-put-message ()
 "Put the current message in some group and return to Gnus."
 (interactive)
 (let ((reply gnus-article-reply)
 	(winconf gnus-prev-winconf)
 	(group gnus-newsgroup-name))
 (or (and group (not (gnus-group-read-only-p group)))
 	(setq group (read-string "Put in group: " nil
 				 (gnus-writable-groups))))
 (when (gnus-gethash group gnus-newsrc-hashtb)
 (error "No such group: %s" group))
 (when (get-buffer gnus-group-buffer)
 (when (gnus-buffer-exists-p (car-safe reply))
 	(set-buffer (car reply))
 	(and (cdr reply)
 	     (gnus-summary-mark-article-as-replied
 	      (cdr reply))))
 (when winconf
 	(set-window-configuration winconf)))))
 (defun gnus-article-mail (yank)
 "Send a reply to the address near point.
 If YANK is non-nil, include the original article."
 (interactive "P")
 (let ((address
 	 (buffer-substring
 	  (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
 	  (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
 (when address
 (message-reply address)
 (set-buffer gnus-original-article-buffer)
 (gnus-setup-message 'compose-bounce
 (let* ((references (mail-fetch-field "references"))
 	   (parent (and references (gnus-parent-id references))))
 (message-bounce)
 ;; If there are references, we fetch the article we answered to.
 (and fetch parent
 	   (gnus-summary-refer-article parent)
 	   (gnus-summary-show-all-headers)))))
 ;;; Gcc handling.
 ;; Do Gcc handling, which copied the message over to some group.
 (defun gnus-inews-do-gcc (&optional gcc)
+(interactive)
 (when (gnus-alive-p)
 (save-excursion
 (save-restriction
 	(message-narrow-to-headers)
 	(let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
 	    (message-remove-header "gcc")
 	    (widen)
 	    (setq groups (message-tokenize-header gcc " ,"))
 	    ;; Copy the article over to some group(s).
 	    (while (setq group (pop groups))
 	      (gnus-check-server
 	       (setq method
 		     (cond ((and (null (gnus-get-info group))
 				 (eq (car gnus-message-archive-method)
 				     (car
 				      (gnus-server-to-method
 				       (gnus-group-method group)))))
 			    ;; If the group doesn't exist, we assume
 			    ;; it's an archive group...
 			    gnus-message-archive-method)
 		(gnus-request-create-group group method))
 	      (save-excursion
 		(nnheader-set-temp-buffer " *acc*")
 		(insert-buffer-substring cur)
 		(goto-char (point-min))
 		(when (re-search-forward
 		       (concat "^" (regexp-quote mail-header-separator) "$")
 		       nil t)
 		  (replace-match "" t t ))
 		(unless (gnus-request-accept-article group method t)
 		  (gnus-message 1 "Couldn't store article in group %s: %s"
 				group (gnus-status-message method))
 		  (sit-for 2))
 		(kill-buffer (current-buffer))))))))))
 (defun gnus-inews-insert-gcc ()
 "Insert Gcc headers based on `gnus-outgoing-message-group'."
 (save-excursion
 (save-restriction
 (gnus-inews-narrow-to-headers)
 (let* ((group gnus-outgoing-message-group)
 	     (gcc (cond
 		   ((gnus-functionp group)
 		    (funcall group))
 		   ((or (stringp group) (list group))
 		    group))))
 	(when gcc
 (let* ((var gnus-message-archive-group)
 	 (group (or group gnus-newsgroup-name ""))
 	 result
 	 gcc-self-val
 	 (groups
 	  (cond
 	   ((null gnus-message-archive-method)
 	    ;; Ignore.
 	    nil)
 	   ((stringp var)
 	    ;; Just a single group.
 	   (t
 	    ;; An alist of regexps/functions/forms.
 	    (while (and var
 			(not
 			 (setq result
 			       (cond
 				((stringp (caar var))
 				 ;; Regexp.
 				 (when (string-match (caar var) group)
 				   (cdar var)))
 				((gnus-functionp (car var))
 	  (insert "Gcc: ")
 	  (if (and gnus-newsgroup-name
 		   (setq gcc-self-val
 			 (gnus-group-find-parameter
 			  gnus-newsgroup-name 'gcc-self)))
 	      (progn
 		(insert
 		 (if (stringp gcc-self-val)
 		     gcc-self-val
 		   group))
 		(if (not (eq gcc-self-val 'none))
 		    (beginning-of-line)
 		    (kill-line))))
 	    (while (setq name (pop groups))
 	      (insert (if (string-match ":" name)
 			  name
 			(gnus-group-prefixed-name
 			 name gnus-message-archive-method)))
 	      (when groups
 		(insert " ")))
 	    (insert "\n")))))))
 (defun gnus-summary-send-draft ()
 "Enter a mail/post buffer to edit and send the draft."
 (interactive)
 (gnus-set-global-variables)
 (let (buf)
 (if (not (setq buf (gnus-request-restore-buffer
 			(gnus-summary-article-number) gnus-newsgroup-name)))
 	(error "Couldn't restore the article")
 (switch-to-buffer buf)
 (when (eq major-mode 'news-reply-mode)
 	(local-set-key "\C-c\C-c" 'gnus-inews-news))
 (insert mail-header-separator)
 ;; Configure windows.
 (let ((gnus-draft-buffer (current-buffer)))
 	(gnus-configure-windows 'draft t)
 	(goto-char (point))))))
 (gnus-add-shutdown 'gnus-inews-close 'gnus)
 (defun gnus-inews-close ()
 (setq gnus-inews-sent-ids nil))
 ;;; Allow redefinition of functions.
 (gnus-ems-redefine)
 (provide 'gnus-msg)

Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-msg.el @ 30:ec9a17fef872 r19-15b98