suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

improve DrScheme's auto-indenting and S-exp movement for Scheme code with quote, #;, etc.

Browse Source 
svn: r5977

original commit: 681d88ed526d3dbe647013b78a16b2c7926080dc
This commit is contained in:
Matthew Flatt 2007-04-19 02:44:31 +00:00
parent 64a34efa2a
commit 60a05cdd2f
1 changed files with 34 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
collects/framework/private/scheme.ss
View File

@ -303,11 +303,14 @@
(define (get-white-on-black-color-prefs-table) white-on-black-color-prefs-table)
(define (short-sym->pref-name sym) (string->symbol (short-sym->style-name sym)))
(define (xlate-sym-style sym) (case sym
[(sexp-comment) 'comment]
[else sym]))
(define sn-hash (make-hash-table))
(define (short-sym->style-name sym)
(hash-table-get sn-hash sym
(λ ()
(let ([s (format "framework:syntax-coloring:scheme:~a" sym)])
(let ([s (format "framework:syntax-coloring:scheme:~a" (xlate-sym-style sym))])
(hash-table-put! sn-hash sym s)
s))))
@ -462,7 +465,10 @@
;; "last" is the start of the S-exp just before "pos"
[last
(if contains
(backward-match end limit)
(let ([p (get-backward-sexp end)])
(if (and p (p . >= . limit))
p
(backward-match end limit)))
#f)]
[last-para (and last
(position-paragraph last))])
@ -782,25 +788,29 @@
(let ([snip-pos (get-snip-position snip)])
(delete snip-pos (+ snip-pos 1)))
(set-position pos pos)))
(define/private (stick-to-next-sexp? start-pos)
(let ([end-pos (forward-match start-pos (last-position))])
(and end-pos
(member (get-text start-pos end-pos)
'("'" "," ",@" "`"
"#'" "#," "#`" "#,@"
"#&" "#;"
"#hash" "#hasheq"
"#ci" "#cs")))))
(define/public (get-forward-sexp start-pos)
(forward-match start-pos (last-position))
;; the below is my first attempt to get forward/backward sexp
;; to work properly with qutoe.
;; it broke the tabber, so I took it out for now.
#;
(let ([one-forward (forward-match start-pos (last-position))])
;; loop to work properly with quote, etc.
(let loop ([one-forward (forward-match start-pos (last-position))])
(cond
[(and one-forward (not (= 0 one-forward)))
(let ([bw (backward-match one-forward 0)])
(cond
[(and bw
(= (- one-forward 1) bw)
(member (get-character bw) '(#\, #\` #\')))
(stick-to-next-sexp? bw))
(let ([two-forward (forward-match one-forward (last-position))])
(or two-forward
(if two-forward
(loop two-forward)
one-forward))]
[else
one-forward]))]
@ -832,7 +842,16 @@
(if (and end-pos
(or (not min-pos)
(end-pos . >= . min-pos)))
end-pos
;; Can go backward, but check for preceding quote, unquote, etc.
(let loop ([end-pos end-pos])
(let ([next-end-pos (backward-match end-pos limit)])
(if (and next-end-pos
(or (not min-pos)
(end-pos . >= . min-pos))
(stick-to-next-sexp? next-end-pos))
(loop next-end-pos)
end-pos)))
;; can't go backward at all:
#f)))
[define flash-backward-sexp
(λ (start-pos)