view src/dialog-msw.c @ 665:fdefd0186b75

[xemacs-hg @ 2001-09-20 06:28:42 by ben] The great integral types renaming. The purpose of this is to rationalize the names used for various integral types, so that they match their intended uses and follow consist conventions, and eliminate types that were not semantically different from each other. The conventions are: -- All integral types that measure quantities of anything are signed. Some people disagree vociferously with this, but their arguments are mostly theoretical, and are vastly outweighed by the practical headaches of mixing signed and unsigned values, and more importantly by the far increased likelihood of inadvertent bugs: Because of the broken "viral" nature of unsigned quantities in C (operations involving mixed signed/unsigned are done unsigned, when exactly the opposite is nearly always wanted), even a single error in declaring a quantity unsigned that should be signed, or even the even more subtle error of comparing signed and unsigned values and forgetting the necessary cast, can be catastrophic, as comparisons will yield wrong results. -Wsign-compare is turned on specifically to catch this, but this tends to result in a great number of warnings when mixing signed and unsigned, and the casts are annoying. More has been written on this elsewhere. -- All such quantity types just mentioned boil down to EMACS_INT, which is 32 bits on 32-bit machines and 64 bits on 64-bit machines. This is guaranteed to be the same size as Lisp objects of type `int', and (as far as I can tell) of size_t (unsigned!) and ssize_t. The only type below that is not an EMACS_INT is Hashcode, which is an unsigned value of the same size as EMACS_INT. -- Type names should be relatively short (no more than 10 characters or so), with the first letter capitalized and no underscores if they can at all be avoided. -- "count" == a zero-based measurement of some quantity. Includes sizes, offsets, and indexes. -- "bpos" == a one-based measurement of a position in a buffer. "Charbpos" and "Bytebpos" count text in the buffer, rather than bytes in memory; thus Bytebpos does not directly correspond to the memory representation. Use "Membpos" for this. -- "Char" refers to internal-format characters, not to the C type "char", which is really a byte. -- For the actual name changes, see the script below. I ran the following script to do the conversion. (NOTE: This script is idempotent. You can safely run it multiple times and it will not screw up previous results -- in fact, it will do nothing if nothing has changed. Thus, it can be run repeatedly as necessary to handle patches coming in from old workspaces, or old branches.) There are two tags, just before and just after the change: `pre-integral-type-rename' and `post-integral-type-rename'. When merging code from the main trunk into a branch, the best thing to do is first merge up to `pre-integral-type-rename', then apply the script and associated changes, then merge from `post-integral-type-change' to the present. (Alternatively, just do the merging in one operation; but you may then have a lot of conflicts needing to be resolved by hand.) Script `fixtypes.sh' follows: ----------------------------------- cut ------------------------------------ files="*.[ch] s/*.h m/*.h config.h.in ../configure.in Makefile.in.in ../lib-src/*.[ch] ../lwlib/*.[ch]" gr Memory_Count Bytecount $files gr Lstream_Data_Count Bytecount $files gr Element_Count Elemcount $files gr Hash_Code Hashcode $files gr extcount bytecount $files gr bufpos charbpos $files gr bytind bytebpos $files gr memind membpos $files gr bufbyte intbyte $files gr Extcount Bytecount $files gr Bufpos Charbpos $files gr Bytind Bytebpos $files gr Memind Membpos $files gr Bufbyte Intbyte $files gr EXTCOUNT BYTECOUNT $files gr BUFPOS CHARBPOS $files gr BYTIND BYTEBPOS $files gr MEMIND MEMBPOS $files gr BUFBYTE INTBYTE $files gr MEMORY_COUNT BYTECOUNT $files gr LSTREAM_DATA_COUNT BYTECOUNT $files gr ELEMENT_COUNT ELEMCOUNT $files gr HASH_CODE HASHCODE $files ----------------------------------- cut ------------------------------------ `fixtypes.sh' is a Bourne-shell script; it uses 'gr': ----------------------------------- cut ------------------------------------ #!/bin/sh # Usage is like this: # gr FROM TO FILES ... # globally replace FROM with TO in FILES. FROM and TO are regular expressions. # backup files are stored in the `backup' directory. from="$1" to="$2" shift 2 echo ${1+"$@"} | xargs global-replace "s/$from/$to/g" ----------------------------------- cut ------------------------------------ `gr' in turn uses a Perl script to do its real work, `global-replace', which follows: ----------------------------------- cut ------------------------------------ : #-*- Perl -*- ### global-modify --- modify the contents of a file by a Perl expression ## Copyright (C) 1999 Martin Buchholz. ## Copyright (C) 2001 Ben Wing. ## Authors: Martin Buchholz <martin@xemacs.org>, Ben Wing <ben@xemacs.org> ## Maintainer: Ben Wing <ben@xemacs.org> ## Current Version: 1.0, May 5, 2001 # 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 XEmacs; see the file COPYING. If not, write to the Free # Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA # 02111-1307, USA. eval 'exec perl -w -S $0 ${1+"$@"}' if 0; use strict; use FileHandle; use Carp; use Getopt::Long; use File::Basename; (my $myName = $0) =~ s@.*/@@; my $usage=" Usage: $myName [--help] [--backup-dir=DIR] [--line-mode] [--hunk-mode] PERLEXPR FILE ... Globally modify a file, either line by line or in one big hunk. Typical usage is like this: [with GNU print, GNU xargs: guaranteed to handle spaces, quotes, etc. in file names] find . -name '*.[ch]' -print0 | xargs -0 $0 's/\bCONST\b/const/g'\n [with non-GNU print, xargs] find . -name '*.[ch]' -print | xargs $0 's/\bCONST\b/const/g'\n The file is read in, either line by line (with --line-mode specified) or in one big hunk (with --hunk-mode specified; it's the default), and the Perl expression is then evalled with \$_ set to the line or hunk of text, including the terminating newline if there is one. It should destructively modify the value there, storing the changed result in \$_. Files in which any modifications are made are backed up to the directory specified using --backup-dir, or to `backup' by default. To disable this, use --backup-dir= with no argument. Hunk mode is the default because it is MUCH MUCH faster than line-by-line. Use line-by-line only when it matters, e.g. you want to do a replacement only once per line (the default without the `g' argument). Conversely, when using hunk mode, *ALWAYS* use `g'; otherwise, you will only make one replacement in the entire file! "; my %options = (); $Getopt::Long::ignorecase = 0; &GetOptions ( \%options, 'help', 'backup-dir=s', 'line-mode', 'hunk-mode', ); die $usage if $options{"help"} or @ARGV <= 1; my $code = shift; die $usage if grep (-d || ! -w, @ARGV); sub SafeOpen { open ((my $fh = new FileHandle), $_[0]); confess "Can't open $_[0]: $!" if ! defined $fh; return $fh; } sub SafeClose { close $_[0] or confess "Can't close $_[0]: $!"; } sub FileContents { my $fh = SafeOpen ("< $_[0]"); my $olddollarslash = $/; local $/ = undef; my $contents = <$fh>; $/ = $olddollarslash; return $contents; } sub WriteStringToFile { my $fh = SafeOpen ("> $_[0]"); binmode $fh; print $fh $_[1] or confess "$_[0]: $!\n"; SafeClose $fh; } foreach my $file (@ARGV) { my $changed_p = 0; my $new_contents = ""; if ($options{"line-mode"}) { my $fh = SafeOpen $file; while (<$fh>) { my $save_line = $_; eval $code; $changed_p = 1 if $save_line ne $_; $new_contents .= $_; } } else { my $orig_contents = $_ = FileContents $file; eval $code; if ($_ ne $orig_contents) { $changed_p = 1; $new_contents = $_; } } if ($changed_p) { my $backdir = $options{"backup-dir"}; $backdir = "backup" if !defined ($backdir); if ($backdir) { my ($name, $path, $suffix) = fileparse ($file, ""); my $backfulldir = $path . $backdir; my $backfile = "$backfulldir/$name"; mkdir $backfulldir, 0755 unless -d $backfulldir; print "modifying $file (original saved in $backfile)\n"; rename $file, $backfile; } WriteStringToFile ($file, $new_contents); } } ----------------------------------- cut ------------------------------------ In addition to those programs, I needed to fix up a few other things, particularly relating to the duplicate definitions of types, now that some types merged with others. Specifically: 1. in lisp.h, removed duplicate declarations of Bytecount. The changed code should now look like this: (In each code snippet below, the first and last lines are the same as the original, as are all lines outside of those lines. That allows you to locate the section to be replaced, and replace the stuff in that section, verifying that there isn't anything new added that would need to be kept.) --------------------------------- snip ------------------------------------- /* Counts of bytes or chars */ typedef EMACS_INT Bytecount; typedef EMACS_INT Charcount; /* Counts of elements */ typedef EMACS_INT Elemcount; /* Hash codes */ typedef unsigned long Hashcode; /* ------------------------ dynamic arrays ------------------- */ --------------------------------- snip ------------------------------------- 2. in lstream.h, removed duplicate declaration of Bytecount. Rewrote the comment about this type. The changed code should now look like this: --------------------------------- snip ------------------------------------- #endif /* The have been some arguments over the what the type should be that specifies a count of bytes in a data block to be written out or read in, using Lstream_read(), Lstream_write(), and related functions. Originally it was long, which worked fine; Martin "corrected" these to size_t and ssize_t on the grounds that this is theoretically cleaner and is in keeping with the C standards. Unfortunately, this practice is horribly error-prone due to design flaws in the way that mixed signed/unsigned arithmetic happens. In fact, by doing this change, Martin introduced a subtle but fatal error that caused the operation of sending large mail messages to the SMTP server under Windows to fail. By putting all values back to be signed, avoiding any signed/unsigned mixing, the bug immediately went away. The type then in use was Lstream_Data_Count, so that it be reverted cleanly if a vote came to that. Now it is Bytecount. Some earlier comments about why the type must be signed: This MUST BE SIGNED, since it also is used in functions that return the number of bytes actually read to or written from in an operation, and these functions can return -1 to signal error. Note that the standard Unix read() and write() functions define the count going in as a size_t, which is UNSIGNED, and the count going out as an ssize_t, which is SIGNED. This is a horrible design flaw. Not only is it highly likely to lead to logic errors when a -1 gets interpreted as a large positive number, but operations are bound to fail in all sorts of horrible ways when a number in the upper-half of the size_t range is passed in -- this number is unrepresentable as an ssize_t, so code that checks to see how many bytes are actually written (which is mandatory if you are dealing with certain types of devices) will get completely screwed up. --ben */ typedef enum lstream_buffering --------------------------------- snip ------------------------------------- 3. in dumper.c, there are four places, all inside of switch() statements, where XD_BYTECOUNT appears twice as a case tag. In each case, the two case blocks contain identical code, and you should *REMOVE THE SECOND* and leave the first.
author ben
date Thu, 20 Sep 2001 06:31:11 +0000
parents b39c14581166
children 685b588e92d8
line wrap: on
line source

/* Implements elisp-programmable dialog boxes -- MS Windows interface.
   Copyright (C) 1998 Kirill M. Katsnelson <kkm@kis.ru>
   Copyright (C) 2000 Ben Wing.

This file is part of XEmacs.

XEmacs 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.

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

/* Synched up with: Not in FSF. */

/* Author:
   Initially written by kkm, May 1998
*/

#include <config.h>
#include "lisp.h"

#include "buffer.h"
#include "console-msw.h"
#include "frame.h"
#include "gui.h"
#include "opaque.h"

#include <cderr.h>
#include <commdlg.h>

Lisp_Object Qdialog_box_error;

static Lisp_Object Q_initial_directory;
static Lisp_Object Q_initial_filename;
static Lisp_Object Q_filter_list;
static Lisp_Object Q_allow_multi_select;
static Lisp_Object Q_create_prompt_on_nonexistent;
static Lisp_Object Q_overwrite_prompt;
static Lisp_Object Q_file_must_exist;
static Lisp_Object Q_no_network_button;
static Lisp_Object Q_no_read_only_return;

/* List containing all dialog data structures of currently popped up
   dialogs. */
static Lisp_Object Vdialog_data_list;

/* List of popup frames wanting keyboard traversal handled */
static Lisp_Object Vpopup_frame_list;

Lisp_Object Vdefault_file_dialog_filter_alist;

/* DLUs per character metrics */
#define X_DLU_PER_CHAR	     4
#define Y_DLU_PER_CHAR	     8

/*
  Button metrics
  --------------
  All buttons have height of 15 DLU. The minimum width for a button is 32 DLU, 
  but it can be expanded to accommodate its text, so the width is calculated as
  8 DLU per button plus 4 DLU per character.
  max (32, 6 * text_length). The factor of six is rather empirical, but it
  works better than 8 which comes from the definition of a DLU. Buttons are
  spaced with 6 DLU gap. Minimum distance from the button to the left or right 
  dialog edges is 6 DLU, and the distance between the dialog bottom edge and
  buttons is 7 DLU.
*/

#define X_MIN_BUTTON	    32
#define X_BUTTON_MARGIN	     8
#define Y_BUTTON	    15
#define X_BUTTON_SPACING     6
#define X_BUTTON_FROM_EDGE   6
#define Y_BUTTON_FROM_EDGE   7

/* 
   Text field metrics
   ------------------
   Text distance from left and right edges is the same as for buttons, and the
   top margin is 11 DLU. The static control has height of 2 DLU per control
   plus 8 DLU per each line of text. Distance between the bottom edge of the
   control and the button row is 15 DLU. Minimum width of the static control
   is 100 DLU, thus giving minimum dialog weight of 112 DLU. Maximum width is
   300 DLU, and, if the text is wider than that, the text is wrapped on the
   next line. Each character in the text is considered 4 DLU wide.
*/

#define X_MIN_TEXT	   100
#define X_AVE_TEXT	   200
#define X_MAX_TEXT	   300
#define X_TEXT_FROM_EDGE      X_BUTTON_FROM_EDGE
#define Y_TEXT_FROM_EDGE    11
#define Y_TEXT_MARGIN	     2
#define Y_TEXT_FROM_BUTTON  15

#define X_MIN_TEXT_CHAR	   (X_MIN_TEXT / X_DLU_PER_CHAR)
#define X_AVE_TEXT_CHAR	   (X_AVE_TEXT / X_DLU_PER_CHAR)
#define X_MAX_TEXT_CHAR	   (X_MAX_TEXT / X_DLU_PER_CHAR)

/*
  Layout algorithm
  ----------------
  First we calculate the minimum width of the button row, excluding "from
  edge" distances. Note that the static control text can be narrower than
  X_AVE_TEXT only if both text and button row are narrower than that (so,
  even if text *can* be wrapped into 2 rows narrower than ave width, it is not 
  done). Let WBR denote the width of the button row.

  Next, the width of the static field is determined.
  First, if all lines of text fit into max (WBR, X_MAX_TEXT), the width of the
  control is the same as the width of the longest line. 
  Second, if all lines of text are narrower than X_MIN_TEXT, then width of
  the control is set to X_MIN_TEXT.
  Otherwise, width is set to max(WBR, X_AVE_TEXT). In this case, line wrapping will
  happen.

  If width of the text control is larger than that of the button row, then the
  latter is centered across the dialog, by giving it extra edge
  margins. Otherwise, minimal margins are given to the button row.
*/

#define ID_ITEM_BIAS 32

void
mswindows_register_popup_frame (Lisp_Object frame)
{
  Vpopup_frame_list = Fcons (frame, Vpopup_frame_list);
}

void
mswindows_unregister_popup_frame (Lisp_Object frame)
{
  Vpopup_frame_list = delq_no_quit (frame, Vpopup_frame_list);
}

/* Dispatch message to any dialog boxes.  Return non-zero if dispatched. */
int
mswindows_is_dialog_msg (MSG *msg)
{
  LIST_LOOP_2 (data, Vdialog_data_list)
    {
      if (IsDialogMessage (XMSWINDOWS_DIALOG_ID (data)->hwnd, msg))
	return 1;
    }

  {
    LIST_LOOP_2 (popup, Vpopup_frame_list)
      {
	HWND hwnd = FRAME_MSWINDOWS_HANDLE (XFRAME (popup));
	/* This is a windows feature that allows dialog type
	   processing to be applied to standard windows containing
	   controls. */
	if (IsDialogMessage (hwnd, msg))
	  return 1;
      }
  }
  return 0;
}

static Lisp_Object
mark_mswindows_dialog_id (Lisp_Object obj)
{
  struct mswindows_dialog_id *data = XMSWINDOWS_DIALOG_ID (obj);
  mark_object (data->frame);
  return data->callbacks;
}

DEFINE_LRECORD_IMPLEMENTATION ("mswindows-dialog-id", mswindows_dialog_id,
			       mark_mswindows_dialog_id,
			       internal_object_printer, 0, 0, 0, 0,
			       struct mswindows_dialog_id);

/* Dialog procedure */
static BOOL CALLBACK 
dialog_proc (HWND hwnd, UINT msg, WPARAM w_param, LPARAM l_param)
{
  switch (msg)
    {
    case WM_INITDIALOG:
      SetWindowLong (hwnd, DWL_USER, l_param);
      break;
      
    case WM_DESTROY:
      {
	Lisp_Object data;
	VOID_TO_LISP (data, GetWindowLong (hwnd, DWL_USER));
	Vdialog_data_list = delq_no_quit (data, Vdialog_data_list);
      }
      break;

    case WM_COMMAND:
      {
	Lisp_Object fn, arg, data;
	struct mswindows_dialog_id *did;

	VOID_TO_LISP (data, GetWindowLong (hwnd, DWL_USER));
	did = XMSWINDOWS_DIALOG_ID (data);
	if (w_param != IDCANCEL) /* user pressed escape */
	  {
	    assert (w_param >= ID_ITEM_BIAS 
		    && (EMACS_INT) w_param
		    < XVECTOR_LENGTH (did->callbacks) + ID_ITEM_BIAS);
	    
	    get_gui_callback (XVECTOR_DATA (did->callbacks)
			      [w_param - ID_ITEM_BIAS],
			      &fn, &arg);
	    mswindows_enqueue_misc_user_event (did->frame, fn, arg);
	  }
	else
	  mswindows_enqueue_misc_user_event (did->frame, Qrun_hooks,
					     Qmenu_no_selection_hook);
	/* #### need to error-protect!  will do so when i merge in
	   my working ws */
	va_run_hook_with_args (Qdelete_dialog_box_hook, 1, data);

	DestroyWindow (hwnd);
      }
      break;

    default:
      return FALSE;
    }
  return TRUE;
}

/* Helper function which converts the supplied string STRING into Unicode and
   pushes it at the end of DYNARR */
static void
push_lisp_string_as_unicode (unsigned_char_dynarr* dynarr, Lisp_Object string)
{
  Extbyte *mbcs_string;
  Charcount length = XSTRING_CHAR_LENGTH (string);
  LPWSTR uni_string;

  TO_EXTERNAL_FORMAT (LISP_STRING, string,
		      C_STRING_ALLOCA, mbcs_string,
		      Qnative);
  uni_string = alloca_array (WCHAR, length + 1);
  length = MultiByteToWideChar (CP_ACP, 0, mbcs_string, -1,
				uni_string, sizeof(WCHAR) * (length + 1));
  Dynarr_add_many (dynarr, uni_string, sizeof(WCHAR) * length);
}

/* Helper function which converts the supplied string STRING into Unicode and
   pushes it at the end of DYNARR */
static void
push_intbyte_string_as_unicode (unsigned_char_dynarr* dynarr, Intbyte *string,
				Bytecount len)
{
  Extbyte *mbcs_string;
  Charcount length = bytecount_to_charcount (string, len);
  LPWSTR uni_string;

  TO_EXTERNAL_FORMAT (C_STRING, string,
		      C_STRING_ALLOCA, mbcs_string,
		      Qnative);
  uni_string = alloca_array (WCHAR, length + 1);
  length = MultiByteToWideChar (CP_ACP, 0, mbcs_string, -1,
				uni_string, sizeof(WCHAR) * (length + 1));
  Dynarr_add_many (dynarr, uni_string, sizeof(WCHAR) * length);
}

/* Given button TEXT, return button width in DLU */
static int
button_width (Lisp_Object text)
{
  int width = X_DLU_PER_CHAR * XSTRING_CHAR_LENGTH (text);
  return max (X_MIN_BUTTON, width);
}

/* Unwind protection routine frees a dynarr opaqued into arg */
static Lisp_Object
free_dynarr_opaque_ptr (Lisp_Object arg)
{
  Dynarr_free (get_opaque_ptr (arg));
  return arg;
}


#define ALIGN_TEMPLATE					\
{							\
  int slippage = Dynarr_length (template_) & 3;		\
  if (slippage)						\
    Dynarr_add_many (template_, &zeroes, slippage);	\
}

static struct
{
  DWORD errmess;
  char *errname;
} common_dialog_errors[] =
{
  { CDERR_DIALOGFAILURE, "CDERR_DIALOGFAILURE" },
  { CDERR_FINDRESFAILURE, "CDERR_FINDRESFAILURE" },
  { CDERR_INITIALIZATION, "CDERR_INITIALIZATION" },
  { CDERR_LOADRESFAILURE, "CDERR_LOADRESFAILURE" },
  { CDERR_LOADSTRFAILURE, "CDERR_LOADSTRFAILURE" },
  { CDERR_LOCKRESFAILURE, "CDERR_LOCKRESFAILURE" },
  { CDERR_MEMALLOCFAILURE, "CDERR_MEMALLOCFAILURE" },
  { CDERR_MEMLOCKFAILURE, "CDERR_MEMLOCKFAILURE" },
  { CDERR_NOHINSTANCE, "CDERR_NOHINSTANCE" },
  { CDERR_NOHOOK, "CDERR_NOHOOK" },
  { CDERR_NOTEMPLATE, "CDERR_NOTEMPLATE" },
  { CDERR_REGISTERMSGFAIL, "CDERR_REGISTERMSGFAIL" },
  { CDERR_STRUCTSIZE, "CDERR_STRUCTSIZE" },
  { PDERR_CREATEICFAILURE, "PDERR_CREATEICFAILURE" },
  { PDERR_DEFAULTDIFFERENT, "PDERR_DEFAULTDIFFERENT" },
  { PDERR_DNDMMISMATCH, "PDERR_DNDMMISMATCH" },
  { PDERR_GETDEVMODEFAIL, "PDERR_GETDEVMODEFAIL" },
  { PDERR_INITFAILURE, "PDERR_INITFAILURE" },
  { PDERR_LOADDRVFAILURE, "PDERR_LOADDRVFAILURE" },
  { PDERR_NODEFAULTPRN, "PDERR_NODEFAULTPRN" },
  { PDERR_NODEVICES, "PDERR_NODEVICES" },
  { PDERR_PARSEFAILURE, "PDERR_PARSEFAILURE" },
  { PDERR_PRINTERNOTFOUND, "PDERR_PRINTERNOTFOUND" },
  { PDERR_RETDEFFAILURE, "PDERR_RETDEFFAILURE" },
  { PDERR_SETUPFAILURE, "PDERR_SETUPFAILURE" },
  { CFERR_MAXLESSTHANMIN, "CFERR_MAXLESSTHANMIN" },
  { CFERR_NOFONTS, "CFERR_NOFONTS" },
  { FNERR_BUFFERTOOSMALL, "FNERR_BUFFERTOOSMALL" },
  { FNERR_INVALIDFILENAME, "FNERR_INVALIDFILENAME" },
  { FNERR_SUBCLASSFAILURE, "FNERR_SUBCLASSFAILURE" },
  { FRERR_BUFFERLENGTHZERO, "FRERR_BUFFERLENGTHZERO" },
};

static Lisp_Object
handle_file_dialog_box (struct frame *f, Lisp_Object keys)
{
  OPENFILENAME ofn;
  char fnbuf[8000];

  xzero (ofn);
  ofn.lStructSize = sizeof (ofn);
  ofn.hwndOwner = FRAME_MSWINDOWS_HANDLE (f);
  ofn.lpstrFile = fnbuf;
  ofn.nMaxFile = sizeof (fnbuf) / XETCHAR_SIZE;
  xetcscpy (fnbuf, XETEXT (""));

  LOCAL_FILE_FORMAT_TO_TSTR (Fexpand_file_name (build_string (""), Qnil),
			     ofn.lpstrInitialDir);

  {
    EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, keys)
      {
	if (EQ (key, Q_initial_filename))
	  {
	    Extbyte *fnout;

	    CHECK_STRING (value);
	    LOCAL_FILE_FORMAT_TO_TSTR (value, fnout);
	    xetcscpy (fnbuf, fnout);
	  }
	else if (EQ (key, Q_title))
	  {
	    CHECK_STRING (value);
	    LISP_STRING_TO_EXTERNAL (value, ofn.lpstrTitle, Qmswindows_tstr);
	  }
	else if (EQ (key, Q_initial_directory))
	  LOCAL_FILE_FORMAT_TO_TSTR (Fexpand_file_name (value, Qnil),
				     ofn.lpstrInitialDir);
	else if (EQ (key, Q_file_must_exist))
	  {
	    if (!NILP (value))
	      ofn.Flags |= OFN_FILEMUSTEXIST | OFN_PATHMUSTEXIST;
	    else
	      ofn.Flags &= ~(OFN_FILEMUSTEXIST | OFN_PATHMUSTEXIST);
	  }
	else
	  invalid_constant ("Unrecognized file-dialog keyword", key);
      }
  }

  if (!GetOpenFileName (&ofn))
    {
      DWORD err = CommDlgExtendedError ();
      if (!err)
	{
	  while (1)
	    signal_quit ();
	}
      else
	{
	  int i;

	  for (i = 0; i < countof (common_dialog_errors); i++)
	    {
	      if (common_dialog_errors[i].errmess == err)
		signal_error (Qdialog_box_error,
			      "Creating file-dialog-box",
			      build_string
			      (common_dialog_errors[i].errname));
	    }

	  signal_error (Qdialog_box_error,
			"Unknown common dialog box error???",
			make_int (err));
	}
    }

  return tstr_to_local_file_format (ofn.lpstrFile);
}

static Lisp_Object
handle_question_dialog_box (struct frame *f, Lisp_Object keys)
{
  Lisp_Object_dynarr *dialog_items = Dynarr_new (Lisp_Object);
  unsigned_char_dynarr *template_ = Dynarr_new (unsigned_char);
  int button_row_width = 0;
  int text_width, text_height;
  Lisp_Object question = Qnil, title = Qnil;

  int unbind_count = specpdl_depth ();
  record_unwind_protect (free_dynarr_opaque_ptr,
			 make_opaque_ptr (dialog_items));
  record_unwind_protect (free_dynarr_opaque_ptr,
			 make_opaque_ptr (template_));

  /* A big NO NEED to GCPRO gui_items stored in the array: they are just
     pointers into KEYS list, which is GC-protected by the caller */

  {
    EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, keys)
      {
	if (EQ (key, Q_question))
	  {
	    CHECK_STRING (value);
	    question = value;
	  }
	else if (EQ (key, Q_title))
	  {
	    CHECK_STRING (value);
	    title = value;
	  }
	else if (EQ (key, Q_buttons))
	  {
	    Lisp_Object item_cons;

	    /* Parse each item in the dialog into gui_item structs,
	       and stuff a dynarr of these. Calculate button row width
	       in this loop too */
	    EXTERNAL_LIST_LOOP (item_cons, value)
	      {
		if (!NILP (XCAR (item_cons)))
		  {
		    Lisp_Object gitem =
		      gui_parse_item_keywords (XCAR (item_cons));
		    Dynarr_add (dialog_items, gitem);
		    button_row_width += button_width (XGUI_ITEM (gitem)->name) 
		      + X_BUTTON_MARGIN;
		  }
	      }

	    button_row_width -= X_BUTTON_MARGIN;
	  }
	else
	  invalid_constant ("Unrecognized question-dialog keyword", key);
      }
  }

  if (Dynarr_length (dialog_items) == 0)
    sferror ("Dialog descriptor provides no buttons", keys);

  if (NILP (question))
    sferror ("Dialog descriptor provides no question", keys);

  /* Determine the final width layout */
  {
    Intbyte *p = XSTRING_DATA (question);
    Charcount string_max = 0, this_length = 0;
    while (1)
      {
	Emchar ch = charptr_emchar (p);
	INC_CHARPTR (p);
	
	if (ch == (Emchar)'\n' || ch == (Emchar)'\0')
	  {
	    string_max = max (this_length, string_max);
	    this_length = 0;
	  }
	else
	  ++this_length;

	if (ch == (Emchar)'\0')
	  break;
      }

    if (string_max * X_DLU_PER_CHAR > max (X_MAX_TEXT, button_row_width))
      text_width = X_AVE_TEXT;
    else if (string_max * X_DLU_PER_CHAR < X_MIN_TEXT)
      text_width = X_MIN_TEXT;
    else
      text_width = string_max * X_DLU_PER_CHAR;
    text_width = max (text_width, button_row_width);
  }
  
  /* Now calculate the height for the text control */
  {
    Intbyte *p = XSTRING_DATA (question);
    Charcount break_at = text_width / X_DLU_PER_CHAR;
    Charcount char_pos = 0;
    int num_lines = 1;
    Emchar ch;
    
    while ((ch = charptr_emchar (p)) != (Emchar) '\0')
      {
	INC_CHARPTR (p);
	char_pos += ch != (Emchar) '\n';
	if (ch == (Emchar) '\n' || char_pos == break_at)
	  {
	    ++num_lines;
	    char_pos = 0;
	  }
      }
    text_height = Y_TEXT_MARGIN + Y_DLU_PER_CHAR * num_lines;
  }

  /* Ok, now we are ready to stuff the dialog template and lay out controls */
  {
    DLGTEMPLATE dlg_tem;
    DLGITEMTEMPLATE item_tem;
    int i;
    const unsigned int zeroes = 0;
    const unsigned int ones = 0xFFFFFFFF;
    const WORD static_class_id = 0x0082;
    const WORD button_class_id = 0x0080;

    /* Create and stuff in DLGTEMPLATE header */
    dlg_tem.style = (DS_CENTER | DS_MODALFRAME | DS_SETFONT
		     | WS_CAPTION | WS_POPUP | WS_VISIBLE);
    dlg_tem.dwExtendedStyle = 0;
    dlg_tem.cdit = Dynarr_length (dialog_items) + 1;
    dlg_tem.x = 0;
    dlg_tem.y = 0;
    dlg_tem.cx = text_width + 2 * X_TEXT_FROM_EDGE;
    dlg_tem.cy = (Y_TEXT_FROM_EDGE + text_height + Y_TEXT_FROM_BUTTON
		  + Y_BUTTON + Y_BUTTON_FROM_EDGE);
    Dynarr_add_many (template_, &dlg_tem, sizeof (dlg_tem));

    /* We want no menu and standard class */
    Dynarr_add_many (template_, &zeroes, 4);

    /* And the third is the dialog title. "XEmacs" unless one is supplied.
       Note that the string must be in Unicode. */
    if (NILP (title))
      Dynarr_add_many (template_, L"XEmacs", 14);
    else
      push_lisp_string_as_unicode (template_, title);

    /* We want standard dialog font */
    Dynarr_add_many (template_, L"\x08MS Shell Dlg", 28);

    /* Next add text control. */
    item_tem.style = WS_CHILD | WS_VISIBLE | SS_LEFT | SS_NOPREFIX;
    item_tem.dwExtendedStyle = 0;
    item_tem.x = X_TEXT_FROM_EDGE;
    item_tem.y = Y_TEXT_FROM_EDGE;
    item_tem.cx = text_width;
    item_tem.cy = text_height;
    item_tem.id = 0xFFFF;

    ALIGN_TEMPLATE;
    Dynarr_add_many (template_, &item_tem, sizeof (item_tem));

    /* Right after class id follows */
    Dynarr_add_many (template_, &ones, 2);
    Dynarr_add_many (template_, &static_class_id, sizeof (static_class_id));

    /* Next thing to add is control text, as Unicode string */
    push_lisp_string_as_unicode (template_, question);

    /* Specify 0 length creation data */
    Dynarr_add_many (template_, &zeroes, 2);

    /* Now it's the button time */
    item_tem.y = Y_TEXT_FROM_EDGE + text_height + Y_TEXT_FROM_BUTTON;
    item_tem.x = X_BUTTON_FROM_EDGE + (button_row_width < text_width
				       ? (text_width - button_row_width) / 2
				       : 0);
    item_tem.cy = Y_BUTTON;
    item_tem.dwExtendedStyle = 0;

    for (i = 0; i < Dynarr_length (dialog_items); ++i)
      {
	Lisp_Object* gui_item = Dynarr_atp (dialog_items, i);
	Lisp_Gui_Item *pgui_item = XGUI_ITEM (*gui_item);

	item_tem.style = (WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON
			  | (gui_item_active_p (*gui_item) ? 0 : WS_DISABLED));
	item_tem.cx = button_width (pgui_item->name);
	/* Item ids are indices into dialog_items plus offset, to avoid having
           items by reserved ids (IDOK, IDCANCEL) */
	item_tem.id = i + ID_ITEM_BIAS;

	ALIGN_TEMPLATE;
	Dynarr_add_many (template_, &item_tem, sizeof (item_tem));

	/* Right after 0xFFFF and class id atom follows */
	Dynarr_add_many (template_, &ones, 2);
	Dynarr_add_many (template_, &button_class_id,
			 sizeof (button_class_id));

	/* Next thing to add is control text, as Unicode string */
	{
	  Lisp_Object ctext = pgui_item->name;
	  Emchar accel_unused;
	  Intbyte *trans = (Intbyte *) alloca (2 * XSTRING_LENGTH (ctext) + 3);
	  Bytecount translen;

	  memcpy (trans, XSTRING_DATA (ctext), XSTRING_LENGTH (ctext) + 1);
	  translen =
	    mswindows_translate_menu_or_dialog_item (trans,
					       XSTRING_LENGTH (ctext),
					       2 * XSTRING_LENGTH (ctext) + 3,
					       &accel_unused,
					       ctext);
	  push_intbyte_string_as_unicode (template_, trans, translen);
	}

	/* Specify 0 length creation data. */
	Dynarr_add_many (template_, &zeroes, 2);

	item_tem.x += item_tem.cx + X_BUTTON_SPACING;
      }
  }

  /* Now the Windows dialog structure is ready. We need to prepare a
     data structure for the new dialog, which will contain callbacks
     and the frame for these callbacks.  This structure has to be
     GC-protected and thus it is put into a statically protected
     list. */
  {
    Lisp_Object dialog_data;
    int i;
    struct mswindows_dialog_id *did =
      alloc_lcrecord_type (struct mswindows_dialog_id,
			   &lrecord_mswindows_dialog_id);

    XSETMSWINDOWS_DIALOG_ID (dialog_data, did);

    did->frame = wrap_frame (f);
    did->callbacks = make_vector (Dynarr_length (dialog_items), Qunbound);
    for (i = 0; i < Dynarr_length (dialog_items); i++)
      XVECTOR_DATA (did->callbacks) [i] =
	XGUI_ITEM (*Dynarr_atp (dialog_items, i))->callback;
    
    /* Woof! Everything is ready. Pop pop pop in now! */
    did->hwnd =
      CreateDialogIndirectParam (NULL,
				 (LPDLGTEMPLATE) Dynarr_atp (template_, 0),
				 FRAME_MSWINDOWS_HANDLE (f), dialog_proc,
				 (LPARAM) LISP_TO_VOID (dialog_data));
    if (!did->hwnd)
      /* Something went wrong creating the dialog */
      signal_error (Qdialog_box_error, "Creating dialog", keys);

    Vdialog_data_list = Fcons (dialog_data, Vdialog_data_list);

    /* Cease protection and free dynarrays */
    unbind_to (unbind_count, Qnil);
    return dialog_data;
  }
}

static Lisp_Object
mswindows_make_dialog_box_internal (struct frame* f, Lisp_Object type,
				    Lisp_Object keys)
{
  if (EQ (type, Qfile))
    return handle_file_dialog_box (f, keys);
  else if (EQ (type, Qquestion))
    return handle_question_dialog_box (f, keys);
  else if (EQ (type, Qprint))
    return mswindows_handle_print_dialog_box (f, keys);
  else if (EQ (type, Qpage_setup))
    return mswindows_handle_page_setup_dialog_box (f, keys);
  else
    signal_error (Qunimplemented, "Dialog box type", type);
  return Qnil;
}

void
console_type_create_dialog_mswindows (void)
{
  CONSOLE_HAS_METHOD (mswindows, make_dialog_box_internal);
}

void
syms_of_dialog_mswindows (void)
{
  INIT_LRECORD_IMPLEMENTATION (mswindows_dialog_id);

  DEFKEYWORD (Q_initial_directory);
  DEFKEYWORD (Q_initial_filename);
  DEFKEYWORD (Q_filter_list);
  DEFKEYWORD (Q_title);
  DEFKEYWORD (Q_allow_multi_select);
  DEFKEYWORD (Q_create_prompt_on_nonexistent);
  DEFKEYWORD (Q_overwrite_prompt);
  DEFKEYWORD (Q_file_must_exist);
  DEFKEYWORD (Q_no_network_button);
  DEFKEYWORD (Q_no_read_only_return);

  /* Errors */
  DEFERROR_STANDARD (Qdialog_box_error, Qgui_error);
}

void
vars_of_dialog_mswindows (void)
{
  Vpopup_frame_list = Qnil;
  staticpro (&Vpopup_frame_list);

  Vdialog_data_list = Qnil;
  staticpro (&Vdialog_data_list);

  DEFVAR_LISP ("default-file-dialog-filter-alist",
	       &Vdefault_file_dialog_filter_alist /*
*/ );
  Vdefault_file_dialog_filter_alist =
    list5 (Fcons (build_string ("Text Files"), build_string ("*.txt")),
	   Fcons (build_string ("C Files"), build_string ("*.c;*.h")),
	   Fcons (build_string ("Elisp Files"), build_string ("*.el")),
	   Fcons (build_string ("HTML Files"), build_string ("*.html;*.html")),
	   Fcons (build_string ("All Files"), build_string ("*.*")));
}