File: Listbox.sml

package info (click to toggle)
polyml 5.7.1-5
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, sid
  • size: 40,616 kB
  • sloc: cpp: 44,142; ansic: 26,963; sh: 22,002; asm: 13,486; makefile: 602; exp: 525; python: 253; awk: 91
file content (166 lines) | stat: -rw-r--r-- 6,792 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
(*
    Copyright (c) 2001
        David C.J. Matthews

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 2.1 of the License, or (at your option) any later version.
    
    This 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
    Lesser General Public License for more details.
    
    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
*)

(* Listboxes. *)
structure Listbox:
sig
    structure Style:
    sig
        include BIT_FLAGS where type flags = Window.Style.flags
        val WS_OVERLAPPED: flags and WS_POPUP: flags and WS_CHILD: flags and WS_MINIMIZE: flags
        and WS_VISIBLE: flags and WS_DISABLED:flags and WS_CLIPSIBLINGS:flags
        and WS_CLIPCHILDREN:flags and WS_MAXIMIZE:flags and WS_CAPTION:flags
        and WS_BORDER:flags and WS_DLGFRAME:flags and WS_VSCROLL:flags and WS_HSCROLL:flags
        and WS_SYSMENU:flags and WS_THICKFRAME:flags and WS_GROUP:flags and WS_TABSTOP:flags
        and WS_MINIMIZEBOX:flags and WS_MAXIMIZEBOX:flags and WS_TILED:flags and WS_ICONIC:flags
        and WS_SIZEBOX:flags and WS_OVERLAPPEDWINDOW:flags and WS_TILEDWINDOW:flags
        and WS_POPUPWINDOW: flags and WS_CHILDWINDOW: flags
        and LBS_NOTIFY: flags and LBS_SORT: flags and LBS_NOREDRAW: flags and LBS_MULTIPLESEL: flags
        and LBS_OWNERDRAWFIXED: flags and LBS_OWNERDRAWVARIABLE: flags and LBS_HASSTRINGS: flags
        and LBS_USETABSTOPS: flags and LBS_NOINTEGRALHEIGHT: flags and LBS_MULTICOLUMN: flags
        and LBS_WANTKEYBOARDINPUT: flags and LBS_EXTENDEDSEL: flags and LBS_DISABLENOSCROLL: flags
        and LBS_NODATA: flags and LBS_NOSEL: flags and LBS_STANDARD: flags
    end

    structure Notifications:
    sig
        val LBN_SELCHANGE: int
        val LBN_DBLCLK: int
        val LBN_SELCANCEL: int
        val LBN_SETFOCUS: int
        val LBN_KILLFOCUS: int
    end

    datatype LBDirAttr =
        DDL_READWRITE | DDL_READONLY | DDL_HIDDEN | DDL_SYSTEM | DDL_DIRECTORY |
        DDL_ARCHIVE | DDL_POSTMSGS | DDL_DRIVES | DDL_EXCLUSIVE
end
=
struct
    structure Style =
    struct
        open Window.Style (* Include all the windows styles. *)

        val LBS_NOTIFY            = fromWord 0wx0001
        val LBS_SORT              = fromWord 0wx0002
        val LBS_NOREDRAW          = fromWord 0wx0004
        val LBS_MULTIPLESEL       = fromWord 0wx0008
        val LBS_OWNERDRAWFIXED    = fromWord 0wx0010
        val LBS_OWNERDRAWVARIABLE = fromWord 0wx0020
        val LBS_HASSTRINGS        = fromWord 0wx0040
        val LBS_USETABSTOPS       = fromWord 0wx0080
        val LBS_NOINTEGRALHEIGHT  = fromWord 0wx0100
        val LBS_MULTICOLUMN       = fromWord 0wx0200
        val LBS_WANTKEYBOARDINPUT = fromWord 0wx0400
        val LBS_EXTENDEDSEL       = fromWord 0wx0800
        val LBS_DISABLENOSCROLL   = fromWord 0wx1000
        val LBS_NODATA            = fromWord 0wx2000
        val LBS_NOSEL             = fromWord 0wx4000
        val LBS_STANDARD          = flags[LBS_NOTIFY, LBS_SORT, WS_VSCROLL, WS_BORDER]

        val all = flags[Window.Style.all, LBS_NOTIFY, LBS_SORT, LBS_NOREDRAW, LBS_MULTIPLESEL,
                        LBS_OWNERDRAWFIXED, LBS_OWNERDRAWVARIABLE, LBS_HASSTRINGS,
                        LBS_USETABSTOPS, LBS_NOINTEGRALHEIGHT, LBS_MULTICOLUMN,
                        LBS_WANTKEYBOARDINPUT, LBS_EXTENDEDSEL, LBS_DISABLENOSCROLL,
                        LBS_NODATA, LBS_NOSEL]

        val intersect =
            List.foldl (fn (a, b) => fromWord(SysWord.andb(toWord a, toWord b))) all
    end

    structure Notifications =
    struct
        val LBN_SELCHANGE       = 1
        val LBN_DBLCLK          = 2
        val LBN_SELCANCEL       = 3
        val LBN_SETFOCUS        = 4
        val LBN_KILLFOCUS       = 5
    end

    datatype LBDirAttr = datatype ComboBase.CBDirAttr
