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

SCM Repository

[smlnj] Diff of /sml/trunk/src/eXene/styles/styles-func.sml
ViewVC logotype

Diff of /sml/trunk/src/eXene/styles/styles-func.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1910, Thu Mar 2 23:45:19 2006 UTC revision 1911, Fri Mar 3 03:33:16 2006 UTC
# Line 309  Line 309 
309              targets : (PRS.attr_name * AV.attr_type) list,              targets : (PRS.attr_name * AV.attr_type) list,
310              reply : (PRS.attr_name * AV.attr_value) list SyncVar.ivar              reply : (PRS.attr_name * AV.attr_value) list SyncVar.ivar
311            }            }
312    (* added ddeboer May 2004 *)
313          | GetDb of db SyncVar.ivar
314    (* end additions by ddeboer *)
315    
316      datatype style = STY of {      datatype style = STY of {
317          ctxt : AV.attr_ctxt,          ctxt : AV.attr_ctxt,
# Line 336  Line 339 
339                        in                        in
340                          SyncVar.iPut (reply, results)                          SyncVar.iPut (reply, results)
341                        end                        end
342    (* added ddeboer May 2004 *)
343              | (GetDb(reply)) => (SyncVar.iPut(reply,db))
344    (* end additions by ddeboer *)
345                  (* end case *);                  (* end case *);
346                  server ())                  server ())
347            in            in
# Line 439  Line 445 
445           *)           *)
446  *****************************************************)  *****************************************************)
447    
448        (* Additions by ddeboer, May 2004.
449         * Dusty deBoer, KSU CIS 705, Spring 2004. *)
450    
451        (* utility function: list the resource specs from a db.
452         * a resource spec is roughly:
453         * PRS.RsrcSpec{loose:bool,path:(PRS.component*PRS.binding)list,attr:PRS.attr_name,value:string,ext:(false)}
454         *)
455        fun listRsrcSpecs (DB{db,cache}) =
456            let
457            fun lstSpcs (DBTBL{tight,loose,attrs},pth) =
458                (* list specs from attrs; that is the easy part. *)
459                (let
460                val (qabLst: (Quark.quark * (attr * binding)) list) = QuarkTbl.listItemsi attrs
461                val (rscSpL: PRS.resource_spec list) =
462                    List.map
463                        (fn (qu,(ATTR{rawValue,...},bind)) =>
464                            PRS.RsrcSpec{loose=(case bind of PRS.LOOSE=>true | PRS.TIGHT=>false),
465                                path=pth,attr=qu,value=rawValue,ext=false})
466                        qabLst
467                val (loosqtLst: (Quark.quark * db_tbl) list) =
468                        QuarkTbl.listItemsi loose
469                val (loostpLst: (db_tbl * (PRS.component * PRS.binding) list) list) =
470                        List.map (fn (q,t) => (t,pth@[(PRS.Name q,PRS.LOOSE)])) loosqtLst
471                val (loosRscSpL: PRS.resource_spec list) =
472                        List.concat (List.map lstSpcs loostpLst)
473                val (tghtqtLst: (Quark.quark * db_tbl) list) =
474                        QuarkTbl.listItemsi tight
475                val (tghttpLst: (db_tbl * (PRS.component * PRS.binding) list) list) =
476                        List.map (fn (q,t) => (t,pth@[(PRS.Name q,PRS.TIGHT)])) tghtqtLst
477                val (tghtRscSpL: PRS.resource_spec list) =
478                        List.concat (List.map lstSpcs tghttpLst)
479                in (rscSpL@loosRscSpL@tghtRscSpL) end)
480            in lstSpcs (db,[]) end
481    
482        (* another utility function - get the resource specs from a style, then convert them
483         * to strings. This could be used to write a style back to a database, as in
484         * XrmPutFileDatabase().
485         *)
486        fun stringsFromStyle (STY{reqCh,ctxt}) =
487            let
488            val replyV = SyncVar.iVar()
489            val _ = CML.send(reqCh,GetDb(replyV))
490            val db = SyncVar.iGet replyV
491            in
492                List.map
493                    (fn PRS.RsrcSpec{loose,path,attr,value,...} =>
494                        (String.concat
495                            (List.map
496                                (fn (PRS.Name cn,b) =>
497                                    (case b of PRS.LOOSE => "*" | PRS.TIGHT => ".")^(Quark.stringOf cn))
498                                path))^
499                        (if loose then "*" else ".")^(Quark.stringOf attr)^":"^value)
500                (listRsrcSpecs db)
501            end;
502    
503        (* mergeStyles(sourceStyle: style, targetStyle: style) -> mergedStyle: style
504         *
505         * mergedStyle should consist of the same resource specifications that would
506         * exist in targetStyle if all resource specifications of sourceStyle were
507         * inserted into targetStyle. That is, in particular, a tight binding of a
508         * particular resource specification in targetStyle would not be overwritten
509         * by a loose binding of the same specification in sourceStyle.
510         *
511         * The behavior of this should be similar to XrmMergeDatabases(db1,db2) of Xlib;
512         * in particular, resources specified in db1 should override those in db2.
513         *)
514        fun mergeStyles (STY{reqCh=rc1,ctxt=ctxt1},STY{reqCh=rc2,ctxt=ctxt2}) =
515            let
516            val repv1 = SyncVar.iVar()
517            val repv2 = SyncVar.iVar()
518            val _ = CML.send(rc1,GetDb(repv1))
519            val _ = CML.send(rc2,GetDb(repv2))
520            val (db1: db) = SyncVar.iGet repv1
521            val (db2: db) = SyncVar.iGet repv2
522            val rsrcsp1 = listRsrcSpecs db1
523            fun insRsrcSpcs ([]) = ()
524              | insRsrcSpcs (PRS.RsrcSpec{loose,path,attr,value,...}::rs) =
525                    (insertRsrcSpec (db2,{loose=loose,path=path,attr=attr,value=value});
526                    insRsrcSpcs rs)
527            in
528                (insRsrcSpcs rsrcsp1;
529                mkStyleServer(ctxt2,db2))
530            end
531    
532        (*
533        fun mergeStyles (STY{reqCh=rc1,ctxt=ctxt1},STY{reqCh=rc2,ctxt=ctxt2}) =
534            let
535            val repv1 = SyncVar.iVar()
536            val repv2 = SyncVar.iVar()
537            val _ = CML.send(rc1,GetDb(repv1))
538            val _ = CML.send(rc2,GetDb(repv2))
539            val (db1: db) = SyncVar.iGet repv1
540            val (db2: db) = SyncVar.iGet repv2
541            * insert every entry in quarktable1 into quarktable2 *
542            fun qtMerge (ht1,ht2) =
543                (List.app (fn (k,v) => (QuarkTbl.insert ht2 (k,v))) (QuarkTbl.listItemsi ht1))
544            * merge: insert all attribute values from db1 into db2 *
545            fun dbMerge (DBTBL{tight=tght1,loose=loos1,attrs=attr1},
546                         DBTBL{tight=tght2,loose=loos2,attrs=attr2}) =
547                            (qtMerge(attr1,attr2);dbMerge(tght1,tght2);dbMerge(loos1,loos2))
548            in (dbMerge(db1,db2); mkStyleServer(ctxt2,db2)) end
549        *)
550    
551        (**
552         * Parsing of command line arguments:
553         *----------------------------------
554         *)
555        (* options specified on the command line may be of two types:
556         * - a "named" option, such as "x" and "y" in "add -x 1 -y 3" where "x" and "y" are simple
557         *   arguments to the "add" program that adds them together, and where the "add" program
558         *   simply wishes to determine the value of "x" and "y", or
559         * - a "resource spec" option, such as "foreground" in "xapp -foreground black" where the
560         *   "xapp" wishes to obtain a resource specification like "*foreground: black" from these
561         *   command line arguments.
562         *)
563        (* Named options should be typically useful in obtaining input for
564         * processing by an application, as opposed to X resource specification
565         * values. For example, "-filename foo" will probably be used by an
566         * application in some process, while "-background bar" is an X resource
567         * to be used in some graphical display.
568         * For further details see eXene/styles/styles-func.sml.
569         *)
570        datatype optName
571            = OPT_NAMED of string   (* custom options: retrieve by name *)
572            | OPT_RESSPEC of string (* resource options: convert to a style *)
573    
574        type argName = string (* option spec string in argv *)
575        datatype optKind
576            = OPT_NOARG of string (* as XrmoptionNoArg. optname will assume this value if argName is specified in argv *)
577            | OPT_ISARG     (* as XrmoptionIsArg:     value is option string itself *)
578            | OPT_STICKYARG (* as XrmoptionStickyArg: value is chars immediately following option *)
579            | OPT_SEPARG    (* as XrmoptionSepArg:    value is next argument in argv *)
580            | OPT_RESARG    (* as XrmoptionResArg:    resource and value in next argument in argv *)
581            | OPT_SKIPARG   (* as XrmSkipArg:         ignore this option and next argument in argv *)
582            | OPT_SKIPLINE  (* as XrmSkipLine:        ignore this option and the rest of argv *)
583        datatype optVal
584            = OPT_ATTRVAL of (string * AV.attr_type)
585            | OPT_STRING of string
586        (* option specification table: name for searching, name in argv, kind of option, and type of option *)
587        type optSpec = (optName * argName * optKind * AV.attr_type) list
588        (* command line argument strings, with optSpec, will be converted into a optDb *)
589        type optDb = (optName * optVal) list
590    
591        (* parseCommand: optSpec -> (string list) -> (optDb * string list)
592         * parseCommand proceeds through the string list of command line arguments,
593         * adding any recognizable options from optSpec to the optDb. Any unrecognized
594         * arguments (that is, arguments not recognized as unique prefixes of an option
595         * in optSpec) are returned as a string list, along with the optDb produced.
596         * Future improvement: figure out a way for these unrecognized arguments to be
597         * somehow marked as to their position in the original argument list, in case
598         * position is important.
599         *)
600    
601        fun parseCommand (os: optSpec) [] = ([],[])
602          | parseCommand (os: optSpec) (s::sl) =
603                (let
604                fun mkOptRec (optNam,optVal:string,attrType:AV.attr_type) =
605                    (case optNam of
606                        OPT_NAMED(n) =>
607                            (optNam,OPT_ATTRVAL(optVal,attrType))
608                      | OPT_RESSPEC(n) =>
609                            (optNam,OPT_STRING(optVal)))
610                in
611                (case ((List.filter
612                        (fn (_,an,_,_) => ((String.isPrefix s an) orelse (String.isPrefix an s)))
613                        os): (optName * argName * optKind * AV.attr_type) list) of
614                    ([]:optSpec) =>
615                        (let
616                         val (od,ua) = (parseCommand (os) sl)
617                         in (od,s::ua) end)
618                  | ([(on,an,OPT_NOARG(av),at)]:optSpec) =>
619                        (let
620                         val (od,ua) = (parseCommand (os) sl)
621                         in ((mkOptRec(on,av,at))::od,ua) end)
622                  | ([(on,an,OPT_ISARG,at)]:optSpec) =>
623                        (let
624                         val (od,ua) = (parseCommand (os) sl)
625                         in ((mkOptRec(on,an,at))::od,ua) end)
626                  | ([(on,an,OPT_STICKYARG,at)]:optSpec) =>
627                        (let
628                         val la = String.size(s)
629                         val lo = String.size(an)
630                         val sv = (if la>lo then String.substring(s,(lo),(la-lo)) else "")
631                         val (od,ua) = (parseCommand (os) sl)
632                         in ((mkOptRec(on,sv,at))::od,ua) end)
633                  | ([(on,an,OPT_SEPARG,at)]:optSpec) =>
634                        (case sl of
635                            sv::svs =>
636                                (let
637                                val (od,ua) = (parseCommand (os) svs)
638                                in ((mkOptRec(on,sv,at))::od,ua) end)
639                          | [] =>
640                                (let
641                                val (od,ua) = (parseCommand (os) sl)
642                                in (od,s::ua) end))
643                  | ([(on,an,OPT_RESARG,at)]:optSpec) =>
644                        (case sl of
645                            sv::svs =>
646                                (let
647                                val (bcol::(acol::_)) = (String.tokens (fn c => (c=(#":"))) sv)
648                                val (od,ua) = (parseCommand (os) svs)
649                                in ((mkOptRec(on,sv,at))::
650                                    (OPT_RESSPEC(bcol),OPT_STRING(acol))::od,ua) end)
651                          | [] =>
652                                (let
653                                val (od,ua) = (parseCommand (os) sl)
654                                in (od,s::ua) end))
655                  | ([(on,an,OPT_SKIPARG,at)]:optSpec) =>
656                        (case sl of
657                             sv::svs =>
658                                 (let
659                                 val (od,ua) = (parseCommand (os) svs)
660                                 in (od,ua) end)
661                           | [] =>
662                                 (let
663                                 val (od,ua) = (parseCommand (os) sl)
664                                 in (od,s::ua) end))
665                  | ([(on,an,OPT_SKIPLINE,at)]:optSpec) => ([],[])
666                  (* ambiguous argument s *)
667                  | (_:optSpec) => (let
668                          val (od,ua) = (parseCommand (os) sl)
669                          in (od,s::ua) end))
670               end)
671    
672        (* findNamedOpt: optDb -> optName -> AV.attr_value list
673         * find the attribute values of the "named" command line arguments.
674         * this will return a list of _all_ arguments with the given name, with
675         * the last argument value given on the command line as the head of the
676         * list.
677         * this allows an application to process named arguments in several ways -
678         * it may wish that later arguments take precedence over earlier arguments,
679         * in which case it may use only the head of the value list (if it exists).
680         * otherwise, if the application wishes to obtain all of the argument values,
681         * it may do this also (by working with the whole list).
682    
683         OPT_ATTRVAL(AV.cvtString ctxt (optVal,attrType))
684         *)
685        fun findNamedOpt od (OPT_NAMED(on)) ctxt =
686            let
687            fun filt (OPT_NAMED(n),v) = (n=on)
688              | filt (_,_) = false
689            in
690                (List.rev
691                    (List.map (fn (n,v) =>
692                        (case v of OPT_ATTRVAL(v,t) =>
693                            (AV.cvtString ctxt (v,t)) | _ => AV.AV_NoValue))
694                    (List.filter filt od)))
695            end
696          | findNamedOpt od (OPT_RESSPEC(on)) ctxt = []
697    
698        fun findNamedOptStrings od (OPT_NAMED(on)) =
699            let
700            fun filt (OPT_NAMED(n),v) = (n=on)
701              | filt (_,_) = false
702            in
703                (List.rev
704                    (List.map (fn (n,v) =>
705                        (case v of OPT_ATTRVAL(v,t) => v | _ => ""))
706                    (List.filter filt od)))
707            end
708          | findNamedOptStrings od (OPT_RESSPEC(on)) = []
709    
710        (* styleFromOptDb: create a style from resource specifications in optDb.
711         *)
712        fun styleFromOptDb (ctxt,od) =
713            let
714            fun filt (OPT_RESSPEC(n),v) = true
715              | filt (_,_) = false
716            fun rovToStr(OPT_RESSPEC(n),OPT_STRING(v)) = (n^":"^v)
717              | rovToStr(_,_) = ""
718            val strLst = List.map (rovToStr) (List.filter filt od)
719            in
720                styleFromStrings(ctxt,strLst)
721            end
722    
723        (* a utility function that returns a string outlining the valid command
724         * line arguments in optSpec. *)
725        fun helpStrFromOptSpec (os:optSpec) =
726            let
727            val argLst = (List.map (fn (_,ar,_,_) => ar:string) os)
728            val hlpStr = ("["^(String.concatWith "|" argLst)^"]")
729            in ("Valid options:\n"^hlpStr^"\n") end
730    
731    (* end additions by ddeboer. *)
732    
733    end; (* Styles *)    end; (* Styles *)

Legend:
Removed from v.1910  
changed lines
  Added in v.1911

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