*** empty log message ***
[gnus] / lisp / gnus-sum.el
index 8ab5f13..3bda04e 100644 (file)
@@ -422,6 +422,123 @@ automatically when it is selected.")
 (defvar gnus-group-no-more-groups-hook nil
   "*A hook run when returning to group mode having no more (unread) groups.")
 
+(defvar gnus-summary-selected-face 'underline
+  "Face used for highlighting the current article in the summary buffer.")
+
+(defvar gnus-summary-highlight 
+  (cond
+   ((not (eq gnus-display-type 'color))
+    '(((> score default) . bold)
+      ((< score default) . italic)))
+   ((eq gnus-background-mode 'dark)
+    (list
+     (cons 
+      '(= mark gnus-canceled-mark)
+      (custom-face-lookup "yellow" "black" nil
+                         nil nil nil))
+     (cons '(and (> score default) 
+                (or (= mark gnus-dormant-mark)
+                    (= mark gnus-ticked-mark)))
+          (custom-face-lookup 
+           "pink" nil nil t nil nil))
+     (cons '(and (< score default) 
+                (or (= mark gnus-dormant-mark)
+                    (= mark gnus-ticked-mark)))
+          (custom-face-lookup "pink" nil nil 
+                              nil t nil))
+     (cons '(or (= mark gnus-dormant-mark)
+               (= mark gnus-ticked-mark))
+          (custom-face-lookup 
+           "pink" nil nil nil nil nil))
+
+     (cons
+      '(and (> score default) (= mark gnus-ancient-mark))
+      (custom-face-lookup "medium blue" nil nil t
+                         nil nil))
+     (cons 
+      '(and (< score default) (= mark gnus-ancient-mark))
+      (custom-face-lookup "SkyBlue" nil nil
+                         nil t nil))
+     (cons 
+      '(= mark gnus-ancient-mark)
+      (custom-face-lookup "SkyBlue" nil nil
+                         nil nil nil))
+     (cons '(and (> score default) (= mark gnus-unread-mark))
+          (custom-face-lookup "white" nil nil t
+                              nil nil))
+     (cons '(and (< score default) (= mark gnus-unread-mark))
+          (custom-face-lookup "white" nil nil
+                              nil t nil))
+     (cons '(= mark gnus-unread-mark)
+          (custom-face-lookup
+           "white" nil nil nil nil nil))
+
+     (cons '(> score default) 'bold)
+     (cons '(< score default) 'italic)))
+   (t
+    (list
+     (cons
+      '(= mark gnus-canceled-mark)
+      (custom-face-lookup
+       "yellow" "black" nil nil nil nil))
+     (cons '(and (> score default) 
+                (or (= mark gnus-dormant-mark)
+                    (= mark gnus-ticked-mark)))
+          (custom-face-lookup "firebrick" nil nil
+                              t nil nil))
+     (cons '(and (< score default) 
+                (or (= mark gnus-dormant-mark)
+                    (= mark gnus-ticked-mark)))
+          (custom-face-lookup "firebrick" nil nil
+                              nil t nil))
+     (cons 
+      '(or (= mark gnus-dormant-mark)
+          (= mark gnus-ticked-mark))
+      (custom-face-lookup 
+       "firebrick" nil nil nil nil nil))
+
+     (cons '(and (> score default) (= mark gnus-ancient-mark))
+          (custom-face-lookup "RoyalBlue" nil nil
+                              t nil nil))
+     (cons '(and (< score default) (= mark gnus-ancient-mark))
+          (custom-face-lookup "RoyalBlue" nil nil
+                              nil t nil))
+     (cons 
+      '(= mark gnus-ancient-mark)
+      (custom-face-lookup
+       "RoyalBlue" nil nil nil nil nil))
+
+     (cons '(and (> score default) (/= mark gnus-unread-mark))
+          (custom-face-lookup "DarkGreen" nil nil
+                              t nil nil))
+     (cons '(and (< score default) (/= mark gnus-unread-mark))
+          (custom-face-lookup "DarkGreen" nil nil
+                              nil t nil))
+     (cons
+      '(/= mark gnus-unread-mark)
+      (custom-face-lookup "DarkGreen" nil nil 
+                         nil nil nil))
+
+     (cons '(> score default) 'bold)
+     (cons '(< score default) 'italic))))
+  "Controls the highlighting of summary buffer lines. 
+
+Below is a list of `Form'/`Face' pairs.  When deciding how a a
+particular summary line should be displayed, each form is
+evaluated.  The content of the face field after the first true form is
+used.  You can change how those summary lines are displayed, by
+editing the face field.  
+
+It is also possible to change and add form fields, but currently that
+requires an understanding of Lisp expressions.  Hopefully this will
+change in a future release.  For now, you can use the following
+variables in the Lisp expression:
+
+score:   The article's score
+default: The default article score.
+below:   The score below which articles are automatically marked as read. 
+mark:    The article's mark.")
+
 ;;; Internal variables
 
 (defvar gnus-scores-exclude-files nil)
