;;;-*- Emacs-Lisp -*- 

;;; 
;;; memo.el: メモ書きモード (memo mode with autoliner type for Emacs/Mule.)
;;; 
;;;     Jan.28,'96. OSHIRO Naoki.
;;;   
;;;
;;;     Revision 1.3  1997/12/17 18:56:23  oshiro
;;;     *** empty log message ***
;;;
;;;     Revision 1.1  1996/10/07 18:34:30+09  oshiro
;;;     Initial revision
;;;
;;;
;;;  [1996/04/04] Add indentation function.
;;;  [1996/07/01] Correct TAB regular expression.
;;;  [1996/09/06] memo-new-entry
;;;  [1996/09/20] Add third argument 't' to re-search-*.
;;;  [1996/09/24] Reinforcement indent function with smart previous 
;;;               line observation.
;;;  [1996/10/04] Make thread-indent* (function declaration only :->).
;;;  [1996/10/08] Write actual contents thread-indent*.
;;;  [1996/10/15] add memo-delete-char
;;;  [1996/10/18] fix memo-indent (add save-excursion)
;;;               replace string-width to length (for Emacs compatibility)
;;;  [1996/10/22] change memo-delete-char behavior:
;;;               it don't delete spaces on end of line.
;;;  [1996/10/23] fix indent for empty-line.
;;;               change memo-beginning-of-line more smart.
;;;               change cursor point after memo-indent to fit behavior.
;;;  [1996/10/28] Make memo-kill-entry.
;;;  [1996/10/29] fix memo-indent.
;;;  [1997/01/09] bind auto-fill-mode.
;;;  [1997/08/20] Add memo-skip-header.
;;;  [1997/09/14] new-entry fixed behavior on entry-separated-tag line. 
;;;               Changed behavior kill-entry which start point 
;;;               as next line of entry-separated-tag.
;;;               Add copy-entry-as-kill, and bind to key-map.
;;;  [1997/12/05] Map memo-indet function to indent-line-function.
;;;               Change function name memo-indent to memo-indent-line.
;;;               Comment out setq of auto-fill-hook
;;;               (because obsolete variable?).
;;;  [1997/12/07] Add memo-indent-new-comment-line function
;;;               (take from YaTeX package).
;;;  [1997/12/12] Add memo-{next|previous}-entry.
;;;  [1997/12/18] Change action of memo-previous-line-indent function
;;;               that don't change left-margin variable and return number
;;;               of indent column.
;;;               Add memo-current-line-indent function.
;;;               Add memo-item-line-indent function.
;;;               Add memo-delete-backward-char function.
;;;  [1998/01/18] Change memo-item-line-indent
;;;               (re-search-backward memo-entry-separated-tag).
;;;  [1998/01/23] Add set-window-start to memo-skip-header.
;;;  [1998/01/24] Add memo-description, memo-get-header-description, 
;;;  [1998/04/01] Add memo-entry-move-to-{top|last}.
;;;  [1998/08/28] Add memo-mode-header.
;;;  [1998/12/30] Summary mode created.
;;;  [1999/01/20] Summary header truncate suitable for window width.
;;;  [1999/01/24] Kawamura patch
;;;               outline-mode setting fix.
;;;               case apply hilit19 and font-lock.
;;;               summary-mode fix.
;;;  [1999/01/24] Kawamura patch
;;;               summary buffer read only.
;;;               font-lock.
;;;  [1999/01/25] Add memo-edit-other-file function.
;;;               Add memo-get-file-tag-at-line function.
;;;               Key-bind 'C-c LETTER' changed to suitable one.
;;;  [1999/01/26] Add memo-open-tag function.
;;;               Add memo-send-url-to-browser function.
;;;  [1999/01/27] open-tag: change shell-command to start-process.
;;;

