From 4aed2c8219774f5d797760606b8489a92ddc5163 Mon Sep 17 00:00:00 2001 From: toma Date: Wed, 25 Nov 2009 17:56:58 +0000 Subject: Copy the KDE 3.5 branch to branches/trinity for new KDE 3.5 features. BUG:215923 git-svn-id: svn://anonsvn.kde.org/home/kde/branches/trinity/kdebase@1054174 283d02a7-25f6-0310-bc7c-ecb5cbfe19da --- kioslave/info/LICENSE | 22 + kioslave/info/Makefile.am | 21 + kioslave/info/info.cc | 261 ++++++++++ kioslave/info/info.h | 36 ++ kioslave/info/info.protocol | 11 + kioslave/info/kde-info2html | 1031 ++++++++++++++++++++++++++++++++++++++ kioslave/info/kde-info2html.conf | 43 ++ 7 files changed, 1425 insertions(+) create mode 100644 kioslave/info/LICENSE create mode 100644 kioslave/info/Makefile.am create mode 100644 kioslave/info/info.cc create mode 100644 kioslave/info/info.h create mode 100644 kioslave/info/info.protocol create mode 100755 kioslave/info/kde-info2html create mode 100644 kioslave/info/kde-info2html.conf (limited to 'kioslave/info') diff --git a/kioslave/info/LICENSE b/kioslave/info/LICENSE new file mode 100644 index 000000000..9cb70ac77 --- /dev/null +++ b/kioslave/info/LICENSE @@ -0,0 +1,22 @@ +The following license is applicable to all files in this directory, with the +exception of kde-info2html and kde-info2html.conf which are licensed under the GPL, +since they are based on GPL work. + +LICENSE: + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN +AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/kioslave/info/Makefile.am b/kioslave/info/Makefile.am new file mode 100644 index 000000000..8db4a20ec --- /dev/null +++ b/kioslave/info/Makefile.am @@ -0,0 +1,21 @@ +## Makefile.am of kdebase/kioslave/info + +INCLUDES = $(all_includes) + +METASOURCES = AUTO + +####### Files + +kde_module_LTLIBRARIES = kio_info.la + +kio_info_la_SOURCES = info.cc +kio_info_la_LIBADD = $(LIB_KIO) +kio_info_la_LDFLAGS = $(all_libraries) -module $(KDE_PLUGIN) +noinst_HEADERS = info.h + +kdelnk_DATA = info.protocol +kdelnkdir = $(kde_servicesdir) + +kio_info_data_DATA = kde-info2html.conf +kio_info_data_SCRIPTS = kde-info2html +kio_info_datadir = $(kde_datadir)/kio_info diff --git a/kioslave/info/info.cc b/kioslave/info/info.cc new file mode 100644 index 000000000..6b829ec1c --- /dev/null +++ b/kioslave/info/info.cc @@ -0,0 +1,261 @@ +#include +#include +#include + +#include +#include +#include +#include + +#include +#include +#include +#include +#include +#include + +#include "info.h" + +using namespace KIO; + +InfoProtocol::InfoProtocol( const QCString &pool, const QCString &app ) + : SlaveBase( "info", pool, app ) + , m_page( "" ) + , m_node( "" ) +{ + kdDebug( 7108 ) << "InfoProtocol::InfoProtocol" << endl; + + m_perl = KGlobal::dirs()->findExe( "perl" ); + m_infoScript = locate( "data", "kio_info/kde-info2html" ); + m_infoConf = locate("data", "kio_info/kde-info2html.conf"); + + if( m_perl.isNull() || m_infoScript.isNull() || m_infoConf.isNull() ) { + kdError( 7108 ) << "Critical error: Cannot locate files for HTML-conversion" << endl; + QString errorStr; + if ( m_perl.isNull() ) { + errorStr = "perl."; + } else { + QString missing =m_infoScript.isNull() ? "kio_info/kde-info2html" : "kio_info/kde-info2html.conf"; + errorStr = "kde-info2html" + i18n( "\nUnable to locate file %1 which is necessary to run this service. " + "Please check your software installation" ).arg( missing ); + } + error( KIO::ERR_CANNOT_LAUNCH_PROCESS, errorStr ); + exit(); + } + + kdDebug( 7108 ) << "InfoProtocol::InfoProtocol - done" << endl; +} + +InfoProtocol::~InfoProtocol() +{ + kdDebug( 7108 ) << "InfoProtocol::~InfoProtocol" << endl; + + kdDebug( 7108 ) << "InfoProtocol::~InfoProtocol - done" << endl; +} + +void InfoProtocol::get( const KURL& url ) +{ + kdDebug( 7108 ) << "InfoProtocol::get" << endl; + kdDebug( 7108 ) << "URL: " << url.prettyURL() << " , Path :" << url.path() << endl; + + if (url.path()=="/") + { + KURL newUrl("info:/dir"); + redirection(newUrl); + finished(); + return; + }; + + // some people write info://autoconf instead of info:/autoconf + if (!url.host().isEmpty()) { + KURL newURl(url); + newURl.setPath(url.host()+url.path()); + newURl.setHost(QString::null); + redirection(newURl); + finished(); + return; + } + + if ( url.path().right(1) == "/" ) + { + // Trailing / are not supported, so we need to remove them. + KURL newUrl( url ); + QString newPath( url.path() ); + newPath.truncate( newPath.length()-1 ); + newUrl.setPath( newPath ); + redirection( newUrl ); + finished(); + return; + } + + mimeType("text/html"); + // extract the path and node from url + decodeURL( url ); + + QString path = KGlobal::iconLoader()->iconPath("up", KIcon::Toolbar, true); + int revindex = path.findRev('/'); + path = path.left(revindex); + + QString cmd = KProcess::quote(m_perl); + cmd += " "; + cmd += KProcess::quote(m_infoScript); + cmd += " "; + cmd += KProcess::quote(m_infoConf); + cmd += " "; + cmd += KProcess::quote(path); + cmd += " "; + cmd += KProcess::quote(m_page); + cmd += " "; + cmd += KProcess::quote(m_node); + + kdDebug( 7108 ) << "cmd: " << cmd << endl; + + FILE *file = popen( QFile::encodeName(cmd), "r" ); + if ( !file ) { + kdDebug( 7108 ) << "InfoProtocol::get popen failed" << endl; + error( ERR_CANNOT_LAUNCH_PROCESS, cmd ); + return; + } + + char buffer[ 4096 ]; + QByteArray array; + + bool empty = true; + while ( !feof( file ) ) + { + int n = fread( buffer, 1, sizeof( buffer ), file ); + if ( !n && feof( file ) && empty ) { + error( ERR_CANNOT_LAUNCH_PROCESS, cmd ); + return; + } + if ( n < 0 ) + { + // ERROR + kdDebug( 7108 ) << "InfoProtocol::get ERROR!" << endl; + pclose( file ); + return; + } + + empty = false; + array.setRawData( buffer, n ); + data( array ); + array.resetRawData( buffer, n ); + } + + pclose( file ); + + finished(); + + kdDebug( 7108 ) << "InfoProtocol::get - done" << endl; +} + +void InfoProtocol::mimetype( const KURL& /* url */ ) +{ + kdDebug( 7108 ) << "InfoProtocol::mimetype" << endl; + + // to get rid of those "Open with" dialogs... + mimeType( "text/html" ); + + // finish action + finished(); + + kdDebug( 7108 ) << "InfoProtocol::mimetype - done" << endl; +} + +void InfoProtocol::decodeURL( const KURL &url ) +{ + kdDebug( 7108 ) << "InfoProtocol::decodeURL" << endl; + + /* Notes: + * + * I cleaned up the URL decoding and chose not to support URLs in the + * form "info:/usr/local/share/info/libc.info.gz" or similar which the + * older code attempted (and failed, maybe it had worked once) to do. + * + * The reason is that an obvious use such as viewing a info file off your + * infopath would work for the first page, but then all the links would be + * wrong. Of course, one could change kde-info2html to make it work, but I don't + * think it worthy, others are free to disagree and write the necessary code ;) + * + * luis pedro + */ + + if ( url == KURL( "info:/browse_by_file?special=yes" ) ) { + m_page = "#special#"; + m_node = "browse_by_file"; + kdDebug( 7108 ) << "InfoProtocol::decodeURL - special - browse by file" << endl; + return; + } + + decodePath( url.path() ); + + kdDebug( 7108 ) << "InfoProtocol::decodeURL - done" << endl; +} + +void InfoProtocol::decodePath( QString path ) +{ + kdDebug( 7108 ) << "InfoProtocol::decodePath(-" < + +#include + +class KProcess; + +class InfoProtocol : public KIO::SlaveBase +{ +public: + + InfoProtocol( const QCString &pool, const QCString &app ); + virtual ~InfoProtocol(); + + virtual void get( const KURL& url ); + virtual void stat( const KURL& url ); + virtual void mimetype( const KURL& url ); + +protected: + + void decodeURL( const KURL &url ); + void decodePath( QString path ); + +private: + + QString m_page; + QString m_node; + + QString m_perl; + QString m_infoScript; + QString m_infoConf; +}; + +#endif // __info_h__ diff --git a/kioslave/info/info.protocol b/kioslave/info/info.protocol new file mode 100644 index 000000000..3bb600aea --- /dev/null +++ b/kioslave/info/info.protocol @@ -0,0 +1,11 @@ +[Protocol] +exec=kio_info +protocol=info +input=none +output=filesystem +reading=true +defaultMimetype=text/html +determineMimetypeFromExtension=false +DocPath=kioslave/info.html +Icon=help_index +Class=:local diff --git a/kioslave/info/kde-info2html b/kioslave/info/kde-info2html new file mode 100755 index 000000000..428d65dbb --- /dev/null +++ b/kioslave/info/kde-info2html @@ -0,0 +1,1031 @@ +#!/usr/bin/perl +#--------------------------------------------------------- +# info2html +#--------------------------------------------------------- +# +# PURPOSE +# This perl script converts info nodes to HTML format. +# The node is specified on the command line using the +# syntax +# () +# If and/or are missing, (dir)Top is assumed. +# +# AUTHOR +# Karl Guggisberg +# +# Changes for the KDE Help Center (c) 1999 Matthias ELter +# (me@kde.org) +# +# LICENSE +# GPL +# +# HISTORY +# 11.10.93 V 1.0 +# 14.10.93 V 1.0a some comments added +# 15.10.93 V 1.0b file for configuration settings +# 16.10.93 V 1.0c multiple info path possible +# some bugs in escaping references removed +# 28.6.94 V 1.0d some minor changes +# 8.4.95 V 1.1 bug fixes by Tim Witham +# +# March 1999 Changes for use in KDE Help Center +# February 2000 Changes for bzip2 format +# Sept. 4 2002 Updated to the KDE look +# by Hisham Muhammad +# January 30 2003 Ported Hisham's work to HEAD +# by David Pashley +# March 6 2003 Substitute use of absolute fixed file URLs to images with help:common URLs +# for the images and style sheet. By Luis Pedro Coelho +# March 9 2003 Add support for browsing by file. by Luis Pedro Coelho +# June 11 2003 Update the layout of the sides to the new infopageslayout. +# by Sven Leiber +# +#------------------------------------------------------- + +use strict; + +# set here the full path of the info2html.conf +push @INC, $1 if $0 =~ m!(.*/)[^/]+$!; # full path of config file is passed in ARGV[1] by caller but let's clean this anyway +my $IMAGEDIR = "file:$ARGV[1]/"; # TV: broken, broken, not passed +my $config_file = $ARGV[0]; +delete $ENV{CDPATH}; +delete $ENV{ENV}; +require $config_file; #-- configuration settings + +my $STYLESHEET_KDE = ""; +my $LOGO_KDE = "\"KDE"; + +# the use of a query should make sure it never conflicts with a "real" path +my $BROWSE_BY_FILE_PATH = '/browse_by_file?special=yes'; + + +my $DONTPRINTYET = 'DONTPRINTYET '; + +#-- patterns +my $NODEBORDER = '\037\014?'; #-- delimiter of an info node +my $REDIRSEP = '\177'; #-- delimiter in tag tables +my $WS = '[ \t]+'; #-- white space + +my $WSS = '[ \t]*'; #-- white space * +my $TE = '[\t\,\.]'; #-- end of a tag +my $TAG = '[^\t\,\.]+'; #-- pattern for a tag +my $FTAG = '[^\)]+'; #-- pattern for a file name in + #-- a cross reference + +#--------------------------------------------------------- +# DieFileNotFound +#--------------------------------------------------------- +# Replies and error message if the file '$FileName' is +# not accessible. +#--------------------------------------------------------- +sub DieFileNotFound { + my ($FileName) = @_; + $FileName =~ s/&/&/g; + $FileName =~ s/>/>/g; + $FileName =~ s/ +Info: (no page found) + + +

