--- loncom/interface/lonmenu.pm 2003/02/20 18:00:31 1.43
+++ loncom/interface/lonmenu.pm 2003/11/21 21:38:50 1.103
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Routines to control the menu
#
-# $Id: lonmenu.pm,v 1.43 2003/02/20 18:00:31 www Exp $
+# $Id: lonmenu.pm,v 1.103 2003/11/21 21:38:50 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,33 +25,156 @@
#
# http://www.lon-capa.org/
#
-# (TeX Conversion Module
#
-# 05/29/00,05/30 Gerd Kortemeyer)
+# There are two parameters controlling the action of this module:
+#
+# browser.interface - if this is 'textual', it overrides the second parameter
+# and goes to screen reader PDA mode
+#
+# environment.remote - if this is 'on', the routines controll the remote
+# control, otherwise they render the main window controls; ignored it
+# browser.interface is 'textual'
#
-# 10/05,05/28,05/30,06/01,06/08,06/09,07/04,08/07 Gerd Kortemeyer
-# 02/15/02 Matthew Hall
package Apache::lonmenu;
use strict;
use Apache::lonnet;
use Apache::Constants qw(:common);
+use Apache::lonhtmlcommon();
use Apache::loncommon;
use Apache::File;
+use Apache::lonlocal;
+
use vars qw(@desklines $readdesk);
+
+my @inlineremote;
+my $font;
+my $tabbg;
+my $pgbg;
+
+# ================================================================ Little texts
+
+sub initlittle {
+ return &Apache::lonlocal::texthash('ret' => 'Return to Last Location',
+ 'nav' => 'Navigate Contents',
+ 'main' => 'Main Menu',
+ 'launch' => 'Launch Remote Control');
+}
+
# ============================= This gets called at the top of the body section
sub menubuttons {
my $forcereg=shift;
my $target =shift;
my $registration=shift;
- unless ($ENV{'browser.interface'} eq 'textual') { return ''; }
+ my $navmaps='';
+ my $reloadlink='';
+ my $escurl=&Apache::lonnet::escape($ENV{'request.noversionuri'});
+ my $escsymb=&Apache::lonnet::escape($ENV{'request.symb'});
+ if ($ENV{'browser.interface'} eq 'textual') {
# Textual display only
- my $output='Main Menu
';
- if ($registration) { $output.=&innerregister($forcereg,$target); }
- return $output."
";
+ my %lt=&initlittle();
+ $pgbg='#FFFFFF';
+ $tabbg='#FFFFFF';
+ $font='#000000';
+ if ($ENV{'request.course.id'}) {
+ $navmaps=(<$lt{'nav'}
+ENDNAV
+ if (($ENV{'request.noversionuri'}=~/^\/adm\//) &&
+ ($ENV{'request.noversionuri'}!~/^\/adm\/wrapper\//) &&
+ ($ENV{'request.noversionuri'}!~/^\/adm\/.*\/(smppg|bulletinboard|aboutme)(\?|$)/)) {
+ my $escreload=&Apache::lonnet::escape('return:');
+ $reloadlink=(<$lt{'ret'}
+ENDRELOAD
+ }
+ }
+ my $output=(<
+// BEGIN LON-CAPA Internal
+
+$lt{'main'}
+$reloadlink $navmaps
+
+ENDMAINMENU
+ if ($registration) { $output.=&innerregister($forcereg,$target); }
+ return $output."
";
+ } elsif ($ENV{'environment.remote'} eq 'off') {
+# Remote Control is switched off
+# figure out colors
+ my %lt=&initlittle();
+ my $function='student';
+ if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
+ $function='coordinator';
+ }
+ if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {
+ $function='admin';
+ }
+ if (($ENV{'request.role'}=~/^(au|ca)/) ||
+ ($ENV{'request.noversionuri'}=~/^(\/priv|\~)/)) {
+ $function='author';
+ }
+ my $domain=&Apache::loncommon::determinedomain();
+ $pgbg=&Apache::loncommon::designparm($function.'.pgbg',$domain);
+ $tabbg=&Apache::loncommon::designparm($function.'.tabbg',$domain);
+ $font=&Apache::loncommon::designparm($function.'.font',$domain);
+ my $link=&Apache::loncommon::designparm($function.'.link',$domain);
+ my $alink=&Apache::loncommon::designparm($function.'.alink',$domain);
+ my $vlink=&Apache::loncommon::designparm($function.'.vlink',$domain);
+ my $sidebg=&Apache::loncommon::designparm($function.'.sidebg',$domain);
+# Do we have a NAV link?
+ if ($ENV{'request.course.id'}) {
+ $navmaps=(<
+$lt{'nav'}
+ENDNAVREM
+ if (($ENV{'request.noversionuri'}=~/^\/adm\//) &&
+ ($ENV{'request.noversionuri'}!~/^\/adm\/wrapper\//) &&
+ ($ENV{'request.noversionuri'}!~/^\/adm\/.*\/(smppg|bulletinboard|aboutme)(\?|$)/)) {
+ my $escreload=&Apache::lonnet::escape('return:');
+ $reloadlink=(<
+$lt{'ret'}
+ENDRELOAD
+ }
+ }
+ my $reg='';
+ if ($registration) {
+ $reg=&innerregister($forcereg,$target);
+ }
+ return (<
+// BEGIN LON-CAPA Internal
+
+
+
+
+$reg
+ENDINLINEMENU
+ } else {
+ return '';
+ }
}
# ====================================== This gets called in the header section
@@ -60,24 +183,32 @@ sub registerurl {
my $forcereg=shift;
my $target = shift;
my $result = '';
-
+ if ($ENV{'request.noversionuri'} eq '/res/adm/pages/menu.html') { return ''; }
+ my $force_title='';
+ if ($ENV{'request.state'} eq 'construct') {
+ $force_title=&Apache::lonxml::display_title();
+ }
if ($target eq 'edit') {
- $result .="\n";
}
if (($ENV{'browser.interface'} eq 'textual') ||
+ ($ENV{'environment.remote'} eq 'off') ||
((($ENV{'request.publicaccess'}) ||
- (!&Apache::lonnet::is_on_map($ENV{'REQUEST_URI'}))) &&
+ (!&Apache::lonnet::is_on_map(
+ &Apache::lonnet::unescape($ENV{'request.noversionuri'})))) &&
(!$forcereg))) {
- return $result.
- '';
+ return $result.
+ ''.$force_title;
}
# Graphical display after login only
if ($Apache::lonxml::registered && !$forcereg) { return ''; }
- $result.=&innerregister($forcereg,$target);
- return $result;
+ if ($target ne 'edit') {
+ $result.=&innerregister($forcereg,$target);
+ }
+ return $result.$force_title;
}
# =========== This gets called in order to register a URL, both with the Remote
@@ -87,37 +218,72 @@ sub innerregister {
my $forcereg=shift;
my $target = shift;
my $result = '';
+ if ($ENV{'request.noversionuri'} eq '/res/adm/pages/menu.html') { return ''; }
$Apache::lonxml::registered=1;
- my $textual=($ENV{'browser.interface'} eq 'textual');
+ my $textinter=($ENV{'browser.interface'} eq 'textual');
+ my $noremote=($ENV{'environment.remote'} eq 'off');
+
+ my $textual=($textinter || $noremote);
+
+ @inlineremote=();
+ undef @inlineremote;
+
my $reopen=&Apache::lonmenu::reopenmenu();
my $newmail='';
+ if ($noremote) {
+ $newmail='';
+ }
+ if (($textual) && ($ENV{'request.symb'}) && ($ENV{'request.course.id'})) {
+ my ($mapurl,$rid,$resurl)=&Apache::lonnet::decode_symb($ENV{'request.symb'});
+ $newmail.=$ENV{'course.'.$ENV{'request.course.id'}.'.description'};
+ my $maptitle=&Apache::lonnet::gettitle($mapurl);
+ my $restitle=&Apache::lonnet::gettitle($resurl);
+ if ($maptitle) {
+ $newmail.=', '.$maptitle;
+ }
+ if ($restitle) {
+ $newmail.=': '.$restitle;
+ }
+ $newmail.=' ';
+ }
if (&Apache::lonmsg::newmail()) {
$newmail=($textual?
- 'You have new messages ':
+ 'You have new messages ':
'swmenu.setstatus("you have","messages");');
}
+ if ($noremote) {
+ $newmail.=' |
';
+ }
my $timesync=($textual?'':'swmenu.syncclock(1000*'.time.');');
+ my $tablestart=($noremote?'':'').($textinter?'':'');
# =============================================================================
# ============================ This is for URLs that actually can be registered
- if (($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) || ($forcereg)) {
+ if (($ENV{'request.noversionuri'}!~/^\/(res\/)*adm\//) || ($forcereg)) {
# -- This applies to homework problems for users with grading privileges
my $hwkadd='';
if
($ENV{'request.filename'}=~/\.(problem|exam|quiz|assess|survey|form)$/) {
- if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
- $hwkadd.=&switch('','',7,1,'subm.gif','view sub','missions',
+ my $crs='/'.$ENV{'request.course.id'};
+ if ($ENV{'request.course.sec'}) {
+ $crs.='_'.$ENV{'request.course.sec'};
+ }
+ $crs=~s/\_/\//g;
+
+ if (&Apache::lonnet::allowed('vgr',$crs)) {
+ $hwkadd.=&switch('','',7,1,'subm.gif','view sub-','missions',
"gocmd('/adm/grades','submission')",
'View user submissions for this assessment resource');
}
- if (&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) {
+ if (&Apache::lonnet::allowed('mgr',$crs)) {
$hwkadd.=&switch('','',7,2,'pgrd.gif','problem','grades',
"gocmd('/adm/grades','gradingmenu')",
'Modify user grades for this assessment resource');
}
- if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
+ if (&Apache::lonnet::allowed('opa',$crs)) {
$hwkadd.=&switch('','',7,3,'pparm.gif','problem','parms',
"gocmd('/adm/parmset','set')",
'Modify deadlines, etc, for this assessment resource');
@@ -184,15 +350,21 @@ sub innerregister {
my $menuitems=(<$inlineremote[21] |   | $inlineremote[23] |
+$inlineremote[61] | $inlineremote[62] | $inlineremote[63] |
+$inlineremote[71] | $inlineremote[72] | $inlineremote[73] |
+$inlineremote[81] | $inlineremote[82] | $inlineremote[83] |
+$inlineremote[91] | $inlineremote[92] | $inlineremote[93] |
+ENDINLINE
+ }
$result =(<
// BEGIN LON-CAPA Internal
@@ -213,17 +399,19 @@ $utility
$timesync
$newmail
-$buttons
-$hwkadd
-$editbutton
+$tablestart
+$inlinebuttons
+$tableend
$form
ENDREGTEXT
# Registered, graphical output
} else {
+ my $requri=(split(/\?/,$ENV{'request.noversionuri'}))[0];
+ $requri=&Apache::lonnet::unescape($requri);
$result = (<
@@ -236,8 +424,8 @@ var swmenu=null;
$timesync
$newmail
$buttons
- swmenu.currentURL=window.location.pathname;
- swmenu.reloadURL=window.location.pathname;
+ swmenu.currentURL="$requri";
+ swmenu.reloadURL=swmenu.currentURL+window.location.search;
swmenu.currentSymb="$ENV{'request.symb'}";
swmenu.reloadSymb="$ENV{'request.symb'}";
swmenu.currentStale=0;
@@ -259,7 +447,6 @@ var swmenu=null;
'clearbut(2,1);clearbut(2,3);clearbut(8,1);clearbut(8,2);clearbut(8,3);'+
'clearbut(9,1);clearbut(9,2);clearbut(9,3);clearbut(6,3);clearbut(6,1)',
2000);
-
}
// END LON-CAPA Internal
@@ -311,10 +498,12 @@ ENDDONOTREGTHIS
}
sub loadevents() {
+ if ($ENV{'request.noversionuri'} eq '/res/adm/pages/menu.html') { return ''; }
return 'LONCAPAreg();';
}
sub unloadevents() {
+ if ($ENV{'request.noversionuri'} eq '/res/adm/pages/menu.html') { return ''; }
return 'LONCAPAstale();';
}
@@ -322,10 +511,16 @@ sub unloadevents() {
sub startupremote {
my ($lowerurl)=@_;
- if ($ENV{'browser.interface'} eq 'textual') {
+ if (($ENV{'browser.interface'} eq 'textual') ||
+ ($ENV{'environment.remote'} eq 'off')) {
return ('');
}
+#
+# The Remote actually gets launched!
+#
my $configmenu=&rawconfig();
+ my $esclowerurl=&Apache::lonnet::escape($lowerurl);
+
return(<
@@ -355,7 +550,7 @@ function wait() {
$configmenu
window.location='$lowerurl';
} else {
- alert("Remote Control timed out. It is possible that it was blocked by pop-up window filters.");
+ window.location='/adm/remote?action=collapse&url=$esclowerurl';
}
} else {
wheelswitch();
@@ -364,7 +559,7 @@ function wait() {
}
function main() {
- canceltim=setTimeout('tim=1;',60000);
+ canceltim=setTimeout('tim=1;',30000);
window.status='-';
wait();
}
@@ -383,7 +578,8 @@ ENDSETFLAGS
}
sub maincall() {
- if ($ENV{'browser.interface'} eq 'textual') { return ''; }
+ if (($ENV{'browser.interface'} eq 'textual') ||
+ ($ENV{'environment.remote'} eq 'off')) { return ''; }
return(<
main();
@@ -393,18 +589,19 @@ ENDMAINCALL
# ================================================================= Reopen menu
sub reopenmenu {
- my $nothing='';
- if ($ENV{'browser.interface'} eq 'textual') { return ''; }
+ if (($ENV{'browser.interface'} eq 'textual') ||
+ ($ENV{'environment.remote'} eq 'off')) { return ''; }
my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
- if ($ENV{'browser.type'} eq 'explorer') { $nothing='javascript:void(0);'; }
- return('window.open("'.$nothing.'","'.$menuname.'","",false);');
+ my $nothing = &Apache::lonhtmlcommon::javascript_nothing();
+ return('window.open('.$nothing.',"'.$menuname.'","",false);');
}
# =============================================================== Open the menu
sub open {
my $returnval='';
- if ($ENV{'browser.interface'} eq 'textual') { return ''; }
+ if (($ENV{'browser.interface'} eq 'textual') ||
+ ($ENV{'environment.remote'} eq 'off')) { return ''; }
my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
unless (shift eq 'unix') {
# resizing does not work on linux because of virtual desktop sizes
@@ -419,6 +616,7 @@ ENDRESIZE
window.status='Opening LON-CAPA Remote Control';
var menu=window.open("/res/adm/pages/menu.html","$menuname",
"height=350,width=150,scrollbars=no,menubar=no,top=5,left=5,screenX=5,screenY=5");
+self.name='loncapaclient';
ENDOPEN
return '';
}
@@ -428,9 +626,13 @@ ENDOPEN
sub clear {
my ($row,$col)=@_;
- unless ($ENV{'browser.interface'} eq 'textual') {
+ unless (($ENV{'browser.interface'} eq 'textual') ||
+ ($ENV{'environment.remote'} eq 'off')) {
return "\n".qq(window.status+='.';swmenu.clearbut($row,$col););
- } else { return ''; }
+ } else {
+ $inlineremote[10*$row+$col]='';
+ return '';
+ }
}
# ============================================ Switch a button or create a link
@@ -441,17 +643,62 @@ sub switch {
my ($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc,$nobreak)=@_;
$act=~s/\$uname/$uname/g;
$act=~s/\$udom/$udom/g;
- unless ($ENV{'browser.interface'} eq 'textual') {
+ $top=&mt($top);
+ $bot=&mt($bot);
+ $desc=&mt($desc);
+ unless (($ENV{'browser.interface'} eq 'textual') ||
+ ($ENV{'environment.remote'} eq 'off')) {
+# Remote
return "\n".
qq(window.status+='.';swmenu.switchbutton($row,$col,"$img","$top","$bot","$act","$desc"););
+ } elsif ($ENV{'browser.interface'} eq 'textual') {
+# Accessibility
+ if ($nobreak==2) { return ''; }
+ my $text=$top.' '.$bot;
+ $text=~s/\s*\-\s*//gs;
+ if ($nobreak) {
+ $inlineremote[10*$row+$col]=
+ ''.$text.'';
+ } else {
+ $inlineremote[10*$row+$col]="\n
".
+ $desc.' '.$text.'';
+ }
} else {
+# Inline Remote
if ($nobreak==2) { return ''; }
my $text=$top.' '.$bot;
- $text=~s/\- //;
- return "\n".($nobreak?' ':'
').
- ''.$text.' '.
- ($nobreak?'':$desc);
+ $text=~s/\s*\-\s*//gs;
+ my $pic=
+ '';
+ if (($ENV{'browser.interface'} eq 'textual') || ($ENV{'browser.interface'} eq 'faketextual')) {
+# Accessibility
+ if ($nobreak==3) {
+ $inlineremote[10*$row+$col]="\n".
+ ''.$text.
+ ' | '.
+ ''.$pic.' | ';
+ } elsif ($nobreak) {
+ $inlineremote[10*$row+$col]="\n".
+ ''.
+ ''.$pic.
+ ' | '.$text.' | ';
+ } else {
+ $inlineremote[10*$row+$col]="\n
".
+ ''.
+ ''.$pic.
+ ' | '.$desc.
+ ' |
';
+ }
+ } else {
+# Inline Menu
+ $inlineremote[10*$row+$col]=
+ ''.$pic.
+ ''.$desc.
+ '';
+ }
}
+ return '';
}
sub secondlevel {
@@ -470,18 +717,24 @@ sub secondlevel {
sub openmenu {
my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
- if ($ENV{'browser.interface'} eq 'textual') { return ''; }
- if ($ENV{'browser.type'} eq 'explorer') {
- return "window.open('javascript:void(0);','".$menuname."');";
- } else {
- return "window.open('','".$menuname."');";
- }
+ if (($ENV{'browser.interface'} eq 'textual') ||
+ ($ENV{'environment.remote'} eq 'off')) { return ''; }
+ my $nothing = &Apache::lonhtmlcommon::javascript_nothing();
+ return "window.open(".$nothing.",'".$menuname."');";
+}
+
+sub inlinemenu {
+ @inlineremote=();
+ undef @inlineremote;
+ &rawconfig(1);
+ return join('',map { (defined($_)?$_:'') } @inlineremote);
}
sub rawconfig {
my $textualoverride=shift;
my $output='';
- unless ($ENV{'browser.interface'} eq 'textual') {
+ unless (($ENV{'browser.interface'} eq 'textual') ||
+ ($ENV{'environment.remote'} eq 'off')) {
$output.=
"window.status='Opening Remote Control';var swmenu=".&openmenu().
"\nwindow.status='Configuring Remote Control ';";
@@ -525,7 +778,7 @@ sub rawconfig {
$output.=&secondlevel(
$uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act,$desc);
}
- } elsif (($pro=~/p(\w+)/) && ($prt)) {
+ } elsif (($pro=~/^p(\w+)/) && ($prt)) {
if (&Apache::lonnet::allowed($1,$prt)) {
$output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc);
}
@@ -533,6 +786,14 @@ sub rawconfig {
if ($ENV{'request.course.fn'}) {
$output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc);
}
+ } elsif ($pro =~ /^course_(.*)$/) {
+ # Check for permissions inside of a course
+ if (($ENV{'request.course.id'}) &&
+ (&Apache::lonnet::allowed($1,$ENV{'request.course.id'}.
+ ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))
+ )) {
+ $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc);
+ }
} elsif ($pro eq 'author') {
if ($author) {
if ((($prt eq 'rca') && ($ENV{'request.role'}=~/^ca/)) ||
@@ -554,7 +815,8 @@ sub rawconfig {
}
}
}
- unless ($ENV{'browser.interface'} eq 'textual') {
+ unless (($ENV{'browser.interface'} eq 'textual') ||
+ ($ENV{'environment.remote'} eq 'off')) {
$output.="\nwindow.status='Synchronizing Time';swmenu.syncclock(1000*".time.");\nwindow.status='Remote Control Configured.';";
}
return $output;
@@ -563,7 +825,8 @@ sub rawconfig {
# ======================================================================= Close
sub close {
- if ($ENV{'browser.interface'} eq 'textual') { return ''; }
+ if (($ENV{'browser.interface'} eq 'textual') ||
+ ($ENV{'environment.remote'} eq 'off')) { return ''; }
my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
return(<
@@ -587,8 +850,9 @@ sub footer {
}
sub utilityfunctions {
- unless ($ENV{'browser.interface'} eq 'textual') { return ''; }
- my $currenturl=$ENV{'REQUEST_URI'};
+ unless (($ENV{'browser.interface'} eq 'textual') ||
+ ($ENV{'environment.remote'} eq 'off')) { return ''; }
+ my $currenturl=$ENV{'request.noversionuri'};
my $currentsymb=$ENV{'request.symb'};
return (<
+