xotcl.wu-wien.ac.at
Begin main content
Methods: Source: Variables:
[All Methods | Documented Methods | Hide Methods] [Display Source | Hide Source] [Show Variables | Hide Variables]

::xo::db::CrClass[i] ::xowiki::Page

Class Hierarchy of ::xowiki::Page

  • ::xotcl::Object[i]
    Meta-class:
    ::xotcl::Class[i]
    Methods for instances:
    __api_make_doc, __api_make_forward_doc, __timediff, abstract, ad_doc, ad_forward, ad_proc, appendC, arrayC, asHTML, autonameC, check, classC, cleanupC, configureC, containsC, copyC, db_0or1rowC, db_1rowC, debug, defaultmethodC, destroyC, destroy_on_cleanup, ds, evalC, existsC, extractConfigureArg, filterC, filterguardC, filtersearch, forward, hasclass, incrC, infoC, init, instvarC, invarC, isclass, ismetaclass, ismixin, isobject, istype, lappendC, log, method, mixinC, mixinguardC, moveC, msg, noinitC, objectparameter, parametercmdC, proc, procsearch, qn, requireNamespaceC, residualargsC, self, serialize, setC, set_instance_vars_defaults, show-object, substC, traceC, unknown, unsetC, uplevelC, upvarC, volatileC, vwait
    Methods to be applied on the class (in addition to the methods provided by the meta-class):
    getExitHandler, setExitHandler, unsetExitHandler
    • ::xo::db::Object[i]
      Meta-class:
      ::xo::db::Class[i]
      Methods for instances:
      db_1row, delete, initialize_loaded_object, insert, object_idC, object_titleC, save, save_new
      Methods to be applied on the class:
      Methods provided by the meta-class
      • ::xo::db::CrItem[i]
        Meta-class:
        ::xo::db::CrClass[i]
        Parameter for instances:
        package_id, parent_id (default "-100"), publish_status (default "ready")
        Methods for instances:
        current_user_id, delete, descriptionC, fix_content, initialize_loaded_object, item_idC, mime_typeC, nameC, nls_languageC, privilege=creator, publish_dateC, rename, revision_idC, revisions, save, save_new, set_live_revision, textC, titleC, update_attribute_from_slot, update_content, update_revision
        Methods to be applied on the class:
        Methods provided by the meta-class
        • ::xowiki::Page[i]
          Meta-class:
          ::xo::db::CrClass[i]
          Parameter for instances:
          absolute_links (default "0"), do_substitutions (default "1"), render_adp (default "1")
          Methods for instances:
          adp_subst, anchor, build_instance_attribute_map, build_name, category_export, category_import, check_adp_include_path, clipboard-add, clipboard-clear, clipboard-content, clipboard-copy, clipboard-export, condition=match, condition=regexp, copy_content_vars, create-new, create-or-use, create_form_field, create_form_fields, create_form_fields_from_form_constraints, create_form_page_instance, create_link, create_raw_form_field, creation_userC, creatorC, css_class_name, csv-dump, default_instance_attributes, delete, delete-revision, demarshall, descriptionC, detail_link, diff, div, edit, edit_set_default_values, edit_set_file_selector_folder, error_during_render, error_in_includelet, exists_form_parameterC, exists_query_parameterC, field_names, find_slot, footer, form_field_index, form_parameterC, get_anchor_and_query, get_content, get_description, get_folder, get_form_data, get_html_from_content, get_instance_attributes, get_nls_language_from_lang, get_property_from_link_page, get_rich_text_spec, get_target_from_link_page, htmlFooter, include, include_content, initialize_loaded_object, instantiate_includelet, is_folder_page, is_form, is_link_page, is_new_entry, item_refC, lang, last_modifiedC, list, lookup_cached_form_field, lookup_form_field, make-live-revision, map_categories, map_party, marshall, mime_typeC, mutual_overwrite_occurred, nameC, new_link, nls_languageC, normalize_internal_link_name, page_idC, page_orderC, physical_package_id, physical_parent_id, popular-tags, pretty_link, pretty_name, publish_dateC, query_parameterC, record_last_visited, references_update, regsub_eval, render, render_content, render_icon, render_includelet, reset_resolve_context, resolve_included_page_name, reverse_map_party, reverse_map_party_attribute, revisions, save, save-attributes, save-tags, save_data, save_new, search_render, set_content, set_resolve_context, show_fields, substitute_markup, textC, titleC, translate, unescape, unset_temporary_instance_variables, validate-attribute, validate=form_constraints, validate=name, validate=page_order, view
          Methods to be applied on the class (in addition to the methods provided by the meta-class):
          container_already_rendered, find_slot, get_tags, import, quoted_html_content, save_tags

Class Relations

  • superclass: ::xo::db::CrItem[i]
  • subclass: ::xowiki::File[i], ::xowiki::PageInstance[i], ::xowiki::PageTemplate[i], ::xowiki::PlainPage[i]
::xo::db::CrClass create ::xowiki::Page \
     -superclass ::xo::db::CrItem \
     -parameter {{absolute_links 0} {do_substitutions 1} {render_adp 1}}