KDE Info Pages Viewer Error

+ No info page for topic "$FileName" found.
+ You may find what you are looking for at the $FileName manpage. + +EOF + die "\n"; +} + +#--------------------------------------------------------- +# Redirect +#--------------------------------------------------------- +# Since we can't do a kioslave redirection from here, we resort to an HTML +# redirection. +# +# It could be simpler to just output the correct page, but that would leave the +# the browser URL indication a bit wrong and more importantly we might mess up relative links. +# Therefore, I implemented it like this which is simpler if not as nice on the end user +# who sees a flicker. +#--------------------------------------------------------- + +sub Redirect { + my ($File,$Tag) = @_; + print <Doing redirection + + +

Redirecting ....

+

If you are not automatically taken to a new page, click here to continue. + + +EOF + + exit 0; +} + +#--------------------------------------------------------- +# FileNotFound +#--------------------------------------------------------- +# If the file is not found and the node is '', try to go through +# dir entries. +# This deals with cases like info:ls should open "coreutils/ls invocation" +#--------------------------------------------------------- +sub FileNotFound { + my ($FileName,$NodeName) = @_; + DieFileNotFound($FileName) if $NodeName ne 'Top' || $FileName eq 'dir'; + # Try to find it in dir + + my $DirFileName = &FindFile('dir'); + if ($DirFileName =~ m/.info.bz2$/ ) { + open DIR, "-|", "bzcat", $DirFileName; + } + elsif ($DirFileName =~ m/.info.gz$/ ) { + open DIR, "-|", "gzip", "-dc", $DirFileName; + } + else { + open DIR, $DirFileName; + } + my $looking = 1; + while (

) { + next if $looking && !/\* Menu/; + $looking = 0; + my @item = &ParseMenuItem($_,'dir'); + if (!defined(@item)) { next } + my ($MenuLinkTag, $MenuLinkFile, $MenuLinkRef, $MenuLinkText) = @item; + if ($MenuLinkRef eq $FileName) { + &Redirect($MenuLinkFile, $MenuLinkTag); + exit 0; + } + } + &DieFileNotFound($FileName); +} + +#--------------------------------------------------------- +# Escape +#--------------------------------------------------------- +# This procedures escapes some special characeters. The +# escape sequence follows the WWW guide for escaped +# characters in URLs +#--------------------------------------------------------- +sub Escape { + my ($Tag) = @_; + #-- escaping is not needed anymore KG/28.6.94 + #-- it is, for "?" %3f (info:/cvs/What is CVS?), kaper/23.7.02 + $Tag =~ s/ /%20/g; # space + $Tag =~ s/\?$/%3f/g; # space + $Tag =~ s/\"/%22/g; # space + $Tag =~ s/\#/%23/g; +# $Tag =~ s/\+/%AB/g; # + + $Tag; +} + +#---------------------------------------------------------- +# DirnameCheck +# TV: This is totally broken. +# I don't know what was the original attempt but that code +# cannot work ! we cannot match the info name (which has no full path) +# with the info path ... +# The only thing i can see (guessed from the || part of the caller) +# is that we try to reject files with "/" in their name, guessing +# we pass a man page full path instead of a info file name ... +# In *that* case, the flow logic is inverted and we should have used "&&" +# instead of "||" +# +# Thus the commented out call... +#---------------------------------------------------------- +#sub DirnameCheck { +# my ($Base) = @_; +# my $Dir = $Base; +# +# $Base =~ s!.*/!!g; +# $Dir =~ s!\Q$Base\E!!; +# +# foreach (@info2html::config::INFODIR) { +# return 1 if $Dir =~ /^$_/; +# } +# +# foreach my $i (split(/:/, $ENV{INFOPATH})) { +# return 1 if $Dir =~ /^$i/; +# } +# +# return 0; +#} + +#---------------------------------------------------------- +# DeEscape +#---------------------------------------------------------- +#sub DeEscape { +# my ($Tag) = @_; +# #-- deescaping is not needed anymore. KG/28.6.94 +# $Tag =~ s/%AB/+/g; +# $Tag =~ s/%20/ /g; +# $Tag =~ s/\.\.\///g; +# $Tag =~ s/\.\.//g; +# $Tag =~ s/\.\///g; +# $Tag; +#} + +sub infocat { +# Collect them all into an array that can be sorted + + my %InfoFile; + my %LinkText; + my @dirs; + + foreach my $dir (@info2html::config::INFODIR) { + push @dirs, $dir; + } + if ($ENV{'INFOPATH'}) { + foreach my $dir (split(/:/, $ENV{INFOPATH})) { + push @dirs, $dir; + } + } + + foreach my $dir (@dirs) { + opendir DIR, $dir; + my ($infofile,$filedesc); + while ($infofile = readdir(DIR)) { + if ($infofile =~ m/.info.bz2$/ ) { + open INFOFILE, "-|", "bzcat", "$dir/$infofile"; + } + elsif ($infofile =~ m/.info.gz$/ ) { + open INFOFILE, "-|", "gzip", "-dc", "$dir/$infofile"; + } + elsif ($infofile =~ m/.info$/) { + open INFOFILE, "-|", "$dir/$infofile"; + } + else { + next; + } + $filedesc = ''; + my $collect = 0; + my $empty = 1; + while () { + last if (m/END-INFO-DIR-ENTRY/); + s/^\* //; + chomp; + next if /^\s*$/; + if ($collect) { + $filedesc .= "\n
" if ($collect < 16); + $filedesc .= $_; + --$collect; + $empty = 0; + } elsif (!$empty && !$collect) { + $filedesc .= "
...\n"; + last; + } + $collect=16 if (m/START-INFO-DIR-ENTRY/); + } + if ($empty) { $filedesc .= 'no description available'; } + close INFOFILE; + $filedesc .= $infofile if ($filedesc eq ""); +# Add to the hash + $LinkText{$filedesc} = "$dir/$infofile"; + $InfoFile{$filedesc} = "$infofile"; + } + } + +# Now output the list + my @sorted = sort { lc($a) cmp lc($b) } keys %InfoFile; + + print '
'; + foreach my $description ( @sorted ) { + print < $LinkText{$description} +
$description + +EOF + } + print '
'; +} + +#---------------------------------------------------------- +# ParsHeaderToken +#---------------------------------------------------------- +# Parses the header line of an info node for a specific +# link directive (e.g. Up, Prev) +# +# Returns a link as (InfoFile,Tag). +#---------------------------------------------------------- +sub ParsHeaderToken { + my ($HeaderLine, $Token) = @_; + return ("", "") if $HeaderLine !~ /$Token:/; #-- token not available + my ($InfoFile, $node, $Temp); + if ($HeaderLine =~ m!$Token:$WS(\(($FTAG)\))!) { + $InfoFile = $2; + $Temp = $2 ne "" ? '\(' . $2 . '\)' : ""; + } + $node = $1 if $HeaderLine =~ m!$Token:$WS$Temp$WSS([^\t,\n]+)?([\t,\.\n])!; + $node ||= "Top"; + return $InfoFile, $node; +} + +#--------------------------------------------------------- +# ParsHeaderLine +#-------------------------------------------------------- +# Parses the header line on an info node for all link +# directives allowed in a header line. +# Sometimes the keyword 'Previous' is found in stead of +# 'Prev'. Thats why the redirection line is checked +# against both of these keywords. +#------------------------------------------------------- +sub ParsHeaderLine { + my ($HL) = @_; + my @LinkList; + #-- Node + push(@LinkList, &ParsHeaderToken($HL, "Node")); + #-- Next + push(@LinkList, &ParsHeaderToken($HL, "Next")); + #-- Up + push(@LinkList, &ParsHeaderToken($HL, "Up")); + #-- Prev or Previous + my @LinkInfo = &ParsHeaderToken($HL, "Prev"); + &ParsHeaderToken($HL, "Previous") if $LinkInfo[0] eq "" && $LinkInfo[1] eq ""; + push(@LinkList, @LinkInfo); + return @LinkList; +} + +############################################################ +# turn tabs into correct number of spaces +# +sub Tab2Space { + my ($line) = @_; + $line =~ s/^\t/ /; # 8 leading spaces if initial tab + while ($line =~ s/^([^\t]+)(\t)/$1 . ' ' x (8 - length($1) % 8)/e) { + } # replace each tab with right num of spaces + return $line; +} + +#-------------------------------------------------------- +# ParseMenuItem +#-------------------------------------------------------- +# Takes a line containing a Menu item and returns a list of +# ($MenuLinkTag, $MenuLinkFile, $MenuLinkRef, $MenuLinkText) +# or undef if the parsing fails +#------------------------------------------------------- + +sub ParseMenuItem { + my ($Line,$BaseInfoFile) = @_; + my ($MenuLinkTag, $MenuLinkFile, $MenuLinkRef, $MenuLinkText); + $Line = &Tab2Space($Line); # make sure columns line up well + + if ($Line =~ /\* ([^:]+)::/) { # -- is a simple entry ending with :: ? + $MenuLinkTag = $1; + $MenuLinkRef = $1; + $MenuLinkText = $'; #' --just to help emacs perl-mode + $MenuLinkFile = &Escape($BaseInfoFile); + } elsif ($Line =~ /\* ([^:]+):(\s*\(($FTAG)\)($TAG)?$TE\.?)?(.*)$/) { + $MenuLinkFile = $BaseInfoFile; + $MenuLinkRef = $1; + $MenuLinkText = $5; + if ($2) { + $MenuLinkFile = $3; + $MenuLinkTag = $4 || 'Top'; + $MenuLinkText = ($2 ? ' ' x (length($2)+1) : '') . "$5\n"; + } else { + $Line = "$5\n"; + if ($Line =~ /( *($TAG)?$TE(.*))$/) { + $MenuLinkTag = $2; + $MenuLinkText = $Line; + } + } + } else { + return undef; + } + $MenuLinkTag = &Escape($MenuLinkTag); # -- escape special chars + $MenuLinkText =~ s/^ *//; + return ($MenuLinkTag, $MenuLinkFile, $MenuLinkRef, $MenuLinkText); +} + +#-------------------------------------------------------- +# MenuItem2HTML +#-------------------------------------------------------- +# Transform an info menu item in HTML with references +#------------------------------------------------------- +sub MenuItem2HTML { + my ($Line, $BaseInfoFile) = @_; + my @parse_results = &ParseMenuItem($Line, $BaseInfoFile); + if (!defined (@parse_results)) { return $Line; } + my ($MenuLinkTag, $MenuLinkFile, $MenuLinkRef, $MenuLinkText) = @parse_results; + #-- produce a HTML line + return "$MenuLinkText"; +} + +#------------------------------------------------------------- +# ReadIndirectTable +#------------------------------------------------------------ +# Scans an info file for the occurence of an 'Indirect:' +# table. Scans the entrys and returns two lists with the +# filenames and the global offsets. +#--------------------------------------------------------- +sub ReadIndirectTable { + my ($FileName, $FileNames, $Offsets) = @_; + + local *FH1; + if ($FileName =~ /\.gz$/) { + open FH1, "-|", "gunzip", "-q", "-d", "-c", $FileName || &DieFileNotFound($FileName); + } elsif ($FileName =~ /\.bz2$/) { + open FH1, "-|", "bunzip2", "-q", "-d", "-c", $FileName || &DieFileNotFound($FileName); + } else { + open(FH1, $FileName) || &DieFileNotFound($FileName); + } + #-- scan for start of Indirect: Table + local $_; + while () { + my $Next = if /$NODEBORDER/; + last if $Next =~ /^Indirect:/i; + } + #-- scan the entrys and setup the arrays + local $_; + while () { + last if /$NODEBORDER/; + if (/([^:]+):[ \t]+(\d+)/) { + push(@$FileNames, $1); + push(@$Offsets, $2); + } + } + close(FH1); +} + +#--------------------------------------------------------- +# ReadTagTable +#-------------------------------------------------------- +# Reads in a tag table from an info file. +# Returns an assoziative array with the tags found. +# Tags are transformed to lower case (info is not +# case sensitive for tags). +# The entrys in the assoziative Array are of the +# form +# # +# may be empty if an indirect table is +# present or if the node is located in the +# main file. +# 'Exists' indicates if a tag table has been found. +# 'IsIndirect' indicates if the tag table is based +# on a indirect table. +#-------------------------------------------------------- +sub ReadTagTable { + my ($FileName, $TagList, $Exists, $IsIndirect) = @_; + + local *FH; + if ($FileName =~ /\.gz$/) { + open FH, "-|", "gunzip", "-q", "-d", "-c", $FileName || &DieFileNotFound($FileName); + } elsif ($FileName =~ /\.bz2$/) { + open FH, "-|", "bunzip2", "-q", "-d", "-c", $FileName || &DieFileNotFound($FileName); + } else { + open FH, $FileName || &DieFileNotFound($FileName); + } + ($$Exists, $$IsIndirect) = (0, 0); + #-- scan for start of tag table + local $_; + while () { + if (/$NODEBORDER/) { + if ( =~ /^Tag table:/i) { + $$Exists = 1; + last; + } + } + } + #-- scan the entrys + local $_; + while () { + $$IsIndirect = 1 if /^\(Indirect\)/i; + last if /$NODEBORDER/; + if (/Node:[ \t]+([^$REDIRSEP]+)$REDIRSEP(\d+)/) { + my ($Tag, $Offset) = (lc($1), $2); + my $File = $1 if /File:[ \t]+([^\t,]+)/; + $TagList->{$Tag} = $File."#".$Offset; + } + } + close(FH); +} + +#---------------------------------------------------------- +# ParsCrossRefs +#---------------------------------------------------------- +# scans a line for the existence of cross references and +# transforms them to HTML using a little icon +#---------------------------------------------------------- +sub ParsCrossRefs { + my ($prev, $Line, $BaseInfoFile) = @_; + my ($NewLine, $Token); + my ($CrossRef, $CrossRefFile, $CrossRefTag, $CrossRefRef, $CrossRefText); + $Line = " " . $Line; + if ($prev =~ /\*Note([^\t\,\.]*)$/mi) { + $Line = "$prev-NEWLINE-$Line" if $Line =~ /^$TAG$TE/m; + } + my @Tokens = split(/(\*Note)/i, $Line); # -- split the line + while ($Token = shift @Tokens) { + $CrossRefTag = $CrossRefRef = $CrossRefFile = $CrossRefText = ''; + if ($Token !~ /^\*Note/i) { #-- this part is pure text + $NewLine .= $Token; + next; #-- ... take the next part + } + $CrossRef = shift(@Tokens); + if ($CrossRef !~ /:/) { #-- seems not to be a valid cross ref. + $NewLine .= $Token.$CrossRef; + next; # -- ... take the next one + } + if ($CrossRef =~ /^([^:]+)::/) { # -- a simple cross ref.. + $CrossRefTag = $1; + $CrossRefText = $'; + $CrossRefRef = $CrossRefTag; + $CrossRefTag =~ s/-NEWLINE-/ /g; + $CrossRefTag =~ s/^\s+//; + $CrossRefTag =~ s/\s+/ /g; + $CrossRefRef =~ s/-NEWLINE-/\n/g; + $CrossRefTag = &Escape($CrossRefTag); # -- escape specials + $BaseInfoFile = &Escape($BaseInfoFile); + $NewLine .= ""; + $NewLine .= "$CrossRefRef$CrossRefText"; + next; # -- .. take the next one + } + if ($CrossRef !~ /$TE/) { # never mind if tag doesn't end on this line + $NewLine .= $Token.$CrossRef; + next; + } +#print "--- Com. CR : $CrossRef --- \n"; + if ($CrossRef =~ /([^:]+):/) { #-- A more complicated one .. + $CrossRefRef = $1; + $CrossRef = $'; + $CrossRefText = $CrossRef; + } + if ($CrossRef =~ /^(\s|\n|-NEWLINE-)*\(($FTAG)\)/) { #-- .. with another file ? + $CrossRefFile = $2; + $CrossRef = $'; + } + $CrossRefTag = $2 if $CrossRef =~ /^(\s|\n|-NEWLINE-)*($TAG)?($TE)/; #-- ... and a tag ? + if ($CrossRefTag eq "" && $CrossRefFile eq "") { + $NewLine .= "*Note : $CrossRefText$3"; + next; + } + + $CrossRefTag =~ s/-NEWLINE-/ /g; + $CrossRefTag =~ s/^\s+//; + $CrossRefTag =~ s/\s+/ /g; + $CrossRefRef =~ s/-NEWLINE-/\n/g; + $CrossRefText =~ s/-NEWLINE-/\n/g; + $CrossRefFile = $BaseInfoFile if $CrossRefFile eq ""; + $CrossRefTag = "Top" if $CrossRefTag eq ""; + $CrossRefRef = "($CrossRefFile)$CrossRefTag" if $CrossRefRef eq ''; + $CrossRefTag = &Escape($CrossRefTag); #-- escape specials + $CrossRefFile = &Escape($CrossRefFile); + #-- append the HTML text + $NewLine .= ""; + $NewLine .= "$CrossRefRef$CrossRefText"; + } + if ($NewLine =~ /\*Note([^\t\,\.]*)$/i) { + return "$DONTPRINTYET$NewLine"; + } else { + $NewLine; #-- return the new line + } +} + + +#------------------------------------------------------------- +# PrintLinkInfo +#------------------------------------------------------------- +# prints the HTML text for a link information in the +# header of an info node. Uses some icons URLs of icons +# are specified in 'info2html.conf'. +#------------------------------------------------------------ +sub PrintLinkInfo { + my ($LinkType, $LinkFile, $LinkTag, $BaseInfoFile) = @_; + my ($LinkFileEsc, $LinkTypeText); + return if $LinkFile eq "" && $LinkTag eq ""; + + #-- If no auxiliary file specified use the current info file + $LinkFile ||= $BaseInfoFile; + my $LinkRef = $LinkTag; + $LinkTag = &Escape($LinkTag); + $LinkFileEsc = &Escape($LinkFile); + #-- print the HTML Text + print < + $LinkTypeText + $LinkRef + +EOF +} + +#------------------------------------------------------------- +# PrintHeader +#------------------------------------------------------------- +# Prints the header for an info node in HTML format +#------------------------------------------------------------ +sub PrintHeader { + my ($LinkList, $BaseInfoFile) = @_; + my @LinkList = @{$LinkList}; + + my $UpcaseInfoFile = $BaseInfoFile; + $UpcaseInfoFile =~ tr/a-z/A-Z/; + #-- TEXT for the header of an info node + print < + + + + Info: ($BaseInfoFile) $LinkList[1] + $STYLESHEET_KDE + + + +
+
+ +
+
+ +
+
+$UpcaseInfoFile: $LinkList[1]
+
+
+EOF + common_headers($LinkList, $BaseInfoFile); +print < +
+
+EOF +} + +sub common_headers { + my ($LinkList, $BaseInfoFile) = @_; + my @LinkList = @{$LinkList}; + print < +EOF + &PrintLinkInfo("Prev", $LinkList[6], $LinkList[7], $BaseInfoFile); + print < +EOF + &PrintLinkInfo("Up", $LinkList[4], $LinkList[5], $BaseInfoFile); + print < +EOF + &PrintLinkInfo("Next", $LinkList[2], $LinkList[3], $BaseInfoFile); +} + +#--------------------------------------------------------- +# PrintFooter +#--------------------------------------------------------- +# prints the footer for an info node in HTML format +#--------------------------------------------------------- +sub PrintFooter { + my ($LinkList, $BaseInfoFile, $LinkFile) = @_; + + $LinkFile ||= $BaseInfoFile; + + #-- TEXT for the footer of an info node + print < + Automatically generated by a version of + + info2html + modified for KDE. +
+EOF + common_headers($LinkList, $BaseInfoFile); + print <-->$LinkFile +
+ + +EOF +} + +#---------------------------------------------------------- +# ReplyNotFoundMessage +#---------------------------------------------------------- +sub ReplyNotFoundMessage { + my ($FileName, $Tag) = @_; + print < +Info Files - Error Message + +

