2 ;; Emacs help commands for enscript.
3 ;; Copyright (c) 1997 Markku Rossi.
4 ;; Author: Markku Rossi <mtr@iki.fi>
8 ;; This file is part of GNU Enscript.
10 ;; Enscript 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 3 of the License, or
13 ;; (at your option) any later version.
15 ;; Enscript 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.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with Enscript. If not, see <http://www.gnu.org/licenses/>.
25 ; (build-re '(auto break case char const continue default do double else
26 ; enum extern float for goto if int long register return
27 ; short signed sizeof static struct switch typedef union
28 ; unsigned void volatile while))
31 (defun fetch-first-chars (lst)
32 "Fetch the initial character of list LST of strings."
37 (let ((ch (string-to-char str)))
38 (if (not (member ch result))
39 (setq result (cons ch result)))))
41 (sort result (function <))))
43 (defun fetch-with-prefix (prefix lst)
44 "Fetch the list items from list LST with start with PREFIX. The fetched
45 items are modified so that the prefix is removed from strings."
47 (prefix-len (length prefix)))
50 (if (and (>= (length str) prefix-len)
51 (string= prefix (substring str 0 prefix-len)))
52 (setq result (cons (substring str prefix-len) result))))
56 (defun build-tree (lst)
57 "Build a regular expressions tree from list LST of words to match."
62 (setq prefix (char-to-string prefix))
63 (let ((result (fetch-with-prefix prefix lst)))
64 (if (= (length result) 1)
65 (concat prefix (car result))
66 (let ((rest (build-tree result)))
67 (if (and (= (length rest) 1) (listp (car rest)))
68 (cons (concat prefix (car (car rest))) (cdr (car rest)))
69 (cons prefix rest)))))))
70 (fetch-first-chars lst)))
72 (defun join (list glue result)
75 (if (= (length list) 1)
76 (concat result (car list))
77 (join (cdr list) glue (concat result (car list) glue)))))
79 (defun join-column (list glue result column pos)
80 (if (and (> (+ pos (length (car list)) (length glue)) column) (> pos 0))
81 (let ((len (length result))
82 (gluelen (length glue)))
83 (join-column list glue
84 (concat (substring result 0 (- len gluelen)) "\\\n" glue)
86 (if (= (length list) 1)
87 (concat result (car list))
88 (join-column (cdr list) glue (concat result (car list) glue) column
89 (+ pos (length (car list)) (length glue))))))
91 (defun join-tree (tree case-insensitive)
92 "Join regular expression tree TREE to a string. Argument CASE-INSENSITIVE
93 specifies whatever the generated expression matches its words case
94 insensitively or not."
100 (make-case-insensitive-regexp item)
102 (concat (if case-insensitive
103 (make-case-insensitive-regexp (car item))
106 (join (join-tree (cdr item) case-insensitive) "|" "") ")")))
110 (defun make-case-insensitive-regexp (string)
112 (while (not (string= string ""))
113 (let* ((ch (string-to-char string))
117 (setq string (substring string 1))
118 (setq result (concat result (char-to-string ch))))
119 (setq string (substring string 1))
120 (setq result (concat result "[" (char-to-string ch)
121 (char-to-string uch) "]")))))
124 (defun build-re (words &optional case-insensitive)
125 "Build an optimized regular expression from list WORDS which can contain
126 symbols and strings. Optional second argument CASE-INSENSITIVE specifies
127 whatever the created regular expression should match its keywords case
128 insensitively or not. The default is case sensitive matching. If the
129 function is enclosed in C-comments, it inserts the generated regular expression
130 after the closing \"*/\" sequence, otherwise it returns regular expression
133 (let ((re (concat "/\\b("
134 (join-tree (build-tree (mapcar (lambda (item)
141 (if (search-forward "*/" nil t)