home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #19 / NN_1992_19.iso / spool / comp / lang / tcl / 1284 < prev    next >
Encoding:
Text File  |  1992-08-31  |  11.6 KB  |  346 lines
  1. Newsgroups: comp.lang.tcl
  2. Path: sparky!uunet!eco.twg.com!twg.com!news
  3. From: "David Herron" <david@twg.com>
  4. Subject: Motif-like message/error/warning dialogs 
  5. Message-ID: <1992Aug31.204753.2556@twg.com>
  6. Sensitivity: Personal
  7. Encoding:  32 TEXT , 293 TEXT , 4 TEXT 
  8. Sender: news@twg.com (USENET News System)
  9. Conversion: Prohibited
  10. Organization: The Wollongong Group, Inc., Palo Alto, CA
  11. Conversion-With-Loss: Prohibited
  12. Date: Mon, 31 Aug 1992 20:50:29 GMT
  13. Lines: 331
  14.  
  15. Greetings!
  16.  
  17. I've written up some dialogs which do Motif-like simple message dialogs.
  18. These are the kind to be used which
  19.  
  20.     notifying of error's, warning's, or general information
  21.  
  22.     asking questions
  23.  
  24.     doing a bit of long-term work
  25.  
  26. They include a little picture in the upper left corner to specify which
  27. is which, a piece of text in the upper part, and 1-3 buttons in the
  28. bottom (depending on what's needed).  It all works pretty well and has
  29. a simple programming interface, but it isn't "right".
  30.  
  31. Current problems are:
  32.  
  33. - Modal only.
  34. - Wrong sort of separation 'tween top & bottom.
  35. - No keyboard driven focusing.
  36. - The icons are probably 1/4 the size they should be.
  37. - The `working' dialog is not useful since it doesn't return
  38.   until a button's pressed.
  39.  
  40. But it serves my purposes (where I only need to put up notifications, and
  41. ask questions).
  42.  
  43. BTW, there's a bunch of path names hard coded for bitmap's.  You'll
  44. have to change these to reflect where the bitmaps are stored.
  45.  
  46. It's short enough to just attach here:
  47.  
  48.  
  49. #! /bin/sh
  50. # This is a shell archive, meaning:
  51. # 1. Remove everything above the #! /bin/sh line.
  52. # 2. Save the resulting text in a file.
  53. # 3. Execute the file with /bin/sh (not csh) to create the files:
  54. #    bitmap
  55. #    msgdialog.tk
  56. # This archive created: Mon Aug 31 13:42:28 1992
  57. export PATH; PATH=/bin:$PATH
  58. if test ! -d 'bitmap'
  59. then
  60.     echo shar: creating directory "'bitmap'"
  61.     mkdir 'bitmap'
  62. fi
  63. echo shar: entering directory "'bitmap'"
  64. cd 'bitmap'
  65. echo shar: extracting "'error'" '(278 characters)'
  66. if test -f 'error'
  67. then
  68.     echo shar: will not over-write existing file "'error'"
  69. else
  70. sed 's/^    X//' << \SHAR_EOF > 'error'
  71.     X#define error_width 16
  72.     X#define error_height 16
  73.     Xstatic char error_bits[] = {
  74.     X   0x00, 0x00, 0xe0, 0x01, 0xf8, 0x07, 0x3c, 0x0e, 0x3c, 0x0c, 0x7e, 0x18,
  75.     X   0xe6, 0x18, 0xc6, 0x19, 0x86, 0x1f, 0x0c, 0x0f, 0x1c, 0x0f, 0xf8, 0x07,
  76.     X   0xe0, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
  77. SHAR_EOF
  78. if test 278 -ne "`wc -c < 'error'`"
  79. then
  80.     echo shar: error transmitting "'error'" '(should have been 278 characters)'
  81. fi
  82. fi # end of overwriting check
  83. echo shar: extracting "'information'" '(296 characters)'
  84. if test -f 'information'
  85. then
  86.     echo shar: will not over-write existing file "'information'"
  87. else
  88. sed 's/^    X//' << \SHAR_EOF > 'information'
  89.     X#define information_width 16
  90.     X#define information_height 16
  91.     Xstatic char information_bits[] = {
  92.     X   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0x00, 0x00,
  93.     X   0xe0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00,
  94.     X   0xe0, 0x01, 0xe0, 0x01, 0x00, 0x00, 0x00, 0x00};
  95. SHAR_EOF
  96. if test 296 -ne "`wc -c < 'information'`"
  97. then
  98.     echo shar: error transmitting "'information'" '(should have been 296 characters)'
  99. fi
  100. fi # end of overwriting check
  101. echo shar: extracting "'question'" '(287 characters)'
  102. if test -f 'question'
  103. then
  104.     echo shar: will not over-write existing file "'question'"
  105. else
  106. sed 's/^    X//' << \SHAR_EOF > 'question'
  107.     X#define question_width 16
  108.     X#define question_height 16
  109.     Xstatic char question_bits[] = {
  110.     X   0xf8, 0x07, 0x54, 0x0d, 0xea, 0x1a, 0xf5, 0x35, 0xbb, 0x2b, 0x55, 0x37,
  111.     X   0xab, 0x2b, 0xd5, 0x55, 0xeb, 0xea, 0xd5, 0x15, 0xea, 0x0a, 0xd4, 0x15,
  112.     X   0xe8, 0x0a, 0x58, 0x01, 0xa8, 0x02, 0xfc, 0x07};
  113. SHAR_EOF
  114. if test 287 -ne "`wc -c < 'question'`"
  115. then
  116.     echo shar: error transmitting "'question'" '(should have been 287 characters)'
  117. fi
  118. fi # end of overwriting check
  119. echo shar: extracting "'warning'" '(284 characters)'
  120. if test -f 'warning'
  121. then
  122.     echo shar: will not over-write existing file "'warning'"
  123. else
  124. sed 's/^    X//' << \SHAR_EOF > 'warning'
  125.     X#define warning_width 16
  126.     X#define warning_height 16
  127.     Xstatic char warning_bits[] = {
  128.     X   0x80, 0x03, 0xc0, 0x07, 0xc0, 0x07, 0xc0, 0x07, 0xc0, 0x07, 0xc0, 0x07,
  129.     X   0x80, 0x03, 0x80, 0x03, 0x80, 0x03, 0x80, 0x03, 0x80, 0x03, 0x00, 0x01,
  130.     X   0x00, 0x00, 0x00, 0x01, 0x80, 0x03, 0x00, 0x01};
  131. SHAR_EOF
  132. if test 284 -ne "`wc -c < 'warning'`"
  133. then
  134.     echo shar: error transmitting "'warning'" '(should have been 284 characters)'
  135. fi
  136. fi # end of overwriting check
  137. echo shar: extracting "'working'" '(284 characters)'
  138. if test -f 'working'
  139. then
  140.     echo shar: will not over-write existing file "'working'"
  141. else
  142. sed 's/^    X//' << \SHAR_EOF > 'working'
  143.     X#define working_width 16
  144.     X#define working_height 16
  145.     Xstatic char working_bits[] = {
  146.     X   0xff, 0xff, 0x02, 0x40, 0xfa, 0x5f, 0x0a, 0x50, 0x92, 0x49, 0xe2, 0x47,
  147.     X   0xc2, 0x43, 0x82, 0x41, 0x82, 0x41, 0xc2, 0x43, 0xa2, 0x45, 0xd2, 0x4b,
  148.     X   0xea, 0x57, 0xfa, 0x5f, 0x02, 0x40, 0xff, 0xff};
  149. SHAR_EOF
  150. if test 284 -ne "`wc -c < 'working'`"
  151. then
  152.     echo shar: error transmitting "'working'" '(should have been 284 characters)'
  153. fi
  154. fi # end of overwriting check
  155. echo shar: done with directory "'bitmap'"
  156. cd ..
  157. echo shar: extracting "'msgdialog.tk'" '(5739 characters)'
  158. if test -f 'msgdialog.tk'
  159. then
  160.     echo shar: will not over-write existing file "'msgdialog.tk'"
  161. else
  162. sed 's/^    X//' << \SHAR_EOF > 'msgdialog.tk'
  163.     X
  164.     X# $Id: msgdialog.tk,v 1.4 1992/08/30 03:35:12 david Exp $
  165.     X# msgdialog.tk - Tk procedures to do Motif-like implementations of
  166.     X#    their dialogs derived from MessageBox.
  167.     X#
  168.     X# $Log: msgdialog.tk,v $
  169.     X# Revision 1.4  1992/08/30  03:35:12  david
  170.     X# Change aspect ratio so that it's wide enough to not wrap-around
  171.     X# most things.
  172.     X#
  173.     X# Revision 1.3  1992/08/23  21:27:00  david
  174.     X# Convert to style where the procedure waits for a button press.  We also
  175.     X# issue a grab &c so that it's truly modal.
  176.     X#
  177.     X# Revision 1.2  1992/08/21  15:50:19  david
  178.     X# Added concept of `parent' window in an attempt to locate the
  179.     X# dialog in the center of its parent.
  180.     X#
  181.     X# Revision 1.1  1992/08/07  05:08:12  david
  182.     X# Initial revision.
  183.     X#
  184.     X#
  185.     X#
  186.     X#
  187.     X# USAGE:    DLG:<type> parent name message button_1 button_2 button_3
  188.     X#
  189.     X# parent    The name of the window to parent from
  190.     X# name        The name to use for the toplevel of this dialog
  191.     X# message    Message to print in the message area.
  192.     X# button_{1,2,3} Text to put on each button.
  193.     X#
  194.     X#
  195.     X#
  196.     X# This starts a dialog of the type indicated in <type>.  It has [1..3]
  197.     X# buttons, depending on how many (non-null) strings are passed.  It does
  198.     X# a passive grab, to force the user to respond.  It waits until one of
  199.     X# the buttons are pressed, then kills off the dialog and returns.  The
  200.     X# return value is the number for the button which was pressed {1,2,3}.
  201.     X#
  202.     X# THIS FILE REQUIRES tk2.2 or greater.
  203.     X
  204.     Xproc DLG:information {parent w msg btn1 btn2 btn3} {
  205.     X    return [DLG:build note "$parent" "$w" "$msg" "$btn1" "$btn2" "$btn3"]
  206.     X}
  207.     X
  208.     Xproc DLG:warning {parent w msg btn1 btn2 btn3} {
  209.     X    return [DLG:build warn "$parent" "$w" "$msg" "$btn1" "$btn2" "$btn3"]
  210.     X}
  211.     X
  212.     Xproc DLG:error {parent w msg btn1 btn2 btn3} {
  213.     X    return [DLG:build error "$parent" "$w" "$msg" "$btn1" "$btn2" "$btn3"]
  214.     X}
  215.     X
  216.     Xproc DLG:question {parent w msg btn1 btn2 btn3} {
  217.     X    return [DLG:build ask  "$parent" "$w" "$msg" "$btn1" "$btn2" "$btn3"]
  218.     X}
  219.     X
  220.     Xproc DLG:working {parent w msg btn1 btn2 btn3} {
  221.     X    return [DLG:build work "$parent" "$w" "$msg" "$btn1" "$btn2" "$btn3"]
  222.     X}
  223.     X
  224.     Xproc DLG:build {type parent w msg btn1 btn2 btn3} {
  225.     X    catch { destroy $w }
  226.     X
  227.     X    set done "DLG[set w]done"
  228.     X    global $done
  229.     X    set $done 0
  230.     X
  231.     X    set px [winfo x $parent]
  232.     X    set py [winfo y $parent]
  233.     X    set ph [winfo screenheight $parent]
  234.     X    set pw [winfo screenwidth  $parent]
  235.     X
  236.     X    toplevel $w -class Dialog
  237.     X    wm geometry $w +[expr $px+($pw/3)]+[expr $py+($ph/3)]
  238.     X    wm minsize $w 1 1
  239.     X
  240.     X    # wm raise $parent    -- Motif does this but TK doesn't have the command.
  241.     X
  242.     X    frame $w.msg
  243.     X    frame $w.cmds
  244.     X    pack append $w \
  245.     X        $w.msg  { top fill expand } \
  246.     X        $w.cmds { top fill expand }
  247.     X
  248.     X    case $type {
  249.     X    note    { set iconfile @/home/david/tk-misc/bitmap/information }
  250.     X    warn    { set iconfile @/home/david/tk-misc/bitmap/warning     }
  251.     X    error    { set iconfile @/home/david/tk-misc/bitmap/error       }
  252.     X    ask    { set iconfile @/home/david/tk-misc/bitmap/question    }
  253.     X    work    { set iconfile @/home/david/tk-misc/bitmap/working     }
  254.     X    }
  255.     X
  256.     X    label $w.msg.icon -bitmap $iconfile
  257.     X    message $w.msg.msg  -text "$msg" -justify left -aspect 500
  258.     X    pack append $w.msg \
  259.     X        $w.msg.icon { left } \
  260.     X        $w.msg.msg  { left fill expand }
  261.     X
  262.     X    # Do some cutesy stuff so the buttons are nicely framed.
  263.     X    # We wouldn't have to use two frame's if one option on -relief
  264.     X    # were "knurled" (or some such) to give a raised-edge feel.
  265.     X
  266.     X    frame $w.cmds.f -borderwidth 3 -relief raised
  267.     X    pack append $w.cmds $w.cmds.f { fill expand }
  268.     X    frame $w.cmds.f.f -borderwidth 3 -relief sunken
  269.     X    pack append $w.cmds.f $w.cmds.f.f { fill expand }
  270.     X
  271.     X    # The extra frames below are to indicate current focus.  But we don't
  272.     X    # have anything to handle keyboard focus.  Besides, the Motif
  273.     X    # implementation uses a `knurled' look to the frame around buttons
  274.     X    # in their standard dialogs and we must use two layers of frame to
  275.     X    # implement that (see above).
  276.     X    #
  277.     X    # Also tried to set up stuff for keyboard focus, but it did a couple of
  278.     X    # weird things and there isn't time to fix them now.  Keyboard focus
  279.     X    # remained wherever the last `focus' command had gone, regardless of
  280.     X    # where the pointer focus was.  This is a bug with the regular FOCUS
  281.     X    # module as well.  The cure will be to watch Enter and Leave events
  282.     X    # to know which window the pointer is in.  But this seems to be wrong
  283.     X    # as well: What if the users configures their window manager for
  284.     X    # a click-to-focus mode.  Won't we still get Enter&Leave events
  285.     X    # regardless of where they've clicked-to-focus?
  286.     X
  287.     X    if {"$btn1" != ""} {
  288.     X        frame $w.cmds.f.f.f1 -borderwidth 5 -relief flat
  289.     X        button $w.cmds.f.f.f1.btn1 -text "[lindex $btn1 0]" \
  290.     X                        -command "global $done; set $done 1"
  291.     X        pack append $w.cmds.f.f    $w.cmds.f.f.f1      { left fillx expand }
  292.     X        pack append $w.cmds.f.f.f1 $w.cmds.f.f.f1.btn1 { fill expand }
  293.     X
  294.     X        # DLG:keybindings $w.cmds.f.f.f1.btn1 "[lindex $btn1 1]"
  295.     X    }
  296.     X
  297.     X    if {"$btn2" != ""} {
  298.     X        frame $w.cmds.f.f.f2 -borderwidth 5 -relief flat
  299.     X        button $w.cmds.f.f.f2.btn2 -text "[lindex $btn2 0]" \
  300.     X                     -command "global $done; set $done 2"
  301.     X        pack append $w.cmds.f.f    $w.cmds.f.f.f2      { left fillx expand }
  302.     X        pack append $w.cmds.f.f.f2 $w.cmds.f.f.f2.btn2 { fill expand }
  303.     X
  304.     X        # DLG:keybindings $w.cmds.f.f.f2.btn2 "[lindex $btn2 1]"
  305.     X    }
  306.     X
  307.     X    if {"$btn3" != ""} {
  308.     X        frame $w.cmds.f.f.f3 -borderwidth 5 -relief flat
  309.     X        button $w.cmds.f.f.f3.btn3 -text "[lindex $btn3 0]" \
  310.     X                        -command "global $done; set $done 3"
  311.     X        pack append $w.cmds.f.f    $w.cmds.f.f.f3      { left fillx expand }
  312.     X        pack append $w.cmds.f.f.f3 $w.cmds.f.f.f3.btn3 { fill expand }
  313.     X
  314.     X        # DLG:keybindings $w.cmds.f.f.f3.btn3 "[lindex $btn3 1]"
  315.     X    }
  316.     X
  317.     X    update
  318.     X    grab $w
  319.     X    tkwait variable $done
  320.     X    grab
  321.     X    destroy $w
  322.     X
  323.     X    return "[set $done]"
  324.     X}
  325.     X
  326.     X# Future expansion: For when we are able to do keyboard focus and
  327.     X# traversal in these things.
  328.     X#proc DLG:keybindings { w cmd } {
  329.     X#    bind $w <Key-space> "$cmd"
  330.     X#    bind $w <Key-Return> "$cmd"
  331.     X#}
  332.     X
  333. SHAR_EOF
  334. if test 5739 -ne "`wc -c < 'msgdialog.tk'`"
  335. then
  336.     echo shar: error transmitting "'msgdialog.tk'" '(should have been 5739 characters)'
  337. fi
  338. fi # end of overwriting check
  339. #    End of shell archive
  340. exit 0
  341.  
  342. <- David Herron <david@twg.com> (work) <david@davids.mmdf.com> (home)
  343. <-
  344. <- "ISO is really just another politically correct one-world fantasy
  345. <-  of the U.N." -- Gordon McLachlan (LAN Computing, Aug 1992, p. 37)
  346.