Error

+ +The Info node $Tag in Info file $FileName +does not exist. + +EOF +} + +sub PrintByFileLink { + print < +

If you did not find what you were looking for try browsing by file to + see files from packages which did not update the directory. +EOF +} + +#----------------------------------------------------------- +# BrowseByFile +#----------------------------------------------------------- +# Shows a list of available files in the system with a short +# description of them. +#------------------------------------------------------------ + +sub BrowseByFile { + my @LinkList = ('', '', '', '', + 'dir', 'Top', '','',''); # set LinkList[4] & LinkList[5], of course ;) + my $BaseInfoFile = 'Available Files'; + &PrintHeader(\@LinkList, $BaseInfoFile); + print <Available Files +EOF + &infocat; + &PrintFooter(\@LinkList, $BaseInfoFile); +} + +#----------------------------------------------------------- +# InfoNode2HTML +#----------------------------------------------------------- +# scans an info file for the node with the name '$Tag' +# starting at the postion '$Offset'. +# If found the node is tranlated to HTML and printed. +#------------------------------------------------------------ +sub InfoNode2HTML { + my ($FileName, $Offset, $Tag, $BaseInfoFile) = @_; + + local *FH2; + if ($FileName =~ /\.gz$/) { + open FH2, "-|", "gunzip", "-q", "-d", "-c", $FileName || &DieFileNotFound($FileName); + } elsif ($FileName =~ /\.bz2$/) { + open FH2, "-|", "bunzip2", "-q", "-d", "-c", $FileName || &DieFileNotFound($FileName); + } else { + open FH2, $FileName || &DieFileNotFound($FileName); + } + seek(FH2, $Offset, 0); + $Tag =~ tr/A-Z/a-z/; # -- to lowercase + #-- scan for the node start + my ($Found, @LinkList); + local $_; + while () { + if (/$NODEBORDER/) { + my $line = ; + @LinkList = &ParsHeaderLine($line); + my $CompareTag = $Tag; + $CompareTag =~ s/([^0-9A-Za-z])/\\$1/g; #-- escape special chars ! + my $Temp = $LinkList[1]; + $Temp =~ tr/A-Z/a-z/; #-- to lower case + if ($Temp =~ /^\s*$CompareTag\s*$/) { #-- node start found ? + $Found = 1; + last; + } + } + } + + return &ReplyNotFoundMessage($FileName, $Tag) unless $Found; # -- break if not found; + + &PrintHeader(\@LinkList, $BaseInfoFile); + my $InMenu = 0; + my $prev; + my $LineCount = 0; + my $Entries = 0; + my $Par = 0; + my @ParLines = (); + my $ParLine=0; + my $MayBeText=0; + my $MayBeTitle=0; + my $Line; + my $PrevMenu; + local $_; + while () { + $LineCount++; + last if /$NODEBORDER/; + #-- replace meta characters + #s/"`"([^"'"]*)"'"/""$1""/g; + s/&/&/g; + s/>/>/g; + s/ 1){ #-- an underline ? + if (/^\**$/) { + print "

