new gnus-highlight

new gnus-highlight

[Wes Hardaker]

Recent changes to gnus broke the gnus-highlight.el file, so I don't
know if anyone was using it but you should use the attached copy
instead if you are...

Oh, except, um, I can't attach stuff.  So, um, I'll just append it
instead...

-- 
"In the bathtub of history the truth is harder to hold than the soap,
 and much more difficult to find."  -- Terry Pratchett


;;; simple highlighting by expression in the summary and article buffers

;; Copyright (C) 2003-2004 Free Software Foundation, Inc.

;; Author: Wes Hardaker

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;;; Variables:

(defgroup gnus-highlight nil
  "summary buffer highlighting configuration."
  :group 'gnus-summary)

(defcustom gnus-summary-highlight-expressions '()
  "Defines expressions which cause a line to be highlighted.

   This should be a assoc list full of EXPRESSIONs and HIGHLIGHTs, IE:

      '((EXPRESSION . HIGHLIGHT)
        (EXPRESSION . HIGHLIGHT)
        ...)

   Every element in the list will be evaluated for a potential match
   against the EXPRESSION.

   EXPRESSION should a regular expression in string format.  The
   highlighted region will be mapped to either the entire line or a
   particular region of the matched expression if () grouping is used.
   See the match keyword in HIGHLIGHT, below, for details.

   HIGHLIGHT is one of the following forms:

     - A color STRING, which is the equivelent to '(bg . STRING)

     - An association list with the following possible keys:

       sub: A sub-list to recursively process, the format of which is
       identical to the format of this variable.  This is usefully for
       putting stop clauses in a sub-list to pick between only 1 of a
       number of expression matches.  Note that other face data within
       this HIGHILIGHT expression is ignored when a sub clause is
       specified, although the stop clause is still honored.

       face: A face to apply to the region.  If not specified, an
       automatic face will be generated using the fg and bg tokens
       below (because the author hates defining faces by hand he made
       it easy to do in these definitions):

       bg: the background color for highlighting.

       fg: the foreground color for highlighting.       

       match: a integer field indicating which match position to use
       in a regexp that contains multiple () groupings.  Defaults to
       1.  note that if EXPRESSION contains no () groupings, the
       entire line will be highlighted.

       stop: Any value (including nil) assigned to stop will cause the
       processing of the current EXPRESSION/HIGHLIGHT pairs to stop
       after this one if it succeeds.  (note that the default is to
       contiune, and if this current processing is contained within a
       \"sub\"-clause then processing will finish within the
       \"sub\"-clause and return upward and finish the parent list
       (assuming it didn't contain a stop clause as well).

   Example usage:

     (require 'gnus-highlight)
     (setq gnus-summary-highlight-expressions '(
       ; turns \"keyword\" green.
       (\".*\\\\(keyword\\\\)\"                          . \"green\")
       ; turns entire line yellow
       (\".*otherword\"                              . ((face . \"yellow\")))
       ; turns \"thirdex\" blue
       (\".*\\\\(choice1\\\\|choice2\\\\).*\\\\(thirdex\\\\)\" . ((face . \"blue\"
                                                       match . 2)))
     )
"
  :group 'gnus-highlight
  )

(defcustom gnus-article-highlight-expressions '()
  "Defines article highlight expressions to highlight headers with.
   See the help for gnus-summary-highlight-expressions for information
   about legal values for this variable.

   Example:

	(setq gnus-treat-highlight-headers 'head)
	(setq gnus-article-highlight-expressions
	      '(
                ; highlights \"keyword\" in any header.
		(\".*\\(keyword\\)\" . \"yellow\")
                ; highlights particular source addresses
		(\"From:.*\\(somewhere\\|elsewhere\\)\" . \"red2\")
		))

"
  :group 'gnus-highlight
  )

(defcustom gnus-treat-highlight-expressions
  (and (or window-system
	   (featurep 'xemacs)
	   (>= (string-to-number emacs-version) 21))
       t)
  "Emphasize text based on gnus-article-highlight-expressions.
Valid values are nil, t, `head'."
  :group 'gnus-highlight)
(put 'gnus-treat-highlight-expressions 'highlight t)

;;; Internal Variables:

(defvar gnus-highlight-face-map nil)

;;; Code:

(defun gnus-highlight-get-face (faceinfo)
  "Returns a face symbol given either the symbol itself or a text
  description of the background."
  (let (result
	(autoname "gnus-highlight-autoface"))
    (if (setq result (assq 'bg faceinfo))
	(setq autoname (concat autoname "-bg-" (cdr result))))
    (if (setq result (assq 'fg faceinfo))
	(setq autoname (concat autoname "-fg-" (cdr result))))
    (cond
     ((assq 'face faceinfo)
      (cdr (assq 'face faceinfo)) facedescr)
     ;; look up the face in the cache and use if present
     ((setq result (assoc autoname gnus-highlight-face-map))
      (cdr result))
;      (and (facep (cdr result)) (cdr result)))
     ;; create the face
     (t
      (let* ((symname (make-symbol autoname))
	     (facelist (list)))
;;; maybe in the future:
;	(if (setq result (assq 'facespec faceinfo))
;	    (setq facelist (cdr (assq 'facespec faceinfo))))
	(if (setq result (or (assq 'bg faceinfo) (assq 'background faceinfo)))
	    (setq facelist (append (list :background (cdr result)) facelist)))
	(if (setq result (or (assq 'fg faceinfo) (assq 'foreground faceinfo)))
	    (setq facelist (append (list :foreground (cdr result)) facelist)))
	(custom-declare-face symname
	  (list (list '((class color)) facelist ))
	  (concat "Auto-generated face for background: " autoname))
	(setq gnus-highlight-face-map
	      (push (cons autoname symname) gnus-highlight-face-map))
	symname)))))
;	(and (facep symname) symname))))))

(defun gnus-highlight-line-by-expression (&optional expressions)
  "Highlights a given line based on the gnus-summary-highlight-expressions value."
  (let ((exprs (or expressions gnus-summary-highlight-expressions))
	stop result)
    (mapcar (lambda (def)
	      (if (and (not stop)
		       (looking-at (car def)))
		  ;; apply the face
		  (let* ((facedata (if (stringp (cdr def))
				       (list (cons 'bg (cdr def)))
				       (cdr def)))
			 (start (or (match-beginning
				     (or (cdr (assq 'match facedata))
					 1))
				    (point-at-bol)))
			 (end (or (match-end
				   (or (cdr (assq 'match facedata)) 1))
				  (point-at-eol))))
		    (if (setq result (assq 'sub facedata))
			(gnus-highlight-line-by-expression (cdr result))
		      (gnus-put-text-property-excluding-characters-with-faces
		       start end 'face
		       (gnus-highlight-get-face facedata)))
		    (if (assq 'stop facedata)
			(setq stop t)))))
	  exprs)))

(defun gnus-article-highlight-by-expression ()
  "Highlight header lines as specified by gnus-article-highlight-expressions."
  (interactive)
  (save-excursion
    (set-buffer gnus-article-buffer)
    (save-restriction
      (let ((buffer-read-only nil)
	    (inhibit-point-motion-hooks t))
	(widen)
	(article-narrow-to-head)
	(goto-char (point-min))
	(while (progn
	  (gnus-highlight-line-by-expression gnus-article-highlight-expressions)
	  (equal (forward-line 1) 0)
	  ))))))

; (gnus-highlight-line-by-expression)  a  teststring
; (setq gnus-highlight-face-map nil)
; (assq 'x '((x . y)))

;; Initialization
(require 'gnus-art)
(add-hook 'gnus-summary-update-hook 'gnus-highlight-line-by-expression t)
(setq gnus-treatment-function-alist
      (append 
	      gnus-treatment-function-alist
	      '((gnus-treat-highlight-expressions
		gnus-article-highlight-by-expression))
))

(setq gnus-treat-highlight-expressions 'head)

(provide 'gnus-highlight)

;; gnus-highlight.el ends here

Re: new gnus-highlight

[Marcus Frings]

* Wes Hardaker <wes@hardakers.net> wrote:

> Recent changes to gnus broke the gnus-highlight.el file, so I don't
> know if anyone was using it but you should use the attached copy
> instead if you are...

Uhm, quite late for my response :-) but thanks for the update!

By the way, have you uploaded gnus-highlight.el anywhere to the web? I
tried to look at www.hardakers.net and gnu.emacs.sources but somehow I
wasn't able to locate it. Luckily a friend of mine provided me with an
old version of your package. Anyway, I'm using the new version now. :-)

Regards,
Marcus
-- 
Meister, Meister, gib mir Rosen, Rosen auf mein weißes Kleid,
stich die Blumen in den bloßen unberührten Mädchenleib!
'Diese Rosen kosten Blut', sprach der Meister sanft und gut,
'enden früh dein junges Leben, will Dir lieber keine geben.'

Re: new gnus-highlight

[Wes Hardaker]

>>>>> On Sun, 29 Feb 2004 19:00:52 +0100, Marcus Frings <iam-est-hora-surgere@despammed.com> said:

Marcus> Uhm, quite late for my response :-) but thanks for the update!

Marcus> By the way, have you uploaded gnus-highlight.el anywhere to the web? I
Marcus> tried to look at www.hardakers.net and gnu.emacs.sources but somehow I
Marcus> wasn't able to locate it. Luckily a friend of mine provided me with an
Marcus> old version of your package. Anyway, I'm using the new version
Marcus> now. :-)

No, it was supposed to go into No Gnus CVS once it was opened, but no
one has committed it yet (I don't have write access)

-- 
"In the bathtub of history the truth is harder to hold than the soap,
 and much more difficult to find."  -- Terry Pratchett

Re: new gnus-highlight

[Marcus Frings]

* Wes Hardaker <wes@hardakers.net> wrote:

[gnus-highlight.el]
> No, it was supposed to go into No Gnus CVS once it was opened, but no
> one has committed it yet (I don't have write access)

Well, it would be nice if you announce it here as soon it becomes an
official part of Gnus (or just drop me a mail) because then I can remove
it from my local package directory. By the way, I just love
gnus-highlight.el! :-)

Regards,
Marcus
-- 
Meister, Meister, gib mir Rosen, Rosen auf mein weißes Kleid,
stich die Blumen in den bloßen unberührten Mädchenleib!
'Diese Rosen kosten Blut', sprach der Meister sanft und gut,
'enden früh dein junges Leben, will Dir lieber keine geben.'

Re: new gnus-highlight

[Wes Hardaker]

>>>>> On Mon, 01 Mar 2004 19:23:13 +0100, Marcus Frings <iam-est-hora-surgere@despammed.com> said:

Marcus> Well, it would be nice if you announce it here as soon it
Marcus> becomes an official part of Gnus (or just drop me a mail)
Marcus> because then I can remove it from my local package
Marcus> directory. By the way, I just love gnus-highlight.el! :-)

Glad you like it.  I need to write up some documentation still, though
I tried to make the help descriptions of the configuration variables
fairly good.

-- 
"In the bathtub of history the truth is harder to hold than the soap,
 and much more difficult to find."  -- Terry Pratchett

Re: new gnus-highlight

[Reiner Steib]

On Mon, Mar 01 2004, Wes Hardaker wrote:

> No, it was supposed to go into No Gnus CVS once it was opened, but no
> one has committed it yet (I don't have write access)

Does <news:sdn07waufl.fsf@wes.hardakers.net> contain the most recent
version?

Some remarks and questions:

- `gnus-summary-highlight-expressions' and
  `gnus-article-highlight-expressions' are declared with defcustom,
  but cannot be customized (custom type declarations are missing).

- What is the reasoning behind this test in
  `gnus-treat-highlight-expressions'?

  (and (or window-system
	   (featurep 'xemacs)
	   (>= (string-to-number emacs-version) 21))
       t)

- Could you run `M-x checkdoc RET' on the file and fix the style
  errors?

- Opening and closing braces on a single line (as in your doc-strings
  and sometimes in the code) should be avoided:

	(setq gnus-treat-highlight-headers 'head)
	(setq gnus-article-highlight-expressions
	      '(
                ; highlights "keyword" in any header.
		(".*\(keyword\)" . "yellow")
                ; highlights particular source addresses
		("From:.*\(somewhere\|elsewhere\)" . "red2")
		))

   ... should better read ...

	(setq gnus-treat-highlight-headers 'head)
        (setq gnus-article-highlight-expressions
	      '(;; highlights "keyword" in any header.
		(".*\(keyword\)" . "yellow")
		;; highlights particular source addresses
		("From:.*\(somewhere\|elsewhere\)" . "red2")))

- Why do you use '() instead of nil?

- Shouldn't the initialization part (and *-treat-* variables) be moved
  to `gnus-art.el' (or`gnus-sum.el')?

- How about text for the manual (texi/gnus.texi) and the NEWS file
  (texi/gnus-news.texi)?

Bye, Reiner.
-- 
       ,,,
      (o o)
---ooO-(_)-Ooo--- PGP key available via WWW   http://rsteib.home.pages.de/

Re: new gnus-highlight

[Wes Hardaker]

[-- Attachment #1: Type: text/plain, Size: 2529 bytes --]


Sorry for the delay.

>>>>> On Mon, 01 Mar 2004 20:44:35 +0100, Reiner Steib <4.uce.03.r.s@nurfuerspam.de> said:

Reiner> Does <news:sdn07waufl.fsf@wes.hardakers.net> contain the most recent
Reiner> version?

Don't know.  But I'll attach a current below....

Reiner> - `gnus-summary-highlight-expressions' and
Reiner> `gnus-article-highlight-expressions' are declared with defcustom,
Reiner> but cannot be customized (custom type declarations are
Reiner> missing).

I wasn't sure what it should be a sub-part of when I originally
created it.  Thoughts?

Reiner> - What is the reasoning behind this test in
Reiner> `gnus-treat-highlight-expressions'?

Reiner> (and (or window-system
Reiner> (featurep 'xemacs)
Reiner> (>= (string-to-number emacs-version) 21))
Reiner> t)

I think copied that from somewhere else originally.  I can certainly
replace it with "t" if the code will work in all environments.

Reiner> - Could you run `M-x checkdoc RET' on the file and fix the style
Reiner> errors?

Done.

Reiner> - Opening and closing braces on a single line (as in your doc-strings
Reiner> and sometimes in the code) should be avoided:

Reiner> (setq gnus-treat-highlight-headers 'head)
Reiner> (setq gnus-article-highlight-expressions
Reiner> '(
Reiner> ; highlights "keyword" in any header.
Reiner> (".*\(keyword\)" . "yellow")

...

Reiner> ... should better read ...

Reiner> (setq gnus-treat-highlight-headers 'head)
Reiner> (setq gnus-article-highlight-expressions
Reiner> '(;; highlights "keyword" in any header.
Reiner> (".*\(keyword\)" . "yellow")

I disagree in documentation strings.  It provides a much better visual
separation (IMHO of course) for people trying to get a quick feel for
stuff.

Reiner> - Why do you use '() instead of nil?

Err...  Don't know.  Changed.  I think the original code I wrote
choked due to the way lists were being used.  mapcar is now used, and
this handles a nil ok.

Reiner> - Shouldn't the initialization part (and *-treat-* variables) be moved
Reiner> to `gnus-art.el' (or`gnus-sum.el')?

Yes, which is what I originally did but it wasn't going to be applied
to CVS till No Gnus and thus I pulled it back into the isolated file
so people could still use it without applying a patch.

Reiner> - How about text for the manual (texi/gnus.texi) and the NEWS file
Reiner> (texi/gnus-news.texi)?

As I mentioned in a previous note, I haven't written docs yet.

-- 
"In the bathtub of history the truth is harder to hold than the soap,
 and much more difficult to find."  -- Terry Pratchett

[-- Attachment #2: gnus-highlight.el --]
[-- Type: application/emacs-lisp, Size: 8189 bytes --]

Re: new gnus-highlight

[Jesper Harder]

Wes Hardaker <wes@hardakers.net> writes:

> Reiner> (and (or window-system
> Reiner> (featurep 'xemacs)
> Reiner> (>= (string-to-number emacs-version) 21))
> Reiner> t)
>
> I think copied that from somewhere else originally.  I can certainly
> replace it with "t" if the code will work in all environments.

The original purpose was probably to disable it for GNU Emacs 20.x in
a TTY.  All supported versions of Emacs have colours in a TTY now, so
I think you can replace it with t.

> (defun gnus-article-highlight-by-expression ()

Take a look at `gnus-with-article-headers', which should make it
possible to simplify this function quite a bit.

Re: new gnus-highlight

[Wes Hardaker]

>>>>> On Tue, 16 Mar 2004 03:02:49 +0100, Jesper Harder <harder@ifa.au.dk> said:

>> I think copied that from somewhere else originally.  I can certainly
>> replace it with "t" if the code will work in all environments.

Jesper> The original purpose was probably to disable it for GNU Emacs 20.x in
Jesper> a TTY.  All supported versions of Emacs have colours in a TTY now, so
Jesper> I think you can replace it with t.

Ok, easy enough.  Done in my copy.

>> (defun gnus-article-highlight-by-expression ()

Jesper> Take a look at `gnus-with-article-headers', which should make it
Jesper> possible to simplify this function quite a bit.

When I get the chance, I'll do so.
-- 
"In the bathtub of history the truth is harder to hold than the soap,
 and much more difficult to find."  -- Terry Pratchett