"Fossies" - the Fresh Open Source Software Archive

Member "Pansophica-src-1.3/BAF_modules/tcl/src/a_fram.tcl" (4 Feb 2008, 1868 Bytes) of package /linux/www/old/Pansophica-src-1.3-1.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Tcl/Tk source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "a_fram.tcl" see the Fossies "Dox" file reference documentation.

    1 # Pansophica, An intelligent, virtual-reality, web search agent
    2 # Copyright (C) MMVIII, NeuralVR Technologies Ltd.
    3 # 
    4 # This program is free software: you can redistribute it and/or modify
    5 # it under the terms of the GNU General Public License as published by
    6 # the Free Software Foundation, either version 3 of the License, or
    7 # (at your option) any later version.
    8 # 
    9 # This program is distributed in the hope that it will be useful,
   10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
   11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   12 # GNU General Public License for more details.
   13 # 
   14 # You should have received a copy of the GNU General Public License
   15 # along with this program.  If not, see http://www.gnu.org/licenses/.
   16 
   17 # MODULE: a_fram.tcl
   18 # $Id: a_fram.tcl,v 1.4 2008/02/04 04:21:22 dean Exp $
   19 
   20 # SYNOPSIS
   21 # Routines handy in management of windows and dialogs
   22 
   23 # HISTORY
   24 # $Log: a_fram.tcl,v $
   25 # Revision 1.4  2008/02/04 04:21:22  dean
   26 # updated to GPL
   27 #
   28 # Revision 1.3  2003/10/22 03:55:18  dean
   29 # updated copyrighting licensing
   30 #
   31 # Revision 1.2  2003/05/07 20:35:24  dean
   32 # purged visible NeuralVR references
   33 #
   34 # Revision 1.1  1999/08/26 18:59:28  dean
   35 # initial import of v1 interface beginnings
   36 #
   37 
   38 #
   39 # creates a standard frame type
   40 #
   41 proc a_framNew { path class {width none} {height none} } {
   42 
   43     # if the window exists, then raise it
   44     if { [winfo exists $path] } then {
   45     return -code error "frame already exists"
   46     }
   47 
   48     switch -exact -- $class {
   49     Transparent {
   50     }
   51     default {
   52             return -code error "un-implemented frame class"
   53     }
   54     }
   55 
   56     # caller packs
   57     return $path
   58 }
   59 
   60 #
   61 # a new plate-type window
   62 #
   63 proc a_framPack { path parent } {
   64 
   65     set class [$path:cmd cget -class]
   66 
   67     switch -exact -- $class {
   68     Transparent {
   69     }
   70     default {
   71             return -code error "un-implemented frame class"
   72     }
   73     }
   74 
   75 }
   76 
   77 
   78 
   79 
   80 
   81 
   82