*** empty log message ***
[gnus] / lisp / gnus-ems.el
index 43cd565..0dec88b 100644 (file)
 ;; bore.  
 
 (eval
- '(cond 
-   ((string-match "XEmacs\\|Lucid" emacs-version)
-    ;; XEmacs definitions.
-
-    (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)")
-
-    (setq gnus-mouse-2 [button2])
-    (setq gnus-easymenu 'auc-menu)
-
-    (or (memq 'underline (list-faces))
-       (funcall (intern "make-face") 'underline))
-    ;; Must avoid calling set-face-underline-p directly, because it
-    ;; is a defsubst in emacs19, and will make the .elc files non
-    ;; portable!
-    (or (face-differs-from-default-p 'underline)
-       (funcall 'set-face-underline-p 'underline t))
-    (or (fboundp 'set-text-properties)
-       (defun set-text-properties (start end props &optional buffer)
-         (if (or (null buffer) (bufferp buffer))
-             (if props
-                 (put-text-property start end (car props) (cdr props) buffer)
-               (remove-text-properties start end ())))))
-
-    (defvar gnus-header-face-alist 
-      '(("" bold italic)))
-    
-    (or (fboundp 'make-overlay) (fset 'make-overlay 'make-extent))
-    (or (fboundp 'overlay-put) (fset 'overlay-put 'set-extent-property))
-    (or (fboundp 'move-overlay) 
-        (defun move-overlay (extent start end &optional buffer)
-          (set-extent-endpoints extent start end)))
-    (or (boundp 'standard-display-table) (setq standard-display-table nil))
-    (or (boundp 'read-event) (fset 'read-event 'next-command-event))
-
-    (setq gnus-display-type 
-         (let ((display-resource 
-                (x-get-resource ".displayType" "DisplayType" 'string)))
-           (cond (display-resource (intern (downcase display-resource)))
-                 ((x-display-color-p) 'color)
-                 ((x-display-grayscale-p) 'grayscale)
-                 (t 'mono))))
-
-    (setq gnus-background-mode 
-         (let ((bg-resource 
-                (x-get-resource ".backgroundMode" "BackgroundMode" 'string))
-               (params (frame-parameters)))
-           (cond (bg-resource (intern (downcase bg-resource)))
-;                ((< (apply '+ (x-color-values
-;                               (cdr (assq 'background-color params))))
-;                    (/ (apply '+ (x-color-values "white")) 3))
-;                 'dark)
-                 (t 'light))))
-
-    (if (not gnus-visual)
+ '(progn
+    (if (string-match "XEmacs\\|Lucid" emacs-version)
        ()
-      (setq gnus-group-mode-hook
-           (cons
-            '(lambda ()
-              (easy-menu-add gnus-group-reading-menu)
-              (easy-menu-add gnus-group-group-menu)
-              (easy-menu-add gnus-group-post-menu)
-              (easy-menu-add gnus-group-misc-menu)
-              (gnus-install-mouse-tracker)) 
-            gnus-group-mode-hook))
-      (setq gnus-summary-mode-hook
-           (cons
-            '(lambda ()
-              (easy-menu-add gnus-summary-mark-menu)
-              (easy-menu-add gnus-summary-move-menu)
-              (easy-menu-add gnus-summary-article-menu)
-              (easy-menu-add gnus-summary-thread-menu)
-              (easy-menu-add gnus-summary-misc-menu)
-              (easy-menu-add gnus-summary-post-menu)
-              (easy-menu-add gnus-summary-kill-menu)
-              (gnus-install-mouse-tracker)) 
-            gnus-summary-mode-hook))
-      (setq gnus-article-mode-hook
-           (cons
-            '(lambda ()
-              (easy-menu-add gnus-article-article-menu)
-              (easy-menu-add gnus-article-treatment-menu))
-            gnus-article-mode-hook)))
-
-    (defun gnus-install-mouse-tracker ()
-      (require 'mode-motion)
-      (setq mode-motion-hook 'mode-motion-highlight-line)))
-
-   ((and (not (string-match "28.9" emacs-version)) 
-        (not (string-match "29" emacs-version)))
-    (setq gnus-hidden-properties '(invisible t))
-    (or (fboundp 'buffer-substring-no-properties)
-       (defun buffer-substring-no-properties (beg end)
-         (format "%s" (buffer-substring beg end)))))
+      ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
+      (defvar gnus-display-type 
+       (condition-case nil
+           (let ((display-resource (x-get-resource ".displayType" "DisplayType")))
+             (cond (display-resource (intern (downcase display-resource)))
+                   ((x-display-color-p) 'color)
+                   ((x-display-grayscale-p) 'grayscale)
+                   (t 'mono)))
+         (error 'mono))
+       "A symbol indicating the display Emacs is running under.
+The symbol should be one of `color', `grayscale' or `mono'. If Emacs
+guesses this display attribute wrongly, either set this variable in
+your `~/.emacs' or set the resource `Emacs.displayType' in your
+`~/.Xdefaults'. See also `gnus-background-mode'.
+
+This is a meta-variable that will affect what default values other
+variables get.  You would normally not change this variable, but
+pounce directly on the real variables themselves.")
+
+      (defvar gnus-background-mode 
+       (condition-case nil
+           (let ((bg-resource (x-get-resource ".backgroundMode"
+                                              "BackgroundMode"))
+                 (params (frame-parameters)))
+             (cond (bg-resource (intern (downcase bg-resource)))
+                   ((and (cdr (assq 'background-color params))
+                         (< (apply '+ (x-color-values
+                                       (cdr (assq 'background-color params))))
+                            (/ (apply '+ (x-color-values "white")) 3)))
+                    'dark)
+                   (t 'light)))
+         (error 'light))
+       "A symbol indicating the Emacs background brightness.
+The symbol should be one of `light' or `dark'.
+If Emacs guesses this frame attribute wrongly, either set this variable in
+your `~/.emacs' or set the resource `Emacs.backgroundMode' in your
+`~/.Xdefaults'.
+See also `gnus-display-type'.
+
+This is a meta-variable that will affect what default values other
+variables get.  You would normally not change this variable, but
+pounce directly on the real variables themselves."))
+
+    (cond 
+     ((string-match "XEmacs\\|Lucid" emacs-version)
+      ;; XEmacs definitions.
+
+      (setq gnus-mouse-2 [button2])
+      (setq gnus-easymenu 'auc-menu)
+
+      (or (memq 'underline (list-faces))
+         (funcall (intern "make-face") 'underline))
+      ;; Must avoid calling set-face-underline-p directly, because it
+      ;; is a defsubst in emacs19, and will make the .elc files non
+      ;; portable!
+      (or (face-differs-from-default-p 'underline)
+         (funcall 'set-face-underline-p 'underline t))
+      (or (fboundp 'set-text-properties)
+         (defun set-text-properties (start end props &optional buffer)
+           (if (or (null buffer) (bufferp buffer))
+               (if props
+                   (while props
+                     (put-text-property 
+                      start end (car props) (nth 1 props) buffer)
+                     (setq props (nthcdr 2 props)))
+                 (remove-text-properties start end ())))))
+
+      (or (fboundp 'make-overlay) (fset 'make-overlay 'make-extent))
+      (or (fboundp 'overlay-put) (fset 'overlay-put 'set-extent-property))
+      (or (fboundp 'move-overlay) 
+         (defun move-overlay (extent start end &optional buffer)
+           (set-extent-endpoints extent start end)))
+      (or (boundp 'standard-display-table) (setq standard-display-table nil))
+      (or (boundp 'read-event) (fset 'read-event 'next-command-event))
+
+      ;; Fix by "jeff (j.d.) sparkes" <jsparkes@bnr.ca>.
+      (defvar gnus-display-type (device-class)
+       "A symbol indicating the display Emacs is running under.
+The symbol should be one of `color', `grayscale' or `mono'. If Emacs
+guesses this display attribute wrongly, either set this variable in
+your `~/.emacs' or set the resource `Emacs.displayType' in your
+`~/.Xdefaults'. See also `gnus-background-mode'.
+
+This is a meta-variable that will affect what default values other
+variables get.  You would normally not change this variable, but
+pounce directly on the real variables themselves.")
+
+
+      (or (fboundp 'x-color-values)
+         (fset 'x-color-values 
+               (lambda (color)
+                 (color-instance-rgb-components
+                  (make-color-instance color)))))
+    
+      (defvar gnus-background-mode 
+       (let ((bg-resource 
+              (x-get-resource ".backgroundMode" "BackgroundMode" 'string))
+             (params (frame-parameters)))
+         (cond (bg-resource (intern (downcase bg-resource)))
+               ((and (assq 'background-color params)
+                     (< (apply '+ (x-color-values
+                                   (cdr (assq 'background-color params))))
+                        (/ (apply '+ (x-color-values "white")) 3)))
+                'dark)
+               (t 'light)))
+       "A symbol indicating the Emacs background brightness.
+The symbol should be one of `light' or `dark'.
+If Emacs guesses this frame attribute wrongly, either set this variable in
+your `~/.emacs' or set the resource `Emacs.backgroundMode' in your
+`~/.Xdefaults'.
+See also `gnus-display-type'.
+
+This is a meta-variable that will affect what default values other
+variables get.  You would normally not change this variable, but
+pounce directly on the real variables themselves.")
+
+
+      (defun gnus-install-mouse-tracker ()
+       (require 'mode-motion)
+       (setq mode-motion-hook 'mode-motion-highlight-line)))
+
+     ((and (not (string-match "28.9" emacs-version)) 
+          (not (string-match "29" emacs-version)))
+      (setq gnus-hidden-properties '(invisible t))
+      (or (fboundp 'buffer-substring-no-properties)
+         (defun buffer-substring-no-properties (beg end)
+           (format "%s" (buffer-substring beg end)))))
    
-   ((boundp 'MULE)
-    (provide 'gnusutil))
+     ((boundp 'MULE)
+      (provide 'gnusutil))
    
-   ))
+     )))
 
 (eval-and-compile
   (cond
@@ -173,7 +193,7 @@ To check for marks, e.g. to underline replied articles, use
   (cond 
    ((string-match "XEmacs\\|Lucid" emacs-version)
     ;; XEmacs definitions.
-    (fset 'gnus-set-mouse-face 'identity)
+    (fset 'gnus-mouse-face-function 'identity)
     (fset 'gnus-summary-make-display-table (lambda () nil))
     (fset 'gnus-visual-turn-off-edit-menu 'identity)
 
@@ -380,8 +400,9 @@ NOTE: This command only works with newsgroups that use real or simulated NNTP."
                              'gnus-mark gnus-unread-mark 
                              'gnus-level 0
                              'gnus-pseudo (car pslist)))
-             (remove-text-properties (b) (gnus-point-at-eol)
-                                     '(gnus-number nil gnus-mark nil gnus-level nil))
+             (remove-text-properties
+              b (gnus-point-at-eol)
+              '(gnus-number nil gnus-mark nil gnus-level nil))
              (forward-line -1)
              (gnus-sethash (int-to-string gnus-reffed-article-number)
                            (car pslist) gnus-newsgroup-headers-hashtb-by-number)
@@ -389,6 +410,138 @@ NOTE: This command only works with newsgroups that use real or simulated NNTP."
              (setq pslist (cdr pslist)))))))
 
 
+    (defun gnus-article-push-button (event)
+      "Check text under the mouse pointer for a callback function.
+If the text under the mouse pointer has a `gnus-callback' property,
+call it with the value of the `gnus-data' text property."
+      (interactive "e")
+      (set-buffer (window-buffer (event-window event)))
+      (let* ((pos (event-closest-point event))
+            (data (get-text-property pos 'gnus-data))
+            (fun (get-text-property pos 'gnus-callback)))
+       (if fun (funcall fun data))))
+
+    ;; Re-build the thread containing ID.
+    (defun gnus-rebuild-thread (id)
+      (let ((dep gnus-newsgroup-dependencies)
+           (buffer-read-only nil)
+           parent headers refs thread art)
+       (while (and id (setq headers
+                            (car (setq art (gnus-gethash (downcase id) 
+                                                         dep)))))
+         (setq parent art)
+         (setq id (and (setq refs (header-references headers))
+                       (string-match "\\(<[^>]+>\\) *$" refs)
+                       (substring refs (match-beginning 1) (match-end 1)))))
+       (setq thread (gnus-make-sub-thread (car parent)))
+       (gnus-rebuild-remove-articles thread)
+       (let ((beg (point)))
+         (gnus-summary-prepare-threads (list thread) 0)
+         (save-excursion
+           (while (>= (point) beg)
+             (remove-text-properties
+              (1+ (gnus-point-at-bol)) (1+ (gnus-point-at-eol))
+              '(gnus-number nil gnus-mark nil gnus-level nil))
+             (forward-line -1)))
+         (gnus-summary-update-lines beg (point)))))
+
+    ;; Fixed by Christopher Davis <ckd@loiosh.kei.com>.
+    (defun gnus-article-add-button (from to fun &optional data)
+      "Create a button between FROM and TO with callback FUN and data DATA."
+      (and gnus-article-button-face
+          (overlay-put (make-overlay from to) 'face gnus-article-button-face))
+      (add-text-properties from to
+                          (append
+                           (and gnus-article-mouse-face
+                                (list 'mouse-face gnus-article-mouse-face))
+                           (list 'gnus-callback fun)
+                           (and data (list 'gnus-data data))
+                           (list 'highlight t))))
+
+    (if (not gnus-visual)
+       ()
+      (setq gnus-group-mode-hook
+           (cons
+            '(lambda ()
+              (easy-menu-add gnus-group-reading-menu)
+              (easy-menu-add gnus-group-group-menu)
+              (easy-menu-add gnus-group-post-menu)
+              (easy-menu-add gnus-group-misc-menu)
+              (gnus-install-mouse-tracker)) 
+            gnus-group-mode-hook))
+      (setq gnus-summary-mode-hook
+           (cons
+            '(lambda ()
+              (easy-menu-add gnus-summary-mark-menu)
+              (easy-menu-add gnus-summary-move-menu)
+              (easy-menu-add gnus-summary-article-menu)
+              (easy-menu-add gnus-summary-thread-menu)
+              (easy-menu-add gnus-summary-misc-menu)
+              (easy-menu-add gnus-summary-post-menu)
+              (easy-menu-add gnus-summary-kill-menu)
+              (gnus-install-mouse-tracker)) 
+            gnus-summary-mode-hook))
+      (setq gnus-article-mode-hook
+           (cons
+            '(lambda ()
+              (easy-menu-add gnus-article-article-menu)
+              (easy-menu-add gnus-article-treatment-menu))
+            gnus-article-mode-hook)))
+
+    (defvar gnus-logo (make-glyph (make-specifier 'image)))
+
+    (defun gnus-group-startup-xmessage (&optional x y)
+      "Insert startup message in current buffer."
+      ;; Insert the message.
+      (erase-buffer)
+      (if (featurep 'xpm)
+         (progn
+           (set-glyph-property gnus-logo 'image  "~/tmp/gnus.xpm")
+           (set-glyph-image gnus-logo "~/tmp/gnus.xpm" 'global 'x)
+
+           (insert " ")
+           (set-extent-begin-glyph (make-extent (point) (point)) gnus-logo)
+           (insert "
+   Gnus * A newsreader for Emacsen
+ A Praxis Release * larsi@ifi.uio.no")
+           (goto-char (point-min))
+           (while (not (eobp))
+             (insert (make-string (/ (max (- (window-width) (or x 35)) 0) 2)
+                                  ? ))
+             (forward-line 1))
+           (goto-char (point-min))
+           ;; +4 is fuzzy factor.
+           (insert-char ?\n (/ (max (- (window-height) (or y 24)) 0) 2)))
+
+       (insert
+        (format "
+     %s
+           A newsreader 
+      for GNU Emacs
+
+        Based on GNUS 
+             written by 
+     Masanobu UMEDA
+
+       A Praxis Release
+      larsi@ifi.uio.no
+" 
+                gnus-version))
+       ;; And then hack it.
+       ;; 18 is the longest line.
+       (indent-rigidly (point-min) (point-max) 
+                       (/ (max (- (window-width) (or x 28)) 0) 2))
+       (goto-char (point-min))
+       ;; +4 is fuzzy factor.
+       (insert-char ?\n (/ (max (- (window-height) (or y 12)) 0) 2)))
+
+      ;; Fontify some.
+      (goto-char (point-min))
+      (search-forward "Praxis")
+      (put-text-property (match-beginning 0) (match-end 0) 'face 'bold)
+      (goto-char (point-min)))
+
+
 
     )
 
@@ -413,14 +566,30 @@ NOTE: This command only works with newsgroups that use real or simulated NNTP."
       )
     (defalias 'gnus-truncate-string 'truncate-string)
 
-    (fset 
-     'gnus-format-max-width 
-     (lambda (form length)
-       (let* ((val (eval form))
-             (valstr (if (numberp val) (int-to-string val) val)))
-        (if (> (length valstr) length)
-            (truncate-string valstr length)
-          valstr))))
+    (defun gnus-cite-add-face (number prefix face)
+      ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line.
+      (if face
+         (let ((inhibit-point-motion-hooks t)
+               from to)
+           (goto-line number)
+           (if (boundp 'MULE)
+               (forward-char (chars-in-string prefix))
+             (forward-char (length prefix)))
+           (skip-chars-forward " \t")
+           (setq from (point))
+           (end-of-line 1)
+           (skip-chars-backward " \t")
+           (setq to (point))
+           (if (< from to)
+               (overlay-put (make-overlay from to) 'face face)))))
+
+    (defun gnus-max-width-function (el max-width)
+      (` (let* ((val (eval (, el)))
+               (valstr (if (numberp val)
+                           (int-to-string val) val)))
+          (if (> (length valstr) (, max-width))
+              (truncate-string valstr (, max-width))
+            valstr))))
 
     (fset 'gnus-summary-make-display-table (lambda () nil))
     )