* gnus.el (gnus-other-frame-function): New user option.

[gnus] / lisp / gnus.el

diff --git a/lisp/gnus.el b/lisp/gnus.el
index 508a8ae..3c3e589 100644 (file)
--- a/lisp/gnus.el
+++ b/lisp/gnus.el
@@ -1820,6 +1820,26 @@ Putting (gnus-agentize) in ~/.gnus is obsolete by (setq gnus-agent t)."
   :group 'gnus-agent
   :type 'boolean)
 
+(defcustom gnus-other-frame-function 'gnus
+  "Function called by the command `gnus-other-frame'."
+  :group 'gnus-start
+  :type '(choice (function-item gnus)
+                (function-item gnus-no-server)
+                (function-item gnus-slave)
+                (function-item gnus-slave-no-server)))
+
+(defcustom gnus-other-frame-parameters nil
+  "Frame parameters used by `gnus-other-frame' to create a Gnus frame.
+This should be an alist for FSF Emacs, or a plist for XEmacs."
+  :group 'gnus-start
+  :type (if (featurep 'xemacs)
+           '(repeat (list :inline t :format "%v"
+                          (symbol :tag "Property")
+                          (sexp :tag "Value")))
+         '(repeat (cons :format "%v"
+                        (symbol :tag "Parameter")
+                        (sexp :tag "Value")))))
+
 \f
 ;;; Internal variables
 
@@ -1991,6 +2011,9 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
 (defvar gnus-invalid-group-regexp "[: `'\"/]\\|^$"
   "Regexp matching invalid groups.")
 
+(defvar gnus-other-frame-object nil
+  "A frame object which will be created by `gnus-other-frame'.")
+
 ;;; End of variables.
 
 ;; Define some autoload functions Gnus might use.
@@ -3360,15 +3383,51 @@ server."
   (gnus arg nil 'slave))
 
 ;;;###autoload
-(defun gnus-other-frame (&optional arg)
-  "Pop up a frame to read news."
+(defun gnus-other-frame (&optional arg display)
+  "Pop up a frame to read news.
+This will call one of the Gnus commands which is specified by the user
+option `gnus-other-frame-function' (default `gnus') with the argument
+ARG if Gnus is not running, otherwise just pop up a Gnus frame.  The
+optional second argument DISPLAY should be a standard display string
+such as \"unix:0\" to specify where to pop up a frame.  If DISPLAY is
+omitted or the function `make-frame-on-display' is not available, the
+current display is used."
   (interactive "P")
-  (let ((window (get-buffer-window gnus-group-buffer)))
-    (cond (window
-          (select-frame (window-frame window)))
-         (t
-          (select-frame (make-frame)))))
-  (gnus arg))
+  (if (fboundp 'make-frame-on-display)
+      (unless display
+       (setq display (gnus-frame-or-window-display-name (selected-frame))))
+    (setq display nil))
+  (let ((alive (gnus-alive-p)))
+    (unless (and alive
+                (catch 'found
+                  (walk-windows
+                   (lambda (window)
+                     (when (and (or (not display)
+                                    (equal display
+                                           (gnus-frame-or-window-display-name
+                                            window)))
+                                (with-current-buffer (window-buffer window)
+                                  (string-match "\\`gnus-"
+                                                (symbol-name major-mode))))
+                       (gnus-select-frame-set-input-focus
+                        (setq gnus-other-frame-object (window-frame window)))
+                       (select-window window)
+                       (throw 'found t)))
+                   'ignore t)))
+      (gnus-select-frame-set-input-focus
+       (setq gnus-other-frame-object
+            (if display
+                (make-frame-on-display display gnus-other-frame-parameters)
+              (make-frame gnus-other-frame-parameters))))
+      (if alive
+         (switch-to-buffer gnus-group-buffer)
+       (funcall gnus-other-frame-function arg)
+       (add-hook 'gnus-exit-gnus-hook
+                 (lambda nil
+                   (when (and (frame-live-p gnus-other-frame-object)
+                              (cdr (frame-list)))
+                     (delete-frame gnus-other-frame-object))
+                   (setq gnus-other-frame-object nil)))))))
 
 ;;(setq thing ?                                ; this is a comment
 ;;      more 'yes)