frame+.el - extensions to GNU `frame.el'

[Drew Adams]

;;; frame+.el --- Extensions to `frame.el'.
;; 
;; Emacs Lisp Archive Entry
;; Filename: frame+.el
;; Description: Extensions to `frame.el'.
;; Author: Drew Adams
;; Maintainer: Drew Adams
;; Copyright (C) 1996-2001, Drew Adams, all rights reserved.
;; Created: Fri Apr 12 16:42:12 1996
;; Version: $Id: frame+.el,v 1.6 2001/01/08 22:51:34 dadams Exp $
;; Last-Updated: Mon Jan  8 14:51:28 2001
;;           By: dadams
;;     Update #: 80
;; Keywords: frames
;; Compatibility: GNU Emacs 20.x
;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;;; Commentary: 
;; 
;;    Extensions to `frame.el'.
;;
;;
;;  ***** NOTE: The following function defined in `frame.el' has been
;;              REDEFINED HERE:
;;
;;  `special-display-popup-frame' - Calls `make-frame' while BUFFER is
;;                                  current, so frame hooks use BUFFER.
;;
;;
;;  This file should be loaded after loading the standard GNU file
;;  `frame.el'.  So, in your `~/.emacs' file, do this:
;;  (eval-after-load "frame" '(require 'frame+))
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;;; Change log:
;; 
;; RCS $Log: frame+.el,v $
;; RCS Revision 1.6  2001/01/08 22:51:34  dadams
;; RCS Adapted file header for Emacs Lisp Archive.
;; RCS
;; RCS Revision 1.5  2001/01/03 17:35:49  dadams
;; RCS *** empty log message ***
;; RCS
;; RCS Revision 1.4  2001/01/03 00:38:05  dadams
;; RCS *** empty log message ***
;; RCS
;; RCS Revision 1.3  2000/12/07 19:37:54  dadams
;; RCS Added require of shrink-fit.el.
;; RCS
;; RCS Revision 1.2  2000/09/27 22:01:09  dadams
;; RCS special-display-popup-frame:
;; RCS   1. does shrink-frame-to-fit.
;; RCS   2. doesn't make-frame-visible (done by raise-frame).
;; RCS
;; RCS Revision 1.1  2000/09/14 16:15:08  dadams
;; RCS Initial revision
;; RCS
; Revision 1.2  1999/03/17  13:35:29  dadams
; Updated to corrspond with version Emacs 34.1.
;
; Revision 1.1  1997/03/20  10:51:12  dadams
; Initial revision
;
; Revision 1.2  1996/07/01  13:12:21  dadams
; (trivial)
;
; Revision 1.1  1996/04/15  08:18:12  dadams
; Initial revision
;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;;; Code:

(require 'frame)

(require 'shrink-fit nil t) ;; (no error if not found): shrink-frame-to-fit


(provide 'frame+)

;;;;;;;;;;;;;;;;;;;



;; REPLACES ORIGINAL in `frame.el':
;; 1. Calls `make-frame' while BUFFER is current, so that any frame hooks
;;    (e.g. `after-make-frame-functions') will use BUFFER, not the previously
;; current buffer.
;; 2. Calls `shrink-frame-to-fit'.
;;;###autoload
(defun special-display-popup-frame (buffer &optional args)
  "Display BUFFER in its own frame, reusing an existing window if any.
Return the window chosen. The window is not selected within its frame.

If a new frame is needed, then `make-frame' is called to create it,
with BUFFER as the current buffer (temporarily).

If ARGS is an alist, use it as a list of frame parameter specs.
If ARGS is a list whose car is a symbol, use (car ARGS) as a function
to do the work.  Pass it BUFFER as first arg, and (cdr ARGS) gives the
rest of the args to the function."
  (cond ((and args (symbolp (car args)))
         (let* ((window (apply (car args) buffer (cdr args)))
                (frame (window-frame window)))
           (when (fboundp 'shrink-frame-to-fit)
             (shrink-frame-to-fit (window-frame window)))
           (raise-frame frame)
           window))                     ; Return the window.
        (t
         (let ((window (get-buffer-window buffer t)))
           (if window
               ;; Have a window already - make it visible.
               (let ((frame (window-frame window)))
                 (raise-frame frame)
                 (when (fboundp 'shrink-frame-to-fit) (shrink-frame-to-fit 
frame))
                 window)                ; Return the window.
             ;; No window yet - make one in a new frame.
             (let ((frame (save-excursion ; Make frame while BUFFER is
                            (set-buffer buffer) ; current => frame hooks OK.
                            (make-frame (append args 
special-display-frame-alist)))))
               (unless (memq 'shrink-frame-to-fit after-make-frame-functions)
                 (when (fboundp 'shrink-frame-to-fit)
                   (shrink-frame-to-fit frame)))
               (set-window-buffer (frame-selected-window frame) buffer)
               (set-window-dedicated-p (frame-selected-window frame) t)
               (frame-selected-window frame))))))) ; Return the window.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; `frame+.el' ends here