+;;; Posting styles.
+
+(defun gnus-configure-posting-styles ()
+ "Configure posting styles according to `gnus-posting-styles'."
+ (let ((styles gnus-posting-styles)
+ (gnus-newsgroup-name (or gnus-newsgroup-name ""))
+ style match variable attribute value value-value)
+ ;; Go through all styles and look for matches.
+ (while styles
+ (setq style (pop styles)
+ match (pop style))
+ (when (cond ((stringp match)
+ ;; Regexp string match on the group name.
+ (string-match match gnus-newsgroup-name))
+ ((or (symbolp match)
+ (gnus-functionp match))
+ (cond ((gnus-functionp match)
+ ;; Function to be called.
+ (funcall match))
+ ((boundp match)
+ ;; Variable to be checked.
+ (symbol-value match))))
+ ((listp match)
+ ;; This is a form to be evaled.
+ (eval match)))
+ ;; We have a match, so we set the variables.
+ (while style
+ (setq attribute (pop style)
+ value (cadr attribute)
+ variable nil)
+ ;; We find the variable that is to be modified.
+ (if (and (not (stringp (car attribute)))
+ (not (setq variable (cdr (assq (car attribute)
+ gnus-posting-style-alist)))))
+ (message "Couldn't find attribute %s" (car attribute))
+ ;; We get the value.
+ (setq value-value
+ (cond ((stringp value)
+ value)
+ ((or (symbolp value)
+ (gnus-functionp value))
+ (cond ((gnus-functionp value)
+ (funcall value))
+ ((boundp value)
+ (symbol-value value))))
+ ((listp value)
+ (eval value))))
+ (if variable
+ (progn
+ ;; This is an ordinary variable.
+ (make-local-variable variable)
+ (set variable value-value))
+ ;; This is a header to be added to the headers when
+ ;; posting.
+ (when value-value
+ (make-local-variable 'message-required-mail-headers)
+ (make-local-variable 'message-required-news-headers)
+ (push (cons (car attribute) value-value)
+ message-required-mail-headers)
+ (push (cons (car attribute) value-value)
+ message-required-news-headers)))))))))
+