*** empty log message ***
original commit: 9a223953a518850337b1330798b7b7f217382bd5
This commit is contained in:
Scott Owens
parent
1a28cda103
commit
d8d7528981
|
|
@ -1240,65 +1240,6 @@
|
|||
"That is, \\var{keymap} must be chained to some keymap attached"
|
||||
"to the editor.")
|
||||
|
||||
(scheme-paren:backward-containing-sexp
|
||||
(opt->
|
||||
((is-a?/c text%)
|
||||
(and/c integer? exact?)
|
||||
(and/c integer? exact?))
|
||||
((union false? (is-a?/c match-cache:%)))
|
||||
(union false? (and/c integer? exact?)))
|
||||
((text start end)
|
||||
((cache #f)))
|
||||
"Returns the beginning of the interior of the (non-atomic) S-expression"
|
||||
"containing \\var{start}.")
|
||||
|
||||
(scheme-paren:backward-match
|
||||
(opt->
|
||||
((is-a?/c text%)
|
||||
(and/c integer? exact?)
|
||||
(and/c integer? exact?))
|
||||
((union false? (is-a?/c match-cache:%)))
|
||||
(union false? (and/c integer? exact?)))
|
||||
((text start end)
|
||||
((cache #f)))
|
||||
"Specializes "
|
||||
"@flink paren:backward-match"
|
||||
"to Scheme.")
|
||||
|
||||
(scheme-paren:balanced?
|
||||
((is-a?/c text%) (and/c integer? exact?) (and/c integer? exact?) . -> . boolean?)
|
||||
(text start end)
|
||||
"Specializes "
|
||||
"@flink paren:balanced?"
|
||||
"to Scheme.")
|
||||
|
||||
(scheme-paren:forward-match
|
||||
(opt->
|
||||
((is-a?/c text%)
|
||||
(and/c integer? exact?)
|
||||
(and/c integer? exact?))
|
||||
((union false? (is-a?/c match-cache:%)))
|
||||
(union false? (and/c integer? exact?)))
|
||||
((text start end)
|
||||
((cache #f)))
|
||||
"Specializes"
|
||||
"@flink paren:forward-match"
|
||||
"to Scheme.")
|
||||
|
||||
(scheme-paren:get-comments
|
||||
(-> (listof string?))
|
||||
()
|
||||
"Returns the comment characters for Scheme.")
|
||||
|
||||
(scheme-paren:get-paren-pairs
|
||||
(-> (listof (cons/p string? string?)))
|
||||
()
|
||||
"Returns the paren pairs for Scheme.")
|
||||
|
||||
(scheme-paren:get-quote-pairs
|
||||
(-> (listof (cons/p string? string?)))
|
||||
()
|
||||
"Returns the quote pairs for Scheme.")
|
||||
|
||||
(scheme:add-preferences-panel
|
||||
(-> void?)
|
||||
|
|
@ -1389,126 +1330,6 @@
|
|||
(keymap)
|
||||
"Initializes \\var{keymap} with Scheme-mode keybindings.")
|
||||
|
||||
(paren:backward-match
|
||||
(opt->
|
||||
((is-a?/c text%)
|
||||
(and/c integer? exact?)
|
||||
(and/c integer? exact?)
|
||||
(listof (cons/p string? string?))
|
||||
(listof (cons/p string? string?))
|
||||
(listof string?))
|
||||
(boolean?
|
||||
(union false? (is-a?/c match-cache:%)))
|
||||
(union false? (and/c integer? exact?)))
|
||||
((text start end parens quotes comments)
|
||||
((containing? #f) (cache #f)))
|
||||
"Returns the position in \\var{text} that ``opens'' the text ending at "
|
||||
"\\var{start}, or \\rawscm{\\#f} if no opening position is found (either because a "
|
||||
"parenthesis mis-match is discovered or the \\var{end} boundary was"
|
||||
"reached). The match must occur before \\var{end} (inclusive). Note that"
|
||||
"\\var{start} $>$ \\var{end}, since \\var{start} specifies the starting position"
|
||||
"of the search, not the earliest buffer position to be considered."
|
||||
""
|
||||
"Spaces immediately preceding \\var{start} are skipped. If the text at"
|
||||
"\\var{start} is a close parenthesis or close quote, then the matching"
|
||||
"position is the opening parenthesis or quote. If a comment immediately"
|
||||
"precedes \\var{start}, then the comment is skipped as whitespace. If an"
|
||||
"opening parenthesis immediately precedes \\var{start}, then the"
|
||||
"matching position is \\var{start} - 1. Otherwise, the matching position"
|
||||
"is the first whitespace or parenthesis character before"
|
||||
"\\var{start}."
|
||||
""
|
||||
"If \\var{containing?} is not \\rawscm{\\#f}, then the matching procedure"
|
||||
"is modified as follows:"
|
||||
"\\begin{itemize}"
|
||||
"\\item Searching iterates backwards until some search fails. Then, the"
|
||||
" location of the last successful search is returned."
|
||||
"\\item If a mis-match is detected, then \\rawscm{\\#f} is returned."
|
||||
"\\item If there are no matches (and no mis-matches) before \\var{start},"
|
||||
" \\var{start} itself is returned. "
|
||||
"\\end{itemize}"
|
||||
""
|
||||
"If \\var{cache} is not \\rawscm{\\#f}, it must be an instance of "
|
||||
"\\iscmclass{match-cache:}. A cache"
|
||||
"object can be used to speed up successive calls to "
|
||||
"\\iscmprocedure{paren:backward-match}. However, a buffer using a cache"
|
||||
"must call the cache's"
|
||||
"@link match-cache: invalidate"
|
||||
"method when the buffer is"
|
||||
"modified. Different caches should be used for forward and backward"
|
||||
"matching. See"
|
||||
"\\hyperref{the match cache section}{section~}{}{fw:matchcache}"
|
||||
"for more information.")
|
||||
|
||||
(paren:balanced?
|
||||
((is-a?/c text%)
|
||||
(and/c integer? exact?)
|
||||
(and/c integer? exact?)
|
||||
(listof (cons/p string? string?))
|
||||
(listof (cons/p string? string?))
|
||||
(listof string?)
|
||||
. -> .
|
||||
boolean?)
|
||||
(text start end parens quotes comments)
|
||||
"Returns \\rawscm{\\#t} if the text in \\var{text} between positions"
|
||||
"\\var{start} and \\var{end} is \\defterm{balanced}. The text is balanced"
|
||||
"if there are no unclosed parenthses or quotes, there are no closing"
|
||||
"parentheses that do not match an open parenthesis, and there are no"
|
||||
"mis-matched parentheses."
|
||||
""
|
||||
"This uses "
|
||||
"@flink paren:forward-match %"
|
||||
".")
|
||||
|
||||
(paren:forward-match
|
||||
(opt->
|
||||
((is-a?/c text%)
|
||||
(and/c integer? exact?)
|
||||
(and/c integer? exact?)
|
||||
(listof (cons/p string? string?))
|
||||
(listof (cons/p string? string?))
|
||||
(listof string?))
|
||||
((union false? (is-a?/c match-cache:%)))
|
||||
(union false? (and/c integer? exact?)))
|
||||
((text start end parens quotes comments)
|
||||
((cache #f)))
|
||||
"This function returns the position in \\var{text} that ``closes'' the"
|
||||
"text at \\var{start}, or \\rawscm{\\#f} if no closing position is found"
|
||||
"(either because a parenthesis mis-match is discovered or the \\var{end}"
|
||||
"boundary was reached). The match must occur before \\var{end}"
|
||||
"(inclusive)."
|
||||
""
|
||||
"Spaces immediately following \\var{start} are skipped. If the text at"
|
||||
"\\var{start} is an open parenthesis or open quote, then the matching"
|
||||
"position is the closing parenthesis or quote. If a comment immediately"
|
||||
"follows \\var{start}, it is skipped over as whitespace. If a closing"
|
||||
"parenthesis immediately follows \\var{start} (after skipping"
|
||||
"whitespace), then \\rawscm{\\#f} is returned. Otherwise, the matching"
|
||||
"position is the position before the first whitespace, parenthesis,"
|
||||
"quote, or comment character after \\var{start}."
|
||||
""
|
||||
"If \\var{cache} is not \\rawscm{\\#f}, it must be an instance of "
|
||||
"\\iscmclass{match-cache:}. "
|
||||
"\\scmclassindex{match-cache:} A cache"
|
||||
"object can be used to speed up successive calls to "
|
||||
"\\rawscm{paren:forwardward-match}. However, a buffer using a cache"
|
||||
"must call the cache's \\rawscm{forward-invalidate} method when the buffer is"
|
||||
"modified. Different caches should be used for forward and backward"
|
||||
"matching. See "
|
||||
"\\hyperref{the match cache section}{section~}{}{fw:matchcache}"
|
||||
"for more information."
|
||||
"")
|
||||
|
||||
(paren:skip-whitespace
|
||||
((is-a?/c text%) (and/c integer? exact?) (symbols 'forward 'backward)
|
||||
. -> .
|
||||
(and/c integer? exact?))
|
||||
(text pos dir)
|
||||
"If \\var{dir} is \\rawscm{'forward}, this returns the position of the first"
|
||||
"non-whitespace character in \\var{text} after \\var{pos}. If \\var{dir}"
|
||||
"is \\rawscm{'backward}, it returns the first non-whitespace character before"
|
||||
"\\var{pos}.")
|
||||
|
||||
(color-model:rgb->xyz
|
||||
(number? number? number? . -> . color-model:xyz?)
|
||||
(r g b)
|
||||
|
|
|
|||
|
|
@ -35,7 +35,14 @@
|
|||
thaw-colorer
|
||||
|
||||
reset-region
|
||||
update-region-end))
|
||||
update-region-end
|
||||
|
||||
skip-whitespace
|
||||
backward-match
|
||||
backward-containing-sexp
|
||||
forward-match
|
||||
balanced?
|
||||
in-single-line-comment?))
|
||||
|
||||
(define text-mixin
|
||||
(mixin (text:basic<%>) (-text<%>)
|
||||
|
|
@ -491,9 +498,14 @@
|
|||
(end-edit-sequence)
|
||||
(set! in-match-parens? #f))))
|
||||
|
||||
|
||||
;; forward-match: natural-number? natural-number? -> (union natural-number? false?)
|
||||
;; Skip all consecutive white-space and comments immediately following position.
|
||||
;; If the token at the new position is an open,
|
||||
;; return the position of the matching close, or #f if there is none.
|
||||
;; For any other token, return the start of the next token.
|
||||
|
||||
(define/public (forward-match position cutoff)
|
||||
(do-forward-match position cutoff #f))
|
||||
(do-forward-match position cutoff #t))
|
||||
|
||||
(define (do-forward-match position cutoff skip-whitespace?)
|
||||
(let ((position
|
||||
|
|
@ -511,21 +523,72 @@
|
|||
(cond
|
||||
((<= match-pos cutoff) match-pos)
|
||||
(else #f))))
|
||||
(else #f)))))
|
||||
|
||||
((and start end error) #f)
|
||||
(else
|
||||
(let-values (((tok-start tok-end)
|
||||
(begin
|
||||
(tokenize-to-pos position)
|
||||
(send tokens search! (- position start-pos))
|
||||
(values (send tokens get-root-start-position)
|
||||
(send tokens get-root-end-position)))))
|
||||
(cond
|
||||
((or (send parens is-close-pos? tok-start)
|
||||
(= (+ start-pos tok-end) position))
|
||||
#f)
|
||||
(else
|
||||
(+ start-pos tok-end)))))))))
|
||||
|
||||
|
||||
;; backward-match: natural-number? natural-number? -> (union natural-number? false?)
|
||||
;; Skip all consecutive white-space and comments immediately preceeding position.
|
||||
;; If the token at the new position is a close,
|
||||
;; return the position of the matching open, or #f if there is none.
|
||||
;; For any other token, return the start of that token.
|
||||
(define/public (backward-match position cutoff)
|
||||
(let ((x (internal-backward-match position cutoff)))
|
||||
(cond
|
||||
((eq? x 'open) #f)
|
||||
(else x))))
|
||||
|
||||
(define (internal-backward-match position cutoff)
|
||||
(when stopped?
|
||||
(error 'backward-match "called on a color:text<%> whose colorer is stopped."))
|
||||
(let ((position (skip-whitespace position 'backward #t)))
|
||||
(let-values (((start end error)
|
||||
(send parens match-backward (- position start-pos))))
|
||||
(cond
|
||||
((and start end (not error))
|
||||
(let ((match-pos (+ start-pos end)))
|
||||
(let ((match-pos (+ start-pos start)))
|
||||
(cond
|
||||
((>= match-pos cutoff) match-pos)
|
||||
(else #f))))
|
||||
(else #f)))))
|
||||
|
||||
((and start end error) #f)
|
||||
(else
|
||||
(let-values (((tok-start tok-end)
|
||||
(begin
|
||||
(send tokens search!
|
||||
(if (> position start-pos)
|
||||
(- position start-pos 1)
|
||||
0))
|
||||
(values (send tokens get-root-start-position)
|
||||
(send tokens get-root-end-position)))))
|
||||
(cond
|
||||
((or (send parens is-open-pos? tok-start)
|
||||
(= (+ start-pos tok-start) position))
|
||||
'open)
|
||||
(else
|
||||
(+ start-pos tok-start)))))))))
|
||||
|
||||
(define/public (backward-containing-sexp position cutoff)
|
||||
(when stopped?
|
||||
(error 'backward-containing-sexp "called on a color:text<%> whose colorer is stopped."))
|
||||
(let loop ((cur-pos position))
|
||||
(let ((p (internal-backward-match cur-pos cutoff)))
|
||||
(cond
|
||||
((eq? 'open p) cur-pos)
|
||||
((not p) #f)
|
||||
(else (loop p))))))
|
||||
|
||||
(define (tokenize-to-pos position)
|
||||
(when (and (not up-to-date?) (<= current-pos position))
|
||||
(colorer-driver)
|
||||
|
|
@ -533,7 +596,14 @@
|
|||
|
||||
(inherit last-position)
|
||||
|
||||
|
||||
;; skip-whitespace: natural-number? (symbols 'forward 'backward) boolean -> natural-number?
|
||||
;; If dir is 'forward, this returns the position of the first non-whitespace character
|
||||
;; after pos. If dir is 'backward, it returns the first non-whitespace character before pos.
|
||||
;; Must only be called while the tokenizer is started.
|
||||
(define/public (skip-whitespace position direction comments?)
|
||||
(when stopped?
|
||||
(error 'skip-whitespace "called on a color:text<%> whose colorer is stopped."))
|
||||
(cond
|
||||
((and (eq? direction 'forward)
|
||||
(>= position (if (eq? 'end end-pos) (last-position) end-pos)))
|
||||
|
|
@ -541,9 +611,9 @@
|
|||
((and (eq? direction 'backward) (<= position start-pos))
|
||||
position)
|
||||
(else
|
||||
(let ((p (if (eq? direction 'backward) (sub1 position) position)))
|
||||
(tokenize-to-pos p)
|
||||
(send tokens search! (- p start-pos))
|
||||
(tokenize-to-pos position)
|
||||
(send tokens search! (- (if (eq? direction 'backward) (sub1 position) position)
|
||||
start-pos))
|
||||
(cond
|
||||
((or (eq? 'white-space (send tokens get-root-data))
|
||||
(and comments? (eq? 'comment (send tokens get-root-data))))
|
||||
|
|
@ -551,10 +621,30 @@
|
|||
(if (eq? direction 'forward)
|
||||
(send tokens get-root-end-position)
|
||||
(send tokens get-root-start-position)))
|
||||
direction))
|
||||
(else p))))))
|
||||
direction
|
||||
comments?))
|
||||
(else position)))))
|
||||
|
||||
|
||||
;; Lifted from scheme-paren.ss
|
||||
(define/public (balanced? region-start region-end)
|
||||
(if (or (> region-end (if (eq? end-pos 'end) (last-position) end-pos))
|
||||
(<= region-end region-start))
|
||||
#f
|
||||
(let* ([balance-point (forward-match region-start region-end)]
|
||||
[end-point
|
||||
(and balance-point
|
||||
(skip-whitespace balance-point 'forward #t))])
|
||||
(and balance-point
|
||||
(or (and (<= balance-point region-end) (>= end-point region-end))
|
||||
(balanced? end-point region-end))))))
|
||||
|
||||
|
||||
(define/public (in-single-line-comment? pos)
|
||||
(send tokens search! (sub1 pos))
|
||||
(eq? 'comment (send tokens get-root-data)))
|
||||
|
||||
|
||||
|
||||
;; ------------------------- Callbacks to Override ----------------------
|
||||
|
||||
(rename (super-lock lock))
|
||||
|
|
|
|||
|
|
@ -16,7 +16,6 @@
|
|||
[preferences : framework:preferences^]
|
||||
[finder : framework:finder^]
|
||||
[handler : framework:handler^]
|
||||
[scheme-paren : framework:scheme-paren^]
|
||||
[frame : framework:frame^]
|
||||
[editor : framework:editor^])
|
||||
|
||||
|
|
@ -291,10 +290,7 @@
|
|||
[flash-paren-match
|
||||
(lambda (edit event)
|
||||
(send edit on-default-char event)
|
||||
(let ([pos (scheme-paren:backward-match
|
||||
edit
|
||||
(send edit get-start-position)
|
||||
0)])
|
||||
(let ([pos (send edit backward-match (send edit get-start-position) 0)])
|
||||
(when pos
|
||||
(send edit flash-on pos (+ 1 pos))))
|
||||
#t)]
|
||||
|
|
@ -982,7 +978,6 @@
|
|||
(map ")" "flash-paren-match")
|
||||
(map "]" "flash-paren-match")
|
||||
(map "}" "flash-paren-match")
|
||||
(map "\"" "flash-paren-match")
|
||||
|
||||
(map-meta "(" "insert-()-pair")
|
||||
(map-meta "[" "insert-[]-pair")
|
||||
|
|
|
|||
|
|
@ -18,13 +18,16 @@
|
|||
|
||||
(provide scheme@)
|
||||
|
||||
(define (scheme-paren:get-paren-pairs)
|
||||
'(("(" . ")")
|
||||
("[" . "]")
|
||||
("{" . "}")))
|
||||
|
||||
|
||||
(define scheme@
|
||||
(unit/sig framework:scheme^
|
||||
(import mred^
|
||||
[preferences : framework:preferences^]
|
||||
[match-cache : framework:match-cache^]
|
||||
[paren : framework:paren^]
|
||||
[scheme-paren : framework:scheme-paren^]
|
||||
[icon : framework:icon^]
|
||||
[keymap : framework:keymap^]
|
||||
[text : framework:text^]
|
||||
|
|
@ -291,7 +294,6 @@
|
|||
(define -text<%>
|
||||
(interface ()
|
||||
get-limit
|
||||
balance-quotes
|
||||
balance-parens
|
||||
tabify-on-return?
|
||||
tabify
|
||||
|
|
@ -375,33 +377,13 @@
|
|||
set-style-list
|
||||
set-styles-fixed
|
||||
change-style
|
||||
get-snip-position)
|
||||
get-snip-position
|
||||
backward-match
|
||||
backward-containing-sexp
|
||||
forward-match
|
||||
skip-whitespace
|
||||
in-single-line-comment?)
|
||||
|
||||
(define (in-single-line-comment? position)
|
||||
(let ([para (position-paragraph position)])
|
||||
(ormap
|
||||
(lambda (comment-start)
|
||||
(let loop ([f (find-string comment-start 'backward position)])
|
||||
(cond
|
||||
[(not f)
|
||||
#f]
|
||||
[(= (position-paragraph f) para)
|
||||
(let ([f-1 (- f 2)]) ;; -1 to go back one, -1 to be before char
|
||||
(cond
|
||||
[(< f-1 0)
|
||||
#t]
|
||||
[(not (= (position-paragraph f-1) para))
|
||||
#t]
|
||||
[(not (char=? (get-character f-1) #\\ ))
|
||||
#t]
|
||||
[else
|
||||
(loop (find-string comment-start 'backward f-1))]))]
|
||||
[else
|
||||
#f])))
|
||||
(scheme-paren:get-comments))))
|
||||
|
||||
[define backward-cache (make-object match-cache:%)]
|
||||
[define forward-cache (make-object match-cache:%)]
|
||||
|
||||
(inherit get-styles-fixed)
|
||||
(inherit has-focus? find-snip split-snip)
|
||||
|
|
@ -431,7 +413,7 @@
|
|||
[else (loop (- semi-pos 1))]))]))))
|
||||
|
||||
|
||||
(public get-limit balance-quotes balance-parens tabify-on-return? tabify tabify-selection
|
||||
(public get-limit balance-parens tabify-on-return? tabify tabify-selection
|
||||
tabify-all insert-return calc-last-para
|
||||
box-comment-out-selection comment-out-selection uncomment-selection
|
||||
get-forward-sexp remove-sexp forward-sexp flash-forward-sexp get-backward-sexp
|
||||
|
|
@ -439,24 +421,7 @@
|
|||
remove-parens-forward)
|
||||
(define (get-limit pos) 0)
|
||||
|
||||
(inherit get-visible-position-range)
|
||||
(define (balance-quotes key)
|
||||
(void)
|
||||
#;(let* ([char (send key get-key-code)]) ;; must be a character because of the mapping setup
|
||||
;; this function is only bound to ascii-returning keys
|
||||
(insert char)
|
||||
(let* ([start-pos (get-start-position)]
|
||||
[limit (get-limit start-pos)]
|
||||
[match (scheme-paren:backward-match
|
||||
this start-pos limit backward-cache)])
|
||||
(when match
|
||||
(let ([start-b (box 0)]
|
||||
[end-b (box 0)]
|
||||
[to-flash-point (add1 match)])
|
||||
(get-visible-position-range start-b end-b #f)
|
||||
(when (<= (unbox start-b) to-flash-point (unbox end-b))
|
||||
(flash-on match (add1 match))))))))
|
||||
|
||||
|
||||
(define (balance-parens key-event)
|
||||
(letrec ([char (send key-event get-key-code)] ;; must be a character. See above.
|
||||
[here (get-start-position)]
|
||||
|
|
@ -481,9 +446,7 @@
|
|||
(char=? (string-ref (get-text (- here 1) here) 0) #\\))
|
||||
(insert char)]
|
||||
[(or paren-match? fixup-parens?)
|
||||
(let* ([end-pos (scheme-paren:backward-containing-sexp
|
||||
this here limit
|
||||
backward-cache)])
|
||||
(let* ([end-pos (backward-containing-sexp here limit)])
|
||||
(cond
|
||||
[end-pos
|
||||
(let* ([left-paren-pos (find-enclosing-paren end-pos)]
|
||||
|
|
@ -512,14 +475,13 @@
|
|||
[limit (get-limit pos)]
|
||||
[contains
|
||||
(if okay
|
||||
(scheme-paren:backward-containing-sexp
|
||||
this end limit backward-cache)
|
||||
(backward-containing-sexp end limit)
|
||||
#f)]
|
||||
[contain-para (and contains
|
||||
(position-paragraph contains))]
|
||||
[last
|
||||
(if contains
|
||||
(scheme-paren:backward-match this end limit backward-cache)
|
||||
(backward-match end limit)
|
||||
#f)]
|
||||
[last-para (and last
|
||||
(position-paragraph last))])
|
||||
|
|
@ -649,8 +611,7 @@
|
|||
(dynamic-enable-break (lambda () (break-enabled)))
|
||||
(loop (add1 para))))
|
||||
(when (and (>= (position-paragraph start-pos) end-para)
|
||||
(<= (paren:skip-whitespace
|
||||
this (get-start-position) 'backward)
|
||||
(<= (skip-whitespace (get-start-position) 'backward #f)
|
||||
(paragraph-start-position first-para)))
|
||||
(set-position
|
||||
(let loop ([new-pos (get-start-position)])
|
||||
|
|
@ -787,10 +748,9 @@
|
|||
(let para-loop ([curr-para first-para])
|
||||
(when (<= curr-para last-para)
|
||||
(let ([first-on-para
|
||||
(paren:skip-whitespace
|
||||
this
|
||||
(paragraph-start-position curr-para)
|
||||
'forward)])
|
||||
(skip-whitespace (paragraph-start-position curr-para)
|
||||
'forward
|
||||
#f)])
|
||||
(split-snip first-on-para)
|
||||
(when (and (< first-on-para last-pos)
|
||||
(char=? #\; (get-character first-on-para))
|
||||
|
|
@ -817,10 +777,7 @@
|
|||
|
||||
[define get-forward-sexp
|
||||
(lambda (start-pos)
|
||||
(scheme-paren:forward-match
|
||||
this start-pos
|
||||
(last-position)
|
||||
forward-cache))]
|
||||
(forward-match start-pos (last-position)))]
|
||||
[define remove-sexp
|
||||
(lambda (start-pos)
|
||||
(let ([end-pos (get-forward-sexp start-pos)])
|
||||
|
|
@ -846,11 +803,9 @@
|
|||
(lambda (start-pos)
|
||||
(let* ([limit (get-limit start-pos)]
|
||||
[end-pos
|
||||
(scheme-paren:backward-match
|
||||
this start-pos limit backward-cache)]
|
||||
(backward-match start-pos limit)]
|
||||
[min-pos
|
||||
(scheme-paren:backward-containing-sexp
|
||||
this start-pos limit backward-cache)]
|
||||
(backward-containing-sexp start-pos limit)]
|
||||
[ans
|
||||
(if (and end-pos
|
||||
(or (not min-pos)
|
||||
|
|
@ -875,10 +830,7 @@
|
|||
[define find-up-sexp
|
||||
(lambda (start-pos)
|
||||
(let* ([exp-pos
|
||||
(scheme-paren:backward-containing-sexp
|
||||
this start-pos
|
||||
(get-limit start-pos)
|
||||
backward-cache)]
|
||||
(backward-containing-sexp start-pos (get-limit start-pos))]
|
||||
[paren-pos ;; find the closest open paren from this pair, behind exp-pos
|
||||
(lambda (paren-pair)
|
||||
(find-string
|
||||
|
|
@ -910,13 +862,10 @@
|
|||
(lambda (start-pos)
|
||||
(let ([last (last-position)])
|
||||
(let loop ([pos start-pos])
|
||||
(let ([next-pos (scheme-paren:forward-match
|
||||
this pos last
|
||||
forward-cache)])
|
||||
(let ([next-pos (forward-match pos last)])
|
||||
(if (and next-pos (> next-pos pos))
|
||||
(let ([back-pos
|
||||
(scheme-paren:backward-containing-sexp
|
||||
this (sub1 next-pos) pos backward-cache)])
|
||||
(backward-containing-sexp (sub1 next-pos) pos)])
|
||||
(if (and back-pos
|
||||
(> back-pos pos))
|
||||
back-pos
|
||||
|
|
@ -931,14 +880,12 @@
|
|||
#t))]
|
||||
[define remove-parens-forward
|
||||
(lambda (start-pos)
|
||||
(let* ([pos (paren:skip-whitespace this start-pos 'forward)]
|
||||
(let* ([pos (skip-whitespace start-pos 'forward #f)]
|
||||
[first-char (get-character pos)]
|
||||
[paren? (or (char=? first-char #\( )
|
||||
(char=? first-char #\[ ))]
|
||||
[closer (if paren?
|
||||
(scheme-paren:forward-match
|
||||
this pos (last-position)
|
||||
forward-cache))])
|
||||
(forward-match pos (last-position)))])
|
||||
(if (and paren? closer)
|
||||
(begin (begin-edit-sequence)
|
||||
(delete pos (add1 pos))
|
||||
|
|
@ -1014,20 +961,7 @@
|
|||
(public get-tab-size set-tab-size)
|
||||
[define get-tab-size (lambda () tab-size)]
|
||||
[define set-tab-size (lambda (s) (set! tab-size s))]
|
||||
|
||||
(rename [super-after-delete after-delete])
|
||||
(define/override (after-delete start size)
|
||||
(send backward-cache invalidate start)
|
||||
(send forward-cache forward-invalidate (+ start size) (- size))
|
||||
;; must call super after invalidating cache -- super calls surrogate object
|
||||
(super-after-delete start size))
|
||||
(rename [super-after-insert after-insert])
|
||||
(define/override (after-insert start size)
|
||||
(send backward-cache invalidate start)
|
||||
(send forward-cache forward-invalidate start size)
|
||||
;; must call super after invalidating cache -- super calls surrogate object
|
||||
(super-after-insert start size))
|
||||
|
||||
|
||||
(super-instantiate ())))
|
||||
|
||||
(define -text-mode<%>
|
||||
|
|
@ -1065,7 +999,6 @@
|
|||
(super-new (get-token scheme-lexer-wrapper)
|
||||
(token-sym->style short-sym->style-name)
|
||||
(matches '((|(| |)|)
|
||||
(#\| \|#)
|
||||
(|[| |]|)
|
||||
(|{| |}|))))))
|
||||
|
||||
|
|
@ -1155,9 +1088,6 @@
|
|||
(send keymap add-function "balance-parens"
|
||||
(lambda (edit event)
|
||||
(send edit balance-parens event)))
|
||||
#;(send keymap add-function "balance-quotes"
|
||||
(lambda (edit event)
|
||||
(send edit balance-quotes event)))
|
||||
|
||||
(send keymap map-function "TAB" "tabify-at-caret")
|
||||
|
||||
|
|
@ -1174,8 +1104,6 @@
|
|||
(send keymap map-function ")" "balance-parens")
|
||||
(send keymap map-function "]" "balance-parens")
|
||||
(send keymap map-function "}" "balance-parens")
|
||||
#;(send keymap map-function "\"" "balance-quotes")
|
||||
#;(send keymap map-function "|" "balance-quotes")
|
||||
|
||||
(let ([map-meta
|
||||
(lambda (key func)
|
||||
|
|
|
|||
|
|
@ -59,12 +59,6 @@
|
|||
framework:keymap^
|
||||
framework:keymap-class^
|
||||
framework:keymap-fun^
|
||||
framework:match-cache^
|
||||
framework:match-cache-class^
|
||||
framework:match-cache-fun^
|
||||
framework:scheme-paren^
|
||||
framework:scheme-paren-class^
|
||||
framework:scheme-paren-fun^
|
||||
framework:color^
|
||||
framework:color-class^
|
||||
framework:color-fun^
|
||||
|
|
@ -74,9 +68,6 @@
|
|||
framework:scheme^
|
||||
framework:scheme-class^
|
||||
framework:scheme-fun^
|
||||
framework:paren^
|
||||
framework:paren-class^
|
||||
framework:paren-fun^
|
||||
framework:main^
|
||||
framework:main-class^
|
||||
framework:main-fun^
|
||||
|
|
@ -482,28 +473,6 @@
|
|||
((open framework:keymap-class^)
|
||||
(open framework:keymap-fun^)))
|
||||
|
||||
(define-signature framework:match-cache-class^
|
||||
(%))
|
||||
(define-signature framework:match-cache-fun^
|
||||
())
|
||||
(define-signature framework:match-cache^
|
||||
((open framework:match-cache-class^)
|
||||
(open framework:match-cache-fun^)))
|
||||
|
||||
(define-signature framework:scheme-paren-class^
|
||||
())
|
||||
(define-signature framework:scheme-paren-fun^
|
||||
(get-comments
|
||||
get-paren-pairs
|
||||
get-quote-pairs
|
||||
forward-match
|
||||
backward-match
|
||||
balanced?
|
||||
backward-containing-sexp))
|
||||
(define-signature framework:scheme-paren^
|
||||
((open framework:scheme-paren-class^)
|
||||
(open framework:scheme-paren-fun^)))
|
||||
|
||||
(define-signature framework:color-class^
|
||||
(text<%>
|
||||
text-mixin
|
||||
|
|
@ -558,17 +527,6 @@
|
|||
((open framework:scheme-class^)
|
||||
(open framework:scheme-fun^)))
|
||||
|
||||
(define-signature framework:paren-class^
|
||||
())
|
||||
(define-signature framework:paren-fun^
|
||||
(balanced?
|
||||
forward-match
|
||||
backward-match
|
||||
skip-whitespace))
|
||||
(define-signature framework:paren^
|
||||
((open framework:paren-class^)
|
||||
(open framework:paren-fun^)))
|
||||
|
||||
(define-signature framework:main-class^ ())
|
||||
(define-signature framework:main-fun^ ())
|
||||
(define-signature framework:main^
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user