;;;
;;; 埋め込みメモモード
;;;
;;; -->どういうものか？
;;;    プログラムのコメント段落(行頭がコメント文字である一連の行)をスキャ
;;;    ンし、メモモードに移行する。そして、コメント段落の編集が終わるとき、
;;;    C-c C-c でもとのプログラムにその編集を反映する。
;;;    
;;; -->セットアップ
;;;    Emacs-Lisp で使うなら、 
;;;    (define-key emacs-lisp-mode-map "\C-c\C-m" 'embedded-memo)
;;;    と emacs-lisp-mode-hook にでも書いておく。
;;;    
;;; -->新たにコメント段落を編集する。
;;;    Emacs-Lisp なら、行頭に
;;;    ;;;
;;;    と書いた後、 C-c C-m。
;;;    
;;; -->既存のコメント段落を編集する。
;;;    コメント段落の任意の場所で C-c C-m。
;;;    
;;; -->注意
;;;    まだテスト版なので、動作が安定してから memo-mode.el に入れます。
;;;

;;; [1999/02/10 00:49]なんとか完成
;;; [1999/02/10 00:49]行頭で embedded-memo を実行すると無限ループに陥るバグ発見
;;; -->[1999/02/10 07:23]memo-get-this-comment-paragraphを変更。
;;; [1999/02/11 08:49]行頭にスペースがあるコメント段落も認める。
;;; -->単に正規表現に [ \t]* を付け加えただけ。
;;; [1999/02/11 20:50]
;;; -->memo-mode 起動時に、直前の major-mode を保存するようにした。
;;;    これによって、任意のモード、任意のバッファで memo-mode を起動できるようになった。
;;;   -->コメント段落においては embedded-memo が起動。
;;;   -->そうでない行においては memo-mode 起動。
;;; [1999/03/27 20:34]
;;; -->embedded-memo に入るとき出るときに現在行を反映
;;; -->embedded-memo の編集を反映させた元バッファを保存できるようにした

(require 'memo-mode)

(defvar embedded-memo-entrance-line 1
  "Embedded-memoに入るときのカーソルが何行目にあるか")

(defun memo-get-this-comment-paragraph ()
  "ポイントが属するコメント段落の範囲を得る。(cons begin end) の形で返す。コメント段落でないときは nil を返す。
"
  (interactive)
  (save-excursion
    (beginning-of-line)
    (let ((regexp (concat "^[ \t]*\\(" comment-start "\\)+")))
      (if (and comment-start
               (not (string= comment-start ""))
               (looking-at regexp) )
          (let* ((center (point))
                 begin end bl cl)
            ;;段落の始めを求める
            (while (progn
                     (forward-line -1)
                     (and (looking-at regexp) (not (bobp)))))
            (if (not (bobp)) (forward-line 1))
            (setq begin (point)
                  bl (current-line))
            ;;段落の終わりを求める
            (goto-char center)
            (setq cl (current-line))
            (setq embedded-memo-entrance-line (- cl bl))
            (while (progn
                     (forward-line 1)
                     (and (looking-at regexp) (not (eobp)))))
            (setq end (point))
            (cons begin end)
            )
        nil))))

(defun embedded-memo-init (orig-buf beg end)
  "埋め込みメモのための初期化を行う。"
  (switch-to-buffer
   (generate-new-buffer
    (concat "*embedded-memo " (buffer-name orig-buf) " (" (int-to-string beg) " .. " (int-to-string end) ")*")))
  (embedded-memo-mode)
  (setq embedded-memo-orig-buffer orig-buf
        embedded-memo-begin beg
        embedded-memo-end   end)        ; They are local variables.
  (let (comment-str)
    (insert (save-excursion
              (set-buffer orig-buf)
              (setq comment-str comment-start)
              (buffer-substring beg end)))
    (goto-char (point-min))
    ;;行頭のコメント文字を取り除く
    (looking-at (concat "^[ \t]*\\(" comment-str "\\)+")))
  (let ((length (length (setq embedded-memo-comment-string (match-string 0)))))
    (delete-char length)
    (while (progn
             (forward-line 1)
             (not (eobp))) 
      (delete-char length)
      ))
  (set-buffer-modified-p nil)
  (goto-char (point-min))
  (forward-line embedded-memo-entrance-line)
  )

;;; buffer-local variables
(defvar embedded-memo-orig-buffer nil "元のバッファ")
(defvar embedded-memo-begin nil "元のバッファにおける埋め込みメモ開始位置")
(defvar embedded-memo-end nil "元のバッファにおける埋め込みメモ終了位置")
(defvar embedded-memo-comment-string nil "元のバッファにおける行頭コメント。
埋め込みメモに入ったとき、この変数の内容は取り除かれ、
もとのバッファに復帰するときに付加する。")

(define-derived-mode embedded-memo-mode memo-mode "EmbedMemo"
  "埋め込みメモモード。プログラムのコメントの中にメモを埋め込むモード。
\\{embedded-memo-mode-map}"
  (define-key embedded-memo-mode-map "\C-c\C-c" 'embedded-memo-exit)
  (define-key embedded-memo-mode-map "\C-x\C-s" 'embedded-memo-save-buffer)
  (mapcar 'make-local-variable
          '(embedded-memo-orig-buffer
            embedded-memo-begin embedded-memo-end embedded-memo-comment-string))
  (message "%s" (substitute-command-keys
                 "Type '\\[embedded-memo-exit]' for exiting embedded-memo-mode.")))

(defun embedded-memo ()
  "埋め込みメモモードに入る。"
  (interactive)
  (let* ((orig-buf (current-buffer))
         (ret (memo-get-this-comment-paragraph))
         (beg (car ret))
         (end (cdr ret)))
    (if ret
        (embedded-memo-init orig-buf beg end)
      (memo-mode)
      (message (substitute-command-keys "Type '\\[memo-mode-exit]' to exit memo-mode.")))
    ))

(defun embedded-memo-save-buffer ()
  "埋め込みメモモードの変更を元のバッファに反映させ、セーブする。"
  (interactive)
  (embedded-memo-exit 'save))

(defun embedded-memo-exit (&optional todo)
  "埋め込みメモモードから抜けて、変更を元のバッファに反映する。
もし TODO が save なら、埋め込みメモモードを抜けない代わりに、
元のバッファをセーブする。"
  (interactive)
  (let ((buf (current-buffer))
        (beg embedded-memo-begin) (end embedded-memo-end)
        (line (current-line))
        (orig-buf embedded-memo-orig-buffer)
        (comment-str embedded-memo-comment-string))
    (if (buffer-modified-p)
        (save-excursion
          (set-buffer orig-buf)
          (save-excursion
            (save-restriction
              ;;copy to the original buffer
              (narrow-to-region beg end)
              (delete-region beg end)
              (insert-buffer buf)
              (if (progn
                    (goto-char (point-max)) (> (current-column) 0))
                  (insert "\n"))
              (goto-char (point-min))
              (while (progn
                       (beginning-of-line)
                       (insert comment-str)
                       (forward-line 1)
                       (not (eobp))))))))
    (cond ((eq todo 'save)
           (set-buffer-modified-p nil)
           (save-excursion
             (set-buffer orig-buf)
             (save-buffer)))
          (t                            ;otherwise exit embedded-memo
           (switch-to-buffer orig-buf)
           (goto-char beg) (forward-line line)
           (kill-buffer buf)))))

(defun current-line ()
  "Return the vertical position of point..."
  (+ (count-lines (window-start) (point))
     (if (= (current-column) 0) 1 0)
     -1))

;;; match-string
(or (fboundp 'match-string)
    ;; Introduced in Emacs 19.29.
    (defun match-string (num &optional string)
  "Return string of text matched by last search.
NUM specifies which parenthesized expression in the last regexp.
 Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
Zero means the entire text matched by the whole regexp or whole string.
STRING should be given if the last search was by `string-match' on STRING."
  (if (match-beginning num)
      (if string
	  (substring string (match-beginning num) (match-end num))
	(buffer-substring (match-beginning num) (match-end num))))))

(provide 'embed-memo)