diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 0f78f2e..1369827 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1400,8 +1400,7 @@ For the \"inline\" alternatives, also see the variable (dolist (style (if styles (append gnus-posting-styles (list (cons ".*" styles))) gnus-posting-styles)) - (when (and (stringp (car style)) - (string-match (pop style) gnus-newsgroup-name)) + (when (gnus-posting-style-match style gnus-newsgroup-name) (when (setq tem (cadr (assq 'name style))) (setq user-full-name tem)) (when (setq tem (cadr (assq 'address style))) @@ -1823,7 +1822,7 @@ this is a reply." (with-current-buffer gnus-summary-buffer gnus-posting-styles) gnus-posting-styles)) - style match attribute value v results + style match attribute attributes 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 @@ -1838,46 +1837,12 @@ this is a reply." (setq styles (append styles (list (cons ".*" tmp-style))))))) ;; Go through all styles and look for matches. (dolist (style styles) - (setq match (pop style)) + (setq match (car style)) (goto-char (point-min)) - (when (cond - ((stringp match) - ;; Regexp string match on the group name. - (string-match match group)) - ((eq match 'header) - ;; Obsolete format of header match. - (and (gnus-buffer-live-p gnus-article-copy) - (with-current-buffer gnus-article-copy - (save-restriction - (nnheader-narrow-to-headers) - (let ((header (message-fetch-field (pop style)))) - (and header - (string-match (pop style) header))))))) - ((or (symbolp match) - (functionp match)) - (cond - ((functionp match) - ;; Function to be called. - (funcall match)) - ((boundp match) - ;; Variable to be checked. - (symbol-value match)))) - ((listp match) - (cond - ((eq (car match) 'header) - ;; New format of header match. - (and (gnus-buffer-live-p gnus-article-copy) - (with-current-buffer gnus-article-copy - (save-restriction - (nnheader-narrow-to-headers) - (let ((header (message-fetch-field (nth 1 match)))) - (and header - (string-match (nth 2 match) header))))))) - (t - ;; This is a form to be evalled. - (eval match))))) + (when (setq attributes (gnus-posting-style-match style + group)) ;; We have a match, so we set the variables. - (dolist (attribute style) + (dolist (attribute attributes) (setq element (pop attribute) filep nil) (setq value @@ -1990,6 +1955,46 @@ this is a reply." (insert "From: " (message-make-from) "\n")))) nil 'local))))) +(defun gnus-posting-style-match (style group) + (let ((match (pop style))) + (when (cond + ((stringp match) + ;; Regexp string match on the group name. + (string-match match group)) + ((eq match 'header) + ;; Obsolete format of header match. + (and (gnus-buffer-live-p gnus-article-copy) + (with-current-buffer gnus-article-copy + (save-restriction + (nnheader-narrow-to-headers) + (let ((header (message-fetch-field (pop style)))) + (and header + (string-match (pop style) header))))))) + ((or (symbolp match) + (functionp match)) + (cond + ((functionp match) + ;; Function to be called. + (funcall match)) + ((boundp match) + ;; Variable to be checked. + (symbol-value match)))) + ((listp match) + (cond + ((eq (car match) 'header) + ;; New format of header match. + (and (gnus-buffer-live-p gnus-article-copy) + (with-current-buffer gnus-article-copy + (save-restriction + (nnheader-narrow-to-headers) + (let ((header (message-fetch-field (nth 1 match)))) + (and header + (string-match (nth 2 match) header))))))) + (t + ;; This is a form to be evalled. + (eval match))))) + style))) + ;;; Allow redefinition of functions. (gnus-ems-redefine)