(require 'cl)
(defvar nix-group-important-group 3
"The subscription level of a group that is important to us.")
(defvar nix-group-unimportant-group 4
"The subscription level of a group that is not important to us.")
(defvar nix-group-important-mail-group 1
"The subscription level of a mail group that is important to us.")
(defvar nix-group-unimportant-mail-group 2
"The subscription level of a mail group that is not important to us.")
(defvar nix-gnus-conditions '(unread ticked important)
"A list of conditions that can apply to groups.
These are used to determine how to fontify the groups; see
`nix-gnus-condition-face-name-alist', `nix-gnus-base-face-plist',
`nix-gnus-face-replace-alist', and `nix-gnus-condition-code-ent-alist'.
Note that this list should consist solely of freely recombinable
properties (i.e. the properties should form a strict mathematical set);
if the list of properties you wish to check for is not freely
recombinable, you will probably not want to check for the non-freely-
recombinable elements using this mechanism.
Take care: A power set of faces and code to set them is constructed;
so having more than a few conditions becomes exceedingly slow very,
very fast.")
(defvar nix-gnus-condition-face-name-alist '((unread . "unread")
(ticked . "ticked")
(important . "important")
(t . "base"))
"An alist mapping from conditions to face names.
The complete name of a face is constructed from these names,
concatenated, with a prefix and suffix to signify their facehood.
The `t' entry is used if none of the others apply to a given face.
For the list of valid conditions, see `nix-gnus-conditions'.")
(defvar nix-gnus-condition-code-fragment-alist
'((unread . ((> unread 0) (= unread 0)))
(ticked . ((> ticked 0) (= ticked 0)))
(important . ((or (= level nix-group-important-group)
(= level nix-group-important-mail-group))
(or (= level nix-group-unimportant-group)
(= level nix-group-unimportant-mail-group)))))
"An alist mapping from conditions to code to test for them.
The syntax is ((condition . (IF-TRUE IF-FALSE)) ...)
The code should be suitable for insertion into the `gnus-group-highlight'
variable, and it should be combinable with an `and' with other code
fragments from this variable, in any order.
All valid conditions must be handled by this code, or
`nix-construct-gnus-group-highlight' will fail. For the list of valid
conditions, see `nix-gnus-conditions'.")
(defvar nix-gnus-base-face-plist '(:foreground "LightGrey")
"The `basic' face for group colours, as accepted by `set-face-attribute'.
This is for bog standard unimportant groups with nothing unread
and nothing ticked in them.")
(defvar nix-gnus-face-replace-alist
'(((unread) . (:foreground "White"))
((ticked) . (:slant italic))
((important) . (:weight bold))
((unread ticked) . (:foreground "White" :slant italic))
((unread important) . (:foreground "White" :weight bold))
((important ticked) . (:weight bold :slant italic))
((unread important ticked) . (:foreground "White" :weight bold :slant italic)))
"Things to replace in the `nix-gnus-base-face' when conditions are true.
This is an alist mapping conditions to a plist to merge with the
`nix-gnus-base-face-plist'. If a component is not specified, it is
assumed to be false.
For the list of valid conditions, see `nix-gnus-conditions'.")
(defun nix-construct-gnus-group-highlight ()
"Construct code for insertion into the `gnus-group-highlight', and return it.
The code constructed is dependent upon `nix-gnus-face-replace-alist', and
things referenced therefrom.
Also, create the appropriate faces for that insertion to work.
Iterate through all combinations of the `nix-gnus-conditions', generate faces
for them with names specified in the `nix-gnus-condition-face-name-alist' and
colours specified in the `nix-gnus-base-face-plist' and
`gnus-gnus-face-replace-alist',and build the code to enable these faces at
the appropriate times from the `nix-gnus-condition-code-fragment-alist'.
The code generated by this function will probably be quite large, but it
is hard to byte-compile all of it, as it is assembled from small pieces
and the resulting variable is not a Lisp form, but merely contains Lisp
forms."
(mapcar
#'(lambda (condition-set)
(let* ((face-plist
(append (cdr (assoc* condition-set nix-gnus-face-replace-alist
:test-not 'set-exclusive-or))
nix-gnus-base-face-plist))
(face-name
(intern
(concat "nix-group-"
(let ((partial-face-name
(mapconcat #'(lambda (single-face-condition)
(cdr (or (assq single-face-condition
nix-gnus-condition-face-name-alist))))
condition-set "-")))
(if (= (length partial-face-name) (length condition-set))
(cdr (assq t nix-gnus-condition-face-name-alist))
partial-face-name)))))
(face-code
(cons
(append '(and) (mapcar #'(lambda (potential-condition-and-code)
(if (memq (car potential-condition-and-code)
condition-set)
(cadr potential-condition-and-code)
(caddr potential-condition-and-code)))
nix-gnus-condition-code-fragment-alist))
face-name)))
(make-face face-name)
(apply 'set-face-attribute face-name nil face-plist)
face-code))
(append (power-set nix-gnus-conditions) '(nil))))
(mapc #'(lambda (face) (make-face face))
'(nix-group-unsubbed-face nix-group-zombie-face
nix-group-killed-face))
(set-face-attribute 'nix-group-unsubbed-face :foreground "Grey" :weight 'bold)
(set-face-attribute 'nix-group-zombie-face :foreground "DarkGrey")
(set-face-attribute 'nix-group-killed-face :foreground "DarkGrey" :strike-through t)
(setq gnus-group-highlight (nconc (nix-construct-gnus-group-highlight)
'(((and (>= level gnus-level-subscribed) (< level gnus-level-zombie)) . nix-group-unsubbed-face)
((and (>= level gnus-level-zombie)
(< level gnus-level-killed)) . nix-group-zombie-face)
((<= level gnus-level-killed) . nix-group-killed-face))))
(make-face 'gnus-x-face)
(set-face-background 'gnus-x-face (face-background 'default))
(set-face-foreground 'gnus-x-face "green")
(provide 'dot-gnus-colourization)