code.delx.au - gnu-emacs-elpa/blob - packages/notes-mode/mkindexcache

   1 #!/usr/bin/perl -w
   2
   3 #
   4 # mkindexcache
   5 # $Id: mkindexcache,v 1.12 2008/08/08 17:41:14 johnh Exp $
   6 #
   7 # Copyright (C) 1994-2006,2012  Free Software Foundation, Inc.
   8 # Comments to <johnh@isi.edu>.
   9 #
  10 # This file is under the Gnu Public License.
  11 #
  12
  13 sub usage {
  14     print STDERR <<END;
  15 usage: $0 <index >index.el
  16
  17 Converts a processed index into elisp code to intern
  18 the symbols and font-lock the buffer.
  19 END
  20     exit 1;
  21 }
  22
  23 require 5.006;  # for IO handling of :locale
  24
  25 # Force unicode for input and output.
  26 # Without this requirement, unicode on the input results in incorrect
  27 # (byte-level, not character-level) values of $seek,
  28 # and since emacs' put-text-property is char-level,
  29 # it gets off.
  30 use open ':locale';   # Now let $ENV{LANG} and $ENV{LC_CTYPE} determine input encoding; previously we forced utf8, but not all are pure.
  31
  32 my(@subjects) = ();
  33 my(@sstart, @send) = ();
  34 my($seek) = 1;
  35
  36 while (<>) {
  37     if (m@^(.*): \d@) {
  38         push(@subjects, $1);
  39         push(@sstart, $seek);
  40         push(@send, $seek + length($1));
  41     };
  42     $seek += length($_);
  43 #    my $l1 = length($_);
  44 #    my $l2;
  45 #    do { use bytes; $l2 = length($_); };
  46 #    print "; $l1 $l2\n";
  47 };
  48
  49 sub round_to_power_of_8 {
  50     my($n) = @_;
  51     return 8 ** (length(sprintf("%o", $n)));
  52 }
  53
  54 print ";; auto-generated by mkindexcache\n";
  55 print "(defun notes-index-parse-buffer-cached ()\n";
  56 my($asize) = round_to_power_of_8($#subjects) - 1;
  57 print "  (setq notes-subject-table (make-vector $asize 0))\n";
  58
  59 # output intern'ing code
  60 print "  (mapcar (function (lambda (a) (intern a notes-subject-table))) '(\n";
  61 foreach (@subjects) {
  62     my($qsubject) = $_;
  63     $qsubject =~ s/(["\\])/\\$1/g; #"
  64     print "\t\"$qsubject\"\n";
  65 };
  66 print "    ))\n";
  67
  68 # output font-lock code
  69 print "  (if notes-use-font-lock\n" .
  70       "    (progn\n" .
  71       "      (remove-text-properties (point-min) (point-max) '(face nil))\n" .
  72       "        (mapcar (function (lambda (a)\n" .
  73       "                            (put-text-property (car a) (cdr a) 'face notes-bold-face)))\n" .
  74       "                '(\n";
  75 for (0..$#subjects) {
  76     print "\t\t($sstart[$_] . $send[$_])\n";
  77 };
  78 print "      )))))\n";
  79
  80 exit 0;
  81
  82