1(* 2 Copyright (c) 2001 3 David C.J. Matthews 4 5 This library is free software; you can redistribute it and/or 6 modify it under the terms of the GNU Lesser General Public 7 License as published by the Free Software Foundation; either 8 version 2.1 of the License, or (at your option) any later version. 9 10 This library is distributed in the hope that it will be useful, 11 but WITHOUT ANY WARRANTY; without even the implied warranty of 12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 Lesser General Public License for more details. 14 15 You should have received a copy of the GNU Lesser General Public 16 License along with this library; if not, write to the Free Software 17 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 18*) 19 20(* Listboxes. *) 21structure Listbox: 22sig 23 structure Style: 24 sig 25 include BIT_FLAGS where type flags = Window.Style.flags 26 val WS_OVERLAPPED: flags and WS_POPUP: flags and WS_CHILD: flags and WS_MINIMIZE: flags 27 and WS_VISIBLE: flags and WS_DISABLED:flags and WS_CLIPSIBLINGS:flags 28 and WS_CLIPCHILDREN:flags and WS_MAXIMIZE:flags and WS_CAPTION:flags 29 and WS_BORDER:flags and WS_DLGFRAME:flags and WS_VSCROLL:flags and WS_HSCROLL:flags 30 and WS_SYSMENU:flags and WS_THICKFRAME:flags and WS_GROUP:flags and WS_TABSTOP:flags 31 and WS_MINIMIZEBOX:flags and WS_MAXIMIZEBOX:flags and WS_TILED:flags and WS_ICONIC:flags 32 and WS_SIZEBOX:flags and WS_OVERLAPPEDWINDOW:flags and WS_TILEDWINDOW:flags 33 and WS_POPUPWINDOW: flags and WS_CHILDWINDOW: flags 34 and LBS_NOTIFY: flags and LBS_SORT: flags and LBS_NOREDRAW: flags and LBS_MULTIPLESEL: flags 35 and LBS_OWNERDRAWFIXED: flags and LBS_OWNERDRAWVARIABLE: flags and LBS_HASSTRINGS: flags 36 and LBS_USETABSTOPS: flags and LBS_NOINTEGRALHEIGHT: flags and LBS_MULTICOLUMN: flags 37 and LBS_WANTKEYBOARDINPUT: flags and LBS_EXTENDEDSEL: flags and LBS_DISABLENOSCROLL: flags 38 and LBS_NODATA: flags and LBS_NOSEL: flags and LBS_STANDARD: flags 39 end 40 41 structure Notifications: 42 sig 43 val LBN_SELCHANGE: int 44 val LBN_DBLCLK: int 45 val LBN_SELCANCEL: int 46 val LBN_SETFOCUS: int 47 val LBN_KILLFOCUS: int 48 end 49 50 datatype LBDirAttr = 51 DDL_READWRITE | DDL_READONLY | DDL_HIDDEN | DDL_SYSTEM | DDL_DIRECTORY | 52 DDL_ARCHIVE | DDL_POSTMSGS | DDL_DRIVES | DDL_EXCLUSIVE 53end 54= 55struct 56 structure Style = 57 struct 58 open Window.Style (* Include all the windows styles. *) 59 60 val LBS_NOTIFY = fromWord 0wx0001 61 val LBS_SORT = fromWord 0wx0002 62 val LBS_NOREDRAW = fromWord 0wx0004 63 val LBS_MULTIPLESEL = fromWord 0wx0008 64 val LBS_OWNERDRAWFIXED = fromWord 0wx0010 65 val LBS_OWNERDRAWVARIABLE = fromWord 0wx0020 66 val LBS_HASSTRINGS = fromWord 0wx0040 67 val LBS_USETABSTOPS = fromWord 0wx0080 68 val LBS_NOINTEGRALHEIGHT = fromWord 0wx0100 69 val LBS_MULTICOLUMN = fromWord 0wx0200 70 val LBS_WANTKEYBOARDINPUT = fromWord 0wx0400 71 val LBS_EXTENDEDSEL = fromWord 0wx0800 72 val LBS_DISABLENOSCROLL = fromWord 0wx1000 73 val LBS_NODATA = fromWord 0wx2000 74 val LBS_NOSEL = fromWord 0wx4000 75 val LBS_STANDARD = flags[LBS_NOTIFY, LBS_SORT, WS_VSCROLL, WS_BORDER] 76 77 val all = flags[Window.Style.all, LBS_NOTIFY, LBS_SORT, LBS_NOREDRAW, LBS_MULTIPLESEL, 78 LBS_OWNERDRAWFIXED, LBS_OWNERDRAWVARIABLE, LBS_HASSTRINGS, 79 LBS_USETABSTOPS, LBS_NOINTEGRALHEIGHT, LBS_MULTICOLUMN, 80 LBS_WANTKEYBOARDINPUT, LBS_EXTENDEDSEL, LBS_DISABLENOSCROLL, 81 LBS_NODATA, LBS_NOSEL] 82 83 val intersect = 84 List.foldl (fn (a, b) => fromWord(SysWord.andb(toWord a, toWord b))) all 85 end 86 87 structure Notifications = 88 struct 89 val LBN_SELCHANGE = 1 90 val LBN_DBLCLK = 2 91 val LBN_SELCANCEL = 3 92 val LBN_SETFOCUS = 4 93 val LBN_KILLFOCUS = 5 94 end 95 96 datatype LBDirAttr = datatype ComboBase.CBDirAttr 97end; 98 99(* 100let 101 open Listbox.Style 102 103 val flagTable = 104 [(LBS_NOTIFY, "LBS_NOTIFY"), 105 (LBS_SORT, "LBS_SORT"), 106 (LBS_NOREDRAW, "LBS_NOREDRAW"), 107 (LBS_MULTIPLESEL, "LBS_MULTIPLESEL"), 108 (LBS_OWNERDRAWFIXED, "LBS_OWNERDRAWFIXED"), 109 (LBS_OWNERDRAWVARIABLE, "LBS_OWNERDRAWVARIABLE"), 110 (LBS_HASSTRINGS, "LBS_HASSTRINGS"), 111 (LBS_USETABSTOPS, "LBS_USETABSTOPS"), 112 (LBS_NOINTEGRALHEIGHT, "LBS_NOINTEGRALHEIGHT"), 113 (LBS_MULTICOLUMN, "LBS_MULTICOLUMN"), 114 (LBS_WANTKEYBOARDINPUT, "LBS_WANTKEYBOARDINPUT"), 115 (LBS_EXTENDEDSEL, "LBS_EXTENDEDSEL"), 116 (LBS_DISABLENOSCROLL, "LBS_DISABLENOSCROLL"), 117 (LBS_NODATA, "LBS_NODATA"), 118 (WS_POPUP, "WS_POPUP"), 119 (WS_CHILD, "WS_CHILD"), 120 (WS_MINIMIZE, "WS_MINIMIZE"), 121 (WS_VISIBLE, "WS_VISIBLE"), 122 (WS_DISABLED, "WS_DISABLED"), 123 (WS_CLIPSIBLINGS, "WS_CLIPSIBLINGS"), 124 (WS_CLIPCHILDREN, "WS_CLIPCHILDREN"), 125 (WS_MAXIMIZE, "WS_MAXIMIZE"), 126 (WS_CAPTION, "WS_CAPTION"), 127 (WS_BORDER, "WS_BORDER"), 128 (WS_DLGFRAME, "WS_DLGFRAME"), 129 (WS_VSCROLL, "WS_VSCROLL"), 130 (WS_HSCROLL, "WS_HSCROLL"), 131 (WS_SYSMENU, "WS_SYSMENU"), 132 (WS_THICKFRAME, "WS_THICKFRAME"), 133 (WS_GROUP, "WS_GROUP"), 134 (WS_TABSTOP, "WS_TABSTOP"), 135 (WS_MINIMIZEBOX, "WS_MINIMIZEBOX"), 136 (WS_MAXIMIZEBOX, "WS_MAXIMIZEBOX")] 137 138 fun accumulateFlags f [] = [] 139 | accumulateFlags f ((w, s)::t) = 140 if allSet(w, f) then s :: accumulateFlags(clear(w, f)) t 141 else accumulateFlags f t 142 143 fun printFlags(put, beg, brk, nd) depth _ x = 144 (* This is just the code to print a list. *) 145 let 146 147 val stringFlags = accumulateFlags x flagTable 148 fun plist [] depth = () 149 | plist _ 0 = put "..." 150 | plist [h] depth = put h 151 | plist (h::t) depth = 152 ( put (h^","); 153 brk (1, 0); 154 plist t (depth - 1) 155 ) 156 in 157 beg (3, false); 158 put "["; 159 if depth <= 0 then put "..." else plist stringFlags depth; 160 put "]"; 161 nd () 162 end 163in 164 PolyML.install_pp printFlags 165end; 166*)