lisp/pop3-fma.el: Require mel-b-el if mel-b does not exist.

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

diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el
index 8ff098e..79d0a05 100644 (file)
--- a/lisp/gnus-xmas.el
+++ b/lisp/gnus-xmas.el
@@ -2,6 +2,7 @@
 ;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;;     Katsumi Yamaoka <yamaoka@jpl.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
@@ -246,6 +247,7 @@ call it with the value of the `gnus-data' text property."
   (let* ((pos (event-closest-point event))
         (data (get-text-property pos 'gnus-data))
         (fun (get-text-property pos 'gnus-callback)))
+    (goto-char pos)
     (when fun
       (funcall fun data))))
 
@@ -258,21 +260,6 @@ call it with the value of the `gnus-data' text property."
                 (delete-extent extent)
                 nil)))
 
-;; Fixed by Christopher Davis <ckd@loiosh.kei.com>.
-(defun gnus-xmas-article-add-button (from to fun &optional data)
-  "Create a button between FROM and TO with callback FUN and data DATA."
-  (when gnus-article-button-face
-    (gnus-overlay-put (gnus-make-overlay from to)
-                     'face gnus-article-button-face))
-  (gnus-add-text-properties
-   from to
-   (nconc
-    (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))))
-
 (defun gnus-xmas-window-top-edge (&optional window)
   (nth 1 (window-pixel-edges window)))
 
@@ -401,6 +388,7 @@ call it with the value of the `gnus-data' text property."
 
 (defun gnus-xmas-define ()
   (setq gnus-mouse-2 [button2])
+  (setq gnus-mouse-3 [button3])
   (setq gnus-widget-button-keymap widget-button-keymap)
 
   (unless (memq 'underline (face-list))
@@ -447,7 +435,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 (compiled-function-p fval)
+      (if (byte-code-function-p fval)
          (list 'funcall fval)
        (cons 'progn (cdr (cdr fval))))))
 
@@ -465,7 +453,6 @@ call it with the value of the `gnus-data' text property."
   (fset 'gnus-summary-recenter 'gnus-xmas-summary-recenter)
   (fset 'gnus-extent-start-open 'gnus-xmas-extent-start-open)
   (fset 'gnus-article-push-button 'gnus-xmas-article-push-button)
-  (fset 'gnus-article-add-button 'gnus-xmas-article-add-button)
   (fset 'gnus-window-top-edge 'gnus-xmas-window-top-edge)
   (fset 'gnus-read-event-char 'gnus-xmas-read-event-char)
   (fset 'gnus-group-startup-message 'gnus-xmas-group-startup-message)
@@ -479,7 +466,8 @@ call it with the value of the `gnus-data' text property."
   (fset 'gnus-key-press-event-p 'key-press-event-p)
   (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)
@@ -565,11 +553,13 @@ the resulting string may be narrower than END-COLUMN.
       (let ((pad (abs pad-width)))
        (if (symbolp el)
            (if (< pad-width 0)
-               `(concat ,el (make-string
-                             (max 0 (- ,pad (string-width ,el))) ?\ ))
-             `(concat (make-string
-                       (max 0 (- ,pad (string-width ,el))) ?\ )
-                      ,el))
+               `(let ((val (format "%s" ,el)))
+                  (concat val (make-string
+                               (max 0 (- ,pad (string-width val))) ?\ )))
+             `(let ((val (format "%s" ,el)))
+                (concat (make-string
+                         (max 0 (- ,pad (string-width val))) ?\ )
+                        val)))
          (if (< pad-width 0)
              `(let ((val (eval ,el)))
                 (concat val (make-string
@@ -910,6 +900,17 @@ XEmacs compatibility workaround."
 (defun gnus-xmas-annotation-in-region-p (b e)
   (map-extents (lambda (e u) t) nil b e nil nil 'mm t))
 
+(defun gnus-xmas-mime-button-menu (event)
+  "Construct a context-sensitive menu of MIME commands."
+  (interactive "e")
+  (let ((response (get-popup-menu-response
+                  `("MIME Part"
+                    ,@(mapcar (lambda (c) `[,(caddr c) ,(car c) t])
+                              gnus-mime-button-commands)))))
+    (set-buffer (event-buffer event))
+    (goto-char (event-point event))
+    (funcall (event-function response) (event-object response))))
+
 (provide 'gnus-xmas)
 
 ;;; gnus-xmas.el ends here