--- loncom/interface/lonhtmlcommon.pm 2004/01/02 16:34:03 1.39 +++ loncom/interface/lonhtmlcommon.pm 2004/02/24 23:19:15 1.56 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common html routines # -# $Id: lonhtmlcommon.pm,v 1.39 2004/01/02 16:34:03 www Exp $ +# $Id: lonhtmlcommon.pm,v 1.56 2004/02/24 23:19:15 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -56,13 +56,85 @@ html. package Apache::lonhtmlcommon; use Time::Local; +use Time::HiRes; use Apache::lonlocal; use strict; +############################################## +############################################## + +=pod + +=item authorbombs + +=cut + +############################################## +############################################## + +sub authorbombs { + my $url=shift; + $url=&Apache::lonnet::declutter($url); + my ($udom,$uname)=($url=~/^(\w+)\/(\w+)\//); + my %bombs=&Apache::lonmsg::all_url_author_res_msg($uname,$udom); + foreach (keys %bombs) { + if ($_=~/^$udom\/$uname\//) { + return ''. + &Apache::loncommon::help_open_topic('About_Bombs'); + } + } + return ''; +} ############################################## ############################################## +sub recent_filename { + my $area=shift; + return 'nohist_recent_'.&Apache::lonnet::escape($area); +} + +sub store_recent { + my ($area,$name,$value)=@_; + my $file=&recent_filename($area); + my %recent=&Apache::lonnet::dump($file); + if (scalar(keys(%recent))>10) { +# remove oldest value + my $oldest=time; + my $delkey=''; + foreach (keys %recent) { + my $thistime=(split(/\&/,$recent{$_}))[0]; + if ($thistime<$oldest) { + $oldest=$thistime; + $delkey=$_; + } + } + &Apache::lonnet::del($file,[$delkey]); + } +# store new value + &Apache::lonnet::put($file,{ $name => + time.'&'.&Apache::lonnet::escape($value) }); +} + +sub select_recent { + my ($area,$fieldname,$event)=@_; + my %recent=&Apache::lonnet::dump(&recent_filename($area)); + my $return="\n\n"; + return $return; +} + + =pod =item textbox @@ -97,8 +169,6 @@ sub checkbox { return $Str; } - - ############################################## ############################################## @@ -455,203 +525,6 @@ sub StatusOptions { $Str .= ''."\n"; } - -######################################################## -######################################################## - -=pod - -=item &MultipleSectionSelect() - -Inputs: - -=over 4 - -=item $sections A references to an array containing the names of all the -sections used in a class. - -=item $selectedSections A reference to an array containing the names of the -currently selected sections. - -=back - -Returns: a string containing HTML for a multiple select box for -selecting sections of a course. - -The form element name is 'Section'. @$sections is sorted prior to output. - -=cut - -######################################################## -######################################################## -sub MultipleSectionSelect { - my ($sections,$selectedSections)=@_; - - my $Str = ''; - $Str .= ''."\n"; - - return $Str; -} - -######################################################## -######################################################## - -=pod - -=item &Title() - -Inputs: $pageName a string containing the name of the page to be sent -to &Apache::loncommon::bodytag. - -Returns: string containing being and complete and -as well as a <script> to focus the current window and change its width -and height to 500. Why? I do not know. If you find out, please update -this documentation. - -=cut - -######################################################## -######################################################## -sub Title { - my ($pageName)=@_; - - my $Str = ''; - - $Str .= '<html><head><title>'.$pageName.''."\n"; - $Str .= &Apache::loncommon::bodytag($pageName)."\n"; - $Str .= ''."\n"; - - return $Str; -} - -######################################################## -######################################################## - -=pod - -=item &CreateHeadings() - -This function generates the column headings for the chart. - -=over 4 - -Inputs: $CacheData, $keyID, $headings, $spacePadding - -$CacheData: pointer to a hash tied to the cached data database - -$keyID: a pointer to an array containing the names of the data -held in a column and is used as part of a key into $CacheData - -$headings: The names of the headings for the student information - -$spacePadding: The spaces to go between columns - -Output: $Str - -$Str: A formatted string of the table column headings. - -=back - -=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; - } - - return $Str; -} - -######################################################## -######################################################## - -=pod - -=item &FormatStudentInformation() - -This function produces a formatted string of the student\'s information: -username, domain, section, full name, and PID. - -=over 4 - -Input: $cache, $name, $keyID, $spacePadding - -$cache: This is a pointer to a hash that is tied to the cached data - -$name: The name and domain of the current student in name:domain format - -$keyID: A pointer to an array holding the names used to - -remove data from the hash. They represent the name of the data to be removed. - -$spacePadding: Extra spaces that represent the space between columns - -Output: $Str - -$Str: Formatted string. - -=back - -=cut - -######################################################## -######################################################## -sub FormatStudentInformation { - my ($data,$name,$keyID,$displayString,$format)=@_; - my $Str=''; - my $currentColumn; - - for(my $index=0; $index<(scalar @$keyID); $index++) { - $currentColumn=$data->{$name.':'.$keyID->[$index]}; - - if($format eq 'preformatted') { - my @dataLength=split(//,$currentColumn); - my $length=scalar @dataLength; - $currentColumn.= (' 'x - ($data->{$keyID->[$index].':columnWidth'}-$length)); - } - - my $tempString = $displayString; - $tempString =~ s/DISPLAYDATA/$currentColumn/; - - $Str .= $tempString; - } - - return $Str; -} - ######################################################## ######################################################## @@ -683,6 +556,15 @@ Inputs =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. @@ -751,38 +633,75 @@ Returns: none ######################################################## ######################################################## +my $uniq=0; +sub get_uniq_name { + $uniq++; + return 'uniquename'.$uniq; +} + # Create progress sub Create_PrgWin { - my ($r, $title, $heading, $number_to_do)=@_; - $r->print('"); + "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,'
'); + } else { + $prog_state{'formname'}=$formname; + } + if (!$inputname) { + $prog_state{'inputname'}=&get_uniq_name(); + &r_print($r,$heading.' '); + } else { + $prog_state{'inputname'}=$inputname; + + } + if (!$formname) { &r_print($r,'
'); } + &Update_PrgWin($r,\%prog_state,&mt('Starting')); + } - my %prog_state; $prog_state{'done'}=0; $prog_state{'firststart'}=&Time::HiRes::time(); $prog_state{'laststart'}=&Time::HiRes::time(); $prog_state{'max'}=$number_to_do; - - $r->rflush(); + return %prog_state; } # update progress sub Update_PrgWin { my ($r,$prog_state,$displayString)=@_; - $r->print(''); + &r_print($r,''); $$prog_state{'laststart'}=&Time::HiRes::time(); - $r->rflush(); } # increment progress state @@ -830,33 +749,51 @@ sub Increment_PrgWin { if ($user_browser eq 'explorer' && $user_os =~ 'mac') { $lasttime = ''; } - $r->print(''); + &r_print($r,''); $$prog_state{'laststart'}=&Time::HiRes::time(); - $r->rflush(); } # close Progress Line sub Close_PrgWin { my ($r,$prog_state)=@_; - $r->print(''."\n"); + if ($$prog_state{'type'} eq 'popup') { + &r_print($r,''."\n"); + } elsif ($$prog_state{'type'} eq 'inline') { + &Update_PrgWin($r,$prog_state,&mt('Done')); + } undef(%$prog_state); - $r->rflush(); } +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)=@_; + my ($uri,$target,$prefix,$form)=@_; my $output='
'.$prefix.'/'; if ($ENV{'user.adv'}) { - my $path=$prefix; + my $path=$prefix.'/'; foreach (split('/',$uri)) { unless ($_) { next; } - $path.='/'.$_; - $output.=''.$_.'/'; + $path.=$_; + unless ($path eq $uri) { $path.='/'; } + my $linkpath=$path; + if ($form) { + $linkpath="javascript:$form.action='$path';$form.submit();"; + } + $output.=''.$_.'/'; } } else { $output.=$uri; @@ -865,6 +802,159 @@ sub crumbs { return $output.'
'; } +# ------------------------------------------------- Output headers for HTMLArea + +sub htmlareaheaders { + unless (&htmlareabrowser()) { return ''; } + my $lang='en'; + return (< + + + +ENDHEADERS +} + +# ---------------------------------------------------------- Script to activate + +sub htmlareaactive { + unless (&htmlareabrowser()) { return ''; } + return (< + HTMLArea.replaceAll(); + +ENDSCRIPT +} + +# ---------------------------------------- Browser capable of running HTMLArea? + +sub htmlareabrowser { + return 1; +} + +############################################################ +############################################################ + +=pod + +=item breadcrumbs + +Compiles the previously registered breadcrumbs into an series of links. +FAQ and BUG links will be placed on the left side of the table if they +are defined for the last registered breadcrumb. +Additionally supports a 'component', which will be displayed on the +right side of the table (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: $color (the background color of the table returned), + $component (the large text on the right side of the table), + $component_help + +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. + +returns: nothing + +=cut + +############################################################ +############################################################ +{ + my @Crumbs; + + sub breadcrumbs { + my ($color,$component,$component_help,$function,$domain) = @_; + if (! defined($color)) { + if (! defined($function)) { + $function = &Apache::loncommon::get_users_function(); + } + $color = &Apache::loncommon::designparm($function.'.tabbg', + $domain); + } + # + my $Str = "\n". + ''. + ''; + # + if (defined($component)) { + $Str .= ''; + } + $Str .= '
'. + ''; + # The last breadcrumb does not have a link, so handle it seperately. + my $last = pop(@Crumbs); + # The first one should be the course, I guess. + if (exists($ENV{'request.course.id'})) { + my $cid = $ENV{'request.course.id'}; + unshift(@Crumbs,{href=>'/adm/menu', + title=>'Go to main menu', + text=>$ENV{'course.'.$cid.'.description'}, + }); + } + my $links .= + join('->', + map { + ''. + $_->{'text'}.'' + } @Crumbs + ); + $links .= '->' if ($links ne ''); + $links .= ''.$last->{'text'}.''; + # + my $icons = ''; + if (exists($last->{'faq'})) { + $icons .= &Apache::loncommon::help_open_faq($last->{'faq'}); + } + if (exists($last->{'bug'})) { + $icons .= &Apache::loncommon::help_open_bug($last->{'bug'}); + } + if ($icons ne '') { + $Str .= $icons.' '; + } + # + $Str .= $links.''. + ''.$component.''; + if (defined($component_help)) { + $Str .= + &Apache::loncommon::help_open_topic($component_help); + } + $Str.= '
'."\n"; + # + # Return the @Crumbs stack to what we started with + push(@Crumbs,$last); + shift(@Crumbs); + # + return $Str; + } + + sub clear_breadcrumbs { + undef(@Crumbs); + } + + sub add_breadcrumb { + push (@Crumbs,@_); + } + +} + +############################################################ +############################################################ + 1;