@@ -1114,7 +1231,6 @@ increase the score of each group you read."
          ["Clear above" gnus-summary-clear-above t])
         ["Current score" gnus-summary-current-score t]
         ["Set score" gnus-summary-set-score t]
-        ["Customize score file" gnus-score-customize t]
         ["Switch current score file..." gnus-score-change-score-file t]
         ["Set mark below..." gnus-score-set-mark-below t]
         ["Set expunge below..." gnus-score-set-expunge-below t]
@@ -2030,10 +2146,12 @@ This is all marks except unread, ticked, dormant, and expirable."
    (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
    (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
 
-(defun gnus-summary-insert-line
-  (gnus-tmp-header gnus-tmp-level gnus-tmp-current gnus-tmp-unread
-                  gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil
-                  &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process)
+(defun gnus-summary-insert-line (gnus-tmp-header 
+                                gnus-tmp-level gnus-tmp-current 
+                                gnus-tmp-unread gnus-tmp-replied 
+                                gnus-tmp-expirable gnus-tmp-subject-or-nil
+                                &optional gnus-tmp-dummy gnus-tmp-score 
+                                gnus-tmp-process)
   (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
         (gnus-tmp-lines (mail-header-lines gnus-tmp-header))
         (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
@@ -3828,38 +3946,6 @@ The resulting hash table is returned, or nil if no Xrefs were found."
 (defmacro gnus-nov-field ()
   '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
 
-;; Goes through the xover lines and returns a list of vectors
-(defun gnus-get-newsgroup-headers-xover (sequence &optional 
-                                                 force-new dependencies)
-  "Parse the news overview data in the server buffer, and return a
-list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
-  ;; Get the Xref when the users reads the articles since most/some
-  ;; NNTP servers do not include Xrefs when using XOVER.
-  (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
-  (let ((cur nntp-server-buffer)
-       (dependencies (or dependencies gnus-newsgroup-dependencies))
-       number headers header)
-    (save-excursion
-      (set-buffer nntp-server-buffer)
-      ;; Allow the user to mangle the headers before parsing them.
-      (run-hooks 'gnus-parse-headers-hook)
-      (goto-char (point-min))
-      (while (and sequence (not (eobp)))
-       (setq number (read cur))
-       (while (and sequence (< (car sequence) number))
-         (setq sequence (cdr sequence)))
-       (and sequence
-            (eq number (car sequence))
-            (progn
-              (setq sequence (cdr sequence))
-              (if (setq header
-                        (inline (gnus-nov-parse-line
-                                 number dependencies force-new)))
-                  (setq headers (cons header headers)))))
-       (forward-line 1))
-      (setq headers (nreverse headers)))
-    headers))
-
 ;; This function has to be called with point after the article number
 ;; on the beginning of the line.
 (defun gnus-nov-parse-line (number dependencies &optional force-new)
@@ -3872,70 +3958,100 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
     (narrow-to-region (point) eol)
     (or (eobp) (forward-char))
 
-    (condition-case nil
-       (setq header
-             (vector
-              number                   ; number
-              (gnus-nov-field)         ; subject
-              (gnus-nov-field)         ; from
-              (gnus-nov-field)         ; date
-              (setq id (or (gnus-nov-field)
-                           (concat "none+"
-                                   (int-to-string
-                                    (setq none (1+ none)))))) ; id
-              (progn
-                (save-excursion
-                  (let ((beg (point)))
-                    (search-forward "\t" eol)
-                    (if (search-backward ">" beg t)
-                        (setq ref
-                              (buffer-substring
-                               (1+ (point))
-                               (search-backward "<" beg t)))
-                      (setq ref nil))))
-                (gnus-nov-field))      ; refs
-              (gnus-nov-read-integer)  ; chars
-              (gnus-nov-read-integer)  ; lines
-              (if (= (following-char) ?\n)
-                  nil
-                (gnus-nov-field))      ; misc
-              ))
-      (error (progn
-              (gnus-error 4 "Strange nov line")
-              (setq header nil)
-              (goto-char eol))))
+    (setq header
+         (vector
+          number                       ; number
+          (gnus-nov-field)             ; subject
+          (gnus-nov-field)             ; from
+          (gnus-nov-field)             ; date
+          (setq id (or (gnus-nov-field)
+                       (concat "none+"
+                               (int-to-string
+                                (setq none (1+ none)))))) ; id
+          (progn
+            (save-excursion
+              (let ((beg (point)))
+                (search-forward "\t" eol)
+                (if (search-backward ">" beg t)
+                    (setq ref
+                          (buffer-substring
+                           (1+ (point))
+                           (search-backward "<" beg t)))
+                  (setq ref nil))))
+            (gnus-nov-field))          ; refs
+          (gnus-nov-read-integer)      ; chars
+          (gnus-nov-read-integer)      ; lines
+          (if (= (following-char) ?\n)
+              nil
+            (gnus-nov-field))          ; misc
+          ))
 
     (widen)
 
     ;; We build the thread tree.
-    (when header
-      (when (equal id ref)
-       ;; This article refers back to itself.  Naughty, naughty.
-       (setq ref nil))
-      (if (boundp (setq id-dep (intern id dependencies)))
-         (if (and (car (symbol-value id-dep))
-                  (not force-new))
-             ;; An article with this Message-ID has already been seen,
-             ;; so we ignore this one, except we add any additional
-             ;; Xrefs (in case the two articles came from different
-             ;; servers.
-             (progn
-               (mail-header-set-xref
-                (car (symbol-value id-dep))
-                (concat (or (mail-header-xref
-                             (car (symbol-value id-dep))) "")
-                        (or (mail-header-xref header) "")))
-               (setq header nil))
-           (setcar (symbol-value id-dep) header))
-       (set id-dep (list header))))
-    (when header
-      (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
-         (setcdr (symbol-value ref-dep)
-                 (nconc (cdr (symbol-value ref-dep))
-                        (list (symbol-value id-dep))))
-       (set ref-dep (list nil (symbol-value id-dep)))))
+    (when (equal id ref)
+      ;; This article refers back to itself.  Naughty, naughty.
+      (setq ref nil))
+    (if (boundp (setq id-dep (intern id dependencies)))
+       (if (and (car (symbol-value id-dep))
+                (not force-new))
+           ;; An article with this Message-ID has already been seen,
+           ;; so we ignore this one, except we add any additional
+           ;; Xrefs (in case the two articles came from different
+           ;; servers.
+           (progn
+             (mail-header-set-xref
+              (car (symbol-value id-dep))
+              (concat (or (mail-header-xref
+                           (car (symbol-value id-dep))) "")
+                      (or (mail-header-xref header) "")))
+             (setq header nil))
+         (setcar (symbol-value id-dep) header))
+      (set id-dep (list header)))
+    (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
+       (setcdr (symbol-value ref-dep)
+               (nconc (cdr (symbol-value ref-dep))
+                      (list (symbol-value id-dep))))
+      (set ref-dep (list nil (symbol-value id-dep))))
     header))
 
+;; Goes through the xover lines and returns a list of vectors
+(defun gnus-get-newsgroup-headers-xover (sequence &optional 
+                                                 force-new dependencies)
+  "Parse the news overview data in the server buffer, and return a
+list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
+  ;; Get the Xref when the users reads the articles since most/some
+  ;; NNTP servers do not include Xrefs when using XOVER.
+  (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
+  (let ((cur nntp-server-buffer)
+       (dependencies (or dependencies gnus-newsgroup-dependencies))
+       number headers header)
+    (save-excursion
+      (set-buffer nntp-server-buffer)
+      ;; Allow the user to mangle the headers before parsing them.
+      (run-hooks 'gnus-parse-headers-hook)
+      (goto-char (point-min))
+      (while (not (eobp))
+       (condition-case ()
+           (while (and sequence (not (eobp)))
+             (setq number (read cur))
+             (while (and sequence
+                         (< (car sequence) number))
+               (setq sequence (cdr sequence)))
+             (and sequence
+                  (eq number (car sequence))
+                  (progn
+                    (setq sequence (cdr sequence))
+                    (push (inline (gnus-nov-parse-line
+                                   number dependencies force-new))
+                          headers)))
+             (forward-line 1))
+         (error
+          (progn
+            (gnus-error 4 "Strange nov line")
+            (forward-line 1)))))
+      (nreverse headers))))
+
 (defun gnus-article-get-xrefs ()
   "Fill in the Xref value in `gnus-current-headers', if necessary.
 This is meant to be called in `gnus-article-internal-prepare-hook'."
@@ -4735,6 +4851,7 @@ If optional argument UNREAD is non-nil, only unread article is selected."
 (defun gnus-summary-goto-subject (article &optional force silent)
   "Go the subject line of ARTICLE.
 If FORCE, also allow jumping to articles not currently shown."
+  (interactive "nArticle number: ")
   (let ((b (point))
        (data (gnus-data-find article)))
     ;; We read in the article if we have to.
@@ -6425,8 +6542,8 @@ groups."
       (goto-char (point-min))
       (search-forward "\n\n")
       (narrow-to-region (point-min) (point))
-      (pp-eval-expression
-       (list 'quote (mapcar 'car (nnmail-article-group 'identity)))))))
+      (message "This message would go to %s"
+              (mapconcat 'car (nnmail-article-group 'identity) ", ")))))
 
 ;; Summary marking commands.
 
@@ -7782,9 +7899,6 @@ save those articles instead."
                  (t gnus-reffed-article-number))
                 (current-buffer))
          (insert " Article retrieved.\n"))
-                                       ;(when (and header
-                                       ;          (memq (mail-header-number header) gnus-newsgroup-sparse))
-                                       ;  (setcar (gnus-id-to-thread id) nil))
        (if (not (setq header (car (gnus-get-newsgroup-headers))))
            ()                          ; Malformed head.
          (unless (memq (mail-header-number header) gnus-newsgroup-sparse)