Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-score.el @ 2:ac2d302a0011 r19-15b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children 0293115a14e9
comparison
equal deleted inserted replaced
1:c0c6a60d29db 2:ac2d302a0011
390 (gnus-score-kill-help-buffer) 390 (gnus-score-kill-help-buffer)
391 (unless (setq type (nth 1 (assq (downcase tchar) char-to-type))) 391 (unless (setq type (nth 1 (assq (downcase tchar) char-to-type)))
392 (if mimic (error "%c %c" prefix hchar) (error ""))) 392 (if mimic (error "%c %c" prefix hchar) (error "")))
393 393
394 (when (/= (downcase tchar) tchar) 394 (when (/= (downcase tchar) tchar)
395 ;; It was a majuscle, so we end reading and the the default. 395 ;; It was a majuscle, so we end reading and use the default.
396 (if mimic (message "%c %c %c" prefix hchar tchar) 396 (if mimic (message "%c %c %c" prefix hchar tchar)
397 (message "")) 397 (message ""))
398 (setq pchar (or pchar ?p))) 398 (setq pchar (or pchar ?p)))
399 399
400 ;; We continue reading. 400 ;; We continue reading.
549 (cond ((or (eq type 'r) (eq type 's) (eq type nil)) 549 (cond ((or (eq type 'r) (eq type 's) (eq type nil))
550 (setq match (if match (gnus-simplify-subject-re match) ""))) 550 (setq match (if match (gnus-simplify-subject-re match) "")))
551 ((eq type 'f) 551 ((eq type 'f)
552 (setq match (gnus-simplify-subject-fuzzy match)))) 552 (setq match (gnus-simplify-subject-fuzzy match))))
553 (let ((score (gnus-score-default score)) 553 (let ((score (gnus-score-default score))
554 (header (downcase header)) 554 (header (format "%s" (downcase header)))
555 new) 555 new)
556 (and prompt (setq match (read-string 556 (and prompt (setq match (read-string
557 (format "Match %s on %s, %s: " 557 (format "Match %s on %s, %s: "
558 (cond ((eq date 'now) 558 (cond ((eq date 'now)
559 "now") 559 "now")
563 header 563 header
564 (if (< score 0) "lower" "raise")) 564 (if (< score 0) "lower" "raise"))
565 (if (numberp match) 565 (if (numberp match)
566 (int-to-string match) 566 (int-to-string match)
567 match)))) 567 match))))
568
569 ;; Get rid of string props.
570 (setq match (format "%s" match))
568 571
569 ;; If this is an integer comparison, we transform from string to int. 572 ;; If this is an integer comparison, we transform from string to int.
570 (and (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer) 573 (and (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
571 (setq match (string-to-int match))) 574 (setq match (string-to-int match)))
572 575
707 710
708 (defun gnus-score-set-expunge-below (score) 711 (defun gnus-score-set-expunge-below (score)
709 "Automatically expunge articles with score below SCORE." 712 "Automatically expunge articles with score below SCORE."
710 (interactive 713 (interactive
711 (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) 714 (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
712 (string-to-int (read-string "Expunge below: "))))) 715 (string-to-int (read-string "Set expunge below: ")))))
713 (setq score (or score gnus-summary-default-score 0)) 716 (setq score (or score gnus-summary-default-score 0))
714 (gnus-score-set 'expunge (list score)) 717 (gnus-score-set 'expunge (list score))
715 (gnus-score-set 'touched '(t))) 718 (gnus-score-set 'touched '(t)))
716 719
717 (defun gnus-score-followup-article (&optional score) 720 (defun gnus-score-followup-article (&optional score)
718 "Add SCORE to all followups to the article in the current buffer." 721 "Add SCORE to all followups to the article in the current buffer."
719 (interactive "P") 722 (interactive "P")
720 (setq score (gnus-score-default score)) 723 (setq score (gnus-score-default score))
721 (when (gnus-buffer-live-p gnus-summary-buffer) 724 (when (gnus-buffer-live-p gnus-summary-buffer)
722 (save-excursion 725 (save-excursion
723 (set-buffer gnus-summary-buffer)
724 (save-restriction 726 (save-restriction
725 (goto-char (point-min)) 727 (goto-char (point-min))
726 (let ((id (mail-fetch-field "message-id"))) 728 (let ((id (mail-fetch-field "message-id")))
727 (when id 729 (when id
730 (set-buffer gnus-summary-buffer)
728 (gnus-summary-score-entry 731 (gnus-summary-score-entry
729 "references" (concat id "[ \t]*$") 'r 732 "references" (concat id "[ \t]*$") 'r
730 score (current-time-string) nil t))))))) 733 score (current-time-string) nil t)))))))
731 734
732 (defun gnus-score-followup-thread (&optional score) 735 (defun gnus-score-followup-thread (&optional score)
733 "Add SCORE to all later articles in the thread the current buffer is part of." 736 "Add SCORE to all later articles in the thread the current buffer is part of."
734 (interactive "P") 737 (interactive "P")
735 (setq score (gnus-score-default score)) 738 (setq score (gnus-score-default score))
736 (when (gnus-buffer-live-p gnus-summary-buffer) 739 (when (gnus-buffer-live-p gnus-summary-buffer)
737 (save-excursion 740 (save-excursion
738 (set-buffer gnus-summary-buffer)
739 (save-restriction 741 (save-restriction
740 (goto-char (point-min)) 742 (goto-char (point-min))
741 (let ((id (mail-fetch-field "message-id"))) 743 (let ((id (mail-fetch-field "message-id")))
742 (when id 744 (when id
745 (set-buffer gnus-summary-buffer)
743 (gnus-summary-score-entry 746 (gnus-summary-score-entry
744 "references" id 's 747 "references" id 's
745 score (current-time-string)))))))) 748 score (current-time-string))))))))
746 749
747 (defun gnus-score-set (symbol value &optional alist) 750 (defun gnus-score-set (symbol value &optional alist)