Methods

  • proc container_already_rendered

    ::1382845 proc container_already_rendered field {
        if {![info exists ::xowiki_page_item_id_rendered]} {
          return ""
        }
        #my log "--OMIT and not $field in ([join $::xowiki_page_item_id_rendered ,])"
        return "and not $field in ([join $::xowiki_page_item_id_rendered ,])"
      }
    
  • proc find_slot

    ::1382845 proc find_slot {-start_class:required name} {
        foreach cl [concat $start_class [$start_class info heritage]] {
          set slotobj ${cl}::slot::$name
          if {[my isobject $slotobj]} {
            #my msg $slotobj
            return $slotobj
          }
        }
        return ""
      }
    
  • proc get_tags

    ::1382845 proc get_tags {-package_id:required -item_id -user_id} {
        if {[info exists item_id]} {
          if {[info exists user_id]} {
            # tags for item and user
            set tags [::xo::db_list get_tags {
    	  SELECT distinct tag from xowiki_tags 
    	  where user_id = :user_id and item_id = :item_id and package_id = :package_id
    	}]
          } else {
            # all tags for this item 
            set tags [::xo::db_list get_tags {
    	  SELECT distinct tag from xowiki_tags 
    	  where item_id = :item_id and package_id = :package_id
    	}]
          }
        } else {
          if {[info exists user_id]} {
            # all tags for this user
            set tags [::xo::db_list get_tags {
    	  SELECT distinct tag from xowiki_tags 
    	  where user_id = :user_id and package_id :package_id
    	}]
          } else {
            # all tags for the package
            set tags [::xo::db_list get_tags {
    	  SELECT distinct tag from xowiki_tags 
    	  where package_id = :package_id
    	}]
          }
        }
        join $tags " "
      }
    
  • proc import

    ::1382845 proc import {-user_id -package_id -folder_id {-replace 0} -objects} {
        my log "DEPRECATED"
        if {![info exists package_id]}  {set package_id  [::xo::cc package_id]}
        set cmd  [list $package_id import -replace $replace]
        
        if {[info exists user_id]}   {lappend cmd -user_id $user_id}
        if {[info exists objects]}   {lappend cmd -objects $objects}
        eval $cmd
      }
    
  • proc quoted_html_content

    ::1382845 proc quoted_html_content text {
        list [ad_text_to_html $text] text/html
      }
    
  • proc save_tags

    ::1382845 proc save_tags {-package_id:required -item_id:required -revision_id:required -user_id:required tags} {
        db_dml [my qn delete_tags]  "delete from xowiki_tags where item_id = $item_id and user_id = $user_id"
    
        foreach tag [split $tags " ,;"] {
          if {$tag ne ""} {
    	db_dml [my qn insert_tag]  "insert into xowiki_tags (item_id,package_id, user_id, tag, time)  values ($item_id, $package_id, $user_id, :tag, current_timestamp)"
          }
        }
        search::queue -object_id $revision_id -event UPDATE
      }
    
  • instproc adp_subst

    ::1382845 instproc adp_subst content {
        #
        # The provided content and the returned result are strings
        # containing HTML.
        #
        #my msg "--adp_subst in [my name] vars=[my info vars]"
        set __ignorelist [list RE __defaults name_method object_type_key db_slot]
        foreach __v [my info vars] {
          if {[info exists $__v]} continue
          my instvar $__v
        }
        foreach __v [[my info class] info vars] {
          if {$__v in $__ignorelist} continue
          if {[info exists $__v]} continue
          [my info class] instvar $__v
        }
        set __ignorelist [list __v __vars __l __ignorelist __varlist  __last_includelet __unresolved_references  text item_id content lang_links]
    
        # set variables current_* to ease personalization
        set current_user [::xo::cc set untrusted_user_id]
        set current_url [::xo::cc url]
    
        set __vars [info vars]
        regsub -all [template::adp_variable_regexp] $content {\1@\2;noquote@} content_noquote
        #my log "--adp before adp_eval '[template::adp_level]'"
        #
        # The adp buffer has limited size. For large pages, it might happen
        # that the buffer overflows. In Aolserver 4.5, we can increase the
        # buffer size. In 4.0.10, we are out of luck.
        #
        set __l [string length $content]
        if {[catch {set __bufsize [ns_adp_ctl bufsize]}]} {
          set __bufsize 0
        }
        if {$__bufsize > 0 && $__l > $__bufsize} {
          # we have aolserver 4.5, we can increase the bufsize
          ns_adp_ctl bufsize [expr {$__l + 1024}]
        }
        set template_code [template::adp_compile -string $content_noquote]
        set my_parse_level [template::adp_level]
        if {[catch {set template_value [template::adp_eval template_code]} __errMsg]} {
          #
          # Something went wrong during substitution; prepare a
          # user-friendly error message containing a listing of the
          # available variables.
          #
          # compute list of possible variables
          set __varlist [list]
          set __template_variables__ "<ul>\n"
          foreach __v [lsort $__vars] {
            if {[array exists $__v]} continue ;# don't report  arrays
            if {$__v in $__ignorelist} continue
            lappend __varlist $__v
            append __template_variables__ "<li><b>$__v:</b> '[set $__v]'\n"
          }
          append __template_variables__ "</ul>\n"
          set ::template::parse_level $my_parse_level 
          #my log "--adp after adp_eval '[template::adp_level]' mpl=$my_parse_level"
          return "<div class='errorMsg'>Error in Page $name: $__errMsg</div>$content<p>Possible values are$__template_variables__"
        }
        return $template_value
      }
    
  • instproc anchor

    ::1382845 instproc anchor arg {
        if {[catch {set l [my create_link [my unescape $arg]]} errorMsg]} {
          return "<div class='errorMsg'>Error during processing of anchor ${arg}:<blockquote>$errorMsg</blockquote></div>"
        }
        if {$l eq ""} {return ""}
        set html [$l render]
        $l destroy
        return $html
      }
    
  • instproc build_instance_attribute_map

    ::1382845 instproc build_instance_attribute_map form_fields {
        #
        # Build the data structure for mapping internal values (IDs) into
        # string representations and vice versa. In particular, it builds
        # and maintains the __instance_attribute_map, which is an
        # associative list (attribute/value pairs) for form-field attributes.
        #
        #foreach f $form_fields {lappend fns [list [$f name] [$f info class]]}
        #my msg "page [my name] build_instance_attribute_map $fns"
        if {[my exists  __instance_attribute_map]} {
          array set cm [my set __instance_attribute_map]
        }
        foreach f $form_fields {
          set multiple [expr {[$f exists multiple] ? [$f set multiple] : 0}]
          #my msg "$f [$f name] cat_tree [$f exists category_tree] is fc: [$f exists is_category_field]"
          if {[$f exists category_tree] && [$f exists is_category_field]} {
            #my msg "page [my name] field [$f name] is a category_id from [$f category_tree]"
            set cm([$f name]) [list category [$f category_tree] $multiple]
            my category_export [$f category_tree]
          } elseif {[$f exists is_party_id]} {
            #my msg "page [my name] field [$f name] is a party_id"
            set cm([$f name]) [list party_id $multiple]
          }
        }
        if {[array exists cm]} {
          my set __instance_attribute_map [array get cm]
        }
      }
    
  • instproc build_name

    ::1382845 instproc build_name {{-nls_language ""}} {
        #
        # Build the name of the page, based on the provided nls_language
        # This method strips existing language-prefixes and uses the
        # provided nls_language or the instance variable for the new name.
        # It handles as well anonymous pages, which are never equipped
        # with language prefixes. ::xowiki::File has its own method.
        #
        set name [my name]
        set stripped_name $name
        regexp {^..:(.*)$} $name _ stripped_name
    
        #my msg "$name / '$stripped_name'"
        # prepend the language prefix only, if the entry is not empty
        if {$stripped_name ne ""} {
          if {[my is_folder_page] || [my is_link_page]} {
            #
            # Do not add a language prefix to folder pages
            #
            set name $stripped_name
          } else {
            if {$nls_language ne ""} {my nls_language $nls_language}
            set name [my lang]:$stripped_name
          }
        }
        return $name
      }
    
  • instproc category_export

    ::1382845 instproc category_export tree_name {
        #
        # Build a command to rebuild the category tree on imports
        # (__map_command). In addition this method builds and maintains a
        # category map, which maps internal IDs into symbolic values
        # (__category_map).
        #
        # Ignore locale in get_id for now, since it seems broken    
        set tree_ids [::xowiki::Category get_mapped_trees -object_id [my package_id]  -names [list $tree_name] -output tree_id]
        # Make sure to have only one tree_id, in case multiple trees are
        # mapped with the same name.
        set tree_id [lindex $tree_ids 0]
        array set data [category_tree::get_data $tree_id]
        set categories [list]
        if {[my exists __category_map]} {array set cm [my set __category_map]}
        foreach category [::xowiki::Category get_category_infos -tree_id $tree_id] {
          foreach {category_id category_name deprecated_p level} $category break
          lappend categories $level $category_name
          set names($level) $category_name
          set node_name $tree_name
          for {set l 1} {$l <= $level} {incr l} {append node_name /$names($l)}
          set cm($category_id) $node_name
        }
        set cmd [list my category_import  -name $tree_name -description $data(description)  -locale [lang::system::site_wide_locale]  -categories $categories]
        if {![my exists __map_command] || [string first $cmd [my set __map_command]] == -1} {
          my append __map_command \n $cmd
        }
        my set __category_map [array get cm]
        #my log "cmd=$cmd"
      }
    
  • instproc category_import

    ::1382845 instproc category_import {-name -description -locale -categories} {
        # Execute the category import for every tree name only once per request
        set key ::__xowiki_category_import($name)
        if {[info exists $key]} return
    
        # ok, it is the first request
        #my msg "... catetegoy_import [self args]"
    
        # Do we have a tree with the specified named mapped?
        set tree_ids [::xowiki::Category get_mapped_trees -object_id [my package_id] -locale $locale  -names [list $name] -output tree_id]
        set tree_id [lindex $tree_ids 0]; # handle multiple mapped trees with same name
        if {$tree_id eq ""} {
          # The tree is not mapped, we import the category tree
          my log "...importing category tree $name"
          set tree_id [category_tree::import -name $name -description $description  -locale $locale -categories $categories]
          category_tree::map -tree_id $tree_id -object_id [my package_id]
        }
    
        #
        # build reverse category_map
        foreach category [::xowiki::Category get_category_infos -tree_id $tree_id] {
          foreach {category_id category_name deprecated_p level} $category break
          lappend categories $level $category_name
          set names($level) $category_name
          set node_name $name
          for {set l 1} {$l <= $level} {incr l} {append node_name /$names($l)}
          set ::__xowiki_reverse_category_map($node_name) $category_id
        }
        #my msg "... catetegoy_import reverse map [array names ::__xowiki_reverse_category_map]"
        # mark the tree with this name as already imported
        set $key 1
      }
    
  • instproc check_adp_include_path

    ::1382845 instproc check_adp_include_path adp_fn {
        #
        # For security reasons, don't allow arbitrary paths to different
        # packages.  All allowed includelets must be made available
        # under xowiki/www (preferable xowiki/www/portlets/*). If the
        # provided path contains a admin/* admin rights are required.
        #
        if {[string match "admin/*" $adp_fn]} {
          set allowed [::xo::cc permission  -object_id [my package_id] -privilege admin  -party_id [::xo::cc user_id]]
          if {!$allowed} {
    	return [list allowed $allowed msg "Page can only be included by an admin!" fn ""]
          }
        }
        if {[string match "/*" $adp_fn] || [string match "../*" $adp_fn]} {
          # Never allow absolute paths.
          #
          # Alternatively, we could allow url-based includes, and then using
          # set node [site_node::get -url [ad_conn url]]
          # permission::require_permission -object_id $node(object_id) -privilege read
          # ... or admin/* based checks like in rp.
          #
          return [list allowed 0 msg "Invalid name for adp_include" fn ""]
        }
        return [list allowed 1 msg "" fn /packages/[[my package_id] package_key]/www/$adp_fn]
      }
    
  • instproc clipboard-add

    ::1382845 instproc clipboard-add {} {
        my instvar package_id
    
        if {![my exists_form_parameter "objects"]} {
          my msg "nothing to copy"
        }
        set ids [list]
        foreach page_name [my form_parameter objects] {
          # the page_name is the name exactly as stored in the content repository
          set item_id [::xo::db::CrClass lookup -name $page_name -parent_id [my item_id]]
          if {$item_id == 0} {
    	# when the pasted item was from a child-resources includelet
    	# included on e.g. a plain page. we look for a sibling.
    	set item_id [::xo::db::CrClass lookup -name $page_name -parent_id [my parent_id]]
          }
          #my msg "want to copy $page_name // $item_id"
          if {$item_id ne 0} {lappend ids $item_id}
        }
        ::xowiki::clipboard add $ids
        ::$package_id returnredirect [my query_parameter "return_url" [::xo::cc url]]
      }
    
  • instproc clipboard-clear

    ::1382845 instproc clipboard-clear {} {
        my instvar package_id
        ::xowiki::clipboard clear
        ::$package_id returnredirect [my query_parameter "return_url" [::xo::cc url]]
      }
    
  • instproc clipboard-content

    ::1382845 instproc clipboard-content {} {
        my instvar package_id
        set clipboard [::xowiki::clipboard get]
        if {$clipboard eq ""} {
          util_user_message -message "Clipboard empty"
        } else {
          foreach item_id $clipboard {
    	if {[::xo::db::CrClass get_instance_from_db -item_id $item_id] ne ""} {
    	  util_user_message -message [$item_id pretty_link]
    	} else {
    	  util_user_message -message "item $item_id deleted"
    	}
          }
        }
        ::$package_id returnredirect [my query_parameter "return_url" [::xo::cc url]]
      }
    
  • instproc clipboard-copy

    ::1382845 instproc clipboard-copy {} {
        my instvar package_id
        set clipboard [::xowiki::clipboard get]
        set item_ids [::xowiki::exporter include_needed_objects $clipboard]
        set content [::xowiki::exporter marshall_all $item_ids]
        if {[catch {namespace eval ::xo::import $content} error]} {
          my msg "Error: $error\n$::errorInfo"
          return
        }
        set msg [$package_id import -replace 0 -create_user_ids 1  -parent_id [my item_id] -objects $item_ids]
        util_user_message -html -message $msg
        ::xowiki::clipboard clear
        ::$package_id returnredirect [my query_parameter "return_url" [::xo::cc url]]
      }
    
  • instproc clipboard-export

    ::1382845 instproc clipboard-export {} {
        my instvar package_id
        set clipboard [::xowiki::clipboard get]
        ::xowiki::exporter export $clipboard
        ns_conn close
        ::xowiki::clipboard clear
        #::$package_id returnredirect [my query_parameter "return_url" [::xo::cc url]]
      }
    
  • instproc condition=match

    ::1382845 instproc condition=match {query_context value} {
        #
        # Conditon for conditional checks in policy rules
        # The match condition is called with an attribute 
        # name and a pattern like in
        #
        #  edit {
        #     {{match {name {*weblog}}} package_id admin} 
        #     {package_id write}
        #  }
        #
        # This example specifies that for a page named
        # *weblog, the method "edit" is only allowed
        # for package admins.
        #
        #my msg "query_context='$query_context', value='$value'"
        if {[llength $value] != 2} {
          error "two arguments for match required, [llength $value] passed (arguments='$value')"
        }
        if {[catch {
          set success [string match [lindex $value 1] [my set [lindex $value 0]]]
        } errorMsg]} {
          my log "error during match: $errorMsg"
          set success 0
        }
        return $success
      }
    
  • instproc condition=regexp

    ::1382845 instproc condition=regexp {query_context value} {
        #
        # Conditon for conditional checks in policy rules
        # The match condition is called with an attribute 
        # name and a pattern like in
        #
        #  edit               {
        #    {{regexp {name {(weblog|index)$}}} package_id admin} 
        #    {package_id write}
        #  }
        #
        # This example specifies that for a page ending with
        # weblog or index, the method "edit" is only allowed
        # for package admins.
        #
        #my msg "query_context='$query_context', value='$value'"
        if {[llength $value] != 2} {
          error "two arguments for regexp required, [llength $value] passed (arguments='$value')"
        }
        if {[catch {
          set success [regexp [lindex $value 1] [my set [lindex $value 0]]]
        } errorMsg]} {
          my log "error during regexp: $errorMsg"
          set success 0
        }
        return $success
      }
    
  • instproc copy_content_vars

    ::1382845 instproc copy_content_vars -from_object:required {
        array set excluded_var {
          folder_id 1 package_id 1 absolute_links 1 lang_links 1 modifying_user 1
          publish_status 1 item_id 1 revision_id 1 last_modified 1
        }
        foreach var [$from_object info vars] {
          # don't copy vars starting with "__"
          if {[string match "__*" $var]} continue
          if {![info exists excluded_var($var)]} {
            my set $var [$from_object set $var]
          }
        }
      }
    
  • instproc create-new

    ::1382845 instproc create-new {{-parent_id 0} {-view_method edit} {-name ""} {-nls_language ""}} {
        my instvar package_id
        set original_package_id $package_id
    
        if {[my exists_query_parameter "package_instance"]} {
          set package_instance [my query_parameter "package_instance"]
          #
          # Initialize the target package and set the variable package_id.
          #
          if {[catch {
            ::xowiki::Package initialize  -url $package_instance -user_id [::xo::cc user_id]  -actual_query ""
          } errorMsg]} {
            ns_log error "$errorMsg\n$::errorInfo"
            return [$original_package_id error_msg  "Page <b>'[my name]'</b> invalid provided package instance=$package_instance<p>$errorMsg</p>"]
          }
        }
    
        #
        # collect some default values from query parameters
        #
        set default_variables [list]
        foreach key {name title page_order last_page_id nls_language} {
          if {[my exists_query_parameter $key]} {
            lappend default_variables $key [my query_parameter $key]
          }
        }
    
        # TODO: the following calls are here temporarily for posting
        # content from manually added forms (e.g. linear forum). The
        # following should be done:
        #  - create an includelet to create the form markup automatically
        #  - validate and transform input as usual
        # We should probably allow as well controlling autonaming and
        # setting of publish_status, and probhibit empty postings.
    
        set text_to_html [my form_parameter "__text_to_html" ""]
        foreach key {_text _name} {
          if {[my exists_form_parameter $key]} {
            set __value [my form_parameter $key]
            if {[lsearch $text_to_html $key] > -1} {
              set __value [ad_text_to_html $__value]
            }
            lappend default_variables [string range $key 1 end] $__value
            switch $key {
              _name {set name $__value}
            }
          }
        }
    
        # load the instance attributes from the form parameters
        set instance_attributes [list]
        foreach {_att _value} [::xo::cc get_all_form_parameter] {
          if {[string match _* $_att]} continue
          lappend instance_attributes $_att $_value
        }
    
        #
        # To create form_pages in different places than the form, one can
        # provide provide parent_id and package_id.
        #
        # The following construct is more complex than necessary to
        # provide backward compatibility. Note that the passed-in
        # parent_id has priority over the other measures to obtain it.
        #
        if {$parent_id == 0} {
          if {![my exists parent_id]} {my parent_id [$package_id folder_id]}
          set fp_parent_id [my form_parameter "parent_id" [my query_parameter "parent_id" [my parent_id]]]
        } else {
          set fp_parent_id $parent_id
        }
        # In case the Form is inherited and package_id was not specified, we
        # use the actual package_id.
        set fp_package_id [my form_parameter "package_id" [my query_parameter "package_id" [my package_id]]]
    
        ::xo::Package require $fp_package_id
        set f [my create_form_page_instance  -name $name  -nls_language $nls_language  -parent_id $fp_parent_id  -package_id $fp_package_id  -default_variables $default_variables  -instance_attributes $instance_attributes  -source_item_id [my query_parameter source_item_id ""]]
    
        if {$name eq ""} {
          $f save_new
        } else {
          set id [$fp_package_id lookup -parent_id $fp_parent_id -name $name]
          if {$id == 0} {
            $f save_new
          } else {
            ::xowiki::FormPage get_instance_from_db -item_id $id
            $f copy_content_vars -from_object $id
            $f item_id $id
            $f save
          }
        }
    
        foreach var {return_url template_file title detail_link text} {
          if {[my exists_query_parameter $var]} {
            set $var [my query_parameter $var]
          }
        }
    
        set form_redirect [my form_parameter "__form_redirect" ""]
        if {$form_redirect eq ""} {
          set form_redirect [export_vars -base [$f pretty_link]  [list [list m $view_method] return_url template_file title detail_link text]]
        }
        $package_id returnredirect $form_redirect
        set package_id $original_package_id
      }
    
  • instproc create-or-use

    ::1382845 instproc create-or-use {{-parent_id 0} {-view_method edit} {-name ""} {-nls_language ""}} {
        # can be overloaded
        my create-new  -parent_id $parent_id -view_method $view_method  -name $name -nls_language $nls_language
      }
    
  • instproc create_form_field

    ::1382845 instproc create_form_field {{-cr_field_spec ""} {-field_spec ""} field_name} {
        switch -glob -- $field_name {
          __* {}
          _* {
            set varname [string range $field_name 1 end]
            return [my create_raw_form_field -name $field_name  -spec $cr_field_spec  -slot [my find_slot $varname]]
          }
          default {
            return [my create_raw_form_field -name $field_name  -spec $field_spec  -slot [my find_slot $field_name]]
          }
        }
      }
    
  • instproc create_form_fields

    ::1382845 instproc create_form_fields field_names {
        set form_fields [my create_category_fields]
        foreach att $field_names {
          if {[string match "__*" $att]} continue
          lappend form_fields [my create_form_field $att]
        }
        return $form_fields
      }
    
  • instproc create_form_fields_from_form_constraints

    ::1382845 instproc create_form_fields_from_form_constraints form_constraints {
        #
        # Create form-fields from form constraints.
        # Since create_raw_form_field uses destroy_on_cleanup, we do not
        # have to care here about destroying the objects.
        #
        set form_fields [list]
        foreach name_and_spec $form_constraints {
          regexp {^([^:]+):(.*)$} $name_and_spec _ spec_name short_spec
          if {[string match "@table*" $spec_name] || $spec_name eq "@categories"} continue
          
          #my msg "checking spec '$short_spec' for form field '$spec_name'"
          lappend form_fields [my create_raw_form_field  -name $spec_name  -slot [my find_slot $spec_name]  -spec $short_spec]
        }
        return $form_fields
      }
    
  • instproc create_form_page_instance

    ::1382845 instproc create_form_page_instance {-name:required -package_id -parent_id {-text ""} {-instance_attributes ""} {-default_variables ""} {-nls_language ""} {-creation_user ""} {-publish_status production} {-source_item_id ""}} {
        set ia [my default_instance_attributes]
        foreach {att value} $instance_attributes {lappend ia $att $value}
    
        if {$nls_language eq ""} {
          set nls_language [my query_parameter nls_language [my nls_language]]
        }
        if {![info exists package_id]} { set package_id [my package_id] }
        if {![info exists parent_id]}  { set parent_id [my parent_id] }
        if {$creation_user eq ""} {
          set creation_user [[$package_id context] user_id]
        }
        
        set f [FormPage new -destroy_on_cleanup  -name $name  -text $text  -package_id $package_id  -parent_id $parent_id  -nls_language $nls_language  -publish_status $publish_status  -creation_user $creation_user  -instance_attributes $ia  -page_template [my item_id]]
    
        if {[my exists state]} {
          $f set state [my set state]
        }
    
        # Make sure to load the instance attributes
        $f array set __ia [$f instance_attributes]
    
        # Call the application specific initialization, when a FormPage is
        # initially created. This is used to control the life-cycle of
        # FormPages.
        $f initialize
    
        #
        # if we copy an item, we use source_item_id to provide defaults
        #
        if {$source_item_id ne ""} {
          set source [FormPage get_instance_from_db -item_id $source_item_id]
          $f copy_content_vars -from_object $source
          set name "[::xowiki::autoname new -parent_id $source_item_id -name [my name]]"
          $package_id get_lang_and_name -name $name lang name
          $f set name $name
          #my msg nls=[$f nls_language],source-nls=[$source nls_language]
        }
        foreach {att value} $default_variables {
          $f set $att $value
        }
    
        # Finally provide base for auto-titles
        $f set __title_prefix [my title]
    
        return $f
      }
    
  • instproc create_link

    ::1382845 instproc create_link arg {
        #my msg [self args]
        set label $arg
        set link $arg
        set options ""
        regexp {^([^|]+)[|](.*)$} $arg _ link label
        regexp {^([^|]+)[|](.*)$} $label _ label options
        set options [my unescape $options]
    
        # Get the package_id from the provided path, and - if found -
        # return the shortened link relative to it.
        set package_id [[my package_id] resolve_package_path $link link]
        if {$package_id == 0} {
          # we treat all such links like external links
          if {[regsub {^//} $link / link]} {
            #
            # For local links (starting with //), we provide
            # a direct treatment. Javascript and CSS files are
            # included, images are rendered directly.
            #
    	switch -glob -- [::xowiki::guesstype $link] {
    	  text/css {
    	    ::xo::Page requireCSS $link
    	    return ""
    	  }
    	  application/x-javascript {
    	    ::xo::Page requireJS $link
    	    return ""
    	  }
    	  image/* {
    	    Link create [self]::link  -page [self]  -name ""  -type localimage [list -label $label]  -href $link
    	    eval [self]::link configure $options
    	    return [self]::link
    	  }
    	}
          }
          set l [ExternalLink new [list -label $label] -href $link]
          eval $l configure $options
          return $l
        }
    
        #
        # TODO missing: typed links
        #
        ## do we have a typed link? prefix has more than two chars...
        #  if {[regexp {^([^:/?][^:/?][^:/?]+):((..):)?(.+)$} $link _  # link_type _ lang  stripped_name]} {
        # set name file:$stripped_name
        #  } 
    
        array set "" [my get_anchor_and_query $link]
    
        set parent_id [expr {$package_id == [my package_id] ? 
                             [my parent_id] : [$package_id folder_id]}]
    
        # we might consider make this configurable
        set use_package_path true
    
        if {[regexp {^:(..):(.+)$} $(link) _ lang stripped_name]} {
          # language link (it starts with a ':')
          array set "" [$package_id item_ref  -use_package_path $use_package_path  -default_lang [my lang]  -parent_id $parent_id  ${lang}:$stripped_name]
          set (link_type) language
        } else {
          regsub {^[.]SELF[.]/} $(link) [my name]/ (link)
          array set "" [$package_id item_ref  -use_package_path $use_package_path  -default_lang [my lang]  -parent_id $parent_id  $(link)]
        }
        #my msg "link '$(link)' => [array get {}]"
    
        if {$label eq $arg} {set label $(link)}
        set item_name [string trimleft $(prefix):$(stripped_name) :]
        
        Link create [self]::link  -page [self] -form $(form)  -type $(link_type) [list -name $item_name] -lang $(prefix)  [list -anchor $(anchor)] [list -query $(query)]  [list -stripped_name $(stripped_name)] [list -label $label]  -parent_id $(parent_id) -item_id $(item_id) -package_id $package_id
        
        if {[catch {eval [self]::link configure $options} errorMsg]} {
          ns_log error "$errorMsg\n$::errorInfo"
          return "<div class='errorMsg'>Error during processing of options [list $options] of link of type [[self]::link info class]:<blockquote>$errorMsg</blockquote></div>"
        } else {
          return [self]::link
        }
      }
    
  • instproc create_raw_form_field

    ::1382845 instproc create_raw_form_field {-name {-slot ""} {-spec ""} {-configuration ""}} {
        set save_slot $slot
        if {$slot eq ""} {
          # We have no slot, so create a minimal slot. This should only happen for instance attributes
          set slot [::xo::Attribute new -pretty_name $name -datatype text -noinit]
          $slot destroy_on_cleanup
        }
    
        set spec_list [list]
        if {[$slot exists spec]} {lappend spec_list [$slot set spec]}
        if {$spec ne ""}         {lappend spec_list $spec}
        #my msg "[self args] spec_list $spec_list"
        #my msg "$name, spec_list = '[join $spec_list ,]'"
    
        if {[$slot exists pretty_name]} {
          set label [$slot set pretty_name]
        } else {
          set label $name
          my log "no pretty_name for variable $name in slot $slot"
        }
    
        if {[$slot exists default]} {
          #my msg "setting ff $name default = [$slot default]"
          set default [$slot default] 
        } else {
          set default ""
        }
        set f [::xowiki::formfield::FormField new -name $name  -id        [::xowiki::Includelet html_id F.[my name].$name]  -locale    [my nls_language]  -label     $label  -type      [expr {[$slot exists datatype]  ? [$slot set datatype]  : "text"}]  -help_text [expr {[$slot exists help_text] ? [$slot set help_text] : ""}]  -validator [expr {[$slot exists validator] ? [$slot set validator] : ""}]  -required  [expr {[$slot exists required]  ? [$slot set required]  : "false"}]  -default   $default  -spec      [join $spec_list ,]  -object    [self]  -slot      $save_slot  ]
    
        $f destroy_on_cleanup
        eval $f configure $configuration
        return $f
      }
    
  • instproc css_class_name

    ::1382845 instproc css_class_name {{-margin_form:boolean true}} {
        # Determine the CSS class name for xowiki forms
        #
        # We need this acually only for PageTemplate and FormPage, but
        # aliases will require XOTcl 2.0.... so we define it for the time
        # being on ::xowiki::Page
        set name [expr {$margin_form ? "margin-form " : ""}]
        set CSSname [my name]
    
        # Remove language prefix, if used.
        regexp {^..:(.*)$} $CSSname _ CSSname
    
        # Remove "file extension", since dot's in CSS class names do not
        # make much sense.
        regsub {[.].*$} $CSSname "" CSSname
        return [append name "Form-$CSSname"]
      }
    
  • instproc csv-dump

    ::1382845 instproc csv-dump {} {
        if {![my is_form]} {
          error "not called on a form"
        }
        set form_item_id [my item_id]
        set items [::xowiki::FormPage get_form_entries  -base_item_ids $form_item_id -form_fields "" -initialize false  -publish_status all -package_id [my package_id]]
        # collect all instances attributes of all items
        foreach i [$items children] {array set vars [$i set instance_attributes]}
        array set vars [list _name 1 _last_modified 1 _creation_user 1]
        set attributes [lsort -dictionary [array names vars]]
        # make sure, we the includelet honors the cvs generation
        set includelet_key name:form-usages,form_item_ids:$form_item_id,field_names:[join $attributes " "],
        ::xo::cc set queryparm(includelet_key) $includelet_key
        # call the includelet
        my view [my include [list form-usages -field_names $attributes  -extra_form_constraints _creation_user:numeric,format=%d  -form_item_id [my item_id] -generate csv]]
      }
    
  • instproc default_instance_attributes

    ::1382845 instproc default_instance_attributes {} {
        #
        # Provide the default list of instance attributes to derived
        # FormPages.
        #
        # We want to be able to create FormPages from all pages.
        # by defining this method, we allow derived applications
        # to provide their own set of instance attributes
        return [list]
      }
    
  • instproc delete

    ::1382845 instproc delete {} {
        my instvar package_id item_id name
        # delete always via package
        $package_id delete -item_id $item_id -name $name
      }
    
  • instproc delete-revision

    ::1382845 instproc delete-revision {} {
        my instvar revision_id package_id item_id 
        ::xo::db_1row get_revision {
          select latest_revision,live_revision from cr_items where item_id = :item_id
        }
        # do real deletion via package
        $package_id delete_revision -revision_id $revision_id -item_id $item_id
        # Take care about UI specific stuff....
        set redirect [my query_parameter "return_url"  [export_vars -base [$package_id url] {{m revisions}}]]
        if {$live_revision == $revision_id} {
          # latest revision might have changed by delete_revision, so we have to fetch here
          xo::db_1row [my qn get_revision] "select latest_revision from cr_items where item_id = $item_id"
          if {$latest_revision eq ""} {
            # we are out of luck, this was the final revision, delete the item
            my instvar package_id name
            $package_id delete -name $name -item_id $item_id
          } else {
            ::xo::db::sql::content_item set_live_revision -revision_id $latest_revision
          }
        }
        if {$latest_revision ne ""} {
          # otherwise, "delete" did already the redirect
          ::$package_id returnredirect [my query_parameter "return_url"  [export_vars -base [$package_id url] {{m revisions}}]]
        }
      }
    
  • instproc demarshall

    ::1382845 instproc demarshall {-parent_id -package_id -creation_user {-create_user_ids 0}} {
        # this method is the counterpart of marshall
        my set parent_id $parent_id
        my set package_id $package_id 
        my reverse_map_party_attribute -attribute creation_user   -default_party $creation_user -create_user_ids $create_user_ids
        my reverse_map_party_attribute -attribute modifying_user  -default_party $creation_user -create_user_ids $create_user_ids
        # If we import from an old database without page_order, provide a
        # default value
        if {![my exists page_order]} {my set page_order ""}
        set is_folder_page [my is_folder_page]
        #my msg "is-folder-page [my name] => $is_folder_page"
        if {$is_folder_page} {
          # reset names if necessary (e.g. import from old releases)
          my set name [my build_name]
        } else {
          # Check, if nls_language and lang are aligned.
          if {[regexp {^(..):} [my name] _ lang]} {
            if {[string range [my nls_language] 0 1] ne $lang} {
              set old_nls_language [my nls_language]
              my nls_language [my get_nls_language_from_lang $lang]
              ns_log notice "nls_language for item [my name] set from $old_nls_language to [my nls_language]"
            }
          }
        }
        # in the general case, no more actions required
        #my msg "demarshall [my name] DONE"
      }
    
  • instproc detail_link

    ::1382845 instproc detail_link {} {
        if {[my exists instance_attributes]} {
          array set __ia [my set instance_attributes]
          if {[info exists __ia(detail_link)] && $__ia(detail_link) ne ""} {
            return $__ia(detail_link)
          }
        }
        return [my pretty_link]
      }
    
  • instproc diff

    ::1382845 instproc diff {} {
        my instvar package_id
    
        set compare_id [my query_parameter "compare_revision_id" 0]
        if {$compare_id == 0} {
          return ""
        }
        ::xo::Page requireCSS /resources/xowiki/xowiki.css
        set my_page [::xowiki::Package instantiate_page_from_id -revision_id [my revision_id]]
        $my_page volatile
    
        if {[catch {set html1 [$my_page render]} errorMsg]} {
          set html2 "Error rendering [my revision_id]: $errorMsg"
        }
        set text1 [ad_html_text_convert -from text/html -to text/plain -- $html1]
        set user1 [::xo::get_user_name [$my_page set creation_user]]
        set time1 [$my_page set creation_date]
        set revision_id1 [$my_page set revision_id]
        regexp {^([^.]+)[.]} $time1 _ time1
    
        set other_page [::xowiki::Package instantiate_page_from_id -revision_id $compare_id]
        $other_page volatile
        #$other_page absolute_links 1
    
        if {[catch {set html2 [$other_page render]} errorMsg]} {
          set html2 "Error rendering $compare_id: $errorMsg"
        }
        set text2 [ad_html_text_convert -from text/html -to text/plain -- $html2]
        set user2 [::xo::get_user_name [$other_page set creation_user]]
        set time2 [$other_page set creation_date]
        set revision_id2 [$other_page set revision_id]
        regexp {^([^.]+)[.]} $time2 _ time2
    
        set title "Differences for [my set name]"
        set context [list $title]
        
        # try util::html diff if it is available and works
        if {[catch {set content [::util::html_diff -old $html2 -new $html1 -show_old_p t]}]} {
          # otherwise, fall back to proven text based diff
          set content [::xowiki::html_diff $text2 $text1]
        }
    
        ::xo::Page set_property doc title $title
        array set property_doc [::xo::Page get_property doc]
        set header_stuff [::xo::Page header_stuff]
    
        $package_id return_page -adp /packages/xowiki/www/diff -variables {
          content title context header_stuff
          time1 time2 user1 user2 revision_id1 revision_id2 property_doc
        }
      }
    
  • instproc div

    ::1382845 instproc div arg {
        if {$arg eq "content"} {
          return "<div id='content' class='column'>"
        } elseif {[string match "left-col*" $arg]  || [string match "right-col*" $arg]  || $arg eq "sidebar"} {
          return "<div id='$arg' class='column'>"
        } elseif {$arg eq "box"} {
          return "<div class='box'>"
        } elseif {$arg eq ""} {
          return "</div>"
        } else {
          return ""
        }
      }
    
  • instproc edit

    ::1382845 instproc edit {{-new:boolean false} {-autoname:boolean false} {-validation_errors ""}} {
        my instvar package_id item_id revision_id parent_id
        #my msg "--edit new=$new autoname=$autoname, valudation_errors=$validation_errors, parent=[my parent_id]"
        my edit_set_default_values
        set fs_folder_id [my edit_set_file_selector_folder]
    
        if {[$package_id exists_query_parameter "return_url"]} {
          set submit_link [my query_parameter "return_url" "."]
          set return_url $submit_link
        } else {
          # before we used "." as default submit link (resulting in a "ad_returnredirect ."). 
          # However, this does not seem to work in case we have folders in use....
          #set submit_link "."
          set submit_link [my pretty_link]
        }
        #my log "--u submit_link=$submit_link qp=[my query_parameter return_url]"
        set object_type [my info class]
    
        # We have to do template mangling here; ad_form_template writes
        # form variables into the actual parselevel, so we have to be in
        # our own level in order to access an pass these.
        variable ::template::parse_level
        lappend parse_level [info level]    
        set action_vars [expr {$new ? "{edit-new 1} object_type return_url" : "{m edit} return_url"}]
        #my log "--formclass=[$object_type getFormClass -data [self]] ot=$object_type"
    
        #
        # Determine the package_id of some mounted xowiki instance to find
        # the directory + URL, from where the scripts called from xinha
        # can be used.
        if {[$package_id info class] eq "::xowiki::Package"} {
          # The actual instance is a plain xowiki instance, we can use it
          set folder_spec [list script_dir [$package_id package_url]]
        } else {
          # The actual instance is not a plain xowiki instance, so, we try
          # to find one, where the current user has at least read
          # permissions.  This act is required for sub-packages, which
          # might not have the script dir.
          set first_instance_id [::xowiki::Package first_instance -party_id [::xo::cc user_id] -privilege read]
          if {$first_instance_id ne ""} {
            ::xowiki::Package require $first_instance_id
            set folder_spec [list script_dir [$first_instance_id package_url]]
          }
        }
    
        if {$fs_folder_id ne ""} {lappend folder_spec folder_id $fs_folder_id}
        
        [$object_type getFormClass -data [self]] create ::xowiki::f1 -volatile  -action  [export_vars -base [$package_id url] $action_vars]  -data [self]  -folderspec $folder_spec  -submit_link $submit_link  -autoname $autoname
    
        if {[info exists return_url]} {
          ::xowiki::f1 generate -export [list [list return_url $return_url]]
        } else {
          ::xowiki::f1 generate
        }
    
        ::xowiki::f1 instvar edit_form_page_title context formTemplate
        
        if {[info exists item_id]} {
          set rev_link    [$package_id make_link [self] revisions]
          set view_link   [$package_id make_link [self] view]
        }
        if {[info exists last_page_id]} {
          set back_link [$package_id url]
        }
    
        set index_link  [$package_id make_link -privilege public -link "" $package_id {} {}]
        ::xo::Page set_property doc title "[$package_id instance_name] - $edit_form_page_title"
    
        array set property_doc [::xo::Page get_property doc]
        set tmpl [acs_root_dir]/packages/[[my package_id] package_key]/www/edit
        set edit_tmpl [expr {[file readable $tmpl] ? $tmpl : "/packages/xowiki/www/edit" }]
        set html [$package_id return_page -adp $edit_tmpl  -form f1  -variables {item_id parent_id edit_form_page_title context formTemplate
                        view_link back_link rev_link index_link property_doc}]
        template::util::lpop parse_level
        #my log "--edit html length [string length $html]"
        return $html
      }
    
  • instproc edit_set_default_values

    ::1382845 instproc edit_set_default_values {} {
        my instvar package_id
        # set some default values if they are provided
        foreach key {name title page_order last_page_id nls_language} {
          if {[$package_id exists_query_parameter $key]} {
            #my log "setting [self] set $key [$package_id query_parameter $key]"
            my set $key [$package_id query_parameter $key]
          }
        }    
      }
    
  • instproc edit_set_file_selector_folder

    ::1382845 instproc edit_set_file_selector_folder {} {
        #
        # setting up folder id for file selector (use community folder if available)
        #
        if {[info commands ::dotlrn_fs::get_community_shared_folder] ne ""} {
          # ... we have dotlrn installed
          set cid [::dotlrn_community::get_community_id]
          if {$cid ne ""} {
            # ... we are inside of a community, use the community folder
            return [::dotlrn_fs::get_community_shared_folder -community_id $cid]
          }
        }
        return ""
      }
    
  • instproc error_during_render

    ::1382845 instproc error_during_render msg {
        return "<div class='errorMsg'>$msg</div>"
      }
    
  • instproc error_in_includelet

    ::1382845 instproc error_in_includelet {arg msg} {
        my instvar name
        return [my error_during_render "[_ xowiki.error_in_includelet]<br >\n$msg"]
      }
    
  • instproc field_names

    ::1382845 instproc field_names {{-form ""}} {
        array set dont_modify [list item_id 1 revision_id 1 object_id 1 object_title 1 page_id 1 name 1]
        set field_names [list]
        foreach field_name [[my info class] array names db_slot] {
          if {[info exists dont_modify($field_name)]} continue
          lappend field_names _$field_name
        }
        #my msg field_names=$field_names
        return $field_names
      }
    
  • instproc find_slot

    ::1382845 instproc find_slot {-start_class name} {
        if {![info exists start_class]} {
          set start_class [my info class]
        }
        return [::xowiki::Page find_slot -start_class $start_class $name]
      }
    
  • instproc footer

    ::1382845 instproc footer {} {
        return ""
      }
    
  • instproc form_field_index

    ::1382845 instproc form_field_index nodes {
        set marker ::__computed_form_field_names($nodes)
        if {[info exists $marker]} return
    
        foreach n $nodes {
          if {![$n istype ::xowiki::formfield::FormField]} continue
          set ::_form_field_names([$n name]) $n
          my form_field_index [$n info children]
        }
        set $marker 1
      }
    
  • instproc get_anchor_and_query

    ::1382845 instproc get_anchor_and_query link {
        #
        # strip anchor and query from link name
        #
        set anchor ""
        set query ""
        # remove anchor
        regexp {^([^#]*)(\#|%23)(.*)$} $link _ link . anchor
        # remove query part
        regexp {^(.*)[?]([^?]+)$} $link _ link query
        return [list link $link anchor $anchor query $query]
      }
    
  • instproc get_content

    ::1382845 instproc get_content {} {
        return [my render -with_footer false]
      }
    
  • instproc get_description

    ::1382845 instproc get_description {-nr_chars content} {
        my instvar revision_id
        set description [my set description]
        if {$description eq "" && $content ne ""} {
          set description [ad_html_text_convert -from text/html -to text/plain -- $content]
        }
        if {$description eq "" && $revision_id > 0} {
          set body [::xo::db_string get_description_from_syndication  "select body from syndication where object_id = $revision_id"  -default ""]
          set description [ad_html_text_convert -from text/html -to text/plain -- $body]
        }
        if {[info exists nr_chars] && [string length $description] > $nr_chars} {
          set description [string range $description 0 $nr_chars]...
        }
        return $description
      }
    
  • instproc get_folder

    ::1382845 instproc get_folder -folder_form_ids:required {
        set page [self]
        while {1} {
          if {[$page istype ::xowiki::FormPage]} {
    	if {[$page is_folder_page]} break
    
    # 	set page_template [$page page_template]
    # 	set page_template_name [$page_template name]
    #         # search the page_template in the list of form_ids
    #         if {[lsearch $folder_form_ids $page_template] > -1} {
    #           break
    # 	} elseif {$page_template_name eq "en:folder.form"} {
    # 	  # safety belt, in case we have in different directories
    # 	  # diffenent en:folder.form
    # 	  break
    # 	} elseif {$page_template_name eq "en:link.form"} {
    # 	  set fp [my is_folder_page]
    # 	  my msg fp=$fp
    # 	  break
    #         }
          }
          set page [::xo::db::CrClass get_instance_from_db -item_id [$page parent_id]]
        }
        return $page
      }
    
  • instproc get_form_data (public)

    <instance of ::xowiki::Page[i]> get_form_data \
        [ -field_names field_names ] form_fields
    Get the values from the form and store it in the form fields and finally as instance attributes. If the field names are not specified, all form parameters are used.

    Switches:
    -field_names (optional)
    Parameters:
    form_fields
    ::1382845 instproc get_form_data {-field_names form_fields} {
        set validation_errors 0
        set category_ids [list]
        array set containers [list]
        my instvar __ia package_id
        set cc [$package_id context]
        if {[my exists instance_attributes]} {
          array unset __ia
          array set __ia [my set instance_attributes]
        }
    
        if {![info exists field_names]} {
          set field_names [$cc array names form_parameter]
          #my log "form-params=[$cc array get form_parameter]"
        }
        #my msg "fields $field_names // $form_fields"
        #foreach f $form_fields { my msg "... $f [$f name]" }
        #
        # We have a form and get all form input from the fields of the
        # from into form field objects.
        #
        foreach att $field_names {
          #my msg "getting att=$att"
          set processed($att) 1
          switch -glob -- $att {
            __category_* {
              set f [my lookup_form_field -name $att $form_fields]
              set value [$f value [$cc form_parameter $att]]
              foreach v $value {lappend category_ids $v}
            }
            __* {
              # other internal variables (like __object_name) are ignored
            }
             _* {
               # instance attribute fields
               set f     [my lookup_form_field -name $att $form_fields]
               set value [$f value [string trim [$cc form_parameter $att]]]
               set varname [string range $att 1 end]
               # get rid of strange utf-8 characters hex C2AD (firefox bug?)
               # ns_log notice "FORM_DATA var=$varname, value='$value' s=$s"
               if {$varname eq "text"} {regsub -all "­" $value "" value}
               #ns_log notice "FORM_DATA var=$varname, value='$value'"
               if {![string match *.* $att]} {my set $varname $value}
             }
            default {
               # user form content fields
              if {[regexp {^(.+)[.](tmpfile|content-type)} $att _ file field]} {
                set f [my lookup_form_field -name $file $form_fields]
                $f $field [string trim [$cc form_parameter $att]]
                #my msg "[$f name]: [list $f $field [string trim [$cc form_parameter $att]]]"
              } else {
                set f     [my lookup_form_field -name $att $form_fields]
                set value [$f value [string trim [$cc form_parameter $att]]]
                #my msg "value of $att ($f) = '$value' exists=[$cc exists_form_parameter $att]" 
                if {![string match *.* $att]} {set __ia($att) $value}
                if {[$f exists is_category_field]} {foreach v $value {lappend category_ids $v}}
              }
            }
          }
          if {[string match *.* $att]} {
            foreach {container component} [split $att .] break
            lappend containers($container) $component
          }
        }
        
        #my msg "containers = [array names containers]"
        #my msg "ia=[array get __ia]"
        #
        # In a second iteration, combine the values from the components 
        # of a container to the value of the container.
        #
        foreach c [array names containers] {
          switch -glob -- $c {
            __* {}
            _* {
              set f  [my lookup_form_field -name $c $form_fields]
              set processed($c) 1
              my set [string range $c 1 end] [$f value]
            }
            default {
              set f  [my lookup_form_field -name $c $form_fields]
              set processed($c) 1
              #my msg "container $c: compute value of $c [$f info class]"
              set __ia($c) [$f value]
              #my msg "container $c: __ia($c) is set to '$__ia($c)'"
            }
          }
        }
        
        #
        # The first round was a processing based on the transmitted input
        # fields of the forms. Now we use the formfields to complete the
        # data and to validate it.
        #
        foreach f $form_fields {
          #my msg "validate $f [$f name] [info exists processed([$f name])]"
          set att [$f name]
     
          # Certain form field types (e.g. checkboxes) are not transmitted, if not
          # checked. Therefore, we have not processed these fields above and
          # have to do it now.
          
          if {![info exists processed($att)]} {
    	#my msg "form field $att not yet processed"
    	switch -glob -- $att {
    	  __* {
    	    # other internal variables (like __object_name) are ignored
    	  }
    	  _* {
    	    # instance attribute fields
    	    set varname [string range $att 1 end]
                set default ""
                if {[my exists $varname]} {set default [my set $varname]}
                set v [$f value_if_nothing_is_returned_from_form $default]
                set value [$f value $v]
                if {$v ne $default} {
                  if {![string match *.* $att]} {my set $varname $value}
                }
    	  }
    	  default {
    	    # user form content fields
                set default ""
                # The reason, why we set in the next line the default to
                # the old value is due to "show-solution" in the qti
                # use-case. Maybe one should alter this use-case to
                # simplify the semantics here.
                if {[info exists __ia($att)]} {set default $__ia($att)}
                set v [$f value_if_nothing_is_returned_from_form $default]
                #my msg "value_if_nothing_is_returned_from_form '$default' => '$v' (type=[$f info class])"
                set value [$f value $v]
                if {![string match *.* $att]} {set __ia($att) $value}
    	  }
            }
          }
          
          #
          # Run validators
          #
          set validation_error [$f validate [self]]
          if {$validation_error ne ""} {
    	#my msg "validation of $f [$f name] with value '[$f value]' returns '$validation_error'"
            $f error_msg $validation_error
            incr validation_errors
          }
        }
        #my msg "validation returns $validation_errors errors"
        set current_revision_id [::xo::cc form_parameter __current_revision_id ""]
        if {$validation_errors == 0 && $current_revision_id ne "" && $current_revision_id != [my revision_id]} {
          set validation_errors [my mutual_overwrite_occurred]
        }
    
        if {$validation_errors == 0} {
          #
          # Postprocess based on form fields based on form-fields methods.
          #
          foreach f $form_fields {
    	$f convert_to_internal
          }
        } else {
          my log validation_errors=$validation_errors
    
          # There were validation erros.  Reset the value for form-fields
          # of type "file" to avoid confusions, since a file-name was
          # provided, but the file was not uploaded due to the validation
          # error. If we would not reset the value, the provided name
          # would cause an interpretation of an uploaded empty file. Maybe
          # a new method "reset-to-default" would be a good idea.
          foreach f $form_fields {
    	if {[$f type] eq "file"} {
    	  $f set value ""
            }
          }
        }
    
        my instance_attributes [array get __ia]
        #my msg category_ids=$category_ids
        return [list $validation_errors [lsort -unique $category_ids]]
      }
    
  • instproc get_html_from_content

    ::1382845 instproc get_html_from_content content {
        # Check, whether we got the content through a classic 2-element
        # OpenACS templating widget or directly.  If the list is not
        # well-formed, it must be contained directly.
        if {![catch {set l [llength $content]}] 
    	&& $l == 2 
    	&& [string match "text/*" [lindex $content 1]]} {
          return [lindex $content 0]
        }
        return $content
      }
    
  • instproc get_instance_attributes

    ::1382845 instproc get_instance_attributes {} {
        if {[my exists instance_attributes]} {
          return [my set instance_attributes]
        }
        return ""
      }
    
  • instproc get_nls_language_from_lang

    ::1382845 instproc get_nls_language_from_lang lang {
        # Return the first nls_language matching the provided lang
        # prefix. This method is not precise (when e.g. two nls_languages
        # are defined with the same lang), but the only thing relvant is
        # the lang anyhow.  If nothing matches return empty.
        foreach nls_language [lang::system::get_locales] {
          if {[string range $nls_language 0 1] eq $lang} {
            return $nls_language
          }
        }
        return ""
      }
    
  • instproc get_property_from_link_page

    ::1382845 instproc get_property_from_link_page {property {default {}}} {
        if {![my is_link_page]} {return $default}
        set item_ref [my property link]
    
        # TODO we could save some double-fetch by collecing in
        # get_form_entries via item-ids, not via new-objects
        ::xo::db::CrClass get_instance_from_db -item_id [my item_id]
    
        set props [::xo::cc cache [list [my item_id] compute_link_properties $item_ref]]
        array set "" $props
        if {[info exists ($property)]} {
          #[my item_id] msg "prop $property ==> $($property)"
          return $($property)
        }
        return $default
      }
    
  • instproc get_rich_text_spec

    ::1382845 instproc get_rich_text_spec {field_name default} {
        my instvar package_id
        set spec ""
        #my msg WidgetSpecs=[$package_id get_parameter WidgetSpecs]
        foreach {s widget_spec} [$package_id get_parameter WidgetSpecs] {
          foreach {page_name var_name} [split $s ,] break
          # in case we have no name (edit new page) we use the first value or the default.
          set name [expr {[my exists name] ? [my set name] : $page_name}]
          #my msg "--w T.name = '$name' var=$page_name ([string match $page_name $name]), $var_name $field_name ([string match $var_name $field_name])"
          if {[string match $page_name $name] &&
              [string match $var_name $field_name]} {
            set spec $widget_spec
    	#my msg "setting spec to $spec"
            break
          }
        }
        if {$spec eq ""} {return $default}
        return $field_name:$spec
      }
    
  • instproc get_target_from_link_page

    ::1382845 instproc get_target_from_link_page {{-depth 10}} {
        #
        # Dereference link and return target object of the
        # link. Dereferencing happens up to a maximal depth to avoid loop
        # in circular link structures. If this method is called with e.g.
        # {-depth 1} and the link (actual object) points to some link2,
        # the link2 is returned.
        # 
        # @param depth maximal dereferencing depth
        # @return target object or empty
        #
        set item_id [my get_property_from_link_page item_id 0]
        if {$item_id == 0} {return ""}
        set target [::xo::db::CrClass get_instance_from_db -item_id $item_id]
        set target_package_id [$target package_id]
        if {$target_package_id != [my package_id]} {
          ::xowiki::Package require $target_package_id
          #::xowiki::Package initialize -package_id $target_package_id -init_url false -keep_cc true
        }
        if {$depth > 1 && [$target is_link_page]} {
          set target [my get_target_from_link_page -count [expr {$depth - 1}]]
        }
        return $target
      }
    
  • instproc htmlFooter

    ::1382845 instproc htmlFooter {{-content ""}} {
        my instvar package_id
    
        if {[my exists __no_footer]} {return ""}
    
        set footer ""
        
        if {[ns_conn isconnected]} {
          set url         "[ns_conn location][::xo::cc url]"
          set package_url "[ns_conn location][$package_id package_url]"
        }
    
        set tags ""
        if {[$package_id get_parameter "with_tags" 1] && 
            ![my exists_query_parameter no_tags] &&
            [::xo::cc user_id] != 0
          } {
          set tag_content [my include my-tags]
          set tag_includelet [my set __last_includelet]
          if {[$tag_includelet exists tags]} {
    	set tags [$tag_includelet set tags]
          }
        } else {
          set tag_content ""
        }
    
        if {[$package_id get_parameter "with_digg" 0] && [info exists url]} {
          if {![info exists description]} {set description [my get_description $content]}
          append footer "<div style='float: right'>"  [my include [list digg -description $description -url $url]] "</div>\n"
        }
    
        if {[$package_id get_parameter "with_delicious" 0] && [info exists url]} {
          if {![info exists description]} {set description [my get_description $content]}
          append footer "<div style='float: right; padding-right: 10px;'>"  [my include [list delicious -description $description -url $url -tags $tags]]  "</div>\n"
        }
    
        if {[$package_id get_parameter "with_yahoo_publisher" 0] && [info exists package_url]} {
          set publisher [$package_id get_parameter "my_yahoo_publisher"  [::xo::get_user_name [::xo::cc user_id]]]
          append footer "<div style='float: right; padding-right: 10px;'>"  [my include [list my-yahoo-publisher  -publisher $publisher  -rssurl "$package_url?rss"]]  "</div>\n"
        }
    
        if {[$package_id get_parameter "show_page_references" 1]} {
          append footer [my include my-references] 
        }
        
        if {[$package_id get_parameter "show_per_object_categories" 1]} {
          set html [my include my-categories]
          if {$html ne ""} {
    	append footer $html <br>
          }
          set categories_includelet [my set __last_includelet]
        }
    
        append footer $tag_content
    
        if {[$package_id get_parameter "with_general_comments" 0] &&
            ![my exists_query_parameter no_gc]} {
          append footer [my include my-general-comments] 
        }
    
        if {$footer ne ""} {
          # make sure, the 
          append footer "<div class='visual-clear'><!-- --></div>"
        }
    
        return  "<div class='item-footer'>$footer</div>\n"
      }
    
  • instproc include (public)

    <instance of ::xowiki::Page[i]> include [ -configure configure ] \
        arg
    Include the html of the includelet. The method generates an includelet object (might be an other xowiki page) and renders it and returns either html or an error message.

    Switches:
    -configure (optional)
    Parameters:
    arg
    ::1382845 instproc include {-configure arg} {
        set page [my instantiate_includelet $arg]
        if {$page eq ""} {
          # The variable 'page_name' is required by the message key
          set page_name $arg
          return [my error_during_render [_ xowiki.error-includelet-unknown]]
        }
        if {[$page istype ::xowiki::Page]} {
          set package_id [$page package_id]
          set allowed [[$package_id set policy] check_permissions  -package_id $package_id  -user_id [::xo::cc set untrusted_user_id]  $page view]
          if {!$allowed} {
            return "<div class='errorMsg'>Unsufficient priviledges to view content of [$page name].</div>"
          }
        }
        if {[info exists configure]} {
          eval $page configure $configure
        }
        return [my render_includelet $page]
      }
    
  • instproc include_content

    ::1382845 instproc include_content {arg ch2} {
        # make recursion depth a global variable to ease the deletion etc.
        if {[catch {incr ::xowiki_inclusion_depth}]} {
          set ::xowiki_inclusion_depth 1
        }
        if {$::xowiki_inclusion_depth > 10} {
          return [my error_in_includelet $arg [_ xowiki.error-includelet-nesting_to_deep]]
        }
        if {[regexp {^adp (.*)$} $arg _ adp]} {
          if {[catch {lindex $adp 0} errMsg]} {
            # there is something syntactically wrong
            incr ::xowiki_inclusion_depth -1
            return [my error_in_includelet $arg [_ xowiki.error-includelet-adp_syntax_invalid]]
          }
          set adp [string map {&nbsp; " "} $adp]
          #
          # Check the provided name of the adp file
          #
          array set "" [my check_adp_include_path [lindex $adp 0]]
          if {!$(allowed)} {
            return [my error_in_includelet $arg $(msg)]
          }
          set adp_fn $(fn)
          #
          # check the provided arguments
          #
          set adp_args [lindex $adp 1]
          if {[llength $adp_args] % 2 == 1} {
            incr ::xowiki_inclusion_depth -1
            set adp $adp_args
            return [my error_in_includelet $arg [_ xowiki.error-includelet-adp_syntax_invalid]]
          }
    
          lappend adp_args __including_page [self]
          set including_page_level [template::adp_level]
          if {[catch {set page [template::adp_include $adp_fn $adp_args]} errorMsg]} {
            ns_log error "$errorMsg\n$::errorInfo"
            # in case of error, reset the adp_level to the previous value
            set ::template::parse_level $including_page_level 
            incr ::xowiki_inclusion_depth -1
            return [my error_in_includelet $arg  [_ xowiki.error-includelet-error_during_adp_evaluation]]
          }
    
          return $page$ch2
        } else {
          # we have a direct (adp-less include)
          set html [my include [my unescape $arg]]
          #my log "--include includelet returns $html"
          incr ::xowiki_inclusion_depth -1
          return $html$ch2
        }
      }
    
  • instproc initialize_loaded_object

    ::1382845 instproc initialize_loaded_object {} {
        my instvar title
        if {[info exists title] && $title eq ""} {set title [my set name]}
        next
      }
    
  • instproc instantiate_includelet

    ::1382845 instproc instantiate_includelet arg {
        # we want to use package_id as proc-local variable, since the 
        # cross package reference might alter it locally
        set package_id [my package_id]
    
        # do we have a wellformed list?
        if {[catch {set page_name [lindex $arg 0]} errMsg]} {
          # there must be something syntactically wrong
          return [my error_in_includelet $arg [_ xowiki.error-includelet-dash_syntax_invalid]]
        }
        #my msg "includelet: [lindex $arg 0], caller parms ? '[lrange $arg 1 end]'"
    
        # the include is either a includelet class, or a wiki page
        if {[my isclass ::xowiki::includelet::$page_name]} {
          # direct call, without page, not tailorable
          set page [::xowiki::includelet::$page_name new  -package_id $package_id  -name $page_name  -locale [::xo::cc locale]  -actual_query [::xo::cc actual_query]]
        } else {
          #
          # Include a wiki page, tailorable.
          #
          #set page [my resolve_included_page_name $page_name]
          set page [$package_id get_page_from_item_ref  -use_package_path true  -use_site_wide_pages true  -use_prototype_pages true  -default_lang [my lang]  -parent_id [my parent_id] $page_name]
          
          if {$page ne "" && ![$page exists __decoration]} {
    	# 
    	# we use as default decoration for included pages
    	# the "portlet" decoration
    	#
            $page set __decoration [$package_id get_parameter default-portlet-decoration portlet]
          }
        }
    
        if {$page ne ""} {
          $page set __caller_parameters [lrange $arg 1 end] 
          $page destroy_on_cleanup
          my set __last_includelet $page
          $page set __including_page [self]
          if {[$page istype ::xowiki::Includelet]} {
            $page initialize
          }
        }
        return $page
      }
    
  • instproc is_folder_page

    ::1382845 instproc is_folder_page {{-include_folder_links true}} {
        return 0
      }
    
  • instproc is_form

    ::1382845 instproc is_form {} {
        return 0
      }
    
  • instproc is_link_page

    ::1382845 instproc is_link_page {} {
        return 0
      }
    
  • instproc is_new_entry

    ::1382845 instproc is_new_entry old_name {
        return [expr {[my publish_status] eq "production" && $old_name eq [my revision_id]}]
      }
    
  • instproc lang

    ::1382845 instproc lang {} {
        return [string range [my nls_language] 0 1]
      }
    
  • instproc list

    ::1382845 instproc list {} {
        if {[my is_form]} {
          # The following line is here to provide a short description for
          # larger form-usages (a few MB) where otherwise
          # "ad_html_text_convert" in Page.get_description tend to use forever
          # (at least in Tcl 8.5)
          my set description "form-usages for [my name] [my title]"
          
          return [my view [my include [list form-usages -form_item_id [my item_id]]]]
        }
        if {[my is_folder_page]} {
          return [my view [my include [list child-resources -publish_status all]]]
        }
        #my msg "method list undefined for this kind of object"
        [my package_id] returnredirect [::xo::cc url]
      }
    
  • instproc lookup_cached_form_field

    ::1382845 instproc lookup_cached_form_field -name:required {
        set key ::_form_field_names($name)
        #my msg "FOUND($name)=[info exists $key]"
        if {[info exists $key]} {
          return [set $key]
        }
        error "No form field with name $name found"
      }
    
  • instproc lookup_form_field

    ::1382845 instproc lookup_form_field {-name:required form_fields} {
        my form_field_index $form_fields
    
        set key ::_form_field_names($name)
        if {[info exists $key]} {
          return [set $key]
        }
        #
        # We have here a non-existing form-field. Maybe the entry in the
        # form was dynamically created, so we create it here on the fly...  
        #
        # For forms with variable numbers of entries, we allow wild-cards
        # in the field-names of the form constraints.
        #
        foreach name_and_spec [my get_form_constraints] {
          regexp {^([^:]+):(.*)$} $name_and_spec _ spec_name short_spec
          if {[string match $spec_name $name]} {
    	set f [my create_form_fields_from_form_constraints [list $name:$short_spec]]
    	set $key $f
    	return $f
          }
        }
        if {$name ni {fontname fontsize formatblock}} {
          set names [list]
          foreach f $form_fields {lappend names [$f name]}
          my msg "No form field with name '$name' found (available fields: [lsort [array names ::_form_field_names]])"
        }
        set f [my create_form_fields_from_form_constraints [list $name:text]]
        set $key $f
        return $f
      }
    
  • instproc make-live-revision

    ::1382845 instproc make-live-revision {} {
        my instvar revision_id item_id package_id
        #my log "--M set_live_revision($revision_id)"
        ::xo::db::sql::content_item set_live_revision -revision_id $revision_id
        set page_id [my query_parameter "page_id"]
        ::xo::clusterwide ns_cache flush xotcl_object_cache ::$item_id
        ::$package_id returnredirect [my query_parameter "return_url"  [export_vars -base [$package_id url] {{m revisions}}]]
      }
    
  • instproc map_categories

    ::1382845 instproc map_categories category_ids {
        # could be optimized, if we do not want to have categories (form constraints?)
        #my log "--category::map_object -remove_old -object_id [my item_id] <$category_ids>"
        category::map_object -remove_old -object_id [my item_id] $category_ids
      }
    
  • instproc map_party

    ::1382845 instproc map_party {-property party_id} {
        #my log "+++ $party_id"
        # So far, we just handle users, but we should support parties in
        # the future as well.
        if {$party_id eq "" || $party_id == 0} {
          return $party_id
        }
        if {![catch {acs_user::get -user_id $party_id -array info}]} {
          set result [list]
          foreach a {username email first_names last_name screen_name url} {
    	lappend result $a $info($a)
          }
          ns_log notice "--    map_party $party_id: $result"
          return $result
        }
        if {![catch {group::get -group_id $party_id -array info}]} {
    	ns_log notice "got group info: [array get info]"
    	set result [array get info]
    	set members {}
    	foreach member_id [group::get_members -group_id $party_id] {
    	    lappend members [my map_party -property $property $member_id]
    	}
    	lappend result members $members
    	ns_log notice "--    map_party $party_id: $result"
    	return $result
        }
        ns_log warning "Cannot map party_id $party_id, probably not a user; property $property lost during export"
        return {}
      }
    
  • instproc marshall

    ::1382845 instproc marshall {} {
        my instvar name
        my unset_temporary_instance_variables
        set old_creation_user  [my creation_user]
        set old_modifying_user [my set modifying_user]
        my set creation_user   [my map_party -property creation_user $old_creation_user]
        my set modifying_user  [my map_party -property modifying_user $old_modifying_user]
        if {[regexp {^..:[0-9]+$} $name] ||
            [regexp {^[0-9]+$} $name]} {
          #
          # for anonymous entries, names might clash in the target
          # instance. If we create on the target site for anonymous
          # entries always new instances, we end up with duplicates.
          # Therefore, we rename anonymous entries during export to
          #    ip_address:port/item_id
          #
          set old_name $name
          set server [ns_info server]
          set port [ns_config ns/server/${server}/module/nssock port]
          set name [ns_info address]:${port}-[my item_id]
          set content [my serialize]
          set name $old_name
        } else {
          set content [my serialize]
        }
        my set creation_user  $old_creation_user
        my set modifying_user $old_modifying_user
        return $content
      }
    
  • instproc mutual_overwrite_occurred

    ::1382845 instproc mutual_overwrite_occurred {} {
         util_user_message -html  -message "User <em>[::xo::get_user_name [my set modifying_user]]</em> has modifyed this page  while you were editing it. Open <a href='[::xo::cc url]' target='_blank'>modified page</a> in new window or press OK again to save this page."
        # return 1 to flag validation error, 0 to ignore this fact
        return 1
      }
    
  • instproc new_link

    ::1382845 instproc new_link {-name -title -nls_language -return_url -parent_id page_package_id} {
        if {[info exists parent_id] && $parent_id eq ""} {unset parent_id}
        return [$page_package_id make_link -with_entities 0 $page_package_id  edit-new object_type name title nls_language return_url parent_id autoname]
      }
    
  • instproc normalize_internal_link_name

    ::1382845 instproc normalize_internal_link_name {name stripped_name lang} {
        #
        # strip anchor and query from link name
        #
        set anchor ""
        set query ""
        # remove anchor
        regexp {^([^#]*)(\#|%23)(.*)$} $stripped_name _ stripped_name . anchor
        # remove query part
        regexp {^(.*)[?]([^?]+)$} $stripped_name _ stripped_name query
    
        # if we have an empty stripped name, it is a link to the current
        # page, maybe in a different language
        if {$stripped_name eq ""} {
          regexp {:([^:]+)$} $name _ stripped_name
        }
        
        set normalized_name [[my package_id] normalize_name $stripped_name]
        #my msg "input: [self args] - lang=[my lang], [my nls_language]"
        if {$lang  eq ""}   {set lang [my lang]}
        if {$name  eq ""}   {set name $lang:$normalized_name}
        #my msg result=[list name $name lang $lang normalized_name $normalized_name anchor $anchor]
        return [list name $name lang $lang normalized_name $normalized_name anchor $anchor query $query]
      }
    
  • instproc physical_package_id

    ::1382845 instproc physical_package_id {} {
        if {[my exists physical_package_id]} {
          return [my set physical_package_id]
        } else {
          return [my package_id]
        }
      }
    
  • instproc physical_parent_id

    ::1382845 instproc physical_parent_id {} {
        if {[my exists physical_parent_id]} {
          return [my set physical_parent_id]
        } else {
          return [my parent_id]
        }
      }
    
  • instproc popular-tags

    ::1382845 instproc popular-tags {} {
        my instvar package_id item_id parent_id
        set limit       [my query_parameter "limit" 20]
        set weblog_page [$package_id get_parameter weblog_page weblog]
        set href        [$package_id pretty_link $weblog_page]?summary=1
    
        set entries [list]
        db_foreach [my qn get_popular_tags]  [::xo::db::sql select  -vars "count(*) as nr, tag"  -from "xowiki_tags"  -where "item_id=$item_id"  -groupby "tag"  -orderby "nr"  -limit $limit] {
               lappend entries "<a href='$href&ptag=[ad_urlencode $tag]'>$tag ($nr)</a>"
             }
        ns_return 200 text/html "[_ xowiki.popular_tags_label]: [join $entries {, }]"
      }
    
  • instproc pretty_link

    ::1382845 instproc pretty_link {{-anchor ""} {-query ""} {-absolute:boolean false} {-siteurl ""} {-lang ""} {-download false}} {
        # return the pretty_link for the current page
        [my package_id] pretty_link -parent_id [my parent_id]  -anchor $anchor -query $query -absolute $absolute -siteurl $siteurl  -lang $lang -download $download [my name]
      }
    
  • instproc pretty_name

    ::1382845 instproc pretty_name {} {
        return [my name]
      }
    
  • instproc record_last_visited

    ::1382845 instproc record_last_visited -user_id {
        my instvar item_id package_id
        if {![info exists user_id]} {set user_id [::xo::cc set untrusted_user_id]}
        if {$user_id > 0} {
          # only record information for authenticated users
          db_dml [my qn update_last_visisted]  "update xowiki_last_visited set time = current_timestamp, count = count + 1  where page_id = :item_id and user_id = :user_id"
          if {[db_resultrows] < 1} {
            db_dml [my qn insert_last_visisted]  "insert into xowiki_last_visited (page_id, package_id, user_id, count, time)  values (:item_id, :package_id, :user_id, 1, current_timestamp)"
          }
        }
      }
    
  • instproc references_update

    ::1382845 instproc references_update references {
        #my msg $references
        my instvar item_id
        db_dml [my qn delete_references]  "delete from xowiki_references where page = :item_id"
        foreach ref $references {
          foreach {r link_type} $ref break
          db_dml [my qn insert_reference]  "insert into xowiki_references (reference, link_type, page)  values (:r,:link_type,:item_id)"
        }
      }
    
  • instproc regsub_eval

    ::1382845 instproc regsub_eval {{-noquote:boolean false} re string cmd {prefix {}}} {
        if {$noquote} {
          set map { \[ \\[ \] \\] \$ \\$ \\ \\\\}
        } else {
          set map { \" \\\" \[ \\[ \] \\] \$ \\$ \\ \\\\}
        }
        uplevel [list subst [regsub -all $re [string map $map $string] "\[$cmd\]"]]
      }
    
  • instproc render

    ::1382845 instproc render {{-update_references:boolean false} {-with_footer:boolean true}} {
        #
        # prepare language links
        #
        my array set lang_links {found "" undefined ""}
        #
        # prepare references management
        #
        my set references [list]
        if {[my exists __extra_references]} {
          #
          # xowiki content-flow uses extra references, e.g. to forms.
          # TODO: provide a better interface for providing these kind of
          # non-link references.
          #
          my set references [my set __extra_references]
          my unset __extra_references
        }
        #my msg "[my name] setting unresolved_references 0"
        my set unresolved_references 0
        my set __unresolved_references [list]
        #
        # get page content and care about reference management
        #
        set content [my render_content]
        #
        # record references and clear it
        #
        #my msg "we have the content, update=$update_references, unresolved=[my set unresolved_references]"
        if {$update_references || [my set unresolved_references] > 0} {
          my references_update [lsort -unique [my set references]]
        }
        my unset -nocomplain references
        #
        # handle footer
        #
        if {$with_footer && [::xo::cc get_parameter content-type text/html] eq "text/html"} {
          append content "<DIV class='content-chunk-footer'>"
          if {![my exists __no_footer] && ![::xo::cc get_parameter __no_footer 0]} {
            append content [my footer]
          }
          append content "</DIV>\n"
        }
        return $content
      }
    
  • instproc render_content

    ::1382845 instproc render_content {} {
        #my log "-- '[my set text]'"
        set html ""; set mime ""
        foreach {html mime} [my set text] break
        if {[my render_adp]} {
          set html [my adp_subst $html]
        }
        return [my substitute_markup $html]
      }
    
  • instproc render_icon

    ::1382845 instproc render_icon {} {
        return [list text [namespace tail [my info class]] is_richtext false]
      }
    
  • instproc render_includelet

    ::1382845 instproc render_includelet includelet {
        #
        # The passed includelet is either an instance of ::xowiki::Page or
        # of ::xowiki::Includelet
        #
        foreach {att value} [$includelet set __caller_parameters] {
          switch -- $att {
            -decoration {$includelet set __decoration $value}
            -title {$includelet set title $value}
            -id {$includelet set id $value}
          }
        }
        if {[$includelet exists __decoration] && [$includelet set __decoration] ne "none"} {
          $includelet mixin add ::xowiki::includelet::decoration=[$includelet set __decoration]
        }
    
        set c [$includelet info class]
        if {[$c exists cacheable] && [$c cacheable]} {
          $includelet mixin add ::xowiki::includelet::page_fragment_cache
        }
    
        if {[$includelet istype ::xowiki::Includelet]} {
          # call this always
          $includelet include_head_entries
        }
    
        # "render" might be cached
        if {[catch {set html [$includelet render]} errorMsg]} {
          ns_log error "$errorMsg\n$::errorInfo"
          set page_name [$includelet name]
          set ::errorInfo [::xowiki::Includelet html_encode $::errorInfo]
          set html [my error_during_render [_ xowiki.error-includelet-error_during_render]]
        }
        #my log "--include includelet returns $html"
        return $html
      }
    
  • instproc reset_resolve_context

    ::1382845 instproc reset_resolve_context {} {
        foreach att {item package parent} {
          set name physical_${att}_id
          if {[my exists $name]} {
    	my set ${att}_id [my set $name]
    	my unset $name
          }
        }
      }
    
  • instproc resolve_included_page_name (public)

    <instance of ::xowiki::Page[i]> resolve_included_page_name \
        page_name
    Determine the page object for the specified page name. The specified page name might have the form //some_other_instance/page_name, in which case the page is resolved from some other package instance. If the page_name does not contain a language prefix, the language prefix of the including page is used.

    Parameters:
    page_name
    ::1382845 instproc resolve_included_page_name page_name {
        if {$page_name ne ""} {
          set page [[my package_id] resolve_page_name_and_init_context -lang [my lang] $page_name]
          if {$page eq ""} {
            error "Cannot find page '$page_name' to be included in page '[my name]'"
          }
        } else {
          set page [self]
        }
        return $page
      }
    
  • instproc reverse_map_party

    ::1382845 instproc reverse_map_party {-entry -default_party {-create_user_ids 0}} {
        # So far, we just handle users, but we should support parties in
        # the future as well.http://localhost:8003/nimawf/admin/export
    
        array set "" $entry
        if {[info exists (email)] && $(email) ne ""} {
          set id [party::get_by_email -email $(email)]
          if {$id ne ""} { return $id }
        } 
        if {[info exists (username)] && $(username) ne ""} {
          set id [acs_user::get_by_username -username $(username)]
          if {$id ne ""} { return $id }
        }
        if {[info exists (group_name)] && $(group_name) ne ""} {
          set id [group::get_id -group_name $(group_name)]
          if {$id ne ""} { return $id }
        }
    
        if {$create_user_ids} {
          if {[info exists (group_name)] && $(group_name) ne ""} {
    	my log "+++ create a new group group_name=$(group_name)"
    	set group_id [group::new -group_name $(group_name)]
    	array set info [list join_policy $(join_policy)]
    	group::update -group_id $group_id -array info
    	ns_log notice "+++ reverse_party_map: we could add members $(members) - but we don't"
    	return $group_id
          } else {
    	my log "+++ create a new user username=$(username), email=$(email)"
    	array set status [auth::create_user -username $(username) -email $(email)  -first_names $(first_names) -last_name $(last_name)  -screen_name $(screen_name) -url $(url)]
    	if {$status(creation_status) eq "ok"} {
    	  return $status(user_id)
    	}
    	my log "+++ create user username=${username}, email=$(email) failed, reason=$status(creation_status)"
          }
        }
        return $default_party
      }
    
  • instproc reverse_map_party_attribute

    ::1382845 instproc reverse_map_party_attribute {-attribute {-default_party 0} {-create_user_ids 0}} {
        if {![my exists $attribute]} {
          my set $attribute $default_party
        } elseif {[llength [my set $attribute]] < 2} {
          my set $attribute $default_party
        } else {
          my set $attribute [my reverse_map_party  -entry [my set $attribute]  -default_party $default_party  -create_user_ids $create_user_ids]
        }
      }
    
  • instproc revisions

    ::1382845 instproc revisions {} {
        my instvar package_id name item_id
        set context [list [list [$package_id url] $name ] [_ xotcl-core.revisions]]
        set title "[_ xotcl-core.revision_title] '$name'"
        ::xo::Page set_property doc title $title
        set content [next]
        array set property_doc [::xo::Page get_property doc]
        $package_id return_page -adp /packages/xowiki/www/revisions -variables {
          content context {page_id $item_id} title property_doc
        }
      }
    
  • instproc save

    ::1382845 instproc save args {
        [my package_id] flush_page_fragment_cache
        next
      }
    
  • instproc save-attributes (public)

    <instance of ::xowiki::Page[i]> save-attributes
    The method save-attributes is typically callable over the REST interface. It allows to save attributes of a page without adding a new revision.

    ::1382845 instproc save-attributes {} {
        my instvar package_id
        set field_names [my field_names]
        set form_fields [list]
        set query_field_names [list]
    
        set validation_errors 0
        foreach field_name $field_names {
          if {[::xo::cc exists_form_parameter $field_name]} {
            lappend form_fields [my create_form_field $field_name]
            lappend query_field_names $field_name
          }
        }
        #my show_fields $form_fields
        foreach {validation_errors category_ids}  [my get_form_data -field_names $query_field_names $form_fields] break
    
        if {$validation_errors == 0} {
          #
          # we have no validation errors, so we can save the content
          #
          set update_without_revision [$package_id query_parameter replace 0]
    
          foreach form_field $form_fields {
            # fix richtext content in accordance with oacs conventions
            if {[$form_field istype ::xowiki::formfield::richtext]} {
              $form_field value [list [$form_field value] text/html]
            }
          }
          if {$update_without_revision} {
            # field-wise update without revision
            set update_instance_attributes 0
            foreach form_field $form_fields {
              set s [$form_field slot]
              if {$s eq ""} {
                # empty slot means that we have an instance_attribute; 
                # we save all in one statement below
                set update_instance_attributes 1
              } else {
                error "Not implemented yet"
                my update_attribute_from_slot $s [$form_field value]
              }
            }
            if {$update_instance_attributes} {
              set s [my find_slot instance_attributes]
              my update_attribute_from_slot $s [my instance_attributes]
            }
          } else {
            #
            # perform standard update (with revision)
            # 
            my save_data  -use_given_publish_date [expr {[lsearch $field_names _publish_date] > -1}]  [::xo::cc form_parameter __object_name ""] $category_ids
          }
          $package_id returnredirect  [my query_parameter "return_url" [my pretty_link]]
          return
        } else {
          # todo: handle errors in a user friendly way
          my log "we have $validation_errors validation_errors"
        }
        $package_id returnredirect  [my query_parameter "return_url" [my pretty_link]]
      }
    
  • instproc save-tags

    ::1382845 instproc save-tags {} {
        my instvar package_id item_id revision_id
        ::xowiki::Page save_tags  -user_id [::xo::cc user_id]  -item_id $item_id  -revision_id $revision_id  -package_id $package_id  [my form_parameter new_tags]
    
        ::$package_id returnredirect  [my query_parameter "return_url" [$package_id url]]
      }
    
  • instproc save_data

    ::1382845 instproc save_data {{-use_given_publish_date:boolean false} old_name category_ids} {
        #my log "-- [self args]"
        my unset_temporary_instance_variables
    
        my instvar package_id name
    
        db_transaction {
          #
          # if the newly created item was in production mode, but ordinary entries
          # are not, change on the first save the status to ready
          #
          if {[my is_new_entry $old_name]} {
            if {![$package_id get_parameter production_mode 0]} {
              my set publish_status "ready"
            }
          }
          my map_categories $category_ids
    
          my save -use_given_publish_date $use_given_publish_date
          #my log "-- old_name $old_name, name $name"
          if {$old_name ne $name} {
            #my msg "do rename from $old_name to $name"
            $package_id flush_name_cache -name $old_name -parent_id [my parent_id]
            my rename -old_name $old_name -new_name $name
          }
        }
        return [my item_id]
      }
    
  • instproc save_new

    ::1382845 instproc save_new args {
        [my package_id] flush_page_fragment_cache
        next
      }
    
  • instproc search_render

    ::1382845 instproc search_render {} {
        my set __no_form_page_footer 1
        set html [my render]
        my unset __no_form_page_footer
    
        foreach tag {h1 h2 h3 h4 h5 b strong} {
          foreach {match words} [regexp -all -inline "<$tag>(\[^<\]+)</$tag>" $html] {
    	foreach w [split $words] {
    	  if {$w eq ""} continue
    	  set word($w) 1
    	}
          }
        }
        foreach tag [::xowiki::Page get_tags -package_id [my package_id] -item_id [my item_id]] {
          set word($tag) 1
        }
        #my log [list html $html keywords [array names work]]
        return [list html $html keywords [array names work]]
      }
    
  • instproc set_content

    ::1382845 instproc set_content text {
        my text [list [string map [list >> "\n&gt;&gt;" << "&lt;&lt;\n"]  [string trim $text " \n"]] text/html]
      }
    
  • instproc set_resolve_context

    ::1382845 instproc set_resolve_context {-package_id:required -parent_id:required -item_id} {
        if {[my set parent_id] != $parent_id} {
          my set physical_parent_id [my set parent_id]
          my set parent_id $parent_id
        }
        if {[my set package_id] != $package_id} {
          my set physical_package_id [my set package_id]
          my set package_id $package_id
          #my msg "doing extra require on [my set physical_package_id]"
          #::xowiki::Package require [my set physical_package_id]
        }
        if {[info exists item_id] && [my item_id] != $item_id} {
          my set physical_item_id [my set item_id]
          my set item_id $item_id
        }
      }
    
  • instproc show_fields

    ::1382845 instproc show_fields form_fields {
        # this method is for debugging only
        set msg ""
        foreach f $form_fields { append msg "[$f name] [namespace tail [$f info class]], " }
        my msg $msg
        my log "form_fields: $msg"
      }
    
  • instproc substitute_markup

    ::1382845 instproc substitute_markup content {
    
        if {[my set mime_type] eq "text/enhanced"} {
          set content [ad_enhanced_text_to_html $content]
        }
        if {![my do_substitutions]} {return $content}
        #
        # The provided content and the returned result are strings
        # containing HTML (unless we have other rich-text encodings).
        #
        # First get the right regular expression definitions
        #
        set baseclass [expr {[[my info class] exists RE] ? [my info class] : [self class]}]
        $baseclass instvar RE markupmap
        #my log "-- baseclass for RE = $baseclass"
    
        #
        # secondly, iterate line-wise over the text
        #
        set output ""
        set l ""
        foreach l0 [split $content \n] {
          append l [string map $markupmap(escape) $l0]
          if {[string first \{\{ $l] > -1 && [string first \}\} $l] == -1} {append l " "; continue}
          set l [my regsub_eval $RE(anchor)  $l {my anchor  "\1"} "1"]
          set l [my regsub_eval $RE(div)     $l {my div     "\1"}]
          set l [my regsub_eval $RE(include) $l {my include_content "\1" "\2"}]
          #regsub -all $RE(clean) $l {\1} l
          regsub -all $RE(clean2) $l { \1} l
          set l [string map $markupmap(unescape) $l]
          append output $l \n
          set l ""
        }
        #my log "--substitute_markup returns $output"
        return $output
      }
    
  • instproc translate

    ::1382845 instproc translate {-from -to text} {
        set langpair $from|$to
        set ie UTF8
        #set r [xo::HttpRequest new -url http://translate.google.com/translate_t  -post_data [export_vars {langpair text ie}]  -content_type application/x-www-form-urlencoded]
        #my msg url=http://translate.google.com/#$from/$to/$text
        set r [xo::HttpRequest new -url http://translate.google.com/#$from/$to/$text]
        #my msg status=[$r set status]
        if {[$r set status] eq "finished"} {
          set data [$r set data]
          #my msg data=$data
          dom parse -simple -html $data doc
          $doc documentElement root
          set n [$root selectNodes {//*[@id="result_box"]}]
          my msg "$text $from=>$to node '$n'"
          if {$n ne ""} {return [$n asText]}
        }
        util_user_message -message "Could not translate text,  status=[$r set status]"
        return "untranslated: $text"
      }
    
  • instproc unescape

    ::1382845 instproc unescape string {
        # Some browsers change {{cmd -flag "..."}} into {{cmd -flag &quot;...&quot;}}
        # We have to change this back
        return [string map [list "&gt;" > "&lt;" < "&quot;" \" "&amp;" & "&semicolon;" {;} ] $string]
      }
    
  • instproc unset_temporary_instance_variables

    ::1382845 instproc unset_temporary_instance_variables {} {
        # don't marshall/save/cache the following vars
        my array unset __ia
        my array unset __field_in_form
        my array unset __field_needed 
      }
    
  • instproc validate-attribute

    ::1382845 instproc validate-attribute {} {
        set field_names [my field_names]
        set validation_errors 0
    
        # get the first transmitted form field
        foreach field_name $field_names {
          if {[::xo::cc exists_form_parameter $field_name]} {
            set form_fields [my create_form_field $field_name]
            set query_field_names $field_name
            break
          }
        }
        foreach {validation_errors category_ids}  [my get_form_data -field_names $query_field_names $form_fields] break
        set error ""
        if {$validation_errors == 0} {
          set status_code 200
        } else {
          set status_code 406
          foreach f $form_fields { 
            if {[$f error_msg] ne ""} {set error [::xo::localize [$f error_msg] 1]}
          }
        }
        ns_return $status_code text/html $error
      }
    
  • instproc validate=form_constraints

    ::1382845 instproc validate=form_constraints form_constraints {
        #
        # First check for invalid meta characters for security reasons.
        #
        if {[regexp {[\[\]]} $form_constraints]} {
          my uplevel [list set errorMsg  [_ xowiki.error-form_constraint-invalid_characters]]
          return 0
        }
        #
        # Create from fields from all specs and report, if there are any errors
        #
        if {[catch {
          my create_form_fields_from_form_constraints $form_constraints
        } errorMsg]} {
          ns_log error "$errorMsg\n$::errorInfo"
          my uplevel [list set errorMsg $errorMsg]
          #my msg "ERROR: invalid spec '$short_spec' for form field '$spec_name' -- $errorMsg"
          return 0
        }
        return 1
      }
    
  • instproc validate=name

    ::1382845 instproc validate=name name {
        upvar nls_language nls_language
        set success [::xowiki::validate_name [self]]
        if {$success} {
          # set the instance variable with a potentially prefixed name
          # the classical validators do just an upvar
          my set name $name
        }
        return $success
      }
    
  • instproc validate=page_order

    ::1382845 instproc validate=page_order value {
        if {[my exists page_order]} {
          set page_order [string trim $value " ."]
          my page_order $page_order
          return [expr {![regexp {[^0-9a-zA-Z_.]} $page_order]}]
        }
        return 1
      }
    
  • instproc view

    ::1382845 instproc view {{content {}}} {
        # The method "view" is used primarily for the toplevel call, when
        # the xowiki page is viewed.  It is not intended for e.g. embedded
        # wiki pages (see include), since it contains full framing, etc.
        my instvar item_id 
        ::xowiki::Page set recursion_count 0
        set page_package_id    [my package_id]
        set context_package_id [::xo::cc package_id]
    
        #my msg "page_package_id=$page_package_id, context_package_id=$context_package_id"
    
        set template_file [my query_parameter "template_file"  [::$context_package_id get_parameter template_file view-default]]
    
        if {[my isobject ::xowiki::$template_file]} {
          $template_file before_render [self]
        }
    
        #
        # set up template variables
        #
        set object_type [$page_package_id get_parameter object_type [my info class]]
        set rev_link    [$page_package_id make_link -with_entities 0 [self] revisions]
        
        if {[$context_package_id query_parameter m ""] eq "edit"} {
          set view_link [$page_package_id make_link -with_entities 0 [self] view return_url]
          set edit_link ""
        } else {
          set edit_link [$page_package_id make_link -with_entities 0 [self] edit return_url]
          set view_link ""
        }
        set delete_link [$page_package_id make_link -with_entities 0 [self] delete return_url]
        if {[my exists __link(new)]} {
          set new_link [my set __link(new)]
        } else {
          set new_link [my new_link $page_package_id]
        }
        
        set admin_link  [$context_package_id make_link -privilege admin -link admin/ $context_package_id {} {}] 
        set index_link  [$context_package_id make_link -privilege public -link "" $context_package_id {} {}]
        set import_link [$context_package_id make_link -privilege admin -link "" $context_package_id {} {}]
        set page_show_link [$page_package_id make_link -privilege admin [self] show-object return_url]
    
        set notification_subscribe_link ""
        if {[$context_package_id get_parameter "with_notifications" 1]} {
          if {[::xo::cc user_id] != 0} { ;# notifications require login
            set notifications_return_url [expr {[info exists return_url] ? $return_url : [ad_return_url]}]
            set notification_type [notification::type::get_type_id -short_name xowiki_notif]
            set notification_text "Subscribe the XoWiki instance"
            set notification_subscribe_link  [export_vars -base /notifications/request-new  {{return_url $notifications_return_url}
                       {pretty_name $notification_text} 
                       {type_id $notification_type} 
                       {object_id $context_package_id}}]
            set notification_image  "<img style='border: 0px;' src='/resources/xowiki/email.png'  alt='$notification_text' title='$notification_text'>"
          }
        }
    
        # the menubar is work in progress
        set mb [$context_package_id get_parameter "MenuBar" 0]
        if {$mb ne "0" && [info command ::xowiki::MenuBar] ne ""} {
    
          set clipboard_size [::xowiki::clipboard size]
          set clipboard_label [expr {$clipboard_size ? "Clipboard ($clipboard_size)" : "Clipboard"}]
          #
          # Define standard xowiki menubar
          #
          
          set mb [::xowiki::MenuBar create ::__xowiki__MenuBar -id menubar]
          $mb add_menu -name Package -label [$context_package_id instance_name]
          $mb add_menu -name New
          $mb add_menu -name Clipboard -label $clipboard_label
          $mb add_menu -name Page
          $mb add_menu_item -name Package.Startpage  -item [list text Index url $index_link]
          $mb add_menu_item -name Package.Subscribe  -item [list text Subscribe url $notification_subscribe_link]
          $mb add_menu_item -name Package.Notifications  -item [list text Notifications url /notifications/manage]
          $mb add_menu_item -name Package.Admin  -item [list text Admin url $admin_link]
          $mb add_menu_item -name Package.ImportDump  -item [list url $import_link]
          $mb add_menu_item -name New.Page  -item [list text New Page url $new_link]
          $mb add_menu_item -name Page.Edit  -item [list text Edit url $edit_link]
          $mb add_menu_item -name Page.Revisions  -item [list text Revisions url $rev_link]
          $mb add_menu_item -name Page.Delete  -item [list text Delete url $delete_link]
          if {[acs_user::site_wide_admin_p]} {
    	$mb add_menu_item -name Page.Show  -item [list text "Show Object" url $page_show_link]
          }
        }
        
        # the content may be passed by other methods (e.g. edit) to 
        # make use of the same templating machinery below.
        if {$content eq ""} {
          set content [my render]
          #my msg "--after render"
        }
    
        #
        # these variables can be influenced via set-parameter
        #
        set autoname [$page_package_id get_parameter autoname 0]
    
        #
        # setup top includeletes and footers
        #
    
        set footer [my htmlFooter -content $content]
        set top_includelets ""
        set vp [string trim [$context_package_id get_parameter "top_includelet" ""]]
        if {$vp ne "" && $vp ne "none"} {
          set top_includelets [my include $vp]
        }
        
        if {$mb ne "0"} {
          #
          # The following block should not be here, but in the templates
          #
          set showFolders [$context_package_id get_parameter "MenuBarWithFolder" 1]
          if {$showFolders} {
            set folderhtml [my include {folders -style folders}]
          } else {
    	set folderhtml ""
          }
    
          #
          # At this place, the menu should be complete, we can render it
          #
          append top_includelets \n "<div class='visual-clear'><!-- --></div>" [$mb render-yui]
        }
    
        if {[$context_package_id get_parameter "with_user_tracking" 1]} {
          my record_last_visited
        }
    
        # Deal with the views package (many thanks to Malte for this snippet!)
        if {[$context_package_id get_parameter with_views_package_if_available 1] 
    	&& [apm_package_installed_p "views"]} {
          views::record_view -object_id $item_id -viewer_id [::xo::cc user_id]
          array set views_data [views::get -object_id $item_id]
        }
    
        # import title, name and text into current scope
        my instvar title name text
    
        if {[my exists_query_parameter return_url]} {
          set return_url [my query_parameter return_url]
        }
        
        #my log "--after notifications [info exists notification_image]"
    
        set master [$context_package_id get_parameter "master" 1]
        #if {[my exists_query_parameter "edit_return_url"]} {
        #  set return_url [my query_parameter "edit_return_url"]
        #}
        #my log "--after options master=$master"
        
        if {$master} {
          set context [list $title]
          #my msg "$context_package_id title=[$context_package_id instance_name] - $title"
          #my msg "::xo::cc package_id = [::xo::cc package_id]  ::xo::cc url= [::xo::cc url] "
          ::xo::Page set_property doc title "[$context_package_id instance_name] - $title"
          # We could offer a user to translate the current page to his preferred language
          #
          # set create_in_req_locale_link ""
          # if {[$context_package_id get_parameter use_connection_locale 0]} {
          #  $context_package_id get_lang_and_name -path [$context_package_id set object] req_lang req_local_name
          #  set default_lang [$page_package_id default_language]
          #  if {$req_lang ne $default_lang} {
          #	  set l [Link create new -destroy_on_cleanup  #		     -page [self] -type language -stripped_name $req_local_name  #		     -name ${default_lang}:$req_local_name -lang $default_lang  #		     -label $req_local_name -parent_id [my parent_id] -item_id 0  #	             -package_id $context_package_id -init  #		     -return_only undefined]
          #	  $l render
          #   }
          # }
    
          #my log "--after context delete_link=$delete_link "
          #$context_package_id instvar folder_id  ;# this is the root folder
          #set template [$folder_id get_payload template]
          set template [$context_package_id get_parameter "template" ""]
          set page [self]
    
          foreach css [$context_package_id get_parameter extra_css ""] {::xo::Page requireCSS -order 10 $css}
          # refetch template_file, since it might have been changed via set-parameter
          # the cache flush (next line) is not pretty here and should be supported from xotcl-core
          catch {::xo::cc unset cache([list $context_package_id get_parameter template_file])}
          set template_file [my query_parameter "template_file"  [::$context_package_id get_parameter template_file view-default]]
          # if the template_file does not have a path, assume it in xowiki/www
          if {![regexp {^[./]} $template_file]} {
    	set template_file /packages/xowiki/www/$template_file
          }
    
          #
          # initialize and set the template variables, to be used by
          # a. adp_compile/ adp_eval
          # b. return_page/ adp_include
          #
    	
          set header_stuff [::xo::Page header_stuff]
          if {[info command ::template::head::add_meta] ne ""} {
    	set meta(language) [my lang]
    	set meta(description) [my description]
    	set meta(keywords) ""
    	if {[my istype ::xowiki::FormPage]} {
    	  set meta(keywords) [string trim [my property keywords]]
    	  if {[my property html_title] ne ""} {
    	    ::xo::Page set_property doc title [my property html_title]
    	  }
    	}
    	if {$meta(keywords) eq ""} {
    	  set meta(keywords) [$context_package_id get_parameter keywords ""]
    	}
    	foreach i [array names meta] {
    	  # don't set empty meta tags
    	  if {$meta($i) eq ""} continue
    	  template::head::add_meta -name $i -content $meta($i)
    	}
          }
          
          #
          # pass variables for properties doc and body
          # example: ::xo::Page set_property body class "yui-skin-sam"
          #
          array set property_body [::xo::Page get_property body]
          array set property_doc  [::xo::Page get_property doc]
          
          if {$page_package_id != $context_package_id} {
    	set page_context [$page_package_id instance_name]
          }
    
          if {$template ne ""} {
            set __including_page $page
            set __adp_stub [acs_root_dir]/packages/xowiki/www/view-default
            set template_code [template::adp_compile -string $template]
    	#
    	# make sure that <master/> and <slave/> tags are processed
    	#
    	append template_code {
    	  if { [info exists __adp_master] } {
    	    set __adp_output [template::adp_parse $__adp_master   [concat [list __adp_slave $__adp_output]  [array get __adp_properties]]]
    	  }
    	}
            if {[catch {set content [template::adp_eval template_code]} errmsg]} {
              ns_return 200 text/html "Error in Page $name: $errmsg<br />$template"
            } else {
              ns_return 200 text/html $content
            }
          } else {
            # use adp file
            #my log "use adp"
    	set package_id $context_package_id
            $context_package_id return_page -adp $template_file -variables {
              name title item_id context header_stuff return_url
              content footer package_id page_package_id page_context
              rev_link edit_link delete_link new_link admin_link index_link view_link
              notification_subscribe_link notification_image 
              top_includelets page views_data property_body property_doc
    	  folderhtml
            }
          }
        } else {
          ns_return 200 [::xo::cc get_parameter content-type text/html] $content
        }
      }
    

Methods: Source: Variables:
[All Methods | Documented Methods | Hide Methods] [Display Source | Hide Source] [Show Variables | Hide Variables]