126 |
(defun sml-find-match-forward (this match) |
(defun sml-find-match-forward (this match) |
127 |
"Only works for word matches." |
"Only works for word matches." |
128 |
(let ((level 1) |
(let ((level 1) |
129 |
|
(forward-sexp-function nil) |
130 |
(either (concat this "\\|" match))) |
(either (concat this "\\|" match))) |
131 |
(while (> level 0) |
(while (> level 0) |
132 |
(forward-sexp 1) |
(forward-sexp 1) |
141 |
|
|
142 |
(defun sml-find-match-backward (this match) |
(defun sml-find-match-backward (this match) |
143 |
(let ((level 1) |
(let ((level 1) |
144 |
|
(forward-sexp-function nil) |
145 |
(either (concat this "\\|" match))) |
(either (concat this "\\|" match))) |
146 |
(while (> level 0) |
(while (> level 0) |
147 |
(backward-sexp 1) |
(backward-sexp 1) |
163 |
`(let ((,pt-sym (point))) |
`(let ((,pt-sym (point))) |
164 |
,@body |
,@body |
165 |
(when (/= (point) ,pt-sym) |
(when (/= (point) ,pt-sym) |
166 |
(buffer-substring (point) ,pt-sym))))) |
(buffer-substring-no-properties (point) ,pt-sym))))) |
167 |
(def-edebug-spec sml-move-read t) |
(def-edebug-spec sml-move-read t) |
168 |
|
|
169 |
(defun sml-poly-equal-p () |
(defun sml-poly-equal-p () |
176 |
(sml-point-after (re-search-backward "\\<case\\>" nil 'move)))) |
(sml-point-after (re-search-backward "\\<case\\>" nil 'move)))) |
177 |
|
|
178 |
(defun sml-forward-sym-1 () |
(defun sml-forward-sym-1 () |
179 |
(or (/= 0 (skip-syntax-forward ".'")) |
(or (/= 0 (skip-syntax-forward "'w_")) |
180 |
(/= 0 (skip-syntax-forward "'w_")))) |
(/= 0 (skip-syntax-forward ".'")))) |
181 |
(defun sml-forward-sym () |
(defun sml-forward-sym () |
182 |
(let ((sym (sml-move-read (sml-forward-sym-1)))) |
(let ((sym (sml-move-read (sml-forward-sym-1)))) |
183 |
(cond |
(cond |
225 |
(cond |
(cond |
226 |
((not op) |
((not op) |
227 |
(let ((point (point))) |
(let ((point (point))) |
228 |
(ignore-errors (backward-sexp 1)) |
(ignore-errors (let ((forward-sexp-function nil)) (backward-sexp 1))) |
229 |
(if (/= point (point)) t (backward-char 1) nil))) |
(if (/= point (point)) t (ignore-errors (backward-char 1)) nil))) |
230 |
;; stop as soon as precedence is smaller than `prec' |
;; stop as soon as precedence is smaller than `prec' |
231 |
((and prec op-prec (>= prec op-prec)) nil) |
((and prec op-prec (>= prec op-prec)) nil) |
232 |
;; special rules for nested constructs like if..then..else |
;; special rules for nested constructs like if..then..else |
259 |
(cond |
(cond |
260 |
((not op) |
((not op) |
261 |
(let ((point (point))) |
(let ((point (point))) |
262 |
(ignore-errors (forward-sexp 1)) |
(ignore-errors (let ((forward-sexp-function nil)) (forward-sexp 1))) |
263 |
(if (/= point (point)) t (forward-char 1) nil))) |
(if (/= point (point)) t (forward-char 1) nil))) |
264 |
;; stop as soon as precedence is smaller than `prec' |
;; stop as soon as precedence is smaller than `prec' |
265 |
((and prec op-prec (>= prec op-prec)) nil) |
((and prec op-prec (>= prec op-prec)) nil) |
267 |
((and (or (not prec) (and prec op-prec)) |
((and (or (not prec) (and prec op-prec)) |
268 |
(setq match (cdr (assoc op sml-open-paren)))) |
(setq match (cdr (assoc op sml-open-paren)))) |
269 |
(sml-find-match-forward (first match) (second match))) |
(sml-find-match-forward (first match) (second match))) |
270 |
;; don't back over open-parens |
;; don't forw over close-parens |
271 |
((assoc op sml-close-paren) nil) |
((assoc op sml-close-paren) nil) |
272 |
;; infix ops precedence |
;; infix ops precedence |
273 |
((and prec op-prec) (< prec op-prec)) |
((and prec op-prec) (< prec op-prec)) |