;;; frame-utils.el --- Portable frame functions with multiple-monitor support

;; Author: Andreas Spindler <info@visualco.de>
;; Maintained at: <http://www.visualco.de>
;; Keywords: Emacs, Windows, Frames

;; This file 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  3,  or  (at  your option)  any  later
;; version. For license details C-h C-c in Emacs.

;; This file 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
;; GNU  Emacs;  see the  file  COPYING.  If not,  write  to  the Free  Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

;;; Venue:
;;; ------

;; This package  provides portable (Win32  and X) frame functions  with support
;; for  multiple   monitors.   The   most  important  functions   provided  are
;; `fru-auto-display-frame',   `fru-maximize-frame',   `fru-restore-frame'  and
;; `fru-move-frame-to-monitor'

;;; Motivation:
;;; -----------

;; Under X Window frames are controlled  by the Window Manager, which is an not
;; a standardized program.  Frames are  are the main windows of an application,
;; consisting of a title bar (tab), decorations and the client area. MS Windows
;; has the advantage  of a single, unique API for  windows.  Programs need only
;; to know the handle  of their main window to access it.   Under X each Window
;; Manager  idiosyncratically implements window  frames, so  X clients  such as
;; Emacs can only control what happens in their client area.  For example, with
;; TWM  the client  has to  execute \"f.fullzoom\"  to maximize  its  frame.  A
;; normal Emacs user cannot control frames quickly over the keyboard.
;;
;; Nevertheless Emacs defines a number of frame functions that work on a column
;; or screen pel basis. For  example, `set-frame-position' sets the position of
;; the top left corner in pixel units, counting from the top left corner of the
;; display.    Next    we   have   `set-frame-size',    `set-frame-width'   and
;; `set-frame-height',  which  set  the  frame  size in  character  units.   To
;; maximize  the  frame,  for  example,  we must  use  `frame-char-height'  and
;; `frame-char-width' to evaluate the number  of rows/columns that would fit on
;; the screen with the current font setting.
;;
;; These  values are returned  be `frame-height'  and `frame-width'  (the inner
;; height and  width of  a frame in  characters).  `frame-height'  includes the
;; mode/mini-buffer lines.  `frame-pixel-height' and `frame-pixel-width' return
;; the  height and width  in pixels.  Confusing: `frame-pixel-width'  gives the
;; absolute width  in pixels, but  `frame-pixel-height' only the height  of the
;; text lines, in pixels.

;;; KDE:
;;; ----

;; Under  KDE disable  the  "Focus  stealing prevention  level"  of the  Window
;; Manager, or `find-file-other-frame', `display-buffer' etc. maybe won't raise
;; a frame.

;;; Windows NT `w32-send-sys-command' Codes:
;;; ----------------------------------------

;; 61440 - resize the window via keyboard
;; 61456 - move window via keyboard
;; 61472 - minimize current frame
;; 61488 - maximize current frame
;; 61504 - next window (not very practical)
;; 61520 - previous window (not very practical)
;; 61536 - close the window (this will quit the application)
;; 61552 - vertical scroll (impractical)
;; 61568 - horizontal scroll (impractical)
;; 61584 - mouse menu (impractical)
;; 61696 - activate menubar (will not de-activate it, though)
;; 61712 - arrange (impractical)
;; 61728 - restore current frame
;; 61744 - simulate pressing Windows Start button
;; 61760 - activate screensaver
;; 61776 - hotkey (impractical)

;;; Installation:
;;; -------------

;; Copy <frame-utils.el> to site-lisp-directory, <$HOME/bin> or <$HOME/bin/elisp>.
;; In case of the latter add
;;      (pushnew (expand-file-name "~/bin/elisp") load-path)
;;      (pushnew (expand-file-name "~/bin") load-path)
;; to your <.emacs>.

;; In your <.emacs> either
;;      (autoload 'fru-echo-frame-parameters "frame-utils")
;;      (autoload 'fru-auto-display-frame "frame-utils")
;;      (autoload 'fru-auto-display-window "frame-utils")
;; or
;;      (unless (load "frame-utils" t)
;;        (message "WARNING: frame-utils package not found"))
;; and then
;;      (when (featurep 'frame-utils)
;;        (global-set-key [(control x)(control -)] 'fru-echo-frame-parameters)
;;        (global-set-key [(control x)(-)] 'fru-auto-display-frame))

;;; Multiple monitors:
;;; ------------------

;; Set `fru-maximized-frame-pixel-width' and `fru-maximized-frame-pixel-height'
;; to pixel size  a single monitor can display.  The  package will then compute
;; the  actual  number  of  monitors  based on  the  `display-pixel-width'  and
;; `display-pixel-height'  builtins (see  `fru-number-of-vertical-monitors' and
;; `fru-number-of-horizontal-monitors').
;;
;; For example, if  you have a single, wide 26" 1920x1200  LCD you may simulate
;; two horizontal monitors:
;;
;;     (setq fru-frame-pixel-width 960
;;           fru-frame-pixel-height 1200)
;;
;; `fru-maximize-frame' will now  extend frames up to 920x1200  pels; there are
;; two horizontal monitors.

