;;; -*- Mode: Lisp; Last modified: <2007/12/31 01:13:20> -*-
;;;
;;; This file is not part of xyzzy.
;;;
;;;   clipselect.l --- 僋儕僢僾儃乕僪棜楌偐傜慖戰偟偰揬傝晅偗
;;;
;;;     by HIE Masahiro <madoinu@ybb.ne.jp>
#|

仭奣梫

  xyzzy 偍傛傃偦偺懠偺傾僾儕働乕僔儑儞偑僋儕僢僾儃乕僪偵僐僺乕偟偨
  僨乕僞偺棜楌傪嶌惉偟丄億僢僾傾僢僾儕僗僩偐傜慖戰偟偰揬傝晅偗傑偡丅

  僙儗僋僔儑儞偑偁傟偽丄忋彂偒偟偰揬傝晅偗傑偡丅

  婛偵棜楌偵懚嵼偡傞暥帤楍傪僐僺乕偟偨応崌偼丄婛懚偺梫慺傪嶍彍偟偰丄
  偁傜偨傔偰愭摢梫慺偲偟偰捛壛偟傑偡丅

  暥帤楍偺拞偵夵峴偑娷傑傟傞応崌偼丄巜掕偟偨暥帤偵抲偒姺偊偰儕僗僩
  偵昞帵偟傑偡丅

  儕僗僩偵昞帵偝傟傞暥帤悢偼丄*clipselect-string-length* 偱巜掕偟偨
  抣傑偱偟偐昞帵偟傑偣傫丅暥帤楍偑徣棯偝傟偰偄傞応崌偼丄枛旜偵 " ..."
  傪昞帵偟傑偡丅

  nonentity 偝傫偺丄乽傑偄偔傠偪偭傉偡xyzzy晹栧乿
         http://members.tripod.co.jp/zauberer/microtips/xyzzy.html
  偵偁傞 clipstore.l 傪嶲峫偵丄clipview.l 傪巊傢偣偰偄偨偩偒偮偮丄
  偮偔偭偰傒傑偟偨丅nonentity 偝傫偵偼丄clipview.l 偺摨帪攝晍傕夣戻
  偟偰偄偨偩偒姶幱偱偡丅

  偍傑偗偱偮偗偨 clipselect-yank 偼丄恵揷偝傫
                              http://member.nifty.ne.jp/seiya-suda/
  偺 yank-select 傪嶲峫偵偝偣偰偄偨偩偒傑偟偨丅偙偪傜偼丄僉儖儕儞僌
  偐傜慖戰偟偰揬傝晅偗傑偡丅


仭僀儞僗僩乕儖

  1. clipview.l 偲 clipselect.l 傪 ~/site-lisp 偵僐僺乕偡傞丅

  2. .xyzzy 偐 siteinit.l 偵埲壓偺婰弎傪捛壛偡傞丅

      (require "clipselect")

巊偄曽:

  丒棜楌偐傜慖戰偟偰揬傝晅偗  M-x clipselect
  丒clipboard 偲摨婜壔愗懼    M-x clipselect-toggle-sync

