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