enscript.el - enscript - GNU Enscript
(HTM) git clone git://thinkerwim.org/enscript.git
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) README
(DIR) LICENSE
---
enscript.el (4851B)
---
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 ;; 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.
14 ;;
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.
19 ;;
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/>.
22 ;;
23
24 ;/* Keywords:
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))
29 ;*/
30
31 (defun fetch-first-chars (lst)
32 "Fetch the initial character of list LST of strings."
33 (let ((result '())
34 (str ""))
35 (mapcar
36 (lambda (str)
37 (let ((ch (string-to-char str)))
38 (if (not (member ch result))
39 (setq result (cons ch result)))))
40 lst)
41 (sort result (function <))))
42
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."
46 (let ((result '())
47 (prefix-len (length prefix)))
48 (mapcar
49 (lambda (str)
50 (if (and (>= (length str) prefix-len)
51 (string= prefix (substring str 0 prefix-len)))
52 (setq result (cons (substring str prefix-len) result))))
53 lst)
54 result))
55
56 (defun build-tree (lst)
57 "Build a regular expressions tree from list LST of words to match."
58 (mapcar
59 (lambda (prefix)
60 (if (= prefix 0)
61 ""
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)))
71
72 (defun join (list glue result)
73 (if (stringp list)
74 list
75 (if (= (length list) 1)
76 (concat result (car list))
77 (join (cdr list) glue (concat result (car list) glue)))))
78
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)
85 column 0))
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))))))
90
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."
95 (join-column
96 (mapcar
97 (lambda (item)
98 (if (stringp item)
99 (if case-insensitive
100 (make-case-insensitive-regexp item)
101 item)
102 (concat (if case-insensitive
103 (make-case-insensitive-regexp (car item))
104 (car item))
105 "("
106 (join (join-tree (cdr item) case-insensitive) "|" "") ")")))
107 tree)
108 "|" "" 70 0))
109
110 (defun make-case-insensitive-regexp (string)
111 (let ((result ""))
112 (while (not (string= string ""))
113 (let* ((ch (string-to-char string))
114 (uch (upcase ch)))
115 (if (= ch uch)
116 (progn
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) "]")))))
122 result))
123
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
131 as a string."
132 (save-excursion
133 (let ((re (concat "/\\b("
134 (join-tree (build-tree (mapcar (lambda (item)
135 (if (stringp item)
136 item
137 (symbol-name item)))
138 words))
139 case-insensitive)
140 ")\\b/ {")))
141 (if (search-forward "*/" nil t)
142 (progn
143 (open-line 2)
144 (next-line 1)
145 (insert " " re))
146 re))))