end;

(*
let
    open Listbox.Style

    val flagTable =
        [(LBS_NOTIFY,           "LBS_NOTIFY"),
         (LBS_SORT,             "LBS_SORT"),
         (LBS_NOREDRAW,         "LBS_NOREDRAW"),
         (LBS_MULTIPLESEL,      "LBS_MULTIPLESEL"),
         (LBS_OWNERDRAWFIXED,   "LBS_OWNERDRAWFIXED"),
         (LBS_OWNERDRAWVARIABLE, "LBS_OWNERDRAWVARIABLE"),
         (LBS_HASSTRINGS,       "LBS_HASSTRINGS"),
         (LBS_USETABSTOPS,      "LBS_USETABSTOPS"),
         (LBS_NOINTEGRALHEIGHT, "LBS_NOINTEGRALHEIGHT"),
         (LBS_MULTICOLUMN,      "LBS_MULTICOLUMN"),
         (LBS_WANTKEYBOARDINPUT, "LBS_WANTKEYBOARDINPUT"),
         (LBS_EXTENDEDSEL,      "LBS_EXTENDEDSEL"),
         (LBS_DISABLENOSCROLL,  "LBS_DISABLENOSCROLL"),
         (LBS_NODATA,           "LBS_NODATA"),
         (WS_POPUP,             "WS_POPUP"),
         (WS_CHILD,             "WS_CHILD"),
         (WS_MINIMIZE,          "WS_MINIMIZE"),
         (WS_VISIBLE,           "WS_VISIBLE"),
         (WS_DISABLED,          "WS_DISABLED"),
         (WS_CLIPSIBLINGS,      "WS_CLIPSIBLINGS"),
         (WS_CLIPCHILDREN,      "WS_CLIPCHILDREN"),
         (WS_MAXIMIZE,          "WS_MAXIMIZE"),
         (WS_CAPTION,           "WS_CAPTION"),
         (WS_BORDER,            "WS_BORDER"),
         (WS_DLGFRAME,          "WS_DLGFRAME"),
         (WS_VSCROLL,           "WS_VSCROLL"),
         (WS_HSCROLL,           "WS_HSCROLL"),
         (WS_SYSMENU,           "WS_SYSMENU"),
         (WS_THICKFRAME,        "WS_THICKFRAME"),
         (WS_GROUP,             "WS_GROUP"),
         (WS_TABSTOP,           "WS_TABSTOP"),
         (WS_MINIMIZEBOX,       "WS_MINIMIZEBOX"),
         (WS_MAXIMIZEBOX,       "WS_MAXIMIZEBOX")]

    fun accumulateFlags f [] = []
     |  accumulateFlags f ((w, s)::t) =
        if allSet(w, f) then s :: accumulateFlags(clear(w, f)) t
        else accumulateFlags f t

    fun printFlags(put, beg, brk, nd) depth _ x =
        (* This is just the code to print a list. *)
        let
        
          val stringFlags = accumulateFlags x flagTable
          fun plist [] depth = ()
           |  plist _ 0 = put "..."
           |  plist [h]    depth = put h 
           |  plist (h::t) depth =
                  ( put (h^",");
                    brk (1, 0);
                    plist t (depth - 1)
                  )
        in
          beg (3, false);
          put "[";
          if depth <= 0 then put "..." else plist stringFlags depth;
          put "]";
          nd ()
        end
in
    PolyML.install_pp printFlags
end;
*)