Diff for /loncom/interface/lonhtmlcommon.pm between versions 1.6 and 1.245

version 1.6, 2002/08/01 20:49:06 version 1.245, 2009/11/18 11:47:32
Line 25 Line 25
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
   ######################################################################
   ######################################################################
   
   =pod
   
   =head1 NAME
   
   Apache::lonhtmlcommon - routines to do common html things
   
   =head1 SYNOPSIS
   
   Referenced by other mod_perl Apache modules.
   
   =head1 INTRODUCTION
   
   lonhtmlcommon is a collection of subroutines used to present information
   in a consistent html format, or provide other functionality related to
   html.
   
   =head2 General Subroutines
   
   =over 4
   
   =cut 
   
   ######################################################################
   ######################################################################
   
 package Apache::lonhtmlcommon;  package Apache::lonhtmlcommon;
   
 use strict;  use strict;
   use Time::Local;
   use Time::HiRes;
   use Apache::lonlocal;
   use Apache::lonnet;
   use LONCAPA;
   
   ##############################################
   ##############################################
   
   =pod
   
   =item confirm_success
   
   Successful completion of an operation message
   
   =cut
   
   sub confirm_success {
      my ($message,$failure)=@_;
      if ($failure) {
         return '<span class="LC_error">'."\n"
               .'<img src="/adm/lonIcons/navmap.wrong.gif" alt="'.&mt('Error').'" /> '."\n"
               .$message."\n"
               .'</span>'."\n";
      } else {
         return '<span class="LC_success">'."\n"
               .'<img src="/adm/lonIcons/navmap.correct.gif" alt="'.&mt('OK').'" /> '."\n"
               .$message."\n"
               .'</span>'."\n";
      }
   }
   
   ##############################################
   ##############################################
   
   =pod
   
   =item dragmath_button
   
   Creates a button that launches a dragmath popup-window, in which an 
   expression can be edited and pasted as LaTeX into a specified textarea. 
   
     textarea - Name of the textarea to edit.
     helpicon - If true, show a help icon to the right of the button.
   
   =cut
   
   sub dragmath_button {
       my ($textarea,$helpicon) = @_;
       my $help_text; 
       if ($helpicon) {
           $help_text = &Apache::loncommon::help_open_topic('Authoring_Math_Editor');
       }
       my $buttontext=&mt('Edit Math');
       return <<ENDDRAGMATH;
                   <input type="button" value="$buttontext", onclick="javascript:mathedit('$textarea',document)" />$help_text
   ENDDRAGMATH
   }
   
   ##############################################
   
   =pod
   
 sub AscendOrderOptions {  =item dragmath_js
     my ($order, $page, $formName)=@_;  
   
     my $OpSel1 = '';  Javascript used to open pop-up window containing dragmath applet which 
     my $OpSel2 = '';  can be used to paste LaTeX into a textarea.
    
   =cut
   
   sub dragmath_js {
       my ($popup) = @_;
       return <<ENDDRAGMATHJS;
                   <script type="text/javascript">
                   // <![CDATA[
                     function mathedit(textarea, doc) {
                        targetEntry = textarea;
                        targetDoc   = doc;
                        newwin  = window.open("/adm/dragmath/applet/$popup.html","","width=565,height=500,resizable");
                     }
                   // ]]>
                   </script>
   
   ENDDRAGMATHJS
   }
   
   
   ##############################################
   ##############################################
   
   =pod
   
   =item authorbombs
   
   =cut
   
   ##############################################
   ##############################################
   
   sub authorbombs {
       my $url=shift;
       $url=&Apache::lonnet::declutter($url);
       my ($udom,$uname)=($url=~m{^($LONCAPA::domain_re)/($LONCAPA::username_re)/});
       my %bombs=&Apache::lonmsg::all_url_author_res_msg($uname,$udom);
       foreach my $bomb (keys(%bombs)) {
    if ($bomb =~ /^$udom\/$uname\//) {
       return '<a href="/adm/bombs/'.$url.
    '"><img src="'.&Apache::loncommon::lonhttpdurl('/adm/lonMisc/bomb.gif').'" alt="'.&mt('Bomb').'" border="0" /></a>'.
    &Apache::loncommon::help_open_topic('About_Bombs');
    }
       }
       return '';
   }
   
   ##############################################
   ##############################################
   
   sub recent_filename {
       my $area=shift;
       return 'nohist_recent_'.&escape($area);
   }
   
     if($order eq 'Ascending') {  sub store_recent {
         $OpSel1 = ' selected';      my ($area,$name,$value,$freeze)=@_;
       my $file=&recent_filename($area);
       my %recent=&Apache::lonnet::dump($file);
       if (scalar(keys(%recent))>20) {
   # remove oldest value
    my $oldest=time();
    my $delkey='';
    foreach my $item (keys(%recent)) {
       my $thistime=(split(/\&/,$recent{$item}))[0];
       if (($thistime ne "always_include") && ($thistime<$oldest)) {
    $oldest=$thistime;
    $delkey=$item;
       }
    }
    &Apache::lonnet::del($file,[$delkey]);
       }
   # store new value
       my $timestamp;
       if ($freeze) {
           $timestamp = "always_include";
     } else {      } else {
         $OpSel2 = ' selected';          $timestamp = time();
       }   
       &Apache::lonnet::put($file,{ $name => 
    $timestamp.'&'.&escape($value) });
   }
   
   sub remove_recent {
       my ($area,$names)=@_;
       my $file=&recent_filename($area);
       return &Apache::lonnet::del($file,$names);
   }
   
   sub select_recent {
       my ($area,$fieldname,$event)=@_;
       my %recent=&Apache::lonnet::dump(&recent_filename($area));
       my $return="\n<select name='$fieldname'".
    ($event?" onchange='$event'":'').
    ">\n<option value=''>--- ".&mt('Recent')." ---</option>";
       foreach my $value (sort(keys(%recent))) {
    unless ($value =~/^error\:/) {
       my $escaped = &Apache::loncommon::escape_url($value);
       &Apache::loncommon::inhibit_menu_check(\$escaped);
       $return.="\n<option value='$escaped'>".
    &unescape((split(/\&/,$recent{$value}))[1]).
    '</option>';
    }
     }      }
       $return.="\n</select>\n";
       return $return;
   }
   
     my $Str = '';  sub get_recent {
     $Str .= '<select name="'.(($page)?$page:'').'Ascend"';      my ($area, $n) = @_;
     if($formName) {      my %recent=&Apache::lonnet::dump(&recent_filename($area));
         $Str .= ' onchange="document.'.$formName.'.submit()"';  
   # Create hash with key as time and recent as value
   # Begin filling return_hash with any 'always_include' option
       my %time_hash = ();
       my %return_hash = ();
       foreach my $item (keys(%recent)) {
           my ($thistime,$thisvalue)=(split(/\&/,$recent{$item}));
           if ($thistime eq 'always_include') {
               $return_hash{$item} = &unescape($thisvalue);
               $n--;
           } else {
               $time_hash{$thistime} = $item;
           }
     }      }
     $Str .= '>'."\n";  
     $Str .= '<option'.$OpSel1.'>Ascending</option>'."\n".  
     '<option'.$OpSel2.'>Descending</option>'."\n";  
     $Str .= '</select>'."\n";  
   
     return $Str;  # Sort by decreasing time and return key value pairs
       my $idx = 1;
       foreach my $item (reverse(sort(keys(%time_hash)))) {
          $return_hash{$time_hash{$item}} =
                     &unescape((split(/\&/,$recent{$time_hash{$item}}))[1]);
          if ($n && ($idx++ >= $n)) {last;}
       }
   
       return %return_hash;
 }  }
   
 sub MapOptions {  sub get_recent_frozen {
     my ($data, $page, $formName)=@_;      my ($area) = @_;
     my $Str = '';      my %recent=&Apache::lonnet::dump(&recent_filename($area));
     $Str .= '<select name="';  
     $Str .= (($page)?$page:'').'Maps"';  # Create hash with all 'frozen' items
     if($formName) {      my %return_hash = ();
         $Str .= ' onchange="document.'.$formName.'.submit()"';      foreach my $item (keys(%recent)) {
           my ($thistime,$thisvalue)=(split(/\&/,$recent{$item}));
           if ($thistime eq 'always_include') {
               $return_hash{$item} = &unescape($thisvalue);
           }
     }      }
     $Str .= '>'."\n";      return %return_hash;
   }
   
   
   
   =pod
   
   =item textbox
   
   =cut
   
   ##############################################
   ##############################################
   sub textbox {
       my ($name,$value,$size,$special) = @_;
       $size = 40 if (! defined($size));
       $value = &HTML::Entities::encode($value,'<>&"');
       my $Str = '<input type="text" name="'.$name.'" size="'.$size.'" '.
           'value="'.$value.'" '.$special.' />';
       return $Str;
   }
   
   ##############################################
   ##############################################
   
   =pod
   
     my $selected = 0;  =item checkbox
     foreach my $sequence (split(':',$data->{'orderedSequences'})) {  
  $Str .= '<option';  =cut
         if($data->{$page.'Map'} eq $data->{$sequence.':title'}) {  
             $Str .= ' selected';  ##############################################
             $selected = 1;  ##############################################
         }  sub checkbox {
  $Str .= '>'.$data->{$sequence.':title'}.'</option>'."\n";           my ($name,$checked,$value) = @_;
     }      my $Str = '<input type="checkbox" name="'.$name.'" ';
     $Str .= '<option';      if (defined($value)) {
     if(!$selected) {          $Str .= 'value="'.$value.'"';
         $Str .= ' selected';      } 
       if ($checked) {
           $Str .= ' checked="checked"';
     }      }
     $Str .= '>All Maps</option>'."\n";      $Str .= ' />';
       return $Str;
   }
   
     $Str .= '</select>'."\n";  
   
   =pod
   
   =item radiobutton
   
   =cut
   
   ##############################################
   ##############################################
   sub radio {
       my ($name,$checked,$value) = @_;
       my $Str = '<input type="radio" name="'.$name.'" ';
       if (defined($value)) {
           $Str .= 'value="'.$value.'"';
       } 
       if ($checked eq $value) {
           $Str .= ' checked="checked"';
       }
       $Str .= ' />';
     return $Str;      return $Str;
 }  }
   
 sub StudentOptions {  ##############################################
     my ($cache, $students, $selectedName, $page, $formName)=@_;  ##############################################
   
     my $Str = '';  =pod
     $Str .= '<select name="'.(($page)?$page:'').'Student"';  
     if($formName) {  =item &date_setter
         $Str .= ' onchange="document.'.$formName.'.submit()"';  
   &date_setter returns html and javascript for a compact date-setting form.
   To retrieve values from it, use &get_date_from_form().
   
   Inputs
   
   =over 4
   
   =item $dname 
   
   The name to prepend to the form elements.  
   The form elements defined will be dname_year, dname_month, dname_day,
   dname_hour, dname_min, and dname_sec.
   
   =item $currentvalue
   
   The current setting for this time parameter.  A unix format time
   (time in seconds since the beginning of Jan 1st, 1970, GMT.  
   An undefined value is taken to indicate the value is the current time.
   Also, to be explicit, a value of 'now' also indicates the current time.
   
   =item $special
   
   Additional html/javascript to be associated with each element in
   the date_setter.  See lonparmset for example usage.
   
   =item $includeempty 
   
   =item $state
   
   Specifies the initial state of the form elements.  Either 'disabled' or empty.
   Defaults to empty, which indiciates the form elements are not disabled. 
   
   =back
   
   Bugs
   
   The method used to restrict user input will fail in the year 2400.
   
   =cut
   
   ##############################################
   ##############################################
   sub date_setter {
       my ($formname,$dname,$currentvalue,$special,$includeempty,$state,
           $no_hh_mm_ss,$defhour,$defmin,$defsec,$nolink) = @_;
       my $now = time;
       my $wasdefined=1;
       if (! defined($state) || $state ne 'disabled') {
           $state = '';
       }
       if (! defined($no_hh_mm_ss)) {
           $no_hh_mm_ss = 0;
       }
       if ($currentvalue eq 'now') {
    $currentvalue = $now;
       }
       if ((!defined($currentvalue)) || ($currentvalue eq '')) {
    $wasdefined=0;
    if ($includeempty) {
       $currentvalue = 0;
    } else {
       $currentvalue = $now;
    }
       }
       # other potentially useful values:     wkday,yrday,is_daylight_savings
       my $tzname;
       my ($sec,$min,$hour,$mday,$month,$year)=('','',undef,'','','');
       if ($currentvalue) {
           ($tzname,$sec,$min,$hour,$mday,$month,$year) = &get_timedates($currentvalue); 
       }
       unless ($wasdefined) {
           ($tzname,$sec,$min,$hour,$mday,$month,$year) = &get_timedates($now);
    if (($defhour) || ($defmin) || ($defsec)) {
       $sec=($defsec?$defsec:0);
       $min=($defmin?$defmin:0);
       $hour=($defhour?$defhour:0);
    } elsif (!$includeempty) {
       $sec=0;
       $min=0;
       $hour=0;
    }
       }
       my $result = "\n<!-- $dname date setting form -->\n";
       $result .= <<ENDJS;
   <script type="text/javascript">
   // <![CDATA[
       function $dname\_checkday() {
           var day   = document.$formname.$dname\_day.value;
           var month = document.$formname.$dname\_month.value;
           var year  = document.$formname.$dname\_year.value;
           var valid = true;
           if (day < 1) {
               document.$formname.$dname\_day.value = 1;
           } 
           if (day > 31) {
               document.$formname.$dname\_day.value = 31;
           }
           if ((month == 1)  || (month == 3)  || (month == 5)  ||
               (month == 7)  || (month == 8)  || (month == 10) ||
               (month == 12)) {
               if (day > 31) {
                   document.$formname.$dname\_day.value = 31;
                   day = 31;
               }
           } else if (month == 2 ) {
               if ((year % 4 == 0) && (year % 100 != 0)) {
                   if (day > 29) {
                       document.$formname.$dname\_day.value = 29;
                   }
               } else if (day > 29) {
                   document.$formname.$dname\_day.value = 28;
               }
           } else if (day > 30) {
               document.$formname.$dname\_day.value = 30;
           }
       }
       
       function $dname\_disable() {
           document.$formname.$dname\_month.disabled=true;
           document.$formname.$dname\_day.disabled=true;
           document.$formname.$dname\_year.disabled=true;
           document.$formname.$dname\_hour.disabled=true;
           document.$formname.$dname\_minute.disabled=true;
           document.$formname.$dname\_second.disabled=true;
     }      }
     $Str .= '>'."\n";  
   
     my $selected=0;      function $dname\_enable() {
           document.$formname.$dname\_month.disabled=false;
           document.$formname.$dname\_day.disabled=false;
           document.$formname.$dname\_year.disabled=false;
           document.$formname.$dname\_hour.disabled=false;
           document.$formname.$dname\_minute.disabled=false;
           document.$formname.$dname\_second.disabled=false;        
       }
   
     foreach (@$students) {      function $dname\_opencalendar() {
  $Str .= '<option';          if (! document.$formname.$dname\_month.disabled) {
  if($selectedName eq $_) {              var calwin=window.open(
             $Str .= ' selected';  "/adm/announcements?pickdate=yes&formname=$formname&element=$dname&month="+
             $selected = 1;  document.$formname.$dname\_month.value+"&year="+
   document.$formname.$dname\_year.value,
                "LONCAPAcal",
                 "height=350,width=350,scrollbars=yes,resizable=yes,menubar=no");
           }
   
       }
   // ]]>
   </script>
   ENDJS
       $result .= '  <span class="LC_nobreak">';
       my $monthselector = qq{<select name="$dname\_month" $special $state onchange="javascript:$dname\_checkday()" >};
       # Month
       my @Months = qw/January February  March     April   May      June 
                       July    August    September October November December/;
       # Pad @Months with a bogus value to make indexing easier
       unshift(@Months,'If you can read this an error occurred');
       if ($includeempty) { $monthselector.="<option value=''></option>"; }
       for(my $m = 1;$m <=$#Months;$m++) {
           $monthselector .= qq{      <option value="$m"};
           $monthselector .= ' selected="selected"' if ($m-1 eq $month);
           $monthselector .= '> '.&mt($Months[$m]).' </option>'."\n";
       }
       $monthselector.= '  </select>';
       # Day
       my $dayselector = qq{<input type="text" name="$dname\_day" $state value="$mday" size="3" $special onchange="javascript:$dname\_checkday()" />};
       # Year
       my $yearselector = qq{<input type="text" name="$dname\_year" $state value="$year" size="5" $special onchange="javascript:$dname\_checkday()" />};
       #
       my $hourselector = qq{<select name="$dname\_hour" $special $state >};
       if ($includeempty) { 
           $hourselector.=qq{<option value=''></option>};
       }
       for (my $h = 0;$h<24;$h++) {
           $hourselector .= qq{<option value="$h"};
           $hourselector .= ' selected="selected"' if (defined($hour) && $hour == $h);
           $hourselector .= ">";
           my $timest='';
           if ($h == 0) {
               $timest .= "12 am";
           } elsif($h == 12) {
               $timest .= "12 noon";
           } elsif($h < 12) {
               $timest .= "$h am";
           } else {
               $timest .= $h-12 ." pm";
           }
           $timest=&mt($timest);
           $hourselector .= $timest." </option>\n";
       }
       $hourselector .= "  </select>\n";
       my $minuteselector = qq{<input type="text" name="$dname\_minute" $special $state value="$min" size="3" />};
       my $secondselector= qq{<input type="text" name="$dname\_second" $special $state value="$sec" size="3" />};
       my $cal_link;
       if (!$nolink) {
           $cal_link = qq{<a href="javascript:$dname\_opencalendar()">};
       }
       #
       my $tzone = ' '.$tzname.' ';
       if ($no_hh_mm_ss) {
           $result .= &mt('[_1] [_2] [_3] ',
                          $monthselector,$dayselector,$yearselector).
                      $tzone;
           if (!$nolink) {
               $result .= &mt('[_1]Select Date[_2]',$cal_link,'</a>');
           }
       } else {
           $result .= &mt('[_1] [_2] [_3] [_4] [_5]m [_6]s ',
                         $monthselector,$dayselector,$yearselector,
                         $hourselector,$minuteselector,$secondselector).
                      $tzone;
           if (!$nolink) {
               $result .= &mt('[_1]Select Date[_2]',$cal_link,'</a>');
         }          }
         $Str .= '>';  
         $Str .= $cache->{$_.':fullname'};  
         $Str .= '</option>'."\n";       
     }      }
       $result .= "</span>\n<!-- end $dname date setting form -->\n";
       return $result;
   }
   
     $Str .= '<option';  sub get_timedates {
     if($selectedName eq 'No Student Selected') {      my ($epoch) = @_;
         $Str .= ' selected';      my $dt = DateTime->from_epoch(epoch => $epoch)
         $selected = 1;                       ->set_time_zone(&Apache::lonlocal::gettimezone());
       my $tzname = $dt->time_zone_short_name();
       my $sec = $dt->second;
       my $min = $dt->minute;
       my $hour = $dt->hour;
       my $mday = $dt->day;
       my $month = $dt->month;
       if ($month) {
           $month --;
     }      }
     $Str .= '>No Student Selected</option>'."\n";      my $year = $dt->year;
       return ($tzname,$sec,$min,$hour,$mday,$month,$year);
   }
   
     $Str .= '<option';  sub build_url {
     if(!$selected) {      my ($base, $fields)=@_;
         $Str .= ' selected';      my $url;
       $url = $base.'?';
       foreach my $key (keys(%$fields)) {
           $url.=&escape($key).'='.&escape($$fields{$key}).'&amp;';
     }      }
     $Str .= '>All Students</option>'."\n";      $url =~ s/&amp;$//;
       return $url;
   }
   
     $Str .= '</select>'."\n";  
   
   ##############################################
   ##############################################
   
   =pod
   
   =item &get_date_from_form
   
   get_date_from_form retrieves the date specified in an &date_setter form.
   
   Inputs:
   
   =over 4
   
   =item $dname
   
   The name passed to &date_setter, which prefixes the form elements.
   
   =item $defaulttime
   
   The unix time to use as the default in case of poor inputs.
   
   =back
   
   Returns: Unix time represented in the form.
   
   =cut
   
   ##############################################
   ##############################################
   sub get_date_from_form {
       my ($dname) = @_;
       my ($sec,$min,$hour,$day,$month,$year);
       #
       if (defined($env{'form.'.$dname.'_second'})) {
           my $tmpsec = $env{'form.'.$dname.'_second'};
           if (($tmpsec =~ /^\d+$/) && ($tmpsec >= 0) && ($tmpsec < 60)) {
               $sec = $tmpsec;
           }
    if (!defined($tmpsec) || $tmpsec eq '') { $sec = 0; }
       } else {
           $sec = 0;
       }
       if (defined($env{'form.'.$dname.'_minute'})) {
           my $tmpmin = $env{'form.'.$dname.'_minute'};
           if (($tmpmin =~ /^\d+$/) && ($tmpmin >= 0) && ($tmpmin < 60)) {
               $min = $tmpmin;
           }
    if (!defined($tmpmin) || $tmpmin eq '') { $min = 0; }
       } else {
           $min = 0;
       }
       if (defined($env{'form.'.$dname.'_hour'})) {
           my $tmphour = $env{'form.'.$dname.'_hour'};
           if (($tmphour =~ /^\d+$/) && ($tmphour >= 0) && ($tmphour < 24)) {
               $hour = $tmphour;
           }
       } else {
           $hour = 0;
       }
       if (defined($env{'form.'.$dname.'_day'})) {
           my $tmpday = $env{'form.'.$dname.'_day'};
           if (($tmpday =~ /^\d+$/) && ($tmpday > 0) && ($tmpday < 32)) {
               $day = $tmpday;
           }
       }
       if (defined($env{'form.'.$dname.'_month'})) {
           my $tmpmonth = $env{'form.'.$dname.'_month'};
           if (($tmpmonth =~ /^\d+$/) && ($tmpmonth > 0) && ($tmpmonth < 13)) {
               $month = $tmpmonth;
           }
       }
       if (defined($env{'form.'.$dname.'_year'})) {
           my $tmpyear = $env{'form.'.$dname.'_year'};
           if (($tmpyear =~ /^\d+$/) && ($tmpyear >= 1970)) {
               $year = $tmpyear;
           }
       }
       if (($year<1970) || ($year>2037)) { return undef; }
       if (defined($sec) && defined($min)   && defined($hour) &&
           defined($day) && defined($month) && defined($year)) {
           my $timezone = &Apache::lonlocal::gettimezone();
           my $dt = DateTime->new( year   => $year,
                                   month  => $month,
                                   day    => $day,
                                   hour   => $hour,
                                   minute => $min,
                                   second => $sec,
                                   time_zone => $timezone,
                                 );
           my $epoch_time  = $dt->epoch;
           if ($epoch_time ne '') {
               return $epoch_time;
           } else {
               return undef;
           }
       } else {
           return undef;
       }
   }
   
   ##############################################
   ##############################################
   
   =pod
   
   =item &pjump_javascript_definition()
   
   Returns javascript defining the 'pjump' function, which opens up a
   parameter setting wizard.
   
   =cut
   
   ##############################################
   ##############################################
   sub pjump_javascript_definition {
       my $Str = <<END;
       function pjump(type,dis,value,marker,ret,call,hour,min,sec) {
           parmwin=window.open("/adm/rat/parameter.html?type="+escape(type)
                    +"&value="+escape(value)+"&marker="+escape(marker)
                    +"&return="+escape(ret)
                    +"&call="+escape(call)+"&name="+escape(dis)
                    +"&defhour="+escape(hour)+"&defmin="+escape(min)
                    +"&defsec="+escape(sec),"LONCAPAparms",
                    "height=350,width=350,scrollbars=no,menubar=no");
       }
   END
     return $Str;      return $Str;
 }  }
   
 sub StatusOptions {  ##############################################
     my ($status, $formName)=@_;  ##############################################
   
   =pod
   
   =item &javascript_nothing()
   
   Return an appropriate null for the users browser.  This is used
   as the first arguement for window.open calls when you want a blank
   window that you can then write to.
   
   =cut
   
   ##############################################
   ##############################################
   sub javascript_nothing {
       # mozilla and other browsers work with "''", but IE on mac does not.
       my $nothing = "''";
       my $user_browser;
       my $user_os;
       $user_browser = $env{'browser.type'} if (exists($env{'browser.type'}));
       $user_os      = $env{'browser.os'}   if (exists($env{'browser.os'}));
       if (! defined($user_browser) || ! defined($user_os)) {
           (undef,$user_browser,undef,undef,undef,$user_os) = 
                              &Apache::loncommon::decode_user_agent();
       }
       if ($user_browser eq 'explorer' && $user_os =~ 'mac') {
           $nothing = "'javascript:void(0);'";
       }
       return $nothing;
   }
   
   ##############################################
   ##############################################
   sub javascript_docopen {
       my ($mimetype) = @_;
       $mimetype ||= 'text/html';
       # safari does not understand document.open() and loads "text/html"
       my $nothing = "''";
       my $user_browser;
       my $user_os;
       $user_browser = $env{'browser.type'} if (exists($env{'browser.type'}));
       $user_os      = $env{'browser.os'}   if (exists($env{'browser.os'}));
       if (! defined($user_browser) || ! defined($user_os)) {
           (undef,$user_browser,undef,undef,undef,$user_os) = 
                              &Apache::loncommon::decode_user_agent();
       }
       if ($user_browser eq 'safari' && $user_os =~ 'mac') {
           $nothing = "document.clear()";
       } else {
    $nothing = "document.open('$mimetype','replace')";
       }
       return $nothing;
   }
   
   
   ##############################################
   ##############################################
   
   =pod
   
   =item &StatusOptions()
   
     my $OpSel1 = '';  Returns html for a selection box which allows the user to choose the
     my $OpSel2 = '';  enrollment status of students.  The selection box name is 'Status'.
     my $OpSel3 = '';  
   Inputs:
     if($status eq 'Any')         { $OpSel3 = ' selected'; }  
     elsif($status eq 'Expired' ) { $OpSel2 = ' selected'; }  $status: the currently selected status.  If undefined the value of
     else                         { $OpSel1 = ' selected'; }  $env{'form.Status'} is taken.  If that is undefined, a value of 'Active'
   is used.
   
   $formname: The name of the form.  If defined the onchange attribute of
   the selection box is set to document.$formname.submit().
   
   $size: the size (number of lines) of the selection box.
   
   $onchange: javascript to use when the value is changed.  Enclosed in 
   double quotes, ""s, not single quotes.
   
   Returns: a perl string as described.
   
   =cut
   
   ##############################################
   ##############################################
   sub StatusOptions {
       my ($status, $formName,$size,$onchange,$mult)=@_;
       $size = 1 if (!defined($size));
       if (! defined($status)) {
           $status = 'Active';
           $status = $env{'form.Status'} if (exists($env{'form.Status'}));
       }
   
     my $Str = '';      my $Str = '';
     $Str .= '<select name="Status"';      $Str .= '<select name="Status"';
     if(defined($formName) && $formName ne '') {      if (defined($mult)){
           $Str .= ' multiple="multiple" ';
       }
       if(defined($formName) && $formName ne '' && ! defined($onchange)) {
         $Str .= ' onchange="document.'.$formName.'.submit()"';          $Str .= ' onchange="document.'.$formName.'.submit()"';
     }      }
       if (defined($onchange)) {
           $Str .= ' onchange="'.$onchange.'"';
       }
       $Str .= ' size="'.$size.'" ';
     $Str .= '>'."\n";      $Str .= '>'."\n";
     $Str .= '<option'.$OpSel1.'>Active</option>'."\n";      foreach my $type (['Active',  &mt('Currently Has Access')],
     $Str .= '<option'.$OpSel2.'>Expired</option>'."\n";        ['Future',  &mt('Will Have Future Access')],
     $Str .= '<option'.$OpSel3.'>Any</option>'."\n";        ['Expired', &mt('Previously Had Access')],
         ['Any',     &mt('Any Access Status')]) {
    my ($name,$label) = @$type;
    $Str .= '<option value="'.$name.'" ';
    if ($status eq $name) {
       $Str .= 'selected="selected" ';
    }
    $Str .= '>'.$label.'</option>'."\n";
       }
   
     $Str .= '</select>'."\n";      $Str .= '</select>'."\n";
 }  }
   
 sub MultipleSectionSelect {  ########################################################
     my ($sections,$selectedSections)=@_;  ########################################################
   
     my $Str = '';  =pod
     $Str .= '<select name="Section" multiple="" size="4">'."\n";  
   =item Progess Window Handling Routines
   
   These routines handle the creation, update, increment, and closure of 
   progress windows.  The progress window reports to the user the number
   of items completed and an estimate of the time required to complete the rest.
   
   =over 4
   
   
   =item &Create_PrgWin
   
   Writes javascript to the client to open a progress window and returns a
   data structure used for bookkeeping.
   
   Inputs
   
   =over 4
   
   =item $r Apache request
   
   =item $title The title of the progress window
   
   =item $heading A description (usually 1 line) of the process being initiated.
   
   =item $number_to_do The total number of items being processed.
   
   =item $type Either 'popup' or 'inline' (popup is assumed if nothing is
          specified)
   
   =item $width Specify the width in charaters of the input field.
   
   =item $formname Only useful in the inline case, if a form already exists, this needs to be used and specfiy the name of the form, otherwise the Progress line will be created in a new form of it's own
   
   =item $inputname Only useful in the inline case, if a form and an input of type text exists, use this to specify the name of the input field 
   
   =back
   
   Returns a hash containing the progress state data structure.
   
   
   =item &Update_PrgWin
   
   Updates the text in the progress indicator.  Does not increment the count.
   See &Increment_PrgWin.
   
   Inputs:
   
   =over 4
   
   =item $r Apache request
   
   =item $prog_state Pointer to the data structure returned by &Create_PrgWin
   
   =item $displaystring The string to write to the status indicator
   
   =back
   
   Returns: none
   
   
   =item Increment_PrgWin
   
   Increment the count of items completed for the progress window by 1.  
   
   Inputs:
   
   =over 4
   
   =item $r Apache request
   
   =item $prog_state Pointer to the data structure returned by Create_PrgWin
   
   =item $extraInfo A description of the items being iterated over.  Typically
   'student'.
   
   =back
   
   Returns: none
   
   
   =item Close_PrgWin
   
   Closes the progress window.
   
   Inputs:
   
   =over 4 
   
   =item $r Apache request
   
   =item $prog_state Pointer to the data structure returned by Create_PrgWin
   
   =back
   
     foreach (@$sections) {  Returns: none
         $Str .= '<option';  
         foreach my $selected (@$selectedSections) {  =back
             if($_ eq $selected) {  
                 $Str .= ' selected=""';  =cut
   
   ########################################################
   ########################################################
   
   my $uniq=0;
   sub get_uniq_name {
       $uniq++;
       return 'uniquename'.$uniq;
   }
   
   # Create progress
   sub Create_PrgWin {
       my ($r, $title, $heading, $number_to_do,$type,$width,$formname,
    $inputname)=@_;
       if (!defined($type)) { $type='popup'; }
       if (!defined($width)) { $width=55; }
       my %prog_state;
       $prog_state{'type'}=$type;
       if ($type eq 'popup') {
    $prog_state{'window'}='popwin';
    my $start_page =
       &Apache::loncommon::start_page($title,undef,
      {'only_body' => 1,
       'bgcolor'   => '#88DDFF',
       'js_ready'  => 1});
    my $end_page = &Apache::loncommon::end_page({'js_ready'  => 1});
   
    #the whole function called through timeout is due to issues
    #in mozilla Read BUG #2665 if you want to know the whole story
    &r_print($r,&Apache::lonhtmlcommon::scripttag(
           "var popwin;
            function openpopwin () {
            popwin=open(\'\',\'popwin\',\'width=400,height=100\');".
           "popwin.document.writeln(\'".$start_page.
                 "<h4>".&mt("$heading")."<\/h4>".
                 "<form action=\"\" name=\"popremain\" method=\"post\">".
                 '<input type="text" size="'.$width.'" name="remaining" value="'.
         &mt('Starting').'" /><\\/form>'.$end_page.
                 "\');".
           "popwin.document.close();}".
           "\nwindow.setTimeout(openpopwin,0)"
       ));
    $prog_state{'formname'}='popremain';
    $prog_state{'inputname'}="remaining";
       } elsif ($type eq 'inline') {
    $prog_state{'window'}='window';
    if (!$formname) {
       $prog_state{'formname'}=&get_uniq_name();
       &r_print($r,'<form action="" name="'.$prog_state{'formname'}.'">');
    } else {
       $prog_state{'formname'}=$formname;
    }
    if (!$inputname) {
       $prog_state{'inputname'}=&get_uniq_name();
       &r_print($r,&mt("$heading [_1]",' <input type="text" name="'.$prog_state{'inputname'}.'" size="'.$width.'" />'));
    } else {
       $prog_state{'inputname'}=$inputname;
       
    }
    if (!$formname) { &r_print($r,'</form>'); }
    &Update_PrgWin($r,\%prog_state,&mt('Starting'));
       }
   
       $prog_state{'done'}=0;
       $prog_state{'firststart'}=&Time::HiRes::time();
       $prog_state{'laststart'}=&Time::HiRes::time();
       $prog_state{'max'}=$number_to_do;
       
       return %prog_state;
   }
   
   # update progress
   sub Update_PrgWin {
       my ($r,$prog_state,$displayString)=@_;
       &r_print($r,&Apache::lonhtmlcommon::scripttag(
           $$prog_state{'window'}.'.document.'.
           $$prog_state{'formname'}.'.'.
           $$prog_state{'inputname'}.'.value="'.
           $displayString.'";'
       ));
       $$prog_state{'laststart'}=&Time::HiRes::time();
   }
   
   # increment progress state
   sub Increment_PrgWin {
       my ($r,$prog_state,$extraInfo)=@_;
       $$prog_state{'done'}++;
       my $time_est= (&Time::HiRes::time() - $$prog_state{'firststart'})/
           $$prog_state{'done'} *
    ($$prog_state{'max'}-$$prog_state{'done'});
       $time_est = int($time_est);
       #
       my $min = int($time_est/60);
       my $sec = $time_est % 60;
       # 
       my $str;
       if ($min == 0 && $sec > 1) {
           $str = '[_2] seconds';
       } elsif ($min == 1 && $sec > 1) {
           $str = '1 minute [_2] seconds';
       } elsif ($min == 1 && $sec < 2) {
           $str = '1 minute';
       } elsif ($min < 10 && $sec > 1) {
           $str = '[_1] minutes, [_2] seconds';
       } elsif ($min >= 10 || $sec < 2) {
           $str = '[_1] minutes';
       }
       $time_est = &mt($str,$min,$sec);
       #
       my $lasttime = &Time::HiRes::time()-$$prog_state{'laststart'};
       if ($lasttime > 9) {
           $lasttime = int($lasttime);
       } elsif ($lasttime < 0.01) {
           $lasttime = 0;
       } else {
           $lasttime = sprintf("%3.2f",$lasttime);
       }
       if ($lasttime == 1) {
           $lasttime = '('.$lasttime.' '.&mt('second for').' '.$extraInfo.')';
       } else {
           $lasttime = '('.$lasttime.' '.&mt('seconds for').' '.$extraInfo.')';
       }
       #
       my $user_browser = $env{'browser.type'} if (exists($env{'browser.type'}));
       my $user_os      = $env{'browser.os'}   if (exists($env{'browser.os'}));
       if (! defined($user_browser) || ! defined($user_os)) {
           (undef,$user_browser,undef,undef,undef,$user_os) = 
                              &Apache::loncommon::decode_user_agent();
       }
       if ($user_browser eq 'explorer' && $user_os =~ 'mac') {
           $lasttime = '';
       }
       &r_print($r,&Apache::lonhtmlcommon::scripttag(
           $$prog_state{'window'}.'.document.'.
           $$prog_state{'formname'}.'.'.
           $$prog_state{'inputname'}.'.value="'.
           $$prog_state{'done'}.'/'.$$prog_state{'max'}.
           ': '.$time_est.' '.&mt('remaining').' '.$lasttime.'";'
       ));
       $$prog_state{'laststart'}=&Time::HiRes::time();
   }
   
   # close Progress Line
   sub Close_PrgWin {
       my ($r,$prog_state)=@_;
       if ($$prog_state{'type'} eq 'popup') {
           &r_print($r,&Apache::lonhtmlcommon::scripttag(
               'popwin.close()'
           ));
       } elsif ($$prog_state{'type'} eq 'inline') {
    &Update_PrgWin($r,$prog_state,&mt('Done'));
       }
       undef(%$prog_state);
   }
   
   sub r_print {
       my ($r,$to_print)=@_;
       if ($r) {
    $r->print($to_print);
    $r->rflush();
       } else {
    print($to_print);
       }
   }
   
   # ------------------------------------------------------- Puts directory header
   
   sub crumbs {
       my ($uri,$target,$prefix,$form,$size,$noformat,$skiplast)=@_;
       if (! defined($size)) {
           $size = '+2';
       }
       if ($target) {
           $target = ' target="'.
                     &Apache::loncommon::escape_single($target).'"';
       }
       my $output='';
       unless ($noformat) { $output.='<br /><tt><b>'; }
       $output.='<font size="'.$size.'">'.$prefix.'/';
       if (($env{'user.adv'}) | ($env{'user.author'})) {
    my $path=$prefix.'/';
    foreach my $dir (split('/',$uri)) {
               if (! $dir) { next; }
               $path .= $dir;
       if ($path eq $uri) {
    if ($skiplast) {
       $output.=$dir;
                       last;
    } 
       } else {
    $path.='/'; 
       }    
               my $href_path = &HTML::Entities::encode($path,'<>&"');
       &Apache::loncommon::inhibit_menu_check(\$href_path);
       if ($form) {
           my $href = 'javascript:'.$form.".action='".$href_path."';".$form.'.submit();';
           $output.=qq{<a href="$href" $target>$dir</a>/};
       } else {
           $output.=qq{<a href="$href_path" $target>$dir</a>/};
       }
    }
       } else {
    foreach my $dir (split('/',$uri)) {
               if (! $dir) { next; }
       $output.=$dir.'/';
    }
       }
       if ($uri !~ m|/$|) { $output=~s|/$||; }
       return $output.'</font>'.($noformat?'':'</b></tt><br />');
   }
   
   # --------------------- A function that generates a window for the spellchecker
   
   sub spellheader {
       my $start_page=
    &Apache::loncommon::start_page('Speller Suggestions',undef,
          {'only_body'   => 1,
    'js_ready'    => 1,
    'bgcolor'     => '#DDDDDD',
           'add_entries' => {
       'onload' => 
                                                  'document.forms.spellcheckform.submit()',
                                                }
           });
       my $end_page=
    &Apache::loncommon::end_page({'js_ready'  => 1}); 
   
       my $nothing=&javascript_nothing();
       return (<<ENDCHECK);
   <script type="text/javascript"> 
   // <![CDATA[
   //<!-- BEGIN LON-CAPA Internal
   var checkwin;
   
   function spellcheckerwindow(string) {
       var esc_string = string.replace(/\"/g,'&quot;');
       checkwin=window.open($nothing,'spellcheckwin','height=320,width=280,resizable=yes,scrollbars=yes,location=no,menubar=no,toolbar=no');
       checkwin.document.writeln('$start_page<form name="spellcheckform" action="/adm/spellcheck" method="post"><input type="hidden" name="text" value="'+esc_string+'" /><\\/form>$end_page');
       checkwin.document.close();
   }
   // END LON-CAPA Internal -->
   // ]]>
   </script>
   ENDCHECK
   }
   
   # ---------------------------------- Generate link to spell checker for a field
   
   sub spelllink {
       my ($form,$field)=@_;
       my $linktext=&mt('Check Spelling');
       return (<<ENDLINK);
   <a href="javascript:if (typeof(document.$form.onsubmit)!='undefined') { if (document.$form.onsubmit!=null) { document.$form.onsubmit();}};spellcheckerwindow(this.document.forms.$form.$field.value);">$linktext</a>
   ENDLINK
   }
   
   # ------------------------------------------------- Output headers for HTMLArea
   
   {
       my @htmlareafields;
       sub init_htmlareafields {
    undef(@htmlareafields);
       }
       
       sub add_htmlareafields {
    my (@newfields) = @_;
    push(@htmlareafields,@newfields);
       }
   
       sub get_htmlareafields {
    return @htmlareafields;
       }
   }
   
   sub htmlareaheaders {
       return if (&htmlareablocked());
       return if (!&htmlareabrowser());
       return (<<ENDHEADERS);
   <script type="text/javascript" src="/fckeditor/fckeditor.js"></script>
   ENDHEADERS
   }
   
   # ----------------------------------------------------------------- Preferences
   
   sub disablelink {
       my @fields=@_;
       if (defined($#fields)) {
    unless ($#fields>=0) { return ''; }
       }
       return '<a href="'.&HTML::Entities::encode('/adm/preferences?action=set_wysiwyg&wysiwyg=off&returnurl=','<>&"').&escape($ENV{'REQUEST_URI'}).'">'.&mt('Disable WYSIWYG Editor').'</a>';
   }
   
   sub enablelink {
       my @fields=@_;
       if (defined($#fields)) {
    unless ($#fields>=0) { return ''; }
       }
       return '<a href="'.&HTML::Entities::encode('/adm/preferences?action=set_wysiwyg&wysiwyg=on&returnurl=','<>&"').&escape($ENV{'REQUEST_URI'}).'">'.&mt('Enable WYSIWYG Editor').'</a>';
   }
   
   # ------------------------------------------------- lang to use in html editor
   sub htmlarea_lang {
       my $lang='en';
       if (&mt('htmlarea_lang') ne 'htmlarea_lang') {
    $lang=&mt('htmlarea_lang');
       }
       return $lang;
   }
   
   # ----------------------------------------- Script to activate only some fields
   
   sub htmlareaselectactive {
       my @fields=@_;
       unless (&htmlareabrowser()) { return ''; }
       if (&htmlareablocked()) { return '<br />'.&enablelink(@fields); }
       my $output='<script type="text/javascript" defer="1">'."\n"
                 .'// <![CDATA['."\n";
       my $lang = &htmlarea_lang();
       foreach my $field (@fields) {
    $output.="
   {
       var oFCKeditor = new FCKeditor('$field');
       oFCKeditor.Config['CustomConfigurationsPath'] = 
    '/fckeditor/loncapaconfig.js';    
       oFCKeditor.ReplaceTextarea();
       oFCKeditor.Config['AutoDetectLanguage'] = false;
       oFCKeditor.Config['DefaultLanguage'] = '$lang';
   }";
       }
       $output.="\nwindow.status='Activated Editfields';\n"
               .'// ]]>'."\n"
               .'</script><br />'.
    &disablelink(@fields);
       return $output;
   }
   
   # --------------------------------------------------------------------- Blocked
   
   sub htmlareablocked {
       unless ($env{'environment.wysiwygeditor'} eq 'on') { return 1; }
       return 0;
   }
   
   # ---------------------------------------- Browser capable of running HTMLArea?
   
   sub htmlareabrowser {
       return 1;
   }
   
   ############################################################
   ############################################################
   
   =pod
   
   =item breadcrumbs
   
   Compiles the previously registered breadcrumbs into an series of links.
   Additionally supports a 'component', which will be displayed on the
   right side of the breadcrumbs enclosing div (without a link).
   A link to help for the component will be included if one is specified.
   
   All inputs can be undef without problems.
   
   Inputs: $component (the text on the right side of the breadcrumbs trail),
           $component_help
           $menulink (boolean, controls whether to include a link to /adm/menu)
           $helplink (if 'nohelp' don't include the orange help link)
           $css_class (optional name for the class to apply to the table for CSS)
           $no_mt (optional flag, 1 if &mt() is _not_ to be applied to $component
              when including the text on the right.
   Returns a string containing breadcrumbs for the current page.
   
   =item clear_breadcrumbs
   
   Clears the previously stored breadcrumbs.
   
   =item add_breadcrumb
   
   Pushes a breadcrumb on the stack of crumbs.
   
   input: $breadcrumb, a hash reference.  The keys 'href','title', and 'text'
   are required.  If present the keys 'faq' and 'bug' will be used to provide
   links to the FAQ and bug sites. If the key 'no_mt' is present the 'title' 
   and 'text' values won't be sent through &mt()
   
   returns: nothing    
   
   =cut
   
   ############################################################
   ############################################################
   {
       my @Crumbs;
       my %tools = ();
       
       sub breadcrumbs {
           my ($component,$component_help,$menulink,$helplink,$css_class,$no_mt, $CourseBreadcrumbs) = @_;
           #
           $css_class ||= 'LC_breadcrumbs';
   
           # Make the faq and bug data cascade
           my $faq  = '';
           my $bug  = '';
           my $help = '';
           # Crumb Symbol
           my $crumbsymbol = '&raquo;';
           # The last breadcrumb does not have a link, so handle it separately.
           my $last = pop(@Crumbs);
           #
           # The first one should be the course or a menu link
           if (!defined($menulink)) { $menulink=1; }
           if ($menulink) {
               my $description = 'Menu';
               my $no_mt_descr = 0;
               if (exists($env{'request.course.id'}) && 
                   $env{'request.course.id'} ne '') {
                   $description = 
                       $env{'course.'.$env{'request.course.id'}.'.description'};
                   $no_mt_descr = 1;
             }              }
               $menulink =  {  href   =>'/adm/menu',
                               title  =>'Go to main menu',
                               target =>'_top',
                               text   =>$description,
                               no_mt  =>$no_mt_descr, };
               if($last) {
                   #$last set, so we have some crumbs
                   unshift(@Crumbs,$menulink);
               } else {
                   #only menulink crumb present
                   $last = $menulink;
               }
           }
           my $links = join "", 
                    map {
                        $faq  = $_->{'faq'}  if (exists($_->{'faq'}));
                        $bug  = $_->{'bug'}  if (exists($_->{'bug'}));
                        $help = $_->{'help'} if (exists($_->{'help'}));
   
                        my $result = htmltag( 'a', 
                                              $_->{no_mt} ? 
                                               $_->{text} : mt($_->{text}), 
                                              { 
                                                  href   => $_->{href},
                                                  title  => $_->{no_mt} ? 
                                                   $_->{title} : mt($_->{title}),
                                                  target => $_->{target},
                                              });
                        $result = htmltag( 'li', "$result $crumbsymbol");
                        } @Crumbs;
   
           #should the last Element be translated?
           $links  .= htmltag( 'li', 
                           htmltag( 'b', 
                                    $last->{'no_mt'} ? 
                                    $last->{'text'} : mt($last->{'text'}) ));
   
           my $icons = '';
           $faq  = $last->{'faq'}  if (exists($last->{'faq'}));
           $bug  = $last->{'bug'}  if (exists($last->{'bug'}));
           $help = $last->{'help'} if (exists($last->{'help'}));
           $component_help=($component_help?$component_help:$help);
   #        if ($faq ne '') {
   #            $icons .= &Apache::loncommon::help_open_faq($faq);
   #        }
   #        if ($bug ne '') {
   #            $icons .= &Apache::loncommon::help_open_bug($bug);
   #        }
           if ($faq ne '' || $component_help ne '' || $bug ne '') {
               $icons .= &Apache::loncommon::help_open_menu($component,
                                                            $component_help,
                                                            $faq,$bug);
         }          }
         $Str .= '>'.$_.'</option>'."\n";          #
   
   
           unless ($CourseBreadcrumbs) {
               $links = htmltag('ol',  $links, { id => "LC_MenuBreadcrumbs"   });
           } else {
               $links = htmltag('ul',  $links, { class => "LC_CourseBreadcrumbs" });
           }
   
           if ($component) {
               $links = htmltag('span', 
                                ( $no_mt ? $component : mt($component) ).
                                ( $icons ? $icons : '' ),
                                { class => 'LC_breadcrumbs_component' } )
                                .$links;
           }
           
           #SD START (work in progress!)
           add_tools(\$links);
           #SD END
           $links = htmltag('div', $links, 
                           { id => "LC_breadcrumbs" }) unless ($CourseBreadcrumbs) ;
           add_advtools(\$links);
   
           # Return the @Crumbs stack to what we started with
           push(@Crumbs,$last);
           shift(@Crumbs);
           # Return the breadcrumb's line
           return "$links";
     }      }
     $Str .= '</select>'."\n";  
   
     return $Str;      sub clear_breadcrumbs {
           undef(@Crumbs);
           undef(%tools);
       }
   
       sub add_breadcrumb {
           push(@Crumbs,@_);
       }
       
   
       #SD START (work in progress!)
       sub add_breadcrumb_tool {
           my ($category, $html) = @_;
           return unless $html;
           if (!defined(%tools)) { 
               my %tools = ( A => [], B => [], C => []);
           }
           push @{$tools{$category}}, $html;
       }
   
       sub clear_breadcrumb_tools {
           undef(%tools);
       }
   
       sub add_tools {
           my ($links) = @_;
           return unless defined %tools;
           my $html = '<ul class="LC_bct">';
           for my $category ('A','B') {
               $html .= '<li class="LC_breadcrumb_tools">'
                      . '<ul class="LC_breadcrumb_tools'
                      . " LC_breadcrumb_tools_$category\">";
               for my $item (@{$tools{$category}}){
                   #SD ugly! I'll fix that later on
                   $item =~ s/align="(right|left)"//;
                   $item =~ s/<span(.*?)\/span>//;
                   $html .= "<li>$item</li>";
               }
               $html .= '</li></ul>';
               if ($category eq 'A') { $html .= "<li>$$links</li>"; }
           }
           $$links = $html.'</ul>';
       }
   
       sub add_advtools {
           my ($links) = @_;
           return unless (defined $tools{'C'}) and (scalar (@{$tools{'C'}}) > 0);
           my $html = start_funclist();
           for my $item (@{$tools{'C'}}){
                   next unless $item;
                   $item =~ s/align="(right|left)"//;
                   $html .= add_item_funclist($item);
           }
           $html   .= end_funclist();
           $html    = Apache::loncommon::head_subbox($html);
           $$links .= $html;
       }
       #SD END
   
   } # End of scope for @Crumbs
   
   ############################################################
   ############################################################
   
   # Nested table routines.
   #
   # Routines to display form items in a multi-row table with 2 columns.
   # Uses nested tables to divide form elements into segments.
   # For examples of use see loncom/interface/lonnotify.pm 
   #
   # Can be used in following order: ...
   # &start_pick_box()
   # row1
   # row2
   # row3   ... etc.
   # &submit_row()
   # &end_pick_box()
   #
   # where row1, row 2 etc. are chosen from &role_select_row,&course_select_row,
   # &status_select_row and &email_default_row
   #
   # Can also be used in following order:
   #
   # &start_pick_box()
   # &row_title()
   # &row_closure()
   # &row_title()
   # &row_closure()  ... etc.
   # &submit_row()
   # &end_pick_box()
   #
   # In general a &submit_row() call should proceed the call to &end_pick_box(),
   # as this routine adds a button for form submission.
   # &submit_row() does not require a &row_closure after it.
   #  
   # &start_pick_box() creates a bounding table with 1-pixel wide black border.
   # rows should be placed between calls to &start_pick_box() and &end_pick_box.
   #
   # &row_title() adds a title in the left column for each segment.
   # &row_closure() closes a row with a 1-pixel wide black line.
   #
   # &role_select_row() provides a select box from which to choose 1 or more roles 
   # &course_select_row provides ways of picking groups of courses
   #    radio buttons: all, by category or by picking from a course picker pop-up
   #      note: by category option is only displayed if a domain has implemented 
   #                selection by year, semester, department, number etc.
   #
   # &status_select_row() provides a select box from which to choose 1 or more
   #  access types (current access, prior access, and future access)  
   #
   # &email_default_row() provides text boxes for default e-mail suffixes for
   #  different authentication types in a domain.
   #
   # &row_title() and &row_closure() are called internally by the &*_select_row
   # routines, but can also be called directly to start and end rows which have 
   # needs that are not accommodated by the *_select_row() routines.    
   
   { # Start: row_count block for pick_box
   my @row_count;
   
   sub start_pick_box {
       my ($css_class) = @_;
       if (defined($css_class)) {
    $css_class = 'class="'.$css_class.'"';
       } else {
    $css_class= 'class="LC_pick_box"';
       }
       unshift(@row_count,0);
       my $output = <<"END";
    <table $css_class>
   END
       return $output;
 }  }
   
 sub Title {  sub end_pick_box {
     my ($pageName)=@_;      shift(@row_count);
       my $output = <<"END";
          </table>
   END
       return $output;
   }
   
     my $Str = '';  sub row_headline {
       my $output = <<"END";
              <tr><td colspan="2">
   END
       return $output;
   }
   
     $Str .= '<html><head><title>'.$pageName.'</title></head>'."\n";  sub row_title {
     $Str .= '<body bgcolor="#FFFFFF">'."\n";      my ($title,$css_title_class,$css_value_class, $css_value_furtherAttributes) = @_;
     $Str .= '<script>window.focus(); window.width=500;window.height=500;';      $row_count[0]++;
     $Str .= '</script>'."\n";      my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
     $Str .= '<table width="100%"><tr><td valign="top">';      $css_title_class ||= 'LC_pick_box_title';
     $Str .= '<h1> Course: ';      $css_title_class = 'class="'.$css_title_class.'"';
     $Str .= $ENV{'course.'.$ENV{'request.course.id'}.'.description'};  
     $Str .= '</h1></td><td align="right">'."\n";  
     $Str .= '<img align="right" src=/adm/lonIcons/lonlogos.gif>';  
     $Str .= '</td></tr></table>'."\n";  
   
     return $Str;      $css_value_class ||= 'LC_pick_box_value';
   
       if ($title ne '') {
           $title .= ':';
       }
       my $output = <<"ENDONE";
              <tr class="LC_pick_box_row" $css_value_furtherAttributes> 
               <td $css_title_class>
          $title
               </td>
               <td class="$css_value_class $css_class">
   ENDONE
       return $output;
 }  }
   
 =pod  sub row_closure {
       my ($no_separator) =@_;
       my $output = <<"ENDTWO";
               </td>
              </tr>
   ENDTWO
       if (!$no_separator) {
           $output .= <<"ENDTWO";
              <tr>
               <td colspan="2" class="LC_pick_box_separator">
               </td>
              </tr>
   ENDTWO
       }
       return $output;
   }
   
 =item &CreateTableHeadings()  } # End: row_count block for pick_box
   
 This function generates the column headings for the chart.  
   
 =over 4  sub role_select_row {
       my ($roles,$title,$css_class,$show_separate_custom,$cdom,$cnum) = @_;
       my $crstype = 'Course';
       if ($cdom ne '' && $cnum ne '') {
           $crstype = &Apache::loncommon::course_type($cdom.'_'.$cnum);
       }
       my $output;
       if (defined($title)) {
           $output = &row_title($title,$css_class);
       }
       $output .= qq|
                                     <select name="roles" multiple="multiple">\n|;
       foreach my $role (@$roles) {
           my $plrole;
           if ($role eq 'ow') {
               $plrole = &mt('Course Owner');
           } elsif ($role eq 'cr') {
               if ($show_separate_custom) {
                   if ($cdom ne '' && $cnum ne '') {
                       my %course_customroles = &course_custom_roles($cdom,$cnum);
                       foreach my $crrole (sort(keys(%course_customroles))) {
                           my ($plcrrole) = ($crrole =~ m|^cr/[^/]+/[^/]+/(.+)$|);
                           $output .= '  <option value="'.$crrole.'">'.$plcrrole.
                                      '</option>';
                       }
                   }
               } else {
                   $plrole = &mt('Custom Role');
               }
           } else {
               $plrole=&Apache::lonnet::plaintext($role,$crstype);
           }
           if (($role ne 'cr') || (!$show_separate_custom)) {
               $output .= '  <option value="'.$role.'">'.$plrole.'</option>';
           }
       }
       $output .= qq|                </select>\n|;
       if (defined($title)) {
           $output .= &row_closure();
       }
       return $output;
   }
   
 Inputs: $CacheData, $keyID, $headings, $spacePadding  sub course_select_row {
       my ($title,$formname,$totcodes,$codetitles,$idlist,$idlist_titles,
    $css_class,$crstype) = @_;
       my $output = &row_title($title,$css_class);
       $output .= &course_selection($formname,$totcodes,$codetitles,$idlist,$idlist_titles,$crstype);
       $output .= &row_closure();
       return $output;
   }
   
 $CacheData: pointer to a hash tied to the cached data database  sub course_selection {
       my ($formname,$totcodes,$codetitles,$idlist,$idlist_titles,$crstype) = @_;
       my $output = qq|
   <script type="text/javascript">
   // <![CDATA[
       function coursePick (formname) {
           for  (var i=0; i<formname.coursepick.length; i++) {
               if (formname.coursepick[i].value == 'category') {
                   courseSet('');
               }
               if (!formname.coursepick[i].checked) {
                   if (formname.coursepick[i].value == 'specific') {
                       formname.coursetotal.value = 0;
                       formname.courselist = '';
                   }
               }
           }
       }
       function setPick (formname) {
           for  (var i=0; i<formname.coursepick.length; i++) {
               if (formname.coursepick[i].value == 'category') {
                   formname.coursepick[i].checked = true;
               }
               formname.coursetotal.value = 0;
               formname.courselist = '';
           }
       }
   // ]]>
   </script>
       |;
   
       my ($allcrs,$pickspec);
       if ($crstype eq 'Community') {
           $allcrs = &mt('All communities');
           $pickspec = &mt('Pick specific communities:');
       } else {
           $allcrs = &mt('All courses');
           $pickspec = &mt('Pick specific course(s):');
       }
   
 $keyID: a pointer to an array containing the names of the data       my $courseform='<b>'.&Apache::loncommon::selectcourse_link
 held in a column and is used as part of a key into $CacheData                       ($formname,'pickcourse','pickdomain','coursedesc','',1,$crstype).'</b>';
           $output .= '<input type="radio" name="coursepick" value="all" onclick="coursePick(this.form)" />'.$allcrs.'<br />';
       if ($totcodes > 0) {
           my $numtitles = @$codetitles;
           if ($numtitles > 0) {
               $output .= '<input type="radio" name="coursepick" value="category" onclick="coursePick(this.form);alert('."'".&mt('Choose categories, from left to right')."'".')" />'.&mt('Pick courses by category:').' <br />';
               $output .= '<table><tr><td>'.$$codetitles[0].'<br />'."\n".
                  '<select name="'.$$codetitles[0].
                  '" onChange="setPick(this.form);courseSet('."'$$codetitles[0]'".')">'."\n".
                  ' <option value="-1" />Select'."\n";
               my @items = ();
               my @longitems = ();
               if ($$idlist{$$codetitles[0]} =~ /","/) {
                   @items = split(/","/,$$idlist{$$codetitles[0]});
               } else {
                   $items[0] = $$idlist{$$codetitles[0]};
               }
               if (defined($$idlist_titles{$$codetitles[0]})) {
                   if ($$idlist_titles{$$codetitles[0]} =~ /","/) {
                       @longitems = split(/","/,$$idlist_titles{$$codetitles[0]});
                   } else {
                       $longitems[0] = $$idlist_titles{$$codetitles[0]};
                   }
                   for (my $i=0; $i<@longitems; $i++) {
                       if ($longitems[$i] eq '') {
                           $longitems[$i] = $items[$i];
                       }
                   }
               } else {
                   @longitems = @items;
               }
               for (my $i=0; $i<@items; $i++) {
                   $output .= ' <option value="'.$items[$i].'">'.$longitems[$i].'</option>';
               }
               $output .= '</select></td>';
               for (my $i=1; $i<$numtitles; $i++) {
                   $output .= '<td>'.$$codetitles[$i].'<br />'."\n".
                             '<select name="'.$$codetitles[$i].
                             '" onChange="courseSet('."'$$codetitles[$i]'".')">'."\n".
                             '<option value="-1">&lt;-Pick '.$$codetitles[$i-1].'</option>'."\n".
                             '</select>'."\n".
                             '</td>';
               }
               $output .= '</tr></table><br />';
           }
       }
       $output .= '<input type="radio" name="coursepick" value="specific" onclick="coursePick(this.form);opencrsbrowser('."'".$formname."','dccourse','dcdomain','coursedesc','','1','$crstype'".')" />'.$pickspec.' '.$courseform.'&nbsp;&nbsp;<input type="text" value="0" size="4" name="coursetotal" /><input type="hidden" name="courselist" value="" />selected.<br />'."\n";
       return $output;
   }
   
 $headings: The names of the headings for the student information  sub status_select_row {
       my ($types,$title,$css_class) = @_;
       my $output; 
       if (defined($title)) {
           $output = &row_title($title,$css_class,'LC_pick_box_select');
       }
       $output .= qq|
                                       <select name="types" multiple="multiple">\n|;
       foreach my $status_type (sort(keys(%{$types}))) {
           $output .= '  <option value="'.$status_type.'">'.$$types{$status_type}.'</option>';
       }
       $output .= qq|                   </select>\n|; 
       if (defined($title)) {
           $output .= &row_closure();
       }
       return $output;
   }
   
 $spacePadding: The spaces to go between columns  sub email_default_row {
       my ($authtypes,$title,$descrip,$css_class) = @_;
       my $output = &row_title($title,$css_class);
       $output .= $descrip.
    &Apache::loncommon::start_data_table().
    &Apache::loncommon::start_data_table_header_row().
    '<th>'.&mt('Authentication Method').'</th>'.
    '<th align="right">'.&mt('Username -> e-mail conversion').'</th>'."\n".
    &Apache::loncommon::end_data_table_header_row();
       my $rownum = 0;
       foreach my $auth (sort(keys(%{$authtypes}))) {
           my ($userentry,$size);
           if ($auth =~ /^krb/) {
               $userentry = '';
               $size = 25;
           } else {
               $userentry = 'username@';
               $size = 15;
           }
           $output .= &Apache::loncommon::start_data_table_row().
       '<td>  '.$$authtypes{$auth}.'</td>'.
       '<td align="right">'.$userentry.
       '<input type="text" name="'.$auth.'" size="'.$size.'" /></td>'.
       &Apache::loncommon::end_data_table_row();
       }
       $output .= &Apache::loncommon::end_data_table();
       $output .= &row_closure();
       return $output;
   }
   
 Output: $Str  
   
 $Str: A formatted string of the table column headings.  sub submit_row {
       my ($title,$cmd,$submit_text,$css_class) = @_;
       my $output = &row_title($title,$css_class,'LC_pick_box_submit');
       $output .= qq|
                <br />
                <input type="hidden" name="command" value="$cmd" />
                <input type="submit" value="$submit_text"/> &nbsp;
                <br /><br />
               \n|;
       return $output;
   }
   
 =back  sub course_custom_roles {
       my ($cdom,$cnum) = @_;
       my %returnhash=();
       my %coursepersonnel=&Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
       foreach my $person (sort(keys(%coursepersonnel))) {
           my ($role) = ($person =~ /^([^:]+):/);
           my ($end,$start) = split(/:/,$coursepersonnel{$person});
           if ($end == -1 && $start == -1) {
               next;
           }
           if ($role =~ m|^cr/[^/]+/[^/]+/[^/]|) {
               $returnhash{$role} ++;
           }
       }
       return %returnhash;
   }
   
 =cut  
   
 sub CreateHeadings {  ##############################################
     my ($data,$keyID,$headings,$displayString,$format)=@_;  ##############################################
     my $Str='';  
     my $formatting = '';  
   
     for(my $index=0; $index<(scalar @$headings); $index++) {  
   my $currentHeading=$headings->[$index];  
         if($format eq 'preformatted') {  
             my @dataLength=split(//,$currentHeading);  
             my $length=scalar @dataLength;  
             $formatting = (' 'x  
                       ($data->{$keyID->[$index].':columnWidth'}-$length));  
         }  
         my $linkdata=$keyID->[$index];  
   
         my $tempString = $displayString;  
         $tempString =~ s/LINKDATA/$linkdata/;  
         $tempString =~ s/DISPLAYDATA/$currentHeading/;  
         $tempString =~ s/FORMATTING/$formatting/;  
   
         $Str .= $tempString;  # topic_bar
   #
   # Generates a div containing an (optional) numbered (static) image followed by a 
   # title with a background color defined in the corresponding CSS: LC_topic_bar
   # Inputs:
   # 1. number to display (corresponding static image should exist).
   #    img tag will be included if arg is an integer in the range 1 to 9. 
   # 2. title text to display.
   # Outputs - a scalar containing html mark-up for the div.
   
   sub topic_bar {
       my ($imgnum,$title) = @_;
       my $imgtag;
       if ($imgnum =~ /^[1-9]$/) {
           $imgtag = '<img src="/res/adm/pages/bl_step'.$imgnum.'.gif"'. 
                     ' alt="'.&mt('Step [_1]',$imgnum).'" /> ';
     }      }
       return '<div class="LC_topic_bar">'.$imgtag.$title.'</div>';
   }
   
     return $Str;  ##############################################
   ##############################################
                                                                                
   # echo_form_input
   #
   # Generates html markup to add form elements from the referrer page
   # as hidden form elements (values encoded) in the new page.
   #
   # Intended to support two types of use 
   # (a) to allow backing up to earlier pages in a multi-page 
   # form submission process using a breadcrumb trail.
   #
   # (b) to allow the current page to be reloaded with form elements
   # set on previous page to remain unchanged.  An example would
   # be where the a page containing a dynamically-built table of data is 
   # is to be redisplayed, with only the sort order of the data changed. 
   #  
   # Inputs:
   # 1. Reference to array of form elements in the submitted form on 
   # the referrer page which are to be excluded from the echoed elements.
   #
   # 2. Reference to array of regular expressions, which if matched in the  
   # name of the form element n the referrer page will be omitted from echo. 
   #
   # Outputs: A scalar containing the html markup for the echoed form
   # elements (all as hidden elements, with values encoded). 
   
   
   sub echo_form_input {
       my ($excluded,$regexps) = @_;
       my $output = '';
       foreach my $key (keys(%env)) {
           if ($key =~ /^form\.(.+)$/) {
               my $name = $1;
               my $match = 0;
               if ((!@{$excluded}) || (!grep/^$name$/,@{$excluded})) {
                   if (defined($regexps)) {
                       if (@{$regexps} > 0) {
                           foreach my $regexp (@{$regexps}) {
                               if ($name =~ /\Q$regexp\E/) {
                                   $match = 1;
                                   last;
                               }
                           }
                       }
                   }
                   if (!$match) {
                       if (ref($env{$key})) {
                           foreach my $value (@{$env{$key}}) {
                               $value = &HTML::Entities::encode($value,'<>&"');
                               $output .= '<input type="hidden" name="'.$name.
                                                '" value="'.$value.'" />'."\n";
                           }
                       } else {
                           my $value = &HTML::Entities::encode($env{$key},'<>&"');
                           $output .= '<input type="hidden" name="'.$name.
                                                '" value="'.$value.'" />'."\n";
                       }
                   }
               }
           }
       }
       return $output;
   }
   
   ##############################################
   ##############################################
                                                                                
   # set_form_elements
   #
   # Generates javascript to set form elements to values based on
   # corresponding values for the same form elements when the page was
   # previously submitted.
   #     
   # Last submission values are read from hidden form elements in referring 
   # page which have the same name, i.e., generated by &echo_form_input(). 
   #
   # Intended to be called by onload event.
   #
   # Inputs:
   # (a) Reference to hash of echoed form elements to be set.
   #
   # In the hash, keys are the form element names, and the values are the
   # element type (selectbox, radio, checkbox or text -for textbox, textarea or
   # hidden).
   #
   # (b) Optional reference to hash of stored elements to be set.
   #
   # If the page being displayed is a page which permits modification of
   # previously stored data, e.g., the first page in a multi-page submission,
   # then if stored is supplied, form elements will be set to the last stored
   # values.  If user supplied values are also available for the same elements
   # these will replace the stored values. 
   #        
   # Output:
   #  
   # javascript function - set_form_elements() which sets form elements,
   # expects an argument: formname - the name of the form according to 
   # the DOM, e.g., document.compose
   
   sub set_form_elements {
       my ($elements,$stored) = @_;
       my %values;
       my $output .= 'function setFormElements(courseForm) {
   ';
       if (defined($stored)) {
           foreach my $name (keys(%{$stored})) {
               if (exists($$elements{$name})) {
                   if (ref($$stored{$name}) eq 'ARRAY') {
                       $values{$name} = $$stored{$name};
                   } else {
                       @{$values{$name}} = ($$stored{$name});
                   }
               }
           }
       }
   
       foreach my $key (keys(%env)) {
           if ($key =~ /^form\.(.+)$/) {
               my $name = $1;
               if (exists($$elements{$name})) {
                   @{$values{$name}} = &Apache::loncommon::get_env_multiple($key);
               }
           }
       }
   
       foreach my $name (keys(%values)) {
           for (my $i=0; $i<@{$values{$name}}; $i++) {
               $values{$name}[$i] = &HTML::Entities::decode($values{$name}[$i],'<>&"');
               $values{$name}[$i] =~ s/([\r\n\f]+)/\\n/g;
               $values{$name}[$i] =~ s/"/\\"/g;
           }
           if (($$elements{$name} eq 'text') || ($$elements{$name} eq 'hidden')) {
               my $numvalues = @{$values{$name}};
               if ($numvalues > 1) {
                   my $valuestring = join('","',@{$values{$name}});
                   $output .= qq|
     var textvalues = new Array ("$valuestring");
     var total = courseForm.elements['$name'].length;
     if (total > $numvalues) {
         total = $numvalues;
     }    
     for (var i=0; i<total; i++) {
         courseForm.elements['$name']\[i].value = textvalues[i];
     }
   |;
               } else {
                   $output .= qq|
     courseForm.elements['$name'].value = "$values{$name}[0]";
   |;
               }
           } else {
               $output .=  qq|
     var elementLength = courseForm.elements['$name'].length;
     if (elementLength==undefined) {
   |;
               foreach my $value (@{$values{$name}}) {
                   if ($$elements{$name} eq 'selectbox') {
                       $output .=  qq|
         if (courseForm.elements['$name'].options[0].value == "$value") {
             courseForm.elements['$name'].options[0].selected = true;
         }|;
                   } elsif (($$elements{$name} eq 'radio') ||
                            ($$elements{$name} eq 'checkbox')) {
                       $output .= qq|
         if (courseForm.elements['$name'].value == "$value") {
             courseForm.elements['$name'].checked = true;
         } else {
             courseForm.elements['$name'].checked = false;
         }|;
                   }
               }
               $output .= qq|
     }
     else {
         for (var i=0; i<courseForm.elements['$name'].length; i++) {
   |;
               if ($$elements{$name} eq 'selectbox') {
                   $output .=  qq|
             courseForm.elements['$name'].options[i].selected = false;|;
               } elsif (($$elements{$name} eq 'radio') || 
                        ($$elements{$name} eq 'checkbox')) {
                   $output .= qq|
             courseForm.elements['$name']\[i].checked = false;|; 
               }
               $output .= qq|
         }
         for (var j=0; j<courseForm.elements['$name'].length; j++) {
   |;
               foreach my $value (@{$values{$name}}) {
                   if ($$elements{$name} eq 'selectbox') {
                       $output .=  qq|
             if (courseForm.elements['$name'].options[j].value == "$value") {
                 courseForm.elements['$name'].options[j].selected = true;
             }|;
                   } elsif (($$elements{$name} eq 'radio') ||
                            ($$elements{$name} eq 'checkbox')) { 
                         $output .= qq|
             if (courseForm.elements['$name']\[j].value == "$value") {
                 courseForm.elements['$name']\[j].checked = true;
             }|;
                   }
               }
               $output .= qq|
         }
     }
   |;
           }
       }
       $output .= "
       return;
   }\n";
       return $output;
   }
   
   ##############################################
   ##############################################
   
   # javascript_valid_email
   #
   # Generates javascript to validate an e-mail address.
   # Returns a javascript function which accetps a form field as argumnent, and
   # returns false if field.value does not satisfy two regular expression matches
   # for a valid e-mail address.  Backwards compatible with old browsers without
   # support for javascript RegExp (just checks for @ in field.value in this case). 
   
   sub javascript_valid_email {
       my $scripttag .= <<'END';
   function validmail(field) {
       var str = field.value;
       if (window.RegExp) {
           var reg1str = "(@.*@)|(\\.\\.)|(@\\.)|(\\.@)|(^\\.)";
           var reg2str = "^.+\\@(\\[?)[a-zA-Z0-9\\-\\.]+\\.([a-zA-Z]{2,3}|[0-9]{1,3})(\\]?)$"; //"
           var reg1 = new RegExp(reg1str);
           var reg2 = new RegExp(reg2str);
           if (!reg1.test(str) && reg2.test(str)) {
               return true;
           }
           return false;
       }
       else
       {
           if(str.indexOf("@") >= 0) {
               return true;
           }
           return false;
       }
   }
   END
       return $scripttag;
   }
   
   
   # USAGE: htmltag(element, content, {attribute => value,...});
   #
   # EXAMPLES: 
   #  - htmltag('a', 'this is an anchor', {href  => 'www.example.com', 
   #                                       title => 'this is a title'})
   #
   #  - You might want to set up needed tags like: 
   #
   #     my $h3  = sub { return htmltag( "h3",  @_ ) };
   #
   #    ... and use them: $h3->("This is a headline")
   #
   #  - To set up a couple of tags, see sub inittags
   #
   # NOTES:
   # - Empty elements, such as <br/> are correctly terminated, 
   #   i.e. htmltag('br') returns <br/> 
   # - Empty attributes (title="") are filtered out.
   # - The function will not check for deprecated attributes.
   #
   # OUTPUT: content enclosed in xhtml conform tags
   sub htmltag{
       return
           qq|<$_[0]|
           . join( '', map { qq| $_="${$_[2]}{$_}"| if ${$_[2]}{$_} } keys %{ $_[2] } )
           . ($_[1] ? qq|>$_[1]</$_[0]>| : qq|/>|). "\n";
   };
   
   
   # USAGE: inittags(@tags);
   #
   # EXAMPLES:
   #  - my ($h1, $h2, $h3) = initTags( qw( h1 h2 h3 ) )
   #    $h1->("This is a headline") #Returns: <h1>This is a headline</h1>
   #
   # NOTES: See sub htmltag for further information.
   #
   # OUTPUT: List of subroutines. 
   sub inittags {
       my @tags = @_;
       return map { my $tag = $_;
                    sub { return htmltag( $tag, @_ ) }
                  } @tags;
 }  }
   
   
   # USAGE: scripttag(scriptcode, [start|end|both]);
   #
   # EXAMPLES: 
   #  - scripttag("alert('Hello World!')", 'both') 
   #    returns:
   #    <script type="text/javascript">
   #    // BEGIN LON-CAPA Internal
   #    alert(Hello World!')
   #    // END LON-CAPA Internal
   #    </script>
   #
   # NOTES:
   # - works currently only for javascripts
   #
   # OUTPUT: 
   # Scriptcode properly enclosed in <script> and CDATA tags (and LC
   # Internal markers if 2nd argument is given)
   sub scripttag {
       my ( $content, $marker ) = @_;
       return unless defined $content;
   
       my $begin = "\n// BEGIN LON-CAPA Internal\n";
       my $end   = "\n// END LON-CAPA Internal\n";
   
       if ($marker) {
           $content  = $begin . $content if $marker eq 'start' or $marker eq 'both';
           $content .= $end              if $marker eq 'end'   or $marker eq 'both';
       }
   
       $content = "\n// <![CDATA[\n$content\n// ]]>\n";
   
       return htmltag('script', $content, {type => 'text/javascript'});
   };
   
   
   ##############################################
   ##############################################
   
   # generate_menu
   #
   # Generates html markup for a menu. 
   #
   # Inputs:
   # An array of following structure:
   #   ({ categorytitle => 'Categorytitle',
   # items => [
   #    {
   #           linktext    => 'Text to be displayed',
   # url        => 'URL the link is pointing to, i.e. /adm/site?action=dosomething',
   # permission  => 'Contains permissions as returned from lonnet::allowed(),
   #         must evaluate to true in order to activate the link',
   # icon        =>  'icon filename',
   # alttext    => 'alt text for the icon',
   # help    => 'Name of the corresponding helpfile',
   # linktitle   => 'Description of the link (used for title tag)'
   #    },
   #    ...
   # ]
   #   }, 
   #   ...
   #   )
   #
   # Outputs: A scalar containing the html markup for the menu.
   
   # ---- Remove when done ----
   # This routine is part of the redesign of LON-CAPA and it's 
   # subject to change during this project.
   # Don't rely on its current functionality as it might be 
   # changed or removed.
   # --------------------------
   sub generate_menu {
       my @menu = @_;
       # subs for specific html elements
       my ($h3, $div, $ul, $li, $a, $img) = inittags( qw(h3 div ul li a img) ); 
       
       my @categories; # each element represents the entire markup for a category
      
       foreach my $category (@menu) {
           my @links;  # contains the links for the current $category
           foreach my $link (@{$$category{items}}) {
               next unless $$link{permission};
               
               # create the markup for the current $link and push it into @links.
               # each entry consists of an image and a text optionally followed 
               # by a help link.
               push(@links,$li->(
                           $a->(
                               $img->("", {
                                   class => "LC_noBorder LC_middle",
                                   src   => "/res/adm/pages/$$link{icon}",
                                   alt   => mt(defined($$link{alttext}) ?
                                   $$link{alttext} : $$link{linktext})
                               }), {
                               href  => $$link{url},
                               title => mt($$link{linktitle})
                               }).
                           $a->(mt($$link{linktext}), {
                               href  => $$link{url},
                               title => mt($$link{linktitle}),
                               class => "LC_menubuttons_link"
                               }).
                            (defined($$link{help}) ? 
                            Apache::loncommon::help_open_topic($$link{help}) : ''),
                            {class => "LC_menubuttons_inline_text"}));
           }
   
           # wrap categorytitle in <h3>, concatenate with 
           # joined and in <ul> tags wrapped @links
           # and wrap everything in an enclosing <div> and push it into
           # @categories
           # such that each element looks like:
           # <div><h3>title</h3><ul><li>...</li>...</ul></div>
           # the category won't be added if there aren't any links
           push(@categories, 
               $div->($h3->(mt($$category{categorytitle}), {class=>"LC_hcell"}).
               $ul->(join('' ,@links),  {class =>"LC_ListStyleNormal" }),
               {class=>"LC_Box LC_400Box"})) if scalar(@links);
       }
   
       # wrap the joined @categories in another <div> (column layout)
       return $div->(join('', @categories), {class => "LC_columnSection"});
   }
   
   ##############################################
   ##############################################
   
 =pod  =pod
   
 =item &FormatStudentInformation()  =item &start_funclist
   
   Start list of available functions
   
   Typically used to offer a simple list of available functions
   at top or bottom of page.
   All available functions/actions for the current page
   should be included in this list.
   
 This function produces a formatted string of the student's information:  If the optional headline text is not provided, a default text will be used.
 username, domain, section, full name, and PID.  
   
   
   Related routines:
 =over 4  =over 4
   add_item_funclist
   end_funclist
   =back
   
 Input: $cache, $name, $keyID, $spacePadding  
   
 $cache: This is a pointer to a hash that is tied to the cached data  Inputs: (optional) headline text
   
 $name:  The name and domain of the current student in name:domain format  Returns: HTML code with function list start
   
 $keyID: A pointer to an array holding the names used to  =cut
   
 remove data from the hash.  They represent the name of the data to be removed.  ##############################################
   ##############################################
   
 $spacePadding: Extra spaces that represent the space between columns  sub start_funclist {
       my($legendtext)=@_;
       $legendtext=&mt('Functions') if !$legendtext;
       return '<ul class="LC_funclist"><li style="font-weight:bold; margin-left:0.8em;">'.$legendtext.'</li>'."\n";
   }
   
 Output: $Str  
   
 $Str: Formatted string.  ##############################################
   ##############################################
   
   =pod
   
   =item &add_item_funclist
   
   Adds an item to the list of available functions
   
   Related routines:
   =over 4
   start_funclist
   end_funclist
 =back  =back
   
   Inputs: content item with text and link to function
   
   Returns: HTML code with list item for funclist
   
 =cut  =cut
   
 sub FormatStudentInformation {  ##############################################
     my ($data,$name,$keyID,$displayString,$format)=@_;  ##############################################
     my $Str='';  
     my $currentColumn;  
   
     for(my $index=0; $index<(scalar @$keyID); $index++) {  sub add_item_funclist {
         $currentColumn=$data->{$name.':'.$keyID->[$index]};      my($content) = @_;
       return '<li>'.$content.'</li>'."\n";
   }
   
         if($format eq 'preformatted') {  ##############################################
             my @dataLength=split(//,$currentColumn);  ##############################################
             my $length=scalar @dataLength;  
             $currentColumn.= (' 'x  
                      ($data->{$keyID->[$index].':columnWidth'}-$length));  
         }  
   
         my $tempString = $displayString;  =pod
         $tempString =~ s/DISPLAYDATA/$currentColumn/;  
   
         $Str .= $tempString;  =item &end_funclist
     }  
   
     return $Str;  End list of available functions
   
   Related routines:
   =over 4
   start_funclist
   add_item_funclist
   =back
   
   Inputs: ./.
   
   Returns: HTML code with function list end
   
   =cut
   
   ##############################################
   ##############################################
   
   sub end_funclist {
       my($r)=@_;
       return "</ul>\n</fieldset>\n";
 }  }
   
 1;  1;
   
 __END__  __END__

Removed from v.1.6  
changed lines
  Added in v.1.245


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>