Importing Pterodactyl Gnus v0.97.

[elisp/gnus.git-] / lisp / gnus-xmas.el

diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el
index 6f99327..90cb1e0 100644 (file)
--- a/lisp/gnus-xmas.el
+++ b/lisp/gnus-xmas.el
@@ -1,5 +1,5 @@
 ;;; gnus-xmas.el --- Gnus functions for XEmacs
-;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -77,7 +77,7 @@ automatically."
   (if (or (featurep 'xface)
          (featurep 'xpm))
       'gnus-xmas-article-display-xface
-    "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -")
+    "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -")
   "*String or function to be executed to display an X-Face header.
 If it is a string, the command will be executed in a sub-shell
 asynchronously.         The compressed face will be piped to this command."
@@ -181,7 +181,9 @@ displayed, no centering will be performed."
                     (- (window-height) 2)))
           (top (cond ((< height 4) 0)
                      ((< height 7) 1)
-                     (t 2)))
+                     (t (if (numberp gnus-auto-center-summary)
+                            gnus-auto-center-summary
+                          2))))
           (bottom (save-excursion (goto-char (point-max))
                                   (forward-line (- height))
                                   (point)))
@@ -434,7 +436,7 @@ call it with the value of the `gnus-data' text property."
   (defun gnus-byte-code (func)
     "Return a form that can be `eval'ed based on FUNC."
     (let ((fval (indirect-function func)))
-      (if (byte-code-function-p fval)
+      (if (compiled-function-p fval)
          (list 'funcall fval)
        (cons 'progn (cdr (cdr fval))))))
 
@@ -466,7 +468,7 @@ call it with the value of the `gnus-data' text property."
   (fset 'gnus-region-active-p 'region-active-p)
   (fset 'gnus-annotation-in-region-p 'gnus-xmas-annotation-in-region-p)
   (fset 'gnus-mime-button-menu 'gnus-xmas-mime-button-menu)
-  
+
   (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
   (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add)
   (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add)
@@ -575,7 +577,7 @@ call it with the value of the `gnus-data' text property."
                                'default-toolbar
                              nil)
   "*If nil, do not use a toolbar.
-If it is non-nil, it must be a toolbar.  The five legal values are
+If it is non-nil, it must be a toolbar.  The five valid values are
 `default-toolbar', `top-toolbar', `bottom-toolbar',
 `right-toolbar', and `left-toolbar'."
   :type '(choice (const default-toolbar)
@@ -595,8 +597,7 @@ If it is non-nil, it must be a toolbar.  The five legal values are
     [gnus-group-unsubscribe gnus-group-unsubscribe t "Unsubscribe group"]
     [gnus-group-subscribe gnus-group-subscribe t "Subscribe group"]
     [gnus-group-kill-group gnus-group-kill-group t "Kill group"]
-    [gnus-group-exit gnus-group-exit t "Exit Gnus"]
-    )
+    [gnus-group-exit gnus-group-exit t "Exit Gnus"])
   "The group buffer toolbar.")
 
 (defvar gnus-summary-toolbar
@@ -700,24 +701,25 @@ XEmacs compatibility workaround."
   "Display any XFace headers in the current article."
   (save-excursion
     (let ((xface-glyph
-          (cond ((featurep 'xface)
-                 (make-glyph (vector 'xface :data
-                                     (concat "X-Face: "
-                                             (buffer-substring beg end)))))
-                ((featurep 'xpm)
-                 (let ((cur (current-buffer)))
-                   (save-excursion
-                     (gnus-set-work-buffer)
-                     (insert (format "%s" (buffer-substring beg end cur)))
-                     (gnus-xmas-call-region "uncompface")
-                     (goto-char (point-min))
-                     (insert "/* Width=48, Height=48 */\n")
-                     (gnus-xmas-call-region "icontopbm")
-                     (gnus-xmas-call-region "ppmtoxpm")
-                     (make-glyph
-                      (vector 'xpm :data (buffer-string))))))
-                (t
-                 (make-glyph [nothing]))))
+          (cond
+           ((featurep 'xface)
+            (make-glyph (vector 'xface :data
+                                (concat "X-Face: "
+                                        (buffer-substring beg end)))))
+           ((featurep 'xpm)
+            (let ((cur (current-buffer)))
+              (save-excursion
+                (gnus-set-work-buffer)
+                (insert (format "%s" (buffer-substring beg end cur)))
+                (gnus-xmas-call-region "uncompface")
+                (goto-char (point-min))
+                (insert "/* Width=48, Height=48 */\n")
+                (gnus-xmas-call-region "icontopbm")
+                (gnus-xmas-call-region "ppmtoxpm")
+                (make-glyph
+                 (vector 'xpm :data (buffer-string))))))
+           (t
+            (make-glyph [nothing]))))
          (ext (make-extent (progn
                              (goto-char (point-min))
                              (re-search-forward "^From:" nil t)
@@ -727,26 +729,12 @@ XEmacs compatibility workaround."
       (set-extent-begin-glyph ext xface-glyph)
       (set-extent-property ext 'duplicable t))))
 
-;;(defvar gnus-xmas-pointer-glyph
-;;  (progn
-;;    (setq gnus-xmas-glyph-directory (message-xmas-find-glyph-directory
-;;                                     "gnus"))
-;;    (let ((file-xpm (expand-file-name "gnus-pointer.xpm"
-;;                                   gnus-xmas-glyph-directory))
-;;       (file-xbm (expand-file-name "gnus-pointer.xbm"
-;;                                   gnus-xmas-glyph-directory)))
-;;      (make-pointer-glyph
-;;       (list (vector 'xpm ':file file-xpm)
-;;          (vector 'xbm ':file file-xbm))))))
-
 (defvar gnus-xmas-modeline-left-extent
   (let ((ext (copy-extent modeline-buffer-id-left-extent)))
-;    (set-extent-property ext 'pointer gnus-xmas-pointer-glyph)
     ext))
 
 (defvar gnus-xmas-modeline-right-extent
   (let ((ext (copy-extent modeline-buffer-id-right-extent)))
-;    (set-extent-property ext 'pointer gnus-xmas-pointer-glyph)
     ext))
 
 (defvar gnus-xmas-modeline-glyph
@@ -763,7 +751,7 @@ XEmacs compatibility workaround."
                          `[xpm :file ,file-xpm])
                         ((featurep 'xbm)
                          ;; Then a not-so-nifty XBM
-                         [xbm :file ,file-xbm])
+                         `[xbm :file ,file-xbm])
                         ;; Then the simple string
                         (t [string :data "Gnus:"])))))
       (set-glyph-face glyph 'modeline-buffer-id)
@@ -793,7 +781,10 @@ XEmacs compatibility workaround."
     (gnus-splash)))
 
 (defun gnus-xmas-annotation-in-region-p (b e)
-  (map-extents (lambda (e u) t) nil b e nil nil 'mm t))
+  (or (map-extents (lambda (e u) t) nil b e nil nil 'mm t)
+      (if (= b e)
+         (eq (cadr (memq 'gnus-undeletable (text-properties-at b))) t)
+       (text-property-any b e 'gnus-undeletable t))))
 
 (defun gnus-xmas-mime-button-menu (event)
   "Construct a context-sensitive menu of MIME commands."