TSfree 発言

みなさまへ

　諸事に追われ、アップする余裕がありませんでした。
　どうぞ改善提案をお願いします。ただ反応は遅れがちになるかも知れません。失礼の段はお許しください。

　みずは

;;footnote.l --- footnote
;;Copyright (C) 2005 RAMIFA
;;ported by MIZUHA,Nobuo

#|
■概要　脚注をつけるための拡張Lisp
　オリジナルのMeadow版はRAMIFAさん作。
　xyzzy lisp への移植は水羽の試行版。使用に際しては十分注意が必要。
　また不具合については、私の能力では対応できかねます。改善提案をお願いします。
　また移植版について現作者へ質問することはご遠慮ください。
■謝辞
　footnote.elの作者・RAMIFAさん
　Emacslisp移植キットの作者・manabu@...さん
　xyzzy Lisp Programmingの著者・Makoto Hiroiさん
　『入門xyzzy』（オーム社、2005年）の著者・山本泰三／日江政弘／稲原知久／佐野匡俊の皆さん
　そしてxyzzyの作者・亀井哲弥さん
　衷心よりお礼申し上げます。
■設定
１）Emacslisp移植キットを有効にする
　/xyzzy/lisp/などにemacs.lとelsip.lをおき、
　.xyzzyに(require "emacs")などと記述する
２）footnote-modeを作成して/xyzzy/lispなどにおく
３）.xyzzyに次のように記述する
　(autoload 'footnote-menu "footnote" t)
　(autoload 'fn-mode "footnotemode" t)
　(setq *auto-mode-alist*
     (append '(("\\.fot$" . fn-mode)) *auto-mode-alist*))
　(global-set-key '(#\C-c #\C-m) 'footnote-menu)
■使用方法（RAMIFAさんのオリジナルファイルよりより）
 M-x footnote-menu か、上で割り当てたキーで、エコーラインに
 n)ew e)dit s)how d)el r)earrange c)heck q)uit
 というメニューが表示されます。続けて n,e,s,d,r,c,q を押すと、それぞれの
 コマンドが実行されます。次のような仕事をします。
 new ......... カーソル位置に新規に脚注を入れる。
 edit ........ カーソルの下にある脚注の編集。
 show ........ 対応する脚注の中身を表示。
 del ......... 脚注番号を削除すると共に、対応する脚注の中身を削除。
 rearrange ... 脚注番号の整列と、脚注ファイルの中身の順番の整列。
 check ....... 脚注ファイルの整合性チェック。
 quit ........ 何もしない。(結果的に C-g と同じ)。
 footnote-mode (脚注ファイルを書く時のモード) は、基本的にはテキスト
 モードなのですが、次のコマンドを追加してあります。
 C-c C-c (footnote-mode-quit) ..... 中身を保存して抜ける。
 C-c C-j (footnote-mode-jump) ..... 対応する本文の脚注番号の箇所にジャンプ。
 C-c C-n (footnote-mode-narrow) ... 現在書いている中身にナローイング。
 なお、普通に footnote-menu から n や e で脚注の編集に入った時には、
 自動的にナローイングがかかるようになってます。C-x n w (widen) など
 の標準コマンドで元の表示に戻ります。
 バグ等...
 del コマンドを使わずに脚注番号のみを消してしまった場合にそれ以降の
 操作で、つじつまが合わなくなるかもしれない。(真面目に動作を考えてな
 かったりする。^^
 その他、いろいろバグが潜んでるかもしれない…。
 それでは、注意してお楽しみ下さい。
■emacs lisp と xyzzy lispの違い
関数定義におけるコメントの位置
■ライセンス
　footnote.elの原著者のRAMIFAさんに従います。
　
This program is free software
 it under the terms of the GNU General Public License as published by
 the Free Software Foundation
 any later version.
 This program is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 GNU General Public License for more details.
 You should have received a copy of the GNU General Public License
 along with this program
 program's author (see below) or write to:
              The Free Software Foundation, Inc.
              675 Mass Ave.
              Cambridge, MA 02139, USA.
|#

(defconstant footnote-version "$Id: footnote.el,v 1.7 2005/04/11 09:00:52 matsu Exp matsu $")

(provide 'footnote)

(defvar footnote-file "~/.FootNote")

(defvar footnote-mark-default "@")

(defvar footnote-mark footnote-mark-default)

(defun footnote-start (&optional number)
  (elisp::concat "<foot num=" (if number
				  (elisp::number-to-string number)
				"\\([0-9]+\\)") ">"))

(defun footnote-start-regexp (&optional number)
  (if number
      (elisp::concat "<foot num=\\(" (elisp::number-to-string number) "\\)>")
    (elisp::concat "^" (footnote-start number) "$")))

(defun footnote-end (&optional number)
  (elisp::concat "</foot>"))

(defun footnote-mark-string (&optional number)
  (elisp::concat footnote-mark (if number 
			    (elisp::number-to-string number) 
			  "\\([0-9]+\\)") ":"))

(defun footnote-mark-regexp (&optional number)
  (footnote-mark-string number))

(defun footnote-menu ()
  (interactive)
  (toggle-ime nil)
  (message "n)ew e)dit s)how d)el r)earrange c)heck q)uit")
  (let ((c (read-char *keyboard*)))
    (cond
     ((char= c #\n) (footnote-new))
     ((char= c #\N) (footnote-new))
     ((char= c #\e) (footnote-edit))
     ((char= c #\E) (footnote-edit))
     ((char= c #\s) (footnote-show))
     ((char= c #\S) (footnote-show))
     ((char= c #\d) (footnote-del))
     ((char= c #\D) (footnote-del))
     ((char= c #\r) (footnote-rearrange-mark-number))
     ((char= c #\R) (footnote-rearrange-mark-number))
     ((char= c #\c) (footnote-check-footnote-number))
     ((char= c #\C) (footnote-check-footnote-number))
     ((char= c #\q) (footnote-quit))
     ((char= c #\Q) (footnote-quit))
     )))

(defun footnote-mode-narrow ()
  (interactive)
  (if (or (looking-at (footnote-start-regexp))
	  (elisp::re-search-backward (footnote-start-regexp) nil t))
      (let* ((number (parse-integer (match-string 1)))
	     (start-end (footnote-get-content-start-end number))
	     (start (car start-end))
	     (end (car (cdr start-end))))
	(message "use C-x w to widen")
	(narrow-to-region start end))
    (message "buffer may be already narrowed")))

(defun footnote-mode-jump ()
  (interactive)
  (widen)
  (beginning-of-line)
  (if (or (looking-at (footnote-start-regexp))
	  (elisp::re-search-backward (footnote-start-regexp) nil t))
      (let* ((footnote-filename (buffer-name (selected-buffer)))
	     (fn (substring footnote-filename 0 (- (length footnote-filename) 4)))
	     (number (match-string 1)))
	(other-window)
	(set-buffer fn)
	(set-window (selected-window))
	(goto-char (point-min))
	(elisp::re-search-forward (footnote-mark-regexp number))
	(elisp::re-search-backward footnote-mark))))

(defun footnote-mode-quit ()
  (interactive)
  (footnote-rearrange-footnote)
  (elisp::save-buffer)
  (write-file (buffer-name (selected-buffer)))
  (delete-buffer (buffer-name (selected-buffer)))
  (delete-window))

;;footnote-rearrange-footnoteを追加

(defun footnote-edit ()
  (interactive)
  (let ((number (footnote-get-number-at-point))
	start-end start end)
    (if (null number)
	(if (y-or-n-p "Not on footnote mark. insert new one?")
	    (footnote-new))
	(progn
	  (setq filename (buffer-name (selected-buffer))
		foot-filename (elisp::concat filename ".fot"))
	  (delete-other-windows)
	  (split-window 16 nil)
	  (recenter)
	  (other-window 1)
	  (footnote-open-foot-file)
	  (switch-to-buffer foot-filename)
	  (widen)
	  (goto-char (point-min))
	      (if (null (setq start-end (footnote-get-start-end number)))
		  (progn
		    (goto-char (point-max))
		    (previous-line 2)
		    (insert (elisp::concat "\n" (footnote-start number) "\n"))
		    (setq start (point))
		    (insert (elisp::concat "\n" (footnote-end number) "\n"))
		    (previous-line 1)
		    (beginning-of-line)
		    (narrow-to-region start (1- (point)))
		    (fn-mode))
		(progn
		  (setq start-end (footnote-get-content-start-end number))
		  (setq start (car start-end)
			end (car (cdr start-end)))
		  (narrow-to-region start end)
		  (fn-mode))))
      )))

(defun footnote-new ()
  (interactive)
  (let ((number 0)
	(buf (buffer-name (selected-buffer))))
    (if (save-excursion
	  (save-restriction
	    (widen)
	    (elisp::re-search-backward (footnote-mark-regexp) nil t)))
	(setq number (parse-integer (match-string 1))))
    (insert (footnote-mark-string (setq number (1+ number))))
    (save-excursion
      (save-restriction
	(let ((bound (point)) num1 num2)
	  (widen)
	  (goto-char (point-max))
	  (while (elisp::re-search-backward (footnote-mark-regexp) bound t)
    	    (setq num1 (parse-integer (match-string 1)))
	    (setq num2 (1+ num1))
	    (goto-char (match-beginning 0))
	    (delete-region (match-beginning 0) (match-end 0))
	    (insert (footnote-mark-string num2))
	    (backward-char 4)
	    (footnote-open-foot-file)
	    (footnote-replace-number num1 num2)
	    (set-buffer buf)))))
    (elisp::re-search-backward footnote-mark nil t)
    (footnote-edit)
    ))


(defun footnote-replace-number (num1 num2)
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (elisp::re-search-forward (footnote-start-regexp num1) nil t)
      (goto-char (match-beginning 0))
      (delete-region (match-beginning 0) (match-end 0))
      (insert (footnote-start num2)))))

(defun footnote-open-main-file ()
  (interactive)
  (let* ((foot-filename (elisp::buffer-file-name))
	 (check (substring foot-filename (- (length foot-filename) 4)))
	 (filename (substring foot-filename 0 (- (length foot-filename) 4))))
    (if (not (equal check ".fot"))
	(if (interactive-p)
	    (message "This file is not footnote file."))
      (if (elisp::file-exists-p filename)
	  (set-buffer (get-file-buffer filename))
	(if (interactive-p)
	    (message "Couldn't find main file"))))))

(defun footnote-open-foot-file ()
  (interactive)
  (elisp::save-buffer)
  (let* ((filename (elisp::buffer-file-name))
	 (foot-filename (elisp::concat filename ".fot")))
    (if filename
	(if (elisp::file-exists-p foot-filename)
	    (progn
	      (elisp::find-file-noselect foot-filename)
	      (set-buffer (get-file-buffer foot-filename))
	      (elisp::current-buffer))
	  (progn
	    (elisp::find-file-noselect foot-filename)
	    (set-buffer (get-file-buffer foot-filename))
	    (insert "<footnote>\n\n</footnote>\n")
	    (elisp::current-buffer))
	  ))))

(defun footnote-get-number-at-point ()
  (save-excursion
    (progn
      (looking-at (footnote-mark-regexp))
      (match-string 1))))

(defun footnote-get-start-end (number)
  (save-excursion
    (save-restriction
      (let (start end)
	(widen)
	(goto-char (point-min))
	(if (and (setq start
		       (if (elisp::re-search-forward (footnote-start number) nil t)
			   (match-beginning 0)))
		 (setq end (elisp::re-search-forward (footnote-end number) nil t)))
	    (list start end))))))

(defun footnote-get-content-start-end (number)
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (if (and number
	       (setq start
		     (if (elisp::re-search-forward (footnote-start number) nil t)
			 (progn
			   (goto-char (match-beginning 0))
			   (forward-line 1)
			   (point))))
	       (setq end
		     (if (elisp::re-search-forward (footnote-end number) nil t)
			 (progn
			   (goto-char (match-end 0))
			   (previous-line 1)
			   (end-of-line)
			   (point)))
		     ))
	  (list start end)))))

(defun footnote-show ()
  (interactive)
  (let ((number (footnote-get-number-at-point))
	(window (selected-window))
	(buf (elisp::current-buffer))
	(point (point))
	start-end fbuf)
    (if (and number
	     (footnote-open-foot-file)
	     (setq start-end (footnote-get-content-start-end number)))
	(progn
	  (narrow-to-region (car start-end) (car (cdr start-end)))
	  (delete-other-windows)
	  (split-window -14 nil)
	  (recenter)
	  (other-window)
	  (set-buffer buf)
	  (set-window window)
	  (goto-char point)
	  )
      (message "Couldn't find footnote!"))
    ))

(defun footnote-del ()
  (interactive)
  (if (null (looking-at (footnote-mark-regexp)))
      (message "You are not on footnote mark.")
    (let ((start (match-beginning 0))
	  (end (match-end 0))
	  (number (match-string 1)))
      (if (yes-or-no-p "Delete the content of footnote at position?")
	  (save-excursion
	    (save-restriction
	      (let ((buf (elisp::current-buffer))
		    start-end)
		(if (and (footnote-open-foot-file)
			 (setq start-end (footnote-get-start-end number)))
		    (progn
		      (widen)
		      (delete-region (car start-end) (car (cdr start-end)))
		      (elisp::save-buffer)
		      (set-buffer buf)
		      (delete-region start end)
		      (elisp::save-buffer)
		      (footnote-rearrange-mark-number))
		  (message "Couldn't find footnote!")
		  ))))))))

(defun footnote-rearrange-mark-number ()
  (interactive)
  (save-excursion
    (save-restriction
      (let (list1 key num1
		 (num2 0))
		(widen)
		(goto-char (point-min))
		(while (elisp::re-search-forward (footnote-mark-regexp) nil t)
		  (setq num1 (parse-integer (match-string 1))
			num2 (1+ num2)
			list1 (append list1 (list (cons num1 num2))))
		  (goto-char (match-beginning 0))
		  (delete-region (match-beginning 0) (match-end 0))
		  (insert (footnote-mark-string num2)))
	(footnote-open-foot-file)
	(save-excursion
	  (save-restriction
	    (widen)
	    (goto-char (point-min))
	    (while (elisp::re-search-forward (footnote-start-regexp) nil t)
	      (setq key (parse-integer (match-string 1)))
	      (goto-char (match-beginning 0))
	      (delete-region (match-beginning 0) (match-end 0))
	      (insert (footnote-start (cdr (elisp::assq key list1))))))))
      (footnote-rearrange-footnote))))
  
(defun footnote-quit ()
  (interactive)
  (footnote-rearrange-footnote-file)
  (elisp::save-buffer)
  (delete-window)
  )
;;footnote-rearrange-footnote-fileを追加

(defun footnote-rearrange-footnote-file ()
  (interactive)
  (if (footnote-open-foot-file)
      (footnote-rearrange-footnote)))

(defun footnote-rearrange-footnote ()
  (save-excursion
    (save-restriction
      (let (number
	    list1
	    start-end start end)
	(widen)
	(goto-char (point-min))
	(while (elisp::re-search-forward (footnote-start-regexp) nil t)
	  (setq number (parse-integer (match-string 1))
		start-end (footnote-get-start-end number)
		start (car start-end)
		end (car (cdr start-end)))
	  (setq list1
		(append list1 (list (cons number
					 (buffer-substring start end))))))
	(delete-region (point-min) (point-max))
	(setq list1
	      (sort list1 (lambda (a b) (< (car a) (car b)))))
	(insert "<footnote>\n\n\n</footnote>\n")
	(previous-line 2)
	(mapcar (function (lambda (x) (insert (cdr x) "\n\n"))) list1)
	(elisp::save-buffer)))))

(defun footnote-content-check ()
  (interactive)
  (let ((buf (elisp::current-buffer))
	num
	(num-list)
	(red-list))
    (footnote-open-foot-file)
    (save-excursion
      (save-restriction
	(widen)
	(goto-char (point-min))
	(while (elisp::re-search-forward (footnote-start-regexp) nil t)
	  (setq num (parse-integer (match-string 1)))
	  (if (elisp::memq num num-list)
	      (setq red-list (append red-list (list num)))
	    (setq num-list (append num-list (list num)))))
	(footnote-open-main-file)
	(save-excursion
	  (save-restriction
	    (widen)
	    (goto-char (point-min))
	    (while (elisp::re-search-forward (footnote-mark-regexp) nil t)
	      (setq num (parse-integer (match-string 1)))
	      (setq num-list (elisp::delq num num-list)))
	    (cons (sort num-list '<) (sort red-list '<))))))))

(defun footnote-mark-check ()
  (interactive)
  (let (mark-list
	foot-list
	num
	red-list)
    (save-excursion
      (save-restriction
	(widen)
	(goto-char (point-min))
	(while (elisp::re-search-forward (footnote-mark-regexp) nil t)
	  (setq num (parse-integer (match-string 1)))
	  (if (memq num mark-list)
	      (setq red-list (append red-list (list num)))
	    (setq mark-list (append mark-list (list num)))))
	(footnote-open-foot-file)
	(save-excursion
	  (save-restriction
	    (widen)
	    (goto-char (point-min))
	    (while (elisp::re-search-forward (footnote-start-regexp) nil t)
	      (setq num (parse-integer (match-string 1)))
	      (setq mark-list (elisp::delq num mark-list)))
	    (cons (sort mark-list '<) (sort red-list '<))))))))

(defun footnote-check-footnote-number ()
  (interactive)
  (let* ((lists (cdr (footnote-content-check)))
	 marks)
    (if (null lists)
	(message "Good, no redundant mark.")
      (progn
	(setq marks (car lists))
	(setq lst (cdr lists))
	(while lst
	  (setq marks (elisp::concat marks ", " (car lst)))
	  (setq lst (cdr lst)))
	(cond ((> (length lists) 1)
	       (message "Number ~D are used by different footnotes." marks))
	      ((= (length lists) 1)
	       (message "Number ~D is used by different footnotes." marks)))))))