;;; -*- Mode: Lisp; Last modified: <2007/12/31 01:12:59> -*-
;;;
;;; This file is not part of xyzzy.
;;;
;;;   rv-region.l --- 儕乕僕儑儞傪斀揮昞帵
;;;
;;;     by HIE Masahiro <madoinu@ybb.ne.jp>
#|

仭奣梫

  儕乕僕儑儞傪斀揮昞帵偡傞丅偦偟偰丄偦傟側傝偵夝彍偡傞丅
  偦偆偟偨偗傟偽丄儕乕僕儑儞偺嶌惉偲摨帪偵僙儗僋僔儑儞傕嶌惉偡傞丅


仭僀儞僗僩乕儖

  1. rv-region.l 傪 ~/site-lisp 偵僐僺乕偡傞丅

  2. 昁梫側傜偽僶僀僩僐儞僷僀儖偡傞丅

       M-x byte-compile-file

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

      (require "rv-region")


仭巊偄曽

  儕乕僕儑儞偺斀揮傪奐巒偡傞偨傔偵丄乽偦偺侾乿傑偨偼乽偦偺俀乿偺愝掕
  傪峴偆丅

  儕乕僕儑儞丄僙儗僋僔儑儞丄嬮宍丄儅僂僗娭學摍偺僐儅儞僪傪幚峴偡傞偲丄
  斀揮昞帵偑夝彍偝傟傞丅

  嫮惂揑偵斀揮昞帵傪巭傔傞応崌偼丄C-g 偡傞丅

  斀揮昞帵怓偼丄乽僯僙斀揮怓乿偱愝掕偝傟偨傕偺丅偟偐偟丆[嫟捠愝掕
  ][昞帵][偪傖傫偲斀揮偡傞]偵僠僃僢僋偑擖偭偰偄傞偲丄乽僯僙斀揮怓乿
  偼巊梡偝傟側偄傛偆偱偡丅


  偦偺侾

  斀揮昞帵奐巒梡僐儅儞僪幚峴帪偺傒丄斀揮昞帵傪奐巒偡傞丅埲壓偺愝掕
  偱偼丄C-@ 偱儅乕僋傪愝掕偡傞偲丄儕乕僕儑儞偺斀揮昞帵傪奐巒偡傞丅
  偦偺懠偺僐儅儞僪偱儅乕僋傪愝掕偟偨応崌偼丄斀揮昞帵偟側偄丅

    (global-set-key #\C-@ 'rv-set-mark-command)

  偙偺愝掕偱偼丄斀揮昞帵奐巒屻丄斀揮昞帵偑夝彍偝傟傞傑偱偺娫偺傒丄
  斀揮昞帵夝彍梡僐儅儞僪偑丄*post-command-hook* 偵愝掕偝傟偰偄傞丅

  *post-command-hook* 傊偺愝掕僐儅儞僪傪乮xyzzy 傊偺晧壸傪乯丄嬌椡
  尭傜偟偨偄曽偵偼丄偙偪傜偺曽偑椙偄偐傕丅


  偦偺俀

  儅乕僋僙僢僩屻偼昁偢斀揮昞帵傪奐巒偡傞丅埲壓偺愝掕傪偡傞偲丄
  *rv-start-command-list* 偵搊榐偝傟偨僐儅儞僪傪幚峴屻丄儕乕僕儑儞
  偺斀揮昞帵傪奐巒偡傞丅

    (setq *rv-region-stay-on* t)

  偙偺愝掕偱偼丄忢帪丄斀揮昞帵奐巒梡僐儅儞僪偑丄*post-command-hook*
  偵愝掕偝傟偰偄傞丅

  斀揮昞帵懸婡偺掆巭/奐巒偼丄M-x rv-toggle-watch 偡傞丅


仭愝掕椺

  丒儕乕僕儑儞偺嶌惉偲摨帪偵僙儗僋僔儑儞傕嶌惉偟丄斀揮昞帵偼僙儗僋
    僔儑儞偵擟偡丅

      (setq *rv-region-use-selection* t)

  丒斀揮傪巭傔傞僐儅儞僪幚峴屻傕丄師偺僐儅儞僪幚峴傑偱斀揮昞帵傪懕
    偗傞丅

      (setq *rv-region-keep-reverse* t)

  丒斀揮昞帵傪奐巒偡傞僐儅儞僪傪捛壛偡傞丅乮乽偦偺俀乿偺応崌偵桳岠乯

      (pushnew 'command *rv-start-command-list*)

  丒斀揮昞帵傪巭傔傞僐儅儞僪傪捛壛偡傞丅

      (setq *rv-exit-command-list* (list 'command1 'command2))

  丒斀揮昞帵傪懕偗傞僐儅儞僪傪捛壛偡傞丅

      (setq *rv-continue-command-list* (list 'command1 'command2))

  丒斀揮偝傟偰偄側偄儕乕僕儑儞偵懳偟斀揮傪奐巒偡傞丅(M-R)

      (global-set-key #\M-R 'rv-restart)

  丒斀揮偝傟偰偄側偄儕乕僕儑儞傪堦帪揑偵斀揮偡傞丅(M-V)

      (global-set-key #\M-V 'rv-check)


仭峏怴棜楌

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

  [Version 2.03.2] 2004/04/09
  丒*rv-exit-command-regexp* 偵丆register 傪捛壛偟偨丅

  [Version 2.03.1] 2003/04/19
  丒*rv-exit-command-regexp* 偵丄tabify 傪捛壛偟偨丅

  [Version 2.03] 2003/01/28
  丒rv-restart 偺捛壛偍傛傃張棟偑偄偔傜偐偱傕寉偔側傞偙偲傪婅偭偰
    rv-region-command 傪彂偒捈偟偰傒偨丅
  丒*rv-exit-command-regexp* 偵偄偔傜偐捛壛偟偨丅
  丒rv-region-toggle-watch 傪 rv-toggle-watch 偵曄峏偟偨丅
  丒rv-region-check 傪 rv-check 偵曄峏偟偨丅
  丒乽巊偄曽乿偺乽偦偺侾乿偲乽偦偺俀乿傪擖懼偊丄乽偦偺侾乿傪偍僗僗儊
    偲偟偨丅

  [Version 2.02.1] 2003/01/26
  丒2.02 偱廋惓偱偒偰偄側偐偭偨偺傪廋惓偟偨丅
    偐偓傢偩偝傫偑徻偟偔彂偄偰偔傟偰偄偨偺偵丏丏丏丅;(;_;);

  [Version 2.02] 2003/01/26 (擔)
  丒*rv-region-use-selection* 傪 t 偵偟偰偄傞偲丄set-mark-command
    偱偟偐斀揮昞帵乮僙儗僋僔儑儞乯偑奐巒偝傟側偄偺傪廋惓偟偨丅

  [Version 2.01] 2003/01/26 (擔)
  丒偐偓傢偩偝傫偺傪嶲峫偵丄儕乕僕儑儞偺嶌惉偲摨帪偵僙儗僋僔儑儞傕
    嶌惉偟丄斀揮昞帵偼僙儗僋僔儑儞偵擟偡偙偲傕偱偒傞傛偆偵偟偨丅
  丒rv-region-start, rv-region-stop 傪 interactive 偱側偔偟偨丅

  [Version 2.00] 2003/01/22 (悈)
  丒TKI 偝傫偺傪嶲峫偵丄儅乕僋傪愝掕偡傞僐儅儞僪偺幚峴傪懸偭偰儕乕
    僕儑儞偺斀揮昞帵傪奐巒偡傞偙偲傕偱偒傞傛偆偵偟偨丅
  丒斀揮傪巭傔傞僐儅儞僪幚峴屻傕丄師偺僐儅儞僪幚峴傑偱斀揮昞帵傪懕
    偗傞偙偲傕偱偒傞傛偆偵偟偨丅
  丒嬮宍張棟幚峴屻偵傕丄斀揮昞帵傪夝彍偡傞傛偆偵偟偨丅
  丒偦偺懠偄傠偄傠丅

  [Version 1.02] 2003/01/18 (搚) 栭
  丒廔椆偡傞僐儅儞僪傪慡偰楍婰偟側偄偱丄戝懱偱敾抐偡傞傛偆偵偟偨丅
  丒*rv-continue-command-list* 傪捛壛偟偨丅

  [Version 1.01] 2003/01/18 (搚) 挬
  丒rv-quit 傪嶍彍偟偨丅

  [Version 1.00] 2003/01/17 (嬥)
  丒偮偔偭偨丅


仭儔僀僙儞僗

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

Copyright (c) 2003-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.
|#

(provide "rv-region")

;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;
;;;  仭 曄悢愝掕
;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;

(defvar *rv-region-stay-on* nil
  "rv-region: 儅乕僋僙僢僩屻偼忢偵斀揮昞帵傪奐巒")

(defvar *rv-region-keep-reverse* nil
  "rv-region: 師偺僐儅儞僪幚峴傑偱斀揮昞帵傪懕偗傞")

(defvar *rv-region-use-selection* nil
  "rv-region: 儕乕僕儑儞偲僙儗僋僔儑儞傪摨帪偵嶌惉偡傞")

(defvar *rv-start-command-list*
  (list 'set-mark-command 'mark-paragraph 'mark-page 'mark-defun
	'mark-sexp 'mark-word 'mark-whole-buffer 'rv-restart)
  "rv-region: 斀揮昞帵傪奐巒偡傞僐儅儞僪偺儕僗僩")

(defvar *rv-exit-command-list* nil
  "rv-region: 斀揮昞帵傪巭傔傞僐儅儞僪偺儕僗僩")

(defvar *rv-continue-command-list* nil
  "rv-region: 斀揮昞帵傪懕偗傞僐儅儞僪偺儕僗僩")

(defvar *rv-exit-command-regexp*
  (compile-regexp (concat
		   "\\(quit\\|self-insert-command"
		   "\\|.*\\(region\\|selection\\|rectangle\\|mouse\\|newline\\|indent\\|tabify\\|register\\).*\\)"))
  "rv-region: 斀揮昞帵傪巭傔傞僐儅儞僪傪昞偡惓婯昞尰")


;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;
;;;  仭 儕乕僕儑儞斀揮昞帵梡娭悢
;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;

(defun rv-region ()
  (let ((com (if *rv-region-keep-reverse* *last-command* *this-command*)))
    (if (and (not (member com *rv-continue-command-list*))
	     (or (member com *rv-exit-command-list*)
		 (string-match *rv-exit-command-regexp* (format nil "~S" com))))
	(rv-region-stop)
      (let ((m (mark t)))
	(and m (rv-region-command m com))))))

(defun rv-region-command (m com)
  (let ((p (point)))
    (if *rv-region-use-selection*
	(if (member com (remove 'set-mark-command *rv-start-command-list*))
	    (save-excursion
	      (save-restriction
		(narrow-to-region m p)
		(if (> m p)
		    (progn
		      (goto-char (point-max))
		      (selection-beginning-of-buffer))
		  (progn
		    (goto-char (point-min))
		    (selection-end-of-buffer)))))
	  (ed::begin-selection))
      (reverse-region m p t))))

(defun rv-region-watch ()
  (let ((m (mark t))
	(com *this-command*))
    (when (and m (member com *rv-start-command-list*))
      (rv-region-start)
      (rv-region-command m com))))

(defun rv-region-start ()
  (stop-selection)
  (add-hook '*post-command-hook* 'rv-region))

(defun rv-region-stop ()
  (delete-hook '*post-command-hook* 'rv-region))


;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;
;;;  仭 懳榖揑側娭悢
;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;

(defun rv-set-mark-command ()
  "rv-region: 儅乕僋傪晅偗儕乕僕儑儞斀揮昞帵傪奐巒"
  (interactive)
  (set-mark-command)
  (rv-region-start))

(defun rv-restart ()
  "rv-region: 儕乕僕儑儞斀揮昞帵傪奐巒"
  (interactive)
  (rv-region-start))

(defun rv-check ()
  "rv-region: 斀揮偝傟偰偄側偄儕乕僕儑儞傪堦帪揑偵斀揮昞帵"
  (interactive)
  (let ((m (mark t)))
    (and m (reverse-region m (point) t))))

(defun rv-toggle-watch ()
  "rv-region: 儅乕僋僙僢僩屻忢偵斀揮昞帵偺僩僌儖"
  (interactive)
  (if *rv-region-stay-on*
      (progn
	(delete-hook '*post-command-hook* 'rv-region-watch)
	(setq *rv-region-stay-on* nil)
	(message "rv-region: off"))
    (progn
      (add-hook '*post-command-hook* 'rv-region-watch)
      (setq *rv-region-stay-on* t)
      (message "rv-region: on"))))


;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;
;;;  仭 婲摦張棟
;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;

(add-hook '*post-startup-hook*
	  #'(lambda ()
	      (when *rv-region-stay-on*
		(add-hook '*post-command-hook* 'rv-region-watch))))


;;; rv-region.l ends here.
