helm/DEVEL/pxp/pxp/examples/xmlforms/ds_style.ml

   1 (* $Id$
   2  * ----------------------------------------------------------------------
   3  *
   4  *)
   5
   6 open Pxp_types
   7 open Pxp_document
   8 open Ds_context
   9
  10
  11 let get_dimension s =
  12   let re = Str.regexp "\\([0-9]*\\(.[0-9]+\\)?\\)[ \t\n]*\\(px\\|cm\\|in\\|mm\\|pt\\)" in
  13   if Str.string_match re s 0 then begin
  14     let number = Str.matched_group 1 s in
  15     let dim = Str.matched_group 3 s in
  16     match dim with
  17         "px" -> Tk.Pixels (int_of_float (float_of_string number))
  18       | "cm" -> Tk.Centimeters (float_of_string number)
  19       | "in" -> Tk.Inches (float_of_string number)
  20       | "mm" -> Tk.Millimeters (float_of_string number)
  21       | "pt" -> Tk.PrinterPoint (float_of_string number)
  22       | _ -> assert false
  23   end
  24   else
  25     failwith ("Bad dimension: " ^ s)
  26 ;;
  27
  28
  29 class virtual shared =
  30   object(self)
  31
  32     (* --- default_ext --- *)
  33
  34     val mutable node = (None : shared node option)
  35
  36     method clone = {< >}
  37     method node =
  38       match node with
  39           None ->
  40             assert false
  41         | Some n -> n
  42     method set_node n =
  43       node <- Some n
  44
  45     (* --- shared attributes: color & font settings --- *)
  46
  47     val mutable fgcolor = (None : string option)
  48     val mutable bgcolor = (None : string option)
  49     val mutable font = (None : string option)
  50
  51     method fgcolor =
  52       (* Get the foreground color: If there is a local value, return it;
  53        * otherwise ask parent node
  54        *)
  55       match fgcolor with
  56           Some c -> c
  57         | None   -> try self # node # parent # extension # fgcolor with
  58                     Not_found -> failwith "#fgcolor"
  59
  60     method bgcolor =
  61       (* Get the background color: If there is a local value, return it;
  62        * otherwise ask parent node
  63        *)
  64       match bgcolor with
  65           Some c -> c
  66         | None   -> try self # node # parent # extension # bgcolor with
  67                     Not_found -> failwith "#bgcolor"
  68
  69     method font =
  70       (* Get the current font: If there is a local value, return it;
  71        * otherwise ask parent node
  72        *)
  73       match font with
  74           Some c -> c
  75         | None   -> try self # node # parent # extension # font with
  76                     Not_found -> failwith "#font"
  77
  78     method private init_color_and_font =
  79       let get_color n =
  80         try
  81           match self # node # attribute n with
  82               Value v -> Some v
  83             | Implied_value -> None
  84             | _ -> assert false
  85         with Not_found -> None in
  86       fgcolor <- get_color "fgcolor";
  87       bgcolor <- get_color "bgcolor";
  88       font    <- get_color "font";      (* sic! *)
  89
  90
  91     method private bg_color_opt =
  92       [ Tk.Background (Tk.NamedColor (self # bgcolor)) ]
  93
  94     method private fg_color_opt =
  95       [ Tk.Foreground (Tk.NamedColor (self # fgcolor)) ]
  96
  97     method private font_opt =
  98       [ Tk.Font (self # font) ]
  99
 100     (* --- virtual --- *)
 101
 102     method virtual prepare : shared Pxp_yacc.index -> unit
 103     method virtual create_widget : Widget.widget -> context -> Widget.widget
 104
 105     method pack_opts = ( [] : Tk.options list )
 106     method xstretchable = false
 107     method ystretchable = false
 108
 109     method accept (c:context) = ()
 110
 111     method private get_mask =
 112       (* find parent which is a mask *)
 113       let rec search n =
 114         match n # node_type with
 115             T_element "mask" ->
 116               n # extension
 117           | T_element _ ->
 118               search (n # parent)
 119           | _ ->
 120               assert false
 121       in
 122       search (self # node)
 123
 124
 125     method private accept_mask (c:context) =
 126       let rec iterate n =
 127         n # extension # accept c;
 128         List.iter iterate (n # sub_nodes)
 129       in
 130       iterate (self # get_mask # node)
 131
 132
 133     method start_node_name =
 134       (failwith "#start_node_name" : string)
 135
 136     (* --- debug --- *)
 137
 138     method private name =
 139       let nt = self # node # node_type in
 140       match nt with
 141           T_element n -> n
 142         | T_data      -> "#PCDATA"
 143         | _           -> assert false
 144
 145   end
 146 ;;
 147
 148
 149 class default =
 150   object (self)
 151     inherit shared
 152
 153     method prepare idx =
 154       self # init_color_and_font
 155
 156     method create_widget w c =
 157       failwith "default # create_widget"
 158   end
 159 ;;
 160
 161
 162 let dummy_node = new element_impl (new default);;
 163
 164 class application =
 165   object (self)
 166     inherit shared
 167
 168     val mutable start_node = dummy_node
 169
 170     method prepare idx =
 171       (* prepare this node *)
 172       self # init_color_and_font;
 173       if fgcolor = None then fgcolor <- Some "black";
 174       if bgcolor = None then bgcolor <- Some "white";
 175       if font = None then font <- Some "fixed";
 176       let start =
 177         match self # node # attribute "start" with
 178             Value v -> v
 179           | _       -> assert false in
 180       start_node <- (try idx # find start with
 181           Not_found -> failwith "Start node not found");
 182       (* iterate over the subtree *)
 183       let rec iterate n =
 184         n # extension # prepare idx;
 185         List.iter iterate (n # sub_nodes)
 186       in
 187       List.iter iterate (self # node # sub_nodes)
 188
 189
 190     method start_node_name =
 191       match self # node # attribute "start" with
 192           Value v -> v
 193         | _       -> assert false
 194
 195     method create_widget w c =
 196       start_node # extension # create_widget w c
 197
 198     method pack_opts =
 199       start_node # extension # pack_opts
 200   end
 201 ;;
 202
 203
 204 class sequence =
 205   object (self)
 206     inherit shared
 207
 208     method prepare idx =
 209       self # init_color_and_font;
 210
 211     method create_widget w c =
 212       let node = List.hd (self # node # sub_nodes) in
 213       node # extension # create_widget w c
 214
 215     method pack_opts =
 216       let node = List.hd (self # node # sub_nodes) in
 217       node # extension # pack_opts
 218   end
 219 ;;
 220
 221
 222 class vbox =
 223   object (self)
 224     inherit shared
 225
 226     val mutable att_halign = "left"
 227
 228     method prepare idx =
 229       self # init_color_and_font;
 230       match self # node # attribute "halign" with
 231           Value v -> att_halign <- v
 232         | _ -> assert false
 233
 234     method create_widget w c =
 235       let f = Frame.create w (self # bg_color_opt) in
 236       let nodes = self # node # sub_nodes in
 237       let options =
 238         match att_halign with
 239             "left"     -> [ Tk.Anchor Tk.W ]
 240           | "right"    -> [ Tk.Anchor Tk.E ]
 241           | "center"   -> [ Tk.Anchor Tk.Center ]
 242           | _ -> assert false
 243       in
 244       List.iter
 245         (fun n ->
 246            let opts = n # extension # pack_opts in
 247            let wdg = n # extension # create_widget f c in
 248            Tk.pack [wdg] (options @ opts);
 249         )
 250         nodes;
 251       f
 252
 253     method pack_opts =
 254       match self # xstretchable, self # ystretchable with
 255           true, false  -> [ Tk.Fill Tk.Fill_X; (* Tk.Expand true *) ]
 256         | false, true  -> [ Tk.Fill Tk.Fill_Y;  (* Tk.Expand true *) ]
 257         | true, true   -> [ Tk.Fill Tk.Fill_Both; (* Tk.Expand true *) ]
 258         | false, false -> []
 259
 260     method xstretchable =
 261       let nodes = self # node # sub_nodes in
 262       List.exists (fun n -> n # extension # xstretchable) nodes
 263
 264     method ystretchable =
 265       let nodes = self # node # sub_nodes in
 266       List.exists (fun n -> n # extension # ystretchable) nodes
 267
 268   end
 269
 270 ;;
 271
 272
 273 class mask =
 274   object (self)
 275
 276     inherit vbox
 277
 278     method prepare idx =
 279       self # init_color_and_font;
 280       att_halign <- "left"
 281   end
 282 ;;
 283
 284
 285 class hbox =
 286   object (self)
 287     inherit shared
 288
 289     val mutable att_width = None
 290     val mutable att_halign = "left"
 291     val mutable att_valign = "top"
 292
 293     method prepare idx =
 294       self # init_color_and_font;
 295       begin match self # node # attribute "halign" with
 296           Value v -> att_halign <- v
 297         | _ -> assert false
 298       end;
 299       begin match self # node # attribute "valign" with
 300           Value v -> att_valign <- v
 301         | _ -> assert false
 302       end;
 303       begin match self # node # attribute "width" with
 304           Value v       -> att_width <- Some (get_dimension v)
 305         | Implied_value -> att_width <- None
 306         | _ -> assert false
 307       end
 308
 309     method create_widget w c =
 310       let f1 = Frame.create w (self # bg_color_opt) in
 311       let f_extra =
 312         match att_width with
 313             None    -> []
 314           | Some wd ->
 315               [ Canvas.create f1
 316                   ( [ Tk.Width wd; Tk.Height (Tk.Pixels 0);
 317                       Tk.Relief Tk.Flat;
 318                       Tk.HighlightThickness (Tk.Pixels 0);
 319                     ] @
 320                     self # bg_color_opt ) ]
 321       in
 322       let f2 = Frame.create f1 (self # bg_color_opt) in
 323       let nodes = self # node # sub_nodes in
 324
 325       let outer_pack_opts =
 326         match att_halign with
 327             "left"     -> [ Tk.Anchor Tk.W ]
 328           | "right"    -> [ Tk.Anchor Tk.E ]
 329           | "center"   -> [ Tk.Anchor Tk.Center ]
 330           | _ -> assert false
 331       in
 332       let inner_pack_opts =
 333         match att_valign with
 334             "top"      -> [ Tk.Anchor Tk.N ]
 335           | "bottom"   -> [ Tk.Anchor Tk.S ]
 336           | "center"   -> [ Tk.Anchor Tk.Center ]
 337           | _ -> assert false
 338       in
 339       List.iter
 340         (fun n ->
 341            let opts = n # extension # pack_opts in
 342            let wdg = n # extension # create_widget f2 c in
 343            Tk.pack [wdg] (inner_pack_opts @ [ Tk.Side Tk.Side_Left ] @ opts);
 344         )
 345         nodes;
 346       let extra_opts = self # pack_opts in
 347       Tk.pack (f_extra @ [f2]) (outer_pack_opts @ extra_opts);
 348       f1
 349
 350     method pack_opts =
 351       match self # xstretchable, self # ystretchable with
 352           true, false  -> [ Tk.Fill Tk.Fill_X;  (* Tk.Expand true *) ]
 353         | false, true  -> [ Tk.Fill Tk.Fill_Y;  (* Tk.Expand true *) ]
 354         | true, true   -> [ Tk.Fill Tk.Fill_Both;  (* Tk.Expand true *) ]
 355         | false, false -> []
 356
 357     method xstretchable =
 358       let nodes = self # node # sub_nodes in
 359       List.exists (fun n -> n # extension # xstretchable) nodes
 360
 361     method ystretchable =
 362       let nodes = self # node # sub_nodes in
 363       List.exists (fun n -> n # extension # ystretchable) nodes
 364
 365   end
 366 ;;
 367
 368 class vspace =
 369   object (self)
 370     inherit shared
 371
 372     val mutable att_height = Tk.Pixels 0
 373     val mutable att_fill  = false
 374
 375     method prepare idx =
 376       self # init_color_and_font;
 377       begin match self # node # attribute "height" with
 378           Value v       -> att_height <- get_dimension v
 379         | _ -> assert false
 380       end;
 381       begin match self # node # attribute "fill" with
 382           Value "yes" -> att_fill <- true
 383         | Value "no"  -> att_fill <- false
 384         | _ -> assert false
 385       end
 386
 387
 388     method create_widget w c =
 389       let f = Frame.create w ( self # bg_color_opt ) in
 390       let strut =
 391         Canvas.create f
 392           ( [ Tk.Height att_height; Tk.Width (Tk.Pixels 0);
 393               Tk.Relief Tk.Flat;
 394               Tk.HighlightThickness (Tk.Pixels 0);
 395             ] @
 396             self # bg_color_opt ) in
 397       if att_fill then
 398         Tk.pack [strut] [Tk.Fill Tk.Fill_Y; Tk.Expand true]
 399       else
 400         Tk.pack [strut] [];
 401       f
 402
 403     method pack_opts =
 404       if att_fill then [ Tk.Fill Tk.Fill_Y; Tk.Expand true ] else []
 405
 406     method ystretchable = att_fill
 407   end
 408 ;;
 409
 410 class hspace =
 411   object (self)
 412     inherit shared
 413
 414
 415     val mutable att_width = Tk.Pixels 0
 416     val mutable att_fill  = false
 417
 418     method prepare idx =
 419       self # init_color_and_font;
 420       begin match self # node # attribute "width" with
 421           Value v       -> att_width <- get_dimension v
 422         | _ -> assert false
 423       end;
 424       begin match self # node # attribute "fill" with
 425           Value "yes" -> att_fill <- true
 426         | Value "no"  -> att_fill <- false
 427         | _ -> assert false
 428       end
 429
 430
 431     method create_widget w c =
 432       let f = Frame.create w ( self # bg_color_opt ) in
 433       let strut =
 434         Canvas.create f
 435           ( [ Tk.Width att_width; Tk.Height (Tk.Pixels 0);
 436               Tk.Relief Tk.Flat;
 437               Tk.HighlightThickness (Tk.Pixels 0);
 438             ] @
 439             self # bg_color_opt ) in
 440       if att_fill then
 441         Tk.pack [strut] [Tk.Fill Tk.Fill_X; Tk.Expand true]
 442       else
 443         Tk.pack [strut] [];
 444       f
 445
 446     method pack_opts =
 447       if att_fill then [ Tk.Fill Tk.Fill_X; Tk.Expand true ] else []
 448
 449     method xstretchable = att_fill
 450   end
 451 ;;
 452
 453 class label =
 454   object (self)
 455     inherit shared
 456
 457     val mutable att_textwidth = (-1)
 458     val mutable att_halign = "left"
 459
 460     method prepare idx =
 461       self # init_color_and_font;
 462       att_textwidth <- (match self # node # attribute "textwidth" with
 463                             Value v ->
 464                               let w = try int_of_string v
 465                               with _ -> failwith ("Not an integer: " ^ v) in
 466                               w
 467                           | Implied_value ->
 468                               (-1)
 469                           | _ -> assert false);
 470       att_halign <- (match self # node # attribute "halign" with
 471                          Value v -> v
 472                        | _ -> assert false);
 473
 474
 475     method create_widget w c =
 476       let opts_textwidth = if att_textwidth < 0 then [] else
 477                                                [ Tk.TextWidth att_textwidth ] in
 478       let opts_halign =
 479         match att_halign with
 480             "left"     -> [ Tk.Anchor Tk.W ]
 481           | "right"    -> [ Tk.Anchor Tk.E ]
 482           | "center"   -> [ Tk.Anchor Tk.Center ]
 483           | _ -> assert false
 484       in
 485       let opts_content =
 486         [ Tk.Text (self # node # data) ] in
 487       let label = Label.create w (opts_textwidth @ opts_halign @
 488                                   opts_content @ self # bg_color_opt @
 489                                   self # fg_color_opt @ self # font_opt) in
 490       label
 491
 492   end
 493 ;;
 494
 495 class entry =
 496   object (self)
 497     inherit shared
 498
 499     val mutable tv = lazy (Textvariable.create())
 500     val mutable att_textwidth = (-1)
 501     val mutable att_slot = ""
 502
 503     method prepare idx =
 504       self # init_color_and_font;
 505       tv <- lazy (Textvariable.create());
 506       att_textwidth <- (match self # node # attribute "textwidth" with
 507                             Value v ->
 508                               let w = try int_of_string v
 509                               with _ -> failwith ("Not an integer: " ^ v) in
 510                               w
 511                           | Implied_value ->
 512                               (-1)
 513                           | _ -> assert false);
 514       att_slot <- (match self # node # attribute "slot" with
 515           Value v -> v
 516         | _ -> assert false);
 517
 518     method create_widget w c =
 519       let opts_textwidth = if att_textwidth < 0 then [] else
 520                                                [ Tk.TextWidth att_textwidth ] in
 521       let e = Entry.create w ( [ Tk.TextVariable (Lazy.force tv) ] @
 522                                self # fg_color_opt @
 523                                self # bg_color_opt @
 524                                self # font_opt @
 525                                opts_textwidth
 526                              ) in
 527       let s =
 528         try c # get_slot att_slot with
 529             Not_found -> self # node # data in
 530       Textvariable.set (Lazy.force tv) s;
 531       e
 532
 533     method accept c =
 534       c # set_slot att_slot (Textvariable.get (Lazy.force tv))
 535
 536   end
 537 ;;
 538
 539 class textbox =
 540   object (self)
 541     inherit shared
 542
 543     val mutable att_textwidth = (-1)
 544     val mutable att_textheight = (-1)
 545     val mutable att_slot = ""
 546     val mutable last_widget = None
 547
 548     method prepare idx =
 549       self # init_color_and_font;
 550       att_textwidth <- (match self # node # attribute "textwidth" with
 551                             Value v ->
 552                               let w = try int_of_string v
 553                               with _ -> failwith ("Not an integer: " ^ v) in
 554                               w
 555                           | Implied_value ->
 556                               (-1)
 557                           | _ -> assert false);
 558       att_textheight <- (match self # node # attribute "textheight" with
 559                             Value v ->
 560                               let w = try int_of_string v
 561                               with _ -> failwith ("Not an integer: " ^ v) in
 562                               w
 563                           | Implied_value ->
 564                               (-1)
 565                           | _ -> assert false);
 566       att_slot <- (match self # node # attribute "slot" with
 567                        Value v -> v
 568                      | Implied_value -> ""
 569                      | _ -> assert false);
 570
 571
 572     method create_widget w c =
 573       let opts_textwidth = if att_textwidth < 0 then [] else
 574                                                [ Tk.TextWidth att_textwidth ] in
 575       let opts_textheight = if att_textheight < 0 then [] else
 576                                             [ Tk.TextHeight att_textheight ] in
 577       let f = Frame.create w (self # bg_color_opt) in
 578       let vscrbar = Scrollbar.create f [ Tk.Orient Tk.Vertical ] in
 579       let e = Text.create f ( [ ] @
 580                               self # fg_color_opt @
 581                               self # bg_color_opt @
 582                               self # font_opt @
 583                               opts_textwidth @ opts_textheight
 584                             ) in
 585       last_widget <- Some e;
 586       Scrollbar.configure vscrbar [ Tk.ScrollCommand
 587                                       (fun s -> Text.yview e s);
 588                                     Tk.Width (Tk.Pixels 9) ];
 589       Text.configure e [ Tk.YScrollCommand
 590                            (fun a b -> Scrollbar.set vscrbar a b) ];
 591       let s =
 592         if att_slot <> "" then
 593           try c # get_slot att_slot with
 594               Not_found -> self # node # data
 595         else
 596           self # node # data
 597       in
 598       (* Text.insert appends always a newline to the last line; so strip
 599        * an existing newline first
 600        *)
 601       let s' =
 602         if s <> "" & s.[String.length s - 1] = '\n' then
 603           String.sub s 0 (String.length s - 1)
 604         else
 605           s in
 606       Text.insert e (Tk.TextIndex(Tk.End,[])) s' [];
 607       if att_slot = "" then
 608         Text.configure e [ Tk.State Tk.Disabled ];
 609       Tk.pack [e] [ Tk.Side Tk.Side_Left ];
 610       Tk.pack [vscrbar] [ Tk.Side Tk.Side_Left; Tk.Fill Tk.Fill_Y ];
 611       f
 612
 613     method accept c =
 614       if att_slot <> "" then
 615         match last_widget with
 616             None -> ()
 617           | Some w ->
 618               let s =
 619                 Text.get
 620                   w
 621                   (Tk.TextIndex(Tk.LineChar(1,0),[]))
 622                   (Tk.TextIndex(Tk.End,[])) in
 623               c # set_slot att_slot s
 624
 625   end
 626 ;;
 627
 628 class button =
 629   object (self)
 630     inherit shared
 631
 632     val mutable att_label = ""
 633     val mutable att_action = ""
 634     val mutable att_goto = ""
 635
 636     method prepare idx =
 637       self # init_color_and_font;
 638       att_label <- (match self # node # attribute "label" with
 639                         Value v -> v
 640                       | _ -> assert false);
 641       att_action <- (match self # node # attribute "action" with
 642                          Value v -> v
 643                        | _ -> assert false);
 644       att_goto <- (match self # node # attribute "goto" with
 645                        Value v -> v
 646                      | Implied_value -> ""
 647                      | _ -> assert false);
 648       if att_action = "goto" then begin
 649         try let _ = idx # find att_goto in () with
 650             Not_found -> failwith ("Target `" ^ att_goto ^ "' not found")
 651       end;
 652       if att_action = "list-prev" or att_action = "list-next" then begin
 653         let m = self # get_mask in
 654         if m # node # parent # node_type <> T_element "sequence" then
 655           failwith ("action " ^ att_action ^ " must not be used out of <sequence>");
 656       end;
 657
 658
 659     method create_widget w c =
 660       let cmd () =
 661         self # accept_mask c;
 662         match att_action with
 663             "goto" ->
 664               c # goto att_goto
 665           | "save" ->
 666               c # save_obj
 667           | "exit" ->
 668               Protocol.closeTk()
 669           | "save-exit" ->
 670               c # save_obj;
 671               Protocol.closeTk()
 672           | "list-prev" ->
 673               let m = self # get_mask # node in
 674               let s = m # parent in
 675               let rec search l =
 676                 match l with
 677                     x :: y :: l' ->
 678                       if y == m then
 679                         match x # attribute "name" with
 680                             Value s -> c # goto s
 681                           | _ -> assert false
 682                       else
 683                         search (y :: l')
 684                   | _ -> ()
 685               in
 686               search (s # sub_nodes)
 687           | "list-next" ->
 688               let m = self # get_mask # node in
 689               let s = m # parent in
 690               let rec search l =
 691                 match l with
 692                     x :: y :: l' ->
 693                       if x == m then
 694                         match y # attribute "name" with
 695                             Value s -> c # goto s
 696                           | _ -> assert false
 697                       else
 698                         search (y :: l')
 699                   | _ -> ()
 700               in
 701               search (s # sub_nodes)
 702           | "hist-prev" ->
 703               (try c # previous with Not_found -> ())
 704           | "hist-next" ->
 705               (try c # next with Not_found -> ())
 706           | _ -> ()
 707       in
 708       let b = Button.create w ( [ Tk.Text att_label; Tk.Command cmd ] @
 709                                 self # fg_color_opt @
 710                                 self # bg_color_opt @
 711                                 self # font_opt ) in
 712       b
 713
 714
 715   end
 716 ;;
 717
 718
 719 (**********************************************************************)
 720
 721 open Pxp_yacc
 722
 723 let tag_map =
 724   make_spec_from_mapping
 725     ~data_exemplar:(new data_impl (new default))
 726     ~default_element_exemplar:(new element_impl (new default))
 727     ~element_mapping:
 728        (let m = Hashtbl.create 50 in
 729         Hashtbl.add m "application"
 730                       (new element_impl (new application));
 731         Hashtbl.add m "sequence"
 732                       (new element_impl (new sequence));
 733         Hashtbl.add m "mask"
 734                       (new element_impl (new mask));
 735         Hashtbl.add m "vbox"
 736                       (new element_impl (new vbox));
 737         Hashtbl.add m "hbox"
 738                       (new element_impl (new hbox));
 739         Hashtbl.add m "vspace"
 740                       (new element_impl (new vspace));
 741         Hashtbl.add m "hspace"
 742                       (new element_impl (new hspace));
 743         Hashtbl.add m "label"
 744                       (new element_impl (new label));
 745         Hashtbl.add m "entry"
 746                       (new element_impl (new entry));
 747         Hashtbl.add m "textbox"
 748                       (new element_impl (new textbox));
 749         Hashtbl.add m "button"
 750                       (new element_impl (new button));
 751         m)
 752     ()
 753 ;;
 754
 755 (* ======================================================================
 756  * History:
 757  *
 758  * $Log$
 759  * Revision 1.1  2000/11/17 09:57:31  lpadovan
 760  * Initial revision
 761  *
 762  * Revision 1.5  2000/08/30 15:58:49  gerd
 763  *      Updated.
 764  *
 765  * Revision 1.4  2000/07/16 19:36:03  gerd
 766  *      Updated.
 767  *
 768  * Revision 1.3  2000/07/08 22:03:11  gerd
 769  *      Updates because of PXP interface changes.
 770  *
 771  * Revision 1.2  2000/06/04 20:29:19  gerd
 772  *      Updates because of renamed PXP modules.
 773  *
 774  * Revision 1.1  1999/08/21 19:11:05  gerd
 775  *      Initial revision.
 776  *
 777  *
 778  *)