4227 |
(defun blink-matching-open () |
(defun blink-matching-open () |
4228 |
"Move cursor momentarily to the beginning of the sexp before point." |
"Move cursor momentarily to the beginning of the sexp before point." |
4229 |
(interactive) |
(interactive) |
4230 |
(and (> (point) (1+ (point-min))) |
(when (and (> (point) (1+ (point-min))) |
4231 |
blink-matching-paren |
blink-matching-paren |
4232 |
;; Verify an even number of quoting characters precede the close. |
;; Verify an even number of quoting characters precede the close. |
4233 |
(= 1 (logand 1 (- (point) |
(= 1 (logand 1 (- (point) |
4234 |
(save-excursion |
(save-excursion |
4235 |
(forward-char -1) |
(forward-char -1) |
4236 |
(skip-syntax-backward "/\\") |
(skip-syntax-backward "/\\") |
4237 |
(point))))) |
(point)))))) |
4238 |
(let* ((oldpos (point)) |
(let* ((oldpos (point)) |
4239 |
(blinkpos) |
blinkpos |
4240 |
(mismatch) |
message-log-max ; Don't log messages about paren matching. |
4241 |
matching-paren) |
matching-paren |
4242 |
(save-excursion |
open-paren-line-string) |
4243 |
(save-restriction |
(save-excursion |
4244 |
(if blink-matching-paren-distance |
(save-restriction |
4245 |
(narrow-to-region (max (point-min) |
(if blink-matching-paren-distance |
4246 |
(- (point) blink-matching-paren-distance)) |
(narrow-to-region (max (point-min) |
4247 |
oldpos)) |
(- (point) blink-matching-paren-distance)) |
4248 |
(condition-case () |
oldpos)) |
4249 |
(let ((parse-sexp-ignore-comments |
(condition-case () |
4250 |
(and parse-sexp-ignore-comments |
(let ((parse-sexp-ignore-comments |
4251 |
(not blink-matching-paren-dont-ignore-comments)))) |
(and parse-sexp-ignore-comments |
4252 |
(setq blinkpos (scan-sexps oldpos -1))) |
(not blink-matching-paren-dont-ignore-comments)))) |
4253 |
(error nil))) |
(setq blinkpos (scan-sexps oldpos -1))) |
4254 |
(and blinkpos |
(error nil))) |
4255 |
;; Not syntax '$'. |
(and blinkpos |
4256 |
(not (eq (syntax-class (syntax-after blinkpos)) 8)) |
;; Not syntax '$'. |
4257 |
(setq matching-paren |
(not (eq (syntax-class (syntax-after blinkpos)) 8)) |
4258 |
(let ((syntax (syntax-after blinkpos))) |
(setq matching-paren |
4259 |
(and (consp syntax) |
(let ((syntax (syntax-after blinkpos))) |
4260 |
(eq (syntax-class syntax) 4) |
(and (consp syntax) |
4261 |
(cdr syntax))) |
(eq (syntax-class syntax) 4) |
4262 |
mismatch |
(cdr syntax))))) |
4263 |
(or (null matching-paren) |
(cond |
4264 |
(/= (char-after (1- oldpos)) |
((or (null matching-paren) |
4265 |
matching-paren)))) |
(/= (char-before oldpos) |
4266 |
(if mismatch (setq blinkpos nil)) |
matching-paren)) |
4267 |
(if blinkpos |
(message "Mismatched parentheses")) |
4268 |
;; Don't log messages about paren matching. |
((not blinkpos) |
4269 |
(let (message-log-max) |
(if (not blink-matching-paren-distance) |
4270 |
(goto-char blinkpos) |
(message "Unmatched parenthesis"))) |
4271 |
(if (pos-visible-in-window-p) |
((pos-visible-in-window-p blinkpos) |
4272 |
(and blink-matching-paren-on-screen |
;; Matching open within window, temporarily move to blinkpos but only |
4273 |
(sit-for blink-matching-delay)) |
;; if `blink-matching-paren-on-screen' is non-nil. |
4274 |
(goto-char blinkpos) |
(when blink-matching-paren-on-screen |
4275 |
(message |
(save-excursion |
4276 |
"Matches %s" |
(goto-char blinkpos) |
4277 |
;; Show what precedes the open in its line, if anything. |
(sit-for blink-matching-delay)))) |
4278 |
(if (save-excursion |
(t |
4279 |
(skip-chars-backward " \t") |
(save-excursion |
4280 |
(not (bolp))) |
(goto-char blinkpos) |
4281 |
(buffer-substring (progn (beginning-of-line) (point)) |
(setq open-paren-line-string |
4282 |
(1+ blinkpos)) |
;; Show what precedes the open in its line, if anything. |
4283 |
;; Show what follows the open in its line, if anything. |
(if (save-excursion |
4284 |
(if (save-excursion |
(skip-chars-backward " \t") |
4285 |
(forward-char 1) |
(not (bolp))) |
4286 |
(skip-chars-forward " \t") |
(buffer-substring (line-beginning-position) |
4287 |
(not (eolp))) |
(1+ blinkpos)) |
4288 |
(buffer-substring blinkpos |
;; Show what follows the open in its line, if anything. |
4289 |
(progn (end-of-line) (point))) |
(if (save-excursion |
4290 |
;; Otherwise show the previous nonblank line, |
(forward-char 1) |
4291 |
;; if there is one. |
(skip-chars-forward " \t") |
4292 |
(if (save-excursion |
(not (eolp))) |
4293 |
(skip-chars-backward "\n \t") |
(buffer-substring blinkpos |
4294 |
(not (bobp))) |
(line-end-position)) |
4295 |
(concat |
;; Otherwise show the previous nonblank line, |
4296 |
(buffer-substring (progn |
;; if there is one. |
4297 |
|
(if (save-excursion |
4298 |
|
(skip-chars-backward "\n \t") |
4299 |
|
(not (bobp))) |
4300 |
|
(concat |
4301 |
|
(buffer-substring (progn |
4302 |
(skip-chars-backward "\n \t") |
(skip-chars-backward "\n \t") |
4303 |
(beginning-of-line) |
(line-beginning-position)) |
4304 |
(point)) |
(progn (end-of-line) |
4305 |
(progn (end-of-line) |
(skip-chars-backward " \t") |
4306 |
(skip-chars-backward " \t") |
(point))) |
4307 |
(point))) |
;; Replace the newline and other whitespace with `...'. |
4308 |
;; Replace the newline and other whitespace with `...'. |
"..." |
4309 |
"..." |
(buffer-substring blinkpos (1+ blinkpos))) |
4310 |
(buffer-substring blinkpos (1+ blinkpos))) |
;; There is nothing to show except the char itself. |
4311 |
;; There is nothing to show except the char itself. |
(buffer-substring blinkpos (1+ blinkpos))))))) |
4312 |
(buffer-substring blinkpos (1+ blinkpos)))))))) |
(message "Matches %s" |
4313 |
(cond (mismatch |
(substring-no-properties open-paren-line-string)))))))) |
|
(message "Mismatched parentheses")) |
|
|
((not blink-matching-paren-distance) |
|
|
(message "Unmatched parenthesis")))))))) |
|
4314 |
|
|
4315 |
;Turned off because it makes dbx bomb out. |
;Turned off because it makes dbx bomb out. |
4316 |
(setq blink-paren-function 'blink-matching-open) |
(setq blink-paren-function 'blink-matching-open) |