C-x b (switch-to-buffer)

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)]

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*"))
+  (when log?
-         (msgwins (filter (lambda (w) (equal? (buffer-mark-pos msgbuf (window-point w))
+    (let* ((msgbuf (find-buffer editor "*Messages*"))
-                                              (buffer-size msgbuf)))
+           (msgwins (filter (lambda (w) (equal? (buffer-mark-pos msgbuf (window-point w))
-                          (windows-for-buffer editor msgbuf))))
+                                                (buffer-size msgbuf)))
-    (buffer-insert! msgbuf (buffer-size msgbuf) (rope-append msg (string->rope "\n")))
+                            (windows-for-buffer editor msgbuf))))
-    (for ((w msgwins)) (buffer-mark! msgbuf (window-point w) (buffer-size 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)

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))))