|
0
|
1 ;;; regi.el --- REGular expression Interpreting engine
|
|
|
2
|
|
|
3 ;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <bwarsaw@cen.com>
|
|
|
4 ;; Maintainer: bwarsaw@cen.com
|
|
|
5 ;; Created: 24-Feb-1993
|
|
|
6 ;; Version: 1.8
|
|
|
7 ;; Last Modified: 1993/06/01 21:33:00
|
|
|
8 ;; Keywords: extensions, matching, wp
|
|
|
9
|
|
|
10 ;; Copyright (C) 1993 Barry A. Warsaw
|
|
|
11
|
|
|
12 ;; This file is part of XEmacs.
|
|
|
13
|
|
|
14 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
15 ;; under the terms of the GNU General Public License as published by
|
|
|
16 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
17 ;; any later version.
|
|
|
18
|
|
|
19 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
22 ;; General Public License for more details.
|
|
|
23
|
|
|
24 ;; You should have received a copy of the GNU General Public License
|
|
|
25 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
|
26 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
27
|
|
|
28 ;; LCD Archive Entry
|
|
|
29 ;; regi|Barry A. Warsaw|bwarsaw@cen.com
|
|
|
30 ;; |REGular expression Interpreting engine
|
|
|
31 ;; |1993/06/01 21:33:00|1.8|
|
|
|
32
|
|
|
33 ;;; Synched up with: FSF 19.30.
|
|
|
34
|
|
|
35 ;;; Code:
|
|
|
36
|
|
|
37
|
|
|
38 (defun regi-pos (&optional position col-p)
|
|
|
39 "Return the character position at various buffer positions.
|
|
|
40 Optional POSITION can be one of the following symbols:
|
|
|
41
|
|
|
42 `bol' == beginning of line
|
|
|
43 `boi' == beginning of indentation
|
|
|
44 `eol' == end of line [default]
|
|
|
45 `bonl' == beginning of next line
|
|
|
46 `bopl' == beginning of previous line
|
|
|
47
|
|
|
48 Optional COL-P non-nil returns `current-column' instead of character position."
|
|
|
49 (save-excursion
|
|
|
50 (cond
|
|
|
51 ((eq position 'bol) (beginning-of-line))
|
|
|
52 ((eq position 'boi) (back-to-indentation))
|
|
|
53 ((eq position 'bonl) (forward-line 1))
|
|
|
54 ((eq position 'bopl) (forward-line -1))
|
|
|
55 (t (end-of-line)))
|
|
|
56 (if col-p (current-column) (point))))
|
|
|
57
|
|
|
58 (defun regi-mapcar (predlist func &optional negate-p case-fold-search-p)
|
|
|
59 "Build a regi frame where each element of PREDLIST appears exactly once.
|
|
|
60 The frame contains elements where each member of PREDLIST is
|
|
|
61 associated with FUNC, and optionally NEGATE-P and CASE-FOLD-SEARCH-P."
|
|
|
62 (let (frame tail)
|
|
|
63 (if (or negate-p case-fold-search-p)
|
|
|
64 (setq tail (list negate-p)))
|
|
|
65 (if case-fold-search-p
|
|
|
66 (setq tail (append tail (list case-fold-search-p))))
|
|
|
67 (while predlist
|
|
|
68 (let ((element (list (car predlist) func)))
|
|
|
69 (if tail
|
|
|
70 (setq element (append element tail)))
|
|
|
71 (setq frame (append frame (list element))
|
|
|
72 predlist (cdr predlist))
|
|
|
73 ))
|
|
|
74 frame))
|
|
|
75
|
|
|
76
|
|
|
77 (defun regi-interpret (frame &optional start end)
|
|
|
78 "Interpret the regi frame FRAME.
|
|
|
79 If optional START and END are supplied, they indicate the region of
|
|
|
80 interest, and the buffer is narrowed to the beginning of the line
|
|
|
81 containing START, and beginning of the line after the line containing
|
|
|
82 END. Otherwise, point and mark are not set and processing continues
|
|
|
83 until your FUNC returns the `abort' symbol (see below). Beware! Not
|
|
|
84 supplying a START or END could put you in an infinite loop.
|
|
|
85
|
|
|
86 A regi frame is a list of entries of the form:
|
|
|
87
|
|
|
88 (PRED FUNC [NEGATE-P [CASE-FOLD-SEARCH]])
|
|
|
89
|
|
|
90 PRED is a predicate against which each line in the region is tested,
|
|
|
91 and if a match occurs, FUNC is `eval'd. Point is then moved to the
|
|
|
92 beginning of the next line, the frame is reset and checking continues.
|
|
|
93 If a match doesn't occur, the next entry is checked against the
|
|
|
94 current line until all entries in the frame are checked. At this
|
|
|
95 point, if no match occurred, the frame is reset and point is moved to
|
|
|
96 the next line. Checking continues until every line in the region is
|
|
|
97 checked. Optional NEGATE-P inverts the result of PRED before FUNC is
|
|
|
98 called and `case-fold-search' is bound to the optional value of
|
|
|
99 CASE-FOLD-SEARCH for the PRED check.
|
|
|
100
|
|
|
101 PRED can be a string, variable, function or one of the following
|
|
|
102 symbols: t, nil, `begin', `end', and `every'. If PRED is a string, or
|
|
|
103 a variable or list that evaluates to a string, it is interpreted as a
|
|
|
104 regular expression and is matched against the current line (from the
|
|
|
105 beginning) using `looking-at'. If PRED does not evaluate to a string,
|
|
|
106 it is interpreted as a binary value (nil or non-nil).
|
|
|
107
|
|
|
108 PRED can also be one of the following symbols:
|
|
|
109
|
|
|
110 t -- always produces a true outcome
|
|
|
111 `begin' -- always executes before anything else
|
|
|
112 `end' -- always executes after everything else
|
|
|
113 `every' -- execute after frame is matched on a line
|
|
|
114
|
|
|
115 Note that NEGATE-P and CASE-FOLD-SEARCH are meaningless if PRED is one
|
|
|
116 of these special symbols. Only the first occurance of each symbol in
|
|
|
117 a frame entry is used, the rest are ignored.
|
|
|
118
|
|
|
119 Your FUNC can return values which control regi processing. If a list
|
|
|
120 is returned from your function, it can contain any combination of the
|
|
|
121 following elements:
|
|
|
122
|
|
|
123 the symbol `continue'
|
|
|
124 Tells regi to continue processing frame-entries after a match,
|
|
|
125 instead of resetting to the first entry and advancing to the next
|
|
|
126 line, as is the default behavior. When returning this symbol,
|
|
|
127 you must take care not to enter an infinite loop.
|
|
|
128
|
|
|
129 the symbol `abort'
|
|
|
130 Tells regi to terminate processing this frame. any end
|
|
|
131 frame-entry is still processed.
|
|
|
132
|
|
|
133 the list `(frame . NEWFRAME)'
|
|
|
134 Tells regi to use NEWFRAME as its current frame. In other words,
|
|
|
135 your FUNC can modify the executing regi frame on the fly.
|
|
|
136
|
|
|
137 the list `(step . STEP)'
|
|
|
138 Tells regi to move STEP number of lines forward during normal
|
|
|
139 processing. By default, regi moves forward 1 line. STEP can be
|
|
|
140 negative, but be careful of infinite loops.
|
|
|
141
|
|
|
142 You should usually take care to explicitly return nil from your
|
|
|
143 function if no action is to take place. Your FUNC will always be
|
|
|
144 `eval'ed. The following variables will be temporarily bound to some
|
|
|
145 useful information:
|
|
|
146
|
|
|
147 `curline'
|
|
|
148 the current line in the buffer, as a string
|
|
|
149
|
|
|
150 `curframe'
|
|
|
151 the full, current frame being executed
|
|
|
152
|
|
|
153 `curentry'
|
|
|
154 the current frame entry being executed."
|
|
|
155
|
|
|
156 (save-excursion
|
|
|
157 (save-restriction
|
|
|
158 (let (begin-tag end-tag every-tag current-frame working-frame donep)
|
|
|
159
|
|
|
160 ;; set up the narrowed region
|
|
|
161 (and start
|
|
|
162 end
|
|
|
163 (let* ((tstart start)
|
|
|
164 (start (min start end))
|
|
|
165 (end (max start end)))
|
|
|
166 (narrow-to-region
|
|
|
167 (progn (goto-char end) (regi-pos 'bonl))
|
|
|
168 (progn (goto-char start) (regi-pos 'bol)))))
|
|
|
169
|
|
|
170 ;; lets find the special tags and remove them from the working
|
|
|
171 ;; frame. note that only the last special tag is used.
|
|
|
172 (mapcar
|
|
|
173 (function
|
|
|
174 (lambda (entry)
|
|
|
175 (let ((pred (car entry))
|
|
|
176 (func (car (cdr entry))))
|
|
|
177 (cond
|
|
|
178 ((eq pred 'begin) (setq begin-tag func))
|
|
|
179 ((eq pred 'end) (setq end-tag func))
|
|
|
180 ((eq pred 'every) (setq every-tag func))
|
|
|
181 (t
|
|
|
182 (setq working-frame (append working-frame (list entry))))
|
|
|
183 ) ; end-cond
|
|
|
184 )))
|
|
|
185 frame) ; end-mapcar
|
|
|
186
|
|
|
187 ;; execute the begin entry
|
|
|
188 (eval begin-tag)
|
|
|
189
|
|
|
190 ;; now process the frame
|
|
|
191 (setq current-frame working-frame)
|
|
|
192 (while (not (or donep (eobp)))
|
|
|
193 (let* ((entry (car current-frame))
|
|
|
194 (pred (nth 0 entry))
|
|
|
195 (func (nth 1 entry))
|
|
|
196 (negate-p (nth 2 entry))
|
|
|
197 (case-fold-search (nth 3 entry))
|
|
|
198 match-p)
|
|
|
199 (catch 'regi-throw-top
|
|
|
200 (cond
|
|
|
201 ;; we are finished processing the frame for this line
|
|
|
202 ((not current-frame)
|
|
|
203 (setq current-frame working-frame) ;reset frame
|
|
|
204 (forward-line 1)
|
|
|
205 (throw 'regi-throw-top t))
|
|
|
206 ;; see if predicate evaluates to a string
|
|
|
207 ((stringp (setq match-p (eval pred)))
|
|
|
208 (setq match-p (looking-at match-p)))
|
|
|
209 ) ; end-cond
|
|
|
210
|
|
|
211 ;; now that we've done the initial matching, check for
|
|
|
212 ;; negation of match
|
|
|
213 (and negate-p
|
|
|
214 (setq match-p (not match-p)))
|
|
|
215
|
|
|
216 ;; if the line matched, package up the argument list and
|
|
|
217 ;; funcall the FUNC
|
|
|
218 (if match-p
|
|
|
219 (let* ((curline (buffer-substring
|
|
|
220 (regi-pos 'bol)
|
|
|
221 (regi-pos 'eol)))
|
|
|
222 (curframe current-frame)
|
|
|
223 (curentry entry)
|
|
|
224 (result (eval func))
|
|
|
225 (step (or (cdr (assq 'step result)) 1))
|
|
|
226 )
|
|
|
227 ;; changing frame on the fly?
|
|
|
228 (if (assq 'frame result)
|
|
|
229 (setq working-frame (cdr (assq 'frame result))))
|
|
|
230
|
|
|
231 ;; continue processing current frame?
|
|
|
232 (if (memq 'continue result)
|
|
|
233 (setq current-frame (cdr current-frame))
|
|
|
234 (forward-line step)
|
|
|
235 (setq current-frame working-frame))
|
|
|
236
|
|
|
237 ;; abort current frame?
|
|
|
238 (if (memq 'abort result)
|
|
|
239 (progn
|
|
|
240 (setq donep t)
|
|
|
241 (throw 'regi-throw-top t)))
|
|
|
242 ) ; end-let
|
|
|
243
|
|
|
244 ;; else if no match occurred, then process the next
|
|
|
245 ;; frame-entry on the current line
|
|
|
246 (setq current-frame (cdr current-frame))
|
|
|
247
|
|
|
248 ) ; end-if match-p
|
|
|
249 ) ; end catch
|
|
|
250 ) ; end let
|
|
|
251
|
|
|
252 ;; after every cycle, evaluate every-tag
|
|
|
253 (eval every-tag)
|
|
|
254 ) ; end-while
|
|
|
255
|
|
|
256 ;; now process the end entry
|
|
|
257 (eval end-tag)))))
|
|
|
258
|
|
|
259
|
|
|
260 (provide 'regi)
|
|
|
261 ;;; regi.el ends here
|
