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