;;; Use Cases
;;; ---------

;;;; Maximize frame at startup:

;; To   maximize    the   frame   after   initialization    is   complete   use
;; `window-setup-hook'. This prevents font  size and window customizations from
;; affecting the size of the maximized frame.
;;
;;      (add-hook 'window-setup-hook 'fru-maximize-frame)

;;; Code:

(defgroup frame-utils nil "Portable Emacs frame utility functions")

(defconst fru-emacs22p
  (and (not (featurep 'xemacs)) (>= emacs-major-version 22)))
(defconst fru-winntp
  (or (eq window-system 'w32)
      (eq window-system 'win32)
      (eq system-type 'windows-nt))
  "Running under Windows NT?")
(defconst fru-xwmp
  (memq window-system '(x mac macos darwin))
  "Running under some X Window Manager?")

(cond
 (fru-winntp (load "w32-fns")))

(defvar fru-restored-configuration ?f
  "The positions, states and window configurations of ALL frames as the
\"restored\" state of Emacs.  In this state the default frame is visible and
not maximized/iconified.  What the register stores is the list returned by
`current-frame-configuration' plus the position of point.")

;;;; -------- MAIN FUNCTIONS
;; ----------------------------------------------------------------------------

;; Smart functions which can be directly bound to keys.

;;;###autoload
(defun fru-auto-display-window (&optional W)
  "Select window W, then shrink its height to be as small as possible to
display its buffer, and shrink/grow its width to by `fill-column' of the
current buffer."
  ;; The shrink-function adjusts the height only. I found no function to set
  ;; window column width, so the problem to adjust the current windows column
  ;; width is solved iteratively.  Makes the window with exactly fill-column+1.
  (save-excursion
    (if W (select-window W))
    (shrink-window-if-larger-than-buffer)
    (while (> (window-width) fill-column) (enlarge-window-horizontally -1))
    (while (< (window-width) fill-column) (enlarge-window-horizontally  1)))
  )

;;;###autoload
(defun fru-auto-display-frame (&optional F)
  "Maximize/restore/repair the frame F (default: selected).
Invoke this function multiple times until F is displayed as you like it."
  (interactive)
  (or F (setq F (selected-frame)))
  (let* ((default-columns (+ 1 fill-column))
         (move-frame current-prefix-arg)
         (W (selected-window))
         (maximized (frame-maximized-p F))
         (restored (frame-restored-p F))
         (special (or buffer-read-only (window-dedicated-p W))))
    (if move-frame
        (let* ((n (fru-number-of-horizontal-monitors))
               (m (fru-number-of-vertical-monitors))
               (h (fru-get-horizontal-monitor-of-frame F))
               (v (fru-get-vertical-monitor-of-frame F)))
          (fru-move-frame-to-monitor (if (>= h (- n 1)) 0 (+ h 1)) v F)
          ;(fru-echo-frame-parameters F)
          )
      ;; Restore or maximize `F'.
      (cond
       ;; Restore invisible or iconified frames.
       ((not (frame-visible-p F))
        (if (frame-iconified-p F)
            (fru-restore-frame F)
          (fru-raise-and-focus-frame F))
        )

       ;; When this is a dedicated frame, iconify and switch to default frame.
       (special
        (iconify-frame F) (fru-raise-and-focus-frame)
        (message "Switched from dedicated frame to default frame.")
        )

       ;; Maximize/restore the default/other frame.  When multiple windows are
       ;; open `fru-auto-display-window' the selected window.
       (t
        (cond (maximized (fru-restore-frame))
              (restored (fru-maximize-frame))
              (t (error "Frame neither maximized nor restored?")))
        (unless (one-window-p t)
          (fru-auto-display-window))
        )
       )
      )
    )
  )

;;;###autoload
(defun fru-echo-frame-parameters (&optional F what)
  "Print some frame parameters in the echo area."
  (interactive)
  (or F (setq F (selected-frame)))
  (message (concat "   %s\n"
                   "   Monitor: %dx%d_%dx%d   Display: %s   Max.cols/rows.: %dx%d   Font: %s\n"
                   "   Frame(%s): %d-%d_%s   Cols/rows/fill: %dx%d_%d   Border: %d,%d,%d,%d")
           (or what "")
           ;; Monitors
           (fru-number-of-horizontal-monitors)
           (fru-number-of-vertical-monitors)
           (fru-display-pixel-width)
           (fru-display-pixel-height)
           ;; Display
           (fru-concat-x-geometry (display-pixel-width) (display-pixel-height))
           ;; Rows/columns max.
           (fru-frame-columns F) (fru-frame-rows F)
           ;; Font
           (fru-concat-x-geometry (frame-char-width F) (frame-char-height F))
           ;; Frame
           (if (frame-maximized-p F) "maximized"
             (if (frame-restored-p F) "restored"
               (if (frame-iconified-p F) "iconified" "?")))
           (+ 1 (fru-get-horizontal-monitor-of-frame F))
           (+ 1 (fru-get-vertical-monitor-of-frame F))
           (fru-concat-x-geometry (frame-pixel-width F) (frame-pixel-height F)
                                  (fru-frame-left-position F) (fru-frame-top-position F))

           (frame-width F) (frame-height F) fill-column
           ;; Border
           (fru-frame-decoration-left)
           (fru-frame-decoration-right)
           (fru-frame-decoration-top)
           (fru-frame-decoration-bottom)
           )
  )

;;;###autoload
(defun fru-restore-frame (&optional F)
  "Restore frame F (default: selected frame)."
  (interactive)
  (or F (setq F (selected-frame)))
  (let ((random-pos t)
        (name (if (fru-is-default-frame F) "Default frame" "Frame")))
    (cond
     ;; Win32.
     (fru-winntp
      (w32-send-sys-command 61728 F))
     ;; Generic handler for X and MacOS.
     (t
      (when (and (fru-is-default-frame F) (get-register fru-restored-configuration))
        (window-configuration-to-register ?t)
        (jump-to-register fru-restored-configuration t)
        (jump-to-register ?t)
        (unless (setq random-pos (frame-maximized-p F))
          (message "%s restored" name)))
      (when random-pos
        ;; Choose a random position. `hmn' is the nth horizontal monitor
        ;; (zerobased) where `F' is currently located on.
        (let* ((maxcols (fru-frame-columns F))
               (maxrows (fru-frame-rows F))
               (dpw (fru-display-pixel-width))
               (vmn 0)
               (hmn (/ (+ (fru-frame-left-position F) (fru-frame-decoration-left F)) dpw)))
          (random t)
          (if (zerop (random 2))
              (set-frame-position F (+ 200 (* hmn dpw)) 100))
          (set-frame-size F (if (one-window-p t)
                                (+ fill-column 3)
                              (+ (truncate (/ maxcols 2)) 10))
                          (+ (truncate (/ maxrows 2)) 5))
          (message "%s restored to some random position on monitor %d-%d" name vmn hmn))
        )
      )
     )
    (if (fru-is-default-frame F)
        (frame-configuration-to-register fru-restored-configuration)))
  )

(defun fru-set-frame-position (F x y)
  ;; The builtin `set-frame-position' ignores X and Y when the frame would
  ;; outrange the screen.
  (let ((w (frame-width F))
        (h (frame-height F)))
    (set-frame-size F 10 10)
    (set-frame-position F x y)
    (set-frame-size F (min w (fru-frame-columns F)) (min h (fru-frame-rows F)))
    )
  )

(defun fru-set-frame-pixel-size (F width height)
  (set-frame-size F (fru-frame-columns F width) (fru-frame-rows F height)))

;;;###autoload
(defun fru-set-frame-icon (&optional iconfile F title)
  (interactive)
  (or F (setq F (selected-frame)))
  (if iconfile
      (if (--file-readable-p iconfile)
          (modify-frame-parameters F (list (cons 'icon-type iconfile)))
        (message "%s: icon-file not found" iconfile)))
  (if title
      (setq frame-title-format title)))

;;;###autoload
(defun fru-maximize-frame (&optional F)
  "Maximize frame F (defaults to selected) to cover the whole display."
  (interactive)
  (or F (setq F (selected-frame)))
  (when (and (fru-is-default-frame F)
             (not (frame-maximized-p F)))
    ;; The frame could have been moved to another monitor.
    (frame-configuration-to-register fru-restored-configuration))
  (cond
   (fru-winntp
    (w32-send-sys-command 61488 F)
    (when (fru-is-default-frame F)
      (message "Default frame maximized")))
   ;; Generic handlers that only size the frame, but do not truely tells the WM
   ;; to maximize it.  `hmn' is the nth horizontal monitor (zerobased) where
   ;; `F' is currently located on.
   (t
    (let* ((maxcols (fru-frame-columns F))
           (maxrows (fru-frame-rows F))
           (dpw (fru-display-pixel-width))
           (name (if (fru-is-default-frame F) "Default frame" "Frame"))
           (vmn 0)
           (hmn (floor (/ (fru-frame-left-position F) dpw))))
      (fru-set-frame-position F (* hmn dpw) 0)
      (set-frame-size F maxcols maxrows)
      (message "%s maximized on monitor %d-%d" name (+ hmn 1) (+ vmn 1)))
    )
   )
  )

(defun fru-move-frame-to-monitor (hmn vmn &optional F)
  "HMN/VMN are zerobased monitor numbers. F defaults to the selected frame."
  (interactive)
  (or F (setq F (selected-frame)))
  (let* ((dpw (fru-display-pixel-width))
         (dph (fru-display-pixel-height))
         (was-maximized (frame-maximized-p F))
         (h (fru-get-horizontal-monitor-of-frame F))
         (v (fru-get-vertical-monitor-of-frame F))
         (xoffs (- (fru-frame-left-position F) (* h dpw)))
         (yoffs (- (fru-frame-top-position F)  (* v dph)))
         (newx (max 0 (+ xoffs (* hmn dpw))))
         (newy (max 0 (+ yoffs (* vmn dph)))))
    (set-frame-position F newx newy)
    (if was-maximized (fru-maximize-frame F))
    (fru-echo-frame-parameters F "MOVED FRAME"))
  )

;;;; -------- UTILITY FUNCTIONS
;; ----------------------------------------------------------------------------

;; Now provided on all Emacssen:
;;     `frame-visible-p' and `frame-totally-visible-p'
;;     `frame-avaible-p' and `frame-live-p'
;;     `frame-iconified-p', `frame-restored-p' and `frame-maximized-p'

(defsubst frame-available-p (F)
  "Actually an alias for `frame-visible-p'."
  (and (frame-live-p F) (eq t (frame-visible-p F))))

(unless (fboundp 'frame-totally-visible-p)
  (defsubst frame-totally-visible-p (F)
    "Returns t when a frame is not obscured by any other X window and not
iconified (see `frame-visible-p').  In this generic implementation, however, we
can only test if a frame is currently in use for display."
    (frame-available-p F)))

(defsubst frame-iconified-p (F)
  "Returns t when a frame is iconified."
  (and (frame-available-p F) (eq 'icon (frame-visible-p F))))

(defsubst frame-restored-p (F)
  "True when frame is not iconified and not maximized."
  (and (frame-available-p F)
       (not (or (frame-iconified-p F)
                (frame-maximized-p F)))))

(defsubst frame-maximized-p (F)
  "True when frame F covers at least 95% of the display width and height."
  (if (frame-available-p F)
      (let ((dpw (fru-display-pixel-width))
            (dph (fru-display-pixel-height))
            (fpw (frame-pixel-width F))
            (fph (frame-pixel-height F)))
        ;;(message "%f %f %s" fpw (* dpw 0.97) (if (>= fpw (* dpw 0.9)) "1" "0"))
        (and (>= fpw (* dpw 0.95))
             (>= fph (* dph 0.95))))))

(defun fru-concat-x-geometry (width height &optional xoffset yoffset)
  "Make X11 geometry string of the form

        <width>x<height>{+-}<xoffset>{+-}<yoffset>

for specifying the size and placement location for an object. `width',
`height', `xoffset' and `yoffset' are numbers that measure pixels.

The `width' and `height' parts of the geometry specification are measured in
pixels.  `xoffset' and `yoffset' specify the distance of the placement
coordinate.  Both types of offsets are measured from the indicated edge of the
object to the corresponding edge of the related object (when this is the
screen, its top-left edge known as (0,0)).

    +xoffset    The left edge of the object is to be placed `xoffset' pixels in from the left edge.
    -xoffset    The left edge of the object is to be placed `xoffset' pixels out from the left edge
    +yoffset    The top edge of the object is to be `yoffset' pixels below the top edge.
    -yoffset    The top edge of the object is to be `yoffset' pixels above the top edge

Either `xoffset' or `yoffset' both must be present."
  (concat (if width (format "%dx%d" width height))
          (if xoffset (format (if (>= xoffset 0) "+%d" "%d") xoffset))
          (if yoffset (format (if (>= yoffset 0) "+%d" "%d") yoffset)))
  )

(defun fru-find-file-reuse-frames (filename &optional lineno)
  "Reuse a visible frame already containing the file and go to LINENO."
  (let ((buffer (find-file-noselect (file-truename filename)))
        (pop-up-frames t)
        (display-buffer-reuse-frames t))
    (set-buffer buffer)
    (select-window (display-buffer buffer nil t))
    (fru-raise-and-focus-frame (window-frame (get-buffer-window buffer)))
    (when lineno (goto-line lineno))))

(defun fru-get-frame-from-buffer (&optional buf)
  "Return frame object for buffer BUF (default: current)."
  (window-frame (get-buffer-window (or buf (current-buffer)))))

(defun fru-raise-and-focus-frame (&optional F)
  "Raise frame F, make it visible and select it for subsequent edit commands.
F defaults to the default frame, i.e. `default-minibuffer-frame'."
  (or F (setq F default-minibuffer-frame))
  (when (frame-live-p F)
    ;; Cancel any focus redirections, deiconify, bring to front, set input
    ;; focus -> try everything "to pursade the WM" to activate it for input.
    (redirect-frame-focus F)
    (raise-frame F)
    (make-frame-visible F)
    (unless fru-emacs22p (focus-frame F))
    (select-frame F)
    (select-frame-set-input-focus F)
    ;; The following code borrows from `gnus-select-frame-set-input-focus'.
    (cond ((and fru-xwmp (fboundp 'x-focus-frame))
           (x-focus-frame F))
          (fru-winntp (w32-focus-frame F)))
    (when focus-follows-mouse
      (set-mouse-position F (1- (frame-width F)) 0)))
  )

;;;; -------- SUPPORT FOR MULTIPLE MONITORS
;; ----------------------------------------------------------------------------

(defvar fru-frame-pixel-width nil
  "Use this variable to define the # of pels a single monitor can display
horizontally, or `nil' for the full `display-pixel-width'.
Note, however, that  `display-pixel-width' relates to all monitors.")

(defvar fru-frame-pixel-height nil
  "Use this variable to define the # of pels a single monitor can display
vertically, or `nil' for the full `display-pixel-height'.
Note, however, that  `display-pixel-height' relates to all monitors.")

(defun fru-have-multiple-monitors ()
  "Return t if more than one monitor is available.
Multiple monitors are defined indirectly by `fru-frame-pixel-width' and
`fru-frame-pixel-height'."
  (or (> (fru-number-of-horizontal-monitors) 1)
      (> (fru-number-of-vertical-monitors) 1)))
(defun fru-number-of-horizontal-monitors ()
  "Get the one-based # monitor columns."
  (max 1 (if fru-frame-pixel-width (/ (display-pixel-width) fru-frame-pixel-width) 0)))
(defun fru-number-of-vertical-monitors ()
  "Get the one-based # monitor rows."
  (max 1 (if fru-frame-pixel-height (/ (display-pixel-height) fru-frame-pixel-height) 0)))

(defun fru-get-vertical-monitor-of-frame (&optional F)
  "Get zerobased row index of monitor displaying F."
  (/ (+ (fru-frame-top-position F) (fru-frame-decoration-top F)) (fru-display-pixel-height)))
(defun fru-get-horizontal-monitor-of-frame (&optional F)
  "Get zerobased column index of monitor displaying F."
  (/ (+ (fru-frame-left-position F) (fru-frame-decoration-left F)) (fru-display-pixel-width)))

(defun fru-display-pixel-width ()
  "`display-pixel-width' quotient for multiple monitors placed horizontally.
See `fru-display-pixel-height'."
  (/ (display-pixel-width) (fru-number-of-horizontal-monitors)))

(defun fru-display-pixel-height ()
  "`display-pixel-height' quotient for multiple monitors stacked vertically.
See `fru-display-pixel-width'."
  (/ (display-pixel-height) (fru-number-of-vertical-monitors)))

;;;; -------- FRAME ATTRIBUTES
;; ----------------------------------------------------------------------------

;;;;;;;;;;;;;;;;;;;;;;;;;
;; Get the extra decoration on all four sides of Emacs frams in pels (pixels).
;;
;; For Emacs 21 and below uses some hard-coded values.

;;(fru-set-frame-position (selected-frame) 1280 0)
;;(fru-set-frame-pixel-size (selected-frame) 1280 900)

(defun fru-frame-border-width (&optional F)
  (+ (frame-parameter F 'border-width)  ; 2, 1
     (frame-parameter F 'internal-border-width)))
(defun fru-frame-decoration-top (&optional F)
  (+ (fru-frame-border-width F)
     (if fru-winntp 12 0)))
(defun fru-frame-decoration-bottom (&optional F)
  (+ (fru-frame-border-width F)
     (if fru-winntp 18 0)))
(defun fru-frame-decoration-left (&optional F)
  (+ (fru-frame-border-width F)
     (if fru-emacs22p (frame-parameter F 'left-fringe)
       (if fru-winntp 8 18))))
(defun fru-frame-decoration-right (&optional F)
  (+ (fru-frame-border-width F)
     (if fru-emacs22p (frame-parameter F 'right-fringe)
       (if fru-winntp 8 12))))

(defun fru-is-default-frame (&optional F)
  "The default frame is the initial frame from which all others are spawned (`default-minibuffer-frame').
The value is set by `frame-initialize' (<frame.el>), called by <startup.el>
before loading the user's initialization file."
  (eq (or F (selected-frame)) default-minibuffer-frame))

(defun fru-frame-top-position (F)
  "Get vertical frame position (top edge) in pixels."
  (eval (frame-parameter F 'top)))
(defun fru-frame-left-position (F)
  "Get horizontal frame position (left edge) in pixels."
  (eval (frame-parameter F 'left)))

(defun fru-frame-columns (&optional F width)
  "Calculates the maximum number of columns that can fit in pixels specified by
WIDTH (default: `fru-display-pixel-width')."
  (truncate (/ (- (or width (fru-display-pixel-width))
                  (fru-frame-decoration-left F)
                  (fru-frame-decoration-right F))
               (frame-char-width F))))
(defun fru-frame-rows (&optional F height)
  "Calculates the number of rows that can fit in pixels specified by
HEIGHT (default: `fru-display-pixel-height')."
  (truncate (/ (- (or height (fru-display-pixel-height))
                  (fru-frame-decoration-top F)
                  (fru-frame-decoration-bottom F))
               (frame-char-height F))))

;;;; -------- MISC
;; ----------------------------------------------------------------------------

(defun fru-frame-font-to-point()
  "Under NT pop dialog and choose a font.  Insert fon-string at point."
  (interactive)
  (cond
   (fru-winntp (insert(prin1-to-string(x-select-font))))
   (t (insert (frame-parameter nil 'font)))))

(defun fru-list-fonts()
  "Show list of all available fonts"
  ;; From <http://www.emacswiki.org/emacs/McMahanEmacsMacros>
  (interactive)
  (pop-to-buffer "*Fonts*")
  (erase-buffer)
  (insert-string (prin1-to-string (x-list-fonts "*")))
  (goto-char (point-min)) (delete-char 2)
  (while (re-search-forward "\" \"" nil t)
    (replace-match "\n"))
  (goto-char (point-max)) (delete-char -2)
  (sort-lines nil (point-min) (point-max))
  (goto-char (point-min))
  (local-set-key "q" (quote delete-window)))

;;;###autoload
(defun fru-set-frame-font (&optional fontnum F)
  "Enables font on frame F according to an abstract number FONTNUM:

     0   user-selection...
     1-4 monospaced tiny, small, normal, large
     5-7 sans-serif small, normal, large
     8-9 serif normal, large

F defaults to current frame. Interactively FONTNUM is the prefix-arg."
  (interactive)
  (let ((Forg (if F (selected-frame)))
        (num (if current-prefix-arg current-prefix-arg fontnum))
        (was-maximized (frame-maximized-p F)))
    (if F (select-frame F))
    (cond
     ;; Win32.
     ;; (insert (w32-select-font))
     (fru-winntp
      (cond ((eq num 0) (set-frame-font (x-select-font nil t)))
            ((eq num 1) (set-frame-font "MS Dialog Light-6"))
            ((eq num 2) (set-frame-font "Lucida Console-9"))
            ((eq num 3) (set-frame-font "Courier-10"))
            ((eq num 4) (set-frame-font "Lucida Sans Typewriter-10"))
            ((eq num 5) (set-frame-font "-outline-Lucida Console-normal-r-normal-normal-16-157-96-96-c-*-iso10646-1"))
            ((eq num 6) (set-frame-font "-outline-Lucida Console-normal-r-normal-normal-18-157-96-96-c-*-iso10646-1"))
            ((eq num 7) (set-frame-font "-outline-Times New Roman-normal-r-normal-normal-17-142-96-96-p-*-iso10646-1"))
            ((eq num 8) (set-frame-font "-outline-Times New Roman-normal-r-normal-normal-19-142-96-96-p-*-iso10646-1"))
            ((eq num 9) (set-frame-font "-outline-Times New Roman-normal-r-normal-normal-24-180-96-96-p-*-iso10646-1"))
            )
      (fru-restore-frame)
      (fru-maximize-frame)
      )
     ;; X/Windows. Try `x-list-fonts', `x-family-fonts'.  Run <xfontsel> in a
     ;; shell. Also try SHIFT+RIGHT-CLICK.
     (fru-xwmp
      (cond ((eq num 0) (shell-command "xfontsel&"))
            ((eq num 1) (set-frame-font "-misc-*-medium-r-normal-*-13-*-*-*-*-*-iso8859-1"))
            ((eq num 2) (set-frame-font "-adobe-*-medium-r-*-*-14-*-*-*-*-*-iso8859-1"))
            ((eq num 3) (set-frame-font "9x15"))
            ((eq num 4) (set-frame-font "-*-fixed-medium-r-normal-*-20-*-ISO8859-1"))
            ((eq num 5) (set-frame-font "-adobe-helvetica-bold-r-*-*-14-*-*-*-*-*-iso8859-1"))
            ((eq num 6) (set-frame-font "-adobe-helvetica-medium-r-*-*-20-*-*-*-*-*-iso8859-1"))
            ((eq num 7) (set-frame-font "-b&h-*-medium-r-*-sans-18-*-*-*-*-*-iso8859-1"))
            ((eq num 8) (set-frame-font "-adobe-times-medium-r-*-*-20-*-*-*-*-*-iso8859-1"))
            ((eq num 9) (set-frame-font "-adobe-new century schoolbook-medium-r-*-*-24-*-*-*-*-*-iso8859-1"))))
     )

    (fru-echo-frame-parameters F "SET FONT")
    (if was-maximized (fru-maximize-frame F))
    (if Forg (select-frame Forg))
    )
  )

(provide 'frame-utils)

;;; frame-utils.el ends here