Open Mash Cross Reference
mash/tcl/nsdr/ui-apps.tcl

   # ui-apps.tcl --
   #
   #       UserApplication is a base class used for deciding what programs may be
   #       launched from the Nsdr session directory tool.
   #
   # Copyright (c) 1997-2002 The Regents of the University of California.
   # All rights reserved.
   #
   # Redistribution and use in source and binary forms, with or without
  # modification, are permitted provided that the following conditions are met:
  #
  # A. Redistributions of source code must retain the above copyright notice,
  #    this list of conditions and the following disclaimer.
  # B. Redistributions in binary form must reproduce the above copyright notice,
  #    this list of conditions and the following disclaimer in the documentation
  #    and/or other materials provided with the distribution.
  # C. Neither the names of the copyright holders nor the names of its
  #    contributors may be used to endorse or promote products derived from this
  #    software without specific prior written permission.
  #
  # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
  # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  # ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
  # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
  # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
  # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  
  
  # UserApplication is a base class used for deciding what programs
  # may be launched from the Nsdr session directory tool.  It's
  # purpose it similar to that of Sdr plugins, but is much more
  # general at the cost of added complexity.<p>
  #
  # For every class that is derived from UserApplication, one object
  # is instantiated.  Then, for every program that is received, the
  # <i>match</i> method is invoked on each message in turn.  This
  # method should return a list of commands (suitable for passing to
  # the tcl <i>exec</i> procedure) that might be run for this program.
  # Typical applications will return a list with 0 or 1 elements
  # (e.g., a class to match a video tool would return a single command
  # for a session with a video stream and nothing for a session
  # without a video stream).  Lists are used for tools that might be
  # run multiple times (with different arguments) on a single stream
  # (e.g., a media independent recording tool or monitoring tool).<p>
  #
  # Simple defaults for various mash tools are in the file
  # <a href=tcl/nsdr/user-apps.tcl.html>tcl/nsdr/user-apps.tcl</a>.
  # Individual users can define new applications without modifying
  # nsdr by putting them in a file ~/.nsdr/apps.tcl or some other
  # file indicated with the -a command line argument to nsdr.
  #
  # The UserApplication class is also queried when a new session is
  # created to determine various options that should be offered
  # (e.g., valid media types, formats, etc...).  When building a
  # UserApplication subclass, you should also add calls to the
  # <i>register_media</i>, <i>register_formats</i>,
  # <i>register_protos</i>, and <i>register_attrs</i> methods so
  # that appropriate options will be available for new sessions.
  # See below for further documentation on these methods.
  Class UserApplication
  
  # Called at startup, instantiates one object of each class derived
  # from the UserApplication base class.
  UserApplication proc init_apps {} {
      # source app files
      set files [concat [$self get_option appFiles] \
                 [$self get_option extraAppFiles]]
      foreach f $files {
          catch {source $f}
      }
  
      $self set instances_ {}
      foreach a [$self info subclass] {
          new $a
      }
  }
  
  #
  UserApplication public init {} {
      $class instvar instances_
      lappend instances_ $self
  
      #FIXME
      UserApplication set mega_rport_ 10004
  }
  
  # Invokes the <i>match</i> method on every object that was created,
  # collects and returns a list of all possible commands that are
  # generated.
  UserApplication proc get_apps {prog} {
      set apps {}
      foreach app [$self set instances_] {
          if [catch {set cmds [$app match $prog]} m] {
              puts stderr "warning: app match failed for [$app info class]: $m"
              continue
         }
         set apps [concat $apps $cmds]
     }
     return $apps
 }
 
 # Overridden in every derived class to return a short name for the
 # application that is being matched.
 UserApplication private name {} {
     $self warn "in UserApplication::name"
     return "unknown app"
 }
 
 # See the description of the UserApplication class above.  Should
 # be overridden in every derived class.
 UserApplication private match {prog} {
     $self warn "in UserApplication::match"
     return ""
 }
 
 
 UserApplication set media_ {}
 
 # Make the media type <i>m</i> available as an option when creating
 # new sessions.
 UserApplication proc register_media {m} {
     $self instvar media_
     if {[lsearch -exact $media_ $m] == -1} {
         lappend media_ $m
     }
 }
 
 # Returns a list of all media types that have been registered.
 UserApplication proc media {} {
     $self instvar media_
     return $media_
 }
 
 # Make all the arguments following <i>media</i> available as
 # potential formats for streams of type <i>media</i> when
 # creating new sessions.
 UserApplication proc register_formats {media args} {
     $self instvar formats_
 
     if ![info exists formats_($media)] {
         set formats_($media) {}
     }
 
     foreach fmt $args {
         if {[lsearch -exact $formats_($media) $fmt ] == -1} {
             lappend formats_($media) $fmt
         }
     }
 }
 
 # Returns a list of all formats registered for media type <i>media</i>.
 UserApplication proc formats {media} {
     $self instvar formats_
     if ![info exists formats_($media)] { return "" }
     return $formats_($media)
 }
 
 #
 UserApplication proc register_protos {media args} {
         $self instvar protos_
         if ![info exists protos_($media)] {
                 set protos_($media) {}
         }
 
         foreach proto $args {
                 if {[lsearch -exact $protos_($media) $proto] == -1} {
                         lappend protos_($media) $proto
                 }
         }
 }
 
 UserApplication proc protos {media} {
         $self instvar protos_
         if ![info exists protos_($media)] { return "" }
         return $protos_($media)
 }
 
 # All arguments following <i>media</i> are potential attributes
 # that may be set on streams of type <i>media</i>.   Each
 # attribute should be a list consisting of the attribute name
 # and the default value (e.g., {scuba 1000}).
 UserApplication proc register_attrs {media args} {
     #FIXME could make this arbitrarily complex.  what is correct?
     $self instvar attrs_
     if ![info exists attrs_($media)] {
         set attrs_($media) {}
     }
 
     foreach attr $args {
         if {[lsearch -exact $attrs_($media) $attr ] == -1} {
             lappend attrs_($media) $attr
         }
     }
 }
 
 # Returns a list of all attributes registered for media type <i>media</i>
 UserApplication proc attrs {media} {
     $self instvar attrs_
     if ![info exists attrs_($media)] { return "" }
     return $attrs_($media)
 }