Re: setting face in gnus-user-format-function-x

[Michael Piotrowski <mxp@dynalabs.de>]

On 2011-06-23, pmlists@free.fr (Peter Münster) wrote:

> On Tue, Jun 07 2011, Michael Piotrowski wrote:
>
>> I just tried it.  Using `gnus-summary-update-hook' works.  For my
>> application--a different face for the date, depending on the age of the
>> message--I used the following two-step approach:
>> 
>> 1. I have a user format function that adds a non-face property, roughly
>>    something like this:
>> 
>>     (cond
>>      ((= message-day today)
>>       (put-text-property 0 10 'mxp-date 'today message-date))
>>      ((= message-day (1- today))
>>       (put-text-property 0 10 'mxp-date 'yesterday message-date))
>>      (t
>>       (put-text-property 0 10 'mxp-date 'older message-date)))
>> 
>> 2. I have a function that looks for this property (using
>>    `gnus-find-text-property-region') and sets the desired face.  This
>>    function is called by `gnus-summary-update-hook'.
>> 
>> Up to now, this approach seems to work nicely.  Maybe you can adapt it
>> to your needs.
>
> Unfortunately no success... :(
>
> This is, what I have now:
>
> (defun gnus-user-format-function-x (header)
>   (let ((my-string (format "%c" gnus-tmp-unread)))
>     (put-text-property 0 0 'my-test 'my-test my-string)
>     my-string))
>
> (defun my-summary-update ()
>   (dolist (region (gnus-find-text-property-region (point-min)
>                                                   (point-max)
>                                                   'my-test))
>     (destructuring-bind (start end function) region
>       (put-text-property start end 'face gnus-face-2)
>       (put-text-property start end 'gnus-face t))))
>
> (add-hook 'gnus-summary-update-hook 'my-summary-update)
>
> But the face is not set.

I found I needed to set `inhibit-read-only' to t; in any case, here are
my functions in full:

--8<---------------cut here---------------start------------->8---
(defun gnus-user-format-function-y (header)
  "Format the message date with different faces, depending on how old the
message is."
  (let* ((message-time (gnus-date-get-time (mail-header-date header)))
	 (message-date
	  (format-time-string "%Y-%m-%d" message-time))
	 (message-day
	  (string-to-number (format-time-string "%y%j" message-time)))
	 (today
	  (string-to-number (format-time-string "%y%j" (current-time)))))
    (cond
     ((= message-day today)
      (put-text-property 0 10 'mxp-date 'today message-date))
     ((= message-day (1- today))
      (put-text-property 0 10 'mxp-date 'yesterday message-date))
     (t
      (put-text-property 0 10 'mxp-date 'older message-date)))
    message-date))

(defun mxp-gnus-fontify-summary-line ()
  (save-excursion
    (let* ((inhibit-read-only t)
	   (date-region (gnus-find-text-property-region
			 (point-at-bol)
			 (point-at-eol) 'mxp-date))
	   (start (caar date-region))
	   (end   (cadar date-region)))
      (when (and start end (gnus-visual-p 'summary-highlight 'highlight))
	(cond
	 ((eq (caddar date-region) 'today)
	  (gnus-put-text-property start end 'face 'mxp-gnus-summary-today-face))
	 ((eq (caddar date-region) 'yesterday)
	  (gnus-put-text-property start end 'face
				  'mxp-gnus-summary-yesterday-face))
	 (t
	  (gnus-put-text-property start end 'face 'mxp-gnus-summary-older-face)))
	))))

(add-hook 'gnus-summary-update-hook 'mxp-gnus-fontify-summary-line)
--8<---------------cut here---------------end--------------->8---

Hope this helps

-- 
Dr.-Ing. Michael Piotrowski, M.A.                   <mxp@dynalabs.de>
Public key at <http://www.dynalabs.de/mxp/pubkey.txt> (ID 0x1614A044)