From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/56744 Path: main.gmane.org!not-for-mail From: Wes Hardaker Newsgroups: gmane.emacs.gnus.general Subject: Re: new gnus-highlight Date: Mon, 15 Mar 2004 17:17:53 -0800 Organization: Sparta Sender: ding-owner@lists.math.uh.edu Message-ID: References: NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: sea.gmane.org 1079399928 30835 80.91.224.253 (16 Mar 2004 01:18:48 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Tue, 16 Mar 2004 01:18:48 +0000 (UTC) Original-X-From: ding-owner+M5283@lists.math.uh.edu Tue Mar 16 02:18:43 2004 Return-path: Original-Received: from malifon.math.uh.edu ([129.7.128.13]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1B33EA-00043S-00 for ; Tue, 16 Mar 2004 02:18:43 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.math.uh.edu) by malifon.math.uh.edu with smtp (Exim 3.20 #1) id 1B33Dc-0001e5-00; Mon, 15 Mar 2004 19:18:08 -0600 Original-Received: from justine.libertine.org ([66.139.78.221] ident=postfix) by malifon.math.uh.edu with esmtp (Exim 3.20 #1) id 1B33DW-0001e0-00 for ding@lists.math.uh.edu; Mon, 15 Mar 2004 19:18:02 -0600 Original-Received: from wes.hardakers.net (adsl-66-127-127-227.dsl.scrm01.pacbell.net [66.127.127.227]) by justine.libertine.org (Postfix) with ESMTP id 142763A003C for ; Mon, 15 Mar 2004 19:18:01 -0600 (CST) Original-Received: by wes.hardakers.net (Postfix, from userid 274) id 0DD2C11E488; Mon, 15 Mar 2004 17:17:56 -0800 (PST) Original-To: ding@gnus.org Face: iVBORw0KGgoAAAANSUhEUgAAADAAAAAwBAMAAAClLOS0AAAAGFBMVEXotKX87e8eDA4GAQbQgmlzNycHAwizYkruzul2AAACaUlEQVR4nFXUTW/jIBAGYFI56jWutuq1S9b2dddW6dWtQFxbq4jzwq73Glmg+fv7DiT9QJGS+GEGhiER67TWEQ5CtOeh21ZcIIbmOPq5QvMZYlyV6u+/gsJLTSrGIL/CxEPxQuPAcP0JYlQsq3x5B3UJmUaEyB6yZ+CQ+pwXCzKsbXtbIhg4KtZypPz+AVGtlxH69c87qAqRY6Rc5QUmZMGeAj+TfVjjUwE1lflKys5JGXpM+V0hltqCJ0qL7Plkft4wRM6lxi5p3Wyy7O7fB8TgtdZivxy5rvAB6wSYhbA9vn+GOCaOEGJRPO2mHgk+q1Chyf0Up3AG0NjhOXI19ogEFziq6M+ZtN3kUZ13NW4qUCprC3CW668C06M5jihON1Vsjq8F1CPJB8LINNeQfscwxUEvAwM5Xghvsq2pBr3hnKhbDIrMS3cBRDx70uS9JW2dy667gM0AbZFFmyvn3GOBGB8wG9kppaSNz357LaCmUdtSny5LU9qeCrglvJmyH20TwkjnXQE0usscIWayCWZJ7OpZ4QbUVGRnhuTub3cMYRk99oSplDIfibzfn0FyXyk7z8XThuvC0P/dGCwee7O8aZJBmh0vPixy0NrYhDaR02aR3W0BbyT6h23OB5Hzybj+DOm5w6XCOZG13p5Oh/bursJVh9S+bBiFnPCDuntpcTH080AO+7GlW1i3bRphBM04dZ2dI6yMLjmGFqnIok/cB1YU8sJAACTeuHOd5+lumQHfDM6KyLqEm4aWkkcc1m4PqBewZxBZOg44lT+aJiexDteewb oiVhxAjSHxQwhiYJEdCR6tMN1/uckirDRNbsgAAAAASUVORK5CYII= In-Reply-To: (Reiner Steib's message of "Mon, 01 Mar 2004 20:44:35 +0100") User-Agent: Gnus/5.110002 (No Gnus v0.2) XEmacs/21.5 (celeriac, linux) Precedence: bulk Xref: main.gmane.org gmane.emacs.gnus.general:56744 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:56744 --=-=-= 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 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 --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=gnus-highlight.el Content-Transfer-Encoding: quoted-printable ;;; gnus-highlight.el --- blah ;; 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 nil "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 nil "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) (>=3D (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) "Return an automatically created face symbol. FACEINFO should be either a symbol or a textual description of a background color." (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) "Highlight a given line based on EXPRESSIONS. If EXPRESSIONS is not specified, the `gnus-summary-highlight-expressions' value will be used." (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-expressio= ns'." (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-h --=-=-=--