Index: openacs-4/packages/xotcl-core/tcl/10-recreation-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/10-recreation-procs.tcl,v diff -u -r1.13.2.3 -r1.13.2.4 --- openacs-4/packages/xotcl-core/tcl/10-recreation-procs.tcl 5 Oct 2019 13:19:20 -0000 1.13.2.3 +++ openacs-4/packages/xotcl-core/tcl/10-recreation-procs.tcl 26 Aug 2020 18:50:43 -0000 1.13.2.4 @@ -1,14 +1,14 @@ ::xo::library doc { XOTcl functionality for handling recreation of objects - + Support for the recreation of classes objects without destroying foreign references. Normally, when a class definition is reloaded, the class is destroyed and created again with the same name. During the destruction of a class several references to this class are removed (e.g. in a class hierarchy, the relation from instances to this class, etc.). - XOTcl provides support for altering this behavior through + XOTcl provides support for altering this behavior through the recreate method. @author Gustaf Neumann (neumann@wu-wien.ac.at) @@ -19,21 +19,21 @@ if {![::xotcl::Object isclass ::xotcl::RecreationClass]} { ::xotcl::Class create ::xotcl::RecreationClass -ad_doc {

This meta-class controls the behavior of classes (and optionally - their instances), when the classes (or their instances) are + their instances), when the classes (or their instances) are overwritten by same named new objects; we call this situation a recreate of an object.

- +

Normally, when files with e.g. class definitions are sourced, - the classes and objects are newly defined. When e.g. class - definitions exists already in this file, these classes are - deleted first before they are newly created. When a class is - deleted, the instances of this class are changed into + the classes and objects are newly defined. When e.g. class + definitions exists already in this file, these classes are + deleted first before they are newly created. When a class is + deleted, the instances of this class are changed into instances of class ::xotcl::Object.

-

This can be a problem when the class instances are not +

This can be a problem when the class instances are not reloaded and when they should survife the redefinition with the - same class relationships. Therefore, we define a - meta class RecreationClass, which can be used to parameterize + same class relationships. Therefore, we define a + meta class RecreationClass, which can be used to parameterize the behavior on redefinitions. Alternatively, Classes or objects could provide their own recreate methods.

@@ -76,7 +76,7 @@ } if {[info exists :instreinit]} { #:log "### instreinit for $obj <$args>" - $obj init + $obj init #:log "### instproc recreate $obj + init ..." } } -proc recreate {obj args} { @@ -97,19 +97,19 @@ } ::Serializer exportObjects { - ::xotcl::RecreationClass + ::xotcl::RecreationClass } } set version [package require XOTcl] if {[string match "1.3.*" $version]} { - Class ad_proc recreate {obj args} { - The re-definition of recreate makes reloading of class definitions via - apm possible, since the foreign keys of the class relations + Class ad_proc recreate {obj args} { + The re-definition of recreate makes reloading of class definitions via + apm possible, since the foreign keys of the class relations to these classes survive these calls. One can define specialized versions of this for certain classes or use ::xotcl::RecreationClass. - Class proc recreate is called on the class level, while + Class proc recreate is called on the class level, while Class instproc recreate is called on the instance level. @param obj name of the object to be recreated @@ -122,13 +122,13 @@ $obj instfilter set {} next ; # clean next on object level } - Class ad_instproc recreate {obj args} { - The re-definition of recreate makes reloading of class definitions via - apm possible, since the foreign keys of the class relations + Class ad_instproc recreate {obj args} { + The re-definition of recreate makes reloading of class definitions via + apm possible, since the foreign keys of the class relations to these classes survive these calls. One can define specialized versions of this for certain classes or use ::xotcl::RecreationClass. - Class proc recreate is called on the class level, while + Class proc recreate is called on the class level, while Class instproc recreate is called on the instance level. @param obj name of the object to be recreated @@ -138,7 +138,7 @@ #:log "+++ instproc recreate $obj <$args> old class = [$obj info class], new class = [self]" $obj filter set {} $obj mixin set {} - set cl [self] + set cl [self] foreach p [$obj info commands] {$obj proc $p {} {}} foreach c [$obj info children] { :log "recreate destroy <$c destroy" @@ -148,7 +148,7 @@ $obj unset $var } # set p new values - $obj class $cl + $obj class $cl $obj set_instance_vars_defaults # we use uplevel to handle -volatile correctly @@ -159,7 +159,7 @@ } } - #::xotcl::Object instforward unset -objscope + #::xotcl::Object instforward unset -objscope # ::xotcl::Object instforward unset ::Serializer exportMethods { ::xotcl::Class instproc recreate @@ -170,9 +170,9 @@ ns_log notice "-- softrecreate" ::xotcl::configure softrecreate true - Class create RR -instproc recreate args { + Class create RR -instproc recreate args { :log "-- [self args]"; next - } -instproc create args { + } -instproc create args { :log "-- [self args]"; next } #::xotcl::Class instmixin RR Index: openacs-4/packages/xotcl-core/tcl/20-Ordered-Composite-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/20-Ordered-Composite-procs.tcl,v diff -u -r1.27.2.6 -r1.27.2.7 --- openacs-4/packages/xotcl-core/tcl/20-Ordered-Composite-procs.tcl 26 Aug 2020 18:13:19 -0000 1.27.2.6 +++ openacs-4/packages/xotcl-core/tcl/20-Ordered-Composite-procs.tcl 26 Aug 2020 18:50:43 -0000 1.27.2.7 @@ -1,7 +1,7 @@ ::xo::library doc { Handling ordered Composites - + ::xo::OrderedComposite to create tree structures with aggregated objects. This is similar to object aggregations, but preserves the order. The OrderedComposite supports @@ -13,7 +13,7 @@ } namespace eval ::xo { - Class create OrderedComposite + Class create OrderedComposite OrderedComposite instproc show {} { next @@ -70,7 +70,7 @@ set :__children [lreplace ${:__children} $p $p] $obj destroy } - + OrderedComposite instproc last_child {} { lindex ${:__children} end } @@ -88,7 +88,7 @@ # destroy all children of the ordered composite if {[info exists :__children]} { #:log "--W destroying children ${:__children}" - foreach c ${:__children} { + foreach c ${:__children} { if {[nsf::is object $c]} {$c destroy} } } @@ -103,15 +103,15 @@ if {"[self class]::ChildManager" ni $m} { set insert 1 Object instmixin add [self class]::ChildManager - } else { + } else { set insert 0 } # [self class]::ChildManager instvar composite # push the active composite lappend composite [self] set errorOccurred 0 - # check, if we have Tcl's apply available + # check, if we have Tcl's apply available if {[info procs ::apply] eq ""} { set applyCmd [list ::apply [list {} $cmds [self]]] } else { @@ -166,7 +166,7 @@ } if {$errorOccurred} {error $errorMsg} } - } + } Class create OrderedComposite::ChildManager -instproc init args { set r [next] @@ -220,7 +220,7 @@ } elseif {$xh > $yh} { return 1 } else { - incr xp + incr xp incr yp #puts "rest [string range $x $xp end] [string range $y $yp end]" return [:__value_compare [string range $x $xp end] [string range $y $yp end] $def] Index: openacs-4/packages/xotcl-core/tcl/cluster-init.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/cluster-init.tcl,v diff -u -r1.5 -r1.5.2.1 --- openacs-4/packages/xotcl-core/tcl/cluster-init.tcl 7 Aug 2017 23:48:30 -0000 1.5 +++ openacs-4/packages/xotcl-core/tcl/cluster-init.tcl 26 Aug 2020 18:50:43 -0000 1.5.2.1 @@ -1,38 +1,38 @@ if {[server_cluster_enabled_p]} { set my_ip [ns_config ns/server/[ns_info server]/module/nssock Address] set my_port [ns_config ns/server/[ns_info server]/module/nssock port] - + foreach host [server_cluster_all_hosts] { set port 80 regexp {^(.*):(.*)} $host _ host port if {"$host-$port" eq "$my_ip-$my_port"} continue ::xo::Cluster create CS_${host}_$port -host $host -port $port } - + foreach ip [parameter::get -package_id [ad_acs_kernel_id] -parameter ClusterAuthorizedIP] { if {[string first * $ip] > -1} { ::xo::Cluster lappend allowed_host_patterns $ip } else { ::xo::Cluster set allowed_host($ip) 1 } } - + set url [::xo::Cluster set url] # Check, if the filter url mirrors a site node. If so, # the cluster mechanism will not work, if the site node # requires a login. Clustering will only work if the # root node is freely accessible. - array set node [site_node::get -url $url] + array set node [site_node::get -url $url] if {$node(url) ne "/"} { ns_log notice "***\n*** WARNING: there appears a package mounted on\ $url\n***Cluster configuration will not work\ since there is a conflict with the AOLserver filter with the same name!\n" } - + #ns_register_filter trace GET $url ::xo::Cluster - ns_register_filter preauth GET $url ::xo::Cluster + ns_register_filter preauth GET $url ::xo::Cluster #ad_register_filter -priority 900 preauth GET $url ::xo::Cluster } Index: openacs-4/packages/xotcl-core/tcl/cluster-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/cluster-procs.tcl,v diff -u -r1.13 -r1.13.2.1 --- openacs-4/packages/xotcl-core/tcl/cluster-procs.tcl 25 Mar 2018 22:13:40 -0000 1.13 +++ openacs-4/packages/xotcl-core/tcl/cluster-procs.tcl 26 Aug 2020 18:50:43 -0000 1.13.2.1 @@ -23,19 +23,19 @@ Class create Cluster -parameter {host {port 80}} Cluster set allowed_host_patterns [list] - Cluster set url /xotcl-cluster-do + Cluster set url /xotcl-cluster-do Cluster array set allowed_host { "127.0.0.1" 1 } - # - # The allowed commands are of the form - # - command names followed by + # + # The allowed commands are of the form + # - command names followed by # - optional "except patterns" # Cluster array set allowed_command { - set "" - unset "" - nsv_set "" + set "" + unset "" + nsv_set "" nsv_unset "" nsv_incr "" bgdelivery "" @@ -44,7 +44,7 @@ xo::cache_flush_all "" } # - # Prevent unwanted object generations for unknown + # Prevent unwanted object generations for unknown # arguments of ::xo::Cluster. # Cluster proc unknown args { @@ -120,7 +120,7 @@ } } Cluster instproc message args { - :log "--cluster outgoing request to [:host]:[:port] // $args" + :log "--cluster outgoing request to [:host]:[:port] // $args" # set r [::xo::HttpRequest new -volatile \ # -host [:host] -port [:port] \ # -path [Cluster set url]?cmd=[ns_urlencode $args]] @@ -129,7 +129,7 @@ set r [::xo::AsyncHttpRequest new -volatile \ -host [:host] -port [:port] \ -path [Cluster set url]?cmd=[ns_urlencode $args]] - + # ::bgdelivery do ::xo::AsyncHttpRequest new \ # -host [:host] -port [:port] \ # -path [Cluster set url]?cmd=[ns_urlencode $args] \ Index: openacs-4/packages/xotcl-core/tcl/http-client-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/http-client-procs.tcl,v diff -u -r1.40.2.6 -r1.40.2.7 --- openacs-4/packages/xotcl-core/tcl/http-client-procs.tcl 6 Aug 2020 12:57:37 -0000 1.40.2.6 +++ openacs-4/packages/xotcl-core/tcl/http-client-procs.tcl 26 Aug 2020 18:50:43 -0000 1.40.2.7 @@ -1,6 +1,6 @@ xo::library doc { - - XOTcl implementation for synchronous and asynchronous + + XOTcl implementation for synchronous and asynchronous HTTP and HTTPS requests @author Gustaf Neumann, Stefan Sobernig @@ -42,15 +42,15 @@ # set r [::xo::HttpRequest new -url http://www.openacs.org/] # # The resulting object $r contains all information - # about the requests, such as e.g. status_code or + # about the requests, such as e.g. status_code or # data (the response body from the server). For details - # look into the output of [$r serialize]. The result + # look into the output of [$r serialize]. The result # object $r is automatically deleted at cleanup of # a connection thread. # # Example of a POST request with a form with var1 and var2 # (providing post_data causes the POST request). - # + # # set r [::xo::HttpRequest new \ # -url http://yourhost.yourdomain/yourpath \ # -post_data [export_vars {var1 var2}] \ @@ -71,26 +71,26 @@ # tclthread <= 2.6.5. At the time of this writing, there was no # post-2.6.5 release of tclthread, hence, you are required to obtain a # CVS snapshot, dating at least 2008-05-23. E.g.: - # + # # cvs -z3 -d:pserver:anonymous@tcl.cvs.sourceforge.net:/cvsroot/tcl co \ # -D 20080523 -d thread2.6.5~20080523 thread # # Provided that the Tcl module tls (see e.g. http://tls.sourceforge.net/) - # is available and can be loaded via "package require tls" into - # the aolserver, you can use both TLS/SSL secured or unsecured requests + # is available and can be loaded via "package require tls" into + # the aolserver, you can use both TLS/SSL secured or unsecured requests # in the synchronous/ asynchronous mode by using an # https url. - # + # # set r [::xo::HttpRequest new -url https://learn.wu-wien.ac.at/] # ###################### # # 2 AsyncHttpRequest # # AsyncHttpRequest is a subclass for HttpCore implementing - # asynchronous HTTP requests without vwait (vwait causes - # stalls on aolserver). AsyncHttpRequest requires to provide a listener - # or callback object that will be notified upon success or failure of + # asynchronous HTTP requests without vwait (vwait causes + # stalls on aolserver). AsyncHttpRequest requires to provide a listener + # or callback object that will be notified upon success or failure of # the request. # # Asynchronous requests are much more complex to handle, since @@ -121,22 +121,22 @@ # 3 HttpRequestTrace # # HttpRequestTrace can be used to trace one or all requests. - # If activated, the class writes protocol data into + # If activated, the class writes protocol data into # [ad_tmpdir]/req-. # - # Use + # Use # # ::xo::HttpCore instmixin add ::xo::HttpRequestTrace # - # to activate trace for all requests, + # to activate trace for all requests, # or mixin the class into a single request to trace it. # Class create HttpCore \ -slots { Attribute create host - Attribute create protocol -default "http" - Attribute create port + Attribute create protocol -default "http" + Attribute create port Attribute create path -default "/" Attribute create url Attribute create method @@ -157,7 +157,7 @@ HttpCore instproc parse_url {} { :instvar protocol url host port path if {[regexp {^(http|https)://([^/]+)(/.*)?$} $url _ protocol host path]} { - # Be friendly and allow strictly speaking invalid URLs + # Be friendly and allow strictly speaking invalid URLs # like "http://www.openacs.org" (no trailing slash) if {$path eq ""} {set path /} :set_default_port $protocol @@ -173,7 +173,7 @@ } HttpCore instproc get_channel_settings { - {-text_translation {auto binary}} + {-text_translation {auto binary}} content_type } { # @@ -195,7 +195,7 @@ # set content_type [string tolower $content_type] set trl [expr {[string match "text/*" $content_type] ? $text_translation : "binary"}] - + # # 3. In the following, an IANA/MIME charset resolution scheme is # implemented which is compliant with RFC 3023 which deals with @@ -207,12 +207,12 @@ # helper proc does not consider RFC 3023 at all. In the future, # RFC 3023 support should enter a revised [ns_encodingfortype], # for now, we fork. - # + # # The mappings between Tcl encoding names (as shown by [encoding # names]) and IANA/MIME charset names (i.e., names and aliases in # the sense of http://www.iana.org/assignments/character-sets) is # provided by ... - # + # # i. A static, built-in correspondence map: see nsd/encoding.c # ii. An extensible correspondence map (i.e., the ns/charsets # section in config.tcl). @@ -261,32 +261,32 @@ # = "binary"). This requires the client of the *HttpRequest* to # treat the data accordingly. # - + set enc "" if {[regexp {^text/.*$|^.*/xml.*$|^.*\+xml.*$} $content_type]} { # Case (A): Check for an explicitly provided charset parameter if {[regexp {;\s*charset\s*=([^;]*)} $content_type _ charset]} { set enc [ns_encodingforcharset [string trim $charset]] - } + } # Case (B.1) if {$enc eq "" && [regexp {^text/xml.*$|text/.*\+xml.*$} $content_type]} { set enc [ns_encodingforcharset us-ascii] - } + } # Case (B.3) if {$enc eq "" && [string match "text/*" $content_type]} { set enc [ns_encodingforcharset iso-8859-1] - } + } } # Cases (C) and (B.2) are covered by the [expr] below. return [list encoding [expr {$enc eq ""?"binary":$enc}] translation $trl] } - + HttpCore instproc init {} { :instvar S post_data host port protocol :destroy_on_cleanup @@ -310,7 +310,7 @@ error "https request require the Tcl module TLS to be installed\n\ See e.g. http://tls.sourceforge.net/" } - # + # # Add HTTPs handling # :mixin add ::xo::Tls @@ -437,7 +437,7 @@ } HttpCore instproc reply_header_done {} { :instvar S - # we have received the header, including potentially the + # we have received the header, including potentially the # content_type of the returned data array set "" [:get_channel_settings [:content_type]] fconfigure $S -translation $(translation) -encoding $(encoding) @@ -485,9 +485,9 @@ # create a cond and mutex set cond [thread::cond create] set mutex [thread::mutex create] - + thread::mutex lock $mutex - + # start the asynchronous request :debug "--a create new ::xo::AsyncHttpRequest" set req [bgdelivery do -async ::xo::AsyncHttpRequest new \ @@ -516,7 +516,7 @@ if {$status eq "JOB_COMPLETED"} { set :data $status_value } else { - set msg "Timeout-constraint, blocking HTTP request failed. Reason: '$status'" + set msg "Timeout-constraint, blocking HTTP request failed. Reason: '$status'" if {$status_value ne ""} { append msg " ($status_value)" } @@ -538,7 +538,7 @@ } } } - + # # Asynchronous (nonblocking) requests # @@ -626,12 +626,12 @@ AsyncHttpRequest instproc reply_first_line_done {} { :set_timeout :instvar S - fileevent $S readable [list [self] header] + fileevent $S readable [list [self] header] } AsyncHttpRequest instproc reply_header_done {} { :instvar S :set_timeout - # we have received the header, including potentially the + # we have received the header, including potentially the # content_type of the returned data array set "" [:get_channel_settings [:content_type]] fconfigure $S -translation $(translation) -encoding $(encoding) @@ -653,7 +653,7 @@ # # SimpleListener defines a mixin class for providing a stub - # implementation for callbacks of the asynchrous HTTP requests. + # implementation for callbacks of the asynchrous HTTP requests. # This class is typically run in the scope of bgdelivery # @@ -697,7 +697,7 @@ :log "[self proc] [self args]" :log "UNKNOWN $method" } - + # Mixin class, used to turn instances of # AsyncHttpRequest into result callbacks # in the scope of bgdelivery, realising @@ -714,7 +714,7 @@ # If a job was canceled, the status variable might not exist # anymore, the condition might be already gone as well. In # this case, we do not have to perform the cond-notify. - if {[:exists_status $condition] && + if {[:exists_status $condition] && [:get_status $condition] eq "COND_WAIT_REFRESH"} { } if {[:exists_status $condition] && @@ -731,12 +731,12 @@ } -instproc set_cond_timeout {} { :instvar condition - if {[:exists_status $condition] && + if {[:exists_status $condition] && [:get_status $condition] eq "COND_WAIT_TIMEOUT"} { :set_status $condition COND_WAIT_REFRESH catch {thread::cond notify $condition} } - + } -instproc start_request {payload obj} { :debug "JOB start request $obj" :set_cond_timeout @@ -754,17 +754,17 @@ :set_cond_timeout } - - # + + # # TLS/SSL support # # Perform HTTPS requests via TLS (does not require nsopenssl) # - requires tls 1.5.0 to be compiled into /lib/ ... - # - - - - - - - - - - - - - - - - - - + # - - - - - - - - - - - - - - - - - - # - see http://www.ietf.org/rfc/rfc2246.txt # - http://wp.netscape.com/eng/ssl3/3-SPEC.HTM - # - - - - - - - - - - - - - - - - - - - + # - - - - - - - - - - - - - - - - - - + Class create Tls Tls instproc open_connection {} { :instvar S @@ -777,27 +777,27 @@ # ::tls::import $S } - + # # Trace Requests - # + # - Class create HttpRequestTrace + Class create HttpRequestTrace nsv_set HttpRequestTrace count 0 HttpRequestTrace instproc init {} { :instvar F post_data set :meta [list] set :requestCount [nsv_incr HttpRequestTrace count] ;# make it an instvar to find it in the log file set F [open [ad_tmpdir]/req-[format %.4d ${:requestCount}] w] - + set method [expr {$post_data eq "" ? "GET" : "POST"}] puts $F "$method [:path] HTTP/1.0" puts $F "Host: [:host]" puts $F "User-Agent: [:user_agent]" foreach {tag value} [:request_header_fields] { puts $F "$tag: $value" } - next + next } HttpRequestTrace instproc POST {} { @@ -818,11 +818,11 @@ catch {close ${:F}} next } - + # # To activate trace for all requests, uncomment the following line. # To trace a single request, mixin ::xo::HttpRequestTrace into the request. - # + # # HttpCore instmixin add ::xo::HttpRequestTrace } Index: openacs-4/packages/xotcl-core/tcl/install-check-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/install-check-procs.tcl,v diff -u -r1.6.2.2 -r1.6.2.3 --- openacs-4/packages/xotcl-core/tcl/install-check-procs.tcl 14 Jul 2020 19:43:09 -0000 1.6.2.2 +++ openacs-4/packages/xotcl-core/tcl/install-check-procs.tcl 26 Aug 2020 18:50:43 -0000 1.6.2.3 @@ -1,9 +1,9 @@ namespace eval ::xotcl-core { ad_proc -private ::xotcl-core::before-install {} { - + Callback for checking whether xotcl is installed for OpenACS - + @author Gustaf Neumann (neumann@wu-wien.ac.at) } { ns_log notice "-- before-install callback" @@ -17,14 +17,14 @@ ns_log notice "XOTcl $::xotcl::version$::xotcl::patchlevel is installed on your system." } } - + ad_proc -private ::xotcl-core::after-upgrade { {-from_version_name:required} {-to_version_name:required} } { - + Callback for upgrading - + @author Gustaf Neumann (neumann@wu-wien.ac.at) } { ns_log notice "-- UPGRADE $from_version_name -> $to_version_name" @@ -34,9 +34,9 @@ ns_log notice "-- upgrading to $v" set dir [acs_package_root_dir xotcl-core] foreach file { - tcl/05-doc-procs.tcl + tcl/05-doc-procs.tcl tcl/10-recreation-procs.tcl-old - tcl/thread_mod-procs.tcl + tcl/thread_mod-procs.tcl } { if {[ad_file exists $dir/$file]} { ns_log notice "Deleting obsolete file $dir/$file" Index: openacs-4/packages/xotcl-core/tcl/test/xotcl-avail-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/test/xotcl-avail-procs.tcl,v diff -u -r1.8 -r1.8.2.1 --- openacs-4/packages/xotcl-core/tcl/test/xotcl-avail-procs.tcl 22 Jul 2018 08:07:53 -0000 1.8 +++ openacs-4/packages/xotcl-core/tcl/test/xotcl-avail-procs.tcl 26 Aug 2020 18:50:43 -0000 1.8.2.1 @@ -30,7 +30,7 @@ } else { ? {set x new} new "ns_cache version seems sufficiently up to date" } - + ? {expr {[::xotcl::Object info methods serialize] ne ""}} 1 "Serialize method available" set errorMsg "" @@ -39,7 +39,7 @@ } else { aa_true "Serializer avalilable" 1 } - + } # Local variables: # mode: tcl Index: openacs-4/packages/xotcl-core/tcl/test/xotcl-core-db-tutorial-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/test/Attic/xotcl-core-db-tutorial-procs.tcl,v diff -u -r1.1.2.4 -r1.1.2.5 --- openacs-4/packages/xotcl-core/tcl/test/xotcl-core-db-tutorial-procs.tcl 25 May 2020 18:52:44 -0000 1.1.2.4 +++ openacs-4/packages/xotcl-core/tcl/test/xotcl-core-db-tutorial-procs.tcl 26 Aug 2020 18:50:43 -0000 1.1.2.5 @@ -10,7 +10,7 @@ aa_run_with_teardown -rollback -test_code { # - # 1) Create new ACS Objects, destroy it in memory, + # 1) Create new ACS Objects, destroy it in memory, # load it from the database, delete it in the database. # @@ -46,7 +46,7 @@ ############################################################ # - # 2) Create new ACS Object Types, ACS Attributes and + # 2) Create new ACS Object Types, ACS Attributes and # SQL Tables from XOTcl Classes with slot definitions. # # Create a new ACS Object type and an XOTcl class named ::demo::Person. @@ -74,14 +74,14 @@ aa_equals "the SQL attributes are slot names" \ [lsort [::demo::Person array names db_slot]] \ {age name person_id projects} - + # # Create a new instance of ::demo::Person with name 'Gustaf' # # The method 'new_persistent_object' of a database class (instance of ::xo::db::Class) - # creates an ACS Object with a fresh id in the database and + # creates an ACS Object with a fresh id in the database and # creates as well an XOTcl object in memory - + set p [::demo::Person new_persistent_object -name Gustaf -age 105] aa_true "'$p' looks like a valid object name" [regexp {^::\d+$} $p] @@ -114,10 +114,10 @@ # which has a few more attributes. Again, we define an XOTcl class # ::demo::Employee which creates the ACS Object Type, the ACS # attributes and the table, if necessary. - + aa_false "Does the ACS Object type ::demo::Employee exist in the database" \ [::xo::db::Class object_type_exists_in_db -object_type ::demo::Employee] - + set cl [::xo::db::Class create ::demo::Employee \ -superclass ::demo::Person \ -table_name demo_employee \ @@ -159,7 +159,7 @@ [lsort [$cl array names db_slot]] \ {email party_id url} - + set cl [::xo::db::Class get_class_from_db -object_type person] aa_equals "fetched class is named ::xo::db::person" "::xo::db::person" $cl @@ -180,7 +180,7 @@ aa_run_with_teardown -rollback -test_code { ############################################################ - # 4) Create new application classes by sub-typing the + # 4) Create new application classes by sub-typing the # Content Repository, adding additional attributes # # We create a subclass of ::xo::db::CrItem called ::demo::Page @@ -226,8 +226,8 @@ # Fetch item per item_id from the database set o [::demo::Page get_instance_from_db -item_id $item_id] aa_true "the fetched object ($o) has the same item_id as before ($item_id)" {[$o item_id] eq $item_id} - - aa_log "o: 
[$o serialize]
" + + aa_log "o: 
[$o serialize]
" set creator [$o creator] aa_true "the fetched creator is $creator" {$creator == "GN"} Index: openacs-4/packages/xotcl-core/www/index.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/www/index.tcl,v diff -u -r1.10 -r1.10.2.1 --- openacs-4/packages/xotcl-core/www/index.tcl 11 Aug 2017 08:15:24 -0000 1.10 +++ openacs-4/packages/xotcl-core/www/index.tcl 26 Aug 2020 18:50:43 -0000 1.10.2.1 @@ -66,7 +66,7 @@ if {!$all_classes && ([string match "::xotcl::*" $cl] || [string match "::nx::*" $cl])} { continue } - + append output "
  • [::xo::api object_link {} $cl]
      " append output [info_classes $cl superclass] @@ -81,7 +81,7 @@ if {$infos ne ""} { append output "
    • $key: $infos
      • \n" } - + } set infos "" Index: openacs-4/packages/xotcl-core/www/show-class-graph.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/www/show-class-graph.tcl,v diff -u -r1.12.2.2 -r1.12.2.3 --- openacs-4/packages/xotcl-core/www/show-class-graph.tcl 8 Aug 2020 08:08:20 -0000 1.12.2.2 +++ openacs-4/packages/xotcl-core/www/show-class-graph.tcl 26 Aug 2020 18:50:43 -0000 1.12.2.3 @@ -1,6 +1,6 @@ ad_page_contract { Show an XOTcl class or object - + @author Gustaf Neumann @cvs-id $Id$ } -query { @@ -20,7 +20,7 @@ # final resort for cases, where ::util::which is not available if {$dot eq "" && [file executable /usr/bin/dot]} {set dot /usr/bin/dot} if {$dot eq ""} {ns_return 404 plain/text "dot not found"; ad_script_abort} - + set tmpnam [ad_tmpnam] set tmpfile $tmpnam.$format set f [open $tmpnam.$format w]; puts $f $dot_code; close $f Index: openacs-4/packages/xotcl-core/www/version-numbers.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/www/version-numbers.tcl,v diff -u -r1.2 -r1.2.2.1 --- openacs-4/packages/xotcl-core/www/version-numbers.tcl 7 Aug 2017 23:48:30 -0000 1.2 +++ openacs-4/packages/xotcl-core/www/version-numbers.tcl 26 Aug 2020 18:50:43 -0000 1.2.2.1 @@ -1,6 +1,6 @@ ad_page_contract { View version numbers of XOTcl and related packages -} { +} { } -properties { title:onevalue context:onevalue Index: openacs-4/packages/xowf/tcl/test-item-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowf/tcl/test-item-procs.tcl,v diff -u -r1.7.2.75 -r1.7.2.76 --- openacs-4/packages/xowf/tcl/test-item-procs.tcl 14 Aug 2020 08:09:08 -0000 1.7.2.75 +++ openacs-4/packages/xowf/tcl/test-item-procs.tcl 26 Aug 2020 18:51:40 -0000 1.7.2.76 @@ -5,6 +5,8 @@ } :::xo::db::require package xowiki +::xo::library require -package xowiki menu-procs +::xo::library require -package xowiki form-field-procs namespace eval ::xowiki::formfield { ########################################################### @@ -1486,12 +1488,12 @@ ######################################################################## :public method last_time_in_state {revision_sets -state:required -with_until:switch } { # - # Loops through revision sets and retrieve the latest date - # where state is that specified. + # Loops through revision sets and retrieves the latest date + # where state is equal the specified value. # # @param revision_sets a list of ns_sets containing revision # data. List is assumed to be sorted in descending - # creation_date order + # creation_date order (as retrieved by get_revision_sets) # # @return a date # @@ -2890,7 +2892,41 @@ } } +namespace eval ::xowiki { + ::xowiki::MenuBar instproc config=test-items { + {-bind_vars {}} + -current_page:required + -package_id:required + -folder_link:required + -return_url + } { + :config=default \ + -bind_vars $bind_vars \ + -current_page $current_page \ + -package_id $package_id \ + -folder_link $folder_link \ + -return_url $return_url + return { + {clear_menu -menu New} + + {entry -name New.Item.TextInteraction -form en:edit-interaction.wf -query p.item_type=Text} + {entry -name New.Item.ShortTextInteraction -form en:edit-interaction.wf -query p.item_type=ShortText} + {entry -name New.Item.SCInteraction -form en:edit-interaction.wf -query p.item_type=SC} + {entry -name New.Item.MCInteraction -form en:edit-interaction.wf -query p.item_type=MC} + {entry -name New.Item.ReorderInteraction -form en:edit-interaction.wf -query p.item_type=Reorder} + {entry -name New.Item.UploadInteraction -form en:edit-interaction.wf -query p.item_type=Upload} + + {entry -name New.App.OnlineExam -form en:online-exam.wf} + {entry -name New.App.InclassQuiz -form en:inclass-quiz.wf} + {entry -name New.App.InclassExam -form en:inclass-exam.wf} + } + } +} + + + + namespace eval ::xowf::test_item { # # Copy the default policy (policy1) from xowiki and add elements for Index: openacs-4/packages/xowf/tcl/xowf-includelet-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowf/tcl/xowf-includelet-procs.tcl,v diff -u -r1.4.2.3 -r1.4.2.4 --- openacs-4/packages/xowf/tcl/xowf-includelet-procs.tcl 4 Aug 2020 16:16:17 -0000 1.4.2.3 +++ openacs-4/packages/xowf/tcl/xowf-includelet-procs.tcl 26 Aug 2020 18:51:40 -0000 1.4.2.4 @@ -170,10 +170,10 @@ {-target_time ""} {-url_poll ""} {-url_dismiss ""} - {-poll_interval 5000} + {-poll_interval 5000} }} } -ad_doc { - + This is the top includelet for the in-class exam, containing a countdown timer and the personal notifications includelet