tnoda · October 26, 2015 17:34
diff --git a/mell.el b/mell.el
 ;;; mell.el --- MELL Emacs Lisp Library
 ;;
 ;; AUTHOR:  Hiroyuki Komatsu <[email protected]>
 ;; LICENCE: GPL2
 ;; $Id: mell.el,v 1.4 2003/03/18 03:34:45 komatsu Exp $
 ;; Version: 1.4.0
 ;;

 ;; ------------------------------------------------------------
 ;; XEmacs と FSF Emacs の差異を吸収
 ;; ------------------------------------------------------------

 ;; Checking Emacs or XEmacs.
 (if (not (boundp 'running-xemacs))
    (defconst running-xemacs nil))

 ;; line-end-position  for XEmacs
 (if (not (fboundp 'line-end-position))
    (defun line-end-position (&optional arg)
      (point-at-eol (or arg 1))))

 ;; define-obsolete-function-alias for FSF Emacs
 (if (not (fboundp 'define-obsolete-function-alias))
    (defun define-obsolete-function-alias (obsolete current)
      (defalias obsolete current)
      (make-obsolete obsolete current))
  )

 ;; add-local-hook
 (or (fboundp 'add-local-hook)
    (defun add-local-hook (hook function &optional append)
      (make-local-hook hook)
      (add-hook hook function append t))
    )

 ;; remove-local-hook
 (or (fboundp 'remove-local-hook)
    (defun remove-local-hook (hook function)
      (if (local-variable-p hook (current-buffer))
 	  (remove-hook hook function t)))
    )
 ;; ------------------------------------------------------------
 ;; mell (basic)
 ;; ------------------------------------------------------------
 (defcustom mell-working-buffer-name " *mell-buffer*"
  "Working buffer name for mell")
 (defvar    mell-working-buffer nil
  "working buffer for mell")

 (defun mell-check-value (value)
  (and (boundp value)
       (symbol-value value)))

 (defun mell-defvar (symbol value &optional doc-string)
  (if (not (boundp symbol))
      (set symbol value))
  (if doc-string
      (put symbol 'variable-documentation doc-string))
  symbol)

 (defun mell-defvar-locally (symbol initvalue &optional docstring)
  (mell-defvar symbol initvalue docstring)
  (make-variable-buffer-local symbol)
  symbol)

 (defun mell-require (feature &optional filename noerror)
  (or (featurep feature)
      (if noerror
 	  (condition-case nil
 	      (require feature filename)
 	    (file-error nil)
 	    )
 	(require feature filename)
 	)))

 (defun mell-point-at-bol (&optional point)
  (save-excursion
    (or point (goto-char point))
    (beginning-of-line)
    (point)
    ))

 (defun mell-point-at-eol (&optional point)
  (save-excursion
    (or point (goto-char point))
    (end-of-line)
    (point)
    ))

 (defun mell-point-at-bop (&optional point)
  (save-excursion
    (goto-char (or point (point)))
    (backward-paragraph 1)
    (point)))

 (defun mell-point-at-eop (&optional point)
  (save-excursion
    (goto-char (or point (point)))
    (forward-paragraph 1)
    (point)))

 (defun mell-column-at-point (point &optional buffer)
  (save-excursion
    (and buffer (set-buffer buffer))
    (goto-char point)
    (current-column)
    ))

 (defun mell-point-at-column (column &optional point buffer)
  (save-excursion
    (and buffer (set-buffer buffer))
    (and point (goto-char point))
    (move-to-column column)
    (point)
    ))

 ;; mell-marker
 (defun mell-marker-make (&optional position buffer type)
  (let ((marker (make-marker)))
    (or position
 	(setq position (point)))
    (set-marker marker position buffer)
    (set-marker-insertion-type marker type)
    marker
    ))

 (defun mell-marker-set (marker &optional position buffer type)
  (or (and (boundp marker) (markerp (symbol-value marker)))
      (set marker (make-marker)))
  (or position
      (setq position (point)))
  (set-marker (symbol-value marker) position buffer)
  (set-marker-insertion-type (symbol-value marker) type)
  (eval marker)
  )

 ;; ------------------------------------------------------------

 ;; mell-sublist
 (if (functionp 'sublist)
    (defalias 'mell-sublist 'sublist)
  (defun mell-sublist (list start &optional end)
    (if (< start 0)
 	(setq start (+ start (length list))))
    (if (null end)
 	(nthcdr start (copy-sequence list))
      (and end (< end 0) 
 	   (setq end (+ end (length list))))
      (let (sublist tmp)
 	(if (> start end)
 	    (progn (setq tmp start)
 		   (setq start end)
 		   (setq end tmp)))
 	(while (< start end)
 	  (setq end (1- end)
 		sublist (cons (nth end list) sublist)))
 	sublist)))
  )

 ;; mell-subarray
 (if (functionp 'subarray)
    (defalias 'mell-subarray 'subarray)
  (defun mell-subarray (array start &optional end)
    (apply 'vector (mell-sublist (append array nil) start end)))
  )

 ;; mell-subseq
 (if (functionp 'subseq)
    (defalias 'mell-subseq 'subseq)
  (defun mell-subseq (seq start &optional end) ;; For Emacs20
    (cond ((stringp seq) (substring seq start end))
 	  ((listp seq)   (mell-sublist seq start end))
 	  (t             (mell-subarray seq start end))
 	  ))
  )

 ;; ------------------------------------------------------------
 ;; mell-mode
 ;; ------------------------------------------------------------

 ;; this function requires mell-alist.
 (defun mell-set-minor-mode (name modeline &optional key-map)
  (make-variable-buffer-local name)
  (setq minor-mode-alist
 	(mell-alist-add minor-mode-alist (list name modeline)))
  (and key-map
       (setq minor-mode-map-alist
 	     (mell-alist-add minor-mode-map-alist (cons name key-map)))
       )
  )

 ;; ------------------------------------------------------------
 ;; mell-region
 ;; ------------------------------------------------------------

 ;; mell-region-face
 (if running-xemacs
    (defconst mell-region-face 'zmacs-region)
  (defconst mell-region-face 'region)
  )

 ;; mell-region-active-p
 (if running-xemacs
    (defun mell-region-active-p ()
      (region-active-p))
  (defun mell-region-active-p ()
    (mell-check-value 'mark-active))
  )

 ;; mell-transient-mode-p
 (if running-xemacs
    (defun mell-transient-mode-p ()
      (mell-check-value 'zmacs-regions))
  (defun mell-transient-mode-p ()
    (mell-check-value 'transient-mark-mode))
  )

 ;; Define mell-transient-region-active-p
 (defun mell-transient-region-active-p ()
  (and (mell-transient-mode-p)
       (mell-region-active-p)))

 (define-obsolete-function-alias
  'transient-region-active-p 'mell-transient-region-active-p)

 (defun mell-transient-region-stay ()
  (and running-xemacs
       (setq zmacs-region-stays t))
  )
 ;; ------------------------------------------------------------
 ;; mell-region (applications)
 ;; ------------------------------------------------------------

 (defun mell-read-region-or-string ()
  "If active region exists, return the substring specified the region.
 Or read string from minibuffer."
  (interactive)
  (if (mell-transient-region-active-p)
      (buffer-substring (mark) (point))
    (read-string "String: " (current-word))
    ))

 (define-obsolete-function-alias
  'read-region-or-string 'mell-read-region-or-string)

 (defun mell-paragraph-string (&optional point)
  (buffer-substring (mell-point-at-bop point) (mell-point-at-eop point)))

 (defun mell-delete-paragraph (&optional point)
  (delete-region (mell-point-at-bop point) (mell-point-at-eop point)))

 (defun mell-read-region-or-paragraph ()
  "If active region exists, return the substring specified the region.
 Or return paragraph on the cursor automatically."
  (interactive)
  (if (mell-transient-region-active-p)
      (buffer-substring (mark) (point))
    (mell-paragraph-string)
    ))

 (defun mell-call-function-region-or-string (function &optional args-list)
  (apply function
 	 (prog1 (mell-read-region-or-string)
 	   (and (mell-transient-region-active-p)
 		(delete-region (point) (mark)))
 	   )
 	 args-list))

 (defun mell-call-function-region-or-paragraph (function &optional args-list)
  (if (or (mell-transient-region-active-p)
 	  (y-or-n-p "Use current paragraph? "))
      (apply function
 	     (prog1 (mell-read-region-or-paragraph)
 	       (if (mell-transient-region-active-p)
 		   (delete-region (point) (mark))
 		 (mell-delete-paragraph))
 	       )
 	     args-list)
    ""))

 (defun mell-narrow-to-transient-region (&optional begin end)
  "If active region exists, narrow-to-region"
  (setq begin (or begin (and (transient-region-active-p) (region-beginning)))
 	end   (or end   (and (transient-region-active-p) (region-end))))
  (if (and begin end)
      (progn
 	(narrow-to-region begin end)
 	(goto-char begin)
 	))
  )
  
 (defun mell-region-get-rectangle-list (start end &optional buffer)
  (save-excursion
    (and buffer (set-buffer buffer))
    (let* (rectangle-alist
 	   (column-min (min (mell-column-at-point start)
 			    (mell-column-at-point end)))
 	   (column-max (max (mell-column-at-point start)
 			    (mell-column-at-point end)))
 	   (point-min (min (mell-point-at-column column-min start)
 			   (mell-point-at-column column-min end)))
 	   (point-max (max (mell-point-at-column column-max start)
 			   (mell-point-at-column column-max end)))
 	   )
      (goto-char point-min)
      (while (< (point) point-max)
 	(move-to-column column-min)
 	(setq rectangle-alist 
 	      (cons (cons (point) (mell-point-at-column column-max))
 		    rectangle-alist))
 	(forward-line 1)
 	)
      (reverse rectangle-alist)
      )))
      
 (put 'mell-region-rectangle-while 'lisp-indent-function 1)
 (defmacro mell-region-rectangle-while (rectangle &rest body)
  `(let ((rectangle-markers
 	  (mell-region-get-rectangle-marker-list
 	   (nth 0 ,rectangle) (nth 1 ,rectangle) (nth 2 ,rectangle)))
 	 )
     (mapcar
      (lambda (region)
 	(let ((line-beginning (car region))
 	      (line-end (cdr region)))
 	  ,@body
 	  ))
      rectangle-markers)
     (mapcar
      (lambda (region)
 	(set-marker (car region) nil)
 	(set-marker (cdr region) nil)
 	)
      rectangle-markers)
     ))

 (defun mell-region-get-rectangle-marker-list (start end &optional buffer)
  (mapcar
   '(lambda (region)
      (cons (mell-marker-make (car region)) (mell-marker-make (cdr region)))
      )
   (mell-region-get-rectangle-list start end buffer))
  )

 (defun mell-region-rectangle-right-edge-p (start end)
  (save-excursion
    (let ((list (mell-region-get-rectangle-list start end))
 	  (result t))
      (while (and list
 		  (progn (goto-char (cdr (car list)))
 			 (eolp)))
 	(setq list (cdr list))
 	)
      (null list)
      )))

 (put 'mell-save-region 'lisp-indent-function 0)
 (defmacro mell-save-region (&rest body)
  `(let ((mark (mark))
 	(active-p (mell-transient-region-active-p))
 	(cur-buffer (current-buffer))
 	global-mark-ring mark-ring
 	kill-ring kill-ring-yank-pointer
 	overlay)
    (if active-p
 	(setq overlay (mell-sign-region-highlight (mark) (point)))
      )
    ,@body
    (if active-p
 	(progn
 	  (mell-transient-region-activate)
 	  (mell-sign-region-highlight-off overlay)
 	  ))
    ))

 ;; ------------------------------------------------------------
 ;; mell-match
 ;; ------------------------------------------------------------

 (defun mell-match-count-string (regexp string)
  (save-match-data
    (let ((i 0) (n 0))
      (while (and (string-match regexp string i) (< i (match-end 0)))
 	(setq i (match-end 0))
 	(setq n (1+ n)))
      n)))
  
 (if running-xemacs
    (defun mell-match-count-region (regexp start end &optional buffer)
      (mell-match-count-string regexp (buffer-substring start end buffer))
      )
  (defun mell-match-count-region (regexp start end &optional buffer)
    (save-excursion
      (and buffer (set-buffer buffer))
      (mell-match-count-string regexp (buffer-substring start end))
      ))
  )

 (define-obsolete-function-alias
  'count-string-match 'mell-match-count-string)

 ;; ------------------------------------------------------------
 ;; mell-alist
 ;; ------------------------------------------------------------
 (defun mell-alist-add! (alist new-cons)
  (if (null alist)
      (error "mell-alist-add! can not deal nil as an alist.")
    (let ((current-cons (assoc (car new-cons) alist)))
      (if current-cons
 	  (setcdr current-cons (cdr new-cons))
 	(if (car alist)
 	    (nconc alist (list new-cons))
 	  (setcar alist new-cons))
 	)
      alist)))
  
 (defun mell-alist-add (alist new-cons)
  (if (null alist)
      (list new-cons)
    (let ((return-alist (copy-alist alist)))
      (mell-alist-add! return-alist new-cons)
      return-alist)))
  
 (defun mell-alist-delete (alist key)
  (if key
      (let (return-alist)
 	(mapcar '(lambda (x)
 		   (or (equal key (car x))
 		       (setq return-alist (cons x return-alist))))
 		alist)
 	(if return-alist
 	    (reverse return-alist)
 	  (list nil)))
    alist)
  )

 (define-obsolete-function-alias
  'delete-assoc 'mell-alist-delete)

 (defun mell-alist-combine (var-list val-list)
  (let ((i 0))
    (mapcar '(lambda (var) 
 	       (prog1 (cons var (nth i val-list))
 		 (setq i (1+ i))))
 	    var-list)))

 (define-obsolete-function-alias
  'mell-make-alist 'mell-alist-combine)

 ;; ------------------------------------------------------------
 ;; mell-list
 ;; ------------------------------------------------------------

 (defun mell-list-member-get-nth (element list)
  (let ((rest-list (member element list)))
    (if rest-list
 	(- (length list) (length rest-list))
      )))

 (defun mell-list-mapfunc (func list &optional value)
  (while list
    (setq value (funcall func value (car list))
 	  list (cdr list)))
  value)

 (define-obsolete-function-alias
  'mapfunc 'mell-list-mapfunc)

 (defun mell-list-mapadd (number-list)
  (mell-list-mapfunc '+ number-list 0))

 (define-obsolete-function-alias
  'mapadd 'mell-list-mapadd)

 ;; elmo-uniq-list (from wanderlust) より.
 (defun mell-list-uniq (list)
  "Distractively uniqfy elements of LIST."
  (let ((tmp list))
    (while tmp (setq tmp
                     (setcdr tmp
                             (and (cdr tmp)
                                  (delete (car tmp)
                                          (cdr tmp)))))))
  list)


 ;; ------------------------------------------------------------
 ;; mell-key-binding
 ;; ------------------------------------------------------------

 (defun mell-key-binding-minor-mode-list (key)
  (delq nil
 	(mapcar 
 	 '(lambda (x) (lookup-key x key))
 	 (current-minor-mode-maps))
  ))
 (define-obsolete-function-alias
  'minor-mode-key-binding-list 'mell-key-binding-minor-mode-list)

 (defun mell-key-binding-next-minor-mode (keymap)
  (car (delq nil
 	     (mapcar '(lambda (x) (lookup-key x (this-command-keys)))
 		     (cdr (member keymap (current-minor-mode-maps))))
 	     )))
 (define-obsolete-function-alias
  'next-minor-mode-key-binding 'mell-key-binding-next-minor-mode)

 (defun mell-key-binding-next (&optional keymap command-keys)
  (let ((mode-maps (if keymap (member keymap (current-minor-mode-maps))
 		     (current-minor-mode-maps)))
 	(command-keys (or command-keys (this-command-keys))))
    (or (car (cdr (delq nil
 			(mapcar '(lambda (x) (lookup-key x command-keys))
 				mode-maps))))
 	(mell-key-binding-local command-keys)
 	(mell-key-binding-global command-keys)
 	)))

 (defun mell-key-binding-local (keys)
  (let ((result (local-key-binding keys)))
    (if (numberp result)
 	(local-key-binding (mell-subseq keys 0 result))
      result)
    ))

 (defun mell-key-binding-global (keys)
  (let ((result (global-key-binding keys)))
    (if (numberp result)
 	(global-key-binding (mell-subseq keys 0 result))
      result)
    ))

 (defun mell-call-next-interactively (&optional keymap command-keys)
  (call-interactively (or (mell-key-binding-next keymap command-keys)
 			  'self-insert-command)
 		      ))

 ;; ------------------------------------------------------------
 ;; mell-time
 ;; ------------------------------------------------------------

 (defun mell-time-get-interval (time1 time2)
  (if (or (> (- (nth 0 time1) (nth 0 time2)) 0)
 	  (> (- (nth 1 time1) (nth 1 time2)) 1000))
      1000000000 ;; 桁あふれへのいんちき対処
    (+ (* 1000000 (- (nth 1 time1) (nth 1 time2)))
       (- (nth 2 time1) (nth 2 time2))))
  )


 ;; ------------------------------------------------------------
 ;; mell-color
 ;; ------------------------------------------------------------
 (defun mell-color-find (color-name &optional alt-tty-color-num)
  (if window-system color-name
    (and (functionp 'find-tty-color)
 	 (or (and color-name (find-tty-color color-name))
 	     (nth alt-tty-color-num (tty-color-list))))
    ))

 (defun mell-color-get-cursor ()
  (if (featurep 'xemacs)
      (face-background-name 'text-cursor) ;; Emacs だと void
    (cdr (assoc 'cursor-color (frame-parameters)))
    ))

 (defun mell-color-get-background ()
  (if (featurep 'xemacs)
      (face-background-name 'default) ;; Emacs だと nil
    (cdr (assoc 'background-color (frame-parameters)))
    ))

 (provide 'mell)

 ;;; mell.el ends here
diff --git a/text-adjust.el b/text-adjust.el
 ;;; text-adjust.el --- Adjust Japanese text

 ;; Version: 0.0.1
 ;; Package-Requires: ((mell "1.4.0"))

 ;;
 ;; text-adjust.el 日本語の文章を整形する. 
 ;;
 ;;  By 小松弘幸  Hiroyuki Komatsu <[email protected]>
 ;;
 ;; このコードは GPL に従って配布可能です. (This is GPLed software.)
 ;; 
 ;; ■インストール方法
 ;; 1) 適当なディレクトリにこのファイルと mell.el をおく.
 ;;    (~/elisp/ 内においたとする). mell.el の一元配布元は
 ;;    http://www.taiyaki.org/elisp/mell/ です.
 ;;
 ;; 2) .emacs に次の 2 行を追加する.
 ;; (setq load-path (cons (expand-file-name "~/elisp") load-path))
 ;; (load "text-adjust")
 ;; 
 ;; ■使い方
 ;; 1) M-x text-adjust を実行すると文章が整形される.
 ;; 2) 使用可能な関数の概要.
 ;;     text-adjust-codecheck : 半角カナ, 規格外文字を「〓」に置き換える.
 ;;     text-adjust-hankaku   : 全角英数文字を半角にする.
 ;;     text-adjust-kutouten  : 句読点を「, 」「. 」に置き換える.
 ;;     text-adjust-space     : 全角文字と半角文字の間に空白を入れる.
 ;;     text-adjust           : これらをすべて実行する.
 ;;     text-adjust-fill      : 句読点優先で, fill-region をする.
 ;;    適応範囲はリージョンがある場合はその範囲を,
 ;;    なければ mark-paragraph で得られた値. 
 ;;
 ;;     *-region : 上記関数をリージョン内で実行する.
 ;;     *-buffer : 上記関数をバッファ内で実行する.
 ;; 
 ;;
 ;; ■Tips
 ;; 1) 次のように設定すると, text-adjust-fill-region 実行時に, 
 ;;  左マージンが考慮される.
 ;;  | (setq adaptive-fill-regexp "[ \t]*")
 ;;  | (setq adaptive-fill-mode t)
 ;;
 ;; 2) ？！や全角空白を半角へ変換しないようにするには.
 ;;  text-adjust-hankaku-except に文字を追加すれば可能になります.
 ;;  | (setq text-adjust-hankaku-except "　？！＠ー〜、，。．")
 ;;

 (require 'mell)

 (defvar text-adjust-hankaku-except "＠ー〜、，。．"
  "text-adjust-hankaku で半角にされたくない文字列. 正規表現ではない.")

 ;; text-adjust-rule のフォーマットは
 ;; (("左端文字列" "対象文字列" "右端文字列") "変換文字列") という構成の
 ;; リストです. "左端文字列", "対象文字列", "右端文字列" は正規表現で
 ;; 記述可能でこの 3 つ を連結した文字列にマッチした個所を変換対象とし, 
 ;; "対象文字列" を "変換文字列" へ変換します.
 ;;
 ;; ■例1
 ;; (("男湯" " " "女湯")   "|壁|")
 ;; 変換前 = "男湯 女湯",  変換後 = "男湯|壁|女湯"
 ;;
 ;; ■例2
 ;; ((("\\cj"        "" "[0-9a-zA-Z]")   " ")
 ;;  (("[0-9a-zA-Z]" "" "\\cj")          " "))
 ;; 変換前 = "YouはShoooock!",  変換後 = "You は Shoooock!"
 ;;
 ;; "変換文字列" では "{", "}" を用いた独自記法によって対象文字列を
 ;; 参照することが可能です. "{1}", "{2}", "{3}" はそれぞれ順に "左端文字列",
 ;; "対象文字列", "右端文字列" の全体を表わし, "{2-3}" は "対象文字列" の
 ;; 3 番目の正規表現の括弧に対応します. また, "{1}" と "{1-0}" は同値です.
 ;;
 ;; ■例3
 ;; (("月" "火水木" "金") "{1}{2}{3}")
 ;; 変換前 = "月火水木金", 変換後 = "月月火水木金金"
 ;;
 ;; ■例4
 ;; (("" "\\(.ン\\)\\(.ン\\)" "") "{2-2}{2-1}")
 ;; 変換前 = "夜明けのガンマン", 変換後 = "夜明けのマンガン"
 ;;
 ;; text-adjust-mode-skip-rule は各モードに特化した特殊変換ルールで, 
 ;; 主に変換をさせたくない個所をスキップする目的で用意されています.
 ;; text-adjust-rule-space, text-adjust-rule-kutouten, 
 ;; text-adjust-rule-codecheck のそれぞれの先頭に追加されたのち, 実行されます.


 ;; 日本語用正規表現 (M-x describe-category を参照)
 ;\\cK カタカナ
 ;\\cC 漢字
 ;\\cH ひらがな
 ;\\cS 全角記号
 ;\\cj 日本語 (上記全部)
 ;\\ck 半角カナ
 (defvar text-adjust-rule-space 
  '((("\\cj\\|)" "" "[[(0-9a-zA-Z+]")   " ")
    (("[])/!?0-9a-zA-Z+]" "" "(\\|\\cj") " "))
  "置換する空白の変換ルール.")

 (defvar text-adjust-rule-kutouten-hperiod
  '((("\\cA\\|\\ca" "．" "\\cA\\|\\ca")   ".")
    (("" "[、，] ?\\([)」』]?\\) *" "$")  "{2-1},")
    (("" "[、，] ?\\([)」』]?\\) ?" "")   "{2-1}, ")
    (("" "[。．] ?\\([)」』]?\\) *" "$")  "{2-1}.")
    (("" "[。．] ?\\([)」』]?\\) ?" "")   "{2-1}. ")
    )
  "「,.」用, 句読点の変換ルール.")

 (defvar text-adjust-rule-kutouten-zperiod
  '((("" "、 ?\\([)」』]?\\)" "")     "{2-1}，")
    (("" "。 ?\\([)」』]?\\)" "")     "{2-1}．")
    (("\\cj" ", ?\\([)」』]?\\)" "")   "{2-1}，")
    (("\\cj" "\\. ?\\([)」』]?\\)" "") "{2-1}．"))
  "「，．」用, 句読点の変換ルール.")

 (defvar text-adjust-rule-kutouten-zkuten
  '((("" "， ?\\([)」』]?\\)" "")     "{2-1}、")
    (("" "． ?\\([)」』]?\\)" "")     "{2-1}。")
    (("\\cj" ", ?\\([)」』]?\\)" "")   "{2-1}、")
    (("\\cj" "\\. ?\\([)」』]?\\)" "") "{2-1}。"))
  "「、。」用, 句読点の変換ルール.")

 (defvar text-adjust-rule-kutouten text-adjust-rule-kutouten-hperiod
  "置換する句読点の変換ルール.
 nil の場合, バッファごとに選択可能.")

 (defvar text-adjust-rule-codecheck
  '((("" "\\ck\\|\\c@" "") "〓")
    ))

 (defvar text-adjust-mode-skip-rule '((sgml-mode . ((("<" "[^>]*" ">") "{2}")
 						   ))))

 ;(defvar text-adjust-fill-regexp ", \\|\\. \\|! \\|\\? \\|を\\| ")
 ;(defvar text-adjust-fill-regexp "[,.!?] \\|[を ]"
 (defvar text-adjust-fill-regexp "[,!] \\|[を ]"
  "この正規表現の次で優先して改行する.")
 (defvar text-adjust-fill-start 60
  "各行とも, この値から fill-column までの値までが\
 text-adjust-fill の有効範囲.")

 (global-set-key [(meta zenkaku-hankaku)] 'text-adjust)


 ;;;; text-adjust
 (defun text-adjust (&optional force-kutouten-rule)
  "日本語文章を整形する.
 各関数 text-adjust-codecheck, text-adjust-hankaku, text-adjust-kutouten,
 text-adjust-space を順に実行することにより,
 英数字交じりの日本語文章を整形する.
 リージョンの指定があった場合はその範囲を, なければ mark-paragraph によって
 得られた範囲を対象にする."
  (interactive "P")
  (save-excursion
    (or (transient-region-active-p)
 	(mark-paragraph))
    (text-adjust-region (region-beginning) (region-end) force-kutouten-rule)))

 (defun text-adjust-buffer (&optional force-kutouten-rule)
  "バッファ内で関数 text-adjust を実行する."
  (interactive "P")
  (text-adjust-region (point-min) (point-max) force-kutouten-rule))

 (defun text-adjust-region (from to &optional force-kutouten-rule) 
  "リージョン内で関数 text-adjust を実行する."
  (interactive "r\nP")
  (text-adjust-kutouten-read-rule force-kutouten-rule)
  (save-restriction
    (narrow-to-region from to)
    (text-adjust-codecheck-region (point-min) (point-max))
    (text-adjust-hankaku-region (point-min) (point-max))
    (text-adjust-kutouten-region (point-min) (point-max))
    (text-adjust-space-region (point-min) (point-max))
 ;    (text-adjust-fill)
    ))


 ;;;; text-adjust-codecheck
 ;;;; jischeck.el より引用
 ;;
 ;; jischeck.el 19960827+19970214+19980406
 ;;     By TAMURA Kent <[email protected]>
 ;;      + akira yamada <[email protected]>
 ;;      + Takashi Ishioka <[email protected]>

 ;; JIS X 0208-1983 で無効な範囲(数値は ISO-2022-JP での値):
 ;;  1,2 Byte目が 0x00-0x20, 0x7f-0xff
 ;;  1 Byte目:  0x29-0x2f, 0x75-0x7e
 ;;
 ;; 細かいところでは:
 ;;  222f-2239, 2242-2249, 2251-225b, 226b-2271, 227a-227d
 ;;  2321-232f, 233a-2340, 235b-2360, 237b-237e
 ;;  2474-247e,
 ;;  2577-257e,
 ;;  2639-2640, 2659-267e,
 ;;  2742-2750, 2772-277e,
 ;;  2841-287e,
 ;;  4f54-4f7e,
 ;;  7425-747e,
 ;;
 ;;;; 引用終わり.

 ;;;; 1 byte 目が 0x29-0x2f, 0x75-0x7e の文字にのみ対応.
 (or (if running-xemacs
 	(defined-category-p ?@)
      (category-docstring ?@))
    (let ((page 41))
      (define-category ?@ "invalid japanese char category")
      (while (<= page 126)
 	(if running-xemacs
 	    (modify-category-entry `[japanese-jisx0208 ,page] ?@)
 	  (modify-category-entry (make-char 'japanese-jisx0208 page) ?@))
 	(setq page 
 	      (if (= page 47) 117 (1+ page))))))

 (defun text-adjust-codecheck (&optional from to)
  "無効な文字コードを text-adjust-codecheck-alarm に置き換える.

 リージョンの指定があった場合はその範囲を, なければ mark-paragraph によって
 得られた範囲を対象にする."
  (interactive)
  (save-excursion
    (or (transient-region-active-p)
 	(mark-paragraph))
    (text-adjust-codecheck-region (region-beginning) (region-end))))

 (defun text-adjust-codecheck-buffer ()
  "バッファ内で関数 text-adjust-jischeck を実行する."
  (interactive)
  (text-adjust-codecheck-region (point-min) (point-max)))

 (defun text-adjust-codecheck-region (from to)
  "リージョン内で関数 text-adjust-jischeck を実行する."
  (interactive "r")
  (text-adjust--replace text-adjust-rule-codecheck from to))


 ;;;; text-adjust-hankaku
 (defun text-adjust-hankaku ()
  "全角英数文字を半角にする.

 リージョンの指定があった場合はその範囲を, なければ mark-paragraph によって
 得られた範囲を対象にする."
  (interactive)
  (save-excursion
    (or (transient-region-active-p)
 	(mark-paragraph))
    (text-adjust-hankaku-region (region-beginning) (region-end))))

 (defun text-adjust-hankaku-buffer ()
  "バッファ内で関数 text-adjust-hankaku を実行する."
  (interactive)
  (text-adjust-hankaku-region (point-min) (point-max)))

 (defun text-adjust-hankaku-region (from to) 
  "リージョン内で関数 text-adjust-hankaku を実行する."
  (interactive "r")
  (require 'japan-util)
  (save-excursion
    (let ((tmp-table (text-adjust--copy-char-table char-code-property-table)))
      (text-adjust--modify-char-table ?　 (list 'ascii "  "))
      (mapcar '(lambda (c) (text-adjust--modify-char-table c nil))
       (string-to-list text-adjust-hankaku-except))
      (japanese-hankaku-region from to t)
      (setq char-code-property-table 
 	    (text-adjust--copy-char-table tmp-table)))))

 (defun text-adjust--modify-char-table (range value)
  (if running-xemacs
      (put-char-table range value char-code-property-table)
    (set-char-table-range char-code-property-table range value)))

 (defun text-adjust--copy-char-table (table)
  (if running-xemacs
      (copy-char-table table)
    (copy-sequence table)))


 ;;;; text-adjust-kutouten
 (defun text-adjust-kutouten (&optional forcep)
  "句読点を変換する.
 句点を text-adjust-kuten-from から text-adjust-kuten-to の値に,
 読点を text-adjust-touten-from から text-adjust-touten-to の値に変換する.

 リージョンの指定があった場合はその範囲を, なければ mark-paragraph によって
 得られた範囲を対象にする."
  (interactive)
  (save-excursion
    (or (transient-region-active-p)
 	(mark-paragraph))
    (text-adjust-kutouten-region (region-beginning) (region-end) forcep)))

 (defun text-adjust-kutouten-buffer (&optional forcep)
  "バッファ内で関数 text-adjust-kutouten を実行する."
  (interactive "P")
  (text-adjust-kutouten-region (point-min) (point-max) forcep))

 (defun text-adjust-kutouten-region (from to &optional forcep)
  "リージョン内で関数 text-adjust-kutouten を実行する."
  (interactive "r\nP")
  (text-adjust-kutouten-read-rule forcep)
  (text-adjust--replace text-adjust-rule-kutouten from to))

 (defun text-adjust-kutouten-read-rule (&optional forcep)
  "変換後の句読点を選択する."
  (interactive)
  (if (and text-adjust-rule-kutouten (not forcep) (not (interactive-p)))
      text-adjust-rule-kutouten
    (make-local-variable 'text-adjust-rule-kutouten)
    (setq text-adjust-rule-kutouten
 	  (symbol-value
 	   (let ((kutouten-alist 
 		  '(("kuten-zenkaku"  . text-adjust-rule-kutouten-zkuten)
 		    ("zenkaku-kuten"  . text-adjust-rule-kutouten-zkuten)
 		    ("、。"           . text-adjust-rule-kutouten-zkuten)
 		    ("period-zenkaku" . text-adjust-rule-kutouten-zperiod)
 		    ("zenkaku-period" . text-adjust-rule-kutouten-zperiod)
 		    ("，．"           . text-adjust-rule-kutouten-zperiod)
 		    ("period-hankaku" . text-adjust-rule-kutouten-hperiod)
 		    ("hankaku-period" . text-adjust-rule-kutouten-hperiod)
 		    (",."             . text-adjust-rule-kutouten-hperiod))))
 	     (cdr (assoc
 		   (completing-read "句読点の種類: " kutouten-alist
 				    nil t ",.")
 		   kutouten-alist)))))))

 ;;;; text-adujst-space
 (defun text-adjust-space ()
  "半角英数と日本語の間に空白を挿入する.
 text-adjust-japanese で定義された日本語文字を示す正規表現と,
 text-adjust-ascii で定義された半角英数文字を示す正規表現との間に
 空白を挿入する.

 リージョンの指定があった場合はその範囲を, なければ mark-paragraph によって
 得られた範囲を対象にする."
  (interactive)
  (save-excursion
    (or (transient-region-active-p)
 	(mark-paragraph))
    (text-adjust-space-region (region-beginning) (region-end))))

 (defun text-adjust-space-buffer () 
  "バッファ内で関数 text-adjust-space を実行する."
  (interactive)
  (text-adjust-space-region (point-min) (point-max)))
  
 (defun text-adjust-space-region (from to) 
  "リージョン内で関数text-adjust-spaceを実行する."
  (interactive "r")
  (text-adjust--replace text-adjust-rule-space from to))


 ;;;; text-adjust-fill
 (defun text-adjust-fill ()
  "句読点での改行を優先して, fill-region を実行する.
 各行の text-adjust-fill-start から, fill-column までの間に,
 text-adjust-fill-regexp が最後に含まれているところで改行する.

 リージョンの指定があった場合はその範囲を, なければ mark-paragraph によって
 得られた範囲を対象にする."
  (interactive)
  (save-excursion
    (or (transient-region-active-p)
 	(mark-paragraph))
    (text-adjust-fill-region (region-beginning) (region-end))))

 (defun text-adjust-fill-buffer () 
  "バッファ内で関数 text-adjust-fill を実行する."
  (interactive)
  (text-adjust-fill-region (point-min) (point-max)))
  
 (defun text-adjust-fill-region (from to) 
  "リージョン内で関数 text-adjust-fill を実行する."
  (interactive "r")
  (save-excursion
    (save-restriction
      (narrow-to-region from to)
      (let ((kinsoku-tmp kinsoku-ascii)
 	    (prefix (if adaptive-fill-mode (fill-context-prefix from to) "")))
 	(setq kinsoku-ascii t)
 	(fill-region (point-min) (point-max))
 	(goto-char (point-min))
 	(while (/= (line-end-position) (point-max))
 	  (move-to-column text-adjust-fill-start)
 	  (if (and (re-search-forward
 		    (concat "\\(" text-adjust-fill-regexp 
 			    "\\) *[^" text-adjust-fill-regexp "]*$")
 		    (line-end-position) t))
 	      (progn
 		(goto-char (match-end 1))
 		(delete-horizontal-space)
 		(if (eolp)
 		    (beginning-of-line 2)
 		  (progn
 		    (insert (concat "\n" prefix))
 		    (beginning-of-line)
 		    )))
 	    (beginning-of-line 2))
 	  (narrow-to-region (point) (point-max))
 	  (fill-region (point-min) to nil nil t)
 	  (goto-char (point-min)))
 	(delete-horizontal-space)
 	(setq kinsoku-ascii kinsoku-tmp)))))


 ;;;; text-adjust engine
 (defun text-adjust--replace (rule from to)
  (save-excursion
    (save-restriction
      (narrow-to-region from to)
      (goto-char (point-min))
      (let* ((rule-pattern 
 	      (text-adjust--make-rule-pattern 
 	       (append (cdr (assoc major-mode text-adjust-mode-skip-rule)) 
 		       rule)))
 	     (regexp (nth 0 rule-pattern))
 	     (target (nth 1 rule-pattern))
 	     (counts (nth 2 rule-pattern)))
 	(while (re-search-forward regexp nil t)
 	  (let ((n 1) (m 0) right-string)
 	    ; 該当パターンまですすめる
 	    (while (not (match-beginning n))
 	      (setq n (+ n 3 (mapadd (nth m counts)))
 		    m (1+ m)))
 	    ; 該当パターンと置換する
 	    (let* ((tmp n)
 		   (total-counts 
 		    (cons n (mapcar (lambda (x) (setq tmp (+ tmp x 1)))
 				    (nth m counts))))
 		   (right-string (match-string (nth 2 total-counts))))
 	      (replace-match 
 	       (concat 
 		;; 該当パターンの左側
 		(match-string n)
 		;; 該当パターンのまん中 (置換部分)
 		(mapconcat
 		 (lambda (x) 
 		   (if (stringp x) x
 		     (match-string (+ (nth (1- (car x)) total-counts) 
 				      (cdr x)))))
 		 (nth m target) "")
 		;; 該当パターンの右側
 		right-string))
 	      ;; "あaあa" のように一文字ずつで並んでいる時の対処
 	      (backward-char (length right-string))))))
      )))

 (defun text-adjust--make-rule-pattern (rule)
  (let ((regexp (mapconcat 
 		 (lambda (x) 
 		   (format "\\(%s\\)\\(%s\\)\\(%s\\)"
 			   (nth 0 (car x)) (nth 1 (car x)) (nth 2 (car x))))
 		 rule "\\|"))
 	(target (mapcar 
 		 (lambda (x)
 		   (text-adjust--parse-replace-string (nth 1 x)))
 		 rule))
 	(counts (mapcar
 		 (lambda (x)
 		   (list (count-string-match "\\\\(" (nth 0 (car x)))
 			 (count-string-match "\\\\(" (nth 1 (car x)))
 			 (count-string-match "\\\\(" (nth 2 (car x)))))
 		 rule)))
    (list regexp target counts)))

 (defun text-adjust--parse-replace-string (rule)
  (let ((n 0) m list)
    (while (string-match "\\([^{]*\\){\\([^}]+\\)}" rule n)
      (setq n (match-end 0))
      (let ((match1 (match-string 1 rule))
 	    (match2 (match-string 2 rule)))
 	(cond ((string-match "^[0-9]+\\(-[0-9]+\\)?$" match2)
 	       (or (string= match1 "") (setq list (cons match1 list)))
 	       (let* ((tmp (split-string match2 "-"))
 		      (num (cons (string-to-number (car tmp))
 				 (string-to-number (or (nth 1 tmp) "0")))))
 		 (setq list (cons num list))))
 	      (t
 	       (setq list (cons match2 (cons match1 list)))))))
    (reverse (cons (substring rule n) list))))


 (provide 'text-adjust)
 ; $Id: text-adjust.el,v 1.1.1.1 2002/08/25 14:24:48 komatsu Exp $

 ;;; text-adjust.el ends here
	;;; mell.el --- MELL Emacs Lisp Library
	;;
	;; AUTHOR: Hiroyuki Komatsu <[email protected]>
	;; LICENCE: GPL2
	;; $Id: mell.el,v 1.4 2003/03/18 03:34:45 komatsu Exp $
	;; Version: 1.4.0
	;;

	;; ------------------------------------------------------------
	;; XEmacs と FSF Emacs の差異を吸収
	;; ------------------------------------------------------------

	;; Checking Emacs or XEmacs.
	(if (not (boundp 'running-xemacs))
	(defconst running-xemacs nil))

	;; line-end-position for XEmacs
	(if (not (fboundp 'line-end-position))
	(defun line-end-position (&optional arg)
	(point-at-eol (or arg 1))))

	;; define-obsolete-function-alias for FSF Emacs
	(if (not (fboundp 'define-obsolete-function-alias))
	(defun define-obsolete-function-alias (obsolete current)
	(defalias obsolete current)
	(make-obsolete obsolete current))
	)

	;; add-local-hook
	(or (fboundp 'add-local-hook)
	(defun add-local-hook (hook function &optional append)
	(make-local-hook hook)
	(add-hook hook function append t))
	)

	;; remove-local-hook
	(or (fboundp 'remove-local-hook)
	(defun remove-local-hook (hook function)
	(if (local-variable-p hook (current-buffer))
	(remove-hook hook function t)))
	)
	;; ------------------------------------------------------------
	;; mell (basic)
	;; ------------------------------------------------------------
	(defcustom mell-working-buffer-name " mell-buffer"
	"Working buffer name for mell")
	(defvar mell-working-buffer nil
	"working buffer for mell")

	(defun mell-check-value (value)
	(and (boundp value)
	(symbol-value value)))

	(defun mell-defvar (symbol value &optional doc-string)
	(if (not (boundp symbol))
	(set symbol value))
	(if doc-string
	(put symbol 'variable-documentation doc-string))
	symbol)

	(defun mell-defvar-locally (symbol initvalue &optional docstring)
	(mell-defvar symbol initvalue docstring)
	(make-variable-buffer-local symbol)
	symbol)

	(defun mell-require (feature &optional filename noerror)
	(or (featurep feature)
	(if noerror
	(condition-case nil
	(require feature filename)
	(file-error nil)
	)
	(require feature filename)
	)))

	(defun mell-point-at-bol (&optional point)
	(save-excursion
	(or point (goto-char point))
	(beginning-of-line)
	(point)
	))

	(defun mell-point-at-eol (&optional point)
	(save-excursion
	(or point (goto-char point))
	(end-of-line)
	(point)
	))

	(defun mell-point-at-bop (&optional point)
	(save-excursion
	(goto-char (or point (point)))
	(backward-paragraph 1)
	(point)))

	(defun mell-point-at-eop (&optional point)
	(save-excursion
	(goto-char (or point (point)))
	(forward-paragraph 1)
	(point)))

	(defun mell-column-at-point (point &optional buffer)
	(save-excursion
	(and buffer (set-buffer buffer))
	(goto-char point)
	(current-column)
	))

	(defun mell-point-at-column (column &optional point buffer)
	(save-excursion
	(and buffer (set-buffer buffer))
	(and point (goto-char point))
	(move-to-column column)
	(point)
	))

	;; mell-marker
	(defun mell-marker-make (&optional position buffer type)
	(let ((marker (make-marker)))
	(or position
	(setq position (point)))
	(set-marker marker position buffer)
	(set-marker-insertion-type marker type)
	marker
	))

	(defun mell-marker-set (marker &optional position buffer type)
	(or (and (boundp marker) (markerp (symbol-value marker)))
	(set marker (make-marker)))
	(or position
	(setq position (point)))
	(set-marker (symbol-value marker) position buffer)
	(set-marker-insertion-type (symbol-value marker) type)
	(eval marker)
	)

	;; ------------------------------------------------------------

	;; mell-sublist
	(if (functionp 'sublist)
	(defalias 'mell-sublist 'sublist)
	(defun mell-sublist (list start &optional end)
	(if (< start 0)
	(setq start (+ start (length list))))
	(if (null end)
	(nthcdr start (copy-sequence list))
	(and end (< end 0)
	(setq end (+ end (length list))))
	(let (sublist tmp)
	(if (> start end)
	(progn (setq tmp start)
	(setq start end)
	(setq end tmp)))
	(while (< start end)
	(setq end (1- end)
	sublist (cons (nth end list) sublist)))
	sublist)))
	)

	;; mell-subarray
	(if (functionp 'subarray)
	(defalias 'mell-subarray 'subarray)
	(defun mell-subarray (array start &optional end)
	(apply 'vector (mell-sublist (append array nil) start end)))
	)

	;; mell-subseq
	(if (functionp 'subseq)
	(defalias 'mell-subseq 'subseq)
	(defun mell-subseq (seq start &optional end) ;; For Emacs20
	(cond ((stringp seq) (substring seq start end))
	((listp seq) (mell-sublist seq start end))
	(t (mell-subarray seq start end))
	))
	)

	;; ------------------------------------------------------------
	;; mell-mode
	;; ------------------------------------------------------------

	;; this function requires mell-alist.
	(defun mell-set-minor-mode (name modeline &optional key-map)
	(make-variable-buffer-local name)
	(setq minor-mode-alist
	(mell-alist-add minor-mode-alist (list name modeline)))
	(and key-map
	(setq minor-mode-map-alist
	(mell-alist-add minor-mode-map-alist (cons name key-map)))
	)
	)

	;; ------------------------------------------------------------
	;; mell-region
	;; ------------------------------------------------------------

	;; mell-region-face
	(if running-xemacs
	(defconst mell-region-face 'zmacs-region)
	(defconst mell-region-face 'region)
	)

	;; mell-region-active-p
	(if running-xemacs
	(defun mell-region-active-p ()
	(region-active-p))
	(defun mell-region-active-p ()
	(mell-check-value 'mark-active))
	)

	;; mell-transient-mode-p
	(if running-xemacs
	(defun mell-transient-mode-p ()
	(mell-check-value 'zmacs-regions))
	(defun mell-transient-mode-p ()
	(mell-check-value 'transient-mark-mode))
	)

	;; Define mell-transient-region-active-p
	(defun mell-transient-region-active-p ()
	(and (mell-transient-mode-p)
	(mell-region-active-p)))

	(define-obsolete-function-alias
	'transient-region-active-p 'mell-transient-region-active-p)

	(defun mell-transient-region-stay ()
	(and running-xemacs
	(setq zmacs-region-stays t))
	)
	;; ------------------------------------------------------------
	;; mell-region (applications)
	;; ------------------------------------------------------------

	(defun mell-read-region-or-string ()
	"If active region exists, return the substring specified the region.
	Or read string from minibuffer."
	(interactive)
	(if (mell-transient-region-active-p)
	(buffer-substring (mark) (point))
	(read-string "String: " (current-word))
	))

	(define-obsolete-function-alias
	'read-region-or-string 'mell-read-region-or-string)

	(defun mell-paragraph-string (&optional point)
	(buffer-substring (mell-point-at-bop point) (mell-point-at-eop point)))

	(defun mell-delete-paragraph (&optional point)
	(delete-region (mell-point-at-bop point) (mell-point-at-eop point)))

	(defun mell-read-region-or-paragraph ()
	"If active region exists, return the substring specified the region.
	Or return paragraph on the cursor automatically."
	(interactive)
	(if (mell-transient-region-active-p)
	(buffer-substring (mark) (point))
	(mell-paragraph-string)
	))

	(defun mell-call-function-region-or-string (function &optional args-list)
	(apply function
	(prog1 (mell-read-region-or-string)
	(and (mell-transient-region-active-p)
	(delete-region (point) (mark)))
	)
	args-list))

	(defun mell-call-function-region-or-paragraph (function &optional args-list)
	(if (or (mell-transient-region-active-p)
	(y-or-n-p "Use current paragraph? "))
	(apply function
	(prog1 (mell-read-region-or-paragraph)
	(if (mell-transient-region-active-p)
	(delete-region (point) (mark))
	(mell-delete-paragraph))
	)
	args-list)
	""))

	(defun mell-narrow-to-transient-region (&optional begin end)
	"If active region exists, narrow-to-region"
	(setq begin (or begin (and (transient-region-active-p) (region-beginning)))
	end (or end (and (transient-region-active-p) (region-end))))
	(if (and begin end)
	(progn
	(narrow-to-region begin end)
	(goto-char begin)
	))
	)

	(defun mell-region-get-rectangle-list (start end &optional buffer)
	(save-excursion
	(and buffer (set-buffer buffer))
	(let* (rectangle-alist
	(column-min (min (mell-column-at-point start)
	(mell-column-at-point end)))
	(column-max (max (mell-column-at-point start)
	(mell-column-at-point end)))
	(point-min (min (mell-point-at-column column-min start)
	(mell-point-at-column column-min end)))
	(point-max (max (mell-point-at-column column-max start)
	(mell-point-at-column column-max end)))
	)
	(goto-char point-min)
	(while (< (point) point-max)
	(move-to-column column-min)
	(setq rectangle-alist
	(cons (cons (point) (mell-point-at-column column-max))
	rectangle-alist))
	(forward-line 1)
	)
	(reverse rectangle-alist)
	)))

	(put 'mell-region-rectangle-while 'lisp-indent-function 1)
	(defmacro mell-region-rectangle-while (rectangle &rest body)
	`(let ((rectangle-markers
	(mell-region-get-rectangle-marker-list
	(nth 0 ,rectangle) (nth 1 ,rectangle) (nth 2 ,rectangle)))
	)
	(mapcar
	(lambda (region)
	(let ((line-beginning (car region))
	(line-end (cdr region)))
	,@body
	))
	rectangle-markers)
	(mapcar
	(lambda (region)
	(set-marker (car region) nil)
	(set-marker (cdr region) nil)
	)
	rectangle-markers)
	))

	(defun mell-region-get-rectangle-marker-list (start end &optional buffer)
	(mapcar
	'(lambda (region)
	(cons (mell-marker-make (car region)) (mell-marker-make (cdr region)))
	)
	(mell-region-get-rectangle-list start end buffer))
	)

	(defun mell-region-rectangle-right-edge-p (start end)
	(save-excursion
	(let ((list (mell-region-get-rectangle-list start end))
	(result t))
	(while (and list
	(progn (goto-char (cdr (car list)))
	(eolp)))
	(setq list (cdr list))
	)
	(null list)
	)))

	(put 'mell-save-region 'lisp-indent-function 0)
	(defmacro mell-save-region (&rest body)
	`(let ((mark (mark))
	(active-p (mell-transient-region-active-p))
	(cur-buffer (current-buffer))
	global-mark-ring mark-ring
	kill-ring kill-ring-yank-pointer
	overlay)
	(if active-p
	(setq overlay (mell-sign-region-highlight (mark) (point)))
	)
	,@body
	(if active-p
	(progn
	(mell-transient-region-activate)
	(mell-sign-region-highlight-off overlay)
	))
	))

	;; ------------------------------------------------------------
	;; mell-match
	;; ------------------------------------------------------------

	(defun mell-match-count-string (regexp string)
	(save-match-data
	(let ((i 0) (n 0))
	(while (and (string-match regexp string i) (< i (match-end 0)))
	(setq i (match-end 0))
	(setq n (1+ n)))
	n)))

	(if running-xemacs
	(defun mell-match-count-region (regexp start end &optional buffer)
	(mell-match-count-string regexp (buffer-substring start end buffer))
	)
	(defun mell-match-count-region (regexp start end &optional buffer)
	(save-excursion
	(and buffer (set-buffer buffer))
	(mell-match-count-string regexp (buffer-substring start end))
	))
	)

	(define-obsolete-function-alias
	'count-string-match 'mell-match-count-string)

	;; ------------------------------------------------------------
	;; mell-alist
	;; ------------------------------------------------------------
	(defun mell-alist-add! (alist new-cons)
	(if (null alist)
	(error "mell-alist-add! can not deal nil as an alist.")
	(let ((current-cons (assoc (car new-cons) alist)))
	(if current-cons
	(setcdr current-cons (cdr new-cons))
	(if (car alist)
	(nconc alist (list new-cons))
	(setcar alist new-cons))
	)
	alist)))

	(defun mell-alist-add (alist new-cons)
	(if (null alist)
	(list new-cons)
	(let ((return-alist (copy-alist alist)))
	(mell-alist-add! return-alist new-cons)
	return-alist)))

	(defun mell-alist-delete (alist key)
	(if key
	(let (return-alist)
	(mapcar '(lambda (x)
	(or (equal key (car x))
	(setq return-alist (cons x return-alist))))
	alist)
	(if return-alist
	(reverse return-alist)
	(list nil)))
	alist)
	)

	(define-obsolete-function-alias
	'delete-assoc 'mell-alist-delete)

	(defun mell-alist-combine (var-list val-list)
	(let ((i 0))
	(mapcar '(lambda (var)
	(prog1 (cons var (nth i val-list))
	(setq i (1+ i))))
	var-list)))

	(define-obsolete-function-alias
	'mell-make-alist 'mell-alist-combine)

	;; ------------------------------------------------------------
	;; mell-list
	;; ------------------------------------------------------------

	(defun mell-list-member-get-nth (element list)
	(let ((rest-list (member element list)))
	(if rest-list
	(- (length list) (length rest-list))
	)))

	(defun mell-list-mapfunc (func list &optional value)
	(while list
	(setq value (funcall func value (car list))
	list (cdr list)))
	value)

	(define-obsolete-function-alias
	'mapfunc 'mell-list-mapfunc)

	(defun mell-list-mapadd (number-list)
	(mell-list-mapfunc '+ number-list 0))

	(define-obsolete-function-alias
	'mapadd 'mell-list-mapadd)

	;; elmo-uniq-list (from wanderlust) より.
	(defun mell-list-uniq (list)
	"Distractively uniqfy elements of LIST."
	(let ((tmp list))
	(while tmp (setq tmp
	(setcdr tmp
	(and (cdr tmp)
	(delete (car tmp)
	(cdr tmp)))))))
	list)


	;; ------------------------------------------------------------
	;; mell-key-binding
	;; ------------------------------------------------------------

	(defun mell-key-binding-minor-mode-list (key)
	(delq nil
	(mapcar
	'(lambda (x) (lookup-key x key))
	(current-minor-mode-maps))
	))
	(define-obsolete-function-alias
	'minor-mode-key-binding-list 'mell-key-binding-minor-mode-list)

	(defun mell-key-binding-next-minor-mode (keymap)
	(car (delq nil
	(mapcar '(lambda (x) (lookup-key x (this-command-keys)))
	(cdr (member keymap (current-minor-mode-maps))))
	)))
	(define-obsolete-function-alias
	'next-minor-mode-key-binding 'mell-key-binding-next-minor-mode)

	(defun mell-key-binding-next (&optional keymap command-keys)
	(let ((mode-maps (if keymap (member keymap (current-minor-mode-maps))
	(current-minor-mode-maps)))
	(command-keys (or command-keys (this-command-keys))))
	(or (car (cdr (delq nil
	(mapcar '(lambda (x) (lookup-key x command-keys))
	mode-maps))))
	(mell-key-binding-local command-keys)
	(mell-key-binding-global command-keys)
	)))

	(defun mell-key-binding-local (keys)
	(let ((result (local-key-binding keys)))
	(if (numberp result)
	(local-key-binding (mell-subseq keys 0 result))
	result)
	))

	(defun mell-key-binding-global (keys)
	(let ((result (global-key-binding keys)))
	(if (numberp result)
	(global-key-binding (mell-subseq keys 0 result))
	result)
	))

	(defun mell-call-next-interactively (&optional keymap command-keys)
	(call-interactively (or (mell-key-binding-next keymap command-keys)
	'self-insert-command)
	))

	;; ------------------------------------------------------------
	;; mell-time
	;; ------------------------------------------------------------

	(defun mell-time-get-interval (time1 time2)
	(if (or (> (- (nth 0 time1) (nth 0 time2)) 0)
	(> (- (nth 1 time1) (nth 1 time2)) 1000))
	1000000000 ;; 桁あふれへのいんちき対処
	(+ (* 1000000 (- (nth 1 time1) (nth 1 time2)))
	(- (nth 2 time1) (nth 2 time2))))
	)


	;; ------------------------------------------------------------
	;; mell-color
	;; ------------------------------------------------------------
	(defun mell-color-find (color-name &optional alt-tty-color-num)
	(if window-system color-name
	(and (functionp 'find-tty-color)
	(or (and color-name (find-tty-color color-name))
	(nth alt-tty-color-num (tty-color-list))))
	))

	(defun mell-color-get-cursor ()
	(if (featurep 'xemacs)
	(face-background-name 'text-cursor) ;; Emacs だと void
	(cdr (assoc 'cursor-color (frame-parameters)))
	))

	(defun mell-color-get-background ()
	(if (featurep 'xemacs)
	(face-background-name 'default) ;; Emacs だと nil
	(cdr (assoc 'background-color (frame-parameters)))
	))

	(provide 'mell)

	;;; mell.el ends here
	;;; text-adjust.el --- Adjust Japanese text

	;; Version: 0.0.1
	;; Package-Requires: ((mell "1.4.0"))

	;;
	;; text-adjust.el 日本語の文章を整形する.
	;;
	;; By 小松弘幸 Hiroyuki Komatsu <[email protected]>
	;;
	;; このコードは GPL に従って配布可能です. (This is GPLed software.)
	;;
	;; ■インストール方法
	;; 1) 適当なディレクトリにこのファイルと mell.el をおく.
	;; (~/elisp/ 内においたとする). mell.el の一元配布元は
	;; http://www.taiyaki.org/elisp/mell/ です.
	;;
	;; 2) .emacs に次の 2 行を追加する.
	;; (setq load-path (cons (expand-file-name "~/elisp") load-path))
	;; (load "text-adjust")
	;;
	;; ■使い方
	;; 1) M-x text-adjust を実行すると文章が整形される.
	;; 2) 使用可能な関数の概要.
	;; text-adjust-codecheck : 半角カナ, 規格外文字を「〓」に置き換える.
	;; text-adjust-hankaku : 全角英数文字を半角にする.
	;; text-adjust-kutouten : 句読点を「, 」「. 」に置き換える.
	;; text-adjust-space : 全角文字と半角文字の間に空白を入れる.
	;; text-adjust : これらをすべて実行する.
	;; text-adjust-fill : 句読点優先で, fill-region をする.
	;; 適応範囲はリージョンがある場合はその範囲を,
	;; なければ mark-paragraph で得られた値.
	;;
	;; *-region : 上記関数をリージョン内で実行する.
	;; *-buffer : 上記関数をバッファ内で実行する.
	;;
	;;
	;; ■Tips
	;; 1) 次のように設定すると, text-adjust-fill-region 実行時に,
	;; 左マージンが考慮される.
	;; \| (setq adaptive-fill-regexp "[ \t]*")
	;; \| (setq adaptive-fill-mode t)
	;;
	;; 2) ？！や全角空白を半角へ変換しないようにするには.
	;; text-adjust-hankaku-except に文字を追加すれば可能になります.
	;; \| (setq text-adjust-hankaku-except "　？！＠ー〜、，。．")
	;;

	(require 'mell)

	(defvar text-adjust-hankaku-except "＠ー〜、，。．"
	"text-adjust-hankaku で半角にされたくない文字列. 正規表現ではない.")

	;; text-adjust-rule のフォーマットは
	;; (("左端文字列" "対象文字列" "右端文字列") "変換文字列") という構成の
	;; リストです. "左端文字列", "対象文字列", "右端文字列" は正規表現で
	;; 記述可能でこの 3 つを連結した文字列にマッチした個所を変換対象とし,
	;; "対象文字列" を "変換文字列" へ変換します.
	;;
	;; ■例1
	;; (("男湯" " " "女湯") "\|壁\|")
	;; 変換前 = "男湯女湯", 変換後 = "男湯\|壁\|女湯"
	;;
	;; ■例2
	;; ((("\\cj" "" "[0-9a-zA-Z]") " ")
	;; (("[0-9a-zA-Z]" "" "\\cj") " "))
	;; 変換前 = "YouはShoooock!", 変換後 = "You は Shoooock!"
	;;
	;; "変換文字列" では "{", "}" を用いた独自記法によって対象文字列を
	;; 参照することが可能です. "{1}", "{2}", "{3}" はそれぞれ順に "左端文字列",
	;; "対象文字列", "右端文字列" の全体を表わし, "{2-3}" は "対象文字列" の
	;; 3 番目の正規表現の括弧に対応します. また, "{1}" と "{1-0}" は同値です.
	;;
	;; ■例3
	;; (("月" "火水木" "金") "{1}{2}{3}")
	;; 変換前 = "月火水木金", 変換後 = "月月火水木金金"
	;;
	;; ■例4
	;; (("" "\\(.ン\\)\\(.ン\\)" "") "{2-2}{2-1}")
	;; 変換前 = "夜明けのガンマン", 変換後 = "夜明けのマンガン"
	;;
	;; text-adjust-mode-skip-rule は各モードに特化した特殊変換ルールで,
	;; 主に変換をさせたくない個所をスキップする目的で用意されています.
	;; text-adjust-rule-space, text-adjust-rule-kutouten,
	;; text-adjust-rule-codecheck のそれぞれの先頭に追加されたのち, 実行されます.


	;; 日本語用正規表現 (M-x describe-category を参照)
	;\\cK カタカナ
	;\\cC 漢字
	;\\cH ひらがな
	;\\cS 全角記号
	;\\cj 日本語 (上記全部)
	;\\ck 半角カナ
	(defvar text-adjust-rule-space
	'((("\\cj\\\|)" "" "[[(0-9a-zA-Z+]") " ")
	(("[])/!?0-9a-zA-Z+]" "" "(\\\|\\cj") " "))
	"置換する空白の変換ルール.")

	(defvar text-adjust-rule-kutouten-hperiod
	'((("\\cA\\\|\\ca" "．" "\\cA\\\|\\ca") ".")
	(("" "[、，] ?\\([)」』]?\\) *" "$") "{2-1},")
	(("" "[、，] ?\\([)」』]?\\) ?" "") "{2-1}, ")
	(("" "[。．] ?\\([)」』]?\\) *" "$") "{2-1}.")
	(("" "[。．] ?\\([)」』]?\\) ?" "") "{2-1}. ")
	)
	"「,.」用, 句読点の変換ルール.")

	(defvar text-adjust-rule-kutouten-zperiod
	'((("" "、 ?\\([)」』]?\\)" "") "{2-1}，")
	(("" "。 ?\\([)」』]?\\)" "") "{2-1}．")
	(("\\cj" ", ?\\([)」』]?\\)" "") "{2-1}，")
	(("\\cj" "\\. ?\\([)」』]?\\)" "") "{2-1}．"))
	"「，．」用, 句読点の変換ルール.")

	(defvar text-adjust-rule-kutouten-zkuten
	'((("" "， ?\\([)」』]?\\)" "") "{2-1}、")
	(("" "． ?\\([)」』]?\\)" "") "{2-1}。")
	(("\\cj" ", ?\\([)」』]?\\)" "") "{2-1}、")
	(("\\cj" "\\. ?\\([)」』]?\\)" "") "{2-1}。"))
	"「、。」用, 句読点の変換ルール.")

	(defvar text-adjust-rule-kutouten text-adjust-rule-kutouten-hperiod
	"置換する句読点の変換ルール.
	nil の場合, バッファごとに選択可能.")

	(defvar text-adjust-rule-codecheck
	'((("" "\\ck\\\|\\c@" "") "〓")
	))

	(defvar text-adjust-mode-skip-rule '((sgml-mode . ((("<" "[^>]*" ">") "{2}")
	))))

	;(defvar text-adjust-fill-regexp ", \\\|\\. \\\|! \\\|\\? \\\|を\\\| ")
	;(defvar text-adjust-fill-regexp "[,.!?] \\\|[を ]"
	(defvar text-adjust-fill-regexp "[,!] \\\|[を ]"
	"この正規表現の次で優先して改行する.")
	(defvar text-adjust-fill-start 60
	"各行とも, この値から fill-column までの値までが\
	text-adjust-fill の有効範囲.")

	(global-set-key [(meta zenkaku-hankaku)] 'text-adjust)


	;;;; text-adjust
	(defun text-adjust (&optional force-kutouten-rule)
	"日本語文章を整形する.
	各関数 text-adjust-codecheck, text-adjust-hankaku, text-adjust-kutouten,
	text-adjust-space を順に実行することにより,
	英数字交じりの日本語文章を整形する.
	リージョンの指定があった場合はその範囲を, なければ mark-paragraph によって
	得られた範囲を対象にする."
	(interactive "P")
	(save-excursion
	(or (transient-region-active-p)
	(mark-paragraph))
	(text-adjust-region (region-beginning) (region-end) force-kutouten-rule)))

	(defun text-adjust-buffer (&optional force-kutouten-rule)
	"バッファ内で関数 text-adjust を実行する."
	(interactive "P")
	(text-adjust-region (point-min) (point-max) force-kutouten-rule))

	(defun text-adjust-region (from to &optional force-kutouten-rule)
	"リージョン内で関数 text-adjust を実行する."
	(interactive "r\nP")
	(text-adjust-kutouten-read-rule force-kutouten-rule)
	(save-restriction
	(narrow-to-region from to)
	(text-adjust-codecheck-region (point-min) (point-max))
	(text-adjust-hankaku-region (point-min) (point-max))
	(text-adjust-kutouten-region (point-min) (point-max))
	(text-adjust-space-region (point-min) (point-max))
	; (text-adjust-fill)
	))


	;;;; text-adjust-codecheck
	;;;; jischeck.el より引用
	;;
	;; jischeck.el 19960827+19970214+19980406
	;; By TAMURA Kent <[email protected]>
	;; + akira yamada <[email protected]>
	;; + Takashi Ishioka <[email protected]>

	;; JIS X 0208-1983 で無効な範囲(数値は ISO-2022-JP での値):
	;; 1,2 Byte目が 0x00-0x20, 0x7f-0xff
	;; 1 Byte目: 0x29-0x2f, 0x75-0x7e
	;;
	;; 細かいところでは:
	;; 222f-2239, 2242-2249, 2251-225b, 226b-2271, 227a-227d
	;; 2321-232f, 233a-2340, 235b-2360, 237b-237e
	;; 2474-247e,
	;; 2577-257e,
	;; 2639-2640, 2659-267e,
	;; 2742-2750, 2772-277e,
	;; 2841-287e,
	;; 4f54-4f7e,
	;; 7425-747e,
	;;
	;;;; 引用終わり.

	;;;; 1 byte 目が 0x29-0x2f, 0x75-0x7e の文字にのみ対応.
	(or (if running-xemacs
	(defined-category-p ?@)
	(category-docstring ?@))
	(let ((page 41))
	(define-category ?@ "invalid japanese char category")
	(while (<= page 126)
	(if running-xemacs
	(modify-category-entry `[japanese-jisx0208 ,page] ?@)
	(modify-category-entry (make-char 'japanese-jisx0208 page) ?@))
	(setq page
	(if (= page 47) 117 (1+ page))))))

	(defun text-adjust-codecheck (&optional from to)
	"無効な文字コードを text-adjust-codecheck-alarm に置き換える.

	リージョンの指定があった場合はその範囲を, なければ mark-paragraph によって
	得られた範囲を対象にする."
	(interactive)
	(save-excursion
	(or (transient-region-active-p)
	(mark-paragraph))
	(text-adjust-codecheck-region (region-beginning) (region-end))))

	(defun text-adjust-codecheck-buffer ()
	"バッファ内で関数 text-adjust-jischeck を実行する."
	(interactive)
	(text-adjust-codecheck-region (point-min) (point-max)))

	(defun text-adjust-codecheck-region (from to)
	"リージョン内で関数 text-adjust-jischeck を実行する."
	(interactive "r")
	(text-adjust--replace text-adjust-rule-codecheck from to))


	;;;; text-adjust-hankaku
	(defun text-adjust-hankaku ()
	"全角英数文字を半角にする.

	リージョンの指定があった場合はその範囲を, なければ mark-paragraph によって
	得られた範囲を対象にする."
	(interactive)
	(save-excursion
	(or (transient-region-active-p)
	(mark-paragraph))
	(text-adjust-hankaku-region (region-beginning) (region-end))))

	(defun text-adjust-hankaku-buffer ()
	"バッファ内で関数 text-adjust-hankaku を実行する."
	(interactive)
	(text-adjust-hankaku-region (point-min) (point-max)))

	(defun text-adjust-hankaku-region (from to)
	"リージョン内で関数 text-adjust-hankaku を実行する."
	(interactive "r")
	(require 'japan-util)
	(save-excursion
	(let ((tmp-table (text-adjust--copy-char-table char-code-property-table)))
	(text-adjust--modify-char-table ?　 (list 'ascii " "))
	(mapcar '(lambda (c) (text-adjust--modify-char-table c nil))
	(string-to-list text-adjust-hankaku-except))
	(japanese-hankaku-region from to t)
	(setq char-code-property-table
	(text-adjust--copy-char-table tmp-table)))))

	(defun text-adjust--modify-char-table (range value)
	(if running-xemacs
	(put-char-table range value char-code-property-table)
	(set-char-table-range char-code-property-table range value)))

	(defun text-adjust--copy-char-table (table)
	(if running-xemacs
	(copy-char-table table)
	(copy-sequence table)))


	;;;; text-adjust-kutouten
	(defun text-adjust-kutouten (&optional forcep)
	"句読点を変換する.
	句点を text-adjust-kuten-from から text-adjust-kuten-to の値に,
	読点を text-adjust-touten-from から text-adjust-touten-to の値に変換する.

	リージョンの指定があった場合はその範囲を, なければ mark-paragraph によって
	得られた範囲を対象にする."
	(interactive)
	(save-excursion
	(or (transient-region-active-p)
	(mark-paragraph))
	(text-adjust-kutouten-region (region-beginning) (region-end) forcep)))

	(defun text-adjust-kutouten-buffer (&optional forcep)
	"バッファ内で関数 text-adjust-kutouten を実行する."
	(interactive "P")
	(text-adjust-kutouten-region (point-min) (point-max) forcep))

	(defun text-adjust-kutouten-region (from to &optional forcep)
	"リージョン内で関数 text-adjust-kutouten を実行する."
	(interactive "r\nP")
	(text-adjust-kutouten-read-rule forcep)
	(text-adjust--replace text-adjust-rule-kutouten from to))

	(defun text-adjust-kutouten-read-rule (&optional forcep)
	"変換後の句読点を選択する."
	(interactive)
	(if (and text-adjust-rule-kutouten (not forcep) (not (interactive-p)))
	text-adjust-rule-kutouten
	(make-local-variable 'text-adjust-rule-kutouten)
	(setq text-adjust-rule-kutouten
	(symbol-value
	(let ((kutouten-alist
	'(("kuten-zenkaku" . text-adjust-rule-kutouten-zkuten)
	("zenkaku-kuten" . text-adjust-rule-kutouten-zkuten)
	("、。" . text-adjust-rule-kutouten-zkuten)
	("period-zenkaku" . text-adjust-rule-kutouten-zperiod)
	("zenkaku-period" . text-adjust-rule-kutouten-zperiod)
	("，．" . text-adjust-rule-kutouten-zperiod)
	("period-hankaku" . text-adjust-rule-kutouten-hperiod)
	("hankaku-period" . text-adjust-rule-kutouten-hperiod)
	(",." . text-adjust-rule-kutouten-hperiod))))
	(cdr (assoc
	(completing-read "句読点の種類: " kutouten-alist
	nil t ",.")
	kutouten-alist)))))))

	;;;; text-adujst-space
	(defun text-adjust-space ()
	"半角英数と日本語の間に空白を挿入する.
	text-adjust-japanese で定義された日本語文字を示す正規表現と,
	text-adjust-ascii で定義された半角英数文字を示す正規表現との間に
	空白を挿入する.

	リージョンの指定があった場合はその範囲を, なければ mark-paragraph によって
	得られた範囲を対象にする."
	(interactive)
	(save-excursion
	(or (transient-region-active-p)
	(mark-paragraph))
	(text-adjust-space-region (region-beginning) (region-end))))

	(defun text-adjust-space-buffer ()
	"バッファ内で関数 text-adjust-space を実行する."
	(interactive)
	(text-adjust-space-region (point-min) (point-max)))

	(defun text-adjust-space-region (from to)
	"リージョン内で関数text-adjust-spaceを実行する."
	(interactive "r")
	(text-adjust--replace text-adjust-rule-space from to))


	;;;; text-adjust-fill
	(defun text-adjust-fill ()
	"句読点での改行を優先して, fill-region を実行する.
	各行の text-adjust-fill-start から, fill-column までの間に,
	text-adjust-fill-regexp が最後に含まれているところで改行する.

	リージョンの指定があった場合はその範囲を, なければ mark-paragraph によって
	得られた範囲を対象にする."
	(interactive)
	(save-excursion
	(or (transient-region-active-p)
	(mark-paragraph))
	(text-adjust-fill-region (region-beginning) (region-end))))

	(defun text-adjust-fill-buffer ()
	"バッファ内で関数 text-adjust-fill を実行する."
	(interactive)
	(text-adjust-fill-region (point-min) (point-max)))

	(defun text-adjust-fill-region (from to)
	"リージョン内で関数 text-adjust-fill を実行する."
	(interactive "r")
	(save-excursion
	(save-restriction
	(narrow-to-region from to)
	(let ((kinsoku-tmp kinsoku-ascii)
	(prefix (if adaptive-fill-mode (fill-context-prefix from to) "")))
	(setq kinsoku-ascii t)
	(fill-region (point-min) (point-max))
	(goto-char (point-min))
	(while (/= (line-end-position) (point-max))
	(move-to-column text-adjust-fill-start)
	(if (and (re-search-forward
	(concat "\\(" text-adjust-fill-regexp
	"\\) [^" text-adjust-fill-regexp "]$")
	(line-end-position) t))
	(progn
	(goto-char (match-end 1))
	(delete-horizontal-space)
	(if (eolp)
	(beginning-of-line 2)
	(progn
	(insert (concat "\n" prefix))
	(beginning-of-line)
	)))
	(beginning-of-line 2))
	(narrow-to-region (point) (point-max))
	(fill-region (point-min) to nil nil t)
	(goto-char (point-min)))
	(delete-horizontal-space)
	(setq kinsoku-ascii kinsoku-tmp)))))


	;;;; text-adjust engine
	(defun text-adjust--replace (rule from to)
	(save-excursion
	(save-restriction
	(narrow-to-region from to)
	(goto-char (point-min))
	(let* ((rule-pattern
	(text-adjust--make-rule-pattern
	(append (cdr (assoc major-mode text-adjust-mode-skip-rule))
	rule)))
	(regexp (nth 0 rule-pattern))
	(target (nth 1 rule-pattern))
	(counts (nth 2 rule-pattern)))
	(while (re-search-forward regexp nil t)
	(let ((n 1) (m 0) right-string)
	; 該当パターンまですすめる
	(while (not (match-beginning n))
	(setq n (+ n 3 (mapadd (nth m counts)))
	m (1+ m)))
	; 該当パターンと置換する
	(let* ((tmp n)
	(total-counts
	(cons n (mapcar (lambda (x) (setq tmp (+ tmp x 1)))
	(nth m counts))))
	(right-string (match-string (nth 2 total-counts))))
	(replace-match
	(concat
	;; 該当パターンの左側
	(match-string n)
	;; 該当パターンのまん中 (置換部分)
	(mapconcat
	(lambda (x)
	(if (stringp x) x
	(match-string (+ (nth (1- (car x)) total-counts)
	(cdr x)))))
	(nth m target) "")
	;; 該当パターンの右側
	right-string))
	;; "あaあa" のように一文字ずつで並んでいる時の対処
	(backward-char (length right-string))))))
	)))

	(defun text-adjust--make-rule-pattern (rule)
	(let ((regexp (mapconcat
	(lambda (x)
	(format "\\(%s\\)\\(%s\\)\\(%s\\)"
	(nth 0 (car x)) (nth 1 (car x)) (nth 2 (car x))))
	rule "\\\|"))
	(target (mapcar
	(lambda (x)
	(text-adjust--parse-replace-string (nth 1 x)))
	rule))
	(counts (mapcar
	(lambda (x)
	(list (count-string-match "\\\\(" (nth 0 (car x)))
	(count-string-match "\\\\(" (nth 1 (car x)))
	(count-string-match "\\\\(" (nth 2 (car x)))))
	rule)))
	(list regexp target counts)))

	(defun text-adjust--parse-replace-string (rule)
	(let ((n 0) m list)
	(while (string-match "\\([^{]*\\){\\([^}]+\\)}" rule n)
	(setq n (match-end 0))
	(let ((match1 (match-string 1 rule))
	(match2 (match-string 2 rule)))
	(cond ((string-match "^[0-9]+\\(-[0-9]+\\)?$" match2)
	(or (string= match1 "") (setq list (cons match1 list)))
	(let* ((tmp (split-string match2 "-"))
	(num (cons (string-to-number (car tmp))
	(string-to-number (or (nth 1 tmp) "0")))))
	(setq list (cons num list))))
	(t
	(setq list (cons match2 (cons match1 list)))))))
	(reverse (cons (substring rule n) list))))


	(provide 'text-adjust)
	; $Id: text-adjust.el,v 1.1.1.1 2002/08/25 14:24:48 komatsu Exp $

	;;; text-adjust.el ends here