Mercurial > hg > xemacs-beta
annotate src/dialog-msw.c @ 5353:38e24b8be4ea
Improve the lexical scoping in #'block, #'return-from.
lisp/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el:
* bytecomp.el (byte-compile-initial-macro-environment):
Shadow `block', `return-from' here, we implement them differently
when byte-compiling.
* bytecomp.el (byte-compile-active-blocks): New.
* bytecomp.el (byte-compile-block-1): New.
* bytecomp.el (byte-compile-return-from-1): New.
* bytecomp.el (return-from-1): New.
* bytecomp.el (block-1): New.
These are two aliases that exist to have their own associated
byte-compile functions, which functions implement `block' and
`return-from'.
* cl-extra.el (cl-macroexpand-all):
Fix a bug here when macros in the environment have been compiled.
* cl-macs.el (block):
* cl-macs.el (return):
* cl-macs.el (return-from):
Be more careful about lexical scope in these macros.
* cl.el:
* cl.el ('cl-block-wrapper): Removed.
* cl.el ('cl-block-throw): Removed.
These aren't needed in code generated by this XEmacs. They
shouldn't be needed in code generated by XEmacs 21.4, but if it
turns out the packages do need them, we can put them back.
2011-01-30 Mike Sperber <mike@xemacs.org>
* font-lock.el (font-lock-fontify-pending-extents): Don't fail if
`font-lock-mode' is unset, which can happen in the middle of
`revert-buffer'.
2011-01-23 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete):
* cl-macs.el (delq):
* cl-macs.el (remove):
* cl-macs.el (remq):
Don't use the compiler macro if these functions were given the
wrong number of arguments, as happens in lisp-tests.el.
* cl-seq.el (remove, remq): Removed.
I added these to subr.el, and forgot to remove them from here.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-setq, byte-compile-set):
Remove kludge allowing keywords' values to be set, all the code
that does that is gone.
* cl-compat.el (elt-satisfies-test-p):
* faces.el (set-face-parent):
* faces.el (face-doc-string):
* gtk-font-menu.el:
* gtk-font-menu.el (gtk-reset-device-font-menus):
* msw-font-menu.el:
* msw-font-menu.el (mswindows-reset-device-font-menus):
* package-get.el (package-get-installedp):
* select.el (select-convert-from-image-data):
* sound.el:
* sound.el (load-sound-file):
* x-font-menu.el (x-reset-device-font-menus-core):
Don't quote keywords, they're self-quoting, and the
win from backward-compatibility is sufficiently small now that the
style problem overrides it.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (block, return-from): Require that NAME be a symbol
in these macros, as always documented in the #'block docstring and
as required by Common Lisp.
* descr-text.el (unidata-initialize-unihan-database):
Correct the use of non-symbols in #'block and #'return-from in
this function.
2011-01-15 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (concatenate): Accept more complicated TYPEs in this
function, handing the sequences over to #'coerce if we don't
understand them here.
* cl-macs.el (inline): Don't proclaim #'concatenate as inline, its
compiler macro is more useful than doing that.
2011-01-11 Aidan Kehoe <kehoea@parhasard.net>
* subr.el (delete, delq, remove, remq): Move #'remove, #'remq
here, they don't belong in cl-seq.el; move #'delete, #'delq here
from fns.c, implement them in terms of #'delete*, allowing support
for sequences generally.
* update-elc.el (do-autoload-commands): Use #'delete*, not #'delq
here, now the latter's no longer dumped.
* cl-macs.el (delete, delq): Add compiler macros transforming
#'delete and #'delq to #'delete* calls.
2011-01-10 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box): Correct a misplaced parenthesis
here, thank you Mats Lidell in 87zkr9gqrh.fsf@mail.contactor.se !
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box):
* list-mode.el (display-completion-list):
These functions used to use cl-parsing-keywords; change them to
use defun* instead, fixing the build. (Not sure what led to me
not including this change in d1b17a33450b!)
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (define-star-compiler-macros):
Make sure the form has ITEM and LIST specified before attempting
to change to calls with explicit tests; necessary for some tests
in lisp-tests.el to compile correctly.
(stable-union, stable-intersection): Add compiler macros for these
functions, in the same way we do for most of the other functions
in cl-seq.el.
2011-01-01 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (dolist, dotimes, do-symbols, macrolet)
(symbol-macrolet):
Define these macros with defmacro* instead of parsing the argument
list by hand, for the sake of style and readability; use backquote
where appropriate, instead of calling #'list and and friends, for
the same reason.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* x-misc.el (device-x-display):
Provide this function, documented in the Lispref for years, but
not existing previously. Thank you Julian Bradfield, thank you
Jeff Mincy.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl-seq.el:
Move the heavy lifting from this file to C. Dump the
cl-parsing-keywords macro, but don't use defun* for the functions
we define that do take keywords, dynamic scope lossage makes that
not practical.
* subr.el (sort, fillarray): Move these aliases here.
(map-plist): #'nsublis is now built-in, but at this point #'eql
isn't necessarily available as a test; use #'eq.
* obsolete.el (cl-delete-duplicates): Make this available for old
compiler macros and old code.
(memql): Document that this is equivalent to #'member*, and worse.
* cl.el (adjoin, subst): Removed. These are in C.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* simple.el (assoc-ignore-case): Remove a duplicate definition of
this function (it's already in subr.el).
* iso8859-1.el (char-width):
On non-Mule, make this function equivalent to that produced by
(constantly 1), but preserve its docstring.
* subr.el (subst-char-in-string): Define this in terms of
#'substitute, #'nsubstitute.
(string-width): Define this using #'reduce and #'char-width.
(char-width): Give this a simpler definition, it makes far more
sense to check for mule at load time and redefine, as we do in
iso8859-1.el.
(store-substring): Implement this in terms of #'replace, now
#'replace is cheap.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* update-elc.el (lisp-files-needed-for-byte-compilation)
(lisp-files-needing-early-byte-compilation):
cl-macs belongs in the former, not the latter, it is as
fundamental as bytecomp.el.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl.el:
Provde the Common Lisp program-error, type-error as error
symbols. This doesn't nearly go far enough for anyone using the
Common Lisp errors.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete-duplicates):
If the form has an incorrect number of arguments, don't attempt a
compiler macroexpansion.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (cl-safe-expr-p):
Forms that start with the symbol lambda are also safe.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
For these functions' compiler macros, the optimisation is safe
even if the first and the last arguments have side effects, since
they're only used the once.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (inline-side-effect-free-compiler-macros):
Unroll a loop here at macro-expansion time, so these compiler
macros are compiled. Use #'eql instead of #'eq in a couple of
places for better style.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (notany, notevery): Avoid some dynamic scope
stupidity with local variable names in these functions, when they
weren't prefixed with cl-; go into some more detail in the doc
strings.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns): #'remove, #'remq are
free of side-effects.
(side-effect-and-error-free-fns):
Drop dot, dot-marker from the list.
2010-11-17 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (coerce):
In the argument list, name the first argument OBJECT, not X; the
former name was always used in the doc string and is clearer.
Handle vector type specifications which include the length of the
target sequence, error if there's a mismatch.
* cl-macs.el (cl-make-type-test): Handle type specifications
starting with the symbol 'eql.
2010-11-14 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (eql): Don't remove the byte-compile property of this
symbol. That was necessary to override a bug in bytecomp.el where
#'eql was confused with #'eq, which bug we no longer have.
If neither expression is constant, don't attempt to handle the
expression in this compiler macro, leave it to byte-compile-eql,
which produces better code anyway.
* bytecomp.el (eq): #'eql is not the function associated with the
byte-eq byte code.
(byte-compile-eql): Add an explicit compile method for this
function, for cases where the cl-macs compiler macro hasn't
reduced it to #'eq or #'equal.
2010-10-25 Aidan Kehoe <kehoea@parhasard.net>
Add compiler macros and compilation sanity-checking for various
functions that take keywords.
* byte-optimize.el (side-effect-free-fns): #'symbol-value is
side-effect free and not error free.
* bytecomp.el (byte-compile-normal-call): Check keyword argument
lists for sanity; store information about the positions where
keyword arguments start using the new byte-compile-keyword-start
property.
* cl-macs.el (cl-const-expr-val): Take a new optional argument,
cl-not-constant, defaulting to nil, in this function; return it if
the expression is not constant.
(cl-non-fixnum-number-p): Make this into a separate function, we
want to pass it to #'every.
(eql): Use it.
(define-star-compiler-macros): Use the same code to generate the
member*, assoc* and rassoc* compiler macros; special-case some
code in #'add-to-list in subr.el.
(remove, remq): Add compiler macros for these two functions, in
preparation for #'remove being in C.
(define-foo-if-compiler-macros): Transform (remove-if-not ...) calls to
(remove ... :if-not) at compile time, which will be a real win
once the latter is in C.
(define-substitute-if-compiler-macros)
(define-subst-if-compiler-macros): Similarly for these functions.
(delete-duplicates): Change this compiler macro to use
#'plists-equal; if we don't have information about the type of
SEQUENCE at compile time, don't bother attempting to inline the
call, the function will be in C soon enough.
(equalp): Remove an old commented-out compiler macro for this, if
we want to see it it's in version control.
(subst-char-in-string): Transform this to a call to nsubstitute or
nsubstitute, if that is appropriate.
* cl.el (ldiff): Don't call setf here, this makes for a load-time
dependency problem in cl-macs.el
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* term/vt100.el:
Refer to XEmacs, not GNU Emacs, in permissions.
* term/bg-mouse.el:
* term/sup-mouse.el:
Put copyright notice in canonical "Copyright DATE AUTHOR" form.
Refer to XEmacs, not GNU Emacs, in permissions.
* site-load.el:
Add permission boilerplate.
* mule/canna-leim.el:
* alist.el:
Refer to XEmacs, not APEL/this program, in permissions.
* mule/canna-leim.el:
Remove my copyright, I've assigned it to the FSF.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* gtk.el:
* gtk-widget-accessors.el:
* gtk-package.el:
* gtk-marshal.el:
* gtk-compose.el:
* gnome.el:
Add copyright notice based on internal evidence.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* easymenu.el: Add reference to COPYING to permission notice.
* gutter.el:
* gutter-items.el:
* menubar-items.el:
Fix typo "Xmacs" in permissions notice.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* auto-save.el:
* font.el:
* fontconfig.el:
* mule/kinsoku.el:
Add "part of XEmacs" text to permission notice.
2010-10-14 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns):
* cl-macs.el (remf, getf):
* cl-extra.el (tailp, cl-set-getf, cl-do-remf):
* cl.el (ldiff, endp):
Tighten up Common Lisp compatibility for #'ldiff, #'endp, #'tailp;
add circularity checking for the first two.
#'cl-set-getf and #'cl-do-remf were Lisp implementations of
#'plist-put and #'plist-remprop; change the names to aliases,
changes the macros that use them to using #'plist-put and
#'plist-remprop directly.
2010-10-12 Aidan Kehoe <kehoea@parhasard.net>
* abbrev.el (fundamental-mode-abbrev-table, global-abbrev-table):
Create both these abbrev tables using the usual
#'define-abbrev-table calls, rather than attempting to
special-case them.
* cl-extra.el: Force cl-macs to be loaded here, if cl-extra.el is
being loaded interpreted. Previously other, later files would
redundantly call (load "cl-macs") when interpreted, it's more
reasonable to do it here, once.
* cmdloop.el (read-quoted-char-radix): Use defcustom here, we
don't have any dump-order dependencies that would prevent that.
* custom.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling, rely on cl-extra.el in the
former case and the appropriate entry in bytecomp-load-hook in the
latter. Get rid of custom-declare-variable-list, we have no
dump-time dependencies that would require it.
* faces.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling.
* packages.el: Remove some inaccurate comments.
* post-gc.el (cleanup-simple-finalizers): Use #'delete-if-not
here, now the order of preloaded-file-list has been changed to
make it available.
* subr.el (custom-declare-variable-list): Remove. No need for it.
Also remove a stub define-abbrev-table from this file, given the
current order of preloaded-file-list there's no need for it.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-constp) Forms quoted with FUNCTION are
also constant.
(byte-compile-initial-macro-environment): In #'the, if FORM is
constant and does not match TYPE, warn at byte-compile time.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* backquote.el (bq-vector-contents, bq-list*): Remove; the former
is equivalent to (append VECTOR nil), the latter to (list* ...).
(bq-process-2): Use (append VECTOR nil) instead of using
#'bq-vector-contents to convert to a list.
(bq-process-1): Now we use list* instead of bq-list
* subr.el (list*): Moved from cl.el, since it is now required to
be available the first time a backquoted form is encountered.
* cl.el (list*): Move to subr.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* test-harness.el (Check-Message):
Add an omitted comma here, thank you the buildbot.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* hash-table.el (hash-table-key-list, hash-table-value-list)
(hash-table-key-value-alist, hash-table-key-value-plist):
Remove some useless #'nreverse calls in these files; our hash
tables have no order, it's not helpful to pretend they do.
* behavior.el (read-behavior):
Do the same in this file, in some code evidently copied from
hash-table.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* info.el (Info-insert-dir):
* format.el (format-deannotate-region):
* files.el (cd, save-buffers-kill-emacs):
Use #'some, #'every and related functions for applying boolean
operations to lists, instead of rolling our own ones that cons and
don't short-circuit.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-initial-macro-environment):
* cl-macs.el (the):
Rephrase the docstring, make its implementation when compiling
files a little nicer.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* descr-text.el (unidata-initialize-unicodedata-database)
(unidata-initialize-unihan-database, describe-char-unicode-data)
(describe-char-unicode-data):
Wrap calls to the database functions with (with-fboundp ...),
avoiding byte compile warnings on builds without support for the
database functions.
(describe-char): (reduce #'max ...), not (apply #'max ...), no
need to cons needlessly.
(describe-char): Remove a redundant lambda wrapping
#'extent-properties.
(describe-char-unicode-data): Call #'nsubst when replacing "" with
nil in the result of #'split-string, instead of consing inside
mapcar.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* x-faces.el (x-available-font-sizes):
* specifier.el (let-specifier):
* package-ui.el (pui-add-required-packages):
* msw-faces.el (mswindows-available-font-sizes):
* modeline.el (modeline-minor-mode-menu):
* minibuf.el (minibuf-directory-files):
Replace the O2N (delq nil (mapcar (lambda (W) (and X Y)) Z)) with
the ON (mapcan (lambda (W) (and X (list Y))) Z) in these files.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
When these functions are handed more than two arguments, and those
arguments have no side effects, transform to a series of two
argument calls, avoiding funcall in the byte-compiled code.
* mule/mule-cmds.el (finish-set-language-environment):
Take advantage of this change in a function called 256 times at
startup.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-function-form, byte-compile-quote)
(byte-compile-quote-form):
Warn at compile time, and error at runtime, if a (quote ...) or a
(function ...) form attempts to quote more than one object.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (byte-optimize-apply): Transform (apply 'nconc
(mapcar ...)) to (mapcan ...); warn about use of the first idiom.
* update-elc.el (do-autoload-commands):
* packages.el (packages-find-package-library-path):
* frame.el (frame-list):
* extents.el (extent-descendants):
* etags.el (buffer-tag-table-files):
* dumped-lisp.el (preloaded-file-list):
* device.el (device-list):
* bytecomp-runtime.el (proclaim-inline, proclaim-notinline)
Use #'mapcan, not (apply #'nconc (mapcar ...) in all these files.
* bytecomp-runtime.el (eval-when-compile, eval-and-compile):
In passing, mention that these macros also evaluate the body when
interpreted.
tests/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
Test lexical scope for `block', `return-from'; add a
Known-Bug-Expect-Failure for a contorted example that fails when
byte-compiled.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 07 Feb 2011 12:01:24 +0000 |
| parents | 6c6d78781d59 |
| children | 308d34e9f07d |
| rev | line source |
|---|---|
| 428 | 1 /* Implements elisp-programmable dialog boxes -- MS Windows interface. |
| 2 Copyright (C) 1998 Kirill M. Katsnelson <kkm@kis.ru> | |
| 4967 | 3 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2010 Ben Wing. |
| 428 | 4 |
| 5 This file is part of XEmacs. | |
| 6 | |
| 7 XEmacs is free software; you can redistribute it and/or modify it | |
| 8 under the terms of the GNU General Public License as published by the | |
| 9 Free Software Foundation; either version 2, or (at your option) any | |
| 10 later version. | |
| 11 | |
| 12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 15 for more details. | |
| 16 | |
| 17 You should have received a copy of the GNU General Public License | |
| 18 along with XEmacs; see the file COPYING. If not, write to | |
| 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 20 Boston, MA 02111-1307, USA. */ | |
| 21 | |
| 22 /* Synched up with: Not in FSF. */ | |
| 23 | |
| 771 | 24 /* This file essentially Mule-ized (except perhaps some Unicode splitting). |
| 25 5-2000. */ | |
| 26 | |
| 428 | 27 /* Author: |
| 28 Initially written by kkm, May 1998 | |
| 29 */ | |
| 30 | |
| 31 #include <config.h> | |
| 32 #include "lisp.h" | |
| 33 | |
| 34 #include "buffer.h" | |
| 872 | 35 #include "frame-impl.h" |
| 428 | 36 #include "gui.h" |
| 37 #include "opaque.h" | |
| 38 | |
| 872 | 39 #include "console-msw-impl.h" |
| 40 | |
| 771 | 41 #include "sysfile.h" |
| 442 | 42 |
| 43 Lisp_Object Qdialog_box_error; | |
| 44 | |
| 45 static Lisp_Object Q_initial_directory; | |
| 46 static Lisp_Object Q_initial_filename; | |
| 47 static Lisp_Object Q_filter_list; | |
| 48 static Lisp_Object Q_allow_multi_select; | |
| 49 static Lisp_Object Q_create_prompt_on_nonexistent; | |
| 50 static Lisp_Object Q_overwrite_prompt; | |
| 51 static Lisp_Object Q_file_must_exist; | |
| 52 static Lisp_Object Q_no_network_button; | |
| 53 static Lisp_Object Q_no_read_only_return; | |
| 54 | |
| 428 | 55 /* List containing all dialog data structures of currently popped up |
| 442 | 56 dialogs. */ |
| 428 | 57 static Lisp_Object Vdialog_data_list; |
| 58 | |
| 442 | 59 /* List of popup frames wanting keyboard traversal handled */ |
| 60 static Lisp_Object Vpopup_frame_list; | |
| 61 | |
| 62 Lisp_Object Vdefault_file_dialog_filter_alist; | |
| 63 | |
| 428 | 64 /* DLUs per character metrics */ |
| 65 #define X_DLU_PER_CHAR 4 | |
| 66 #define Y_DLU_PER_CHAR 8 | |
| 67 | |
| 68 /* | |
| 69 Button metrics | |
| 70 -------------- | |
| 71 All buttons have height of 15 DLU. The minimum width for a button is 32 DLU, | |
| 72 but it can be expanded to accommodate its text, so the width is calculated as | |
| 73 8 DLU per button plus 4 DLU per character. | |
| 74 max (32, 6 * text_length). The factor of six is rather empirical, but it | |
| 75 works better than 8 which comes from the definition of a DLU. Buttons are | |
| 76 spaced with 6 DLU gap. Minimum distance from the button to the left or right | |
| 77 dialog edges is 6 DLU, and the distance between the dialog bottom edge and | |
| 78 buttons is 7 DLU. | |
| 79 */ | |
| 80 | |
| 81 #define X_MIN_BUTTON 32 | |
| 82 #define X_BUTTON_MARGIN 8 | |
| 83 #define Y_BUTTON 15 | |
| 84 #define X_BUTTON_SPACING 6 | |
| 85 #define X_BUTTON_FROM_EDGE 6 | |
| 86 #define Y_BUTTON_FROM_EDGE 7 | |
| 87 | |
| 88 /* | |
| 89 Text field metrics | |
| 90 ------------------ | |
| 91 Text distance from left and right edges is the same as for buttons, and the | |
| 92 top margin is 11 DLU. The static control has height of 2 DLU per control | |
| 93 plus 8 DLU per each line of text. Distance between the bottom edge of the | |
| 94 control and the button row is 15 DLU. Minimum width of the static control | |
| 95 is 100 DLU, thus giving minimum dialog weight of 112 DLU. Maximum width is | |
| 96 300 DLU, and, if the text is wider than that, the text is wrapped on the | |
| 97 next line. Each character in the text is considered 4 DLU wide. | |
| 98 */ | |
| 99 | |
| 100 #define X_MIN_TEXT 100 | |
| 101 #define X_AVE_TEXT 200 | |
| 102 #define X_MAX_TEXT 300 | |
| 103 #define X_TEXT_FROM_EDGE X_BUTTON_FROM_EDGE | |
| 104 #define Y_TEXT_FROM_EDGE 11 | |
| 105 #define Y_TEXT_MARGIN 2 | |
| 106 #define Y_TEXT_FROM_BUTTON 15 | |
| 107 | |
| 108 #define X_MIN_TEXT_CHAR (X_MIN_TEXT / X_DLU_PER_CHAR) | |
| 109 #define X_AVE_TEXT_CHAR (X_AVE_TEXT / X_DLU_PER_CHAR) | |
| 110 #define X_MAX_TEXT_CHAR (X_MAX_TEXT / X_DLU_PER_CHAR) | |
| 111 | |
| 112 /* | |
| 113 Layout algorithm | |
| 114 ---------------- | |
| 115 First we calculate the minimum width of the button row, excluding "from | |
| 116 edge" distances. Note that the static control text can be narrower than | |
| 117 X_AVE_TEXT only if both text and button row are narrower than that (so, | |
| 118 even if text *can* be wrapped into 2 rows narrower than ave width, it is not | |
| 119 done). Let WBR denote the width of the button row. | |
| 120 | |
| 121 Next, the width of the static field is determined. | |
| 122 First, if all lines of text fit into max (WBR, X_MAX_TEXT), the width of the | |
| 123 control is the same as the width of the longest line. | |
| 124 Second, if all lines of text are narrower than X_MIN_TEXT, then width of | |
| 125 the control is set to X_MIN_TEXT. | |
| 126 Otherwise, width is set to max(WBR, X_AVE_TEXT). In this case, line wrapping will | |
| 127 happen. | |
| 128 | |
| 129 If width of the text control is larger than that of the button row, then the | |
| 130 latter is centered across the dialog, by giving it extra edge | |
| 131 margins. Otherwise, minimal margins are given to the button row. | |
| 132 */ | |
| 133 | |
| 134 #define ID_ITEM_BIAS 32 | |
| 135 | |
| 442 | 136 void |
| 137 mswindows_register_popup_frame (Lisp_Object frame) | |
| 138 { | |
| 139 Vpopup_frame_list = Fcons (frame, Vpopup_frame_list); | |
| 140 } | |
| 141 | |
| 142 void | |
| 143 mswindows_unregister_popup_frame (Lisp_Object frame) | |
| 144 { | |
| 145 Vpopup_frame_list = delq_no_quit (frame, Vpopup_frame_list); | |
| 146 } | |
| 147 | |
| 148 /* Dispatch message to any dialog boxes. Return non-zero if dispatched. */ | |
| 149 int | |
| 150 mswindows_is_dialog_msg (MSG *msg) | |
| 151 { | |
| 152 LIST_LOOP_2 (data, Vdialog_data_list) | |
| 153 { | |
| 771 | 154 if (qxeIsDialogMessage (XMSWINDOWS_DIALOG_ID (data)->hwnd, msg)) |
| 442 | 155 return 1; |
| 156 } | |
| 157 | |
| 158 { | |
| 159 LIST_LOOP_2 (popup, Vpopup_frame_list) | |
| 160 { | |
| 161 HWND hwnd = FRAME_MSWINDOWS_HANDLE (XFRAME (popup)); | |
| 444 | 162 /* This is a windows feature that allows dialog type |
| 163 processing to be applied to standard windows containing | |
| 164 controls. */ | |
| 771 | 165 if (qxeIsDialogMessage (hwnd, msg)) |
| 442 | 166 return 1; |
| 167 } | |
| 168 } | |
| 169 return 0; | |
| 170 } | |
| 171 | |
| 1204 | 172 static const struct memory_description mswindows_dialog_id_description [] = { |
| 934 | 173 { XD_LISP_OBJECT, offsetof (struct mswindows_dialog_id, frame) }, |
| 174 { XD_LISP_OBJECT, offsetof (struct mswindows_dialog_id, callbacks) }, | |
| 175 { XD_END } | |
| 176 }; | |
| 177 | |
| 442 | 178 static Lisp_Object |
| 179 mark_mswindows_dialog_id (Lisp_Object obj) | |
| 180 { | |
| 181 struct mswindows_dialog_id *data = XMSWINDOWS_DIALOG_ID (obj); | |
| 182 mark_object (data->frame); | |
| 183 return data->callbacks; | |
| 184 } | |
| 185 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
5117
diff
changeset
|
186 DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("mswindows-dialog-id", |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
5117
diff
changeset
|
187 mswindows_dialog_id, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
5117
diff
changeset
|
188 mark_mswindows_dialog_id, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
5117
diff
changeset
|
189 mswindows_dialog_id_description, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
5117
diff
changeset
|
190 struct mswindows_dialog_id); |
| 442 | 191 |
| 428 | 192 /* Dialog procedure */ |
| 193 static BOOL CALLBACK | |
| 194 dialog_proc (HWND hwnd, UINT msg, WPARAM w_param, LPARAM l_param) | |
| 195 { | |
| 196 switch (msg) | |
| 197 { | |
| 198 case WM_INITDIALOG: | |
| 771 | 199 qxeSetWindowLong (hwnd, DWL_USER, l_param); |
| 428 | 200 break; |
| 201 | |
| 202 case WM_DESTROY: | |
| 203 { | |
| 204 Lisp_Object data; | |
| 5013 | 205 data = GET_LISP_FROM_VOID ((void *) qxeGetWindowLong (hwnd, DWL_USER)); |
| 428 | 206 Vdialog_data_list = delq_no_quit (data, Vdialog_data_list); |
| 207 } | |
| 208 break; | |
| 209 | |
| 210 case WM_COMMAND: | |
| 211 { | |
| 212 Lisp_Object fn, arg, data; | |
| 442 | 213 struct mswindows_dialog_id *did; |
| 214 | |
| 5013 | 215 data = GET_LISP_FROM_VOID ((void *) qxeGetWindowLong (hwnd, DWL_USER)); |
| 442 | 216 did = XMSWINDOWS_DIALOG_ID (data); |
| 217 if (w_param != IDCANCEL) /* user pressed escape */ | |
| 218 { | |
| 219 assert (w_param >= ID_ITEM_BIAS | |
| 647 | 220 && (EMACS_INT) w_param |
| 442 | 221 < XVECTOR_LENGTH (did->callbacks) + ID_ITEM_BIAS); |
| 222 | |
| 223 get_gui_callback (XVECTOR_DATA (did->callbacks) | |
| 224 [w_param - ID_ITEM_BIAS], | |
| 225 &fn, &arg); | |
| 226 mswindows_enqueue_misc_user_event (did->frame, fn, arg); | |
| 227 } | |
| 228 else | |
| 229 mswindows_enqueue_misc_user_event (did->frame, Qrun_hooks, | |
| 230 Qmenu_no_selection_hook); | |
| 853 | 231 va_run_hook_with_args_trapping_problems |
| 1333 | 232 (Qdialog, Qdelete_dialog_box_hook, 1, data, 0); |
| 428 | 233 |
| 234 DestroyWindow (hwnd); | |
| 235 } | |
| 236 break; | |
| 237 | |
| 238 default: | |
| 239 return FALSE; | |
| 240 } | |
| 241 return TRUE; | |
| 242 } | |
| 243 | |
| 244 /* Helper function which converts the supplied string STRING into Unicode and | |
| 245 pushes it at the end of DYNARR */ | |
| 246 static void | |
| 771 | 247 push_lisp_string_as_unicode (unsigned_char_dynarr *dynarr, Lisp_Object string) |
| 428 | 248 { |
| 771 | 249 int length; |
| 250 Extbyte *uni_string; | |
| 428 | 251 |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
252 LISP_STRING_TO_SIZED_EXTERNAL (string, uni_string, length, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
253 Qmswindows_unicode); |
| 771 | 254 Dynarr_add_many (dynarr, uni_string, length); |
| 255 Dynarr_add (dynarr, '\0'); | |
| 256 Dynarr_add (dynarr, '\0'); | |
| 442 | 257 } |
| 258 | |
| 428 | 259 /* Given button TEXT, return button width in DLU */ |
| 647 | 260 static int |
| 428 | 261 button_width (Lisp_Object text) |
| 262 { | |
| 771 | 263 /* !!#### do Japanese chars count as two? */ |
| 264 int width = | |
| 265 X_DLU_PER_CHAR * | |
| 867 | 266 ibyte_string_displayed_columns (XSTRING_DATA (text), |
| 771 | 267 XSTRING_LENGTH (text)); |
| 428 | 268 return max (X_MIN_BUTTON, width); |
| 269 } | |
| 270 | |
| 271 /* Unwind protection routine frees a dynarr opaqued into arg */ | |
| 272 static Lisp_Object | |
| 273 free_dynarr_opaque_ptr (Lisp_Object arg) | |
| 274 { | |
| 275 Dynarr_free (get_opaque_ptr (arg)); | |
| 276 return arg; | |
| 277 } | |
| 278 | |
| 707 | 279 /* Unwind protection decrements dialog count */ |
| 280 static Lisp_Object | |
| 2286 | 281 dialog_popped_down (Lisp_Object UNUSED (arg)) |
| 707 | 282 { |
| 283 popup_up_p--; | |
| 771 | 284 return Qnil; |
| 707 | 285 } |
| 286 | |
| 428 | 287 |
| 647 | 288 #define ALIGN_TEMPLATE \ |
| 289 { \ | |
| 290 int slippage = Dynarr_length (template_) & 3; \ | |
| 291 if (slippage) \ | |
| 292 Dynarr_add_many (template_, &zeroes, slippage); \ | |
| 428 | 293 } |
| 294 | |
| 442 | 295 static struct |
| 296 { | |
| 647 | 297 DWORD errmess; |
| 4932 | 298 const Ascbyte *errname; |
| 442 | 299 } common_dialog_errors[] = |
| 300 { | |
| 301 { CDERR_DIALOGFAILURE, "CDERR_DIALOGFAILURE" }, | |
| 302 { CDERR_FINDRESFAILURE, "CDERR_FINDRESFAILURE" }, | |
| 303 { CDERR_INITIALIZATION, "CDERR_INITIALIZATION" }, | |
| 304 { CDERR_LOADRESFAILURE, "CDERR_LOADRESFAILURE" }, | |
| 305 { CDERR_LOADSTRFAILURE, "CDERR_LOADSTRFAILURE" }, | |
| 306 { CDERR_LOCKRESFAILURE, "CDERR_LOCKRESFAILURE" }, | |
| 307 { CDERR_MEMALLOCFAILURE, "CDERR_MEMALLOCFAILURE" }, | |
| 308 { CDERR_MEMLOCKFAILURE, "CDERR_MEMLOCKFAILURE" }, | |
| 309 { CDERR_NOHINSTANCE, "CDERR_NOHINSTANCE" }, | |
| 310 { CDERR_NOHOOK, "CDERR_NOHOOK" }, | |
| 311 { CDERR_NOTEMPLATE, "CDERR_NOTEMPLATE" }, | |
| 312 { CDERR_REGISTERMSGFAIL, "CDERR_REGISTERMSGFAIL" }, | |
| 313 { CDERR_STRUCTSIZE, "CDERR_STRUCTSIZE" }, | |
| 314 { PDERR_CREATEICFAILURE, "PDERR_CREATEICFAILURE" }, | |
| 315 { PDERR_DEFAULTDIFFERENT, "PDERR_DEFAULTDIFFERENT" }, | |
| 316 { PDERR_DNDMMISMATCH, "PDERR_DNDMMISMATCH" }, | |
| 317 { PDERR_GETDEVMODEFAIL, "PDERR_GETDEVMODEFAIL" }, | |
| 318 { PDERR_INITFAILURE, "PDERR_INITFAILURE" }, | |
| 319 { PDERR_LOADDRVFAILURE, "PDERR_LOADDRVFAILURE" }, | |
| 320 { PDERR_NODEFAULTPRN, "PDERR_NODEFAULTPRN" }, | |
| 321 { PDERR_NODEVICES, "PDERR_NODEVICES" }, | |
| 322 { PDERR_PARSEFAILURE, "PDERR_PARSEFAILURE" }, | |
| 323 { PDERR_PRINTERNOTFOUND, "PDERR_PRINTERNOTFOUND" }, | |
| 324 { PDERR_RETDEFFAILURE, "PDERR_RETDEFFAILURE" }, | |
| 325 { PDERR_SETUPFAILURE, "PDERR_SETUPFAILURE" }, | |
| 326 { CFERR_MAXLESSTHANMIN, "CFERR_MAXLESSTHANMIN" }, | |
| 327 { CFERR_NOFONTS, "CFERR_NOFONTS" }, | |
| 328 { FNERR_BUFFERTOOSMALL, "FNERR_BUFFERTOOSMALL" }, | |
| 329 { FNERR_INVALIDFILENAME, "FNERR_INVALIDFILENAME" }, | |
| 330 { FNERR_SUBCLASSFAILURE, "FNERR_SUBCLASSFAILURE" }, | |
| 331 { FRERR_BUFFERLENGTHZERO, "FRERR_BUFFERLENGTHZERO" }, | |
| 332 }; | |
| 333 | |
| 771 | 334 struct param_data |
| 335 { | |
| 336 Extbyte *fname; | |
| 337 Extbyte *unknown_fname; | |
| 673 | 338 int validate; |
| 339 }; | |
| 340 | |
| 341 static int | |
| 342 CALLBACK handle_directory_proc (HWND hwnd, UINT msg, | |
| 343 LPARAM lParam, LPARAM lpData) | |
| 344 { | |
| 4854 | 345 Extbyte szDir[PATH_MAX_TCHAR]; |
| 771 | 346 struct param_data *pd = (struct param_data *) lpData; |
| 673 | 347 |
| 771 | 348 switch (msg) |
| 349 { | |
| 350 case BFFM_INITIALIZED: | |
| 351 /* WParam is TRUE since you are passing a path. | |
| 352 It would be FALSE if you were passing a pidl. */ | |
| 353 qxeSendMessage (hwnd, BFFM_SETSELECTION, TRUE, (LPARAM) pd->fname); | |
| 354 break; | |
| 355 | |
| 356 case BFFM_SELCHANGED: | |
| 357 /* Set the status window to the currently selected path. */ | |
| 358 if (qxeSHGetPathFromIDList ((LPITEMIDLIST) lParam, szDir)) | |
| 359 qxeSendMessage (hwnd, BFFM_SETSTATUSTEXT, 0, (LPARAM) szDir); | |
| 360 break; | |
| 361 | |
| 362 case BFFM_VALIDATEFAILED: | |
| 363 if (pd->validate) | |
| 364 return TRUE; | |
| 365 else | |
| 2421 | 366 pd->unknown_fname = qxetcsdup ((Extbyte *) lParam); |
| 771 | 367 break; |
| 368 | |
| 369 default: | |
| 370 break; | |
| 673 | 371 } |
| 372 return 0; | |
| 373 } | |
| 374 | |
| 375 static Lisp_Object | |
| 376 handle_directory_dialog_box (struct frame *f, Lisp_Object keys) | |
| 377 { | |
| 378 Lisp_Object ret = Qnil; | |
| 771 | 379 BROWSEINFOW bi; |
| 673 | 380 LPITEMIDLIST pidl; |
| 381 LPMALLOC pMalloc; | |
| 382 struct param_data pd; | |
| 771 | 383 |
| 384 xzero (pd); | |
| 385 xzero (bi); | |
| 386 | |
| 387 bi.lParam = (LPARAM) &pd; | |
| 673 | 388 bi.hwndOwner = FRAME_MSWINDOWS_HANDLE (f); |
| 389 bi.pszDisplayName = 0; | |
| 390 bi.pidlRoot = 0; | |
| 771 | 391 bi.ulFlags = |
| 392 BIF_RETURNONLYFSDIRS | BIF_STATUSTEXT | BIF_EDITBOX | BIF_NEWDIALOGSTYLE; | |
| 673 | 393 bi.lpfn = handle_directory_proc; |
| 771 | 394 |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
395 LISP_LOCAL_FILE_FORMAT_TO_TSTR (Fexpand_file_name (build_ascstring (""), Qnil), |
| 771 | 396 pd.fname); |
| 397 | |
| 673 | 398 { |
| 399 EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, keys) | |
| 400 { | |
| 401 if (EQ (key, Q_title)) | |
| 402 { | |
| 403 CHECK_STRING (value); | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
404 bi.lpszTitle = (XELPTSTR) LISP_STRING_TO_TSTR (value); |
| 673 | 405 } |
| 406 else if (EQ (key, Q_initial_directory)) | |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
407 LISP_LOCAL_FILE_FORMAT_TO_TSTR (Fexpand_file_name (value, Qnil), |
| 673 | 408 pd.fname); |
| 409 else if (EQ (key, Q_initial_filename)) | |
| 410 ; /* do nothing */ | |
| 411 else if (EQ (key, Q_file_must_exist)) | |
| 412 { | |
| 771 | 413 if (!NILP (value)) |
| 414 { | |
| 415 pd.validate = TRUE; | |
| 416 bi.ulFlags |= BIF_VALIDATE; | |
| 417 } | |
| 673 | 418 else |
| 419 bi.ulFlags &= ~BIF_VALIDATE; | |
| 420 } | |
| 421 else | |
| 422 invalid_constant ("Unrecognized directory-dialog keyword", key); | |
| 423 } | |
| 424 } | |
| 771 | 425 |
| 426 if (SHGetMalloc (&pMalloc) == NOERROR) | |
| 673 | 427 { |
| 771 | 428 pidl = qxeSHBrowseForFolder (&bi); |
| 429 if (pidl) | |
| 430 { | |
| 4854 | 431 Extbyte *szDir = alloca_extbytes (PATH_MAX_TCHAR); |
| 771 | 432 |
| 433 if (qxeSHGetPathFromIDList (pidl, szDir)) | |
| 434 ret = tstr_to_local_file_format (szDir); | |
| 435 | |
| 436 XECOMCALL1 (pMalloc, Free, pidl); | |
| 437 XECOMCALL0 (pMalloc, Release); | |
| 438 return ret; | |
| 673 | 439 } |
| 771 | 440 else if (pd.unknown_fname != 0) |
| 441 { | |
| 442 ret = tstr_to_local_file_format (pd.unknown_fname); | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
443 xfree (pd.unknown_fname); |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
444 pd.unknown_fname = 0; |
| 771 | 445 } |
| 707 | 446 else while (1) |
| 447 signal_quit (); | |
| 673 | 448 } |
| 449 else | |
| 450 signal_error (Qdialog_box_error, | |
| 451 "Unable to create folder browser", | |
| 452 make_int (0)); | |
| 453 return ret; | |
| 454 } | |
| 455 | |
| 442 | 456 static Lisp_Object |
| 457 handle_file_dialog_box (struct frame *f, Lisp_Object keys) | |
| 458 { | |
| 771 | 459 OPENFILENAMEW ofn; |
| 460 Extbyte fnbuf[8000]; | |
| 673 | 461 |
| 442 | 462 xzero (ofn); |
| 463 ofn.lStructSize = sizeof (ofn); | |
| 673 | 464 ofn.Flags = OFN_EXPLORER; |
| 442 | 465 ofn.hwndOwner = FRAME_MSWINDOWS_HANDLE (f); |
| 771 | 466 ofn.lpstrFile = (XELPTSTR) fnbuf; |
| 442 | 467 ofn.nMaxFile = sizeof (fnbuf) / XETCHAR_SIZE; |
| 2421 | 468 qxetcscpy (fnbuf, XETEXT ("")); |
| 771 | 469 |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
470 LISP_LOCAL_FILE_FORMAT_TO_TSTR (Fexpand_file_name (build_ascstring (""), |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
471 Qnil), |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
472 ofn.lpstrInitialDir); |
| 771 | 473 |
| 442 | 474 { |
| 475 EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, keys) | |
| 476 { | |
| 477 if (EQ (key, Q_initial_filename)) | |
| 478 { | |
| 479 Extbyte *fnout; | |
| 771 | 480 |
| 442 | 481 CHECK_STRING (value); |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
482 LISP_LOCAL_FILE_FORMAT_TO_TSTR (value, fnout); |
| 2421 | 483 qxetcscpy (fnbuf, fnout); |
| 442 | 484 } |
| 485 else if (EQ (key, Q_title)) | |
| 486 { | |
| 487 CHECK_STRING (value); | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
488 ofn.lpstrTitle = (XELPTSTR) LISP_STRING_TO_TSTR (value); |
| 442 | 489 } |
| 490 else if (EQ (key, Q_initial_directory)) | |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
491 LISP_LOCAL_FILE_FORMAT_TO_TSTR (Fexpand_file_name (value, Qnil), |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
492 ofn.lpstrInitialDir); |
| 442 | 493 else if (EQ (key, Q_file_must_exist)) |
| 494 { | |
| 495 if (!NILP (value)) | |
| 496 ofn.Flags |= OFN_FILEMUSTEXIST | OFN_PATHMUSTEXIST; | |
| 497 else | |
| 498 ofn.Flags &= ~(OFN_FILEMUSTEXIST | OFN_PATHMUSTEXIST); | |
| 499 } | |
| 500 else | |
| 563 | 501 invalid_constant ("Unrecognized file-dialog keyword", key); |
| 442 | 502 } |
| 503 } | |
| 771 | 504 |
| 505 if (!qxeGetOpenFileName (&ofn)) | |
| 442 | 506 { |
| 507 DWORD err = CommDlgExtendedError (); | |
| 508 if (!err) | |
| 509 { | |
| 510 while (1) | |
| 511 signal_quit (); | |
| 512 } | |
| 513 else | |
| 514 { | |
| 515 int i; | |
| 771 | 516 |
| 442 | 517 for (i = 0; i < countof (common_dialog_errors); i++) |
| 518 { | |
| 519 if (common_dialog_errors[i].errmess == err) | |
| 563 | 520 signal_error (Qdialog_box_error, |
| 521 "Creating file-dialog-box", | |
| 771 | 522 build_msg_string |
| 563 | 523 (common_dialog_errors[i].errname)); |
| 442 | 524 } |
| 771 | 525 |
| 563 | 526 signal_error (Qdialog_box_error, |
| 527 "Unknown common dialog box error???", | |
| 528 make_int (err)); | |
| 442 | 529 } |
| 530 } | |
| 771 | 531 |
| 532 return tstr_to_local_file_format ((Extbyte *) ofn.lpstrFile); | |
| 442 | 533 } |
| 534 | |
| 535 static Lisp_Object | |
| 536 handle_question_dialog_box (struct frame *f, Lisp_Object keys) | |
| 428 | 537 { |
| 538 Lisp_Object_dynarr *dialog_items = Dynarr_new (Lisp_Object); | |
| 593 | 539 unsigned_char_dynarr *template_ = Dynarr_new (unsigned_char); |
| 647 | 540 int button_row_width = 0; |
| 541 int text_width, text_height; | |
| 442 | 542 Lisp_Object question = Qnil, title = Qnil; |
| 771 | 543 |
| 428 | 544 int unbind_count = specpdl_depth (); |
| 545 record_unwind_protect (free_dynarr_opaque_ptr, | |
| 546 make_opaque_ptr (dialog_items)); | |
| 547 record_unwind_protect (free_dynarr_opaque_ptr, | |
| 593 | 548 make_opaque_ptr (template_)); |
| 771 | 549 |
| 428 | 550 /* A big NO NEED to GCPRO gui_items stored in the array: they are just |
| 442 | 551 pointers into KEYS list, which is GC-protected by the caller */ |
| 771 | 552 |
| 428 | 553 { |
| 442 | 554 EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, keys) |
| 428 | 555 { |
| 442 | 556 if (EQ (key, Q_question)) |
| 557 { | |
| 558 CHECK_STRING (value); | |
| 559 question = value; | |
| 560 } | |
| 561 else if (EQ (key, Q_title)) | |
| 562 { | |
| 563 CHECK_STRING (value); | |
| 564 title = value; | |
| 565 } | |
| 566 else if (EQ (key, Q_buttons)) | |
| 428 | 567 { |
| 442 | 568 /* Parse each item in the dialog into gui_item structs, |
| 569 and stuff a dynarr of these. Calculate button row width | |
| 570 in this loop too */ | |
| 2367 | 571 EXTERNAL_LIST_LOOP_2 (item, value) |
| 442 | 572 { |
| 2367 | 573 if (!NILP (item)) |
| 442 | 574 { |
| 2367 | 575 Lisp_Object gitem = gui_parse_item_keywords (item); |
| 442 | 576 Dynarr_add (dialog_items, gitem); |
| 577 button_row_width += button_width (XGUI_ITEM (gitem)->name) | |
| 578 + X_BUTTON_MARGIN; | |
| 579 } | |
| 580 } | |
| 771 | 581 |
| 442 | 582 button_row_width -= X_BUTTON_MARGIN; |
| 428 | 583 } |
| 442 | 584 else |
| 563 | 585 invalid_constant ("Unrecognized question-dialog keyword", key); |
| 428 | 586 } |
| 587 } | |
| 771 | 588 |
| 442 | 589 if (Dynarr_length (dialog_items) == 0) |
| 563 | 590 sferror ("Dialog descriptor provides no buttons", keys); |
| 771 | 591 |
| 442 | 592 if (NILP (question)) |
| 563 | 593 sferror ("Dialog descriptor provides no question", keys); |
| 771 | 594 |
| 428 | 595 /* Determine the final width layout */ |
| 596 { | |
| 867 | 597 Ibyte *p = XSTRING_DATA (question); |
| 428 | 598 Charcount string_max = 0, this_length = 0; |
| 599 while (1) | |
| 600 { | |
| 867 | 601 Ichar ch = itext_ichar (p); |
| 602 INC_IBYTEPTR (p); | |
| 428 | 603 |
| 867 | 604 if (ch == (Ichar)'\n' || ch == (Ichar)'\0') |
| 428 | 605 { |
| 606 string_max = max (this_length, string_max); | |
| 607 this_length = 0; | |
| 608 } | |
| 609 else | |
| 610 ++this_length; | |
| 771 | 611 |
| 867 | 612 if (ch == (Ichar)'\0') |
| 428 | 613 break; |
| 614 } | |
| 771 | 615 |
| 428 | 616 if (string_max * X_DLU_PER_CHAR > max (X_MAX_TEXT, button_row_width)) |
| 617 text_width = X_AVE_TEXT; | |
| 618 else if (string_max * X_DLU_PER_CHAR < X_MIN_TEXT) | |
| 619 text_width = X_MIN_TEXT; | |
| 620 else | |
| 621 text_width = string_max * X_DLU_PER_CHAR; | |
| 622 text_width = max (text_width, button_row_width); | |
| 623 } | |
| 624 | |
| 625 /* Now calculate the height for the text control */ | |
| 626 { | |
| 867 | 627 Ibyte *p = XSTRING_DATA (question); |
| 428 | 628 Charcount break_at = text_width / X_DLU_PER_CHAR; |
| 629 Charcount char_pos = 0; | |
| 630 int num_lines = 1; | |
| 867 | 631 Ichar ch; |
| 428 | 632 |
| 867 | 633 while ((ch = itext_ichar (p)) != (Ichar) '\0') |
| 428 | 634 { |
| 867 | 635 INC_IBYTEPTR (p); |
| 636 char_pos += ch != (Ichar) '\n'; | |
| 637 if (ch == (Ichar) '\n' || char_pos == break_at) | |
| 428 | 638 { |
| 639 ++num_lines; | |
| 640 char_pos = 0; | |
| 641 } | |
| 642 } | |
| 643 text_height = Y_TEXT_MARGIN + Y_DLU_PER_CHAR * num_lines; | |
| 644 } | |
| 771 | 645 |
| 428 | 646 /* Ok, now we are ready to stuff the dialog template and lay out controls */ |
| 647 { | |
| 648 DLGTEMPLATE dlg_tem; | |
| 649 DLGITEMTEMPLATE item_tem; | |
| 650 int i; | |
| 651 const unsigned int zeroes = 0; | |
| 652 const unsigned int ones = 0xFFFFFFFF; | |
| 653 const WORD static_class_id = 0x0082; | |
| 654 const WORD button_class_id = 0x0080; | |
| 771 | 655 |
| 428 | 656 /* Create and stuff in DLGTEMPLATE header */ |
| 771 | 657 dlg_tem.style = (DS_CENTER | DS_MODALFRAME |
| 428 | 658 | WS_CAPTION | WS_POPUP | WS_VISIBLE); |
| 659 dlg_tem.dwExtendedStyle = 0; | |
| 660 dlg_tem.cdit = Dynarr_length (dialog_items) + 1; | |
| 661 dlg_tem.x = 0; | |
| 662 dlg_tem.y = 0; | |
| 663 dlg_tem.cx = text_width + 2 * X_TEXT_FROM_EDGE; | |
| 664 dlg_tem.cy = (Y_TEXT_FROM_EDGE + text_height + Y_TEXT_FROM_BUTTON | |
| 665 + Y_BUTTON + Y_BUTTON_FROM_EDGE); | |
| 593 | 666 Dynarr_add_many (template_, &dlg_tem, sizeof (dlg_tem)); |
| 771 | 667 |
| 428 | 668 /* We want no menu and standard class */ |
| 593 | 669 Dynarr_add_many (template_, &zeroes, 4); |
| 771 | 670 |
| 442 | 671 /* And the third is the dialog title. "XEmacs" unless one is supplied. |
| 672 Note that the string must be in Unicode. */ | |
| 673 if (NILP (title)) | |
| 593 | 674 Dynarr_add_many (template_, L"XEmacs", 14); |
| 442 | 675 else |
| 593 | 676 push_lisp_string_as_unicode (template_, title); |
| 771 | 677 |
| 428 | 678 /* Next add text control. */ |
| 679 item_tem.style = WS_CHILD | WS_VISIBLE | SS_LEFT | SS_NOPREFIX; | |
| 680 item_tem.dwExtendedStyle = 0; | |
| 681 item_tem.x = X_TEXT_FROM_EDGE; | |
| 682 item_tem.y = Y_TEXT_FROM_EDGE; | |
| 683 item_tem.cx = text_width; | |
| 684 item_tem.cy = text_height; | |
| 685 item_tem.id = 0xFFFF; | |
| 771 | 686 |
| 428 | 687 ALIGN_TEMPLATE; |
| 593 | 688 Dynarr_add_many (template_, &item_tem, sizeof (item_tem)); |
| 771 | 689 |
| 428 | 690 /* Right after class id follows */ |
| 593 | 691 Dynarr_add_many (template_, &ones, 2); |
| 692 Dynarr_add_many (template_, &static_class_id, sizeof (static_class_id)); | |
| 771 | 693 |
| 428 | 694 /* Next thing to add is control text, as Unicode string */ |
| 593 | 695 push_lisp_string_as_unicode (template_, question); |
| 771 | 696 |
| 428 | 697 /* Specify 0 length creation data */ |
| 593 | 698 Dynarr_add_many (template_, &zeroes, 2); |
| 771 | 699 |
| 428 | 700 /* Now it's the button time */ |
| 701 item_tem.y = Y_TEXT_FROM_EDGE + text_height + Y_TEXT_FROM_BUTTON; | |
| 702 item_tem.x = X_BUTTON_FROM_EDGE + (button_row_width < text_width | |
| 703 ? (text_width - button_row_width) / 2 | |
| 704 : 0); | |
| 705 item_tem.cy = Y_BUTTON; | |
| 706 item_tem.dwExtendedStyle = 0; | |
| 771 | 707 |
| 428 | 708 for (i = 0; i < Dynarr_length (dialog_items); ++i) |
| 709 { | |
| 771 | 710 Lisp_Object *gui_item = Dynarr_atp (dialog_items, i); |
| 440 | 711 Lisp_Gui_Item *pgui_item = XGUI_ITEM (*gui_item); |
| 771 | 712 |
| 428 | 713 item_tem.style = (WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON |
| 1913 | 714 | (gui_item_active_p (*gui_item) ? 0 : WS_DISABLED)); |
| 428 | 715 item_tem.cx = button_width (pgui_item->name); |
| 716 /* Item ids are indices into dialog_items plus offset, to avoid having | |
| 717 items by reserved ids (IDOK, IDCANCEL) */ | |
| 718 item_tem.id = i + ID_ITEM_BIAS; | |
| 771 | 719 |
| 428 | 720 ALIGN_TEMPLATE; |
| 593 | 721 Dynarr_add_many (template_, &item_tem, sizeof (item_tem)); |
| 771 | 722 |
| 428 | 723 /* Right after 0xFFFF and class id atom follows */ |
| 593 | 724 Dynarr_add_many (template_, &ones, 2); |
| 725 Dynarr_add_many (template_, &button_class_id, | |
| 726 sizeof (button_class_id)); | |
| 771 | 727 |
| 428 | 728 /* Next thing to add is control text, as Unicode string */ |
| 442 | 729 { |
| 867 | 730 Ichar accel_unused; |
| 771 | 731 |
| 732 push_lisp_string_as_unicode | |
| 733 (template_, | |
| 734 mswindows_translate_menu_or_dialog_item | |
| 735 (pgui_item->name, &accel_unused)); | |
| 442 | 736 } |
| 771 | 737 |
| 428 | 738 /* Specify 0 length creation data. */ |
| 593 | 739 Dynarr_add_many (template_, &zeroes, 2); |
| 771 | 740 |
| 428 | 741 item_tem.x += item_tem.cx + X_BUTTON_SPACING; |
| 742 } | |
| 743 } | |
| 771 | 744 |
| 428 | 745 /* Now the Windows dialog structure is ready. We need to prepare a |
| 746 data structure for the new dialog, which will contain callbacks | |
| 442 | 747 and the frame for these callbacks. This structure has to be |
| 748 GC-protected and thus it is put into a statically protected | |
| 749 list. */ | |
| 428 | 750 { |
| 751 int i; | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
752 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (mswindows_dialog_id); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
753 struct mswindows_dialog_id *did = XMSWINDOWS_DIALOG_ID (obj); |
| 771 | 754 |
| 442 | 755 did->frame = wrap_frame (f); |
| 756 did->callbacks = make_vector (Dynarr_length (dialog_items), Qunbound); | |
| 757 for (i = 0; i < Dynarr_length (dialog_items); i++) | |
| 758 XVECTOR_DATA (did->callbacks) [i] = | |
| 759 XGUI_ITEM (*Dynarr_atp (dialog_items, i))->callback; | |
| 428 | 760 |
| 761 /* Woof! Everything is ready. Pop pop pop in now! */ | |
| 442 | 762 did->hwnd = |
| 771 | 763 qxeCreateDialogIndirectParam (NULL, |
| 4967 | 764 (LPDLGTEMPLATE) Dynarr_begin (template_), |
| 771 | 765 FRAME_MSWINDOWS_HANDLE (f), dialog_proc, |
| 5125 | 766 (LPARAM) STORE_LISP_IN_VOID (obj)); |
| 442 | 767 if (!did->hwnd) |
| 428 | 768 /* Something went wrong creating the dialog */ |
| 563 | 769 signal_error (Qdialog_box_error, "Creating dialog", keys); |
| 771 | 770 |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
771 Vdialog_data_list = Fcons (obj, Vdialog_data_list); |
| 771 | 772 |
| 442 | 773 /* Cease protection and free dynarrays */ |
| 771 | 774 unbind_to (unbind_count); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
775 return obj; |
| 428 | 776 } |
| 442 | 777 } |
| 428 | 778 |
| 442 | 779 static Lisp_Object |
| 780 mswindows_make_dialog_box_internal (struct frame* f, Lisp_Object type, | |
| 781 Lisp_Object keys) | |
| 782 { | |
| 707 | 783 int unbind_count = specpdl_depth (); |
| 784 record_unwind_protect (dialog_popped_down, Qnil); | |
| 785 popup_up_p++; | |
| 819 | 786 |
| 442 | 787 if (EQ (type, Qfile)) |
| 771 | 788 return unbind_to_1 (unbind_count, handle_file_dialog_box (f, keys)); |
| 673 | 789 else if (EQ (type, Qdirectory)) |
| 771 | 790 return unbind_to_1 (unbind_count, handle_directory_dialog_box (f, keys)); |
| 442 | 791 else if (EQ (type, Qquestion)) |
| 771 | 792 return unbind_to_1 (unbind_count, handle_question_dialog_box (f, keys)); |
| 442 | 793 else if (EQ (type, Qprint)) |
| 771 | 794 return unbind_to_1 (unbind_count, |
| 795 mswindows_handle_print_dialog_box (f, keys)); | |
| 442 | 796 else if (EQ (type, Qpage_setup)) |
| 771 | 797 return unbind_to_1 (unbind_count, |
| 798 mswindows_handle_page_setup_dialog_box (f, keys)); | |
| 442 | 799 else |
| 563 | 800 signal_error (Qunimplemented, "Dialog box type", type); |
| 442 | 801 return Qnil; |
| 428 | 802 } |
| 803 | |
| 804 void | |
| 805 console_type_create_dialog_mswindows (void) | |
| 806 { | |
| 442 | 807 CONSOLE_HAS_METHOD (mswindows, make_dialog_box_internal); |
| 808 } | |
| 809 | |
| 810 void | |
| 811 syms_of_dialog_mswindows (void) | |
| 812 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
813 INIT_LISP_OBJECT (mswindows_dialog_id); |
| 771 | 814 |
| 442 | 815 DEFKEYWORD (Q_initial_directory); |
| 816 DEFKEYWORD (Q_initial_filename); | |
| 817 DEFKEYWORD (Q_filter_list); | |
| 818 DEFKEYWORD (Q_title); | |
| 819 DEFKEYWORD (Q_allow_multi_select); | |
| 820 DEFKEYWORD (Q_create_prompt_on_nonexistent); | |
| 821 DEFKEYWORD (Q_overwrite_prompt); | |
| 822 DEFKEYWORD (Q_file_must_exist); | |
| 823 DEFKEYWORD (Q_no_network_button); | |
| 824 DEFKEYWORD (Q_no_read_only_return); | |
| 771 | 825 |
| 442 | 826 /* Errors */ |
| 563 | 827 DEFERROR_STANDARD (Qdialog_box_error, Qgui_error); |
| 428 | 828 } |
| 829 | |
| 830 void | |
| 831 vars_of_dialog_mswindows (void) | |
| 832 { | |
| 442 | 833 Vpopup_frame_list = Qnil; |
| 834 staticpro (&Vpopup_frame_list); | |
| 771 | 835 |
| 428 | 836 Vdialog_data_list = Qnil; |
| 837 staticpro (&Vdialog_data_list); | |
| 771 | 838 |
| 442 | 839 DEFVAR_LISP ("default-file-dialog-filter-alist", |
| 840 &Vdefault_file_dialog_filter_alist /* | |
| 771 | 841 */ ); |
| 442 | 842 Vdefault_file_dialog_filter_alist = |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
843 list5 (Fcons (build_defer_string ("Text Files"), build_ascstring ("*.txt")), |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
844 Fcons (build_defer_string ("C Files"), build_ascstring ("*.c;*.h")), |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
845 Fcons (build_defer_string ("Elisp Files"), build_ascstring ("*.el")), |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
846 Fcons (build_defer_string ("HTML Files"), build_ascstring ("*.html;*.html")), |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
847 Fcons (build_defer_string ("All Files"), build_ascstring ("*.*"))); |
| 428 | 848 } |