;;; Code:
(eval-when-compile (require 'cl))
+(eval-when-compile (require 'static))
(require 'gnus)
(require 'gnus-ems)
(require 'message)
(require 'gnus-art)
-(defcustom gnus-post-method nil
+(defcustom gnus-post-method 'current
"*Preferred method for posting USENET news.
If this variable is `current', Gnus will use the \"current\" select
method when posting. If it is nil (which is the default), Gnus will
-use the native posting method of the server.
+use the native select method when posting.
This method will not be used in mail groups and the like, only in
\"real\" newsgroups.
If not nil nor `native', the value must be a valid method as discussed
-in the documentation of `gnus-select-method'. It can also be a list of
-methods. If that is the case, the user will be queried for what select
+in the documentation of `gnus-select-method'. It can also be a list of
+methods. If that is the case, the user will be queried for what select
method to use when posting."
:group 'gnus-group-foreign
:type `(choice (const nil)
"*Alist of styles to use when posting.")
(defcustom gnus-group-posting-charset-alist
- '(("^no\\." iso-8859-1)
- (message-this-is-mail nil)
- (".*" iso-8859-1)
- (message-this-is-news iso-8859-1))
- "Alist of regexps (to match group names) and default charsets to be unencoded when posting."
- :type '(repeat (list (regexp :tag "Group")
- (symbol :tag "Charset")))
+ '(("^\\(no\\|fr\\|dk\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\|dk\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1))
+ (message-this-is-mail nil nil)
+ (message-this-is-news nil t))
+ "Alist of regexps and permitted unencoded charsets for posting.
+Each element of the alist has the form (TEST HEADER BODY-LIST), where
+TEST is either a regular expression matching the newsgroup header or a
+variable to query,
+HEADER is the charset which may be left unencoded in the header (nil
+means encode all charsets),
+BODY-LIST is a list of charsets which may be encoded using 8bit
+content-transfer encoding in the body, or one of the special values
+nil (always encode using quoted-printable) or t (always use 8bit).
+
+Note that any value other tha nil for HEADER infringes some RFCs, so
+use this option with care."
+ :type '(repeat (list :tag "Permitted unencoded charsets"
+ (choice :tag "Where"
+ (regexp :tag "Group")
+ (const :tag "Mail message" :value message-this-is-mail)
+ (const :tag "News article" :value message-this-is-news))
+ (choice :tag "Header"
+ (const :tag "None" nil)
+ (symbol :tag "Charset"))
+ (choice :tag "Body"
+ (const :tag "Any" :value t)
+ (const :tag "None" :value nil)
+ (repeat :tag "Charsets"
+ (symbol :tag "Charset")))))
:group 'gnus-charset)
;;; Internal variables.
"c" gnus-summary-cancel-article
"s" gnus-summary-supersede-article
"r" gnus-summary-reply
+ "y" gnus-summary-yank-message
"R" gnus-summary-reply-with-original
"w" gnus-summary-wide-reply
"W" gnus-summary-wide-reply-with-original
(set (make-local-variable 'gnus-message-group-art)
(cons ,group ,article))
(set (make-local-variable 'gnus-newsgroup-name) ,group)
- (set (make-local-variable 'message-posting-charset)
- (gnus-setup-posting-charset ,group))
(gnus-run-hooks 'gnus-message-setup-hook))
(gnus-add-buffer)
(gnus-configure-windows ,config t)
(funcall (car elem) group))
(and (symbolp (car elem))
(symbol-value (car elem))))
- (throw 'found (cadr elem))))))))
+ (throw 'found (cons (cadr elem) (caddr elem)))))))))
(defun gnus-inews-add-send-actions (winconf buffer article)
(make-local-hook 'message-sent-hook)
(set-buffer gnus-article-copy)
(delete-region (goto-char (point-min))
(or (search-forward "\n\n" nil t) (point-max)))
+ ;; Encode bitmap smileys to ordinary text.
+ (static-unless (featurep 'xemacs)
+ (when (featurep 'smiley-mule)
+ (smiley-encode-buffer)))
;; Insert the original article headers.
(insert-buffer-substring gnus-original-article-buffer beg end)
(article-decode-encoded-words)))
;; the default method.
((null group-method)
(or (and (null (eq gnus-post-method 'active)) gnus-post-method)
- gnus-select-method message-post-method))
+ gnus-select-method message-post-method))
;; We want the inverse of the default
((and arg (not (eq arg 0)))
(if (eq gnus-post-method 'active)
;; Override normal method.
((and (eq gnus-post-method 'current)
(not (eq (car group-method) 'nndraft))
+ (gnus-get-function group-method 'request-post t)
(not arg))
group-method)
((and gnus-post-method
(defun gnus-extended-version ()
"Stringified gnus version."
- (concat gnus-product-name "/" gnus-version-number " (based on "
- gnus-original-product-name " v" gnus-original-version-number ")"))
+ (concat gnus-product-name "/" gnus-version-number
+ " (based on "
+ gnus-original-product-name " v" gnus-original-version-number ")"
+ (if (zerop (string-to-number gnus-revision-number))
+ ""
+ (concat " (revision " gnus-revision-number ")"))
+ ))
(defun gnus-message-make-user-agent (&optional include-mime-info max-column)
"Return user-agent info.
(insert gnus-bug-message)
(goto-char (point-min)))
(message-pop-to-buffer "*Gnus Bug*")
- (message-setup
- `((To . ,gnus-maintainer) (Cc . ,semi-gnus-developers) (Subject . "")))
+ (message-setup `((To . ,gnus-maintainer) (Subject . "")))
(when gnus-bug-create-help-buffer
(push `(gnus-bug-kill-buffer) message-send-actions))
(goto-char (point-min))
(re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
(forward-line 1)
- (insert (gnus-version) "\n"
+ (insert gnus-product-name " " gnus-version-number
+ " (r" gnus-revision-number ") "
+ "based on " gnus-original-product-name " v"
+ gnus-original-version-number "\n"
(emacs-version) "\n")
(when (and (boundp 'nntp-server-type)
(stringp nntp-server-type))
(insert nntp-server-type))
(insert "\n\n\n\n\n")
- (save-excursion
- (set-buffer (gnus-get-buffer-create " *gnus environment info*"))
- (gnus-debug))
- (insert "<#part type=application/x-emacs-lisp buffer=\" *gnus environment info*\" disposition=inline description=\"User settings\"><#/part>")
+ (let (mime-content-types)
+ (mime-edit-insert-tag "text" "plain" "; type=emacs-lisp"))
+ (insert (with-temp-buffer
+ (gnus-debug)
+ (buffer-string)))
(goto-char (point-min))
(search-forward "Subject: " nil t)
(message "")))
(when (get-buffer "*Gnus Help Bug*")
(kill-buffer "*Gnus Help Bug*")))
+(defun gnus-summary-yank-message (buffer n)
+ "Yank the current article into a composed message."
+ (interactive
+ (list (completing-read "Buffer: " (mapcar 'list (message-buffers)) nil t)
+ current-prefix-arg))
+ (gnus-summary-iterate n
+ (let ((gnus-display-mime-function nil)
+ (gnus-inhibit-treatment t))
+ (gnus-summary-select-article))
+ (save-excursion
+ (set-buffer buffer)
+ (message-yank-buffer gnus-article-buffer))))
+
(defun gnus-debug ()
"Attempts 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."
(message-narrow-to-headers)
(let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
(coding-system-for-write 'raw-text)
+ (output-coding-system 'raw-text)
groups group method)
(when gcc
(message-remove-header "gcc")
(unless gnus-inhibit-posting-styles
(let ((group (or gnus-newsgroup-name ""))
(styles gnus-posting-styles)
- style match variable attribute value v styles results
+ style match variable attribute value v results
filep name address element)
;; If the group has a posting-style parameter, add it at the end with a
;; regexp matching everything, to be sure it takes precedence over all
;; Go through all styles and look for matches.
(dolist (style styles)
(setq match (pop style))
+ (goto-char (point-min))
(when (cond
((stringp match)
;; Regexp string match on the group name.
- (string-match match gnus-newsgroup-name))
+ (string-match match group))
+ ((eq match 'header)
+ (let ((header (message-fetch-field (pop style))))
+ (and header
+ (string-match (pop style) header))))
((or (symbolp match)
(gnus-functionp match))
(cond
filep nil)
(setq value
(cond
- ((eq (car attribute) :file)
+ ((eq (car attribute) ':file)
(setq filep t)
(cadr attribute))
((eq (car attribute) :value)
(setq element 'signature
filep t))
;; Get the contents of file elems.
- (when filep
+ (when (and filep v)
(setq v (with-temp-buffer
(insert-file-contents v)
(buffer-string))))
(setq results (delq (assoc element results) results))
- (push (cons element
- v) results))))
+ (push (cons element v) results))))
;; Now we have all the styles, so we insert them.
(setq name (assq 'name results)
address (assq 'address results))
(when (cdr result)
(add-hook 'message-setup-hook
(cond
+ ((eq 'eval (car result))
+ 'ignore)
((eq 'body (car result))
`(lambda ()
(save-excursion
((eq 'signature (car result))
(set (make-local-variable 'message-signature) nil)
(set (make-local-variable 'message-signature-file) nil)
- `(lambda ()
- (save-excursion
- (let ((message-signature ,(cdr result)))
- (message-insert-signature)))))
+ (if (not (cdr result))
+ 'ignore
+ `(lambda ()
+ (save-excursion
+ (let ((message-signature ,(cdr result)))
+ (when message-signature
+ (message-insert-signature)))))))
(t
(let ((header
(if (symbolp (car result))
(when (or name address)
(add-hook 'message-setup-hook
`(lambda ()
- (let ((user-full-name ,(or (cdr name) user-full-name))
+ (set (make-local-variable 'user-mail-address)
+ ,(or (cdr address) user-mail-address))
+ (let ((user-full-name ,(or (cdr name) (user-full-name)))
(user-mail-address
,(or (cdr address) user-mail-address)))
(save-excursion
))))
+;;; @ for MIME view mode
+;;;
+
+(defun gnus-following-method (buf)
+ (gnus-setup-message 'reply-yank
+ (set-buffer buf)
+ (if (message-news-p)
+ (message-followup)
+ (message-reply nil 'wide))
+ (let ((message-reply-buffer buf))
+ (message-yank-original))
+ (message-goto-body))
+ (kill-buffer buf))
+
+
;;; Allow redefinition of functions.
(gnus-ems-redefine)
projects / elisp / gnus.git- / blobdiff