attached patch
Sorry, that was an older version; revised is attached.
diff --git a/nrepl.scm b/nrepl.scm
index aaf7515..eae5f11 100644
--- a/nrepl.scm
+++ b/nrepl.scm
@@ -972,8 +972,11 @@
(mouse-col #f)
(mouse-row #f)
(repl-done #f)
- (selection #f)
- (control-key (ash 1 33))) ; notcurses getc returns 32
bits
+ (selection "")
+ (previously-selected #f)
+ (just-selected #f)
+ (control-key (ash 1 33))
+ (meta-key (ash 1 34))) ; notcurses getc returns 32
bits
(set! (top-level-let 'ncp-let) (curlet))
(set! display-debug-info local-debug-info)
@@ -1154,67 +1157,123 @@
((= i 256))
(set! (keymap i) normal-char))
- (set! (keymap (char->integer #\escape))
- (lambda (c)
- ;; these are the Meta key handlers
- (let ((k (notcurses_getc nc (c-pointer 0) (c-pointer
0) ni)))
-
- (case (integer->char k)
- ((#\C #\c)
- (do ((len (- (eols row) col))
- (cur-line (ncplane_contents ncp row col 1
(- (eols row) col)))
- (i 0 (+ i 1)))
- ((or (= i len)
- (char-alphabetic? (cur-line i)))
- (when (< i len)
- (set! (cur-line i) (char-upcase (cur-line
i)))
- (nc-display row col cur-line)
- (notcurses_refresh nc)
- (do ((k (+ i 1) (+ k 1)))
- ((or (>= k len)
- (not (or (char-alphabetic?
(cur-line k))
- (char-numeric?
(cur-line k)))))
- (set! col (min (eols row) (+ col
k)))))))))
-
- ((#\L #\l)
- (do ((len (- (eols row) col))
- (cur-line (ncplane_contents ncp row col 1
(- (eols row) col)))
- (i 0 (+ i 1)))
- ((or (= i len)
- (char-alphabetic? (cur-line i)))
- (when (< i len)
- (do ((k i (+ k 1)))
- ((or (= k len)
- (not (char-alphabetic? (cur-line
k))))
- (nc-display row col cur-line)
- (notcurses_refresh nc)
- (set! col (+ col k)))
- (set! (cur-line k) (char-downcase
(cur-line k))))))))
-
- ((#\U #\u)
- (do ((len (- (eols row) col))
- (cur-line (ncplane_contents ncp row col 1
(- (eols row) col)))
- (i 0 (+ i 1)))
- ((or (= i len)
- (char-alphabetic? (cur-line i)))
- (when (< i len)
- (do ((k i (+ k 1)))
- ((or (= k len)
- (not (char-alphabetic? (cur-line
k))))
- (nc-display row col cur-line)
- (notcurses_refresh nc)
- (set! col (+ col k)))
- (set! (cur-line k) (char-upcase
(cur-line k))))))))
-
- ((#\<)
- (set-row 0)
- (set-col (bols 0)))
-
- ((#\>)
- (set-row ncp-max-row)
- (set-col (bols ncp-max-row)))
-
- )))) ; end Meta keys
+ (define (prepend-to-selection new-text)
+ (unless (zero? (length new-text))
+ (set! selection (if previously-selected (append new-text
selection)
+ new-text))
+ (set! just-selected #t)))
+ (define (append-to-selection new-text)
+ (unless (zero? (length new-text))
+ (set! selection (if previously-selected (append
selection new-text)
+ new-text))
+ (set! just-selected #t)))
+ (define (char-separator? c)
+ (char-position c " ()`',\"#"))
+ (define (word-back-x)
+ (let loop ((col (max (bols row) (- col 1))))
+ (if (= col (bols row))
+ col
+ (if (char-separator? (ncplane_contents ncp row col 1
1))
+ (loop (- col 1))
+ (let loop ((col col))
+ (if (= col (bols row))
+ col
+ (if (char-separator? (ncplane_contents ncp row
(- col 1) 1 1))
+ col
+ (loop (- col 1)))))))))
+ (define (word-forward-x)
+ (let loop ((col (min (eols row) (+ col 1))))
+ (if (= col (eols row))
+ col
+ (if (char-separator? (ncplane_contents ncp row col 1
1))
+ (loop (+ col 1))
+ (let loop ((col col))
+ (if (= col (eols row))
+ col
+ (if (char-separator? (ncplane_contents ncp row
col 1 1))
+ col
+ (loop (+ col 1)))))))))
+
+ (set! (keymap (+ meta-key (char->integer #\B)))
+ (set! (keymap (+ meta-key (char->integer #\b)))
+ (lambda (c)
+ (set! col (word-back-x)))))
+
+ (set! (keymap (+ meta-key (char->integer #\C)))
+ (set! (keymap (+ meta-key (char->integer #\c)))
+ (lambda (c)
+ (do ((len (- (eols row) col))
+ (cur-line (ncplane_contents ncp row col 1 (-
(eols row) col)))
+ (i 0 (+ i 1)))
+ ((or (= i len)
+ (char-alphabetic? (cur-line i)))
+ (when (< i len)
+ (set! (cur-line i) (char-upcase (cur-line i)))
+ (nc-display row col cur-line)
+ (notcurses_refresh nc)
+ (do ((k (+ i 1) (+ k 1)))
+ ((or (>= k len)
+ (not (or (char-alphabetic? (cur-line k))
+ (char-numeric? (cur-line k)))))
+ (set! col (min (eols row) (+ col k)))))))))))
+
+ (set! (keymap (+ meta-key (char->integer #\D)))
+ (set! (keymap (+ meta-key (char->integer #\d)))
+ (lambda (c)
+ (let ((newcol (word-forward-x)))
+ (append-to-selection (ncplane_contents ncp row col 1
(- newcol col)))
+ (nc-display row col (ncplane_contents ncp row newcol
1 (- (eols row) newcol)))
+ (nc-display row (- (eols row) (- newcol col))
(make-string (- newcol col) #\space))
+ (set! (eols row) (- (eols row) (- newcol col)))))))
+
+ (set! (keymap (+ meta-key (char->integer #\F)))
+ (set! (keymap (+ meta-key (char->integer #\f)))
+ (lambda (c)
+ (set! col (word-forward-x)))))
+
+ (set! (keymap (+ meta-key (char->integer #\L)))
+ (set! (keymap (+ meta-key (char->integer #\l)))
+ (lambda (c)
+ (do ((len (- (eols row) col))
+ (cur-line (ncplane_contents ncp row col 1 (-
(eols row) col)))
+ (i 0 (+ i 1)))
+ ((or (= i len)
+ (char-alphabetic? (cur-line i)))
+ (when (< i len)
+ (do ((k i (+ k 1)))
+ ((or (= k len)
+ (not (char-alphabetic? (cur-line k))))
+ (nc-display row col cur-line)
+ (notcurses_refresh nc)
+ (set! col (+ col k)))
+ (set! (cur-line k) (char-downcase (cur-line
k))))))))))
+
+ (set! (keymap (+ meta-key (char->integer #\U)))
+ (set! (keymap (+ meta-key (char->integer #\u)))
+ (lambda (c)
+ (do ((len (- (eols row) col))
+ (cur-line (ncplane_contents ncp row col 1 (-
(eols row) col)))
+ (i 0 (+ i 1)))
+ ((or (= i len)
+ (char-alphabetic? (cur-line i)))
+ (when (< i len)
+ (do ((k i (+ k 1)))
+ ((or (= k len)
+ (not (char-alphabetic? (cur-line k))))
+ (nc-display row col cur-line)
+ (notcurses_refresh nc)
+ (set! col (+ col k)))
+ (set! (cur-line k) (char-upcase (cur-line
k))))))))))
+
+ (set! (keymap (+ meta-key (char->integer #\<)))
+ (lambda (c)
+ (set-row 0)
+ (set-col (bols 0))))
+
+ (set! (keymap (+ meta-key (char->integer #\>)))
+ (lambda (c)
+ (set-row ncp-max-row)
+ (set-col (bols ncp-max-row))))
(set! (keymap (char->integer #\tab)) tab)
@@ -1265,11 +1324,11 @@
(ncplane_move_yx ncp ncp-row ncp-col)
(reprompt row)))
- (set! (keymap (+ control-key (char->integer #\K)))
- (lambda (c)
- (set! selection (ncplane_contents ncp row col 1 (-
(eols row) col)))
- (nc-display row col (make-string (- (eols row) col)
#\space))
- (set! (eols row) col)))
+ (set! (keymap (+ control-key (char->integer #\K)))
+ (lambda (c)
+ (append-to-selection (ncplane_contents ncp row col 1 (-
(eols row) col)))
+ (nc-display row col (make-string (- (eols row) col)
#\space))
+ (set! (eols row) col)))
(set! (keymap (+ control-key (char->integer #\L))) ; not the
same as emacs's C-l (moves current row to top)
(lambda (c)
@@ -1338,6 +1397,23 @@
(if (< cur (eols row))
(set-col (+ cur 1)))))))
+ (set! (keymap (+ control-key (char->integer #\U)))
+ (lambda (c)
+ (prepend-to-selection (ncplane_contents ncp row (bols
row) 1 (- col (bols row))))
+ (nc-display row (bols row) (ncplane_contents ncp row col
1 (- (eols row) col)))
+ (nc-display row (- (eols row) (- col (bols row)))
(make-string (- col (bols row)) #\space))
+ (set! (eols row) (- (eols row) (- col (bols row))))
+ (set! col (bols row))))
+
+ (set! (keymap (+ control-key (char->integer #\W)))
+ (lambda (c)
+ (let ((newcol (word-back-x)))
+ (prepend-to-selection (ncplane_contents ncp row newcol
1 (- col newcol)))
+ (nc-display row newcol (ncplane_contents ncp row col 1
(- (eols row) col)))
+ (nc-display row (- (eols row) (- col newcol))
(make-string (- col newcol) #\space))
+ (set! (eols row) (- (eols row) (- col newcol)))
+ (set! col newcol))))
+
(set! (keymap (+ control-key (char->integer #\Y)))
(lambda (c)
(when (string? selection)
@@ -1350,7 +1426,7 @@
(> (length trailing) 0))
(nc-display row (+ col (length selection))
trailing)))
(set! (eols row) (+ (eols row) (length selection)))
- (set-col (eols row)))))
+ (set-col (+ col (length selection))))))
(set! (keymap NCKEY_LEFT) ; arrow keys
(lambda (c)
@@ -1472,8 +1548,15 @@
(when recursor
(recover-previous-layout))
+ (set! previously-selected just-selected)
+ (set! just-selected #f)
+
(let* ((c (notcurses_getc nc (c-pointer 0) (c-pointer
0) ni))
- (func (hash-table-ref keymap (if (ncinput_ctrl
ni) (+ c control-key) c))))
+ (c (if (= c (char->integer #\escape))
+ (logior meta-key (notcurses_getc nc
(c-pointer 0) (c-pointer 0) ni))
+ c))
+ (func (hash-table-ref keymap (logior c (if
(ncinput_ctrl ni) control-key 0)
+ (if
(ncinput_alt ni) meta-key 0)))))
(if (procedure? func)
(catch #t
_______________________________________________
Cmdist mailing list
Cmdist@ccrma.stanford.edu
https://cm-mail.stanford.edu/mailman/listinfo/cmdist
