Article View: gnu.emacs.gnus
Article #81496Re: wanted: highlighting, background fetch
From: Marc Andreessen
Date: Thu, 03 Dec 1992 01:57
Date: Thu, 03 Dec 1992 01:57
237 lines
9465 bytes
9465 bytes
In article <1992Dec2.154623.17417@MITL.COM> douglis@MITL.COM (Fred
Douglis) writes:
1) nn has a fantastic feature of auto-selection, which allows one to
distinguish between articles that *might* be interesting and those
that are *likely* to be interesting -- those with a certain substring
in the subject, or by a particular author. I would really like to use
epoch to highlight those articles that meet certain criteria, rather
than just auto-killing those that I don't want to see. Can do?
I hacked up this code a while back, as an experiment; no guarantees
that it even works, but it might...
(defvar gnus-readme-regexps '("epoch" " gl" "motif" "rs/6000" "irix" "ncsa")
"A list of regexps for which to search in a GNUS Subject buffer.")
(defvar gnus-readme-style motion::style
"A style with which to highlight matched regexps in a GNUS subject buffer.")
(defun gnus-this-column ()
"Return the column position of point in its current line."
(- (point) (save-excursion (beginning-of-line) (point))))
(defun gnus-short-line-p ()
"Return t if the current line is short, indicating that it's the
child of another entry in a GNUS Subject buffer, else return nil."
(> 111 (save-excursion (end-of-line) (gnus-this-column))))
(defun gnus-readme-doit ()
"Highlight some subject headers in a GNUS Subject buffer based on
regexps found in gnus-readme-regexps."
(let ((case-fold-search t))
(save-excursion
(dolist (x gnus-readme-regexps)
(goto-char (point-min))
(while (re-search-forward x (point-max) t)
;; If gnus-short-line-p returns nil then the line is
;; child to another subject and we don't want to highlight
;; this header, since it's out of sight.
(if (gnus-short-line-p)
(let ((beg (save-excursion (beginning-of-line) (point)))
(end (save-excursion (end-of-line) (point))))
;; Subject headers range from pos 28 to end of line.
(epoch::add-zone (+ beg 28) end gnus-readme-style))))))))
;; Author: Daniel LaLiberte (liberte@cs.uiuc.edu).
(defun gnus-postpend-unique-hook (hook-var hook-function)
"Postpend HOOK-VAR with HOOK-FUNCTION, if it is not already an element.
hook-var's value may be a single function or a list of functions."
(if (boundp hook-var)
(let ((value (symbol-value hook-var)))
(if (and (listp value) (not (eq (car value) 'lambda)))
(and (not (memq hook-function value))
(set hook-var (append value (list hook-function))))
(and (not (eq hook-function value))
(set hook-var (append value (list hook-function))))))
(set hook-var (list hook-function))))
(gnus-postpend-unique-hook 'gnus-Subject-prepare-hook 'gnus-readme-doit)
2) nn runs some background tasks to make starting news very fast.
gnus on the other hand takes quite a while to start up. I'd be happy
enough if I could just say "start gnus and let me know when you're
ready". Has anyone implemented a background gnus that will do not
only kills in background (as suggested in the info doc with emacs
-batch) but also news fetching, and which is done in the current emacs
rather than a batch process?
Here are some speedup fixes that have been posted more than once
before.... they help me quite a bit.
;; gnus-speedups|Felix Lee|flee@cs.psu.edu
;; |Simple performance enhancements for GNUS
;; |1992-05-18|1.2: stable||
;; This package contains two plug-compatible performance enhancements
;; for GNUS 3.13 and 3.14:
;; 1. A faster version of gnus-find-new-newsgroups, for making GNUS
;; start more quickly.
;; 2. Faster subject and date sorting in the *Subject* buffer.
;; This file must be loaded after "gnus.el". You can do this by
;; adding '(load "gnus-speedups") at the end of your local gnus
;; wrapper, or at the end of "gnus.el". Or you could just include
;; this file directly.
(require 'gnus)
;;;;;
;; 1. A faster version of gnus-find-new-newsgroups.
;; We reduce an O(N**2) process to O(N) by building a hash table for
;; the list of known newsgroups. (It's a little strange that GNUS
;; doesn't already have a hash table for this.)
(defun gnus-find-new-newsgroups ()
"Look for new newsgroups and return names.
`-n' option of options line in .newsrc file is recognized."
(let ( (group nil)
(new-groups nil)
(known-groups (gnus-make-hashtable)) )
;; Build a table of known newsgroups.
(mapcar
(function (lambda (group) (gnus-sethash (car group) t known-groups)))
gnus-killed-assoc)
(mapcar
(function (lambda (group) (gnus-sethash (car group) t known-groups)))
gnus-newsrc-assoc)
;; Compare the active file against what's known.
(mapatoms
(function
(lambda (sym)
(setq group (symbol-name sym))
;; Take into account the -n option.
(and (or (null gnus-newsrc-options-n-no)
(not (string-match gnus-newsrc-options-n-no group))
(and gnus-newsrc-options-n-yes
(string-match gnus-newsrc-options-n-yes group)))
(null (gnus-gethash group known-groups))
(setq new-groups (cons group new-groups)))
))
gnus-active-hashtb)
new-groups
))
;;;;;
;; 2. Faster subject and date sorting in the *Subject* buffer.
;; The basic idea is explained in 'gnus-keyed-sort.
;; Sample hook usage:
;; (setq gnus-Select-group-hook
;; (function
;; (lambda ()
;; (gnus-keyed-sort-headers
;; (function gnus-string-lessp)
;; (function (lambda (it) (gnus-simplify-subject it 're-only))))
;; )))
(defun gnus-keyed-sort (list compare extract)
"Sort LIST stably and return the sorted list. Does not modify LIST.
Arguments are (LIST COMPARE EXTRACT). Elements in the list are
compared as if the predicate were:
(COMPARE (EXTRACT a) (EXTRACT b))
but EXTRACT is run over each element of the list in a preprocessing
stage for efficiency. This reduces the number of EXTRACT calls from
O(N log N) to O(N).
Example: (gnus-keyed-sort load-path 'string< 'downcase)
"
(let ( (keyed-list
(mapcar
(function (lambda (it) (cons (funcall extract it) it)))
list)) )
(setq keyed-list
(sort keyed-list
(function
(lambda (a b) (funcall compare (car a) (car b))))))
(mapcar (function (lambda (it) (cdr it)))
keyed-list)
))
(defun gnus-keyed-sort-headers (compare extract)
"Sort current group's headers by COMPARE and EXTRACT. Sorting is
done as if the predicate were
(COMPARE (EXTRACT a) (EXTRACT b))
See 'gnus-keyed-sort for details.
Note: interrupting the sort leaves the headers unsorted.
"
(setq gnus-newsgroup-headers
(gnus-keyed-sort
gnus-newsgroup-headers
compare extract)))
(defun gnus-Subject-keyed-sort-subjects (compare extract &optional reverse)
"Sort and redisplay the *Subject* buffer by COMPARE and EXTRACT.
Calls 'gnus-keyed-sort-headers to do the sorting. Optional argument
REVERSE means to do an 'nreverse after sorting.
"
(let ( (current (gnus-Subject-article-number)) )
(gnus-keyed-sort-headers compare extract)
(if reverse
(setq gnus-newsgroup-headers (nreverse gnus-newsgroup-headers)))
(gnus-Subject-prepare)
(gnus-Subject-goto-subject current)
))
;; XXX It should be 'gnus-sort-fold-case, not 'case-fold-search
(defun gnus-Subject-sort-by-subject (reverse)
"Sort *Subject* buffer by subject alphabetically. Argument REVERSE
means reverse order. \"Re:\"s are ignored. If 'case-fold-search, then
case of letters will be ignored.
"
(interactive "P")
;; The main complication here is we try to speed up the sort process
;; by hoisting conditions outside the sort.
(gnus-Subject-keyed-sort-subjects
'string<
(if case-fold-search
(function
(lambda (it)
(downcase (gnus-simplify-subject (nntp-header-subject it) 're-only))))
(function
(lambda (it)
(gnus-simplify-subject (nntp-header-subject it) 're-only)))
)
reverse)
)
;; For backward compatibility with GNUS 3.13
(if (not (fboundp 'gnus-sortable-date))
(fset 'gnus-sortable-date 'gnus-comparable-date))
(defun gnus-Subject-sort-by-date (reverse)
"Sort *Subject* buffer by posted date. Argument REVERSE means
reverse order."
(interactive "P")
(gnus-Subject-keyed-sort-subjects
'string<
(function
(lambda (it)
(gnus-sortable-date (nntp-header-date it))))
reverse)
)
Cheers,
Marc
--
Marc Andreessen
Software Development Group
National Center for Supercomputing Applications
marca@ncsa.uiuc.edu
Technical Details
Message-ID:
<MARCA.92Dec2205711@wintermute.ncsa.uiuc.edu>Path:
arc1-ca.pugleaf.net!sparky!uunet!europa.asd.contel.com!emory!wupost!uwm.edu!ux1.cso.uiuc.edu!news.cso.uiuc.edu!128.174.5.61!marcaReferences:
<1992Dec2.154623.17417@MITL.COM>Show Full Headers
Complete Article Headers
X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: 1016f0,5e800b0580cd5128 X-Google-Attributes: gid1016f0,public X-Google-ArrivalTime: 1992-12-02 19:22:14 PST Newsgroups: gnu.emacs.gnus Path: arc1-ca.pugleaf.net!sparky!uunet!europa.asd.contel.com!emory!wupost!uwm.edu!ux1.cso.uiuc.edu!news.cso.uiuc.edu!128.174.5.61!marca From: marca@ncsa.uiuc.edu (Marc Andreessen) Subject: Re: wanted: highlighting, background fetch References: <1992Dec2.154623.17417@MITL.COM> Message-ID: <MARCA.92Dec2205711@wintermute.ncsa.uiuc.edu> Sender: usenet@news.cso.uiuc.edu (Net Noise owner) Organization: Nat'l Center for Supercomputing Applications In-Reply-To: douglis@MITL.COM's message of Wed, 2 Dec 1992 15:46:23 GMT Date: Thu, 3 Dec 1992 01:57:11 GMT Lines: 237