* xyzzy lisp : へなちょこ補完その3
絞込み
update : 2006-08-18 (Fri) 00:00:00
(defun dmc-instance-name ()
(save-excursion
(let ((start (progn (skip-syntax-spec-backward "w_") (point))))
(cond
((char= #\. (char-before start))
(buffer-substring (progn (forward-char -1) (skip-syntax-spec-backward "w_") (point)) (1- start)))
((and (char= #\> (char-before start))
(char= #\- (char-before (1- start))))
(buffer-substring (progn (forward-char -2) (skip-syntax-spec-backward "w_") (point)) (- start 2)))
(t
nil)))))
(defun dmc-find-all-candidates (name abbrev case-fold match-table start matches)
(let ((regexp (compile-regexp (concat (regexp-quote name) "\\(\\.\\|->\\)")))
(f (if *dabbrevs-case-fold* #'string-equal #'string=)))
(save-excursion
(goto-char (point-min))
(while (scan-buffer regexp :case-fold case-fold
:tail t :left-bound :symbol :regexp t)
(let ((from (point))
(text (buffer-substring (point) (save-excursion (skip-syntax-spec-forward "w_") (point)))))
(unless (or (zerop (length text))
(gethash text match-table)
(> (length abbrev) (length text))
(and abbrev (not (funcall f abbrev text :end2 (length abbrev)))))
(setf (gethash text match-table) from)
(push text matches))))
matches)))
(defun dmc-popup ()
(interactive "*")
(let ((end (point))
(start (save-excursion (skip-syntax-spec-backward "w_") (point)))
(name (dmc-instance-name)))
(unless name
(return-from dmc-popup nil))
(let ((match-table (make-hash-table :test (if *dabbrevs-case-fold* #'equalp #'equal)))
matches abbrev)
(when (/= start end)
(setq abbrev (buffer-substring start end))
(setf (gethash abbrev match-table) start))
(setq matches (dmc-find-all-candidates name abbrev *dabbrevs-case-fold* match-table start nil))
(unless *dabbrev-popup-this-buffer-only*
(let ((curbuf (selected-buffer))
(case-fold *dabbrevs-case-fold*)
(syntax-table (syntax-table)))
(with-set-buffer
(with-interval-message (300)
(save-excursion
(dolist (buffer (buffer-list))
(unless (eq buffer curbuf)
(message "Searching (~A)..." (buffer-name buffer))
(set-buffer buffer)
(save-excursion
(let ((osyntax-table (syntax-table)))
(unwind-protect
(progn
(use-syntax-table syntax-table nil t)
(setq matches (dmc-find-all-candidates
name abbrev case-fold match-table nil matches)))
(use-syntax-table osyntax-table nil t))))))))))
(clear-message))
(if matches
(popup-completion-list-loop (sort matches #'string-lessp) start end)
(plain-error "ないよん")))))
(defun popup-list-loop-2 (list callback &optional point with-insert (base ""))
(let ((add "") (matched list) matched1 selected input str)
(loop
(if with-insert (insert add))
(popup-list matched (lambda (x) (setq selected x)) point) ; #\ESC
(refresh-screen)
(while (not (or selected (setq input (read-char-no-hang *keyboard*))))
(do-events))
(if with-insert (delete-region (- (point) (length add)) (point)))
(cond (selected
(funcall callback selected)
(if (eq input #\SPC) (unread-char input))
(return t))
; ((eq input #\ESC) (return nil))
((eq input #\C-h) (unless (zerop (length add)) (setq add (substring add 0 -1))))
((graphic-char-p input) (setq add (format nil "~A~C" add input)))
(t (unread-char input) (return nil)))
(setq str (concat base add))
(setq matched1 (remove-if (lambda (x)
(or (< (length x) (length str))
(string/= x str :end1 (length str))))
list))
(if (endp matched1) (if with-insert
(progn (funcall callback str) (return t))
(setq add (substring add 0 -1)))
(setq matched matched1)))))
(defun popup-completion-list-loop (list from &optional (to from))
(let ((buffer (selected-buffer))
(point (point)))
(popup-list-loop-2 list #'(lambda (string)
(when (and (eq buffer (selected-buffer))
(= point (point)))
(let ((l (- to from)))
(when (and (>= (length string) l)
(save-excursion
(goto-char from)
(looking-for (subseq string 0 l))))
(incf from l)
(setq string (subseq string l))))
(delete-region from to)
(insert string)
(refresh-screen)))
from
t
(buffer-substring from to))
))
update : 2006-08-18 (Fri) 00:00:00
Source of Nothingness
NANRI
NANRI