;;;
;;; Configuration:
;;;
;;;   Insert follow line in your ~/.emacs file
;;;
;;;     (autoload 'memo-mode "memo-mode" "Memo mode" t)
;;;

;;;
;;; Todo: 
;;;
;;;   [1996/06/28]
;;;   ・インデントを項目別に初期化する．
;;;   ・@インデントのクリアのみを行うキーバインドを作る．
;;;   ・指定領域のインデントの増減．
;;;   [1996/10/04]
;;;   ・@階層の一括インデント増減
;;;   [1996/10/07]
;;;   ・@string-width 関数は Emacs では標準じゃないらしい．どうする？
;;;       -->length 関数に変えてみた
;;;   [1996/10/18]
;;;   ・memo-indent は，なぜ行頭のスペースで呼び出すとゼロカラムへ
;;;     カーソルが移動するのか？
;;;   [1996/10/18]
;;;   ・entry-tag の直前の行で C-u C-c > をやると '>>>' というゴミが出る．
;;;       -->いまやったらでなかった？？？
;;;       -->間違って C-u > としていたのが原因だった．
;;;          キーストロークが複雑すぎるか？
;;;   [1996/10/23]
;;;   ・@なんでカーソルがゼロカラムにあるとインデントしてくれないの (;_;)？
;;;   [1996/10/28]
;;;   ・@memo-kill-entry: メモの項目を kill-region する
;;;   ・memo-kill-thread: メモの枝を kill-region する
;;;   [1996/10/29]
;;;   ・@インデントする必要がないときに TAB を押すとすこしずつ行頭へ寄っていくよ？
;;;   [1996/11/12]
;;;   ・@[1997/01/09]
;;;     インデントモードを簡単に切り替えられるように，トグルキーバインドを．
;;;   [1996/12/22]
;;;   ・memo-sort で，各種インデックス（メモの日付など）で整列する．
;;;   [1997/05/13]
;;;   ・make new-memo-file: file-find + c-prologue + memo-mode (+ mode-head)
;;;   [1997/08/25]
;;;   ・make memo-save-entry-other-file メモエントリを指定したファイルの冒頭
;;;     または末尾に移動する．
;;;     -->メモの整理に役立つ
;;;

(require 'get-date)

(defvar memo-mode-hook nil "")
(defvar memo-mode-map nil "")
(defvar memo-prefix-map nil "")
(defvar memo-prefix "\C-c" "Memo prefix")
(defvar memo-indent-level 2 "*Indentation of Memo statements.")
(defvar memo-item "-->")
(defvar memo-entry-separated-tag "^---[ \t]*$")
(defvar memo-comment-prefix "#")
(defvar memo-fill-prefix "")
(defvar memo-fill-column 70)
(defvar memo-paragraph-start (concat "^[ \t]*" memo-item "\\|" memo-entry-separated-tag))
(defvar memo-paragraph-separate (concat "^[ \t]*" memo-item "\\|" memo-entry-separated-tag))
(defvar Memo-version "$Id: memo-mode.el,v 1.2 2003/01/16 21:17:28 akihisa Exp $")

(if memo-mode-map
    ()
  (setq memo-mode-map   (make-sparse-keymap))
  (setq memo-prefix-map (make-sparse-keymap))
  (define-key memo-mode-map memo-prefix memo-prefix-map)
  (define-key memo-mode-map "a"  'memo-beginning-of-line)
  ;(define-key memo-mode-map "p"  'memo-previous-line)
  ;(define-key memo-mode-map "n"  'memo-next-line)
  (define-key memo-mode-map "p"  'memo-previous-entry)
  (define-key memo-mode-map "n"  'memo-next-entry)
  (define-key memo-mode-map "\C-a" 'memo-beginning-of-line)
  (define-key memo-mode-map "\C-m" 'memo-newline-and-indent)
  (define-key memo-mode-map "\C-d" 'memo-delete-char)
  (define-key memo-mode-map ""   'memo-delete-backward-char)
  (define-key memo-mode-map "\t" 'memo-indent-line)
  (define-key memo-prefix-map "\C-d" 'get-date)
  (define-key memo-prefix-map "\ed" 'get-dtime)
  (define-key memo-prefix-map "\C-t" 'get-time)
  (define-key memo-prefix-map "=" 'memo-summary-this-buffer)
  ;(define-key memo-prefix-map "=" 'diff-date-string-of-two-lines)
  (define-key memo-prefix-map "\C-n" 'memo-new-entry)
  (define-key memo-prefix-map "\C-a" 'memo-add-item-as-previous-line)
  (define-key memo-prefix-map "\C-m" 'memo-save-and-make-command)
  (define-key memo-prefix-map "\C-e" 'memo-edit-other-file)
  (define-key memo-prefix-map "\C-c" 'memo-indent-reset)
  (define-key memo-prefix-map "\C-i" 'memo-indent-increment)
  (define-key memo-prefix-map "\C-o" 'memo-indent-decrement)
  (define-key memo-prefix-map ">" 'memo-thread-indent-increment)
  (define-key memo-prefix-map "<" 'memo-thread-indent-decrement)
  (define-key memo-prefix-map "^" 'memo-move-entry-to-top)
  (define-key memo-prefix-map "_" 'memo-move-entry-to-last)
  (define-key memo-prefix-map "\?" 'memo-newline-and-indent)
  (define-key memo-prefix-map "\C-w" 'memo-kill-entry)
  (define-key memo-prefix-map "\ew" 'memo-copy-entry-as-kill)
  (define-key memo-prefix-map "\eo" 'memo-open-tag)
  (define-key memo-prefix-map "\C-f" 'auto-fill-mode)
  ;;; [1998/02/14]
  (define-key memo-mode-map [down-mouse-3] 
    '(lambda ()
       (interactive)
       (let ((o-list (car (overlays-at (point)))))
	 (if o-list (message "overlay:%s" o-list) (message "not overlay"))
	 (if o-list (message "overlay:%s" (overlay-properties o-list)))
)))
)

(defun memo-version ()
  (interactive)
  (message (format "Memo mode: %s" Memo-version)))

(defun memo-mode ()
  "This mode enables you can do outline type memo scripting.

Key Binding:
C-c     Biding for prefix key, hereinafter [P].
[P] C-i   Insert new item. Indent level down.
[P] C-o   Insert new item. Indent level up.
[P] C-a   Insert new item. Indent level keep.
[P] C-n   Add new entry.
[P] C-w   Kill entry.
[P] ESC w Copy entry.
[P] C-c   Reset current left-margin.
[P] =     Invoke memo summary.

[P] C-d   Insert date string.
[P] C-t   Insert time string.
[P] ESC d Insert date and time string.
[P] C-f   Toggle a mode of auto fill.

[P] >     Indent level down of lower threads. 
          If you specified prefix arguments 'C-u', 
          followed same indent level thread do as similary.
[P] <     Indent level up of lower threads. (c.f. [P] >).

[P] ESC o Open tag (URL) at a line.

[P] ^     Memo entry move to top.
[P] _     Memo entry move to last.

Variables:
memo-item                \"-->\"   Memo listing item.
memo-entry-separated-tag \"^---$\" Entry separated tag.
memo-indent-level        2         Space counts for each indent.

Functions:
memo-version              Display memo version.
memo-indent-line          Indent according to previous line.
memo-new-entry            Add new memo entry.
memo-kill-entry           Kill memo entry.
memo-copy-entry-as-kill   Copy memo entry.
memo-add-item             Insert memo-item.

memo-newline-and-indent
memo-newline-and-add-item
memo-add-item-as-previous-line
memo-indent-reset
memo-indent-increment
memo-indent-decrement
memo-thread-indent-increment
memo-thread-indent-decrement
"
  (interactive)
  (kill-all-local-variables)
  (use-local-map memo-mode-map)
  (setq mode-name "memo")
  (setq major-mode 'memo-mode)
  (mapcar 'make-local-variable
          '(fill-column fill-prefix fill-paragraph
            paragraph-start paragraph-separate
            indent-line-function
            comment-start comment-start-skip
            ))
  ;; 以降の outline-minor 関係の設定を有効にすると読み込みが
  ;; 関数の実行が途中で終ってしまうらしい．．
  (make-local-variable 'outline-regexp)
;  (outline-minor-mode)
  (setq outline-regexp "^[ \t]*--")
;  (setq outline-regexp "[^#\n\^M]")
;  (setq outline-level 'memo-outline-level)
  (setq indent-line-function 'memo-indent-line)
;  (setq auto-fill-hook 'memo-indent-line)
;  (message "auto-fill-hook: %s" auto-fill-hook)
  (setq comment-start memo-comment-prefix)
  (setq fill-prefix memo-fill-prefix)
  (setq fill-column memo-fill-column)
  (setq paragraph-start memo-paragraph-start)
  (setq paragraph-separate memo-paragraph-separate)
  (setq hilit-auto-highlight t)
  (setq hilit-auto-rehighlight t)
  (run-hooks 'memo-mode-hook)
  (memo-skip-header)
 )

(defun memo-outline-level ()
  (save-excursion
    (skip-chars-forward "\t ")
    (current-column)))

(defun memo-description () ;; [1998/01/24]
  (interactive)
  (let ((desc (memo-get-header-description)))
    (if (string= desc "") (setq desc "(none)"))
    (if desc (message "MEMO: %s" desc))))

;; [1999/01/25]
(defun memo-get-file-tag-at-line ()
  (let ((file nil))
    (save-excursion
      (goto-char (point-bol))
      (if (re-search-forward "\\(\\(https?\\|file\\|ftp\\|gopher\\|wysiwyg\\|img\\):[^ ]+\\)" (point-eol) t)
	  (progn
	    (setq file (buffer-substring (match-beginning 0) (match-end 0)))))
      file)))

;; [1999/01/25]
(defun memo-edit-other-file (&optional file)
  (interactive)
  (let (str)
    (setq file (memo-get-file-tag-at-line))
    (setq str (completing-read "Memo File: "
			       (mapcar (lambda (l) (list l))
				       (file-name-all-completions "" ""))
			       nil nil file))
    (if (not (string= str "")) (setq file str))
    (if (string-match "^file:" file)
	(setq file (substring file (match-end 0))))
    (find-file file)))

;; [1999/01/26]
(defun memo-open-tag (&optional tag)
  (interactive)
  (let ((www-browser "start")
	(tgif "tgifj3")
	(image-viewer "display")
	(xdvi "xdvi")
	(qtmovie "xanim")
	(realplayer "raplay")
	)
    (if (interactive-p) (setq tag (memo-get-file-tag-at-line)))
    (if (not tag) (message "No tag on this line.")
      (cond
       ((string-match "^\\(file:\\).+\\.mmp$" tag)
	(start-process "tkduke" nil (concat (getenv "HOME") "/tkduke")
		       (substring tag (match-end 1))))
       ((string-match "^\\(file:\\).+\\.\\(gif|jpe?g|p[pgbn]m\\)$" tag)
	(start-process "image-viewer" nil image-viewer
		       (substring tag (match-end 1))))
       ((string-match "^\\(ima?ge?:\\)" tag)
	(start-process "image-viewer" nil image-viewer
		       (substring tag (match-end 1))))
       ((string-match "^\\(file:\\).+\\.obj$" tag)
	(start-process "tgif" nil tgif
		       (substring tag (match-end 1))))
       ((string-match "^\\(file:\\).+\\.dvi$" tag)
	(start-process "xdvi" nil xdvi
		       (substring tag (match-end 1))))
       ((string-match "^\\(file:\\).+\\.mov$" tag)
	(start-process "qtmovie" nil qtmovie
		       (substring tag (match-end 1))))
       ((string-match "\\.ra$" tag)
	(start-process "raplayer" nil realplayer tag))
       ((string-match "^\\(file:\\)" tag)
	(find-file (substring tag (match-end 1))))
       ((string-match "^\\(https?\\|ftp\\|gopher\\|wysiwyg\\):"
		      tag)
	(progn
	  (message "Send URL to %s...: %s" www-browser tag)
	  (memo-send-url-to-browser tag www-browser)
	  (message "Send URL to %s...done." www-browser)))
       (t (message "Cannot find binding program for %s" tag))
       ))))

(defun memo-send-url-to-browser (tag &optional browser)
  (cond
   ((string-match "w3" browser) (w3-fetch tag))
   (t (start-process "www-browser" nil "start"
       "-remote" (concat "OpenURL(" tag (if nil ",new-window") ")")))))

(defun memo-get-header-description ()
  (let (p desc (name (buffer-name (current-buffer))))
    (goto-char (point-min))
    (re-search-forward memo-entry-separated-tag nil t)
    (setq p (point))
    (goto-char (point-min))
    (if (re-search-forward "^ *# *.+: *\\(.+\\)" p t)
	(progn
	  (setq desc (buffer-substring (match-beginning 1)
				       (match-end 1)))
	  (if (not (string-match "^ +$" desc))
	      (format "%s (%s)" desc name) name)))))

(defun memo-skip-header ()
  (interactive)
  (let ((b (current-buffer)) (min (point-min)) (name "") desc)
    (setq name (buffer-name b))
    (switch-to-buffer name)
    (if (eq (point) min)
	(progn
	  (memo-description)
	  (goto-char min)
	  (re-search-forward memo-entry-separated-tag nil t)
	  (forward-line -1)
	  (let ((w (get-buffer-window b)))
	    (beginning-of-line)
	    (set-window-start  w (point)))
	  (forward-line 2)
	  (beginning-of-line)))
    name))

(defun memo-new-entry ()
  (interactive)
  (if (not (eq (current-column) 0))
      (forward-line 1))
  (move-to-column 0)
  (if (re-search-forward memo-entry-separated-tag (point-eol) t)
      (forward-line 1))
  (insert (concat (get-date) "\n\n" "---\n"))
  (forward-line -2))

(defun memo-add-item ()
  (interactive)
  (insert memo-item)
  )

(defun memo-indent-line ()
  (interactive)
  (let ((col (current-column)) b-col (shift 0) (m (point-eol)))
    (save-excursion
      (beginning-of-line)
      (setq b-col (current-indentation))
      (if (< col b-col) (setq col b-col))
      (beginning-of-line)
      ;(if (re-search-forward (concat "^[ \t]*" memo-item) m t) ()
      (if (re-search-forward memo-paragraph-start m t) ()
	(setq left-margin (memo-previous-line-indent))
	(indent-to-left-margin)
	(setq shift (- left-margin b-col))
	))
    (setq col (+ col shift))
    (move-to-column col)
    ))

(if (fboundp 'memo-saved-indent-new-comment-line) nil
  (fset 'memo-saved-indent-new-comment-line
	(symbol-function 'indent-new-comment-line))
  (fset 'indent-new-comment-line 'memo-indent-new-comment-line))

(defun memo-indent-new-comment-line (&optional soft)
  (cond
   ((not (eq major-mode 'memo-mode))
    (apply 'memo-saved-indent-new-comment-line (if soft (list soft))))
   (t (let (fill-prefix)
	(apply 'memo-saved-indent-new-comment-line (if soft (list soft)))))))

(defun memo-newline-and-indent ()
  (interactive)
  (if (= (current-column) 0) (newline)
    (newline)
    (setq left-margin (memo-previous-line-indent))
    (indent-to-left-margin)))

(defun memo-newline-and-add-item (shift)
  (interactive)
  (end-of-line)
  (memo-newline-and-indent)
  (let ((margin left-margin))
    (setq left-margin (+ left-margin shift))
    (if (> left-margin memo-indent-level)
	(setq left-margin (- left-margin (length memo-item))))
    (indent-to-left-margin)
    (memo-add-item)
    (setq left-margin margin)))

(defun memo-item-line-indent ()
  (let (p)
    (save-excursion
      (save-excursion
	(re-search-backward memo-entry-separated-tag 0 t)
	(setq p (point)))
      (if (not (re-search-backward (concat "^[ \t]*" memo-item) p t)) 0
	(re-search-forward (concat "^[ \t]*" memo-item) (point-eol) t)
	(current-column)))))

(defun memo-previous-line-indent ()
  (save-excursion
    (forward-line -1)
    (memo-current-line-indent)))

(defun memo-current-line-indent ()
  (save-excursion
    (beginning-of-line)
    (re-search-forward (concat "^[ \t]*\\(" memo-item "\\)?") (point-eol) t)
    (current-column)))

(defun memo-delete-char ()
  (interactive)
  (if (not (eolp)) (delete-char 1)
    (save-excursion
      (forward-char 1)
      (delete-horizontal-space)
      (forward-char -1)
      (delete-char 1))))

(defun memo-delete-backward-char ()
  (interactive)
  (let ((m (current-column))
	(icur (memo-current-line-indent))
	(iitem (memo-item-line-indent)))
    (cond
     ((<= m iitem) (delete-backward-char (+ m 1)))
     (t (delete-backward-char 1)))))

(defun memo-previous-entry ()
  (interactive)
  ;(forward-line -1)
  (end-of-line)
  (if (and (re-search-backward memo-entry-separated-tag nil t)
	   (re-search-backward memo-entry-separated-tag nil t))
	   (progn (forward-line 1)
		  (beginning-of-line))))

(defun memo-next-entry ()
  (interactive)
  (forward-line 1)
  (beginning-of-line)
  (if (re-search-forward memo-entry-separated-tag nil t)
      (progn (forward-line 1)
	     (beginning-of-line))))

(defun memo-previous-line ()
  (interactive)
  (forward-line -1)
  (beginning-of-line)
  (if (re-search-backward "^[ \t]*" nil t)
	(if (search-backward memo-item) 
	    (search-forward memo-item))))

(defun memo-next-line ()
  (interactive)
  (forward-line 1)
  (beginning-of-line)
  (if (re-search-forward "^[ \t]*" nil t)
      (search-forward memo-item)))

(defun memo-indent-reset ()
  (interactive)
  (setq left-margin 0)
  )

(defun memo-add-item-as-previous-line ()
  (interactive)
  (memo-newline-and-add-item 0)
  )

(defun memo-indent-increment ()
  (interactive)
  (memo-newline-and-add-item memo-indent-level)
  )

(defun memo-indent-decrement ()
  (interactive)
  (memo-newline-and-add-item (- memo-indent-level))
  )

(defun memo-thread-indent (indent &optional all-indent)
  ; カーソルが left-margin よりも小さい位置にある場合の動作がおかしい？
  ;   [1998/01/17]
  ;   -->save-excursion と indent-to-left-indentation の相性が悪いらしい
  ;      自前で point を保存・復帰してみる
  ;     -->インデント時のタブとスペースの変換のため保存した point では
  ;        希望位置にカーソルを置けない．
  ;     -->(current-column) でカラム数を保存してみたけど．．どうなるか？
  ;(let ((col (current-column)))
  (save-excursion
    (beginning-of-line)
    (let ((org (current-indentation)) (cur) (tag memo-entry-separated-tag))
      (setq left-margin (+ org indent))
      (indent-to-left-margin)
      (catch 'indented ; 現在行以下のインデント処理
	(while (not (save-excursion (end-of-line) (eobp)))
	  (forward-line 1)
	  (beginning-of-line)
	  (if (re-search-forward tag (save-excursion (end-of-line) (point)) t)
	      (throw 'indented t))
	  (setq cur (current-indentation))
	  (if (or (< cur org) (and (not all-indent) (= cur org)))
	      (throw 'indented t))  ;; [A]
	  (setq left-margin (+ cur indent))
	  (indent-to-left-margin)))
      )
    )
    ;(move-to-column col)
    ;)
  )

(defun memo-thread-indent-increment (&optional arg)
  (interactive "P")
  (memo-thread-indent memo-indent-level (not (null arg))))

(defun memo-thread-indent-decrement (&optional arg)
  (interactive "P")
  (memo-thread-indent (- memo-indent-level) (not (null arg))))

(defun memo-beginning-of-line ()
  (interactive)
  (let ((col (current-column)) (m (point-eol)) icol iicol)
    (setq icol (current-indentation))
    (save-excursion
      (move-to-column icol)
      (search-forward memo-item (+ (point) (length memo-item)) t)
      (setq iicol (current-column)))
    (cond
     ((= col 0) ())
     ((> col iicol)  (move-to-column iicol))
     ((> col icol )  (move-to-column icol ))
     (t (beginning-of-line)))
    ))

(defun memo-kill-entry ()
  (interactive)
  (let (b e)
    (save-excursion
      (if (not (= (current-column) 0))
	  (end-of-line))
      (re-search-backward memo-entry-separated-tag nil t)
      (forward-line 1)
      (beginning-of-line)
      (setq b (point))
      (forward-line 1)
      (re-search-forward memo-entry-separated-tag nil t)
      (forward-line 1)
      (beginning-of-line)
      (setq e (point))
      (kill-region b e)
      )
    (goto-char b)))

(defun memo-copy-entry-as-kill ()
  (interactive)
  (let (b e)
    (save-excursion
      (if (not (= (current-column) 0))
	  (end-of-line))
      (re-search-backward memo-entry-separated-tag nil t)
      (forward-line 1)
      (beginning-of-line)
      (setq b (point))
      (forward-line 1)
      (re-search-forward memo-entry-separated-tag nil t)
      (forward-line 1)
      (beginning-of-line)
      (setq e (point))
      (copy-region-as-kill b e)
      )
    ))

(defun memo-save-and-make-command ()
  (interactive)
  (save-buffer)
  (shell-command "make"))

;;; [1998/02/13] set hilit19-face
(if window-system
    (cond
     ((featurep 'hilit19)
      (hilit-set-mode-patterns
       'memo-mode
       '(("^---+ *$" nil type)
	 (memo-search-item nil decl)
	 ("\\[..../../..\\( +..:..\\)?\\]\\|\\[..:..\\]" nil define)
	 ("^ *#.*" nil comment)
	 ("\\(https?\\|file\\|ftp\\|gopher\\|wysiwyg\\|img\\):[^ \n]+" nil string)
	 )))

     ((featurep 'font-lock)
      (defvar memo-font-lock-keywords
	(list (cons memo-entry-separated-tag
		    'font-lock-type-face)
	      (cons (concat "^[ \t]*" memo-item)
		    'font-lock-function-name-face)
	      '("\\]\n\\(.*\\)$"
		1 font-lock-variable-name-face)
	      '("\\[..../../..\\( +..:..\\)?\\]\\|\\[..:..\\]"
		. font-lock-constant-face)
	      '("^ *#.*"
		. font-lock-comment-face)
	      '("\\(https?\\|file\\|ftp\\|gopher\\|wysiwyg\\|img\\):[^\n]+"
		. font-lock-keyword-face))
	"Defaults for Font Lock mode specified by the memo mode.")
      (if (and (>= (string-to-int emacs-version) 19)
	       (not (featurep 'xemacs)))
	  (add-hook
	   'memo-mode-hook
	   (lambda ()
	     (make-local-variable 'font-lock-defaults)
	     (setq font-lock-defaults
		   '((memo-font-lock-keywords) nil nil ((?\_ . "w"))))))
	(add-hook 'ruby-mode-hook
		  (lambda ()
		    (setq font-lock-keywords memo-font-lock-keywords)))))))

(defun memo-search-item (a)
  (interactive)
  (let (b e)
    (if (re-search-forward (format "^[ \t]*%s" memo-item) nil t)
	(progn
	  (setq e (point))
	  (re-search-backward memo-item)
	  (setq b (point))
	  (and e (cons b e))))))

(defun memo-move-entry-to-top ()
  (interactive)
  (save-excursion
    (memo-kill-entry)
    (goto-char (point-min))
    (if (re-search-forward memo-entry-separated-tag nil t)
	(forward-line 1))
    (yank)))

(defun memo-move-entry-to-last ()
  (interactive)
  (save-excursion
    (memo-kill-entry)
    (goto-char (point-max))
    (if (re-search-backward memo-entry-separated-tag nil t)
	(forward-line 1))
    (yank)))

;;; [1998/02/14]
(defun memo-energize-urls ()
  ;; require vm-5.96beta:vm-page.el:vm-energize-ruls (or upper?).
  (interactive)
  (save-excursion
    (save-restriction
      (widen)
      (vm-energize-urls)
      )))

;;; [1998/08/28]
(defun memo-mode-header ()
  (interactive)
  (save-excursion
    (save-restriction
      (goto-char (point-min))
      (if (re-search-forward "^#[ ]*-\\*- memo -\\*-" (point-eol) t) ()
	(insert "# -*- memo -*-\n\n")
	(memo-mode))
      )))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; memo summary [1998/12/30]
;;;
(defvar memo-summary-buffer nil)
(defvar memo-summary-cur-item-no -1)
(defvar memo-summary-mode-map nil)

(if memo-summary-mode-map ()
  (setq memo-summary-mode-map   (make-sparse-keymap))
  (define-key memo-summary-mode-map " "  'memo-summary-display)
  (define-key memo-summary-mode-map "<"  'memo-summary-redisplay)
  (define-key memo-summary-mode-map "."  'memo-summary-redisplay)
  (define-key memo-summary-mode-map ","  'scroll-other-window-down)
  (define-key memo-summary-mode-map "^"  'memo-summary-enlarge-other-window)
  (define-key memo-summary-mode-map "_"  'memo-summary-shrink-other-window)
  (define-key memo-summary-mode-map "n"  'memo-summary-next)
  (define-key memo-summary-mode-map "p"  'memo-summary-prev)
  (define-key memo-summary-mode-map "q"  'memo-summary-quit)
  (define-key memo-summary-mode-map "g"  'memo-summarize)
  (define-key memo-summary-mode-map "e"  'memo-summary-jump)
  (define-key memo-summary-mode-map "S"  'memo-summarize-with-search)
  (define-key memo-summary-mode-map "\es"  'memo-summary-search)
  (define-key memo-summary-mode-map "s"  'memo-summary-save-item)
  (define-key memo-summary-mode-map "v"  'memo-summary-visit)
  (define-key memo-summary-mode-map "="  'delete-other-windows)
  )

(defun memo-summary-this-buffer ()
  (interactive)
  (memo-summary-visit (buffer-file-name)))

(defun memo-summary-visit (file)
  (interactive "fMemo file: ")
  (if (or (null memo-summary-buffer)
          (null (buffer-name memo-summary-buffer))
	  (null (get-buffer memo-summary-buffer))) ()
    (pop-to-buffer memo-summary-buffer)
    (widen))
  (find-file file)
  (setq memo-summary-cur-item-no -1)
  (setq memo-summary-buffer (get-file-buffer file))
  (memo-summarize))

(defun memo-summary-make ()
  (interactive)
  (let ((buf (current-buffer)) head date b e m ptmp)
    (setq memo-items nil)
    (switch-to-buffer memo-summary-buffer)
    (widen)
    (save-excursion
      (goto-char (point-min))
      (while (re-search-forward memo-entry-separated-tag nil t)
	(forward-char 1)
	(setq b (point))
	(setq ptmp b)
	(setq head (buffer-substring ptmp (point-eol)))
	(setq date "____/__/__")
	(if (string-match "^\\[\\(..../../..\\( *..:..\\)?\\)] *$" head)
	    (progn
	      (setq date
	            (substring head (match-beginning 1) (match-end 1)))
	      (setq ptmp (+ (point-eol) 1))
	      (goto-char ptmp)
	      (setq head (buffer-substring ptmp (point-eol)))
	      ))
	(if (setq m (string-match "\\[..:..\\] *$" head))
	    (setq head (substring head 0 m)))
	(save-excursion
	  (if (re-search-forward memo-entry-separated-tag nil t)
	      (progn
		(save-excursion
		  (goto-char (- (point-bol) 1))
		  (while (re-search-backward "^#.+:" (point-bol) t)
		    (forward-char -1))
		  (setq e (point-eol))))
	    (setq e nil)))
	(setq memo-items (cons (list b e head date) memo-items)))
      (setq memo-items (reverse (cdr memo-items))))
    (switch-to-buffer buf)))

(defun memo-summary-make-with-search (word)
  (interactive "sSearch word: ")
  (let ((buf (current-buffer)) head date b e m ptmp)
    (setq memo-items nil)
    (setq memo-cur-item-no -1)
    (switch-to-buffer memo-summary-buffer)
    (widen)
    (save-excursion
      (goto-char (point-min))
      (while (and (re-search-forward word nil t)
		  (re-search-backward memo-entry-separated-tag nil t))
	(goto-char (+ (point-eol) 1))
	(setq b (point))
	(setq ptmp b)
	(setq head (buffer-substring ptmp (point-eol)))
	(setq date "____/__/__")
	(if (string-match "^\\[\\(..../../..\\( *..:..\\)?\\)] *$" head)
	    (progn
	      (setq date
	      	    (substring head (match-beginning 1) (match-end 1)))
	      (setq ptmp (+ (point-eol) 1))
	      (goto-char ptmp)
	      (setq head (buffer-substring ptmp (point-eol)))
	      ))
	(if (setq m (string-match "\\[..:..\\] *$" head))
	    (setq head (substring head 0 m)))
	(save-excursion
	  (if (re-search-forward memo-entry-separated-tag nil t)
	      (progn
		(save-excursion
		  (goto-char (- (point-bol) 1))
		  (while (re-search-backward "^#.+:" (point-bol) t)
		    (forward-char -1))
		  (setq e (point-eol))))
	    (setq e nil)))
	(setq memo-items (cons (list b e head date) memo-items))
	(re-search-forward memo-entry-separated-tag nil t)
	(forward-char -1)
	)
      (setq memo-items (reverse memo-items)))
    (switch-to-buffer buf)))
  
(defun memo-summary-display-summary ()
  (interactive)
  (let (no num str w p)
    (save-excursion
      (setq no 1)
      (save-restriction
	(pop-to-buffer "*Memo Summary*")
	(setq buffer-read-only nil)
	(delete-region (point-min) (point-max))
	(setq num (length memo-items))
	(setq w (- (window-width) 3))
	(mapcar
	 (lambda (i)
	   (setq str (format " %4d: [%s] %s"
			     (+ num (- no) 1) (nth 3 i) (nth 2 i)))
	   (insert (truncate-string str w) "\n")
	   (setq no (+ no 1)))
	 memo-items)
	(setq buffer-read-only t)))))

(defun memo-summarize (&optional word)
  (interactive)
  (let (exist b)
    (if word
	(memo-summary-make-with-search word)
      (memo-summary-make))
    (setq exist (window-live-p (get-buffer-window "*Memo Summary*")))
    (pop-to-buffer "*Memo Summary*")
    (setq b (point))
    (memo-summary-display-summary)
    (if (and (null exist)
	     (window-live-p (get-buffer-window memo-summary-buffer))) ()
      (delete-other-windows))
    (goto-char b)
    (memo-summary-mode)))

(defun memo-summarize-with-search (word)
  (interactive "sSearch with summarize: ")
  (memo-summarize word))

(defun memo-summary-enlarge-other-window ()
  (interactive)
  (enlarge-window -1))

(defun memo-summary-shrink-other-window ()
  (interactive)
  (enlarge-window 1))

(defun memo-summary-mode ()
  (interactive)
  (use-local-map memo-summary-mode-map)
  (setq mode-name (format "%s Summary" memo-summary-buffer))
  (setq major-mode 'memo-summary-mode))

(defun memo-summary-quit ()
  (interactive)
  (if (> (count-windows) 1)
      (delete-window)
    (switch-to-buffer memo-summary-buffer)
    )
  (pop-to-buffer memo-summary-buffer)
  (widen)
  (bury-buffer "*Memo Summary*"))

(defun memo-summary-redisplay ()
  (interactive)
  (setq memo-summary-cur-item-no -1)
  (memo-summary-display))

(defun memo-summary-display ()
  (interactive)
  (let ((num (length memo-items)) n b e buf)
    (save-excursion
      (goto-char (point-bol))
      (if (re-search-forward "^ *\\([0-9]+\\)" nil t)
	  (progn
	    (setq n (string-to-int (buffer-substring (match-beginning 1) (match-end 1))))
	    (setq b (car (nth (- num n) memo-items)))
	    (setq e (car (cdr (nth (- num n) memo-items))))
	    (setq buf (current-buffer))
	    (if (and (window-live-p (get-buffer-window memo-summary-buffer))
		     (= n memo-summary-cur-item-no))
		(scroll-other-window)
	      (if (window-live-p (get-buffer-window memo-summary-buffer)) ()
		(delete-other-windows)
		(split-window-calculate-height "30")
		)
	      (pop-to-buffer memo-summary-buffer)
	      (widen)
	      (narrow-to-region b e)
	      (set-window-start (get-buffer-window memo-summary-buffer) b)
	      (pop-to-buffer buf))
	    (setq memo-summary-cur-item-no n)
	    )))
    ))

(defun memo-summary-jump ()
  (interactive)
    (save-excursion
      (goto-char (point-bol))
      (pop-to-buffer memo-summary-buffer)
      (widen)))
;    (if (re-search-forward "^ *\\([0-9]+\\)" nil t)
;    	(progn
;	  (setq n (string-to-int (buffer-substring (match-beginning 1) (match-end 1))))
;	  (setq b (car (nth (- num n) memo-items)))
;	  (setq buf (current-buffer))
;	  (pop-to-buffer memo-summary-buffer)
;	  (goto-char b)
;	  (pop-to-buffer buf))))
;	  (pop-to-buffer memo-summary-buffer))

(defun memo-summary-next ()
  (interactive)
  (setq memo-summary-cur-item-no -1)
  (goto-char (+ (point-eol) 1))
  (memo-summary-display))

(defun memo-summary-prev ()
  (interactive)
  (setq memo-summary-cur-item-no -1)
  (goto-char (+ (point-bol) -1))
  (goto-char (point-bol))
  (memo-summary-display))

(defun memo-summary-search (word)
  (interactive "sSearch: ")
  (let ((buf (current-buffer)))
    (pop-to-buffer memo-summary-buffer)
    (if (window-live-p (get-buffer-window memo-summary-buffer))
	(goto-char (point-eol)))
    (if (re-search-forward word nil t)
	(progn
	  (goto-char (point-bol))
	  (set-window-start (get-buffer-window (get-buffer memo-summary-buffer))
			    (point))))
    (pop-to-buffer buf)))

(defun memo-summary-save-item (folder)
  (interactive "FSave folder (test implement): ")
  (let (num n buf-tmp b e)
    (save-excursipon
      (goto-char (point-bol))
      (if (re-search-forward "^ *\\([0-9]+\\)" nil t)
	  (progn
	    (setq num (length memo-items))
	    (setq n (string-to-int
		     (buffer-substring (match-beginning 1) (match-end 1))))
	    (setq buf-tmp (current-buffer))
	    (pop-to-buffer memo-summary-buffer)
	    (widen)
	    (memo-copy-entry-as-kill)
					;(memo-kill-entry)
	    (find-file folder)
	    (pop-to-buffer (get-file-buffer folder))
	    (goto-char (point-min))
	    (if (re-search-forward memo-entry-separated-tag nil t)
		(forward-char 1)
	      (insert (concat "# -*- memo -*-\n---\n")))
	    (yank)
	    (save-buffer)
	    (pop-to-buffer memo-summary-buffer)
	    ;(save-buffer)
	    ;(memo-summary-make)
	    ;(memo-summary-display-summary)
	    ;(setq num (length memo-items))
	    ;(if (> n num) (setq n num))
	    ;(setq b (car (nth (- num n) memo-items)))
	    ;(setq e (car (cdr (nth (- num n) memo-items))))
	    (narrow-to-region b e)
	    (pop-to-buffer buf-tmp)
	    (beginning-of-line)
	    (kill-line)
	    )))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Some Utilities

(defun point-bol () (save-excursion (beginning-of-line) (point)))
(defun point-eol () (save-excursion (end-of-line) (point)))

(defun repeat-char (ch n)
  (let ((i n) (str))
    (while (> i 0)
      (progn
	(setq str (concat str ch))
	(setq i (- i 1))))
    str))

(defun split-window-calculate-height (height) ;; from yatexlib.el
  "Split current window wight specified HEIGHT.
If HEIGHT is number, make a new window that has HEIGHT lines.
If HEIGHT is string, make a new window that occupies HEIGT % of screen height.
Otherwise split window conventionally."
  (if (one-window-p t)
      (split-window
       (selected-window)
       (max
	(min
	 (- (screen-height)
	    (if (numberp height)
		(+ height 2)
	      (/ (* (screen-height)
		    (string-to-int height))
		 100)))
	 (- (screen-height) window-min-height 1))
	window-min-height))))

(provide 'memo-mode)

(defvar memo-mode-load-hook nil)
(run-hooks 'memo-mode-load-hook)

;;; end of memo-mode here.