LablGTK app maxes out CPU

[Matt Gushee <matt@gushee.net>]

[I posted this to the LablGTK list last week, but have not received any
  responses, so here it is ...]

Hello all,

I have a program that I am developing in LablGTK, which has a 'daemon 
mode' such that the app runs in the background without displaying the 
GUI until the user 'starts' it--which in practice means waking it up; 
then when the user 'quits', it really means just hiding the GUI and 
waiting for the next invocation.

Commands are passed to the daemon by means of a named pipe, and 
GMain.Io.add_watch is used to cause the daemon to read the pipe (code 
below). Now, I thought this would prevent the app from monopolizing the 
CPU, but apparently it does not. When the app is started but before the 
GUI is displayed for the first time, CPU usage is negligible, but as 
soon as the GUI is displayed, the app starts using all available CPU 
time, and it continues to do so as long as it runs, whether the GUI is 
displayed or not. So I wonder if there's something more I need to do to 
keep the app well-behaved (BTW, it should never require much CPU time. 
It's a lightweight file manager, and is graphical only in the sense that 
it is a GUI app--it uses no icons or other images).

Here's the relevant code:

     method daemon_setup () =
       self#int_add_panel ~go:true ();
       is_daemon <- true;
       msg_pipe <- Filename.concat Util.temp_user_dir "message.pipe";
       if not (Sys.file_exists Util.temp_user_dir) then
         Unix.mkdir Util.temp_user_dir 0o755
       else if Sys.file_exists msg_pipe then
         Unix.unlink msg_pipe;
       Unix.mkfifo msg_pipe 0o600;
       msg_fd <-
         (* Unix.openfile msg_pipe [Unix.O_RDONLY; Unix.O_NONBLOCK] 
0o600; *)
         Unix.openfile msg_pipe [Unix.O_RDONLY] 0o600;
       let chan = GMain.Io.channel_of_descr msg_fd in
       let watcher _ =
         let cmdbuf = Buffer.create 4
         and temp = " " in
         let rec read_input ready =
           let nchars = GMain.Io.read chan ~buf:temp ~pos:0 ~len:1 in
           if nchars = 0 then ()
           else
             match temp with
             | "%" -> read_input true
             | "\n" -> read_input false
             | s when ready -> (Buffer.add_string cmdbuf s; read_input true)
             | _ -> read_input false
         and do_command cmdstring =
           match cmdstring with
           | "show" -> self#show ()
           | "hide" -> self#hide ()
           | "quit" -> self#really_quit ()
           | "hup" -> self#hup ()
           | cs -> self#warn ("Unknown command: " ^ cs) in
         read_input false;
         do_command (Buffer.contents cmdbuf);
         true in
       ignore (GMain.Io.add_watch ~cond:[`IN] ~callback:watcher chan)


Any suggestions?

-- 
Matt Gushee
: Bantam - lightweight file manager : matt.gushee.net/software/bantam/ :
: RASCL's A Simple Configuration Language :     matt.gushee.net/rascl/ :