*** empty log message ***
[gnus] / lisp / gnus-vis.el
index 7730b4e..d96abf6 100644 (file)
@@ -1,5 +1,5 @@
 ;;; gnus-vis.el --- display-oriented parts of Gnus
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
 ;;     Per Abrahamsen <abraham@iesd.auc.dk>
 ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; 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:
 
 ;;; Code:
 
 (require 'gnus)
-(require gnus-easymenu)
-
-;;; summary highligts
-
-(defvar gnus-summary-selected-face 'underline
-  "*Face used for highlighting the current article in the summary buffer.")
-
-(defvar gnus-summary-highlight
-  '(((> score default) . bold)
-    ((< score default) . italic))
-  "*Alist of `(FORM . FACE)'.
-Summary lines are highlighted with the FACE for the first FORM which
-evaluate to a non-nil value.  
-
-Point will be at the beginning of the line when FORM is evaluated.
-The following can be used for convenience:
-
-score:   (gnus-summary-article-score)
-default: gnus-summary-default-score
-below:   gnus-summary-mark-below
-
-To check for marks, e.g. to underline replied articles, use
-`gnus-summary-article-mark': 
-
-   ((= (gnus-summary-article-mark) gnus-replied-mark) . underline)")
+(require 'gnus-ems)
+(require 'easymenu)
+(require 'custom)
+(require 'browse-url)
+(require 'gnus-score)
+(eval-when-compile (require 'cl))
+
+(defvar gnus-group-menu-hook nil
+  "*Hook run after the creation of the group mode menu.")
+
+(defvar gnus-summary-menu-hook nil
+  "*Hook run after the creation of the summary mode menu.")
+
+(defvar gnus-article-menu-hook nil
+  "*Hook run after the creation of the article mode menu.")
+
+;;; Summary highlights.
+
+;(defvar gnus-summary-highlight-properties
+;  '((unread "ForestGreen" "green")
+;    (ticked "Firebrick" "pink")
+;    (read "black" "white")
+;    (low italic italic)
+;    (high bold bold)
+;    (canceled "yellow/black" "black/yellow")))
+
+;(defvar gnus-summary-highlight-translation
+;  '(((unread (= mark gnus-unread-mark))
+;     (ticked (or (= mark gnus-ticked-mark) (= mark gnus-dormant-mark)))
+;     (read (not (or (= mark gnus-unread-mark) (= mark gnus-dormant-mark)
+;                  (= mark gnus-ticked-mark) (= mark gnus-canceled-mark))))
+;     (canceled (= mark gnus-canceled-mark)))
+;    ((low (< score gnus-summary-default-score))
+;     (high (> score gnus-summary-default-score)))))
+
+;(defun gnus-visual-map-face-translation ()
+;  (let ((props gnus-summary-highlight-properties)
+;      (trans gnus-summary-highlight-translation)
+;      map)
+;    (while props)))
+      
+;see gnus-cus.el
+;(defvar gnus-summary-selected-face 'underline
+;  "*Face used for highlighting the current article in the summary buffer.")
+;see gnus-cus.el
+;(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 "SkyBlue" 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))))
+;  "*Alist of `(FORM . FACE)'.
+;Summary lines are highlighted with the FACE for the first FORM which
+;evaluate to a non-nil value.  
+
+;Point will be at the beginning of the line when FORM is evaluated.
+;The following can be used for convenience:
+
+;score:   (gnus-summary-article-score)
+;default: gnus-summary-default-score
+;below:   gnus-summary-mark-below
+;mark:    (gnus-summary-article-mark)
+
+;The latter can be used like this:
+;   ((= mark gnus-replied-mark) . underline)")
 
 ;;; article highlights
 
-(defvar gnus-make-foreground t
-  "Non nil means foreground color to highlight citations.")
-
-(defvar gnus-article-button-face 'bold
-  "Face used for text buttons.")
-
-(defvar gnus-article-mouse-face (if (boundp 'gnus-mouse-face)
-                                   gnus-mouse-face
-                                 'highlight)
-  "Face used when the mouse is over the button.")
-
-(defvar gnus-header-face-alist '(("" bold italic))
-  "Alist of headers and faces used for highlighting them.
-The entries in the list has the form `(REGEXP NAME CONTENT)', where
-REGEXP is a regeular expression matching the beginning of the header,
-NAME is the face used for highlighting the header name and CONTENT is
-the face used for highlighting the header content. 
-
-The first non-nil NAME or CONTENT with a matching REGEXP in the list
-will be used.") 
-
-(defvar gnus-signature-face 'italic
-  "Face used for signature.")
+;see gnus-cus.el
+;(defvar gnus-header-face-alist 
+;  (cond ((not (eq gnus-display-type 'color))
+;       '(("" bold italic)))
+;      ((eq gnus-background-mode 'dark)
+;       (list (list "From" nil 
+;                   (custom-face-lookup "SkyBlue" nil nil t t nil))
+;             (list "Subject" nil 
+;                   (custom-face-lookup "pink" nil nil t t nil))
+;             (list "Newsgroups:.*," nil
+;                   (custom-face-lookup "yellow" nil nil t t nil))
+;             (list "" 
+;                   (custom-face-lookup "cyan" nil nil t nil nil)
+;                   (custom-face-lookup "green" nil nil nil t nil))))
+;      (t
+;       (list (list "From" nil 
+;                   (custom-face-lookup "RoyalBlue" nil nil t t nil))
+;             (list "Subject" nil 
+;                   (custom-face-lookup "firebrick" nil nil t t nil))
+;             (list "Newsgroups:.*," nil
+;                   (custom-face-lookup "red" nil nil t t nil))
+;             (list ""
+;                   (custom-face-lookup "DarkGreen" nil nil t nil nil)
+;                   (custom-face-lookup "DarkGreen" nil nil nil t nil)))))
+;  "Alist of headers and faces used for highlighting them.
+;The entries in the list has the form `(REGEXP NAME CONTENT)', where
+;REGEXP is a regular expression matching the beginning of the header,
+;NAME is the face used for highlighting the header name and CONTENT is
+;the face used for highlighting the header content. 
+
+;The first non-nil NAME or CONTENT with a matching REGEXP in the list
+;will be used.")
+
+
+;see gnus-cus.el
+;(defvar gnus-make-foreground t
+;  "Non nil means foreground color to highlight citations.")
+
+;see gnus-cus.el
+;(defvar gnus-article-button-face 'bold
+;  "Face used for text buttons.")
+
+;see gnus-cus.el
+;(defvar gnus-article-mouse-face (if (boundp 'gnus-mouse-face)
+;                                  gnus-mouse-face
+;                                'highlight)
+;  "Face used when the mouse is over the button.")
+
+;see gnus-cus.el
+;(defvar gnus-signature-face 'italic
+;  "Face used for signature.")
+
+(defvar gnus-button-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-\\wa-zA-Z0-9_=!?#$@~`%&*+|\\/.,]*[-\\wa-zA-Z0-9_=#$@~`%&*+|\\/]"
+  "*Regular expression that matches URLs.")
 
 (defvar gnus-button-alist 
-  '(("in\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 
-     (assq (count-lines (point-min) (match-end 0)) 
-          gnus-cite-attribution-alist)
+  `(("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 
+     t gnus-button-message-id 3)
+    ("\\(<?\\(url: ?\\)?news:\\([^>\n\t ]*\\)>?\\)" 1 t
      gnus-button-message-id 3)
+    ("\\(<URL: *\\)?mailto: *\\([^> \n\t]+\\)>?" 0 t gnus-button-reply 2)
     ;; This is how URLs _should_ be embedded in text...
-    ("<URL:\\([^\n\r>]*\\)>" 0 t gnus-button-url 1)
-    ;; Next regexp stolen from highlight-headers.el
-    ("\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]+" 0 t
-     gnus-button-url 0))
-  "Alist of regexps matching buttons in an article.
+    ("<URL: *\\([^\n\r>]*\\)>" 0 t gnus-button-url 1)
+    ;; Next regexp stolen from highlight-headers.el.
+    ;; Modified by Vladimir Alexiev.
+    (,gnus-button-url-regexp 0 t gnus-button-url 0))
+  "Alist of regexps matching buttons in article bodies.
 
 Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
 REGEXP: is the string matching text around the button,
@@ -101,19 +235,53 @@ PAR: is a number of a regexp grouping whose text will be passed to CALLBACK.
 CALLBACK can also be a variable, in that case the value of that
 variable it the real callback function.")
 
-(defvar gnus-button-url (cond ((fboundp 'w3-fetch)
-                              'w3-fetch)
-                             ((fboundp 'highlight-headers-follow-url-netscape)
-                              'highlight-headers-follow-url-netscape)
-                             (t nil))
-  "Function to fetch URL.  
-The function will be called with one argument, the URL to fetch.
-Useful values of this function are:
-
-w3-fetch: 
-   defined in the w3 emacs package by William M. Perry.
-highlight-headers-follow-url-netscape: 
-   from `highlight-headers.el' for loading NetScape 1.1.")
+(defvar gnus-header-button-alist 
+  `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>"
+     0 t gnus-button-message-id 0)
+    ("^\\(From\\|Reply-To\\):" ": *\\