faq.pl 2.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081
  1. # Copyright (C) 2004 Alex Schroeder <alex@emacswiki.org>
  2. # Niklas Volbers <mithrandir42@web.de>
  3. #
  4. # This program is free software; you can redistribute it and/or modify
  5. # it under the terms of the GNU General Public License as published by
  6. # the Free Software Foundation; either version 2 of the License, or
  7. # (at your option) any later version.
  8. #
  9. # This program is distributed in the hope that it will be useful,
  10. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. # GNU General Public License for more details.
  13. #
  14. # You should have received a copy of the GNU General Public License
  15. # along with this program; if not, write to the
  16. # Free Software Foundation, Inc.
  17. # 59 Temple Place, Suite 330
  18. # Boston, MA 02111-1307 USA
  19. # This module creates a list of all questions on the page, e.g.
  20. # for a faq. It does so by recognizing all lines that begin with
  21. # a Q: as a question.
  22. # Additionally, lines starting with Q: and A: are rendered using
  23. # the css classes div.question and div.answer.
  24. use strict;
  25. use v5.10;
  26. AddModuleDescription('faq.pl', 'FAQ Extension');
  27. our ($q, $bol, @MyRules);
  28. our ($FaqHeaderText, $FaqQuestionText, $FaqAnswerText);
  29. $FaqHeaderText = "Questions on this page:" unless $FaqHeaderText;
  30. $FaqQuestionText = "Question: " unless $FaqQuestionText;
  31. $FaqAnswerText = "Answer: " unless $FaqAnswerText;
  32. push(@MyRules, \&FaqRule);
  33. sub FaqRule {
  34. if ($bol && m/\GQ: (.+)/cg) {
  35. return $q->a({name=>'FAQ_' . UrlEncode($1)},'')
  36. . $q->div({class=>'question'}, $FaqQuestionText . $1);
  37. } elsif ($bol && m/\GA:[ \t]*/cg) {
  38. return CloseHtmlEnvironments()
  39. . AddHtmlEnvironment('div', "class='answer'") . $FaqAnswerText;
  40. }
  41. return;
  42. }
  43. *OldFaqGetHeader = \&GetHeader;
  44. *GetHeader = \&NewFaqGetHeader;
  45. sub NewFaqGetHeader {
  46. my ($id) = @_;
  47. my $result = OldFaqGetHeader(@_);
  48. # append FAQ to header
  49. $result .= FaqHeadings($id) if $id;
  50. return $result;
  51. }
  52. sub FaqHeadings {
  53. my $page = GetPageContent(shift);
  54. # ignore all the stuff that gets processed anyway by usemod.pl and
  55. # creole.pl -- if we're not going to hook into ordinary parsing like
  56. # toc.pl does, this will always be incomplete.
  57. $page =~ s/<nowiki>(.*\n)*<\/nowiki>//gi;
  58. $page =~ s/<pre>(.*\n)*<\/pre>//gi;
  59. $page =~ s/<code>(.*\n)*<\/code>//gi;
  60. $page =~ s/\{\{\{[ \t]*\n(.*?)\n\}\}\}[ \t]*(\n|$)//gs;
  61. my $Headings = '';
  62. foreach my $line (grep(/^Q:[ \t]*(.*?)$/, split(/\n/, $page))) {
  63. next unless $line =~ /^Q:[ \t]*(.*?)$/;
  64. next unless $1;
  65. my $link = 'FAQ_' . UrlEncode($1);
  66. $Headings .= $q->li($q->a({href=>'#' . $link}, $1));
  67. }
  68. return $q->div({class=>'faq'}, $FaqHeaderText . $q->ol($Headings)) if $Headings;
  69. }