$prev

\n"; + $prev = ""; + next; + } + elsif (/^=*$/) { + print "

$prev

\n"; + $prev = ""; + next; + } + else { + print "

$prev

\n"; + $prev = ""; + next; + } + } + + if (/^\* Menu/ && $InMenu == 0) { # -- start of menu section ? + $InMenu = 1; + print "

Menu

\n"; + } + elsif ($InMenu == 1) { + # This is pretty crappy code. + # A lot of logic (like the ParsCrossRefs and tranforming Variable: etc) is repeated below. + # There have been a few bugs which were fixed in one branch of the code and left in the other. + # This should be refactored. + # LPC (16 March 2003) + if (/^\* /) { #-- a menu entry ? + if ($Entries == 0) { + $Entries = 1; + print ""; + } + print &MenuItem2HTML($_,$BaseInfoFile); + } + elsif (/^$/) { #-- empty line + if ($Entries == 1) { + print "
"; + $Entries = 0; + } + print "
"; + } + else { + $Line = &ParsCrossRefs($prev,$_,$BaseInfoFile); + if ($Line =~ /^$DONTPRINTYET/) { + $prev = $Line; + $prev =~ s/^$DONTPRINTYET//; + chomp $prev; + } + elsif ($LineCount == 2) { + $prev = $Line; + } else { + $prev = $Line; + $Line =~ s#- (Variable|Function|Macro|Command|Special Form|User Option|Data Type):.*$#$&#; + $Line =~ s/^[ \t]*//; + print $Line; + } + } + } + else { + if (/^ *$/) { + if ($MayBeText == 1) { + print "

