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/graph-util/get-dpy.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/graph-util/get-dpy.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 26 - (view) (download)

1 : monnier 26 (* get-dpy.sml
2 :     *
3 :     * COPYRIGHT (c) 1998 Bell Labs, Lucent Technologies.
4 :     *
5 :     * Utility code for getting the display name and authentication information.
6 :     *)
7 :    
8 :     structure GetDpy : GET_DPY =
9 :     struct
10 :    
11 :     structure EXB = EXeneBase
12 :     structure SS = Substring
13 :    
14 :     fun getDpyName NONE = (case (Posix.ProcEnv.getenv "DISPLAY")
15 :     of NONE => ""
16 :     | (SOME dpy) => dpy
17 :     (* end case *))
18 :     | getDpyName (SOME dpy) = dpy
19 :    
20 :     (* parse a string specifying a X display into its components. *)
21 :     fun parseDisplay "" = {host="",dpy="0",screen="0"}
22 :     | parseDisplay d = let
23 :     val (host,rest) = SS.splitl (fn c => c <> #":") (SS.all d)
24 :     val (dpy,scr) = SS.splitl (fn c => c <> #".") rest
25 :     in
26 :     if SS.size dpy < 2 then raise EXB.BadAddr "No display field"
27 :     else if SS.size scr = 1 then raise EXB.BadAddr "No screen number"
28 :     else {host=SS.string host,
29 :     dpy=SS.string(SS.triml 1 dpy),
30 :     screen=SS.string(SS.triml 1 scr)}
31 :     end
32 :    
33 :     (* given an optional display name, return the display and authentication
34 :     * information. If the argument is NONE, then we use the DISPLAY environment
35 :     * variable if it is defined, and "" if it is not defined.
36 :     *)
37 :     fun getDpy dpyOpt = let
38 :     val dpy = getDpyName dpyOpt
39 :     val auth = (case dpy
40 :     of "" => XAuth.getAuthByAddr {
41 :     family = XAuth.familyLocal,
42 :     addr = "",
43 :     dpy = "0"
44 :     }
45 :     | d => let
46 :     val {dpy,...} = parseDisplay d
47 :     in
48 :     XAuth.getAuthByAddr {
49 :     family = XAuth.familyInternet,
50 :     addr = "",
51 :     dpy = dpy
52 :     }
53 :     end
54 :     (* end case *))
55 :     in
56 :     (dpy, auth)
57 :     end
58 :    
59 :     end;
60 :    

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