1 rizwank 1.1 ;;
  2             ;; Emacs help commands for enscript.
  3             ;; Copyright (c) 1997 Markku Rossi.
  4             ;; Author: Markku Rossi <mtr@iki.fi>
  5             ;;
  6             
  7             ;;
  8             ;; This file is part of GNU enscript.
  9             ;;
 10             ;; This program is free software; you can redistribute it and/or modify
 11             ;; it under the terms of the GNU General Public License as published by
 12             ;; the Free Software Foundation; either version 2, or (at your option)
 13             ;; any later version.
 14             ;;
 15             ;; This program is distributed in the hope that it will be useful,
 16             ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 17             ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 18             ;; GNU General Public License for more details.
 19             ;;
 20             ;; You should have received a copy of the GNU General Public License
 21             ;; along with this program; see the file COPYING.  If not, write to
 22 rizwank 1.1 ;; the Free Software Foundation, 59 Temple Place - Suite 330,
 23             ;; Boston, MA 02111-1307, USA.
 24             ;;
 25             
 26             ;/* Keywords:
 27             ;   (build-re '(auto break case char const continue default do double else
 28             ;               enum extern float for goto if int long register return
 29             ;		short signed sizeof static struct switch typedef union
 30             ;		unsigned void volatile while))
 31             ;*/
 32             
 33             (defun fetch-first-chars (lst)
 34               "Fetch the initial character of list LST of strings."
 35               (let ((result '())
 36             	(str ""))
 37                 (mapcar
 38                  (lambda (str)
 39                    (let ((ch (string-to-char str)))
 40             	 (if (not (member ch result))
 41             	     (setq result (cons ch result)))))
 42                  lst)
 43 rizwank 1.1     (sort result (function <))))
 44             
 45             (defun fetch-with-prefix (prefix lst)
 46               "Fetch the list items from list LST with start with PREFIX.  The fetched
 47             items are modified so that the prefix is removed from strings."
 48               (let ((result '())
 49             	(prefix-len (length prefix)))
 50                 (mapcar
 51                  (lambda (str)
 52                    (if (and (>= (length str) prefix-len)
 53             		(string= prefix (substring str 0 prefix-len)))
 54             	   (setq result (cons (substring str prefix-len) result))))
 55                  lst)
 56                 result))
 57             
 58             (defun build-tree (lst)
 59               "Build a regular expressions tree from list LST of words to match."
 60               (mapcar
 61                (lambda (prefix)
 62                  (if (= prefix 0)
 63             	 ""
 64 rizwank 1.1        (setq prefix (char-to-string prefix))
 65                    (let ((result (fetch-with-prefix prefix lst)))
 66             	 (if (= (length result) 1)
 67             	     (concat prefix (car result))
 68             	   (let ((rest (build-tree result)))
 69             	     (if (and (= (length rest) 1) (listp (car rest)))
 70             		 (cons (concat prefix (car (car rest))) (cdr (car rest)))
 71             	       (cons prefix rest)))))))
 72                (fetch-first-chars lst)))
 73             
 74             (defun join (list glue result)
 75               (if (stringp list)
 76                   list
 77                 (if (= (length list) 1)
 78             	(concat result (car list))
 79                   (join (cdr list) glue (concat result (car list) glue)))))
 80             
 81             (defun join-column (list glue result column pos)
 82               (if (and (> (+ pos (length (car list)) (length glue)) column) (> pos 0))
 83                   (let ((len (length result))
 84             	    (gluelen (length glue)))
 85 rizwank 1.1 	(join-column list glue
 86             		     (concat (substring result 0 (- len gluelen)) "\\\n" glue)
 87             		     column 0))
 88                 (if (= (length list) 1)
 89             	(concat result (car list))
 90                   (join-column (cdr list) glue (concat result (car list) glue) column
 91             		   (+ pos (length (car list)) (length glue))))))
 92             
 93             (defun join-tree (tree case-insensitive)
 94               "Join regular expression tree TREE to a string.  Argument CASE-INSENSITIVE
 95             specifies whatever the generated expression matches its words case
 96             insensitively or not."
 97               (join-column
 98                (mapcar
 99                 (lambda (item)
100                   (if (stringp item)
101             	  (if case-insensitive
102             	      (make-case-insensitive-regexp item)
103             	    item)
104             	(concat (if case-insensitive
105             		    (make-case-insensitive-regexp (car item))
106 rizwank 1.1 		  (car item))
107             		"("
108             		(join (join-tree (cdr item) case-insensitive) "|" "") ")")))
109                 tree)
110                "|" "" 70 0))
111             
112             (defun make-case-insensitive-regexp (string)
113               (let ((result ""))
114                 (while (not (string= string ""))
115                   (let* ((ch (string-to-char string))
116             	     (uch (upcase ch)))
117             	(if (= ch uch)
118             	    (progn
119             	      (setq string (substring string 1))
120             	      (setq result (concat result (char-to-string ch))))
121             	  (setq string (substring string 1))
122             	  (setq result (concat result "[" (char-to-string ch)
123             			       (char-to-string uch) "]")))))
124                 result))
125             
126             (defun build-re (words &optional case-insensitive)
127 rizwank 1.1   "Build an optimized regular expression from list WORDS which can contain
128             symbols and strings.  Optional second argument CASE-INSENSITIVE specifies
129             whatever the created regular expression should match its keywords case
130             insensitively or not.  The default is case sensitive matching.  If the
131             function is enclosed in C-comments, it inserts the generated regular expression
132             after the closing \"*/\" sequence, otherwise it returns regular expression
133             as a string."
134               (save-excursion
135                 (let ((re (concat "/\\b("
136             		      (join-tree (build-tree (mapcar (lambda (item)
137             						       (if (stringp item)
138             							   item
139             							 (symbol-name item)))
140             						     words))
141             				 case-insensitive)
142             		      ")\\b/ {")))
143                   (if (search-forward "*/" nil t)
144             	  (progn
145             	    (open-line 2)
146             	    (next-line 1)
147             	    (insert "  " re))
148 rizwank 1.1 	re))))