Mercurial > emacs
view lwlib/lwlib-Xaw.c @ 73331:f21883dcffa9
Merge from upstream, upto version 5.22.
After 5.0:
`cperl-add-tags-recurse-noxs-fullpath': new function (for -batch mode)
After 5.1:
;; Major edit. Summary of most visible changes:
;; a) Multiple <<HERE per line allowed.
;; b) Handles multiline subroutine declaration headers (with comments).
;; (The exception is `cperl-etags' - but it is not used in the rest
;; of the mode.)
;; c) Fontifies multiline my/our declarations (even with comments,
;; and with legacy `font-lock').
;; d) Major speedup of syntaxification, both immediate and postponed
;; (3.5x to 15x [for different CPUs and versions of Emacs] on the
;; huge real-life document I tested).
;; e) New bindings, edits to imenu.
;; f) "_" is made into word-char during fontification/syntaxification;
;; some attempts to recognize non-word "_" during other operations too.
;; g) Detect bug in Emacs with `looking-at' inside `narrow' and bulk out.
;; h) autoload some more perldoc-related stuff
;; i) Some new convenience features: ISpell POD/HEREDOCs, narrow-to-HEREDOC
;; j) Attempt to incorporate XEmacs edits which reached me
Fine-grained changelog:
`cperl-hook-after-change': New configuration variable
`cperl-vc-sccs-header': Likewise.
`cperl-vc-sccs-header': Likewise.
`cperl-vc-header-alist': Default via two preceding variables
`cperl-invalid-face': Remove double quoting under XEmacs
(still needed under 21.2)
`cperl-tips': Update URLs for resources
`cperl-problems': Likewise.
`cperl-praise': Mention new features
New C-c key bindings: for `cperl-find-bad-style',
`cperl-pod-spell', `cperl-here-doc-spell', `cperl-narrow-to-here-doc',
`cperl-perdoc', `cperl-perldoc-at-point'
CPerl Mode menu changes: "Fix style by spaces", "Imenu on Perl Info"
moved, new submenu of Tools with Ispell entries and narrowing.
`cperl-after-sub-regexp': New defsubst
`cperl-imenu--function-name-regexp-perl': Use `cperl-after-sub-regexp',
Allows heads up to head4
Allow "package;"
`defun-prompt-regexp': Use `cperl-after-sub-regexp',
`paren-backwards-message': ??? Something for XEmacs???
`cperl-mode': Never auto-switch abbrev-mode off
Try to allow '_' be non-word char
Do not use `font-lock-unfontify-region-function' on XEmacs
Reset syntax cache on mode start
Support multiline facification (even
on legacy `font-lock')
`cperl-facemenu-add-face-function': ??? Some contributed code ???
`cperl-after-change-function': Since `font-lock' and `lazy-lock'
refuse to inform us whether the fontification is due to lazy
calling or due to edit to a buffer, install our own hook
(controlled by `cperl-hook-after-change')
`cperl-electric-pod': =cut may have been recognized as start
`cperl-block-p': Moved, updated for attributes
`cperl-calculate-indent': Try to allow '_' be non-word char
Support subs with attributes
`cperl-where-am-i': Queit (?) a warning
`cperl-cached-syntax-table' New function
`cperl-forward-re': Use `cperl-cached-syntax-table'
`cperl-unwind-to-safe': Recognize `syntax-type' property
changing in a middle of line
`cperl-find-sub-attrs': New function
`cperl-find-pods-heres': Allow many <<EOP per line
Allow subs with attributes
Major speedups (3.5x..15x on a real-life
test file nph-proxy.pl)
Recognize "extproc " (OS/2)
case-folded and only at start
/x on s///x with empty replacement was
not recognized
Better comments
`cperl-after-block-p': Remarks on diff with `cperl-block-p'
Allow subs with attributes, labels
Do not confuse "else::foo" with "else"
Minor optimizations...
`cperl-after-expr-p': Try to allow '_' be non-word char
`cperl-fill-paragraph': Try to detect a major bug in Emacs
with `looking-at' inside `narrow' and bulk out if found
`cperl-imenu--create-perl-index': Updates for new
`cperl-imenu--function-name-regexp-perl'
`cperl-outline-level': Likewise.
`cperl-init-faces': Allow multiline subroutine headers
and my/our declarations, and ones with comments
Allow subroutine attributes
`cperl-imenu-on-info': Better docstring.
`cperl-etags' Rudimentary support for attributes
Support for packages and "package;"
`cperl-add-tags-recurse-noxs': Better (?) docstring
`cperl-add-tags-recurse-noxs-fullpath': Likewise.
`cperl-tags-hier-init': Misprint for `fboundp' fixed
`cperl-not-bad-style-regexp': Try to allow '_' be non-word char
`cperl-perldoc': Add autoload
`cperl-perldoc-at-point': Likewise.
`cperl-here-doc-spell': New function
`cperl-pod-spell': Likewise.
`cperl-map-pods-heres': Likewise.
`cperl-get-here-doc-region': Likewise.
`cperl-font-lock-fontify-region-function': Likewise (backward compatibility
for legacy `font-lock')
`cperl-font-lock-unfontify-region-function': Fix style
`cperl-fontify-syntaxically': Recognize and optimize away
deferred calls with no-change. Governed by `cperl-hook-after-change'
`cperl-fontify-update': Recognize that syntaxification region
can be larger than fontification one.
XXXX we leave `cperl-postpone' property, so this is quadratic...
`cperl-fontify-update-bad': Temporary placeholder until
it is clear how to implement `cperl-fontify-update'.
`cperl-time-fontification': New function
`attrib-group': New text attribute
`multiline': New value: `syntax-type' text attribute
After 5.2:
`cperl-emulate-lazy-lock': New function
`cperl-fontify-syntaxically': Would skip large regions
Add `cperl-time-fontification', `cperl-emulate-lazy-lock' to menu
Some globals were declared, but uninitialized
After 5.3, 5.4:
`cperl-facemenu-add-face-function': Add docs, fix U<>
Copyright message updated.
`cperl-init-faces': Work around a bug in `font-lock'. May slow
facification down a bit.
Misprint for my|our|local for old `font-lock'
"our" was not fontified same as "my|local"
Highlight variables after "my" etc even in
a middle of an expression
Do not facify multiple variables after my etc
unless parentheses are present
After 5.5, 5.6
`cperl-fontify-syntaxically': after-change hook could reset
`cperl-syntax-done-to' to a middle of line; unwind to BOL.
After 5.7:
`cperl-init-faces': Allow highlighting of local ($/)
`cperl-problems-old-emaxen': New variable (for the purpose of DOCSTRING).
`cperl-problems': Remove fixed problems.
`cperl-find-pods-heres': Recognize #-comments in m##x too
Recognize charclasses (unless delimiter is \).
`cperl-fontify-syntaxically': Unwinding to safe was done in wrong order
`cperl-regexp-scan': Update docs
`cperl-beautify-regexp-piece': use information got from regexp scan
After 5.8:
Major user visible changes:
Recognition and fontification of character classes in RExen.
Variable indentation of RExen according to groups
`cperl-find-pods-heres': Recognize POSIX classes in REx charclasses
Fontify REx charclasses in variable-name face
Fontify POSIX charclasses in "type" face
Fontify unmatched "]" in function-name face
Mark first-char of HERE-doc as `front-sticky'
Reset `front-sticky' property when needed
`cperl-calculate-indent': Indents //x -RExen accordning to parens level
`cperl-to-comment-or-eol': Recognize ends of `syntax-type' constructs
`cperl-backward-to-noncomment': Recognize stringy `syntax-type' constructs
Support `narrow'ed buffers.
`cperl-praise': Remove a reservation
`cperl-make-indent': New function
`cperl-indent-for-comment': Use `cperl-make-indent'
`cperl-indent-line': Likewise.
`cperl-lineup': Likewise.
`cperl-beautify-regexp-piece': Likewise.
`cperl-contract-level': Likewise.
`cperl-toggle-set-debug-unwind': New function
New menu entry for this
`fill-paragraph-function': Use when `boundp'
`cperl-calculate-indent': Take into account groups when indenting RExen
`cperl-to-comment-or-eol': Recognize # which end a string
`cperl-modify-syntax-type': Make only syntax-table property non-sticky
`cperl-fill-paragraph': Return t: needed for `fill-paragraph-function'
`cperl-fontify-syntaxically': More clear debugging message
`cperl-pod2man-build-command': XEmacs portability: check `Man-filter-list'
`cperl-init-faces': More complicated highlight even on XEmacs (new)
Merge cosmetic changes from XEmacs
After 5.9:
`cperl-1+': Moved to before the first use
`cperl-1-': Likewise.
After 5.10:
This code may lock Emacs hard!!! Use on your own risk!
`cperl-font-locking': New internal variable
`cperl-beginning-of-property': New function
`cperl-calculate-indent': Use `cperl-beginning-of-property'
instead of `previous-single-property-change'
`cperl-unwind-to-safe': Likewise.
`cperl-after-expr-p': Likewise.
`cperl-get-here-doc-region': Likewise.
`cperl-font-lock-fontify-region-function': Likewise.
`cperl-to-comment-or-eol': Do not call `cperl-update-syntaxification'
recursively
Bound `next-single-property-change'
via `point-max'
`cperl-unwind-to-safe': Bound likewise
`cperl-font-lock-fontify-region-function': Likewise.
`cperl-find-pods-heres': Mark as recursive for `cperl-to-comment-or-eol'
Initialization of
`cperl-font-lock-multiline-start' could be missed if the "main"
fontification did not run due to the keyword being already fontified.
`cperl-pod-spell': Return t from do-one-chunk function
`cperl-map-pods-heres': Stop when the worker returns nil
Call `cperl-update-syntaxification'
`cperl-get-here-doc-region': Call `cperl-update-syntaxification'
`cperl-get-here-doc-delim': Remove unused function
After 5.11:
The possible lockup of Emacs (introduced in 5.10) fixed
`cperl-unwind-to-safe': `cperl-beginning-of-property' won't return nil
`cperl-syntaxify-for-menu': New customization variable
`cperl-select-this-pod-or-here-doc': New function
`cperl-get-here-doc-region': Extra argument
Do not adjust pos by 1
New menu entries (Perl/Tools): Selection of current POD or HERE-DOC section
(Debugging CPerl:) backtrace on fontification
After 5.12:
`cperl-cached-syntax-table': use `car-safe'
`cperl-forward-re': Remove spurious argument SET-ST
Add documentation
`cperl-forward-group-in-re': New function
`cperl-find-pods-heres': Find and highlight (?{}) blocks in RExen
(XXXX Temporary (?) hack is to syntax-mark them as comment)
After 5.13:
`cperl-string-syntax-table': Make { and } not-grouping
(Sometimes they ARE grouping in RExen, but matching them would only
confuse in many situations when they are not)
`beginning-of-buffer': Replaced two occurences with goto-char...
`cperl-calculate-indent': `char-after' could be nil...
`cperl-find-pods-heres': REx can start after "[" too
Hightlight (??{}) in RExen too
`cperl-maybe-white-and-comment-rex': New constant
`cperl-white-and-comment-rex': Likewise.
XXXX Not very efficient, but hard to make
better while keeping 1 group
After 5.13:
`cperl-find-pods-heres': $foo << identifier() is not a HERE-DOC
Likewise for 1 << identifier
After 5.14:
`cperl-find-pods-heres': Different logic for $foo .= <<EOF etc
Error-less condition-case could fail
`cperl-font-lock-fontify-region-function': Likewise.
`cperl-init-faces': Likewise.
After 5.15:
`cperl-find-pods-heres': Support property REx-part2
`cperl-calculate-indent': Likewise.
Don't special-case REx with non-empty 1st line
`cperl-find-pods-heres': In RExen, highlight non-literal backslashes
Invert highlighting of charclasses:
now the envelop is highlighted
Highlight many others 0-length builtins
`cperl-praise': Mention indenting and highlight in RExen
After 5.15:
`cperl-find-pods-heres': Highlight capturing parens in REx
After 5.16:
`cperl-find-pods-heres': Highlight '|' for alternation
Initialize `font-lock-warning-face' if not present
`cperl-find-pods-heres': Use `font-lock-warning-face' instead of
`font-lock-function-name-face'
`cperl-look-at-leading-count': Likewise.
`cperl-find-pods-heres': localize `font-lock-variable-name-face'
`font-lock-keyword-face' (needed for
batch processing) etc
Use `font-lock-builtin-face' for builtin in REx
Now `font-lock-variable-name-face'
is used for interpolated variables
Use "talking aliases" for faces inside REx
Highlight parts of REx (except in charclasses)
according to the syntax and/or semantic
Syntax-mark a {}-part of (?{}) as "comment"
(it was the ()-part)
Better logic to distinguish what is what in REx
`cperl-tips-faces': Document REx highlighting
`cperl-praise': Mention REx syntax highlight etc.
After 5.17:
`cperl-find-sub-attrs': Would not always manage to print error message
`cperl-find-pods-heres': localize `font-lock-constant-face'
After 5.18:
`cperl-find-pods-heres': Misprint in REx for parsing REx
Very minor optimization
`my-cperl-REx-modifiers-face' got quoted
Recognize "print $foo <<END" as HERE-doc
Put `REx-interpolated' text attribute if needed
`cperl-invert-if-unless-modifiers': New function
`cperl-backward-to-start-of-expr': Likewise.
`cperl-forward-to-end-of-expr': Likewise.
`cperl-invert-if-unless': Works in "the opposite way" too
Cursor position on return is on the switch-word
Indents comments better
`REx-interpolated': New text attribute
`cperl-next-interpolated-REx': New function
`cperl-next-interpolated-REx-0': Likewise.
`cperl-next-interpolated-REx-1': Likewise.
"\C-c\C-x", "\C-c\C-y", "\C-c\C-v": New keybinding for these functions
Perl/Regexp menu: 3 new entries for `cperl-next-interpolated-REx'
`cperl-praise': Mention finded interpolated RExen
After 5.19:
`cperl-init-faces': Highlight %$foo, @$foo too
`cperl-short-docs': Better docs for system, exec
`cperl-find-pods-heres': Better detect << after print {FH} <<EOF etc.
Would not find HERE-doc ended by EOF without NL
`cperl-short-docs': Correct not-doubled \-escapes
start block: Put some `defvar' for stuff gone from XEmacs
After 5.20:
initial comment: Extend copyright, fix email address
`cperl-indent-comment-at-column-0': New customization variable
`cperl-comment-indent': Indentation after $#a would increasy by 1
`cperl-mode': Make `defun-prompt-regexp' grok BEGIN/END etc
`cperl-find-pods-heres': Mark CODE of s///e as `syntax-type' `multiline'
`cperl-at-end-of-expr': Would fail if @BAR=12 follows after ";"
`cperl-init-faces': If `cperl-highlight-variables-indiscriminately'
highlight $ in $foo too (UNTESTED)
`cperl-set-style': Docstring missed some available styles
toplevel: Menubar/Perl/Indent-Styles had FSF, now K&R
Change "Current" to "Memorize Current"
`cperl-indent-wrt-brace': New customization variable; the default is
as for pre-5.2 version
`cperl-styles-entries': Keep `cperl-extra-newline-before-brace-multiline'
`cperl-style-alist': Likewise.
`cperl-fix-line-spacing': Support `cperl-merge-trailing-else' being nil,
and `cperl-extra-newline-before-brace' etc
being t
`cperl-indent-exp': Plans B and C to find continuation blocks even
if `cperl-extra-newline-before-brace' is t
After 5.21:
Improve some docstrings concerning indentation.
`cperl-indent-rules-alist': New variable
`cperl-sniff-for-indent': New function name
(separated from `cperl-calculate-indent')
`cperl-calculate-indent': Separated the sniffer and the indenter;
uses `cperl-sniff-for-indent' now
`cperl-comment-indent': Test for `cperl-indent-comment-at-column-0'
was inverted;
Support `comment-column' = 0
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Wed, 11 Oct 2006 06:47:35 +0000 |
parents | 23a17af379b1 |
children | a274050b67b1 f9a65d7ebd29 |
line wrap: on
line source
/* The lwlib interface to Athena widgets. Copyright (C) 1993 Chuck Thompson <cthomp@cs.uiuc.edu> This file is part of the Lucid Widget Library. The Lucid Widget Library 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 1, or (at your option) any later version. The Lucid Widget Library 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ #ifdef HAVE_CONFIG_H #include <config.h> #endif #include <stdio.h> #include "../src/lisp.h" #include "lwlib-Xaw.h" #include <X11/StringDefs.h> #include <X11/IntrinsicP.h> #include <X11/CoreP.h> #include <X11/Shell.h> #include <X11/Xaw/Scrollbar.h> #include <X11/Xaw/Paned.h> #include <X11/Xaw/Dialog.h> #include <X11/Xaw/Form.h> #include <X11/Xaw/Command.h> #include <X11/Xaw/Label.h> #include <X11/Xatom.h> static void xaw_generic_callback (/*Widget, XtPointer, XtPointer*/); Boolean lw_xaw_widget_p (widget) Widget widget; { return (XtIsSubclass (widget, scrollbarWidgetClass) || XtIsSubclass (widget, dialogWidgetClass)); } #if 0 static void xaw_update_scrollbar (instance, widget, val) widget_instance *instance; Widget widget; widget_value *val; { if (val->scrollbar_data) { scrollbar_values *data = val->scrollbar_data; Dimension height, width; Dimension pos_x, pos_y; int widget_shown, widget_topOfThumb; float new_shown, new_topOfThumb; XtVaGetValues (widget, XtNheight, &height, XtNwidth, &width, XtNx, &pos_x, XtNy, &pos_y, XtNtopOfThumb, &widget_topOfThumb, XtNshown, &widget_shown, NULL); /* * First size and position the scrollbar widget. * We need to position it to second-guess the Paned widget's notion * of what should happen when the WMShell gets resized. */ if (height != data->scrollbar_height || pos_y != data->scrollbar_pos) { XtConfigureWidget (widget, pos_x, data->scrollbar_pos, width, data->scrollbar_height, 0); XtVaSetValues (widget, XtNlength, data->scrollbar_height, XtNthickness, width, NULL); } /* * Now the size the scrollbar's slider. */ new_shown = (float) data->slider_size / (float) (data->maximum - data->minimum); new_topOfThumb = (float) (data->slider_position - data->minimum) / (float) (data->maximum - data->minimum); if (new_shown > 1.0) new_shown = 1.0; if (new_shown < 0) new_shown = 0; if (new_topOfThumb > 1.0) new_topOfThumb = 1.0; if (new_topOfThumb < 0) new_topOfThumb = 0; if (new_shown != widget_shown || new_topOfThumb != widget_topOfThumb) XawScrollbarSetThumb (widget, new_topOfThumb, new_shown); } } #endif void #ifdef PROTOTYPES xaw_update_one_widget (widget_instance *instance, Widget widget, widget_value *val, Boolean deep_p) #else xaw_update_one_widget (instance, widget, val, deep_p) widget_instance *instance; Widget widget; widget_value *val; Boolean deep_p; #endif { #if 0 if (XtIsSubclass (widget, scrollbarWidgetClass)) { xaw_update_scrollbar (instance, widget, val); } #endif if (XtIsSubclass (widget, dialogWidgetClass)) { Arg al[1]; int ac = 0; XtSetArg (al[ac], XtNlabel, val->contents->value); ac++; XtSetValues (widget, al, ac); } else if (XtIsSubclass (widget, commandWidgetClass)) { Dimension bw = 0; Arg al[3]; XtVaGetValues (widget, XtNborderWidth, &bw, NULL); if (bw == 0) /* Don't let buttons end up with 0 borderwidth, that's ugly... Yeah, all this should really be done through app-defaults files or fallback resources, but that's a whole different can of worms that I don't feel like opening right now. Making Athena widgets not look like shit is just entirely too much work. */ { XtSetArg (al[0], XtNborderWidth, 1); XtSetValues (widget, al, 1); } XtSetSensitive (widget, val->enabled); XtSetArg (al[0], XtNlabel, val->value); /* Force centered button text. Se above. */ XtSetArg (al[1], XtNjustify, XtJustifyCenter); XtSetValues (widget, al, 2); XtRemoveAllCallbacks (widget, XtNcallback); XtAddCallback (widget, XtNcallback, xaw_generic_callback, instance); } } void xaw_update_one_value (instance, widget, val) widget_instance *instance; Widget widget; widget_value *val; { /* This function is not used by the scrollbars and those are the only Athena widget implemented at the moment so do nothing. */ return; } void xaw_destroy_instance (instance) widget_instance *instance; { if (XtIsSubclass (instance->widget, dialogWidgetClass)) /* Need to destroy the Shell too. */ XtDestroyWidget (XtParent (instance->widget)); else XtDestroyWidget (instance->widget); } void xaw_popup_menu (widget, event) Widget widget; XEvent *event; { /* An Athena menubar has not been implemented. */ return; } void #ifdef PROTOTYPES xaw_pop_instance (widget_instance *instance, Boolean up) #else xaw_pop_instance (instance, up) widget_instance *instance; Boolean up; #endif { Widget widget = instance->widget; if (up) { if (XtIsSubclass (widget, dialogWidgetClass)) { /* For dialogs, we need to call XtPopup on the parent instead of calling XtManageChild on the widget. Also we need to hack the shell's WM_PROTOCOLS to get it to understand what the close box is supposed to do!! */ Display *dpy = XtDisplay (widget); Widget shell = XtParent (widget); Atom props [2]; int i = 0; props [i++] = XInternAtom (dpy, "WM_DELETE_WINDOW", False); XChangeProperty (dpy, XtWindow (shell), XInternAtom (dpy, "WM_PROTOCOLS", False), XA_ATOM, 32, PropModeAppend, (unsigned char *) props, i); /* Center the widget in its parent. Why isn't this kind of crap done automatically? I thought toolkits were supposed to make life easier? */ { unsigned int x, y, w, h; Widget topmost = instance->parent; Arg args[2]; w = shell->core.width; h = shell->core.height; while (topmost->core.parent && XtIsRealized (topmost->core.parent)) topmost = topmost->core.parent; if (topmost->core.width < w) x = topmost->core.x; else x = topmost->core.x + ((topmost->core.width - w) / 2); if (topmost->core.height < h) y = topmost->core.y; else y = topmost->core.y + ((topmost->core.height - h) / 2); /* Using XtMoveWidget caused the widget to come out in the wrong place with vtwm. Question of virtual vs real coords, perhaps. */ XtSetArg (args[0], XtNx, x); XtSetArg (args[1], XtNy, y); XtSetValues (shell, args, 2); } /* Finally, pop it up. */ XtPopup (shell, XtGrabNonexclusive); } else XtManageChild (widget); } else { if (XtIsSubclass (widget, dialogWidgetClass)) XtUnmanageChild (XtParent (widget)); else XtUnmanageChild (widget); } } /* Dialog boxes */ static char overrideTrans[] = "<Message>WM_PROTOCOLS: lwlib_delete_dialog()"; /* Dialogs pop down on any key press */ static char dialogOverride[] = "<KeyPress>Escape: lwlib_delete_dialog()"; static void wm_delete_window(); static XtActionsRec xaw_actions [] = { {"lwlib_delete_dialog", wm_delete_window} }; static Boolean actions_initted = False; static Widget make_dialog (name, parent, pop_up_p, shell_title, icon_name, text_input_slot, radio_box, list, left_buttons, right_buttons) char* name; Widget parent; Boolean pop_up_p; char* shell_title; char* icon_name; Boolean text_input_slot; Boolean radio_box; Boolean list; int left_buttons; int right_buttons; { Arg av [20]; int ac = 0; int i, bc; char button_name [255]; Widget shell; Widget dialog; Widget button; XtTranslations override; if (! pop_up_p) abort (); /* not implemented */ if (text_input_slot) abort (); /* not implemented */ if (radio_box) abort (); /* not implemented */ if (list) abort (); /* not implemented */ if (! actions_initted) { XtAppContext app = XtWidgetToApplicationContext (parent); XtAppAddActions (app, xaw_actions, sizeof (xaw_actions) / sizeof (xaw_actions[0])); actions_initted = True; } override = XtParseTranslationTable (overrideTrans); ac = 0; XtSetArg (av[ac], XtNtitle, shell_title); ac++; XtSetArg (av[ac], XtNallowShellResize, True); ac++; /* Don't allow any geometry request from the user. */ XtSetArg (av[ac], XtNgeometry, 0); ac++; shell = XtCreatePopupShell ("dialog", transientShellWidgetClass, parent, av, ac); XtOverrideTranslations (shell, override); ac = 0; dialog = XtCreateManagedWidget (name, dialogWidgetClass, shell, av, ac); override = XtParseTranslationTable (dialogOverride); XtOverrideTranslations (dialog, override); bc = 0; button = 0; for (i = 0; i < left_buttons; i++) { ac = 0; XtSetArg (av [ac], XtNfromHoriz, button); ac++; XtSetArg (av [ac], XtNleft, XtChainLeft); ac++; XtSetArg (av [ac], XtNright, XtChainLeft); ac++; XtSetArg (av [ac], XtNtop, XtChainBottom); ac++; XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++; XtSetArg (av [ac], XtNresizable, True); ac++; sprintf (button_name, "button%d", ++bc); button = XtCreateManagedWidget (button_name, commandWidgetClass, dialog, av, ac); } if (right_buttons) { /* Create a separator I want the separator to take up the slack between the buttons on the right and the buttons on the left (that is I want the buttons after the separator to be packed against the right edge of the window) but I can't seem to make it do it. */ ac = 0; XtSetArg (av [ac], XtNfromHoriz, button); ac++; /* XtSetArg (av [ac], XtNfromVert, XtNameToWidget (dialog, "label")); ac++; */ XtSetArg (av [ac], XtNleft, XtChainLeft); ac++; XtSetArg (av [ac], XtNright, XtChainRight); ac++; XtSetArg (av [ac], XtNtop, XtChainBottom); ac++; XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++; XtSetArg (av [ac], XtNlabel, ""); ac++; XtSetArg (av [ac], XtNwidth, 30); ac++; /* #### aaack!! */ XtSetArg (av [ac], XtNborderWidth, 0); ac++; XtSetArg (av [ac], XtNshapeStyle, XmuShapeRectangle); ac++; XtSetArg (av [ac], XtNresizable, False); ac++; XtSetArg (av [ac], XtNsensitive, False); ac++; button = XtCreateManagedWidget ("separator", /* labelWidgetClass, */ /* This has to be Command to fake out the Dialog widget... */ commandWidgetClass, dialog, av, ac); } for (i = 0; i < right_buttons; i++) { ac = 0; XtSetArg (av [ac], XtNfromHoriz, button); ac++; XtSetArg (av [ac], XtNleft, XtChainRight); ac++; XtSetArg (av [ac], XtNright, XtChainRight); ac++; XtSetArg (av [ac], XtNtop, XtChainBottom); ac++; XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++; XtSetArg (av [ac], XtNresizable, True); ac++; sprintf (button_name, "button%d", ++bc); button = XtCreateManagedWidget (button_name, commandWidgetClass, dialog, av, ac); } return dialog; } Widget xaw_create_dialog (instance) widget_instance* instance; { char *name = instance->info->type; Widget parent = instance->parent; Widget widget; Boolean pop_up_p = instance->pop_up_p; char *shell_name = 0; char *icon_name = 0; Boolean text_input_slot = False; Boolean radio_box = False; Boolean list = False; int total_buttons; int left_buttons = 0; int right_buttons = 1; switch (name [0]) { case 'E': case 'e': icon_name = "dbox-error"; shell_name = "Error"; break; case 'I': case 'i': icon_name = "dbox-info"; shell_name = "Information"; break; case 'L': case 'l': list = True; icon_name = "dbox-question"; shell_name = "Prompt"; break; case 'P': case 'p': text_input_slot = True; icon_name = "dbox-question"; shell_name = "Prompt"; break; case 'Q': case 'q': icon_name = "dbox-question"; shell_name = "Question"; break; } total_buttons = name [1] - '0'; if (name [3] == 'T' || name [3] == 't') { text_input_slot = False; radio_box = True; } else if (name [3]) right_buttons = name [4] - '0'; left_buttons = total_buttons - right_buttons; widget = make_dialog (name, parent, pop_up_p, shell_name, icon_name, text_input_slot, radio_box, list, left_buttons, right_buttons); return widget; } static void xaw_generic_callback (widget, closure, call_data) Widget widget; XtPointer closure; XtPointer call_data; { widget_instance *instance = (widget_instance *) closure; Widget instance_widget; LWLIB_ID id; XtPointer user_data; lw_internal_update_other_instances (widget, closure, call_data); if (! instance) return; if (widget->core.being_destroyed) return; instance_widget = instance->widget; if (!instance_widget) return; id = instance->info->id; #if 0 user_data = NULL; XtVaGetValues (widget, XtNuserData, &user_data, NULL); #else /* Damn! Athena doesn't give us a way to hang our own data on the buttons, so we have to go find it... I guess this assumes that all instances of a button have the same call data. */ { widget_value *val = instance->info->val->contents; char *name = XtName (widget); while (val) { if (val->name && !strcmp (val->name, name)) break; val = val->next; } if (! val) abort (); user_data = val->call_data; } #endif if (instance->info->selection_cb) instance->info->selection_cb (widget, id, user_data); } static void wm_delete_window (w, closure, call_data) Widget w; XtPointer closure; XtPointer call_data; { LWLIB_ID id; Cardinal nkids; int i; Widget *kids = 0; Widget widget, shell; if (XtIsSubclass (w, dialogWidgetClass)) shell = XtParent (w); else shell = w; if (! XtIsSubclass (shell, shellWidgetClass)) abort (); XtVaGetValues (shell, XtNnumChildren, &nkids, NULL); XtVaGetValues (shell, XtNchildren, &kids, NULL); if (!kids || !*kids) abort (); for (i = 0; i < nkids; i++) { widget = kids[i]; if (XtIsSubclass (widget, dialogWidgetClass)) break; } id = lw_get_widget_id (widget); if (! id) abort (); { widget_info *info = lw_get_widget_info (id); if (! info) abort (); if (info->selection_cb) info->selection_cb (widget, id, (XtPointer) -1); } lw_destroy_all_widgets (id); } /* Scrollbars */ #if 0 static void xaw_scrollbar_scroll (widget, closure, call_data) Widget widget; XtPointer closure; XtPointer call_data; { widget_instance *instance = (widget_instance *) closure; LWLIB_ID id; scroll_event event_data; if (!instance || widget->core.being_destroyed) return; id = instance->info->id; event_data.slider_value = 0; event_data.time = 0; if ((int) call_data > 0) event_data.action = SCROLLBAR_PAGE_DOWN; else event_data.action = SCROLLBAR_PAGE_UP; if (instance->info->pre_activate_cb) instance->info->pre_activate_cb (widget, id, (XtPointer) &event_data); } #endif #if 0 static void xaw_scrollbar_jump (widget, closure, call_data) Widget widget; XtPointer closure; XtPointer call_data; { widget_instance *instance = (widget_instance *) closure; LWLIB_ID id; scroll_event event_data; scrollbar_values *val = (scrollbar_values *) instance->info->val->scrollbar_data; float percent; if (!instance || widget->core.being_destroyed) return; id = instance->info->id; percent = * (float *) call_data; event_data.slider_value = (int) (percent * (float) (val->maximum - val->minimum)) + val->minimum; event_data.time = 0; event_data.action = SCROLLBAR_DRAG; if (instance->info->pre_activate_cb) instance->info->pre_activate_cb (widget, id, (XtPointer) &event_data); } #endif static Widget xaw_create_scrollbar (instance) widget_instance *instance; { #if 0 Arg av[20]; int ac = 0; Dimension width; Widget scrollbar; XtVaGetValues (instance->parent, XtNwidth, &width, NULL); XtSetArg (av[ac], XtNshowGrip, 0); ac++; XtSetArg (av[ac], XtNresizeToPreferred, 1); ac++; XtSetArg (av[ac], XtNallowResize, True); ac++; XtSetArg (av[ac], XtNskipAdjust, True); ac++; XtSetArg (av[ac], XtNwidth, width); ac++; XtSetArg (av[ac], XtNmappedWhenManaged, True); ac++; scrollbar = XtCreateWidget (instance->info->name, scrollbarWidgetClass, instance->parent, av, ac); /* We have to force the border width to be 0 otherwise the geometry manager likes to start looping for awhile... */ XtVaSetValues (scrollbar, XtNborderWidth, 0, NULL); XtRemoveAllCallbacks (scrollbar, "jumpProc"); XtRemoveAllCallbacks (scrollbar, "scrollProc"); XtAddCallback (scrollbar, "jumpProc", xaw_scrollbar_jump, (XtPointer) instance); XtAddCallback (scrollbar, "scrollProc", xaw_scrollbar_scroll, (XtPointer) instance); return scrollbar; #else return NULL; #endif } static Widget xaw_create_main (instance) widget_instance *instance; { Arg al[1]; int ac; /* Create a vertical Paned to hold menubar */ ac = 0; XtSetArg (al[ac], XtNborderWidth, 0); ac++; return XtCreateWidget (instance->info->name, panedWidgetClass, instance->parent, al, ac); } widget_creation_entry xaw_creation_table [] = { {"scrollbar", xaw_create_scrollbar}, {"main", xaw_create_main}, {NULL, NULL} }; /* arch-tag: fbbd3589-ae1c-41a0-9142-f628cfee6564 (do not change this comment) */