ottt

iswitchb の場合、目線が minibaffer にいくので目線はそのままでバッファの表示量を増やし *do-completion を利用してかっちり補完移動と曖昧補完移動。(↑↓→← C-f C-b C-p C-n でも移動) きっちりモードに仕上げるのがいいと思ったけど、長くなるので個人的に使うのでここまでにした。

    (defun list/n(list n)
      (unless(atom list)
        (let ((i (if(< n (length list)) n (length list))))
          (cons(subseq list 0 i)
               (list/n (subseq list i nil)n)))))

    (defun miswitchb-color(search)
      (let((from (progn(scan-buffer search)(point))))
        (save-excursion
          (set-text-attribute from
                              (progn
                                (scan-buffer search :tail t)
                                (point))
                              'buf  :foreground 9 :bold t))))

    (defun miswitchb-switch(buf)
      (find-buffer buf)
      (delete-window)
      (switch-to-buffer buf))

    (defun vague-amiswitchb-list(str)
      (sort
       (remove-if #'(lambda (x)
                      (eq(char (buffer-name x) 0) #\SPC))
                  (let(r)
                    (dolist(x (remove-if
                               #'(lambda (x)
                                   (not (string-matchp(regexp-quote str)
                                                      (buffer-name x))))
                               (buffer-list))
                              r)
                      (push (buffer-name x) r))))
       #'string-lessp))

    (defun miswitchb(arg)
      (interactive "P")
      (and(get-ime-mode)
          (toggle-ime nil))
      (let((str "")
           (fmt " Completion Buffer~%~60,,,'-@A~%~{~{ ~20,@A ~}~%~}")
           (buf " *Buffer List Completion*")
           (i 0)
           ib c sym complete blst from to fbl ime)
        (and(get-ime-mode)
            (setq ime t)
            (toggle-ime nil))
        ;; 実行時にただ表示させるだけ
        (with-output-to-temp-buffer(buf)
          (multiple-value-bind(a b)
              (*do-completion str :buffer-name)
            (format t fmt ""
                    (list/n (setq fbl(sort
                                      (delete buf b :test 'equal)
                                      #'string-lessp)) 4))))
        (miswitchb-color(setq complete (car fbl)))
        (loop
          (minibuffer-message "Buffer: ~A" str)
          ;;RETで決定 複数の場合car
          (when(and(eq #\RET (setq c (read-char *keyboard*)))
                   ;; どうにかならんか
                   (if arg
                       (if (eq sym :no-match)
                         t
                       (if sym (stringp sym) t))
                     t))
            (miswitchb-switch complete)
            (and ime (toggle-ime ime))
            (return complete))
          (setq ib (1- (length blst)))
          (case c
            ((#\RET)
             (miswitchb-switch (car blst))
             (return (car blst)))
            ((#\C-g) (quit))
            ((#\C-h)
             (or(eq (length str) 0)
                (setq str (subseq str 0 (1- (length str))))))
            ((#\Left #\C-b)
             (if(< 0 i)(decf i)))
            ((#\Right #\C-f)
             (cond((= 0 i)
                   (setq i 1))
                  ((< i  ib)
                   (incf i))
                  (t (setq i 0))))
            ((#\Up #\C-p)
             (cond((<= 0 (- i 4)) (decf i 4))
                  ((< 0 i 4) (decf i))
                  (t (setq i ib))))
            ((#\Down #\C-n)
             (cond((< (- ib 4) i  ib)(incf i))
                  ((< ib i) (setq i 0))
                  ((< (+ i 3) ib)(incf i 4))
                  (t (setq i 0))))
            (t (setq i 0)
               (if(eq (lookup-key-command c) 'self-insert-command)
                   (setq str (concatenate 'string str (string c)))
                 t)))
          (message "~A" i)
          (with-output-to-temp-buffer(buf)
            (multiple-value-bind(a b)
                (*do-completion str :buffer-name)
              (format t fmt ""
                      (list/n (setq blst
                                    ;; 切り替え
                                    (if arg
                                        (sort (delete buf b :test 'equal)  #'string-lessp)
                                        (or (vague-amiswitchb-list str) fbl)
                                      ))
                              4))
              ;; 切り替え
              (and arg (setq sym a))
              (setq complete (nth i blst))
              ;書き換えた後の始めの位置
              (and blst (miswitchb-color (car blst)))
              ))
          (delete-text-attributes 'buf);前回の色を消す
          (and blst (miswitchb-color complete))
          (refresh-screen))
        ))