From: Wes Hardaker <wes@hardakers.net>
Subject: new gnus-highlight
Date: Fri, 06 Feb 2004 11:18:06 -0800 [thread overview]
Message-ID: <sdn07waufl.fsf@wes.hardakers.net> (raw)
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
next reply other threads:[~2004-02-06 19:18 UTC|newest]
Thread overview: 9+ messages / expand[flat|nested] mbox.gz Atom feed top
2004-02-06 19:18 Wes Hardaker [this message]
2004-02-29 18:00 ` Marcus Frings
2004-03-01 17:18 ` Wes Hardaker
2004-03-01 18:23 ` Marcus Frings
2004-03-01 18:27 ` Wes Hardaker
2004-03-01 19:44 ` Reiner Steib
2004-03-16 1:17 ` Wes Hardaker
2004-03-16 2:02 ` Jesper Harder
2004-03-16 21:10 ` Wes Hardaker
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=sdn07waufl.fsf@wes.hardakers.net \
--to=wes@hardakers.net \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).