Merge branch 'master' of /home/argggh/git/lxrng/

3 files changed, 129 insertions, 101 deletions

diff --git a/lib/LXRng/Context.pm b/lib/LXRng/Context.pm
index 6909c58..db486bf 100644
--- a/lib/LXRng/Context.pm
+++ b/lib/LXRng/Context.pm
@@ -82,7 +82,7 @@ sub new {
 
     if ($$self{'tree'} and $$self{'tree'} !~ /^[+]/) {
 	my $tree = $$self{'tree'};
-	die("No config for tree $tree") 
+	return $self
 	    unless exists($$config{$tree});
 
 	$$self{'config'} = $$config{$tree};
diff --git a/lib/LXRng/Lang/C.pm b/lib/LXRng/Lang/C.pm
index 928b450..60a571b 100644
--- a/lib/LXRng/Lang/C.pm
+++ b/lib/LXRng/Lang/C.pm
@@ -52,13 +52,12 @@ sub identifier_re {
 }
 
 my $_reserved ||= { map { $_ => 1 }
-		    qw(asm auto break case char continue default do
-		       double else enum extern float for fortran goto
-		       if int long register return short signed sizeof
-		       static struct switch typedef union unsigned
-		       void volatile while
-		       #define #else #endif #if #ifdef #ifndef #include
-		       #undef)};
+		    qw(asm auto break case char const continue default
+		       do double else enum extern float for fortran
+		       goto if int long register return short signed
+		       sizeof static struct switch typedef union
+		       unsigned void volatile while #define #else
+		       #endif #if #ifdef #ifndef #include #undef)};
 
 sub reserved {
     return $_reserved;
diff --git a/lib/LXRng/Web.pm b/lib/LXRng/Web.pm
index 63ca5b6..28a3f3a 100644
--- a/lib/LXRng/Web.pm
+++ b/lib/LXRng/Web.pm
@@ -37,9 +37,6 @@ use File::Temp qw(tempdir tempfile);
 use File::Path qw(mkpath);
 use POSIX qw(waitpid);
 
-use constant PDF_LINELEN => 95;
-use constant PDF_CHARPTS => 6.6;
-
 # Cache must be purged if this is changed.
 use constant FRAGMENT_SIZE => 250;
 
@@ -86,7 +83,7 @@ sub print_markedup_file {
 	my $fline  = $context->param('line');
 
 	$focus = $fline < 100 if defined($fline);
-    
+
 	my $shaid = sha1_hex(join("\0", $node->name, $node->revision,
 				  $context->release));
 	my $cfile;
@@ -94,7 +91,7 @@ sub print_markedup_file {
 	$cfile = $context->config->{'cache'}.'/'.$shaid
 	    if exists $context->config->{'cache'};
 
-	if ($cfile and -d $cfile) {
+	if ($cfile and -e "$cfile/.complete") {
 	    print("<pre id=\"file_contents\">");
 	    while (-r "$cfile/$line") {
 		print("<div class=\"".($focus ? "done" : "pending").
@@ -137,7 +134,7 @@ sub print_markedup_file {
 		  "\" id=\"$shaid/0\">");
 	    while (1) {
 		my @frags = map { split(/(?<=\n)/, $_) }
-				  $markup->markupfile($subst, $parse);
+		$markup->markupfile($subst, $parse);
 		last unless @frags;
 		foreach my $f (@frags) {
 		    print($f) if $focus;
@@ -163,12 +160,38 @@ sub print_markedup_file {
 		}
 	    }
 	    print("</div></pre>\n");
-	    close($cache) if $cache;
+	    if ($cache) {
+		close($cache);
+		open($cache, '>', "$cfile/.complete");
+		close($cache);
+	    }
 	}
 	return $shaid;
     }
 }
 
+sub print_error {
+    my ($context, $template, $query, $error) = @_;
+
+    my $tmpl;
+    if ($context->config and $context->config->{'repository'}) {
+	$tmpl = 'error.tt2';
+    }
+    else {
+	$tmpl = 'bare_error.tt2';
+    }
+
+    print($query->header(-type => 'text/html',
+			 -charset => 'utf-8'));
+
+    my $base = $context->base_url();
+    $template->process($tmpl,
+		       {'context' => $context,
+			'base_url' => $base,
+			'error' => $error})
+	or die $template->error();
+}    
+
 sub print_tree_list {
     my ($context, $template) = @_;
 
@@ -177,7 +200,7 @@ sub print_tree_list {
     $template->process('tree_list.tt2',
 		       {'context' => $context,
 			'base_url' => $base})
-		or die $template->error();
+	or die $template->error();
 }    
 
 sub print_release_list {
@@ -185,7 +208,7 @@ sub print_release_list {
 
     $template->process('release_select.tt2',
 		       {'context' => $context})
-		or die $template->error();
+	or die $template->error();
 }
 
 sub source {
@@ -242,10 +265,18 @@ sub source {
 
     my $ver = $context->release;
     my $rep = $context->config->{'repository'};
-    die "No tree given" unless $rep;
+    unless ($rep) {
+	print_error($context, $template, $query,
+		    "No/unknown tree indicated");
+	return;
+    }
 
     my $node = $rep->node($context->path, $ver);
-    die "Node not found: ".$context->path." ($ver)" unless $node;
+    unless ($node) {
+	print_error($context, $template, $query,
+		    "Node not found: ".$context->path." ($ver)");
+	return;
+    }
 
     my $gzip = do_compress_response($query);
 
@@ -325,29 +356,8 @@ sub source {
     # 0.18, this seems to truncate the stream.  Not strictly needed
     # for CGI, reexamine when adapting to mod_perl.
     ## binmode(\*STDOUT, ":pop") if $gzip;
-    
 }
 
-#sub ident {
-#    my ($self) = @_;
-
-#    my $index = $self->context->config->{'index'};
-#    my $view = LXRng::View->new('context' => $self->context);;
-
-#    my $ident  = $self->context->value('ident');
-#    my $target = $self->context->value('navtarget');
-#    $target ||= 'source';
-
-#    my $rel_id = $index->release_id($self->tree, $self->context->value('v'));
-#    my ($symname, $symid, $ident, $refs) =
-#        $index->get_identifier_info($ident, $rel_id);
-
-#    $$ident[1] = $LXRng::Lang::deftypes{$$ident[1]};
-#    $$ident[5] &&= $LXRng::Lang::deftypes{$$ident[5]};
-    
-#    return $view->identifier_info($symname, $symid, $ident, $refs, $target);
-#}
-
 
 # Perform various search operations.  Return results as html suitable
 # both as a response to an ajax request and inclusion in a more
@@ -402,8 +412,8 @@ sub search {
 				$_ }
 			  sort { $LXRng::Lang::defweight{$$b[1]} cmp
 				     $LXRng::Lang::defweight{$$a[1]} ||
-				 $$a[2] cmp $$b[2] ||
-				 $$a[3] <=> $$b[3] }
+				     $$a[2] cmp $$b[2] ||
+				     $$a[3] <=> $$b[3] }
 			  @$result);
 	    $template_args{'code_res'} = {'query' => $find,
 					  'idents' => \@cooked};
@@ -424,13 +434,13 @@ sub search {
 	    my $rep = $context->config->{'repository'};
 	    my @args = grep {
 		$rep->node($_, $context->release)
-	    } split(/\|/, $find);
+		} split(/\|/, $find);
 	    $template_args{'ambig_res'} = {'query' => $find,
 					   'files' => \@args,}
 	}
     }
     else {
-	die "No query string given";
+	$template_args{'error'} = 'No query string given';
     }
     my $html = '';
     $template_args{'tree'} = $context->tree;
@@ -493,6 +503,10 @@ sub handle_ajax_request {
     binmode(\*STDOUT, ":gzip") if $gzip;
 
     if ($context->param('fname') eq 'pjx_load_file') {
+	unless ($context->config and $context->config->{'repository'}) {
+	    print('<div class="error">No/unknown tree indicated.</div>');
+	    return;
+	}
 	my $rep = $context->config->{'repository'};
 	my $node = $rep->node($context->param('file'), $context->release);
 	print_markedup_file($context, $template, $node);
@@ -569,7 +583,7 @@ sub handle_preferences {
 	my $nav = 'is_replace';
 	$nav = 'is_'.$context->prefs->{'navmethod'} if
 	    $context->prefs and $context->prefs->{'navmethod'} ne '';
-	    
+	
 	my $ret = $context->base_url();
 	$ret =~ s,[+]prefs/?,,;
 	$ret .= $query->param('return') if $query->param('return');
@@ -592,25 +606,25 @@ sub generate_pdf {
     my $tempdir = tempdir(CLEANUP => 1);
 
     my %tspecials = (
-	'$'	=> '\$',	'*'	=> "\$\\ast\$",
-	'&'	=> '\&',	'%'	=> '\%',
-	'#'	=> '\#',	'_'	=> '\_',
-	'^'	=> '\^{}',	'{'	=> '\{',
-	'}'	=> '\}',	'|'	=> "\$|\$",
-	'['	=> '{[}',	']'	=> '{]}',
-	"'"	=> "{'}",	"\""	=> "\\string\"",
-	'~'	=> '\~{}',	'<'	=> "\$<\$",
-	'>'	=> "\$>\$",	"\\"	=> "\$\\backslash\$",
-	'-'	=> '\dash{}',
+		     '$'	=> '\$',	'*'	=> "\$\\ast\$",
+		     '&'	=> '\&',	'%'	=> '\%',
+		     '#'	=> '\#',	'_'	=> '\_',
+		     '^'	=> '\^{}',	'{'	=> '\{',
+		     '}'	=> '\}',	'|'	=> "\$|\$",
+		     '['	=> '{[}',	']'	=> '{]}',
+		     "'"	=> "{'}",	"\""	=> "\\string\"",
+		     '~'	=> '\~{}',	'<'	=> "\$<\$",
+		     '>'	=> "\$>\$",	"\\"	=> "\$\\backslash\$",
+		     '-'	=> '\dash{}',
 # These are latin1-replacements, and interact badly with utf8...
-	"\242"	=> '?',		"\244"	=> '?',
-	"\245"	=> '?',		"\246"	=> '?',
-	"\252"	=> "\$\252\$",	"\254"	=> "\$\254\$",
-	"\255"	=> "\\dash{}",	"\260"	=> "\$\260\$",
-	"\261"	=> "\$\261\$",	"\262"	=> "\$\262\$",
-	"\263"	=> "\$\263\$",	"\265"	=> "\$\265\$",
-	"\271"	=> "\$\271\$",	"\272"	=> "\$\272\$",
-	"\327"	=> "\$\327\$",	"\367"	=> "\$\367\$",
+		     "\242"	=> '?',		"\244"	=> '?',
+		     "\245"	=> '?',		"\246"	=> '?',
+		     "\252"	=> "\$\252\$",	"\254"	=> "\$\254\$",
+		     "\255"	=> "\\dash{}",	"\260"	=> "\$\260\$",
+		     "\261"	=> "\$\261\$",	"\262"	=> "\$\262\$",
+		     "\263"	=> "\$\263\$",	"\265"	=> "\$\265\$",
+		     "\271"	=> "\$\271\$",	"\272"	=> "\$\272\$",
+		     "\327"	=> "\$\327\$",	"\367"	=> "\$\367\$",
 		     );
 
     my $tspecials = join('', map { quotemeta($_) } keys(%tspecials));
@@ -630,7 +644,7 @@ sub generate_pdf {
     my $resre;
     if (%$res) {
 	$resre = '(?:(?<=[\s\W])|^)('.
-	    join('|', map { my $c = $_; $c =~ s/\#/\\\#/g; quotemeta($c) }
+	    join('|', map { "\Q$_\E" }
 		 sort { length($b) <=> length($a) }
 		 keys %$res).')(?=$|[\s\W])';
     }
@@ -639,10 +653,12 @@ sub generate_pdf {
     my $row = 1;
     my $col = 0;
     my $line = '\\lxrln{1}';
+    my %ptabs = ();
+    my %ntabs = ();
 
     while (1) {
 	my ($btype, $frag) = $parse->nextfrag;
-    
+	
 	last unless defined $frag;
 
 	$btype ||= 'code';
@@ -655,6 +671,8 @@ sub generate_pdf {
 
 	    if ($part eq "\n") {
 		push(@lines, $line);
+		%ptabs = %ntabs;
+		%ntabs = ();
 
 		$col = 0;
 		$row++;
@@ -667,56 +685,61 @@ sub generate_pdf {
 		next;
 	    }
 
-	    if ($part =~ /^(.*?   +)(.*)/) {
-		unshift(@parts, $2);
+	    if ($part =~ /^(.*?)( +)(.*)/) {
+		unshift(@parts, $3);
 		$part  = $1;
-		$align = 1;
-	    }
-
-	    $col += length($part);
-
-	    if ($col > PDF_LINELEN) {
-		unshift(@parts, 
-			substr($part, PDF_LINELEN - $col, length($part), ''));
-		if ($part =~ s/([^\s_,\(\)\{\}\/\=\-\+\*\<\>\[\]\.]+)$//) {
-		    if (length($1) < 20) {
-			unshift(@parts, $1);
-		    }
-		    else {
-			$part .= $1;
-		    }
+		if (length($2) > 2 or $ptabs{$col + length($1) + length($2)}) {
+		    $align = 1;
+		    $col += length($2);
+		    $ntabs{$col + length($part)} = 1;
+		}
+		else {
+		    $part .= $2;
 		}
-		$align = 0;
-		$cont  = 1;
 	    }
+	    $col += length($part);
 
-	    $part =~ s(([$tspecials\0-\010\013\014\016-\037\200-\240]))
-		(exists $tspecials{$1} ? $tspecials{$1} : '?')ge;
-	    
 	    if ($btype eq 'code') {
-		$part =~ s/$resre/\\textbf{$1}/g if $resre;
+		$part =~ s/$resre/\\bf{}\\sffamily{}$1\\sf{}/g if $resre;
 	    }
 	    elsif ($btype eq 'include') {
-		$part =~ s/$resre/\\textbf{$1}/ if $resre;
+		# This is a bit of a special treatment for C...
+		$part =~ s((<[^>]*>|\"[^\"]*\")|$resre)
+		    ($1 ? "$1" : "\\bf{}\\sffamily{}$2\\sf{}")ge if $resre;
 	    }
 	    elsif ($btype eq 'comment') {
-		$part = '\textit{'.$part.'}';
+		$part = '\\em{}'.$part.'\\sf{}';
 	    }
 	    elsif ($btype eq 'string') {
-		$part = '\texttt{'.$part.'}';
+		$part = '\\tt{}'.$part.'\\sf{}';
 	    }
 
-	    # Common fixed-width "ascii-art" characters.
-	    $part =~ s/(\$\\ast\$|=)/'\\makebox['.PDF_CHARPTS."pt][c]{$1}"/ge;
+	    $part =~ s{(\\(?:sf|bf|em|tt|sffamily)\{\})|
+			   ([*=])|
+			   ([ ]+)|
+			   ([$tspecials\0-\010\013\014\016-\037\200-\240])|
+			   ([[:alnum:]]+|.)}
+	    {
+		if (defined $1) {
+		    $1;
+		}
+		elsif (defined $2) {
+		    "\\lxgr{".(exists $tspecials{$2} ? $tspecials{$2} : $2)."}";
+		}
+		elsif (defined $3) {
+		    "\\lxws{$3}";
+		}
+		elsif (defined $4) {
+		    "\\lxlt{".(exists $tspecials{$4} ? $tspecials{$4} : '?')."}";
+		}
+		else {
+		    "\\lxlt{$5}";
+		}
+	    }gex;
+
 	    $line .= $part;
 	    if ($align) {
-		$line = '\\makebox['.int($col * PDF_CHARPTS).
-		    'pt][l]{'.$line.'}';
-	    }
-	    if ($cont) {
-		push(@lines, "$line\\raisebox{-2pt}{\\ArrowBoldRightStrobe}");
-		$line = '\\raisebox{-2pt}{\\ArrowBoldDownRight} ';
-		$col  = 3;
+		$line .= "\\lxalign{$col}";
 	    }
 	}
     }
@@ -783,8 +806,14 @@ sub generate_pdf {
 sub handle {
     my ($self, $query) = @_;
 
-    my $context  = LXRng::Context->new('query' => $query);
     my $template = Template->new({'INCLUDE_PATH' => $LXRng::ROOT.'/tmpl/'});
+    my $context  = LXRng::Context->new('query' => $query);
+
+    unless ($context->config) {
+	print_error($context, $template, $query,
+		    "No/unknown tree indicated");
+	return;
+    }
 
     if ($context->param('fname')) {
 	handle_ajax_request($query, $context, $template);