$Par

" + } else { + print "
";
+            foreach (@ParLines) {
+               print $_;
+            }
+            print "\n";
+            print "
"; + } + @ParLines = (); + $ParLine = 1; + $MayBeText = 1; + $MayBeTitle = 1; + $Par = ""; + } else { + if ($ParLine == 1) { + if (!/^ {1,4}[^ ]/ || /[^ ] [^ ]/) { + $MayBeText = 0; + } + } else { + if (!/^ ?[^ ]/ || /[^ ] [^ ]/) { + $MayBeText = 0; + } + } + $Line = &ParsCrossRefs($prev,$_,$BaseInfoFile); + if ($Line =~ /^$DONTPRINTYET/) { + $prev = $Line; + $prev =~ s/^$DONTPRINTYET//; + chomp $prev; + } elsif ($LineCount == 2) { + $prev = $Line; + } else { + $prev = $Line; + $Line =~ s#- (Variable|Function|Macro|Command|Special Form|User Option):.*$#$&#; + $Line =~ s/`([^']*)'/`$1<\/span>'/g; #' + $Line =~ s/((news|ftp|http):\/\/[A-Za-z0-9\.\/\#\-_\~]*)/$1<\/a>/g; + $Line =~ s/([A-Za-z0-9\.\/\#\-_\~]*\@[A-Za-z0-9\.\/\#\-_\~]*\.[A-Za-z]{2,3})/$1<\/a>/g; + $Par = $Par . $Line; + $ParLines[$ParLine] = $Line; + $ParLine++; + } + } + } + } + if ($Entries == 1) { + print "" + } + if ($PrevMenu =~ "") { + print &MenuItem2HTML($PrevMenu,$BaseInfoFile); + } + + close(FH2); + + if ($BaseInfoFile =~ m/dir/i + && $Tag =~ m/Top/i) { + &PrintByFileLink; + } + + &PrintFooter(\@LinkList, $BaseInfoFile); +} + +#------------------------------------------------------------- +# max +#------------------------------------------------------------ +sub max { + my ($a, $b) = @_; + return $a >= $b ? $a : $b; +} + +#----------------------------------------------------------- +# GetFileAndOffset +#------------------------------------------------------------ +# This procedure locates a specific node in a info file +# The location is based on the tag and indirect table in +# basic info file if such tables are available. +# Because the offsets specified in the tag and in the +# indirect table are more or less inacurate the computet +# offset is set back 100 bytes. From this position +# the specified node will looked for sequentially +#------------------------------------------------------------ +sub GetFileAndOffset { + my ($BaseInfoFile, $NodeName) = @_; + my ($Exists, $IsIndirect, $File, $Offset, $FileOffset, %TagList, @FileNames, @Offsets); + $NodeName =~ tr/A-Z/a-z/; + &ReadIndirectTable($BaseInfoFile, \@FileNames, \@Offsets); + + +# This looks wastefull: +# We build a whole TagList hash and then use it to lookup the tag info. +# Why not pass $NodeName to ReadTagTable and let it return just the desired info? +# lpc (16 March 2003) + &ReadTagTable($BaseInfoFile, \%TagList, \$Exists, \$IsIndirect); + return "", 0 unless $Exists; #-- no tag table available + return "", 0 unless defined $TagList{$NodeName}; #-- tag is not in the tag table + ($File, $Offset) = split(/#/, $TagList{$NodeName}); + return $File, &max($Offset - 100, 0) if $File; #-- there is an explicite + #-- not in the tag table + + if ($IsIndirect == 1) { + foreach my $i (0..$#Offsets) { + $FileOffset = $Offsets[$i] if $Offsets[$i] <= $Offset; + $File = $FileNames[$i] if $Offsets[$i] <= $Offset; + } + return $File, &max($Offset - $FileOffset - 100,0); #-- be safe (-100!) + } else { + return "", &max($Offset - 100, 0); + } +} + +# FindFile: find the given file on the infopath, return full name or "". +# Let filenames optionally have .info suffix. Try named version first. +# Handle gzipped file too. +sub FindFile { + my ($File) = @_; + return "" if ($File =~ /\.\./); + my $Alt = $File =~ /^(.+)\.info$/ ? $1 : $File . '.info'; + foreach my $Name ($File, $Alt) { + my $gzName = $Name . '.gz'; + my $bz2Name = $Name . '.bz2'; + + foreach (@info2html::config::INFODIR) { + return "$_/$Name" if -e "$_/$Name"; + return "$_/$gzName" if -e "$_/$gzName"; + return "$_/$bz2Name" if -e "$_/$bz2Name"; + } + next unless $ENV{INFOPATH}; + foreach my $i (split(/:/, $ENV{INFOPATH})) { + return "$i/$Name" if -e "$i/$Name"; + return "$i/$gzName" if -e "$i/$gzName"; + return "$i/$bz2Name" if -e "$i/$bz2Name"; + } + } + return ""; +} + +#------------------------------------------------------- +# +#------------------- MAIN ----------------------------- +# +# called as +# perl /path/kde-info2html config_file image_base_path BaseInfoFile NodeName +# +# BaseInfoFile eq '#special#' to pass special args through NodeName (yes, it is a hack). +# + +my $PROGRAM = $0; # determine our basename and version +$PROGRAM =~ s!.*/!!; +my ($BaseInfoFile, $NodeName) = ($ARGV[2], $ARGV[3]); +#&DirnameCheck($BaseInfoFile) || &DieFileNotFound($BaseInfoFile); + +if ($BaseInfoFile eq '#special#' && $NodeName eq 'browse_by_file') { + &BrowseByFile; + exit 0; +} + +$BaseInfoFile = "dir" if $BaseInfoFile =~ /^dir$/i; +my $FileNameFull = &FindFile($BaseInfoFile) || &FileNotFound($BaseInfoFile,$NodeName); +my ($File, $Offset) = &GetFileAndOffset($FileNameFull, $NodeName); +$File ||= $BaseInfoFile; +$FileNameFull = &FindFile($File); +&InfoNode2HTML($FileNameFull, $Offset, $NodeName, $BaseInfoFile); + +exit 0; diff --git a/kioslave/info/kde-info2html.conf b/kioslave/info/kde-info2html.conf new file mode 100644 index 000000000..260d2b336 --- /dev/null +++ b/kioslave/info/kde-info2html.conf @@ -0,0 +1,43 @@ +# -*- perl -*- +package info2html::config; +#----------------------------------------------------------------- +# info2html.conf +#----------------------------------------------------------------- +# PURPOSE +# configuration settings for the 'info2html' script. +# +# AUTHOR +# Karl Guggisberg +# +# HISTORY +# 15.10.93 V 1.0b +# 16.10.93 V 1.0c multple info files possible +# 28.6.94 V 1.0d some minor changes +# 8.4.95 V 1.1 some changements +#---------------------------------------------------------------- + +use strict; +#use vars qw(@ISA @EXPORT); +# +#@ISA = qw(Exporter); +#@EXPORT = qw(@INFODIR $DOC_URL); + + +#-- location of info files. +our @INFODIR = ( + "/usr/share/info", + "/usr/info", + "/usr/lib/info", +# "/usr/lib/teTeX/info", + "/usr/local/info", + "/usr/local/lib/info", + "/usr/X11R6/info", + "/usr/X11R6/lib/info", + "/usr/X11R6/lib/xemacs/info" + ); + + +#-- URL for documentation of info2html +our $DOC_URL = 'http://info2html.sourceforge.net/'; + +1; -- cgit v1.2.3