turnaround.l

;;; -*- mode: lisp; package: editor -*-
;;;
;;; turnaround.l

(in-package :editor)

(export '(turnaround
          turnaround-or-select-word
          turnaround-or-self-insert))

(defvar-local turnaround-candidates-list nil)

(defun select-region (from to)
  (goto-char to)
  (start-selection 2 t from))

(defun %current-word (&optional (point (point) point-supplied-p))
  (save-excursion
    (when point-supplied-p (goto-char point))
    (skip-syntax-spec-backward "w_")
    (let ((from (point)))
      (skip-syntax-spec-forward "w_")
      (values (buffer-substring from (point))
              from
              (point)))))

(defun turnaround-find-candidates (text)
  (let ((all turnaround-candidates-list))
    (do ((candidates (car all) (car rest))
         (rest (cdr all) (cdr rest)))
        ((null candidates) nil)
      (let ((pos (position text candidates :test 'string=)))
        (when pos (return (values candidates pos)))))))

(defun next-item (list n)
  (let ((next-n (1+ n)))
    (if (= next-n (length list))
        (car list)
      (nth next-n list))))

(defun turnaround ()
  (interactive "*")
  (multiple-value-bind (text from to)
      (%current-word)
    (unless (stringp text) (return-from turnaround nil))
    (multiple-value-bind (candidates n)
        (turnaround-find-candidates text)
      (if candidates
          (progn
            (delete-region from to)
            (insert (next-item candidates n))
            (select-region from (point)))
        (interactive-p)))))

(defun turnaround-or-select-word ()
  (interactive "*")
  (or (turnaround)
      (multiple-value-bind (text from to)
          (%current-word)
        (if text
            (select-region from to)
          (interactive-p)))))

(defun turnaround-or-self-insert ()
  (interactive "*")
  (call-interactively
   (if (member *last-command* '(turnaround turnaround-or-self-insert))
       'turnaround
     'self-insert-command)))

;;; turnaround.l ends here.

うちで使ってる monday.vim っぽいもの。
.xyzzy の設定が↓な感じ。
(require :turnaround)

(define-key *global-keymap* #\C-t 'turnaround-or-select-word)

(defparameter *lisp-turnaround-candidates-list*
  '(("defvar" "defparameter" "defconstant" "defvar-local")
    ("labels" "flet")
    ("let" "let*")
    ("mapcar" "mapcan" "remove-if-not" "delete-if-not" "remove-if" "delete-if")
    ("find" "member" "some")))

(add-hook '*lisp-shared-hook*
  (defun lisp-setup-turnaround ()
    (setf ed::turnaround-candidates-list *lisp-turnaround-candidates-list*)))