*** pub/rgnus/lisp/gnus-eform.el Sun Aug 4 00:22:02 1996 --- rgnus/lisp/gnus-eform.el Mon Aug 5 00:16:23 1996 *************** *** 82,89 **** Call EXIT-FUNC on exit. Display DOCUMENTATION in the beginning of the buffer." (let ((winconf (current-window-configuration))) ! (set-buffer (setq gnus-edit-form-buffer ! (get-buffer-create gnus-edit-form-buffer))) (gnus-configure-windows 'edit-form) (gnus-add-current-to-buffer-list) (gnus-edit-form-mode) --- 82,88 ---- Call EXIT-FUNC on exit. Display DOCUMENTATION in the beginning of the buffer." (let ((winconf (current-window-configuration))) ! (set-buffer (get-buffer-create gnus-edit-form-buffer)) (gnus-configure-windows 'edit-form) (gnus-add-current-to-buffer-list) (gnus-edit-form-mode) *************** *** 108,116 **** "Update changes and kill the current buffer." (interactive) (goto-char (point-min)) ! (let ((form (read (current-buffer)))) (gnus-edit-form-exit) ! (funcall gnus-edit-form-done-function form))) (defun gnus-edit-form-exit () "Kill the current buffer." --- 107,116 ---- "Update changes and kill the current buffer." (interactive) (goto-char (point-min)) ! (let ((form (read (current-buffer))) ! (func gnus-edit-form-done-function)) (gnus-edit-form-exit) ! (funcall func form))) (defun gnus-edit-form-exit () "Kill the current buffer." *** pub/rgnus/lisp/gnus-group.el Sun Aug 4 00:22:03 1996 --- rgnus/lisp/gnus-group.el Mon Aug 5 00:27:29 1996 *************** *** 422,427 **** --- 422,429 ---- (gnus-update-group-mark-positions) (gnus-make-local-hook 'post-command-hook) (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) + (when gnus-use-undo + (gnus-undo-mode 1)) (run-hooks 'gnus-group-mode-hook)) (defun gnus-update-group-mark-positions () *************** *** 1097,1109 **** (cons (current-buffer) 'summary)))))) gnus-newsrc-hashtb) (set-buffer gnus-group-buffer) ! (or (gnus-check-server method) ! (error "Unable to contact server: %s" (gnus-status-message method))) (if activate (or (gnus-request-group group) (error "Couldn't request group"))) (condition-case () (gnus-group-read-group t t group) ! (error nil) (quit nil)))) (defun gnus-group-jump-to-group (group) --- 1099,1111 ---- (cons (current-buffer) 'summary)))))) gnus-newsrc-hashtb) (set-buffer gnus-group-buffer) ! (unless (gnus-check-server method) ! (error "Unable to contact server: %s" (gnus-status-message method))) (if activate (or (gnus-request-group group) (error "Couldn't request group"))) (condition-case () (gnus-group-read-group t t group) ! ;(error nil) (quit nil)))) (defun gnus-group-jump-to-group (group) *** pub/rgnus/lisp/gnus-load.el Sat Aug 3 19:37:13 1996 --- rgnus/lisp/gnus-load.el Sun Aug 4 22:10:28 1996 *************** *** 264,271 **** (defvar gnus-save-score nil "*If non-nil, save group scoring info.") (defvar gnus-use-adaptive-scoring nil ! "*If non-nil, use some adaptive scoring scheme.") (defvar gnus-use-cache 'passive "*If nil, Gnus will ignore the article cache. --- 264,277 ---- (defvar gnus-save-score nil "*If non-nil, save group scoring info.") + (defvar gnus-use-undo t + "*If non-nil, allow undoing in Gnus group mode buffers.") + (defvar gnus-use-adaptive-scoring nil ! "*If non-nil, use some adaptive scoring scheme. ! If a list, then the values `word' and `line' are meaningful. The ! former will perform adaption on individual words in the subject ! header while `line' will perform adaption on several headers.") (defvar gnus-use-cache 'passive "*If nil, Gnus will ignore the article cache. *************** *** 681,687 **** gnus-article-strip-leading-blank-lines gnus-article-date-local gnus-article-date-original gnus-article-date-lapsed gnus-decode-rfc1522 gnus-article-show-all-headers ! gnus-article-edit-mode) ("gnus-int" gnus-request-type) ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1 gnus-dribble-enter) --- 687,694 ---- gnus-article-strip-leading-blank-lines gnus-article-date-local gnus-article-date-original gnus-article-date-lapsed gnus-decode-rfc1522 gnus-article-show-all-headers ! gnus-article-edit-mode gnus-article-edit-article ! gnus-article-edit-done) ("gnus-int" gnus-request-type) ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1 gnus-dribble-enter) *************** *** 692,697 **** --- 699,705 ---- ("gnus-move" :interactive t gnus-group-move-group-to-server gnus-change-server) ("gnus-logic" gnus-score-advanced) + ("gnus-undo" gnus-undo-mode gnus-undo-register) ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next gnus-async-prefetch-article gnus-async-prefetch-remove-group) ("gnus-vm" :interactive t gnus-summary-save-in-vm *** pub/rgnus/lisp/gnus-score.el Sun Aug 4 00:14:31 1996 --- rgnus/lisp/gnus-score.el Mon Aug 5 01:08:19 1996 *************** *** 144,155 **** (defvar gnus-default-adaptive-score-alist '((gnus-kill-file-mark) (gnus-unread-mark) ! (gnus-read-mark (from 3) (subject 30)) (gnus-catchup-mark (subject -10)) (gnus-killed-mark (from -1) (subject -20)) (gnus-del-mark (from -2) (subject -15))) "*Alist of marks and scores.") (defvar gnus-score-mimic-keymap nil "*Have the score entry functions pretend that they are a keymap.") --- 144,179 ---- (defvar gnus-default-adaptive-score-alist '((gnus-kill-file-mark) (gnus-unread-mark) ! (gnus-read-mark (from 3) (subject 30)) (gnus-catchup-mark (subject -10)) (gnus-killed-mark (from -1) (subject -20)) (gnus-del-mark (from -2) (subject -15))) "*Alist of marks and scores.") + (defvar gnus-ignored-adaptive-words + '("a" "i" "the" "to" "of" "and" "in" "is" "it" "for" "that" "if" "you" + "this" "be" "on" "with" "not" "have" "are" "or" "as" "from" "can" + "but" "by" "at" "an" "will" "no" "all" "was" "do" "there" "my" "one" + "so" "we" "they" "what" "would" "any" "which" "about" "get" "your" + "use" "some" "me" "then" "name" "like" "out" "when" "up" "time" + "other" "more" "only" "just" "end" "also" "know" "how" "new" "should" + "been" "than" "them" "he" "who" "make" "may" "people" "these" "now" + "their" "here" "into" "first" "could" "way" "had" "see" "work" "well" + "were" "two" "very" "where" "while" "us" "because" "good" "same" + "even" "much" "most" "many" "such" "long" "his" "over" "last" "since" + "right" "before" "our" "without" "too" "those" "why" "must" "part" + "being" "current" "back" "still" "go" "point" "value" "each" "did" + "both" "true" "off" "say" "another" "state" "might" "under" "start" + "try") + "List of words to be ignored when doing adaptive word scoring.") + + (defvar gnus-default-adaptive-word-score-alist + `((,gnus-read-mark . 30) + (,gnus-catchup-mark . -10) + (,gnus-killed-mark . -20) + (,gnus-del-mark . -15)) + "*Alist of marks and scores.") + (defvar gnus-score-mimic-keymap nil "*Have the score entry functions pretend that they are a keymap.") *************** *** 288,293 **** --- 312,318 ---- "f" gnus-score-edit-file "F" gnus-score-flush-cache "t" gnus-score-find-trace + "w" gnus-score-find-favourite-words "C" gnus-score-customize) ;; Summary score file commands *************** *** 1138,1152 **** (string-match gnus-score-uncacheable-files file) (gnus-score-remove-from-cache file)))) (kill-buffer (current-buffer))))) ! ! (defun gnus-score-headers (score-files &optional trace) ! ;; Score `gnus-newsgroup-headers'. ! (let (scores news) ! ;; PLM: probably this is not the best place to clear orphan-score ! (setq gnus-orphan-score nil) ! (setq gnus-scores-articles nil) ! (setq gnus-scores-exclude-files nil) ! ;; Load the score files. (while score-files (if (stringp (car score-files)) ;; It is a string, which means that it's a score file name, --- 1163,1173 ---- (string-match gnus-score-uncacheable-files file) (gnus-score-remove-from-cache file)))) (kill-buffer (current-buffer))))) ! ! (defun gnus-score-load-files (score-files) ! "Load all score files in SCORE-FILES." ! ;; Load the score files. ! (let (scores) (while score-files (if (stringp (car score-files)) ;; It is a string, which means that it's a score file name, *************** *** 1159,1170 **** ;; Prune the score files that are to be excluded, if any. (when gnus-scores-exclude-files (let ((s scores) ! c type) (while s (and (setq c (rassq (car s) gnus-score-cache)) (member (car c) gnus-scores-exclude-files) (setq scores (delq (car s) scores))) (setq s (cdr s))))) (setq news scores) ;; Do the scoring. (while news --- 1180,1201 ---- ;; Prune the score files that are to be excluded, if any. (when gnus-scores-exclude-files (let ((s scores) ! c) (while s (and (setq c (rassq (car s) gnus-score-cache)) (member (car c) gnus-scores-exclude-files) (setq scores (delq (car s) scores))) (setq s (cdr s))))) + scores)) + + (defun gnus-score-headers (score-files &optional trace) + ;; Score `gnus-newsgroup-headers'. + (let (scores news) + ;; PLM: probably this is not the best place to clear orphan-score + (setq gnus-orphan-score nil + gnus-scores-articles nil + gnus-scores-exclude-files nil + scores (gnus-score-load-files score-files)) (setq news scores) ;; Do the scoring. (while news *************** *** 1644,1650 **** ;; Insert the unique article headers in the buffer. (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) ;; gnus-score-index is used as a free variable. ! alike last this art entries alist articles scores fuzzy) ;; Sorting the articles costs os O(N*log N) but will allow us to ;; only match with each unique header. Thus the actual matching --- 1675,1682 ---- ;; Insert the unique article headers in the buffer. (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) ;; gnus-score-index is used as a free variable. ! alike last this art entries alist articles scores ! fuzzies arts words kill) ;; Sorting the articles costs os O(N*log N) but will allow us to ;; only match with each unique header. Thus the actual matching *************** *** 1656,1827 **** articles gnus-scores-articles) (erase-buffer) ! (while articles ! (setq art (car articles) ! this (aref (car art) gnus-score-index) ! articles (cdr articles)) (if (equal last this) ;; O(N*H) cons-cells used here, where H is the number of ;; headers. (setq alike (cons art alike)) ! (if last ! (progn ! ;; Insert the line, with a text property on the ! ;; terminating newline referring to the articles with ! ;; this line. ! (insert last ?\n) ! (put-text-property (1- (point)) (point) 'articles alike))) (setq alike (list art) last this))) ! (and last ; Bwadr, duplicate code. ! (progn ! (insert last ?\n) ! (put-text-property (1- (point)) (point) 'articles alike))) ! ! ;; Find ordinary matches. ! (setq scores score-list) ! (while scores ! (setq alist (car scores) ! scores (cdr scores) entries (assoc header alist)) (while (cdr entries) ;First entry is the header index. ! (let* ((rest (cdr entries)) ! (kill (car rest)) (match (nth 0 kill)) (type (or (nth 3 kill) 's)) (score (or (nth 1 kill) gnus-score-interactive-default-score)) (date (nth 2 kill)) (found nil) (mt (aref (symbol-name type) 0)) ! (case-fold-search ! (not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F)))) (dmt (downcase mt)) (search-func (cond ((= dmt ?r) 're-search-forward) ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) ! (t (error "Illegal match type: %s" type)))) ! arts art) ! (if (= dmt ?f) ! (setq fuzzy t) ! ;; Do non-fuzzy matching. (goto-char (point-min)) ! (if (= dmt ?e) ! ;; Do exact matching. ! (while (and (not (eobp)) ! (funcall search-func match nil t)) ! (and (= (progn (beginning-of-line) (point)) ! (match-beginning 0)) ! (= (progn (end-of-line) (point)) ! (match-end 0)) ! (progn ! (setq found (setq arts (get-text-property ! (point) 'articles))) ! ;; Found a match, update scores. ! (if trace ! (while arts ! (setq art (car arts) ! arts (cdr arts)) ! (setcdr art (+ score (cdr art))) ! (setq gnus-score-trace ! (cons ! (cons ! (car-safe ! (rassq alist gnus-score-cache)) ! kill) ! gnus-score-trace))) ! (while arts ! (setq art (car arts) ! arts (cdr arts)) ! (setcdr art (+ score (cdr art))))))) ! (forward-line 1)) ! ;; Do regexp and substring matching. ! (and (string= match "") (setq match "\n")) ! (while (and (not (eobp)) ! (funcall search-func match nil t)) ! (goto-char (match-beginning 0)) ! (end-of-line) ! (setq found (setq arts (get-text-property (point) 'articles))) ! ;; Found a match, update scores. ! (if trace ! (while arts ! (setq art (pop arts)) ! (setcdr art (+ score (cdr art))) ! (push (cons ! (car-safe (rassq alist gnus-score-cache)) ! kill) ! gnus-score-trace)) ! (while arts ! (setq art (pop arts)) ! (setcdr art (+ score (cdr art))))) ! (forward-line 1))) ! ;; Update expire date (cond ! ((null date)) ;Permanent entry. ! ((and found gnus-update-score-entry-dates) ;Match, update date. (gnus-score-set 'touched '(t) alist) ! (setcar (nthcdr 2 kill) now)) ! ((and expire (< date expire)) ;Old entry, remove. (gnus-score-set 'touched '(t) alist) ! (setcdr entries (cdr rest)) ! (setq rest entries)))) ! (setq entries rest)))) ;; Find fuzzy matches. ! (when fuzzy ! (setq scores score-list) (gnus-simplify-buffer-fuzzy) ! (while scores ! (setq alist (car scores) ! scores (cdr scores) ! entries (assoc header alist)) ! (while (cdr entries) ;First entry is the header index. ! (let* ((rest (cdr entries)) ! (kill (car rest)) ! (match (nth 0 kill)) ! (type (or (nth 3 kill) 's)) ! (score (or (nth 1 kill) gnus-score-interactive-default-score)) (date (nth 2 kill)) ! (found nil) ! (mt (aref (symbol-name type) 0)) ! (case-fold-search (not (= mt ?F))) ! (dmt (downcase mt)) ! arts art) ! (when (= dmt ?f) ! (goto-char (point-min)) ! (while (and (not (eobp)) ! (search-forward match nil t)) ! (when (and (= (progn (beginning-of-line) (point)) ! (match-beginning 0)) ! (= (progn (end-of-line) (point)) ! (match-end 0))) ! (setq found (setq arts (get-text-property ! (point) 'articles))) ! ;; Found a match, update scores. ! (if trace ! (while arts ! (setq art (pop arts)) ! (setcdr art (+ score (cdr art))) ! (push (cons ! (car-safe (rassq alist gnus-score-cache)) ! kill) ! gnus-score-trace)) ! (while arts ! (setq art (pop arts)) ! (setcdr art (+ score (cdr art)))))) ! (forward-line 1)) ! ;; Update expire date ! (unless trace ! (cond ! ((null date)) ;Permanent entry. ! ((and found gnus-update-score-entry-dates) ;Match, update date. ! (gnus-score-set 'touched '(t) alist) ! (setcar (nthcdr 2 kill) now)) ! ((and expire (< date expire)) ;Old entry, remove. ! (gnus-score-set 'touched '(t) alist) ! (setcdr entries (cdr rest)) ! (setq rest entries))))) ! (setq entries rest)))))) ! nil) (defun gnus-score-string< (a1 a2) ;; Compare headers in articles A2 and A2. --- 1688,1908 ---- articles gnus-scores-articles) (erase-buffer) ! (while (setq art (pop articles)) ! (setq this (aref (car art) gnus-score-index)) (if (equal last this) ;; O(N*H) cons-cells used here, where H is the number of ;; headers. (setq alike (cons art alike)) ! (when last ! ;; Insert the line, with a text property on the ! ;; terminating newline referring to the articles with ! ;; this line. ! (insert last ?\n) ! (put-text-property (1- (point)) (point) 'articles alike)) (setq alike (list art) last this))) ! (when last ; Bwadr, duplicate code. ! (insert last ?\n) ! (put-text-property (1- (point)) (point) 'articles alike)) ! ! ;; Go through all the score alists and pick out the entries ! ;; for this header. ! (while score-list ! (setq alist (pop score-list) ! ;; There's only one instance of this header for ! ;; each score alist. entries (assoc header alist)) (while (cdr entries) ;First entry is the header index. ! (let* ((kill (cadr entries)) (match (nth 0 kill)) (type (or (nth 3 kill) 's)) (score (or (nth 1 kill) gnus-score-interactive-default-score)) (date (nth 2 kill)) (found nil) (mt (aref (symbol-name type) 0)) ! (case-fold-search (not (memq mt '(?R ?S ?E ?F)))) (dmt (downcase mt)) (search-func (cond ((= dmt ?r) 're-search-forward) ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) ! (t (error "Illegal match type: %s" type))))) ! (cond ! ;; Fuzzy matches. We save these for later. ! ((= dmt ?f) ! (push entries fuzzies)) ! ;; Word matches. Save these for even later. ! ((= dmt ?w) ! (push entries words)) ! ;; Exact matches. ! ((= dmt ?e) ! ;; Do exact matching. (goto-char (point-min)) ! (while (and (not (eobp)) ! (funcall search-func match nil t)) ! ;; Is it really exact? ! (and (eolp) ! (= (gnus-point-at-bol) (match-beginning 0)) ! ;; Yup. ! (progn ! (setq found (setq arts (get-text-property ! (point) 'articles))) ! ;; Found a match, update scores. ! (if trace ! (while (setq art (pop arts)) ! (setcdr art (+ score (cdr art))) ! (setq gnus-score-trace ! (cons ! (cons ! (car-safe ! (rassq alist gnus-score-cache)) ! kill) ! gnus-score-trace))) ! (while (setq art (pop arts)) ! (setcdr art (+ score (cdr art))))))) ! (forward-line 1))) ! ;; Regexp and substring matching. ! (t ! (goto-char (point-min)) ! (when (string= match "") ! (setq match "\n")) ! (while (and (not (eobp)) ! (funcall search-func match nil t)) ! (goto-char (match-beginning 0)) ! (end-of-line) ! (setq found (setq arts (get-text-property (point) 'articles))) ! ;; Found a match, update scores. ! (if trace ! (while (setq art (pop arts)) ! (setcdr art (+ score (cdr art))) ! (push (cons (car-safe (rassq alist gnus-score-cache)) kill) ! gnus-score-trace)) ! (while (setq art (pop arts)) ! (setcdr art (+ score (cdr art))))) ! (forward-line 1)))) ! ;; Update expiry date ! (if trace ! (setq entries (cdr entries)) (cond ! ;; Permanent entry. ! ((null date) ! (setq entries (cdr entries))) ! ;; We have a match, so we update the date. ! ((and found gnus-update-score-entry-dates) (gnus-score-set 'touched '(t) alist) ! (setcar (nthcdr 2 kill) now) ! (setq entries (cdr entries))) ! ;; This entry has expired, so we remove it. ! ((and expire (< date expire)) (gnus-score-set 'touched '(t) alist) ! (setcdr entries (cddr entries))) ! ;; No match; go to next entry. ! (t ! (setq entries (cdr entries)))))))) ;; Find fuzzy matches. ! (when fuzzies ! ;; Simplify the entire buffer for easy matching. (gnus-simplify-buffer-fuzzy) ! (while (setq kill (cadr fuzzies)) ! (let* ((match (nth 0 kill)) ! (type (nth 3 kill)) ! (score (or (nth 1 kill) gnus-score-interactive-default-score)) ! (date (nth 2 kill)) ! (mt (aref (symbol-name type) 0)) ! (case-fold-search (not (= mt ?F))) ! found) ! (goto-char (point-min)) ! (while (and (not (eobp)) ! (search-forward match nil t)) ! (when (and (= (gnus-point-at-bol) (match-beginning 0)) ! (eolp)) ! (setq found (setq arts (get-text-property (point) 'articles))) ! (if trace ! (while (setq art (pop arts)) ! (setcdr art (+ score (cdr art))) ! (push (cons ! (car-safe (rassq alist gnus-score-cache)) kill) ! gnus-score-trace)) ! ;; Found a match, update scores. ! (while (setq art (pop arts)) ! (setcdr art (+ score (cdr art)))))) ! (forward-line 1)) ! ;; Update expiry date ! (if trace ! (setq entries (cdr entries)) ! (cond ! ;; Permanent. ! ((null date) ! (setq fuzzies (cdr fuzzies))) ! ;; Match, update date. ! ((and found gnus-update-score-entry-dates) ! (gnus-score-set 'touched '(t) alist) ! (setcar (nthcdr 2 kill) now) ! (setq fuzzies (cdr fuzzies))) ! ;; Old entry, remove. ! ((and expire (< date expire)) ! (gnus-score-set 'touched '(t) alist) ! (setcdr fuzzies (cddr fuzzies))) ! (t ! (setq fuzzies (cdr fuzzies)))))))) ! ! (when words ! ;; Enter all words into the hashtb. ! (let ((hashtb (gnus-make-hashtable ! (* 10 (count-lines (point-min) (point-max)))))) ! (gnus-enter-score-words-into-hashtb hashtb) ! (while (setq kill (cadr words)) ! (let* ((score (or (nth 1 kill) gnus-score-interactive-default-score)) (date (nth 2 kill)) ! found) ! (when (setq arts (intern-soft (nth 0 kill) hashtb)) ! (setq found t) ! (if trace ! (while (setq art (pop arts)) ! (setcdr art (+ score (cdr art))) ! (push (cons ! (car-safe (rassq alist gnus-score-cache)) kill) ! gnus-score-trace)) ! ;; Found a match, update scores. ! (while (setq art (pop arts)) ! (setcdr art (+ score (cdr art)))))) ! ;; Update expiry date ! (if trace ! (setq entries (cdr entries)) ! (cond ! ;; Permanent. ! ((null date) ! (setq words (cdr words))) ! ;; Match, update date. ! ((and found gnus-update-score-entry-dates) ! (gnus-score-set 'touched '(t) alist) ! (setcar (nthcdr 2 kill) now) ! (setq words (cdr words))) ! ;; Old entry, remove. ! ((and expire (< date expire)) ! (gnus-score-set 'touched '(t) alist) ! (setcdr words (cddr words))) ! (t ! (setq words (cdr words))))))))) ! nil)) ! ! (defun gnus-enter-score-words-into-hashtb (hashtb) ! ;; Find all the words in the buffer and enter them into ! ;; the hashtable. ! (let (word) ! (goto-char (point-min)) ! (while (re-search-forward "\\b\\w+\\b" nil t) ! (gnus-sethash ! (setq word (downcase (buffer-substring ! (match-beginning 0) (match-end 0)))) ! (append (get-text-property (gnus-point-at-eol) 'articles) ! (gnus-gethash word hashtb)) ! hashtb)) ! ;; Make all the ignorable words ignored. ! (let ((ignored gnus-ignored-adaptive-words)) ! (while ignored ! (gnus-sethash (pop ignored) nil hashtb))))) (defun gnus-score-string< (a1 a2) ;; Compare headers in articles A2 and A2. *************** *** 1829,1838 **** (string-lessp (aref (car a1) gnus-score-index) (aref (car a2) gnus-score-index))) - (defun gnus-score-build-cons (article) - ;; Build a `gnus-newsgroup-scored' type cons from ARTICLE. - (cons (mail-header-number (car article)) (cdr article))) - (defun gnus-current-score-file-nondirectory (&optional score-file) (let ((score-file (or score-file gnus-current-score-file))) (if score-file --- 1910,1915 ---- *************** *** 1840,1908 **** "none"))) (defun gnus-score-adaptive () ! (save-excursion ! (let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist)) ! (alist malist) ! (date (current-time-string)) ! (data gnus-newsgroup-data) ! elem headers match) ! ;; First we transform the adaptive rule alist into something ! ;; that's faster to process. ! (while malist ! (setq elem (car malist)) ! (if (symbolp (car elem)) ! (setcar elem (symbol-value (car elem)))) ! (setq elem (cdr elem)) ! (while elem ! (setcdr (car elem) ! (cons (if (eq (caar elem) 'followup) ! "references" ! (symbol-name (caar elem))) ! (cdar elem))) ! (setcar (car elem) ! `(lambda (h) ! (,(intern ! (concat "mail-header-" ! (if (eq (caar elem) 'followup) ! "message-id" ! (downcase (symbol-name (caar elem)))))) ! h))) ! (setq elem (cdr elem))) ! (setq malist (cdr malist))) ! ;; We change the score file to the adaptive score file. (save-excursion ! (set-buffer gnus-summary-buffer) ! (gnus-score-load-file ! (or gnus-newsgroup-adaptive-score-file ! (gnus-score-file-name ! gnus-newsgroup-name gnus-adaptive-file-suffix)))) ! ;; The we score away. ! (while data ! (setq elem (cdr (assq (gnus-data-mark (car data)) alist))) ! (if (or (not elem) ! (gnus-data-pseudo-p (car data))) ! () ! (when (setq headers (gnus-data-header (car data))) ! (while elem ! (setq match (funcall (caar elem) headers)) ! (gnus-summary-score-entry ! (nth 1 (car elem)) match ! (cond ! ((numberp match) ! '=) ! ((equal (nth 1 (car elem)) "date") ! 'a) ! (t ! ;; Whether we use substring or exact matches are controlled ! ;; here. ! (if (or (not gnus-score-exact-adapt-limit) ! (< (length match) gnus-score-exact-adapt-limit)) ! 'e ! (if (equal (nth 1 (car elem)) "subject") ! 'f 's)))) ! (nth 2 (car elem)) date nil t) ! (setq elem (cdr elem))))) ! (setq data (cdr data)))))) (defun gnus-score-edit-done () (let ((bufnam (buffer-file-name (current-buffer))) --- 1917,2028 ---- "none"))) (defun gnus-score-adaptive () ! "Create adaptive score rules for this newsgroup." ! (when gnus-use-adaptive-scoring ! ;; We change the score file to the adaptive score file. ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (gnus-score-load-file ! (or gnus-newsgroup-adaptive-score-file ! (gnus-score-file-name ! gnus-newsgroup-name gnus-adaptive-file-suffix)))) ! (cond ! ;; Perform ordinary line scoring. ! ((or (not (listp gnus-use-adaptive-scoring)) ! (memq 'line gnus-use-adaptive-scoring)) (save-excursion ! (let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist)) ! (alist malist) ! (date (current-time-string)) ! (data gnus-newsgroup-data) ! elem headers match) ! ;; First we transform the adaptive rule alist into something ! ;; that's faster to process. ! (while malist ! (setq elem (car malist)) ! (if (symbolp (car elem)) ! (setcar elem (symbol-value (car elem)))) ! (setq elem (cdr elem)) ! (while elem ! (setcdr (car elem) ! (cons (if (eq (caar elem) 'followup) ! "references" ! (symbol-name (caar elem))) ! (cdar elem))) ! (setcar (car elem) ! `(lambda (h) ! (,(intern ! (concat "mail-header-" ! (if (eq (caar elem) 'followup) ! "message-id" ! (downcase (symbol-name (caar elem)))))) ! h))) ! (setq elem (cdr elem))) ! (setq malist (cdr malist))) ! ;; Then we score away. ! (while data ! (setq elem (cdr (assq (gnus-data-mark (car data)) alist))) ! (if (or (not elem) ! (gnus-data-pseudo-p (car data))) ! () ! (when (setq headers (gnus-data-header (car data))) ! (while elem ! (setq match (funcall (caar elem) headers)) ! (gnus-summary-score-entry ! (nth 1 (car elem)) match ! (cond ! ((numberp match) ! '=) ! ((equal (nth 1 (car elem)) "date") ! 'a) ! (t ! ;; Whether we use substring or exact matches is ! ;; controlled here. ! (if (or (not gnus-score-exact-adapt-limit) ! (< (length match) gnus-score-exact-adapt-limit)) ! 'e ! (if (equal (nth 1 (car elem)) "subject") ! 'f 's)))) ! (nth 2 (car elem)) date nil t) ! (setq elem (cdr elem))))) ! (setq data (cdr data)))))) ! ! ;; Perform adaptive word scoring. ! ((memq 'word gnus-use-adaptive-scoring) ! (nnheader-temp-write nil ! (let* ((hashtb (gnus-make-hashtable 1000)) ! (date (current-time-string)) ! (data gnus-newsgroup-data) ! word d score) ! ;; Go through all articles. ! (while (setq d (pop data)) ! (when (setq score (cdr (assq ! (gnus-data-mark d) ! gnus-default-adaptive-word-score-alist))) ! ;; This article has a mark that should lead to ! ;; adaptive word rules, so we insert the subject ! ;; and find all words in that string. ! (insert (mail-header-subject (gnus-data-header d))) ! (downcase-region (point-min) (point-max)) ! (goto-char (point-min)) ! (while (re-search-forward "\\b\\w+\\b" nil t) ! ;; Put the word and score into the hashtb. ! (gnus-sethash (setq word (match-string 0)) ! (+ (or (gnus-gethash word hashtb) 0) score) ! hashtb)) ! (erase-buffer))) ! ;; Make all the ignorable words ignored. ! (let ((ignored gnus-ignored-adaptive-words)) ! (while ignored ! (gnus-sethash (pop ignored) nil hashtb))) ! ;; Now we have all the words and scores, so we ! ;; add these rules to the ADAPT file. ! (mapatoms ! (lambda (word) ! (gnus-summary-score-entry ! "subject" (symbol-name word) 'w (symbol-value word) ! date)) ! hashtb))))))) (defun gnus-score-edit-done () (let ((bufnam (buffer-file-name (current-buffer))) *************** *** 1917,1941 **** (let ((gnus-newsgroup-headers (list (gnus-summary-article-header))) (gnus-newsgroup-scored nil) - (buf (current-buffer)) trace) ! (when (get-buffer "*Gnus Scores*") ! (save-excursion ! (set-buffer "*Gnus Scores*") ! (erase-buffer))) (setq gnus-score-trace nil) (gnus-possibly-score-headers 'trace) (if (not (setq trace gnus-score-trace)) (gnus-error 1 "No score rules apply to the current article.") ! (pop-to-buffer "*Gnus Scores*") (gnus-add-current-to-buffer-list) - (erase-buffer) (while trace (insert (format "%S -> %s\n" (cdar trace) (file-name-nondirectory (caar trace)))) (setq trace (cdr trace))) (goto-char (point-min)) ! (pop-to-buffer buf)))) (defun gnus-summary-rescore () "Redo the entire scoring process in the current summary." --- 2037,2092 ---- (let ((gnus-newsgroup-headers (list (gnus-summary-article-header))) (gnus-newsgroup-scored nil) trace) ! (save-excursion ! (nnheader-set-temp-buffer "*Score Trace*")) (setq gnus-score-trace nil) (gnus-possibly-score-headers 'trace) (if (not (setq trace gnus-score-trace)) (gnus-error 1 "No score rules apply to the current article.") ! (set-buffer "*Score Trace*") (gnus-add-current-to-buffer-list) (while trace (insert (format "%S -> %s\n" (cdar trace) (file-name-nondirectory (caar trace)))) (setq trace (cdr trace))) (goto-char (point-min)) ! (gnus-configure-windows 'score-trace)))) ! ! (defun gnus-score-find-favourite-words () ! "List words used in scoring." ! (interactive) ! (let ((alists (gnus-score-load-files (gnus-all-score-files))) ! alist rule rules) ! ;; Go through all the score alists for this group ! ;; and find all `w' rules. ! (while (setq alist (pop alists)) ! (when (and (stringp (setq rule (pop alist))) ! (equal "subject" (downcase (pop rule)))) ! (while rule ! (when (memq (nth 3 (car rule)) '(w W word Word)) ! (push (cons (or (nth 1 rule) gnus-score-interactive-default-score) ! (car rule)) ! rules)) ! (pop rule)))) ! (setq rules (sort rules (lambda (r1 r2) ! (string-lessp (cdr r1) (cdr r2))))) ! ;; Add up words that have appeared several times. ! (let ((r rules)) ! (while (cdr r) ! (if (equal (cdar r) (cdadr r)) ! (progn ! (setcar (car r) (+ (caar r) (caadr r))) ! (setcdr r (cddr r))) ! (pop r)))) ! ;; Insert the words. ! (nnheader-set-temp-buffer "*Score Words*") ! (setq rules (sort rules (lambda (r1 r2) (> (car r1) (car r2))))) ! (while rules ! (insert (format "%-5d: %s\n" (caar rules) (cdar rules))) ! (pop rules)) ! (gnus-add-current-to-buffer-list) ! (gnus-configure-windows 'score-words))) (defun gnus-summary-rescore () "Redo the entire scoring process in the current summary." *************** *** 2220,2226 **** (cons (cons group score-files) gnus-score-file-alist-cache)) score-files))) ! (defun gnus-possibly-score-headers (&optional trace) (let ((funcs gnus-score-find-score-files-function) (group gnus-newsgroup-name) score-files) --- 2371,2378 ---- (cons (cons group score-files) gnus-score-file-alist-cache)) score-files))) ! (defun gnus-all-score-files () ! "Return a list of all score files for the current group." (let ((funcs gnus-score-find-score-files-function) (group gnus-newsgroup-name) score-files) *************** *** 2251,2262 **** ;; Add any home score files. (let ((home (gnus-home-score-file group))) (when home ! (setq score-files (nconc score-files (list home))))) ;; Check whether there is a `score-file' group parameter. (let ((param-file (gnus-group-get-parameter group 'score-file))) (when param-file ! (setq score-files (nconc score-files (list param-file))))) ;; Do the scoring if there are any score files for this group. (when score-files (gnus-score-headers score-files trace)))) --- 2403,2419 ---- ;; Add any home score files. (let ((home (gnus-home-score-file group))) (when home ! (push home score-files))) ;; Check whether there is a `score-file' group parameter. (let ((param-file (gnus-group-get-parameter group 'score-file))) (when param-file ! (push param-file score-files))) ;; Do the scoring if there are any score files for this group. + score-files)) + + (defun gnus-possibly-score-headers (&optional trace) + "Do scoring if scoring is required." + (let ((score-files (gnus-all-score-files))) (when score-files (gnus-score-headers score-files trace)))) *************** *** 2335,2351 **** (defun gnus-hierarchial-home-score-file (group) "Return the score file of the top-level hierarchy of GROUP." (if (string-match "^[^.]+\\." group) ! (concat (match-string 0 group) "all." gnus-score-file-suffix) ;; Group name without any dots. ! (concat group ".all." gnus-score-file-suffix))) (defun gnus-hierarchial-home-adapt-file (group) "Return the adapt file of the top-level hierarchy of GROUP." (if (string-match "^[^.]+\\." group) ! (concat (match-string 0 group) "all." gnus-adaptive-file-suffix) ;; Group name without any dots. ! (concat group ".all." gnus-adaptive-file-suffix))) ! (provide 'gnus-score) ;;; gnus-score.el ends here --- 2492,2513 ---- (defun gnus-hierarchial-home-score-file (group) "Return the score file of the top-level hierarchy of GROUP." (if (string-match "^[^.]+\\." group) ! (concat (match-string 0 group) gnus-score-file-suffix) ;; Group name without any dots. ! (concat group "." gnus-score-file-suffix))) (defun gnus-hierarchial-home-adapt-file (group) "Return the adapt file of the top-level hierarchy of GROUP." (if (string-match "^[^.]+\\." group) ! (concat (match-string 0 group) gnus-adaptive-file-suffix) ;; Group name without any dots. ! (concat group "." gnus-adaptive-file-suffix))) ! ! ;;; ! ;;; Adaptive word scoring ! ;;; ! ! (provide 'gnus-score) ;;; gnus-score.el ends here *** pub/rgnus/lisp/gnus-srvr.el Fri Aug 2 18:57:13 1996 --- rgnus/lisp/gnus-srvr.el Mon Aug 5 00:16:23 1996 *************** *** 592,601 **** "Enter the group at the current line." (interactive) (let ((group (gnus-browse-group-name))) ! (or (gnus-group-read-ephemeral-group ! group gnus-browse-current-method nil ! (cons (current-buffer) 'browse)) ! (error "Couldn't enter %s" group)))) (defun gnus-browse-select-group () "Select the current group." --- 592,601 ---- "Enter the group at the current line." (interactive) (let ((group (gnus-browse-group-name))) ! (unless (gnus-group-read-ephemeral-group ! group gnus-browse-current-method nil ! (cons (current-buffer) 'browse)) ! (error "Couldn't enter %s" group)))) (defun gnus-browse-select-group () "Select the current group." *** pub/rgnus/lisp/gnus-sum.el Sat Aug 3 22:17:17 1996 --- rgnus/lisp/gnus-sum.el Mon Aug 5 00:43:31 1996 *************** *** 4771,4791 **** (gnus-summary-hide-all-threads)) ;; Try to return to the article you were at, or one in the ;; neighborhood. ! (if data ! ;; We try to find some article after the current one. ! (while data ! (and (gnus-summary-goto-subject ! (gnus-data-number (car data)) nil t) ! (setq data nil ! found t)) ! (setq data (cdr data)))) ! (or found ! ;; If there is no data, that means that we were after the last ! ;; article. The same goes when we can't find any articles ! ;; after the current one. ! (progn ! (goto-char (point-max)) ! (gnus-summary-find-prev))) ;; We return how many articles were removed from the summary ;; buffer as a result of the new limit. (- total (length gnus-newsgroup-data)))) --- 4771,4789 ---- (gnus-summary-hide-all-threads)) ;; Try to return to the article you were at, or one in the ;; neighborhood. ! (when data ! ;; We try to find some article after the current one. ! (while data ! (when (gnus-summary-goto-subject (gnus-data-number (car data)) nil t) ! (setq data nil ! found t)) ! (setq data (cdr data)))) ! (unless found ! ;; If there is no data, that means that we were after the last ! ;; article. The same goes when we can't find any articles ! ;; after the current one. ! (goto-char (point-max)) ! (gnus-summary-find-prev)) ;; We return how many articles were removed from the summary ;; buffer as a result of the new limit. (- total (length gnus-newsgroup-data)))) *************** *** 6361,6396 **** (interactive "P") (gnus-set-global-variables) (prog1 ! (if (or quietly ! (not gnus-interactive-catchup) ;Without confirmation? ! gnus-expert-user ! (gnus-y-or-n-p ! (if all ! "Mark absolutely all articles as read? " ! "Mark all unread articles as read? "))) ! (if (and not-mark ! (not gnus-newsgroup-adaptive) ! (not gnus-newsgroup-auto-expire)) ! (progn ! (when all ! (setq gnus-newsgroup-marked nil ! gnus-newsgroup-dormant nil)) ! (setq gnus-newsgroup-unreads nil)) ! ;; We actually mark all articles as canceled, which we ! ;; have to do when using auto-expiry or adaptive scoring. ! (gnus-summary-show-all-threads) ! (if (gnus-summary-first-subject (not all)) ! (while (and ! (if to-here (< (point) to-here) t) ! (gnus-summary-mark-article-as-read gnus-catchup-mark) ! (gnus-summary-find-next (not all))))) ! (unless to-here (setq gnus-newsgroup-unreads nil)) ! (gnus-set-mode-line 'summary))) (let ((method (gnus-find-method-for-group gnus-newsgroup-name))) ! (if (and (not to-here) (eq 'nnvirtual (car method))) ! (nnvirtual-catchup-group ! (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all))) (gnus-summary-position-point))) (defun gnus-summary-catchup-to-here (&optional all) --- 6359,6394 ---- (interactive "P") (gnus-set-global-variables) (prog1 ! (when (or quietly ! (not gnus-interactive-catchup) ;Without confirmation? ! gnus-expert-user ! (gnus-y-or-n-p ! (if all ! "Mark absolutely all articles as read? " ! "Mark all unread articles as read? "))) ! (if (and not-mark ! (not gnus-newsgroup-adaptive) ! (not gnus-newsgroup-auto-expire)) ! (progn ! (when all ! (setq gnus-newsgroup-marked nil ! gnus-newsgroup-dormant nil)) (setq gnus-newsgroup-unreads nil)) ! ;; We actually mark all articles as canceled, which we ! ;; have to do when using auto-expiry or adaptive scoring. ! (gnus-summary-show-all-threads) ! (when (gnus-summary-first-subject (not all)) ! (while (and ! (if to-here (< (point) to-here) t) ! (gnus-summary-mark-article-as-read gnus-catchup-mark) ! (gnus-summary-find-next (not all))))) ! (unless to-here ! (setq gnus-newsgroup-unreads nil)) ! (gnus-set-mode-line 'summary))) (let ((method (gnus-find-method-for-group gnus-newsgroup-name))) ! (when (and (not to-here) (eq 'nnvirtual (car method))) ! (nnvirtual-catchup-group ! (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all))) (gnus-summary-position-point))) (defun gnus-summary-catchup-to-here (&optional all) *** pub/rgnus/lisp/gnus-undo.el Mon Aug 5 02:16:28 1996 --- rgnus/lisp/gnus-undo.el Sun Aug 4 22:10:32 1996 *************** *** 0 **** --- 1,153 ---- + ;;; gnus-undo.el --- minor mode for undoing in Gnus + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; 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: + + ;; This package allows arbitrary undoing in Gnus buffers. As all the + ;; Gnus buffers aren't very text-oriented (what is in the buffers is + ;; just some random representation of the actual data), normal Emacs + ;; undoing doesn't work at all for Gnus. + ;; + ;; This package works by letting Gnus register functions for reversing + ;; actions, and then calling these functions when the user pushes the + ;; `undo' key. As with normal `undo', there it is possible to set + ;; undo boundaries and so on. + ;; + ;; Internally, the undo sequence is represented by the + ;; `gnus-undo-actions' list, where each element is a list of functions + ;; to be called, in sequence, to undo some action. (An "action" is a + ;; collection of functions.) + ;; + ;; For instance, a function for killing a group will call + ;; `gnus-undo-register' with a function that un-kills the group. This + ;; package will put that function into an action. + + ;;; Code: + + (require 'gnus-util) + + (defvar gnus-undo-mode nil + "Minor mode for undoing in Gnus buffers.") + + (defvar gnus-undo-mode-hook nil + "Hook called in all `gnus-undo-mode' buffers.") + + ;;; Internal variables. + + (defvar gnus-undo-actions nil) + (defvar gnus-undo-boundary t) + (defvar gnus-undo-last nil) + + ;;; Minor mode definition. + + (defvar gnus-undo-mode-map nil) + + (unless gnus-undo-mode-map + (setq gnus-undo-mode-map (make-sparse-keymap)) + + (gnus-define-keys gnus-undo-mode-map + "\M-\C-_" gnus-undo)) + + (defun gnus-undo-make-menu-bar () + (unless (boundp 'gnus-undo-menu) + (easy-menu-define + gnus-undo-menu gnus-undo-mode-map "" + '("Undo" + ("Undo" + ["Undo" gnus-undo gnus-undo-actions]))))) + + (defun gnus-undo-mode (&optional arg) + "Minor mode for providing `undo' in Gnus buffers. + + \\{gnus-undo-mode-map}" + (interactive "P") + (set (make-local-variable 'gnus-undo-mode) + (if (null arg) (not gnus-undo-mode) + (> (prefix-numeric-value arg) 0))) + (set (make-local-variable 'gnus-undo-actions) nil) + (set (make-local-variable 'gnus-undo-boundary) t) + (when gnus-undo-mode + ;; Set up the menu. + (when (and menu-bar-mode + (gnus-visual-p 'undo-menu 'menu)) + (gnus-undo-make-menu-bar)) + ;; Don't display anything in the mode line -- too annoying. + ;;(unless (assq 'gnus-undo-mode minor-mode-alist) + ;; (push '(gnus-undo-mode " Undo") minor-mode-alist)) + (unless (assq 'gnus-undo-mode minor-mode-map-alist) + (push (cons 'gnus-undo-mode gnus-undo-mode-map) + minor-mode-map-alist)) + (gnus-make-local-hook 'post-command-hook) + (gnus-add-hook 'post-command-hook 'gnus-undo-boundary nil t) + (run-hooks 'gnus-undo-mode-hook))) + + ;;; Interface functions. + + (defun gnus-disable-undo (&optional buffer) + "Disable undoing in the current buffer." + (interactive) + (save-excursion + (when buffer + (set-buffer buffer)) + (gnus-undo-mode -1))) + + (defun gnus-undo-boundary () + "Set Gnus undo boundary." + (setq gnus-undo-boundary t)) + + (defun gnus-undo-register (function) + "Register FUNCTION as something to be performed to undo a change." + (when gnus-undo-mode + (cond + ;; We are on a boundary, so we create a new action. + (gnus-undo-boundary + (push (list function) gnus-undo-actions) + (setq gnus-undo-boundary nil)) + ;; Prepend the function to an old action. + (gnus-undo-actions + (setcar gnus-undo-actions (cons function (car gnus-undo-actions)))) + ;; Initialize list. + (t + (setq gnus-undo-actions (list (list function))))))) + + (defun gnus-undo (n) + "Undo some previous changes in Gnus buffers. + Repeat this command to undo more changes. + A numeric argument serves as a repeat count." + (interactive "p") + (unless gnus-undo-mode + (error "Undoing is not enabled in this buffer")) + (when (or (not (eq last-command 'gnus-undo)) + (not gnus-undo-last)) + (setq gnus-undo-last gnus-undo-actions)) + (let (actions action) + (while (setq actions (pop gnus-undo-last)) + (unless action + (errror "Nothing further to undo")) + (setq gnus-undo-actions (delq action gnus-undo-actions)) + (while action + (funcall (pop action)))))) + + (provide 'gnus-undo) + + ;;; gnus-undo.el ends here *** pub/rgnus/lisp/gnus-util.el Fri Aug 2 18:50:17 1996 --- rgnus/lisp/gnus-util.el Mon Aug 5 00:27:27 1996 *************** *** 495,502 **** (defmacro gnus-group-real-name (group) "Find the real name of a foreign newsgroup." `(let ((gname ,group)) ! (if (string-match ":[^:]+$" gname) ! (substring gname (1+ (match-beginning 0))) gname))) (defun gnus-make-sort-function (funs) --- 495,502 ---- (defmacro gnus-group-real-name (group) "Find the real name of a foreign newsgroup." `(let ((gname ,group)) ! (if (string-match "^[^:]+:" gname) ! (substring gname (match-end 0)) gname))) (defun gnus-make-sort-function (funs) *** pub/rgnus/lisp/gnus-vis.el Fri Aug 2 21:42:23 1996 --- rgnus/lisp/gnus-vis.el Sun Aug 4 22:10:33 1996 *************** *** 494,499 **** --- 494,500 ---- ["Edit current score file" gnus-score-edit-current-scores t] ["Edit score file" gnus-score-edit-file t] ["Trace score" gnus-score-find-trace t] + ["Find words" gnus-score-find-favuorite-words t] ["Rescore buffer" gnus-summary-rescore t] ["Increase score..." gnus-summary-increase-score t] ["Lower score..." gnus-summary-lower-score t])))) *** pub/rgnus/lisp/gnus-win.el Sun Aug 4 00:22:02 1996 --- rgnus/lisp/gnus-win.el Sun Aug 4 22:10:33 1996 *************** *** 131,136 **** --- 131,144 ---- (vertical 1.0 ("*Gnus Help Bug*" 0.5) ("*Gnus Bug*" 1.0 point))) + (score-trace + (vertical 1.0 + (summary 0.5 point) + ("*Score Trace*" 1.0))) + (score-trace + (vertical 1.0 + (summary 0.5 point) + ("*Score Words*" 1.0))) (compose-bounce (vertical 1.0 (article 0.5) *** pub/rgnus/lisp/gnus.el Sat Aug 3 19:37:16 1996 --- rgnus/lisp/gnus.el Sun Aug 4 23:16:57 1996 *************** *** 28,34 **** (eval '(run-hooks 'gnus-load-hook)) ! (defconst gnus-version-number "0.5" "Version number for this version of Gnus.") (defconst gnus-version (format "Red Gnus v%s" gnus-version-number) --- 28,34 ---- (eval '(run-hooks 'gnus-load-hook)) ! (defconst gnus-version-number "0.6" "Version number for this version of Gnus.") (defconst gnus-version (format "Red Gnus v%s" gnus-version-number) *** pub/rgnus/lisp/nntp.el Sun Aug 4 00:50:09 1996 --- rgnus/lisp/nntp.el Mon Aug 5 02:13:31 1996 *************** *** 315,320 **** --- 315,323 ---- (nntp-possibly-change-group nil server) (when (nntp-send-command "^[23].*\r?\n" "POST") (nntp-send-buffer "^[23].*\n"))) + + (deffoo nntp-request-type (group article) + 'news) ;;; Hooky functions. *** pub/rgnus/lisp/ChangeLog Sun Aug 4 00:50:10 1996 --- rgnus/lisp/ChangeLog Mon Aug 5 02:13:31 1996 *************** *** 1,3 **** --- 1,47 ---- + Mon Aug 5 01:12:24 1996 Lars Magne Ingebrigtsen + + * nntp.el (nntp-request-type): Defined again. + + Mon Aug 5 01:01:15 1996 Ralph Schleicher + + * gnus-score.el (gnus-ignored-adaptive-words): New value. + + Mon Aug 5 00:12:54 1996 Lars Magne Ingebrigtsen + + * gnus-util.el (gnus-group-real-name): Tweaked definition. + + * gnus-eform.el (gnus-edit-form-done): Didn't call the right + function. + + Sun Aug 4 23:30:52 1996 Lars Magne Ingebrigtsen + + * gnus-score.el (gnus-score-load-files): Returned nil. + + Sun Aug 4 06:11:02 1996 Lars Magne Ingebrigtsen + + * gnus-load.el (gnus-use-undo): New variable. + + * gnus-undo.el: New file. + + * gnus-score.el (gnus-default-adaptive-word-score-alist): New + variable. + (gnus-score-adaptive): Adaptivity on words. + (gnus-ignored-adaptive-words): New variable. + (gnus-all-score-files): Made into own function. + (gnus-score-load-files): Ditto. + (gnus-score-find-favourite-words): New command and keystroke. + + * gnus-load.el (gnus-use-adaptive-scoring): Doc fix. + + * gnus-score.el (gnus-enter-score-words-into-hashtb): New + function. + (gnus-score-build-cons): Removed. + (gnus-score-string): Score words. + + Sun Aug 4 01:33:31 1996 Lars Magne Ingebrigtsen + + * gnus.el: Red Gnus v0.5 is released. + Sun Aug 4 00:17:51 1996 Lars Magne Ingebrigtsen * nntp.el (nntp-wait-for): Goto point-max before inserting. *** pub/rgnus/texi/gnus.texi Sun Aug 4 01:27:00 1996 --- rgnus/texi/gnus.texi Mon Aug 5 01:08:20 1996 *************** *** 9708,9721 **** @table @dfn @item From, Subject, References, Xref, Message-ID ! For most header types, there are the @code{r} and @code{R} (regexp) as ! well as @code{s} and @code{S} (substring) types and @code{e} and ! @code{E} (exact match) types. If this element is not present, Gnus will ! assume that substring matching should be used. @code{R} and @code{S} ! differ from the other two in that the matches will be done in a ! case-sensitive manner. All these one-letter types are really just ! abbreviations for the @code{regexp}, @code{string} and @code{exact} ! types, which you can use instead, if you feel like. @item Lines, Chars These two headers use different match types: @code{<}, @code{>}, --- 9708,9722 ---- @table @dfn @item From, Subject, References, Xref, Message-ID ! For most header types, there are the @code{r} and @code{R} (regexp), as ! well as @code{s} and @code{S} (substring) types, and @code{e} and ! @code{E} (exact match), and @code{w} (word match) types. If this ! element is not present, Gnus will assume that substring matching should ! be used. @code{R}, @code{S}, and @code{E} differ from the others in ! that the matches will be done in a case-sensitive manner. All these ! one-letter types are really just abbreviations for the @code{regexp}, ! @code{string}, @code{exact}, and @code{word} types, which you can use ! instead, if you feel like. @item Lines, Chars These two headers use different match types: @code{<}, @code{>}, *************** *** 9892,9898 **** article, you leave marks behind. On exit from the group, Gnus can sniff these marks and add score elements depending on what marks it finds. You turn on this ability by setting @code{gnus-use-adaptive-scoring} to ! @code{t}. @vindex gnus-default-adaptive-score-alist To give you complete control over the scoring process, you can customize --- 9893,9902 ---- article, you leave marks behind. On exit from the group, Gnus can sniff these marks and add score elements depending on what marks it finds. You turn on this ability by setting @code{gnus-use-adaptive-scoring} to ! @code{t} or @code{(line)}. If you want score adaptively on separate ! words appearing in the subjects, you should set this variable to ! @code{(word)}. If you want to use both adaptive methods, set this ! variable to @code{(word line)}. @vindex gnus-default-adaptive-score-alist To give you complete control over the scoring process, you can customize *************** *** 9975,9985 **** this variable is @code{nil}, exact matching will always be used to avoid this problem. @node Home Score File @section Home Score File ! The score file where new score file entries will go is calle the @dfn{home score file}. This is normally (and by default) the score file for the group itself. For instance, the home score file for @samp{gnu.emacs.gnus} is @file{gnu.emacs.gnus.SCORE}. --- 9979,10011 ---- this variable is @code{nil}, exact matching will always be used to avoid this problem. + As mentioned above, you can adapt either on individual words or entire + headers. If you adapt on words, the + @code{gnus-default-adaptive-word-score-alist} says what score each + instance of a word should add given a mark. + + @lisp + (setq gnus-default-adaptive-word-score-alist + `((,gnus-read-mark . 30) + (,gnus-catchup-mark . -10) + (,gnus-killed-mark . -20) + (,gnus-del-mark . -15))) + @end lisp + + This is the default value. If you have adaption on words enabled, every + word that appears in subjects of articles that are marked with + @code{gnus-read-mark} will result in a score rule that increase the + score with 30 points. + + After using this scheme for a while, it might be nice to write a + @code{gnus-psychoanalyze-user} command to go through the rules and see + what words you like and what words you don't like. Or perhaps not. + @node Home Score File @section Home Score File ! The score file where new score file entries will go is called the @dfn{home score file}. This is normally (and by default) the score file for the group itself. For instance, the home score file for @samp{gnu.emacs.gnus} is @file{gnu.emacs.gnus.SCORE}. *** pub/rgnus/texi/ChangeLog Sat Aug 3 19:37:20 1996 --- rgnus/texi/ChangeLog Sun Aug 4 22:10:37 1996 *************** *** 1,3 **** --- 1,8 ---- + Sun Aug 4 07:15:28 1996 Lars Magne Ingebrigtsen + + * gnus.texi (Score File Format): Addition. + (Adaptive Scoring): Addition. + Sat Aug 3 17:35:36 1996 Lars Magne Ingebrigtsen * gnus.texi (Group Parameters): Addition.