;;; lisp file for xyzzy ver0.2.2.233
;;; extend-copy.l ver0.1.0.3 // for text-mode or else mode // crayonzen [2006-06-16]01:35:34(+0900)

(provide "extend-copy")

(in-package "editor")

(export '(copy-selection-and-to-clipboard
	  kill-selection-and-to-clipboard
	  ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;拡張コピー＆カット＆ペースト
;;クリップボードと*selection-ring*に同時に格納する。
;;F7                  kill-selection
;;F8                  copy-selection
;;F9                  yank-selection
;;矩形の*selection-ring*は通常のペーストのみ。

;;;;(Esc-w コピー　C-w カット)のyankと似た仕様にする。
;;;;yankの仕様(C-y 'yank ペースト　M-y 'yank-pop　*kill-ring*ペースト)

;;キー設定例
;;M-vを*selection-ring*ペーストに設定
;;(global-set-key #\M-v 'yank-selection-and-pop);順にペースト(格納は消去される)
;;もしくは
;;ring-popup-menu.lファイルを使ってポップアップ。
;;(load-library "ring-popup-menu")
;;(global-set-key #\M-y 'kill-ring-popup-menu)
;;(global-set-key #\M-v 'selection-ring-popup-menu)

(defun copy-selection-and-to-clipboard ()
  (interactive)
  (when (pre-selection-p)
    (cond ((eql (get-selection-type) 3) ;矩形
	   (let ((*dont-clear-selection* t))
	     (rectangle-selection-to-clipboard #'copy-rectangle-selection) ;clipboard
	     (copy-rectangle-selection)
	     (let ((string (get-clipboard-data))) ;selection-ring (from clipboard)
	       (when string
		 (selection-new 2 string)))
	     (if *shodat-copy-mode*
		 (continue-pre-selection)
	       (stop-selection))))
	  (t
	   (let ((type (get-selection-type)))
	     (selection-start-end (start end) ;clipboard
	       (copy-region-to-clipboard start end)
	       (start-selection type t end))
	     (selection-start-end (start end) ;selection-ring
	       (selection-new type (buffer-substring start end))
	       (if *shodat-copy-mode*
		   (start-selection type t end))
	       )))
	  ))
  t)

(defun kill-selection-and-to-clipboard ()
  (interactive)
  (cond ((eql (get-selection-type) 3) ;矩形
	 (if (pre-selection-p)
	   (let ((*dont-clear-selection* t))
	     (rectangle-selection-to-clipboard #'copy-rectangle-selection) ;clipboard
	     (let ((string (get-clipboard-data))) ;selection-ring (from clipboard)
	       (when string
		 (selection-new 2 string)))
	     (kill-rectangle-selection))))
	(t
	 (let ((type (get-selection-type)))
	   (selection-start-end (start end) ;selection-ring
	     (selection-new type (buffer-substring start end))
	     (start-selection type t end))
	   (selection-start-end (start end) ;clipboard　killしてclipboardなのでringより後に
	     (kill-region-to-clipboard start end))))
	)
  t)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;矩形のring格納処理
;;yank-selectionでのペーストで「貼り付け-矩形」はないので
;;ringへの格納だけでよく、行モード、文字モードは関係ないので、とりあえず通常の2に設定。
;;（補足：モード設定はringに格納される。行モードの1だとペーストの時に行頭からペースト）

;;(eql (get-selection-type) 3) rectangle
;;(eql (get-selection-type) 2) normal select (selection-point)(selection-mark)
;;(eql (get-selection-type) 1) (selection-point)(selection-mark)->(goto-virtual-bol)(point)
;;region.l:20:(defvar *kill-ring-max* 16)
;;select.l:59:(defvar *selection-ring-max* 16)

;;  nil   選択なし、
;;  1     行モード選択状態
;;  2     文字モード選択状態
;;  3     矩形選択状態
;;行モード選択状態 start-selection-as-line

;;矩形
;;copy-selection -> copy-rectangle-selection -> (operate-on-rectangle-selection :copy t)
;;operate-on-rectangle-selection (&key copy delete clear open string) ->
;;operate-on-rectangle (p1 p2 c1 c2 &key copy delete clear open string)
;;