emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-score.el [emacs-unicode-2]


From: Miles Bader
Subject: [Emacs-diffs] Changes to emacs/lisp/gnus/gnus-score.el [emacs-unicode-2]
Date: Thu, 09 Sep 2004 08:12:16 -0400

Index: emacs/lisp/gnus/gnus-score.el
diff -c emacs/lisp/gnus/gnus-score.el:1.13.4.2 
emacs/lisp/gnus/gnus-score.el:1.13.4.3
*** emacs/lisp/gnus/gnus-score.el:1.13.4.2      Fri Apr 16 12:50:15 2004
--- emacs/lisp/gnus/gnus-score.el       Thu Sep  9 09:36:25 2004
***************
*** 1,5 ****
  ;;; gnus-score.el --- scoring code for Gnus
! ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2004
  ;;        Free Software Foundation, Inc.
  
  ;; Author: Per Abrahamsen <address@hidden>
--- 1,5 ----
  ;;; gnus-score.el --- scoring code for Gnus
! ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
  ;;        Free Software Foundation, Inc.
  
  ;; Author: Per Abrahamsen <address@hidden>
***************
*** 32,40 ****
--- 32,43 ----
  (require 'gnus)
  (require 'gnus-sum)
  (require 'gnus-range)
+ (require 'gnus-win)
  (require 'message)
  (require 'score-mode)
  
+ (autoload 'ffap-string-at-point "ffap")
+ 
  (defcustom gnus-global-score-files nil
    "List of global score files and directories.
  Set this variable if you want to use people's score files.  One entry
***************
*** 47,53 ****
  
   (setq gnus-global-score-files
         '(\"/ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE\"
!          \"/ftp.some-where:/pub/score\"))"
    :group 'gnus-score-files
    :type '(repeat file))
  
--- 50,56 ----
  
   (setq gnus-global-score-files
         '(\"/ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE\"
!        \"/ftp.some-where:/pub/score\"))"
    :group 'gnus-score-files
    :type '(repeat file))
  
***************
*** 232,237 ****
--- 235,246 ----
                                             (symbol :tag "other"))
                                     (integer :tag "Score"))))))
  
+ (defcustom gnus-adaptive-word-length-limit nil
+   "*Words of a length lesser than this limit will be ignored when doing 
adaptive scoring."
+   :group 'gnus-score-adapt
+   :type '(radio (const :format "Unlimited " nil)
+               (integer :format "Maximum length: %v\n" :size 0)))
+ 
  (defcustom gnus-ignored-adaptive-words nil
    "List of words to be ignored when doing adaptive word scoring."
    :group 'gnus-score-adapt
***************
*** 483,489 ****
    "Make a score entry based on the current article.
  The user will be prompted for header to score on, match type,
  permanence, and the string to be used.  The numerical prefix will be
! used as score."
    (interactive (gnus-interactive "P\ny"))
    (gnus-summary-increase-score (- (gnus-score-delta-default score)) symp))
  
--- 492,499 ----
    "Make a score entry based on the current article.
  The user will be prompted for header to score on, match type,
  permanence, and the string to be used.  The numerical prefix will be
! used as score.  A symbolic prefix of `a' says to use the `all.SCORE'
! file for the command instead of the current score file."
    (interactive (gnus-interactive "P\ny"))
    (gnus-summary-increase-score (- (gnus-score-delta-default score)) symp))
  
***************
*** 497,503 ****
    "Make a score entry based on the current article.
  The user will be prompted for header to score on, match type,
  permanence, and the string to be used.  The numerical prefix will be
! used as score."
    (interactive (gnus-interactive "P\ny"))
    (let* ((nscore (gnus-score-delta-default score))
         (prefix (if (< nscore 0) ?L ?I))
--- 507,514 ----
    "Make a score entry based on the current article.
  The user will be prompted for header to score on, match type,
  permanence, and the string to be used.  The numerical prefix will be
! used as score.  A symbolic prefix of `a' says to use the `all.SCORE'
! file for the command instead of the current score file."
    (interactive (gnus-interactive "P\ny"))
    (let* ((nscore (gnus-score-delta-default score))
         (prefix (if (< nscore 0) ?L ?I))
***************
*** 637,643 ****
          (and gnus-extra-headers
               (equal (nth 1 entry) "extra")
               (intern                  ; need symbol
!               (gnus-completing-read
                 (symbol-name (car gnus-extra-headers)) ; default response
                 "Score extra header:"  ; prompt
                 (mapcar (lambda (x)    ; completion list
--- 648,654 ----
          (and gnus-extra-headers
               (equal (nth 1 entry) "extra")
               (intern                  ; need symbol
!               (gnus-completing-read-with-default
                 (symbol-name (car gnus-extra-headers)) ; default response
                 "Score extra header:"  ; prompt
                 (mapcar (lambda (x)    ; completion list
***************
*** 729,741 ****
        (insert (format format (caar alist) (nth idx (car alist))))
        (setq alist (cdr alist))
        (setq i (1+ i))))
      ;; display ourselves in a small window at the bottom
      (gnus-appt-select-lowest-window)
!     (split-window)
!     (pop-to-buffer "*Score Help*")
      (let ((window-min-height 1))
        (shrink-window-if-larger-than-buffer))
!     (select-window (get-buffer-window gnus-summary-buffer t))))
  
  (defun gnus-summary-header (header &optional no-err extra)
    ;; Return HEADER for current articles, or error.
--- 740,755 ----
        (insert (format format (caar alist) (nth idx (car alist))))
        (setq alist (cdr alist))
        (setq i (1+ i))))
+     (goto-char (point-min))
      ;; display ourselves in a small window at the bottom
      (gnus-appt-select-lowest-window)
!     (if (< (/ (window-height) 2) window-min-height)
!       (switch-to-buffer "*Score Help*")
!       (split-window)
!       (pop-to-buffer "*Score Help*"))
      (let ((window-min-height 1))
        (shrink-window-if-larger-than-buffer))
!     (select-window (gnus-get-buffer-window gnus-summary-buffer t))))
  
  (defun gnus-summary-header (header &optional no-err extra)
    ;; Return HEADER for current articles, or error.
***************
*** 863,869 ****
      ;; Return the new scoring rule.
      new))
  
! (defun gnus-summary-score-effect (header match type score extra)
    "Simulate the effect of a score file entry.
  HEADER is the header being scored.
  MATCH is the string we are looking for.
--- 877,883 ----
      ;; Return the new scoring rule.
      new))
  
! (defun gnus-summary-score-effect (header match type score &optional extra)
    "Simulate the effect of a score file entry.
  HEADER is the header being scored.
  MATCH is the string we are looking for.
***************
*** 875,882 ****
                                      (lambda (x) (fboundp (nth 2 x)))
                                      t)
                     (read-string "Match: ")
!                    (y-or-n-p "Use regexp match? ")
!                    (prefix-numeric-value current-prefix-arg)))
    (save-excursion
      (unless (and (stringp match) (> (length match) 0))
        (error "No match"))
--- 889,896 ----
                                      (lambda (x) (fboundp (nth 2 x)))
                                      t)
                     (read-string "Match: ")
!                    (if (y-or-n-p "Use regexp match? ") 'r 's)
!                    (string-to-int (read-string "Score: "))))
    (save-excursion
      (unless (and (stringp match) (> (length match) 0))
        (error "No match"))
***************
*** 926,932 ****
  
  ;; All score code written by Per Abrahamsen <address@hidden>.
  
- ;; Added by Per Abrahamsen <address@hidden>.
  (defun gnus-score-set-mark-below (score)
    "Automatically mark articles with score below SCORE as read."
    (interactive
--- 940,945 ----
***************
*** 1093,1098 ****
--- 1106,1144 ----
     4 (substitute-command-keys
        "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
  
+ (defun gnus-score-edit-file-at-point (&optional format)
+   "Edit score file at point in Score Trace buffers.
+ If FORMAT, also format the current score file."
+   (let* ((rule (save-excursion
+                (beginning-of-line)
+                (read (current-buffer))))
+        (sep "[ \n\r\t]*")
+        ;; Must be synced with `gnus-score-find-trace':
+        (reg " -> +")
+        (file (save-excursion
+                (end-of-line)
+                (if (and (re-search-backward reg (gnus-point-at-bol) t)
+                         (re-search-forward  reg (gnus-point-at-eol) t))
+                    (buffer-substring (point) (gnus-point-at-eol))
+                  nil))))
+     (if (or (not file)
+           (string-match "\\<\\(non-file rule\\|A file\\)\\>" file)
+           ;; (see `gnus-score-find-trace' and `gnus-score-advanced')
+           (string= "" file))
+       (gnus-error 3 "Can't find a score file in current line.")
+       (gnus-score-edit-file file)
+       (when format
+       (gnus-score-pretty-print))
+       (when (consp rule) ;; the rule exists
+       (setq rule (mapconcat #'(lambda (obj)
+                                 (regexp-quote (format "%S" obj)))
+                             rule
+                             sep))
+       (goto-char (point-min))
+       (re-search-forward rule nil t)
+       ;; make it easy to use `kill-sexp':
+       (goto-char (1- (match-beginning 0)))))))
+ 
  (defun gnus-score-load-file (file)
    ;; Load score file FILE.  Returns a list a retrieved score-alists.
    (let* ((file (expand-file-name
***************
*** 1143,1149 ****
          (mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist)))
          (files (gnus-score-get 'files alist))
          (exclude-files (gnus-score-get 'exclude-files alist))
!           (orphan (car (gnus-score-get 'orphan alist)))
          (adapt (gnus-score-get 'adapt alist))
          (thread-mark-and-expunge
           (car (gnus-score-get 'thread-mark-and-expunge alist)))
--- 1189,1195 ----
          (mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist)))
          (files (gnus-score-get 'files alist))
          (exclude-files (gnus-score-get 'exclude-files alist))
!         (orphan (car (gnus-score-get 'orphan alist)))
          (adapt (gnus-score-get 'adapt alist))
          (thread-mark-and-expunge
           (car (gnus-score-get 'thread-mark-and-expunge alist)))
***************
*** 1202,1208 ****
                   (setq gnus-newsgroup-adaptive t)
                   adapt)
                  (t
-                  ;;(setq gnus-newsgroup-adaptive gnus-use-adaptive-scoring)
                   gnus-default-adaptive-score-alist)))
        (setq gnus-thread-expunge-below
            (or thread-mark-and-expunge gnus-thread-expunge-below))
--- 1248,1253 ----
***************
*** 1366,1372 ****
              ;; This is a normal score file, so we print it very
              ;; prettily.
              (let ((lisp-mode-syntax-table score-mode-syntax-table))
!               (pp score (current-buffer)))))
          (gnus-make-directory (file-name-directory file))
          ;; If the score file is empty, we delete it.
          (if (zerop (buffer-size))
--- 1411,1417 ----
              ;; This is a normal score file, so we print it very
              ;; prettily.
              (let ((lisp-mode-syntax-table score-mode-syntax-table))
!               (gnus-pp score))))
          (gnus-make-directory (file-name-directory file))
          ;; If the score file is empty, we delete it.
          (if (zerop (buffer-size))
***************
*** 1428,1434 ****
               (headers gnus-newsgroup-headers)
               (current-score-file gnus-current-score-file)
               entry header new)
!         (gnus-message 5 "Scoring...")
          ;; Create articles, an alist of the form `(HEADER . SCORE)'.
          (while (setq header (pop headers))
            ;; WARNING: The assq makes the function O(N*S) while it could
--- 1473,1479 ----
               (headers gnus-newsgroup-headers)
               (current-score-file gnus-current-score-file)
               entry header new)
!         (gnus-message 7 "Scoring...")
          ;; Create articles, an alist of the form `(HEADER . SCORE)'.
          (while (setq header (pop headers))
            ;; WARNING: The assq makes the function O(N*S) while it could
***************
*** 1470,1476 ****
                (with-current-buffer gnus-summary-buffer
                  (setq gnus-newsgroup-scored scored))))
            ;; Remove the buffer.
!           (kill-buffer (current-buffer)))
  
          ;; Add articles to `gnus-newsgroup-scored'.
          (while gnus-scores-articles
--- 1515,1521 ----
                (with-current-buffer gnus-summary-buffer
                  (setq gnus-newsgroup-scored scored))))
            ;; Remove the buffer.
!           (gnus-kill-buffer (current-buffer)))
  
          ;; Add articles to `gnus-newsgroup-scored'.
          (while gnus-scores-articles
***************
*** 1489,1495 ****
                  (gnus-score-advanced (car score) trace))
                (pop score))))
  
!         (gnus-message 5 "Scoring...done"))))))
  
  (defun gnus-score-lower-thread (thread score-adjust)
    "Lower the score on THREAD with SCORE-ADJUST.
--- 1534,1540 ----
                  (gnus-score-advanced (car score) trace))
                (pop score))))
  
!         (gnus-message 7 "Scoring...done"))))))
  
  (defun gnus-score-lower-thread (thread score-adjust)
    "Lower the score on THREAD with SCORE-ADJUST.
***************
*** 1516,1536 ****
  which has references, but is not connected via its references to a
  root article.  This function finds all the orphans, and adjusts their
  score in `gnus-newsgroup-scored' by SCORE."
!   (let ((threads (gnus-make-threads)))
!     ;; gnus-make-threads produces a list, where each entry is a "thread"
!     ;; as described in the gnus-score-lower-thread docs.  This function
!     ;; will be called again (after limiting has been done) if the display
!     ;; is threaded.  It would be nice to somehow save this info and use
!     ;; it later.
!     (while threads
!       (let* ((thread (car threads))
!            (id (aref (car thread) gnus-score-index)))
!       ;; If the parent of the thread is not a root, lower the score of
!       ;; it and its descendants.  Note that some roots seem to satisfy
!       ;; (eq id nil) and some (eq id "");  not sure why.
!       (if (and id (not (string= id "")))
!           (gnus-score-lower-thread thread score)))
!       (setq threads (cdr threads)))))
  
  (defun gnus-score-integer (scores header now expire &optional trace)
    (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
--- 1561,1579 ----
  which has references, but is not connected via its references to a
  root article.  This function finds all the orphans, and adjusts their
  score in `gnus-newsgroup-scored' by SCORE."
!   ;; gnus-make-threads produces a list, where each entry is a "thread"
!   ;; as described in the gnus-score-lower-thread docs.  This function
!   ;; will be called again (after limiting has been done) if the display
!   ;; is threaded.  It would be nice to somehow save this info and use
!   ;; it later.
!   (dolist (thread (gnus-make-threads))
!     (let ((id (aref (car thread) gnus-score-index)))
!       ;; If the parent of the thread is not a root, lower the score of
!       ;; it and its descendants.  Note that some roots seem to satisfy
!       ;; (eq id nil) and some (eq id "");  not sure why.
!       (when (and id
!                (not (string= id "")))
!       (gnus-score-lower-thread thread score)))))
  
  (defun gnus-score-integer (scores header now expire &optional trace)
    (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
***************
*** 1718,1724 ****
                        (setq found t)
                        (when trace
                          (push
!                          (cons (car-safe (rassq alist gnus-score-cache)) kill)
                           gnus-score-trace)))
                      ;; Update expire date
                      (unless trace
--- 1761,1768 ----
                        (setq found t)
                        (when trace
                          (push
!                          (cons (car-safe (rassq alist gnus-score-cache))
!                                kill)
                           gnus-score-trace)))
                      ;; Update expire date
                      (unless trace
***************
*** 1776,1782 ****
            (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))
  
--- 1820,1826 ----
            (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))
  
***************
*** 1785,1791 ****
        (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))
--- 1829,1835 ----
        (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))
***************
*** 1805,1811 ****
            (goto-char (point-min))
            (if (= dmt ?e)
                (while (funcall search-func match nil t)
!                 (and (= (progn (beginning-of-line) (point))
                          (match-beginning 0))
                       (= (progn (end-of-line) (point))
                          (match-end 0))
--- 1849,1855 ----
            (goto-char (point-min))
            (if (= dmt ?e)
                (while (funcall search-func match nil t)
!                 (and (= (gnus-point-at-bol)
                          (match-beginning 0))
                       (= (progn (end-of-line) (point))
                          (match-end 0))
***************
*** 1824,1829 ****
--- 1868,1879 ----
                (setq found (setq arts (get-text-property (point) 'articles)))
                ;; Found a match, update scores.
                (while (setq art (pop arts))
+                 (setcdr art (+ score (cdr art)))
+                 (when trace
+                   (push (cons
+                          (car-safe (rassq alist gnus-score-cache))
+                          kill)
+                         gnus-score-trace))
                  (when (setq new (gnus-score-add-followups
                                   (car art) score all-scores thread))
                    (push new news)))))
***************
*** 1871,1878 ****
    ;; 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.
!         (simplify (and gnus-score-thread-simplify
!                        (string= "subject" header)))
        alike last this art entries alist articles
        fuzzies arts words kill)
  
--- 1921,1928 ----
    ;; 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.
!       (simplify (and gnus-score-thread-simplify
!                      (string= "subject" header)))
        alike last this art entries alist articles
        fuzzies arts words kill)
  
***************
*** 1897,1903 ****
        ;; with working on them as a group.  What a hassle.
        ;; Just wait 'til you see what horrors we commit against `match'...
        (if (= gnus-score-index 9)
!         (setq this (prin1-to-string this))) ; ick.
  
        (if simplify
          (setq this (gnus-map-function gnus-simplify-subject-functions this)))
--- 1947,1953 ----
        ;; with working on them as a group.  What a hassle.
        ;; Just wait 'til you see what horrors we commit against `match'...
        (if (= gnus-score-index 9)
!         (setq this (gnus-prin1-to-string this))) ; ick.
  
        (if simplify
          (setq this (gnus-map-function gnus-simplify-subject-functions this)))
***************
*** 1936,1945 ****
               (dmt (downcase mt))
               ;; Assume user already simplified regexp and fuzzies
               (match (if (and simplify (not (memq dmt '(?f ?r))))
!                           (gnus-map-function
!                            gnus-simplify-subject-functions
!                            (nth 0 kill))
!                         (nth 0 kill)))
               (search-func
                (cond ((= dmt ?r) 're-search-forward)
                      ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
--- 1986,1995 ----
               (dmt (downcase mt))
               ;; Assume user already simplified regexp and fuzzies
               (match (if (and simplify (not (memq dmt '(?f ?r))))
!                         (gnus-map-function
!                          gnus-simplify-subject-functions
!                          (nth 0 kill))
!                       (nth 0 kill)))
               (search-func
                (cond ((= dmt ?r) 're-search-forward)
                      ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
***************
*** 1949,1955 ****
          ;; Evil hackery to make match usable in non-standard headers.
          (when extra
            (setq match (concat "[ (](" extra " \\. \"[^)]*"
!                               match "[^(]*\")[ )]")
                  search-func 're-search-forward)) ; XXX danger?!?
  
          (cond
--- 1999,2005 ----
          ;; Evil hackery to make match usable in non-standard headers.
          (when extra
            (setq match (concat "[ (](" extra " \\. \"[^)]*"
!                               match "[^\"]*\")[ )]")
                  search-func 're-search-forward)) ; XXX danger?!?
  
          (cond
***************
*** 2275,2285 ****
                      ;; Put the word and score into the hashtb.
                      (setq val (gnus-gethash (setq word (match-string 0))
                                              hashtb))
!                     (setq val (+ score (or val 0)))
!                     (if (and gnus-adaptive-word-minimum
!                              (< val gnus-adaptive-word-minimum))
!                         (setq val gnus-adaptive-word-minimum))
!                     (gnus-sethash word val hashtb))
                    (erase-buffer))))
            (set-syntax-table syntab))
          ;; Make all the ignorable words ignored.
--- 2325,2338 ----
                      ;; Put the word and score into the hashtb.
                      (setq val (gnus-gethash (setq word (match-string 0))
                                              hashtb))
!                     (when (or (not gnus-adaptive-word-length-limit)
!                               (> (length word)
!                                  gnus-adaptive-word-length-limit))
!                       (setq val (+ score (or val 0)))
!                       (if (and gnus-adaptive-word-minimum
!                                (< val gnus-adaptive-word-minimum))
!                           (setq val gnus-adaptive-word-minimum))
!                       (gnus-sethash word val hashtb)))
                    (erase-buffer))))
            (set-syntax-table syntab))
          ;; Make all the ignorable words ignored.
***************
*** 2318,2324 ****
      (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)
--- 2371,2380 ----
      (let ((gnus-newsgroup-headers
           (list (gnus-summary-article-header)))
          (gnus-newsgroup-scored nil)
!         ;; Must be synced with `gnus-score-edit-file-at-point':
!         (frmt "%S [%s] -> %s\n")
!         trace
!         file)
        (save-excursion
        (nnheader-set-temp-buffer "*Score Trace*"))
        (setq gnus-score-trace nil)
***************
*** 2328,2338 ****
           1 "No score rules apply to the current article (default score %d)."
           gnus-summary-default-score)
        (set-buffer "*Score Trace*")
        (setq truncate-lines t)
!       (while trace
!         (insert (format "%S  ->  %s\n" (cdar trace)
!                         (or (caar trace) "(non-file rule)")))
!         (setq trace (cdr trace)))
        (goto-char (point-min))
        (gnus-configure-windows 'score-trace)))
      (set-buffer gnus-summary-buffer)
--- 2384,2427 ----
           1 "No score rules apply to the current article (default score %d)."
           gnus-summary-default-score)
        (set-buffer "*Score Trace*")
+       ;; Use a keymap instead?
+       (local-set-key "q"
+                      (lambda ()
+                        (interactive)
+                        (bury-buffer nil)
+                        (gnus-summary-expand-window)))
+       (local-set-key "e" (lambda ()
+                            "Run `gnus-score-edit-file-at-point'."
+                            (interactive)
+                            (gnus-score-edit-file-at-point)))
+       (local-set-key "f" (lambda ()
+                            "Run `gnus-score-edit-file-at-point'."
+                            (interactive)
+                            (gnus-score-edit-file-at-point 'format)))
+       (local-set-key "t" 'toggle-truncate-lines)
        (setq truncate-lines t)
!       (dolist (entry trace)
!         (setq file (or (car entry)
!                        ;; Must be synced with
!                        ;; `gnus-score-edit-file-at-point':
!                        "(non-file rule)"))
!         (insert
!          (format frmt
!                  (cdr entry)
!                  ;; Don't use `file-name-sans-extension' to see .SCORE and
!                  ;; .ADAPT directly:
!                  (file-name-nondirectory file)
!                  (abbreviate-file-name file))))
!       (insert
!        "\n\nQuick help:
! 
! Type `e' to edit score file corresponding to the score rule on current line,
! `f' to format (pretty print) the score file and edit it,
! `t' toggle to truncate long lines in this buffer,
! `q' to quit.
! 
! The first sexp on each line is the score rule, followed by the file name of
! the score file and its full name, including the directory.")
        (goto-char (point-min))
        (gnus-configure-windows 'score-trace)))
      (set-buffer gnus-summary-buffer)
***************
*** 2460,2466 ****
  (defun gnus-summary-lower-thread (&optional score)
    "Lower score of articles in the current thread with SCORE."
    (interactive "P")
!   (gnus-summary-raise-thread (- (1- (gnus-score-delta-default score)))))
  
  ;;; Finding score files.
  
--- 2549,2555 ----
  (defun gnus-summary-lower-thread (&optional score)
    "Lower score of articles in the current thread with SCORE."
    (interactive "P")
!   (gnus-summary-raise-thread (- (gnus-score-delta-default score))))
  
  ;;; Finding score files.
  
***************
*** 2522,2528 ****
        (push file out))))
      (or out
        ;; Return a dummy value.
!       (list "~/News/this.file.does.not.exist.SCORE"))))
  
  (defun gnus-score-file-regexp ()
    "Return a regexp that match all score files."
--- 2611,2618 ----
        (push file out))))
      (or out
        ;; Return a dummy value.
!       (list (expand-file-name "this.file.does.not.exist.SCORE"
!                               gnus-kill-files-directory)))))
  
  (defun gnus-score-file-regexp ()
    "Return a regexp that match all score files."
***************
*** 2586,2596 ****
            (replace-match ".*" t t))
          (goto-char (point-min))
          ;; Deal with "not."s.
!         (setq not-match (looking-at "not."))
!         (setq regexp
!               (concat "^" (buffer-substring (+ (point-min) (if not-match 4 0))
!                                             (point-max))
!                       "$"))
          ;; Finally - if this resulting regexp matches the group name,
          ;; we add this score file to the list of score files
          ;; applicable to this group.
--- 2676,2688 ----
            (replace-match ".*" t t))
          (goto-char (point-min))
          ;; Deal with "not."s.
!         (if (looking-at "not.")
!             (progn
!               (setq not-match t)
!               (setq regexp
!                     (concat "^" (buffer-substring 5 (point-max)) "$")))
!           (setq regexp (concat "^" (buffer-substring 1 (point-max)) "$"))
!           (setq not-match nil))
          ;; Finally - if this resulting regexp matches the group name,
          ;; we add this score file to the list of score files
          ;; applicable to this group.
***************
*** 2601,2607 ****
                         (ignore-errors (string-match regexp group-trans))))
            (push (car sfiles) ofiles)))
        (setq sfiles (cdr sfiles)))
!       (kill-buffer (current-buffer))
        ;; Slight kludge here - the last score file returned should be
        ;; the local score file, whether it exists or not.  This is so
        ;; that any score commands the user enters will go to the right
--- 2693,2699 ----
                         (ignore-errors (string-match regexp group-trans))))
            (push (car sfiles) ofiles)))
        (setq sfiles (cdr sfiles)))
!       (gnus-kill-buffer (current-buffer))
        ;; Slight kludge here - the last score file returned should be
        ;; the local score file, whether it exists or not.  This is so
        ;; that any score commands the user enters will go to the right
***************
*** 2733,2741 ****
        ;; Go through all the functions for finding score files (or actual
        ;; scores) and add them to a list.
        (while funcs
!       (when (gnus-functionp (car funcs))
          (setq score-files
!               (nconc score-files (nreverse (funcall (car funcs) group)))))
        (setq funcs (cdr funcs)))
        (when gnus-score-use-all-scores
        ;; Add any home score files.
--- 2825,2834 ----
        ;; Go through all the functions for finding score files (or actual
        ;; scores) and add them to a list.
        (while funcs
!       (when (functionp (car funcs))
          (setq score-files
!               (append score-files
!                       (nreverse (funcall (car funcs) group)))))
        (setq funcs (cdr funcs)))
        (when gnus-score-use-all-scores
        ;; Add any home score files.
***************
*** 2800,2806 ****
    (let (out)
      (while files
        ;; #### /$ Unix-specific?
!       (if (string-match "/$" (car files))
          (setq out (nconc (directory-files
                            (car files) t
                            (concat (gnus-score-file-regexp) "$"))))
--- 2893,2899 ----
    (let (out)
      (while files
        ;; #### /$ Unix-specific?
!       (if (file-directory-p (car files))
          (setq out (nconc (directory-files
                            (car files) t
                            (concat (gnus-score-file-regexp) "$"))))
***************
*** 2835,2850 ****
             ((stringp elem)
              elem)
             ;; Function.
!            ((gnus-functionp elem)
              (funcall elem group))
             ;; Regexp-file cons.
             ((consp elem)
              (when (string-match (gnus-globalify-regexp (car elem)) group)
                (replace-match (cadr elem) t nil group))))))
      (when found
        (if (file-name-absolute-p found)
!           found
!         (nnheader-concat gnus-kill-files-directory found)))))
  
  (defun gnus-hierarchial-home-score-file (group)
    "Return the score file of the top-level hierarchy of GROUP."
--- 2928,2944 ----
             ((stringp elem)
              elem)
             ;; Function.
!            ((functionp elem)
              (funcall elem group))
             ;; Regexp-file cons.
             ((consp elem)
              (when (string-match (gnus-globalify-regexp (car elem)) group)
                (replace-match (cadr elem) t nil group))))))
      (when found
+       (setq found (nnheader-translate-file-chars found))
        (if (file-name-absolute-p found)
!         found
!       (nnheader-concat gnus-kill-files-directory found)))))
  
  (defun gnus-hierarchial-home-score-file (group)
    "Return the score file of the top-level hierarchy of GROUP."
***************
*** 2872,2884 ****
  
  (defun gnus-decay-score (score)
    "Decay SCORE according to `gnus-score-decay-constant' and 
`gnus-score-decay-scale'."
!   (floor
!    (- score
!       (* (if (< score 0) -1 1)
!        (min (abs score)
!             (max gnus-score-decay-constant
!                  (* (abs score)
!                     gnus-score-decay-scale)))))))
  
  (defun gnus-decay-scores (alist day)
    "Decay non-permanent scores in ALIST."
--- 2966,2984 ----
  
  (defun gnus-decay-score (score)
    "Decay SCORE according to `gnus-score-decay-constant' and 
`gnus-score-decay-scale'."
!   (let ((n (- score
!             (* (if (< score 0) -1 1)
!                (min (abs score)
!                     (max gnus-score-decay-constant
!                          (* (abs score)
!                             gnus-score-decay-scale)))))))
!     (if (and (featurep 'xemacs)
!            ;; XEmacs' floor can handle only the floating point
!            ;; number below the half of the maximum integer.
!            (> (abs n) (lsh -1 -2)))
!       (string-to-number
!        (car (split-string (number-to-string n) "\\.")))
!       (floor n))))
  
  (defun gnus-decay-scores (alist day)
    "Decay non-permanent scores in ALIST."
***************
*** 2911,2917 ****
  In the `bad' case, the string is a unsafe subexpression of REGEXP,
  and we do not have a simple replacement to suggest.
  
! See `(Gnus)Scoring Tips' for examples of good regular expressions."
    (let (case-fold-search)
      (and
       ;; First, try a relatively fast necessary condition.
--- 3011,3017 ----
  In the `bad' case, the string is a unsafe subexpression of REGEXP,
  and we do not have a simple replacement to suggest.
  
! See Info node `(gnus)Scoring Tips' for examples of good regular expressions."
    (let (case-fold-search)
      (and
       ;; First, try a relatively fast necessary condition.




reply via email to

[Prev in Thread] Current Thread [Next in Thread]