-;;; Posting styles.
-
-(defvar gnus-message-style-insertions nil)
-
-(defun gnus-configure-posting-styles ()
- "Configure posting styles according to `gnus-posting-styles'."
- (unless gnus-inhibit-posting-styles
- (let ((styles gnus-posting-styles)
- (gnus-newsgroup-name (or gnus-newsgroup-name ""))
- style match variable attribute value value-value)
- (make-local-variable 'gnus-message-style-insertions)
- ;; 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 (eq 'body (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
- ;; This is an ordinary variable.
- (set (make-local-variable variable) value-value)
- ;; This is either a body or a header to be inserted in the
- ;; message.
- (when value-value
- (let ((attr (car attribute)))
- (make-local-variable 'message-setup-hook)
- (if (eq 'body attr)
- (add-hook 'message-setup-hook
- `(lambda ()
- (save-excursion
- (message-goto-body)
- (insert ,value-value))))
- (add-hook 'message-setup-hook
- 'gnus-message-insert-stylings)
- (push (cons (if (stringp attr) attr
- (symbol-name attr))
- value-value)
- gnus-message-style-insertions))))))))))))
-
-(defun gnus-message-insert-stylings ()
- (let (val)
- (save-excursion
- (message-goto-eoh)
- (while (setq val (pop gnus-message-style-insertions))
- (when (cdr val)
- (insert (car val) ": " (cdr val) "\n"))
- (gnus-pull (car val) gnus-message-style-insertions)))))
-