Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/eXene/widgets/util/run-exene.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/widgets/util/run-exene.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 (* run-exene.sml
2 :     *
3 :     * COPYRIGHT (c) 1994 AT&T Bell Laboratories.
4 :     *
5 :     * This structure provides a higher-level interface to invoking applications.
6 :     * Users may set the shell variable "DISPLAY" to specify the display connection.
7 :     *)
8 :    
9 :     structure RunEXene : sig
10 :    
11 :     val parseDisplay : string -> {
12 :     host : string,
13 :     dpy : string,
14 :     screen : string
15 :     }
16 :    
17 :     val run : (Widget.root -> unit) -> unit
18 :    
19 :     type options = {
20 :     dpy : string option, (* specify the display to connect to *)
21 :     timeq : LargeInt.int option (* specify the CML time quantum in ms. *)
22 :     }
23 :    
24 :     val runWArgs : (Widget.root -> unit) -> options -> unit
25 :    
26 :     end = struct
27 :    
28 :     structure W = Widget
29 :     structure SS = Substring
30 :     structure EXB = EXeneBase
31 :    
32 :     fun getDpyName NONE = (case (Posix.ProcEnv.getenv "DISPLAY")
33 :     of NONE => ""
34 :     | (SOME dpy) => dpy
35 :     (* end case *))
36 :     | getDpyName (SOME dpy) = dpy
37 :    
38 :     fun parseDisplay "" = {host="",dpy="0",screen="0"}
39 :     | parseDisplay d = let
40 :     val (host,rest) = SS.splitl (fn c => c <> #":") (SS.all d)
41 :     val (dpy,scr) = SS.splitl (fn c => c <> #".") rest
42 :     in
43 :     if SS.size dpy < 2 then raise EXB.BadAddr "No display field"
44 :     else if SS.size scr = 1 then raise EXB.BadAddr "No screen number"
45 :     else {host=SS.string host,
46 :     dpy=SS.string(SS.triml 1 dpy),
47 :     screen=SS.string(SS.triml 1 scr)}
48 :     end
49 :    
50 :     fun mkRoot dpy = let
51 :     val auth = (case dpy
52 :     of "" => XAuth.getAuthByAddr {
53 :     family = XAuth.familyLocal,
54 :     addr = "",
55 :     dpy = "0"
56 :     }
57 :     | d => let
58 :     val {dpy,...} = parseDisplay d
59 :     in
60 :     XAuth.getAuthByAddr {
61 :     family = XAuth.familyInternet,
62 :     addr = "",
63 :     dpy = dpy
64 :     }
65 :     end
66 :     (* end case *))
67 :     in
68 :     Widget.mkRoot (dpy, auth)
69 :     handle (EXeneBase.BadAddr s) => (
70 :     TextIO.output (TextIO.stdErr, String.concat[
71 :     "eXene: unable to open display \"", dpy, "\"\n",
72 :     " ", s, "\n"
73 :     ]);
74 :     RunCML.shutdown OS.Process.failure)
75 :     end
76 :    
77 :     (* the default time quantum *)
78 :     val defaultTimeQ = Time.fromMilliseconds 20 (* ms *)
79 :    
80 :     fun run doit = let
81 :     fun runIt () = let
82 :     val root = mkRoot (getDpyName NONE)
83 :     in
84 :     doit root
85 :     end
86 :     in
87 :     ignore(RunCML.doit (runIt, SOME defaultTimeQ))
88 :     end
89 :    
90 :     type options = {
91 :     dpy : string option, (* specify the display to connect to *)
92 :     timeq : LargeInt.int option (* specify the CML time quantum in ms. *)
93 :     }
94 :    
95 :     fun runWArgs doit (opts : options) = let
96 :     fun runIt () = let
97 :     val root = mkRoot (getDpyName (#dpy opts))
98 :     in
99 :     doit root
100 :     end
101 :     val timeQ = (case (#timeq opts)
102 :     of NONE => defaultTimeQ
103 :     | (SOME ms) => if (ms <= 0) then defaultTimeQ
104 :     else Time.fromMilliseconds ms
105 :     (* end case *))
106 :     in
107 :     ignore (RunCML.doit (runIt, SOME timeQ))
108 :     end
109 :    
110 :     end; (* RunEXene *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0