仭愝掕椺

  丒僉乕僶僀儞僪

      (define-key ctl-x-map #\Insert 'clipselect-paste)
      (define-key ctl-x-map #\y 'clipselect-yank)
      (define-key ctl-x-map #\F9 'clipselect-yank-selection)

    偲偐丅


仭峏怴棜楌

  [Version 1.05] 2007-12-31 (寧)
  丒儔僀僙儞僗忦崁(MIT儔僀僙儞僗)傪婰嵹丅

  [Version 1.04.1] 2004/07/04 (擔)
  丒曇廤儊僯儏乕偵傕捛壛偱偒傞傛偆偵偟偨丅
  丒乽僙儗僋僔儑儞儕儞僌偐傜揬傝晅偗乿傕摨崼偟偨丅
  丒clipselect 傪 clipselect-paste 偵曄峏偟偨丅

  [Version 2003.05.13]
  丒塃僋儕僢僋儊僯儏乕傊捛壛偟偨丅
  丒yankselect 傪 clipselect-yank 偵曄峏偟偨丅

  [Version 1.03] 2003/04/09 (悈)
  丒儕僗僩偺昞帵暥帤悢傪惂尷偡傞偨傔偵丄傪 popup-menu 傪巊偆傛偆偵偟偨丅
  丒夵峴傪暿偺暥帤偵抲偒姺偊偰昞帵偱偒傞傛偆偵偟偨丅
  丒clipselect-sync 傪 clipselect-toggle-sync 偵曄峏偟偨丅
  丒偍傑偗偱丄yankselect 傪偮偗偨丅
  丒摨崼偺 clipview.l 傪怴偟偄傕偺偵偟偨丅乮nonentity 偝傫偁傝偑偲偆偛偞偄傑偡丅乯

  [Version 1.02.1] 2003/01/15 (悈)
  丒廔椆張棟梡 hook 偺捛壛/嶍彍傪挌擩偵偡傞傛偆偵偟偨丅

  [Version 1.02] 2003/01/15 (悈)
  丒屻偐傜婲摦偟偨 xyzzy 傪愭偵廔椆偝偣傞偲丄clipboard 偲摨婜偑庢傟
    側偔側傞晄嬶崌傪廋惓偟偨丅乮偮傕傝乯

  [Version 1.01] 2003/01/14 (壩)
  丒clipselect-copy, clipselect-kill 偑晄梫側偙偲偵崱崰婥晅偒嶍彍偟偨丅
  丒*clipselect-sync*, clipselect-sync 傪捛壛偟偨丅
  丒僨乕僞枛旜偺儂儚僀僩僗儁乕僗偍傛傃夵峴傪嶍彍偟側偄傛偆偵偟偨丅
  丒clipselect-clear, *clipselect-enable-self-owner* 傪嶍彍偟偨丅
  丒clipselect-viewer-hook 傪嶍彍偟丄clipselect-push 偵傑偲傔偨丅

  [Version 1.00] 2002/12/30 (寧)
  丒偮偔偭偨丅


仭儔僀僙儞僗

  clipselect.l 偼MIT儔僀僙儞僗偵婎偯偄偰棙梡壜擻偱偡丅
  <http://www.opensource.org/licenses/mit-license.php>

Copyright (c) 2002-2007 HIE Masahiro

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.

|#

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require "clipview"))

(provide "clipselect")


;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;
;;;  仭 曄悢愝掕乮揔摉偵僇僗僞儅僀僘偡傞偁偨傝乯
;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;

;;; xyzzy 婲摦帪偵 clipboard 偲摨婜傪奐巒
(defvar *clipselect-sync* t)

;;; 曐懚偡傞棜楌偺悢
(defvar *clipselect-ring-max* 16)

;;; 億僢僾傾僢僾儊僯儏乕偺昞帵暥帤悢
(defvar *clipselect-string-length* 50)

;;; 夵峴傪抲偒姺偊傞暥帤
(defvar *clipselect-new-line-char* "劔")

;;; 曇廤儊僯儏乕傊捛壛偡傞
(defvar *clipselect-add-menu* t)

;;; 僔儑乕僩僇僢僩儊僯儏乕傊捛壛偡傞
(defvar *clipselect-add-popup-menu* t)

;;; 儊僯儏乕憓擖埵抲
(defvar *clipselect-menu-position* 4)

(defvar *clipselect-ring* nil)


;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;
;;;  仭 僋儕僢僾儃乕僪棜楌憖嶌
;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;

(defun clipselect-paste ()
  "clipselect: 僋儕僢僾儃乕僪偺棜楌偐傜慖戰偟偰揬傝晅偗"
  (interactive "*")
  (let ((menu (create-popup-menu nil))
	from to)
    (dotimes (arg (length *clipselect-ring*))
      (let* ((str (string (nth arg *clipselect-ring*)))
	     (shortstr (if *clipselect-new-line-char*
			   (substitute-string str "\n" *clipselect-new-line-char*)
			 str)))
	(add-menu-item menu 'clipselect
		       (if (< (length shortstr) *clipselect-string-length*)
			   shortstr
			 (concat (substring shortstr 0 *clipselect-string-length*) " ..."))
		       #'(lambda ()
			   (interactive)
			   (selection-start-end (start end)
			     (delete-region start end))
			   (insert str)))))
    (track-popup-menu menu)))

