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>
