diff --git a/rmacs/buffer.rkt b/rmacs/buffer.rkt index f21dda3..12b9ac4 100644 --- a/rmacs/buffer.rkt +++ b/rmacs/buffer.rkt @@ -3,6 +3,7 @@ (provide (struct-out buffer-mark-type) make-buffergroup initialize-buffergroup! + buffergroup-buffer-titles buffer? make-buffer register-buffer! @@ -116,6 +117,9 @@ (set-buffergroup-editor! g editor) g) +(define (buffergroup-buffer-titles g) + (map buffer-title (circular-list->list (buffergroup-members g)))) + (define (initial-contents-rope initial-contents) (cond [(string? initial-contents) (string->rope initial-contents)] diff --git a/rmacs/editor.rkt b/rmacs/editor.rkt index 6467726..3b3290d 100644 --- a/rmacs/editor.rkt +++ b/rmacs/editor.rkt @@ -3,6 +3,7 @@ (provide (except-out (struct-out editor) editor) make-editor configure-fresh-buffer! + find-buffer window-layout window-width window-height @@ -288,7 +289,7 @@ (message editor "Unbound key sequence: ~a" (keyseq->keyspec total-keyseq))) (loop '() '() (root-keyseq-handler editor) (request-repaint))] [(incomplete-key-sequence next-handler) - (message editor "~a-" (keyseq->keyspec total-keyseq)) + (message #:log? #f editor "~a-" (keyseq->keyspec total-keyseq)) (wait-for-input next-handler)] [(command-invocation selector prefix-arg remaining-input) (define accepted-input @@ -318,16 +319,18 @@ (invalidate-layout! editor))) (define (message #:duration [duration0 #f] + #:log? [log? #t] editor fmt . args) (define duration (or duration0 (and (editor-recursive-edit editor) 2))) (define msg (string->rope (apply format fmt args))) (define echo-area (editor-echo-area editor)) - (let* ((msgbuf (find-buffer editor "*Messages*")) - (msgwins (filter (lambda (w) (equal? (buffer-mark-pos msgbuf (window-point w)) - (buffer-size msgbuf))) - (windows-for-buffer editor msgbuf)))) - (buffer-insert! msgbuf (buffer-size msgbuf) (rope-append msg (string->rope "\n"))) - (for ((w msgwins)) (buffer-mark! msgbuf (window-point w) (buffer-size msgbuf)))) + (when log? + (let* ((msgbuf (find-buffer editor "*Messages*")) + (msgwins (filter (lambda (w) (equal? (buffer-mark-pos msgbuf (window-point w)) + (buffer-size msgbuf))) + (windows-for-buffer editor msgbuf)))) + (buffer-insert! msgbuf (buffer-size msgbuf) (rope-append msg (string->rope "\n"))) + (for ((w msgwins)) (buffer-mark! msgbuf (window-point w) (buffer-size msgbuf))))) (buffer-replace-contents! echo-area msg) (set-window-buffer! (editor-mini-window editor) echo-area (buffer-size echo-area)) (invalidate-layout! editor) diff --git a/rmacs/mode/fundamental.rkt b/rmacs/mode/fundamental.rkt index a469ec5..5b71d4a 100644 --- a/rmacs/mode/fundamental.rkt +++ b/rmacs/mode/fundamental.rkt @@ -4,6 +4,7 @@ (require racket/set) (require racket/match) +(require racket/string) (require "../api.rkt") (define fundamental-mode (make-mode "fundamental")) @@ -172,3 +173,18 @@ (invoke (copy-command cmd #:selector (string->symbol content) #:keyseq #f))))) + +(define-command fundamental-mode (switch-to-buffer buf #:window win #:editor ed) + #:bind-key "C-x b" + (define default-target (buffer-next buf)) + (completing-read ed + (format "Switch to buffer~a: " + (if default-target + (format " (default ~a)" (buffer-title default-target)) + "")) + (simple-completion (buffergroup-buffer-titles (editor-buffers ed))) + #:on-accept (lambda (title0) + (define title1 (string-trim title0)) + (define title (if (equal? title1 "") #f title1)) + (define target (if title (find-buffer ed title) default-target)) + (set-window-buffer! win target))))