;;; 媽娭悢柤偲偺屳姺
(setf (symbol-function 'clipselect) 'clipselect-paste)

#|
;;; 慜偵巊偭偰偨傕偺
(defun clipselect-paste ()
  "clipselect: 僋儕僢僾儃乕僪偺棜楌偐傜慖戰偟偰揬傝晅偗"
  (interactive "*")
  (let (from to)
    (selection-start-end (start end)
      (setq from start)(setq to end))
    (popup-list *clipselect-ring*
		#'(lambda (str)
		    (when (and from to)
		      (delete-region from to))
		    (insert str)
		    (refresh-screen)))))
|#

(defun clipselect-toggle-sync ()
  "clipselect: 僋儕僢僾儃乕僪偲偺摨婜傪愗傝懼偊"
  (interactive)
  (if *clipselect-sync*
      (progn (setq *clipselect-sync* nil)
	(win-user::delete-clipboard-viewer-hook 'clipselect-push)
	(delete-hook '*kill-xyzzy-hook* 'clipselect-exit)
	(message "clipselect-sync stop."))
    (progn (setq *clipselect-sync* t)
      (win-user::add-clipboard-viewer-hook 'clipselect-push)
      (add-hook '*kill-xyzzy-hook* 'clipselect-exit)
      (message "clipselect-sync start."))))

(defun clipselect-push ()
  (let ((str (get-clipboard-data)))
    (when str
      (setq *clipselect-ring* (remove str *clipselect-ring* :test #'string=))
      (setq *clipselect-ring*
	    (ed::push-kill-ring str *clipselect-ring* *clipselect-ring-max*)))))

(defun clipselect-exit ()
  (win-user::delete-clipboard-viewer-hook 'clipselect-push))


;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;
;;;  仭 *kill-ring*/*selection-ring* 憖嶌
;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;

(defun clipselect-yank ()
  "clipselect: 僉儖儕儞僌偐傜慖戰偟偰揬傝晅偗"
  (interactive "*")
  (let ((menu (create-popup-menu nil))
	from to)
    (dotimes (arg (length *kill-ring*))
      (let* ((str (car (ed::current-kill arg t)))
	     (shortstr (if *clipselect-new-line-char*
			   (substitute-string str "\n" *clipselect-new-line-char*)
			 str)))
	(add-menu-item menu 'yankselect
		       (if (< (length shortstr) *clipselect-string-length*)
			   shortstr
			 (concat (substring shortstr 0 *clipselect-string-length*) " ..."))
		       #'(lambda ()
			   (interactive)
			   (selection-start-end (start end)
			     (delete-region start end))
			   (insert str)))))
    (track-popup-menu menu)))

(defun clipselect-yank-selection ()
  "clipselect: 僙儗僋僔儑儞儕儞僌偐傜慖戰偟偰揬傝晅偗"
  (interactive "*")
  (let ((menu (create-popup-menu nil))
	from to)
    (dotimes (arg (length *selection-ring*))
      (let* ((str (cdr (ed::current-selection arg t)))
	     (shortstr (if *clipselect-new-line-char*
			   (substitute-string str "\n" *clipselect-new-line-char*)
			 str)))
	(add-menu-item menu 'clipselect2
		       (if (< (length shortstr) *clipselect-string-length*)
			   shortstr
			 (concat (substring shortstr 0 *clipselect-string-length*) " ..."))
		       #'(lambda ()
			   (interactive)
			   (selection-start-end (start end)
			     (delete-region start end))
			   (insert str)))))
    (track-popup-menu menu)))


;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;
;;;  仭 儊僯儏乕
;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;

;;; 曇廤儊僯儏乕偵捛壛
;;;   OHKUBO 偝傫偺 multiple-replace.l 偐傜捀偒 m(_ _)m
(defun clipselect-insert-menu (&key menu position head-sep tail-sep)
  (if (and (not (menup menu)) (menup *app-menu*))
      (setq menu (get-menu *app-menu* 'ed::edit)))
  (when (menup menu)
    ;(clipselect-delete-menu menu)
    (unless (and (numberp position) (integerp position) (not (minusp position))
		 (get-menu menu position t))
      (setq position -1)
      (while (get-menu menu (incf position) t)))
    (decf position)
    (if (and head-sep
	     (not (minusp position))
	     (get-menu menu position t))
	(insert-menu-separator menu (incf position) 'clipselect-sep))
    (insert-menu-item menu (incf position) nil
		      "棜楌偐傜慖戰偟偰揬傝晅偗(&H)..."
		      'clipselect-paste
		      #'(lambda ()
			  (unless *clipselect-ring*
			    :disable)))
    (insert-menu-item menu (incf position) nil
		      "僉儖儕儞僌偐傜慖戰偟偰揬傝晅偗(&K)..."
		      'clipselect-yank
		      #'(lambda ()
			  (unless *kill-ring*
			    :disable)))
    (insert-menu-item menu (incf position) nil
		      "僙儗僋僔儑儞儕儞僌偐傜慖戰偟偰揬傝晅偗(&Y)..."
		      'clipselect-yank-selection
		      #'(lambda ()
			  (unless *selection-ring*
			    :disable)))
    (if (and tail-sep
	     (get-menu menu (incf position) t))
	(insert-menu-separator menu position 'clipselect-sep))))

;;; 僔儑乕僩僇僢僩儊僯儏乕偵捛壛
(defun clipselect-insert-popup-menu ()
  (let (pos menu)
    (setq pos *clipselect-menu-position*)
    (setq menu *app-popup-menu*)
    (setq pos (1- pos))
    (insert-menu-separator menu (incf pos))
    (insert-menu-item menu (incf pos) nil
		      "棜楌偐傜慖戰偟偰揬傝晅偗(&H)..."
		      'clipselect-paste
		      #'(lambda ()
			  (unless *clipselect-ring*
			    :disable)))
    (insert-menu-item menu (incf pos) nil
		      "僉儖儕儞僌偐傜慖戰偟偰揬傝晅偗(&K)..."
		      'clipselect-yank
		      #'(lambda ()
			  (unless *kill-ring*
			    :disable)))
    (insert-menu-item menu (incf pos) nil
		      "僙儗僋僔儑儞儕儞僌偐傜慖戰偟偰揬傝晅偗(&Y)..."
		      'clipselect-yank-selection
		      #'(lambda ()
			  (unless *selection-ring*
			    :disable)))
    (insert-menu-separator menu (incf pos))))


;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;
;;;  仭 婲摦帪偺張棟
;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;

(defun clipselect-init ()
  (when *clipselect-add-menu*
    (clipselect-insert-menu :position 7 :head-sep t :tail-sep t))
  (when *clipselect-add-popup-menu*
    (clipselect-insert-popup-menu))
  (when *clipselect-sync*
    (win-user::add-clipboard-viewer-hook 'clipselect-push)
    (add-hook '*kill-xyzzy-hook* 'clipselect-exit)))

(add-hook '*init-app-menus-hook* #'clipselect-init)


;;; clipselect.l ends here.
