[XEmacs 21.2.35] gathering kill-ring and selection

XEmacs 21.2.35 から select.el や select.c が大きく変わったのに合わせて kill-ring の先端と selection を統合するプログラムを書き換えてみました。 これを使うと ・マウスでドラッグしたテキストを C-y で yank できます。 ・C-k や C-w で kill したテキストをマウスで paste できます。 ・XEmacs 以外の kterm などとも相互にやりとりすることができます。 ・ISO646 文字を ASCII に変換します。 まだ荒削りです。それと secondary-selection のことは考えていません。 (setq mouse-yank-at-point t zmacs-regions t kill-hooks '(own-selection)) (eval-when-compile (defmacro _iso646-unify-string (string) (let ((diff (- (make-char 'latin-jisx0201 33) ?!))) `(let ((regexp (format "[%c-%c]+" (make-char 'latin-jisx0201 33) (make-char 'latin-jisx0201 126)))) (with-temp-buffer (insert ,string) (goto-char (point-min)) (while (re-search-forward regexp nil t) (replace-match (mapconcat (lambda (char) (char-to-string (- char ,diff))) (match-string 0) ""))) (buffer-string)))))) (setq interprogram-paste-function (lambda () (let ((data (or (get-selection-no-error) (get-selection-no-error 'CLIPBOARD)))) (if (stringp data) (_iso646-unify-string data) (buffer-substring (car data) (cdr data) (marker-buffer (car data))))))) (defun insert-selection (&optional check-cutbuffer-p move-point-event) "Insert the current selection into buffer at point." (interactive "P") ;; we fallback to the clipboard if the current selection is not existent (let ((data (if check-cutbuffer-p (or (get-selection-no-error) (get-cutbuffer) (get-selection-no-error 'CLIPBOARD) (error "No selection, clipboard or cut buffer available")) (or (get-selection-no-error) (get-selection 'CLIPBOARD))))) (cond (move-point-event (mouse-set-point move-point-event) (push-mark (point))) ((interactive-p) (push-mark (point)))) ;; (dehilight-selection 'PRIMARY) (if (stringp data) (insert (_iso646-unify-string data)) (insert-buffer-substring (marker-buffer (car data)) (car data) (cdr data))))) (defun default-mouse-track-down-hook (event click-count) (put '_mouse-track-down-position 'window (get-buffer-window (current-buffer))) (put '_mouse-track-down-position 'position (point)) (setq default-mouse-track-down-event (copy-event event)) nil) (defun default-mouse-track-drag-up-hook (event click-count) (let* ((pair (default-mouse-track-return-dragged-selection event)) (start (car pair)) (end (cdr pair))) (if (= start end) (disown-selection 'PRIMARY) (push-mark (if (= (point) start) end start)) (let ((data (cons (set-marker (make-marker) start) (set-marker (make-marker) end)))) (own-selection data 'PRIMARY) ;; (when zmacs-regions ;; (setq primary-selection-extent ;; (select-make-extent-for-selection ;; data primary-selection-extent)) ;; (set-extent-face primary-selection-extent 'primary-selection)) ) (if (eq 'x (console-type)) (x-store-cutbuffer (buffer-substring start end))) (when (window-live-p (get '_mouse-track-down-position 'window)) (select-window (get '_mouse-track-down-position 'window)) (goto-char (get '_mouse-track-down-position 'position))))) t) -- Katsumi Yamaoka <yamaoka(a)jpl.org&gt;