..
original commit: bcf8165f200e02e9ed2ebd7bfe7af6b538c9e160
This commit is contained in:
Robby Findler
parent
a6da57796d
commit
2a1ecc6448
|
|
@ -77,11 +77,11 @@
|
|||
|
||||
(define aug-keymap% (aug-keymap-mixin keymap%))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;;;; ;;;;;;;;
|
||||
;;;;;;; canonicalize-keybinding-string ;;;;;;;;
|
||||
;;;;;;; ;;;;;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;;;; ;;;;;;;;
|
||||
;;;;;;; canonicalize-keybinding-string ;;;;;;;;
|
||||
;;;;;;; ;;;;;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; canonicalize-keybinding-string : string -> string
|
||||
;; The result can be used with string=? to determine
|
||||
|
|
@ -106,11 +106,11 @@
|
|||
(car strs)
|
||||
(let loop ([sepd-strs (cdr strs)])
|
||||
(cond
|
||||
[(null? sepd-strs) null]
|
||||
[else (list*
|
||||
sep
|
||||
(car sepd-strs)
|
||||
(loop (cdr sepd-strs)))]))))))
|
||||
[(null? sepd-strs) null]
|
||||
[else (list*
|
||||
sep
|
||||
(car sepd-strs)
|
||||
(loop (cdr sepd-strs)))]))))))
|
||||
|
||||
;; canonicalize-single-keybinding-string : (listof char) -> string
|
||||
(define (canonicalize-single-keybinding-string chars)
|
||||
|
|
@ -119,9 +119,9 @@
|
|||
[mods
|
||||
(let loop ([mods mods/key])
|
||||
(cond
|
||||
[(null? mods) null]
|
||||
[(null? (cdr mods)) null]
|
||||
[else (cons (car mods) (loop (cdr mods)))]))]
|
||||
[(null? mods) null]
|
||||
[(null? (cdr mods)) null]
|
||||
[else (cons (car mods) (loop (cdr mods)))]))]
|
||||
[key (car (last-pair mods/key))]
|
||||
[shift (if neg? #f 'd/c)]
|
||||
[control (if neg? #f 'd/c)]
|
||||
|
|
@ -132,9 +132,9 @@
|
|||
[do-key
|
||||
(lambda (char val)
|
||||
(cond
|
||||
[(eq? val #t) (string char)]
|
||||
[(eq? val #f) (string #\~ char)]
|
||||
[(eq? val 'd/c) #f]))])
|
||||
[(eq? val #t) (string char)]
|
||||
[(eq? val #f) (string #\~ char)]
|
||||
[(eq? val 'd/c) #f]))])
|
||||
|
||||
(for-each (lambda (mod)
|
||||
(let ([val (not (char=? (car mod) #\~))])
|
||||
|
|
@ -167,28 +167,28 @@
|
|||
[this-split null]
|
||||
[all-split null])
|
||||
(cond
|
||||
[(null? chars)
|
||||
(reverse (cons (reverse this-split) all-split))]
|
||||
[else (let ([char (car chars)])
|
||||
(cond
|
||||
[(char=? split-char char)
|
||||
(if (null? (cdr chars))
|
||||
(loop null
|
||||
(cons char this-split)
|
||||
all-split)
|
||||
(loop (cdr chars)
|
||||
null
|
||||
(cons (reverse this-split) all-split)))]
|
||||
[else
|
||||
(loop (cdr chars)
|
||||
(cons char this-split)
|
||||
all-split)]))])))
|
||||
[(null? chars)
|
||||
(reverse (cons (reverse this-split) all-split))]
|
||||
[else (let ([char (car chars)])
|
||||
(cond
|
||||
[(char=? split-char char)
|
||||
(if (null? (cdr chars))
|
||||
(loop null
|
||||
(cons char this-split)
|
||||
all-split)
|
||||
(loop (cdr chars)
|
||||
null
|
||||
(cons (reverse this-split) all-split)))]
|
||||
[else
|
||||
(loop (cdr chars)
|
||||
(cons char this-split)
|
||||
all-split)]))])))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;;;; ;;;;;;;;
|
||||
;;;;;;; end canonicalize-keybinding-string ;;;;;;;;
|
||||
;;;;;;; ;;;;;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;;;; ;;;;;;;;
|
||||
;;;;;;; end canonicalize-keybinding-string ;;;;;;;;
|
||||
;;;;;;; ;;;;;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (make-meta-prefix-list key)
|
||||
(list (string-append "m:" key)
|
||||
|
|
@ -203,7 +203,7 @@
|
|||
(define add-to-right-button-menu/before (make-parameter void))
|
||||
|
||||
(define setup-global
|
||||
; Define some useful keyboard functions
|
||||
; Define some useful keyboard functions
|
||||
(let* ([ring-bell
|
||||
(lambda (edit event)
|
||||
(bell))]
|
||||
|
|
@ -302,47 +302,56 @@
|
|||
(send edit flash-on pos (+ 1 pos))))
|
||||
#t)]
|
||||
[collapse-variable-space
|
||||
;; As per emacs: collapse tabs & spaces around the point,
|
||||
;; perhaps leaving a single space.
|
||||
;; drscheme bonus: if at end-of-line, collapse into the next line.
|
||||
(lambda (leave-one? edit event)
|
||||
(letrec ([end-pos (send edit last-position)]
|
||||
[find-nonwhite
|
||||
(lambda (pos d)
|
||||
(letrec ([last-pos (send edit last-position)]
|
||||
[sel-start (send edit get-start-position)]
|
||||
[sel-end (send edit get-end-position)]
|
||||
[collapsible? (lambda (c) (and (char-whitespace? c)
|
||||
(not (char=? #\newline c))))]
|
||||
[find-noncollapsible
|
||||
; Return index of next non-collapsible char,
|
||||
; starting at pos in direction dir.
|
||||
; NB returns -1 or last-pos, if examining
|
||||
; initial/final whitespace
|
||||
; (or, when initial pos is outside of [0,last-pos).)
|
||||
(lambda (pos dir)
|
||||
(let loop ([pos pos])
|
||||
(if (or (and (= d -1)
|
||||
(= pos 0))
|
||||
(and (= pos end-pos)
|
||||
(= d 1)))
|
||||
pos
|
||||
(let ([c (send edit get-character pos)])
|
||||
(cond
|
||||
[(char=? #\newline c) pos]
|
||||
[(char-whitespace? c) (loop (+ pos d))]
|
||||
[else pos])))))])
|
||||
(let ([sel-start (send edit get-start-position)]
|
||||
[sel-end (send edit get-end-position)])
|
||||
(when (= sel-start sel-end)
|
||||
(let ([start
|
||||
(if (= sel-start 0)
|
||||
0
|
||||
(+ (find-nonwhite (- sel-start 1) -1) 1))]
|
||||
[end (find-nonwhite sel-start 1)])
|
||||
(send edit begin-edit-sequence)
|
||||
(cond
|
||||
;; funny case when to delete the newline
|
||||
[(and leave-one?
|
||||
(= (+ start 1) end)
|
||||
(< end end-pos)
|
||||
(char=? #\space (send edit get-character start))
|
||||
(char=? #\newline (send edit get-character end)))
|
||||
(send edit delete end (+ end 1))]
|
||||
[else
|
||||
(send edit delete start end)
|
||||
(cond
|
||||
[leave-one?
|
||||
(send edit insert #\space start)
|
||||
(send edit set-position (+ start 1))]
|
||||
[else
|
||||
(send edit set-position start)])])
|
||||
(send edit end-edit-sequence))))))]
|
||||
(cond [(< pos 0) -1]
|
||||
[(>= pos last-pos) last-pos]
|
||||
[(collapsible? (send edit get-character pos))
|
||||
(loop (+ pos dir))]
|
||||
[else pos])))])
|
||||
(when (= sel-start sel-end) ; Only when no selection:
|
||||
(let* ([start (add1 (find-noncollapsible (sub1 sel-start) -1))]
|
||||
[end-heeding-eol (find-noncollapsible sel-start +1)]
|
||||
; This is the end of the range, were we to always heed newlines.
|
||||
|
||||
; Special case: if we're sitting at EOL,
|
||||
; and we're not affecting much else,
|
||||
; then delete that EOL and collapse spaces
|
||||
; at the start of next line, too:
|
||||
[end (if (and (<= (- end-heeding-eol start)
|
||||
(if leave-one? 1 0))
|
||||
(char=? #\newline (send edit get-character end-heeding-eol))
|
||||
; If you wish to avoid deleting an newline at EOF, do so here.
|
||||
)
|
||||
(find-noncollapsible (add1 end-heeding-eol) +1)
|
||||
end-heeding-eol)]
|
||||
[making-no-difference?
|
||||
; Don't introduce edits into undo-chain, if no effect.
|
||||
(if leave-one?
|
||||
(and (= (- end start) 1)
|
||||
(char=? #\space (send edit get-character start)))
|
||||
(= (- end start) 0))])
|
||||
(unless making-no-difference?
|
||||
(send edit begin-edit-sequence)
|
||||
(send edit set-position end) ; Even after delete, caret will be at "end".
|
||||
(send edit delete start end)
|
||||
(when leave-one? (send edit insert #\space start))
|
||||
(send edit end-edit-sequence))))))]
|
||||
|
||||
[collapse-space
|
||||
(lambda (edit event)
|
||||
|
|
@ -365,12 +374,12 @@
|
|||
(escape pos)
|
||||
(let ([c (send edit get-character (+ pos offset))])
|
||||
(cond
|
||||
[(char=? #\newline c)
|
||||
(loop (+ pos d))
|
||||
(escape pos)]
|
||||
[(char-whitespace? c)
|
||||
(loop (+ pos d))]
|
||||
[else pos])))))))])
|
||||
[(char=? #\newline c)
|
||||
(loop (+ pos d))
|
||||
(escape pos)]
|
||||
[(char-whitespace? c)
|
||||
(loop (+ pos d))]
|
||||
[else pos])))))))])
|
||||
(let ([sel-start (send edit get-start-position)]
|
||||
[sel-end (send edit get-end-position)])
|
||||
(when (= sel-start sel-end)
|
||||
|
|
@ -397,22 +406,22 @@
|
|||
[end-line-start
|
||||
(send edit line-start-position (add1 end-line))])
|
||||
(cond
|
||||
[(and whiteline?
|
||||
(= start-line pos-line)
|
||||
(= end-line pos-line))
|
||||
; Special case: just delete this line
|
||||
(send edit delete pos-line-start (add1 pos-line-end))]
|
||||
[(and whiteline? (< start-line pos-line))
|
||||
; Can delete before & after
|
||||
(send* edit
|
||||
(begin-edit-sequence)
|
||||
(delete (add1 pos-line-end) end-line-start)
|
||||
(delete start-line-start pos-line-start)
|
||||
(end-edit-sequence))]
|
||||
[else
|
||||
; Only delete after
|
||||
(send edit delete (add1 pos-line-end)
|
||||
end-line-start)]))))))]
|
||||
[(and whiteline?
|
||||
(= start-line pos-line)
|
||||
(= end-line pos-line))
|
||||
; Special case: just delete this line
|
||||
(send edit delete pos-line-start (add1 pos-line-end))]
|
||||
[(and whiteline? (< start-line pos-line))
|
||||
; Can delete before & after
|
||||
(send* edit
|
||||
(begin-edit-sequence)
|
||||
(delete (add1 pos-line-end) end-line-start)
|
||||
(delete start-line-start pos-line-start)
|
||||
(end-edit-sequence))]
|
||||
[else
|
||||
; Only delete after
|
||||
(send edit delete (add1 pos-line-end)
|
||||
end-line-start)]))))))]
|
||||
|
||||
[open-line
|
||||
(lambda (edit event)
|
||||
|
|
@ -420,8 +429,8 @@
|
|||
[sel-end (send edit get-end-position)])
|
||||
(if (= sel-start sel-end)
|
||||
(send* edit
|
||||
(insert #\newline)
|
||||
(set-position sel-start)))))]
|
||||
(insert #\newline)
|
||||
(set-position sel-start)))))]
|
||||
|
||||
[transpose-chars
|
||||
(lambda (edit event)
|
||||
|
|
@ -440,11 +449,11 @@
|
|||
(let ([s (send edit get-text
|
||||
sel-start (add1 sel-start))])
|
||||
(send* edit
|
||||
(begin-edit-sequence)
|
||||
(delete sel-start (add1 sel-start))
|
||||
(insert s (- sel-start 1))
|
||||
(set-position (add1 sel-start))
|
||||
(end-edit-sequence)))))))]
|
||||
(begin-edit-sequence)
|
||||
(delete sel-start (add1 sel-start))
|
||||
(insert s (- sel-start 1))
|
||||
(set-position (add1 sel-start))
|
||||
(end-edit-sequence)))))))]
|
||||
|
||||
[transpose-words
|
||||
(lambda (edit event)
|
||||
|
|
@ -466,15 +475,15 @@
|
|||
(unbox word-2-start)
|
||||
(unbox word-2-end))])
|
||||
(send* edit
|
||||
(begin-edit-sequence)
|
||||
(insert text-1
|
||||
(unbox word-2-start)
|
||||
(unbox word-2-end))
|
||||
(insert text-2
|
||||
(unbox word-1-start)
|
||||
(unbox word-1-end))
|
||||
(set-position (unbox word-2-end))
|
||||
(end-edit-sequence))))))))))]
|
||||
(begin-edit-sequence)
|
||||
(insert text-1
|
||||
(unbox word-2-start)
|
||||
(unbox word-2-end))
|
||||
(insert text-2
|
||||
(unbox word-1-start)
|
||||
(unbox word-1-end))
|
||||
(set-position (unbox word-2-end))
|
||||
(end-edit-sequence))))))))))]
|
||||
|
||||
[capitalize-it
|
||||
(lambda (edit char-case1 char-case2)
|
||||
|
|
@ -491,17 +500,17 @@
|
|||
(when (< pos word-end)
|
||||
(let ([c (send edit get-character pos)])
|
||||
(cond
|
||||
[(char-alphabetic? c)
|
||||
(send edit insert
|
||||
(list->string
|
||||
(list (char-case c)))
|
||||
pos (add1 pos))
|
||||
(loop (add1 pos) char-case2)]
|
||||
[else
|
||||
(loop (add1 pos) char-case)]))))
|
||||
[(char-alphabetic? c)
|
||||
(send edit insert
|
||||
(list->string
|
||||
(list (char-case c)))
|
||||
pos (add1 pos))
|
||||
(loop (add1 pos) char-case2)]
|
||||
[else
|
||||
(loop (add1 pos) char-case)]))))
|
||||
(send* edit
|
||||
(end-edit-sequence)
|
||||
(set-position word-end))))))]
|
||||
(end-edit-sequence)
|
||||
(set-position word-end))))))]
|
||||
|
||||
[capitalize-word
|
||||
(lambda (edit event)
|
||||
|
|
@ -613,19 +622,19 @@
|
|||
(when (string? num-str)
|
||||
(let ([line-num (inexact->exact (string->number num-str))])
|
||||
(cond
|
||||
[(and (number? line-num)
|
||||
(= line-num (floor line-num))
|
||||
(<= 1 line-num (+ (send edit last-line) 1)))
|
||||
(let ([pos (send edit line-start-position
|
||||
(sub1 line-num))])
|
||||
(send edit set-position pos))]
|
||||
[else
|
||||
(message-box
|
||||
(string-constant goto-line)
|
||||
(format
|
||||
(string-constant goto-line-invalid-number)
|
||||
num-str
|
||||
(+ (send edit last-line) 1)))]))))
|
||||
[(and (number? line-num)
|
||||
(= line-num (floor line-num))
|
||||
(<= 1 line-num (+ (send edit last-line) 1)))
|
||||
(let ([pos (send edit line-start-position
|
||||
(sub1 line-num))])
|
||||
(send edit set-position pos))]
|
||||
[else
|
||||
(message-box
|
||||
(string-constant goto-line)
|
||||
(format
|
||||
(string-constant goto-line-invalid-number)
|
||||
num-str
|
||||
(+ (send edit last-line) 1)))]))))
|
||||
|
||||
#t)]
|
||||
[goto-position
|
||||
|
|
@ -698,7 +707,7 @@
|
|||
|
||||
[do-macro
|
||||
(lambda (edit event)
|
||||
; If c:x;e during record, copy the old macro
|
||||
; If c:x;e during record, copy the old macro
|
||||
(when building-macro
|
||||
(set! building-macro (append (reverse current-macro)
|
||||
(cdr building-macro))))
|
||||
|
|
@ -788,7 +797,7 @@
|
|||
[add-m (lambda (name func)
|
||||
(send kmap add-function name func))])
|
||||
|
||||
; Map names to keyboard functions
|
||||
; Map names to keyboard functions
|
||||
(add "toggle-overwrite" toggle-overwrite)
|
||||
|
||||
(add "exit" (lambda (edit event)
|
||||
|
|
@ -847,7 +856,7 @@
|
|||
|
||||
(add "mouse-popup-menu" mouse-popup-menu)
|
||||
|
||||
; Map keys to functions
|
||||
; Map keys to functions
|
||||
(map "c:g" "ring-bell")
|
||||
(map-meta "c:g" "ring-bell")
|
||||
(map "c:x;c:g" "ring-bell")
|
||||
|
|
@ -976,7 +985,7 @@
|
|||
(map "s:insert" "paste-clipboard")
|
||||
|
||||
(map-meta "space" "collapse-space")
|
||||
;(map-meta "\\" "remove-space") ;; conflicts with european keyboards
|
||||
;(map-meta "\\" "remove-space") ; Conflicts with european keyboards.
|
||||
(map "c:x;c:o" "collapse-newline")
|
||||
(map "c:o" "open-line")
|
||||
(map "c:t" "transpose-chars")
|
||||
|
|
@ -1020,13 +1029,13 @@
|
|||
(lambda (edit event)
|
||||
(let ([frame
|
||||
(cond
|
||||
[(is-a? edit editor<%>)
|
||||
(let ([canvas (send edit get-active-canvas)])
|
||||
(and canvas
|
||||
(send canvas get-top-level-window)))]
|
||||
[(is-a? edit area<%>)
|
||||
(send edit get-top-level-window)]
|
||||
[else #f])])
|
||||
[(is-a? edit editor<%>)
|
||||
(let ([canvas (send edit get-active-canvas)])
|
||||
(and canvas
|
||||
(send canvas get-top-level-window)))]
|
||||
[(is-a? edit area<%>)
|
||||
(send edit get-top-level-window)]
|
||||
[else #f])])
|
||||
(if frame
|
||||
(invoke-method frame)
|
||||
(bell)))
|
||||
|
|
@ -1066,7 +1075,7 @@
|
|||
(map "c:g" "find-string-again")
|
||||
|
||||
;; covered by menu
|
||||
;(map "c:f" "move-to-search-or-search")
|
||||
;(map "c:f" "move-to-search-or-search")
|
||||
|
||||
(map "c:i" "toggle-search-focus")]
|
||||
[(macos macosx)
|
||||
|
|
@ -1074,7 +1083,7 @@
|
|||
(map "c:g" "hide-search")
|
||||
|
||||
;; covered by menu
|
||||
;(map "d:f" "move-to-search-or-search")
|
||||
;(map "d:f" "move-to-search-or-search")
|
||||
|
||||
(map "d:r" "move-to-search-or-reverse-search")
|
||||
(map "d:g" "find-string-again")
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user