feat: Improve pop-to-buffer selection UI.

Before this change, the user was supposed to select the short
documentation of the functions, which might not be very practical,
depending on how the user's completing-read works.

With this change, the user is supposed to select a short symbol, with
the shortdoc displayed as annotation.

This change also adds tests for the pop-to-buffer selection UI.

Author: szermatt

test/turtles-test.el

@@ -1071,6 +1071,92 @@
   (should (eq (alist-get 'window-system (frame-parameters))
               (turtles-pop-to-buffer-other-frame :check nil nil))))
 
+(ert-deftest turtles-pop-to-buffer-interactive ()
+  (turtles-ert-test)
+
+  (let ((inst (turtles-start-instance 'default))
+        (buf (turtles-instance-eval
+              'default
+              '(with-current-buffer
+                   (generate-new-buffer "*pop-to-buffer-test*")
+                 (insert "foo bar")
+                 (current-buffer))))
+        (turtles-pop-to-buffer-actions
+         (list #'turtles-pop-to-buffer-embedded
+               #'turtles-pop-to-buffer-copy))
+        (inhibit-message t))
+
+    (turtles-with-minibuffer
+        (let ((completion-cycle-threshold 0))
+          (turtles-pop-to-buffer buf))
+
+      (turtles-with-grab-buffer (:name "initial")
+          (should (equal "Display buffer:" (buffer-string))))
+
+      (minibuffer-complete)
+      (minibuffer-complete)
+      (turtles-with-grab-buffer (:buf "*Completions*")
+        (goto-char (point-min))
+        (search-forward "possible completions:\n")
+        (should (equal (concat "copy Display a copy of the instance buffer.\n"
+                               "embedded Display buffer in the terminal buffer.")
+                       (buffer-substring (point) (point-max))))
+
+        (execute-kbd-macro (kbd "copy"))))
+
+    ;; pop-to-buffer should have made a copy. Let's check it.
+    (with-current-buffer (window-buffer (selected-window))
+      (should (string-prefix-p "[default] *pop-to-buffer-test*" (buffer-name)))
+      (should (equal "foo bar" (buffer-string)))
+      (kill-buffer (current-buffer)))))
+
+(ert-deftest turtles-pop-to-buffer-interactive-lambdas ()
+  (turtles-ert-test)
+
+  (let* ((inst (turtles-start-instance 'default))
+         (buf (turtles-instance-eval
+               'default
+               '(with-current-buffer
+                    (generate-new-buffer "*pop-to-buffer-test*")
+                  (insert "foo bar")
+                  (current-buffer))))
+         (calls nil)
+         (turtles-pop-to-buffer-actions
+          (list
+           (lambda (action &rest _args)
+             "My Lambda 1."
+             (when (eq :display action)
+               (push 'lambda-1 calls))
+             t)
+           (lambda (action &rest _args)
+             "My Lambda 2."
+             (when (eq :display action)
+               (push 'lambda-2 calls))
+             t)))
+         (inhibit-message t))
+
+    (turtles-with-minibuffer
+        (let ((completion-cycle-threshold 0))
+          (turtles-pop-to-buffer buf))
+      
+      (turtles-with-grab-buffer (:name "initial")
+        (should (equal "Display buffer:" (buffer-string))))
+
+      (minibuffer-complete)
+      (minibuffer-complete)
+      (turtles-with-grab-buffer (:buf "*Completions*")
+        (goto-char (point-min))
+        (search-forward "possible completions:\n")
+        (should (equal (concat "lambda-1 My Lambda 1.\n"
+                               "lambda-2 My Lambda 2.")
+                       (buffer-substring (point) (point-max)))))
+      
+      (execute-kbd-macro (kbd "1"))
+      (turtles-with-grab-buffer (:name "choice")
+        (should (equal "Display buffer: lambda-1" (buffer-string)))))
+
+    (should (equal '(lambda-1) calls))))
+
 (ert-deftest turtles--split-minibuffer-body ()
   (should
    (equal
@@ -1264,3 +1350,4 @@
       (goto-char (match-beginning 0))
       (should (string-equal-ignore-case "#276ce2" (foreground-color-at-point)))
       (should (string-equal-ignore-case "#0c1526" (background-color-at-point))))))
+

turtles-instance.el

@@ -466,11 +466,11 @@ or nil.
 If specified, PREDICATE must be a function that takes a single
 argument of type `turtles-instance'."
   (let ((completion-extra-properties
-         '(:annotation-function
-           (lambda (id-as-str)
-             (when-let* ((inst (turtles-get-instance (intern id-as-str)))
-                         (doc (turtles-instance-shortdoc inst)))
-               (concat " " doc)))))
+         `(:annotation-function
+           ,(lambda (id-as-str)
+              (when-let* ((inst (turtles-get-instance (intern id-as-str)))
+                          (doc (turtles-instance-shortdoc inst)))
+                (concat " " doc)))))
         (predicate (if predicate
                        (lambda (cell)
                          (funcall predicate (cdr cell)))

turtles.el

@@ -1061,19 +1061,29 @@ itself."
      ((length= actions 1)
       (apply (car actions) :display inst buffer-name pop-to-buffer-args))
      (t
-      (let* ((action-alist (mapcar (lambda (func)
-                                     (cons (or (car (split-string (documentation func) "\n"))
-                                               (when (symbolp func) (symbol-name func))
-                                               "Anonymous action")
-                                           func))
+      (let* ((action-alist (mapcar (let ((counter 0))
+                                     (lambda (func)
+                                       (cons
+                                        (if (symbolp func)
+                                            (string-remove-prefix
+                                             "turtles-pop-to-buffer-" (symbol-name func))
+                                          (format "lambda-%d" (cl-incf counter)))
+                                        func)))
                                    actions))
+             (completion-extra-properties
+              `(:annotation-function
+                ,(lambda (key)
+                   (let ((func (alist-get key action-alist nil nil #'string=)))
+                     (when-let ((shortdoc (car (split-string (documentation func) "\n"))))
+                       (concat " " shortdoc))))))
              (action
-             (completing-read
-              "Display buffer: "
-              action-alist nil 'require-match nil 'pop-to-buffer-action-history)))
+              (alist-get
+               (completing-read
+                "Display buffer: "
+                action-alist nil 'require-match nil 'pop-to-buffer-action-history)
+               action-alist nil nil #'string=)))
         (when action
-          (apply (alist-get action action-alist nil nil #'string=)
-                 :display inst buffer-name pop-to-buffer-args)))))))
+          (apply action :display inst buffer-name pop-to-buffer-args)))))))
 
 (defun turtles-pop-to-buffer-embedded (action inst buffer-name &rest pop-to-buffer-args)
   "Display buffer in the terminal buffer.