Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-score.el @ 140:585fb297b004 r20-2b4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-2b4
author cvs
date Mon, 13 Aug 2007 09:32:43 +0200
parents cca96a509cfe
children 43dd3413c7c7
comparison
equal deleted inserted replaced
139:2b5203979d01 140:585fb297b004
1 ;;; gnus-score.el --- scoring code for Gnus 1 1;;; gnus-score.el --- scoring code for Gnus
2 ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. 2 ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
3 3
4 ;; Author: Per Abrahamsen <amanda@iesd.auc.dk> 4 ;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
5 ;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no> 5 ;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
6 ;; Keywords: news 6 ;; Keywords: news
524 (setq hchar nil) 524 (setq hchar nil)
525 (gnus-score-insert-help "Match on header" char-to-header 1))) 525 (gnus-score-insert-help "Match on header" char-to-header 1)))
526 526
527 (gnus-score-kill-help-buffer) 527 (gnus-score-kill-help-buffer)
528 (unless (setq entry (assq (downcase hchar) char-to-header)) 528 (unless (setq entry (assq (downcase hchar) char-to-header))
529 (if mimic (error "%c %c" prefix hchar) (error ""))) 529 (if mimic (error "%c %c" prefix hchar)
530 (error "Illegal header type")))
530 531
531 (when (/= (downcase hchar) hchar) 532 (when (/= (downcase hchar) hchar)
532 ;; This was a majuscule, so we end reading and set the defaults. 533 ;; This was a majuscule, so we end reading and set the defaults.
533 (if mimic (message "%c %c" prefix hchar) (message "")) 534 (if mimic (message "%c %c" prefix hchar) (message ""))
534 (setq tchar (or tchar ?s) 535 (setq tchar (or tchar ?s)
535 pchar (or pchar ?t))) 536 pchar (or pchar ?t)))
536 537
537 ;; We continue reading - the type. 538 (let ((legal-types
538 (while (not tchar) 539 (delq nil
539 (if mimic 540 (mapcar (lambda (s)
540 (progn 541 (if (eq (nth 4 entry)
541 (sit-for 1) (message "%c %c-" prefix hchar)) 542 (nth 3 s))
542 (message "%s header '%s' with match type (%s?): " 543 s nil))
543 (if increase "Increase" "Lower") 544 char-to-type))))
544 (nth 1 entry) 545 ;; We continue reading - the type.
545 (mapconcat (lambda (s) 546 (while (not tchar)
546 (if (eq (nth 4 entry) 547 (if mimic
547 (nth 3 s)) 548 (progn
548 (char-to-string (car s)) 549 (sit-for 1) (message "%c %c-" prefix hchar))
549 "")) 550 (message "%s header '%s' with match type (%s?): "
550 char-to-type ""))) 551 (if increase "Increase" "Lower")
551 (setq tchar (read-char)) 552 (nth 1 entry)
552 (when (or (= tchar ??) (= tchar ?\C-h)) 553 (mapconcat (lambda (s) (char-to-string (car s)))
553 (setq tchar nil) 554 legal-types "")))
554 (gnus-score-insert-help 555 (setq tchar (read-char))
555 "Match type" 556 (when (or (= tchar ??) (= tchar ?\C-h))
556 (delq nil 557 (setq tchar nil)
557 (mapcar (lambda (s) 558 (gnus-score-insert-help "Match type" legal-types 2)))
558 (if (eq (nth 4 entry) 559
559 (nth 3 s)) 560 (gnus-score-kill-help-buffer)
560 s nil)) 561 (unless (setq type (nth 1 (assq (downcase tchar) legal-types)))
561 char-to-type)) 562 (if mimic (error "%c %c" prefix hchar)
562 2))) 563 (error "Illegal match type"))))
563
564 (gnus-score-kill-help-buffer)
565 (unless (setq type (nth 1 (assq (downcase tchar) char-to-type)))
566 (if mimic (error "%c %c" prefix hchar) (error "")))
567 564
568 (when (/= (downcase tchar) tchar) 565 (when (/= (downcase tchar) tchar)
569 ;; It was a majuscule, so we end reading and use the default. 566 ;; It was a majuscule, so we end reading and use the default.
570 (if mimic (message "%c %c %c" prefix hchar tchar) 567 (if mimic (message "%c %c %c" prefix hchar tchar)
571 (message "")) 568 (message ""))
594 (eq tchar 114) 591 (eq tchar 114)
595 (eq (- pchar 4) 111)) 592 (eq (- pchar 4) 111))
596 (error "You rang?")) 593 (error "You rang?"))
597 (if mimic 594 (if mimic
598 (error "%c %c %c %c" prefix hchar tchar pchar) 595 (error "%c %c %c %c" prefix hchar tchar pchar)
599 (error "")))) 596 (error "Illegal match duration"))))
600 ;; Always kill the score help buffer. 597 ;; Always kill the score help buffer.
601 (gnus-score-kill-help-buffer)) 598 (gnus-score-kill-help-buffer))
602 599
603 ;; We have all the data, so we enter this score. 600 ;; We have all the data, so we enter this score.
604 (setq match (if (string= (nth 2 entry) "") "" 601 (setq match (if (string= (nth 2 entry) "") ""
2453 (goto-char (point-min)) 2450 (goto-char (point-min))
2454 ;; Deal with "not."s. 2451 ;; Deal with "not."s.
2455 (if (looking-at "not.") 2452 (if (looking-at "not.")
2456 (progn 2453 (progn
2457 (setq not-match t) 2454 (setq not-match t)
2458 (setq regexp (concat "^" (buffer-substring 5 (point-max))))) 2455 (setq regexp (concat "^" (buffer-substring 5 (point-max)) "$")))
2459 (setq regexp (concat "^" (buffer-substring 1 (point-max)))) 2456 (setq regexp (concat "^" (buffer-substring 1 (point-max)) "$"))
2460 (setq not-match nil)) 2457 (setq not-match nil))
2461 ;; Finally - if this resulting regexp matches the group name, 2458 ;; Finally - if this resulting regexp matches the group name,
2462 ;; we add this score file to the list of score files 2459 ;; we add this score file to the list of score files
2463 ;; applicable to this group. 2460 ;; applicable to this group.
2464 (when (or (and not-match 2461 (when (or (and not-match