;;; hnf-mode.el --- major mode for editing hnf.

;; Copyright (C) 1998-2000 by Akihiro Arisawa <ari@nijino.com>

;; Author: Akihiro Arisawa <ari@nijino.com>
;; Version: $Id: hnf-mode.el,v 3.10 2000/02/26 16:04:30 ari Exp $
;; Keywords: hnf nikki hns

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; 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 GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; 【できること】
;; 1. hnfを編集時にTABでいろいろと補完ができます。
;; 2. font-lockを使ってhnfをカラー表示します。
;; 3. M-x hnf で ~/diary/1999/d19990107.hnf 等、その日のhnfを開きます。
;;    C-u numeric M-x hnf で、numeric日前のhnfを開きます。
;; 4. NEWやSUBのリンクのnameを表示、及び、kill-ringへ挿入できます。
;;    また、リンク先のファイルをオープンできます。(相対パスで指定時のみ)
;; 5. namazu.elからnamazu_for_hnsで検索した結果からファイルを開けます。
;; 6. M-x calendarと連携ができます。
;; 7. その他、いろいろ。
;;
;; 【インストール】
;; 1. APELをインストールします。
;; 2. hnf-mode.el を load-path の通ったところに置きます。
;; 
;; 【設定などなど】
;; 必須の設定は1〜2だけです。それ以外はお好みでどうぞ。
;;
;; 1. 拡張子が.hnfなファイルを開いた時にhnf-modeとなるように~/.emacs等で
;;    設定します。
;;    (autoload 'hnf "hnf-mode" nil t)
;;    (autoload 'hnf-mode "hnf-mode" nil t)
;;    (setq auto-mode-alist (cons '("\\.hnf$" . hnf-mode) auto-mode-alist))
;;
;; 2. hnf-diary-dir, hnf-html-dir, hnf-diary-year-directory-flagを必要に応じて
;;    設定します。設定すべき値は変数のコメントを参照してください。
;;    例) (setq hnf-diary-dir "~/diary")
;;	  (setq hnf-html-dir "~/public_html/diary")
;;	  (setq hnf-diary-year-directory-flag t)
;;
;; 3. 変数を補完したい場合はhnf-variableを設定します。
;;    例) (setq hnf-variable '(("TENKI") ("BASHO") ("TAIJU") ("TAION")))
;;
;; 4. マークの補完をしたい場合はhnf-marksを設定します。
;;    例) (setq hnf-marks '(("(^^)") ("(-_-)") ("(^^;") ("(;_;)") ("(T_T)"))
;;
;; 5. RLINKを補完したい場合はhnf-rlinkを設定します。
;;    例) (setq hnf-rlink '(("h14m") ("ari")))
;;
;; 6. CATを補完したい場合はhnf-catを設定します。
;;    例) (setq hnf-cat '(("Linux") ("Nikki")))
;;
;; 7. ALIASを補完したい場合はhnf-aliasを設定します。
;;    例) (setq hnf-alias '(("Be") ("hns")))
;;
;; 8. M-x hnfにて新規ファイルを開いた時に、実行したい関数をhnf-initial-function
;;    に設定します。"OK"を自動挿入したければ以下のようにします。
;;    例) (setq hnf-initial-function '(lambda () (insert "OK\n\n")))
;;
;; 9. 一日が28:00まである生活をしている場合は、以下の設定をしてみてください。
;;         (setq hnf-hour-not-today 4)
;;     詳細はhnf-hour-not-todayの説明を参照してください。
;;
;; 10. NEWやSUBの行で、リンクのnameを表示したいならば hnf-get-link(C-c=) を、
;;     リンク先のファイルをオープンしたいならば hnf-link-find-file(C-cC-f) を
;;     使います。また、C-uC-c= でリンクのnameがkill-ringに挿入されます。
;;
;;    (注1) hns-1.03pl0以前ではデフォルトのリンクのnameが異なります。
;;          その形式で表示したい時は以下の設定を行ってください。
;;          (setq hnf-get-link-name-function 'hnf-get-link-name)
;;    (注2) hns-2.1以降(?)ではデフォルトのリンクの名前が異なります。
;;          その形式で表示したい時は以下の設定を行ってください。
;;          (setq hnf-get-link-name-function 'hnf-get-link-name-with-abc)
;;
;; 11. 時間を挿入したいならば hnf-insert-time(C-cC-t) を使います。
;;     フォーマットは hnf-time-format で変更できます。
;;     C-uC-cC-t でカーソル以降に既に挿入されている時間を現在の時間に
;;     変更します。
;;
;;     また hnf-write-file-insert-time(C-cC-s)を評価すると、ファイルの末尾に
;;     時間を挿入しファイルを保存します。
;;
;; 12. hnf-newline(C-cC-m)で、改行と同時に閉じるタグの挿入などが行われます。
;;     "\C-m"にバインドしても問題無いと思います。
;;     例) (add-hook 'hnf-mode-load-hook
;;                   '(lambda ()
;;                      (define-key hnf-mode-map "\C-m" 'hnf-newline)))
;;
;; 13. namazu.elにてnamazu_for_hnsの検索結果からファイルを開きたいならば、
;;     hnf-namazu-find-fileをnamazu-mode-mapに適宜設定することをすすめます。
;;     例) (setq namazu-command (expand-file-name "~/diary/namazu/bin/namazu"))
;;	   (add-hook 'namazu-mode-hook
;;		     '(lambda ()
;;		       (define-key namazu-mode-map "f" 'hnf-namazu-find-file)))
;;	   (autoload 'hnf-namazu-find-file "hnf-mode" nil t)
;;
;;     また、hnf-modeからC-cC-nでnamazu.elを実行できます。
;;
;; 14. M-x calendarと連携したいならば、hnf-insert-diary-entryを適宜バインド
;;     しましょう。
;;     例) (autoload 'hnf-insert-diary-entry "hnf-mode" nil t)
;;         (add-hook 'calendar-load-hook
;;             '(lambda ()
;;                (define-key calendar-mode-map "iD" 'hnf-insert-diary-entry)))
;;     また、hnf-mark-diary-entriesを実行すると、日記を入力してある日は
;;     マークが付きます。
;;     例) (autoload 'hnf-mark-diary-entries "hnf-mode" nil t)
;;         (add-hook 'today-visible-calendar-hook 'hnf-mark-diary-entries)
;;         (add-hook 'today-invisible-calendar-hook 'hnf-mark-diary-entries)
;;
;; 15. Web Browserと連携したい場合は、hnf-diary-urlに日記のURLを設定して
;;     下さい。
;;     hnf-browse-recent-diary(C-cC-b) または hnf-browse-diary で
;;     Web Browserが起動します。
;;     例) (setq hnf-diary-url "http://www.nijino.com/ari/diary/")
;;
;;     また、hnf-preview-diary(C-cC-p)では、httpd を経由せずに表示できます。
;;
;; 2〜7,9はcustomを使って設定もできるはずです。(動作未確認(^^;)
;;
;; 【Emacsen】
;; 動作確認は主にemacs-20で行っています。XEmacs-20/21も多分問題無いでしょう。
;; mule-2.3@emacs-19.34ではcustom-1.9962をインストールすれば使えると思います。
;; mule-2.3@emacs-19.28ではかなり頑張る必要があるでしょう(^^;
;;
;; なお、mule-2.3@19.34でcustom-1.9962を使う場合は、http://www.jpl.org/elips/
;; から取得できるパッチを当てる必要があります。
;;
;; 【To do】
;; 1. calendarからもbrowse-urlを呼べるようにしようかな。
;; 2. (hnf-write-file-insert-time)を評価した時に、既に最終行に時間が
;;    挿入されている場合は、上書きできた方がいいだろう。
;; 3. 全般的にエラー処理が甘いのを直すべきだろうな。
;;
;; 【謝辞】
;; ハイパー日記システムの作者の方々に感謝します。ハイパー日記システム無くしては
;; hnf-modeは生まれなかったでしょう:-)。
;; 同僚の福居君に感謝します。補完の下位関数は彼のtoali.elから奪っています(^^;
;; 橋本賢一さん(http://i21x12.fuis.fukui-u.ac.jp/~ken/diary/)に感謝します。
;; おかげでM-x hnfという機能が追加されました(^^)。
;; また、hnf-modeに協力していただいた以下の皆さんに感謝します。
;;	やまぐちさん	http://symphony.sone.riec.tohoku.ac.jp/~yamaya/diary/
;;	宮崎さん	http://zak.interwave.or.jp/diary/
;;	JUNさん		http://jun.misao.gr.jp/diary/
;;	sawさん		http://www.be-in.org/~mas/diary/

;;; Code:

(defconst hnf-mode-version "2.1")

(require 'poe)
(require 'pcustom)

(defgroup hnf nil
  "Hyper Nikki File"
  :group 'hypermedia)

(defcustom hnf-diary-dir "~/diary"
  "日記ディレクトリを指定します。"
  :group 'hnf
  :type 'directory)

(defcustom hnf-html-dir "~/public_html/diary"
  "hnsのウェブ・ディレクトリを指定します。"
  :group 'hnf
  :type 'directory)

(defcustom hnf-hns-program (concat hnf-html-dir "/index.cgi")
  "hnsのプログラム名です。"
  :group 'hnf
  :type 'file)

(defcustom hnf-document-root "/usr/local/apache/htdocs"
  "WebサーバのDocumentRootを指定します。"
  :group 'hnf
  :type 'directory)

(defcustom hnf-diary-year-directory-flag t
  "hnfを日記ディレクトリの直下に置く場合はnilを、年毎にディレクトリを
分ける場合はnon-nilを指定します。"
  :group 'hnf
  :type 'boolean)

(defcustom hnf-diary-url (concat "http://" (system-name) "/"
				 "~" (user-login-name) "/diary/")
  "日記のURLを指定します。"
  :group 'hnf
  :type 'string)

(defcustom hnf-index-name-list '("index.html" "index.shtml" "index.phtml")
  "indexとして開くファイル名を指定します。"
  :group 'hnf
  :type 'list)

(defcustom hnf-mode-hook nil
  "hnf-mode の hook"
  :group 'hnf
  :type 'hook)

(defcustom hnf-mode-load-hook nil
  "hnf-modeのload時のhook"
  :group 'hnf
  :type 'hook)

(defcustom hnf-initial-function nil
  "新規ファイルをオープンした時に呼ばれる関数。"
  :group 'hnf
  :type 'function)

(defcustom hnf-variable nil
  "hnfで使用する変数を指定します。nilを指定すると変数の補完は行いません。"
  :group 'hnf
  :type 'list)

(defcustom hnf-marks nil
  "hnfで使用するマークを指定します。nilを指定するとマークの補完は行いません。"
  :group 'hnf
  :type 'list)

(defcustom hnf-alias nil
  "hnfで使用するALIASを指定します。nilを指定するとALIASの補完は行いません。"
  :group 'hnf
  :type 'list)

(defcustom hnf-commands
  '(("NEW"	1	"NEW セクションのタイトル")
    ("SUB"	1	"SUB セクション内のサブ・セクションのタイトル")
    ("CAT"	1	"CAT カテゴリ1 [カテゴリ2 ...]")
    ("LNEW"	2	"LNEW url セクションのタイトル")
    ("LSUB"	2	"LSUB url セクション内のサブ・セクションのタイトル")
    ("LINK"	2	"LINK url 説明文章")
    ("URL"	2	"URL url 説明文章")
    ("RLINK"	3	"RLINK arg1 arg2 説明文章")
    ("FONT"	3	"FONT arg1 arg2 文章")
    ("STRIKE"	1	"STRIKE 文章")
    ("LSTRIKE"	2	"STRIKE url 文章")
    ("STRONG"	1	"STRONG 文章")
    ("IMG"	3	"IMG {r|l|n} ファイル名 文字列")
    ("MARK"	1	"MARK 引数")
    ("UL"	0	"UL")
    ("/UL"	0	"/UL")
    ("OL"	0	"OL")
    ("/OL"	0	"/OL")
    ("LI"	1	"LI 文章")
    ("PRE"	0	"PRE")
    ("/PRE"	0	"/PRE")
    ("CITE"	0	"CITE")
    ("/CITE"	0	"/CITE")
    ("!"	1	"! 文章")
    ("!#"	1	"!# 文章")
    ("FN"	0	"FN")
    ("/FN"	0	"/FN")
    ("ALIAS"	1	"ALIAS arg")
    )
  "hnfで使用するコマンドを指定します。"
  :group 'hnf
  :type 'list)

(defcustom hnf-close-command-list
  '("UL" "OL" "PRE" "CITE" "FN")
  "hnfで閉じる必要のあるコマンドのリストを指定します。"
  :group 'hnf
  :type 'list)

(defcustom hnf-rlink nil
  "hnfで使用するRLINKを指定します。"
  :group 'hnf
  :type 'list)

(defcustom hnf-cat nil
  "hnfで使用するCATを指定します。"
  :group 'hnf
  :type 'list)

(defcustom hnf-font-lock-flag t
  "font-lockを使うかどうかの指定をします。"
  :group 'hnf
  :type 'boolean)

(defcustom hnf-complete-command-insert-space-flag t
  "コマンドの補完が完了した時にスペースを挿入するかどうかの指定をします。"
  :group 'hnf
  :type 'boolean)

(defcustom hnf-complete-command-insert-newline-function 'hnf-newline
  "引数を必要としないコマンドの補完が完了した時に、コールする関数を
指定します。"
  :group 'hnf
  :type 'function)

(defcustom hnf-time-format "(%H:%M)"
  "hnf-insert-timeのフォーマットを指定します。
`format-time-string'を参照してください。"
  :group 'hnf
  :type 'string)

(defcustom hnf-time-regexp "([0-9][0-9]:[0-9][0-9])"
  "`hnf-insert-time' で挿入される文字列の正規表現です。"
  :group 'hnf
  :type 'regexp)

(defcustom hnf-namazu-index-dir (concat hnf-diary-dir "/namazu/index")
  "namazuのインデックスの置いてあるディレクトリ名です。"
  :group 'hnf
  :type 'directory)

(defcustom hnf-tab-command 'tab-to-tab-stop
  "`hnf-tab-complete'で補完／展開が実行されなかった時に実行される関数を
指定します。"
  :group 'hnf
  :type 'function)

(defcustom hnf-header-p-function 'hnf-header-p
  "ヘッダ部の判定を行う関数を指定します。"
  :group 'hnf
  :type 'function)

(defcustom hnf-font-lock-keywords
  '(("^CAT.*" . hnf-cat-face)
    ("^L?NEW.*" . hnf-new-face)
    ("^L?SUB.*" . hnf-sub-face)
    ("^\\(!\\|!#\\).*" . hnf-comment-face)
    ("^RLINK[ \t]+\\([^ \t]+[ \t]+[^ \t]+\\)" 1 hnf-link-face)
    ("^\\(URL\\|LINK\\|LNEW\\|LSUB\\)[ \t]+\\([^ \t\n]+\\)" 2 hnf-link-face)
    (eval . (cons (concat "^\\(" (mapconcat 'car hnf-commands "\\|") "\\)\\>")
		  hnf-command-face))
    (eval . (list (concat "^\\(" (mapconcat 'car hnf-variable "\\|") "\\)\\>")
		  '(0 (if (hnf-header-p) hnf-variable-face))))
    ("~$" . hnf-tilde-face)
    )
  "hnfモードでのfont-lockのキーワード。"
  :group 'hnf
  :type 'list)

(defcustom hnf-get-link-name-function 'hnf-get-link-name-with-to
  "(hnf-get-link)でリンクの名前を作成する関数を指定します。
hns-1.03pl0までのは`hnf-get-link-name'を、hns-1.03pl1以降は
`hnf-get-link-name-with-to'を指定してください。"
  :group 'hnf
  :type 'function)

(defcustom hnf-hour-not-today 0
  "指定の時間までを前日とみなします。0〜23の整数を指定します。

例: 6を指定すると、0:00〜5:59までは前日であるとみなし、
    M-x hnfを実行時には前日のhnfを開きます。また、(hnf-insert-time)は
    \"25:00\" といった表示になります。"
  :group 'hnf
  :type 'integer)

(defface hnf-cat-face '((t (:foreground "purple" :bold t)))
  "hnfのCATの行のフェイス。"
  :group 'hnf)
(defface hnf-new-face '((t (:foreground "purple" :bold t)))
  "hnfのNEWの行のフェイス。"
  :group 'hnf)
(defface hnf-sub-face '((t (:foreground "purple")))
  "hnfのNEWの行のフェイス。"
  :group 'hnf)
(defface hnf-link-face '((t (:foreground "Blue")))
  "hnfのリンクの行のフェイス。"
  :group 'hnf)
(defface hnf-comment-face '((t (:foreground "Red")))
  "hnfのコメント行のフェイス。"
  :group 'hnf)
(defface hnf-command-face '((t (:foreground "firebrick")))
  "hnfのコマンドのフェイス。"
  :group 'hnf)
(defface hnf-tilde-face '((t (:foreground "orange")))
  "hnfの\"~\"のフェイス。"
  :group 'hnf)
(defface hnf-variable-face '((t (:foreground "DarkGoldenrod")))
  "hnfの変数のフェイス(不完全なり)。"
  :group 'hnf)

(defvar hnf-mode-map nil)

(defvar hnf-cat-face 'hnf-cat-face)
(defvar hnf-new-face 'hnf-new-face)
(defvar hnf-sub-face 'hnf-sub-face)
(defvar hnf-link-face 'hnf-link-face)
(defvar hnf-comment-face 'hnf-comment-face)
(defvar hnf-command-face 'hnf-command-face)
(defvar hnf-tilde-face 'hnf-tilde-face)
(defvar hnf-variable-face 'hnf-variable-face)

(defvar hnf-complete-ok t
  "non-nilを指定するとOKを補完対象に含めます。")

(defconst hnf-completion-buffer-name "*HNF Completions*")

(if hnf-mode-map nil
  (setq hnf-mode-map (make-sparse-keymap))
  (define-key hnf-mode-map "\t" 'hnf-tab-complete)
  (define-key hnf-mode-map "\C-c\C-m" 'hnf-newline)
  (define-key hnf-mode-map "\C-c?" 'hnf-command-help)
  (define-key hnf-mode-map "\C-c=" 'hnf-get-link)
  (define-key hnf-mode-map "\C-c\C-f" 'hnf-link-find-file)
  (define-key hnf-mode-map "\C-c\C-t" 'hnf-insert-time)
  (define-key hnf-mode-map "\C-c\C-s" 'hnf-write-file-insert-time)
  (define-key hnf-mode-map "\C-c\C-b" 'hnf-browse-recent-diary)
  (define-key hnf-mode-map "\C-c\C-p" 'hnf-preview-diary)
  (define-key hnf-mode-map "\C-c\C-n" 'hnf-namazu)
  )

;;;###autoload
(defun hnf-mode ()
  "hnfのモード。"
  (interactive)
  (use-local-map hnf-mode-map)
  (setq mode-name "HNF")
  (setq major-mode 'hnf-mode)
  ; font-lock
  (if hnf-font-lock-flag
      (progn
	(require 'font-lock)
	(make-local-variable 'font-lock-defaults)
	(setq font-lock-defaults '(hnf-font-lock-keywords t))
	(font-lock-mode t)))
  (run-hooks 'hnf-mode-hook))

;;;###autoload
(defun hnf (&optional arg)
  "今日のhnfを開く。"
  (interactive "P")
  (let* ((days-ago (if (listp arg) nil arg))
	 (now (hnf-current-time days-ago))
	 (name (concat hnf-diary-dir "/" 
		       (and hnf-diary-year-directory-flag
			    (hnf-format-time-string "%Y/" now))
		       (if (and arg (listp arg)) nil
			 (hnf-format-time-string "d%Y%m%d.hnf" now))))
	 find-file-not-found-hooks)
    (if (and arg (listp arg)) (setq name (read-file-name "Find file: " name)))
    (if (functionp hnf-initial-function)
	(add-hook 'find-file-not-found-hooks
		  '(lambda () (funcall hnf-initial-function))))
    (find-file name)
    (hnf-mode)))

(defun hnf-tab-complete ()
  "TABを押した時の補完／展開を行う。"
  (interactive)
  (let ((spaces (hnf-count-spaces))
	(command-word (hnf-command-word)))
    (cond ((funcall hnf-header-p-function)
	   (or (and (eq spaces 0)
		    (or (and hnf-variable
			     (not (eq (hnf-complete hnf-variable) 'no-match)))
			(and hnf-complete-ok
			     (not (eq (hnf-complete '(("OK"))) 'no-match)))))
	       (funcall hnf-tab-command)))
	  ((string= "CAT" command-word)	; CATでは複数個の記述が可能
	   (and hnf-cat (hnf-complete hnf-cat)))
	  ((and (string= "MARK" command-word) (= spaces 1))
	   (and hnf-marks (hnf-complete hnf-marks)))
	  ((and (string= "RLINK" command-word) (= spaces 1))
	   (and hnf-rlink (hnf-complete hnf-rlink)))
	  ((and (string= "ALIAS" command-word) (= spaces 1))
	   (and hnf-alias (hnf-complete hnf-alias)))
	  ((and (or (string= "LINK" command-word)
		    (string= "LNEW" command-word)
		    (string= "LSUB" command-word))
		(= spaces 1))
	   (hnf-complete-link))
	  ((and (string= "/" command-word) (= spaces 0))
	   (and hnf-close-command-list (hnf-close-command)))
	  ((and (= spaces 0)
		(not (eq (hnf-complete-command command-word) 'no-match))))
	  (t
	   (funcall hnf-tab-command)))))

;;; 各種コマンド
(defun hnf-newline ()
  "return時にいろいろ挿入します。"
  (interactive)
  (let ((command-word (hnf-command-word))
	(close-command-regexp
	 (concat "^\\("
		 (mapconcat 'identity hnf-close-command-list "\\|")
		 "\\)$")))
    (cond ((string-match close-command-regexp command-word) ; 閉じるタグ挿入
	   (save-excursion (insert (concat "\n/" command-word "\n")))
	   (cond ((or (string= "UL" command-word) (string= "OL" command-word))
		  (insert "\nLI "))
		 (t
		  (insert "\n"))))
	  ((string= "CAT" command-word)
	   (insert "\nNEW "))
	  (t
	   (newline)))))

(defun hnf-command-help ()
  "コマンドの簡単なヘルプを表示します。"
  (interactive)
  (message (nth 2 (assoc (hnf-command-word) hnf-commands))))

(defun hnf-link-find-file ()
  "LINKやLSUBにて相対パスで指定されたファイルをオープンします。"
  (interactive)
  (let ((command-word (hnf-command-word)))
    (if (or (string= "LINK" command-word)
	    (string= "LNEW" command-word)
	    (string= "LSUB" command-word))
	(let (p fname)
	  (save-excursion
	    (beginning-of-line)
	    (skip-chars-forward "^ \t\n")
	    (skip-chars-forward " ")
	    (setq p (point))
	    (skip-chars-forward "^ \t\n#")
	    (setq fname (buffer-substring-no-properties p (point))))
	  (cond ((string-match "^\\(http\\|ftp\\)://" fname)
		 (error "Absolute-URL is not supported"))
		((string-match "^/" fname)
		 (setq fname (concat hnf-document-root fname)))
		(t
		 (setq fname (concat hnf-html-dir "/" fname))))
	  (if (file-directory-p fname)
	      (progn
		(if (not (string-match "/$" fname))
		    (setq fname (concat fname "/")))
		(let ((index-list hnf-index-name-list))
		  (while (and index-list
			      (not (file-exists-p
				    (concat fname (car index-list)))))
		    (setq index-list (cdr index-list)))
		  (if index-list
		      (setq fname (concat fname (car index-list)))
		    (setq fname
			  (read-file-name "Find file: " fname))))))
	  (find-file fname)))))

(defun hnf-get-link (&optional arg)
  "NEWやSUBのリンクのnameを取得します。"
  (interactive "P")
  (let ((date-list (hnf-buffer-hnf-p))
	year mon day day-num dayhi abc cmd-word new-cnt sub-cnt link-name)
    (if (null date-list)
	(error "hnfではありません")
      (setq year (nth 0 date-list)
	    mon (nth 1 date-list)
	    day (nth 2 date-list)
	    day-num (string-to-number day)
	    dayhi (/ day-num 10)
	    abc (cond ((< day-num 11) "a") ((< day-num 21) "b") (t "c"))
	    cmd-word (hnf-command-word))
      (save-excursion
	(if (string-match "^L?SUB$" cmd-word)
	    (progn
	      (setq sub-cnt 1)
	      (while (and (= (forward-line -1) 0)
			  (not (string-match
				"^L?NEW$"
				(setq cmd-word (hnf-command-word)))))
		(if (string-match "^L?SUB$" cmd-word)
		    (setq sub-cnt (1+ sub-cnt))))))
	(if (string-match "^L?NEW$" cmd-word)
	    (progn
	      (setq new-cnt 1)
	      (while (= (forward-line -1) 0)
		(if (string-match "^L?NEW$" (hnf-command-word))
		    (setq new-cnt (1+ new-cnt)))))))
      (if new-cnt
	  (progn 
	    (setq link-name (funcall hnf-get-link-name-function))
	    (message link-name)
	    (if arg (kill-new link-name)))))))

(defun hnf-get-link-name ()
  "hns-1.03pl0以前のNEWのリンクの名前を作成する関数です。"
  (let ((link-name (format "?%s%s%d#%s%s%s%d" 
			   year mon dayhi year mon day new-cnt)))
    (if sub-cnt
	(concat link-name "S" (number-to-string sub-cnt))
      link-name)))

(defun hnf-get-link-name-with-to ()
  "hns-1.03pl1以降のNEWのリンクの名前を作成する関数です。"
  (let ((link-name (format "%s%s%s%d" year mon day new-cnt)))
    (if sub-cnt
	(setq link-name (concat link-name "S" (number-to-string sub-cnt))))
    (setq link-name (format "?%s%s%d&to=%s#%s" 
			    year mon dayhi link-name link-name))))

(defun hnf-get-link-name-with-to-abc ()
  "hns-2.1以降(?)のNEWのリンクの名前を作成する関数です。"
  (let ((link-name (format "%s%s%s%d" year mon day new-cnt)))
    (if sub-cnt
	(setq link-name (concat link-name "S" (number-to-string sub-cnt))))
    (setq link-name (format "?%s%s%s&to=%s#%s" 
			    year mon abc link-name link-name))))

(defun hnf-get-link-name-with-abc ()
  "hns-2.1以降(?)のNEWのリンクの名前を作成する関数です。"
  (let ((link-name (format "%s%s%s%d" year mon day new-cnt)))
    (if sub-cnt
	(setq link-name (concat link-name "S" (number-to-string sub-cnt))))
    (setq link-name (format "?%s%s%s#%s" 
			    year mon abc link-name link-name))))

(defun hnf-insert-time (&optional arg)
  "時間を挿入します。"
  (interactive "P")
  (if (and arg
	   (re-search-forward hnf-time-regexp nil t))
      (replace-match
       (save-match-data
	 (hnf-format-time-string hnf-time-format (hnf-current-time))))
    (insert (hnf-format-time-string hnf-time-format (hnf-current-time)))))

(defun hnf-write-file-insert-time ()
  "`(hnf-insert-time)'を実行し、ファイルを保存します。"
  (interactive)
  (save-excursion
    (goto-char (point-max))
    (hnf-insert-time))
  (save-buffer))

;;; for namazu.el
(defun hnf-namazu (key)
  (interactive
   (progn
     (require 'namazu)
     (list (read-from-minibuffer "Enter Keyword: " nil
				 (if (boundp 'namazu-minibuffer-field-map)
				     namazu-minibuffer-field-map)
				 nil 'namazu-history))))
  (namazu 0 hnf-namazu-index-dir key))

(defun hnf-namazu-find-file ()
  "\*namazu\*にてポイントが位置する項目をエディトします。"
  (interactive)
  (save-excursion
    (if (re-search-forward 
	 "#\\([1-9][0-9][0-9][0-9]\\)\\([0-1][0-9][0-3][0-9]\\)0" nil t)
	(find-file (concat hnf-diary-dir "/"
			   (and hnf-diary-year-directory-flag 
				(concat (match-string 1) "/"))
			   "d" (match-string 1) (match-string 2) ".hnf")))))

;;; for calendar.el
(defun hnf-filename-from-date (date)
  (concat hnf-diary-dir "/"
	  (and hnf-diary-year-directory-flag
	       (format "%d/" (extract-calendar-year date)))
	  (format "d%04d%02d%02d.hnf"
		  (extract-calendar-year date)
		  (extract-calendar-month date)
		  (extract-calendar-day date))))

;;;###autoload
(defun hnf-insert-diary-entry ()
  "カレンダーのポイントがある日付けのhnfを開きます。"
  (interactive)
  (find-file-other-window
   (hnf-filename-from-date (calendar-cursor-to-date t))))

;;;###autoload
(defun hnf-mark-diary-entries ()
  "カレンダー中に日記が書いてある日をマークします。"
  (interactive)
  (require 'calendar)
  (let (y m first-date last-date tmp)
    (save-excursion
      (set-buffer calendar-buffer)
      (setq m displayed-month)
      (setq y displayed-year))
    (increment-calendar-month m y -1)
    (setq first-date
          (calendar-absolute-from-gregorian (list m 1 y)))
    (increment-calendar-month m y 2)
    (setq last-date
          (calendar-absolute-from-gregorian
           (list m (calendar-last-day-of-month m y) y)))
    (calendar-for-loop date from first-date to last-date do
		       (if (file-exists-p
			    (hnf-filename-from-date
			     (setq tmp
				   (calendar-gregorian-from-absolute date))))
			   (mark-visible-calendar-date tmp)))))

;;; for browse-url
(defun hnf-browse-recent-diary ()
  "browse-urlを使って最新の日記を表示します。"
  (interactive)
  (browse-url hnf-diary-url))

(defun hnf-browse-diary ()
  "browse-urlを使って現在編集中の日記を表示します。"
  (interactive)
  (let ((date-list (hnf-buffer-hnf-p)))
    (if (null date-list)
	(error "hnfではありません")
      (browse-url (concat hnf-diary-url "?"
			  (mapconcat 'identity date-list ""))))))

(defvar hnf-temp-file-list '())

(defun hnf-preview-diary ()
  "browse-urlを使って現在編集中の日記を表示します。"
  (interactive)
  (let ((date-list (hnf-buffer-hnf-p)))
    (if (null date-list)
        (error "hnfではありません")
      (let ((temp-file (concat temporary-file-directory
			       "hnf" (apply 'concat date-list) ".html"))
            (default-directory (file-name-directory hnf-hns-program)))
        (with-temp-file temp-file
          (call-process hnf-hns-program nil t t (apply 'concat date-list)))
        (browse-url-of-file temp-file)
	(add-to-list 'hnf-temp-file-list temp-file)))))

(defun hnf-delete-temp-file-list ()
  "hnf-temp-file-list のファイルを削除します。"
  (while hnf-temp-file-list
    (if (file-exists-p (car hnf-temp-file-list))
	(delete-file (car hnf-temp-file-list)))
    (setq hnf-temp-file-list (cdr hnf-temp-file-list))))
(add-hook 'kill-emacs-hook 'hnf-delete-temp-file-list)

;;; 雑多な関数
(defun hnf-buffer-hnf-p (&optional buffer)
  "bufferがhnfかどうかを判定します。bufferを省略した場合は`current-buffer'に
対して判定します。hnfの場合は(year mon day)のリストを返します。"
  (let ((fname (buffer-file-name buffer)))
    (if (and fname
	     (string-match 
	      "d\\([0-9][0-9][0-9][0-9]\\)\\([0-1][0-9]\\)\\([0-3][0-9]\\)\\.hnf"
	      (setq fname (file-name-nondirectory fname))))
	(list (match-string 1 fname)
	      (match-string 2 fname)
	      (match-string 3 fname)))))

(defun hnf-header-p ()
  "ヘッダ部かどうかを調べます。"
  (save-excursion
    (not (search-backward "\n\n" nil t))))

(defun hnf-count-spaces ()
  "カーソル位置までの空白数を求めます。"
  (save-excursion
    (let ((p (point))
	  (cnt 0))
      (beginning-of-line)
      (while (re-search-forward "[ \t]+" p t)
	(setq cnt (+ cnt 1)))
      cnt)))

(defun hnf-cur-word (&optional erase)
  "カーソル位置の単語を抽出します。"
  (save-excursion
    (let ((p (point))
	  string)
      (skip-chars-backward "^ \t\n")
      (setq string (buffer-substring-no-properties p (point)))
      (if erase (delete-region p (point)))
      string)))

(defun hnf-command-word ()
  "その行のコマンド(と思われるもの)を取得します。"
  (save-excursion
    (beginning-of-line)
    (let ((p (point)))
      (skip-chars-forward "^ \t\n")
      (buffer-substring-no-properties p (point)))))

(defun hnf-close-command ()
  "閉じるコマンドを挿入します。
(コマンドのネストには未対応)"
    (if (save-excursion
	  (re-search-backward
	   (concat "^\\("
		   (mapconcat 'identity hnf-close-command-list "\\|")
		   "\\)$")
	   nil t))
	(insert (match-string 0))))

(defun hnf-current-time (&optional days-ago)
  "`current-time'を返します。ただし、`hnf-hour-not-today'が設定されていれば
その時間分だけ以前の時間を返します。"
  (let ((time (current-time)))
    (if (not (numberp days-ago)) (setq days-ago 0))
    (hnf-time-float (- (hnf-float-time time)
		       (* days-ago 24 60 60)
		       (* (or hnf-hour-not-today 0) 60 60)))))

(defun hnf-format-time-string (time-format &optional time)
  "`format-time-string'と同等です。ただし、%Hは`hnf-hour-not-today'の分だけ
未来の時間となります。"
  (let ((case-fold-search nil)
	sub-format hour)
    (while (string-match "%[a-zA-Z]" time-format)
      (setq sub-format (match-string 0 time-format))
      (setq time-format
	    (replace-match
	     (if (string= sub-format "%H")
		 (format "%d"
			 (+ (or hnf-hour-not-today 0)
			    (string-to-number (format-time-string "%H" time))))
	       (format-time-string sub-format time))
	     nil nil time-format)))
    time-format))

(defun hnf-float-time (&optional tm)
  (let ((time (or tm (current-time))))
    (+ (* (float (ash 1 16)) (nth 0 time)) (float (nth 1 time)))))
  
(defun hnf-time-float (num)
  (let* ((most-time (floor num 65536))
	 (least-time (floor (- num (* 65536.0 most-time)))))
    (list most-time least-time 0)))


;;; 補完の上位関数
(defun hnf-complete (alist)
  "カーソル位置にて補完を行います。alist にて候補を指定します。"
  (hnf-complete-string (hnf-cur-word t) alist))

(defun hnf-complete-link ()
  "LINKの補完を行います。"
  (let* ((cur (hnf-cur-word t))
	 (dname (file-name-directory cur))
	 (fname (file-name-nondirectory cur))
	 (files (file-name-all-completions
		 fname
		 (if (char-equal (string-to-char cur) ?/)
		     (concat hnf-document-root dname)
		   (concat hnf-html-dir "/" dname)))))
    (if dname (insert dname))
    (hnf-complete-string fname (mapcar 'list files))))

(defun hnf-complete-command (command-word)
  "コマンドの補完を行います。"
  (let ((sts (hnf-complete hnf-commands)))
    (if (or (eq sts 'match)
	    (and (eq sts 'match1) (setq command-word (hnf-command-word))))
	(if (eq (cadr (assoc command-word hnf-commands)) 0)
	    (and hnf-complete-command-insert-newline-function
		 (funcall hnf-complete-command-insert-newline-function))
	  (and hnf-complete-command-insert-space-flag (insert " "))))
    sts))

;;; 補完の下位関数
(defun hnf-complete-string (string alist)
  (let* ((completion-ignore-case t)
	 (completions (all-completions string alist))
	 (cur (current-buffer))
	 comp)
    (cond 
     ((= (length completions) 1) ; 補完候補が1個だけ
      (if (string= (car completions) string)
	  (progn
	    (insert string)
	    (hnf-delete-completion-window)
	    'match)
	(insert (car completions))
	'match1))
     ((and (setq comp (try-completion string alist))
	   (not (string= comp string))) ; 途中まで補完
      (insert comp)
      'complete)
     (t
      (insert string)
      (if (not comp) 
	  (progn ; 候補がない
	    (hnf-delete-completion-window)
	    'no-match)
	; 候補を表示
	(buffer-disable-undo (get-buffer-create hnf-completion-buffer-name))
	(with-output-to-temp-buffer
	    hnf-completion-buffer-name
	  (display-completion-list (sort completions 'string<)))
	'complete-list)))))
  
(defun hnf-delete-completion-window ()
  (and
   (get-buffer hnf-completion-buffer-name)
   (let ((w (get-buffer-window hnf-completion-buffer-name)))
     (and w
	  (delete-window w))
     (kill-buffer hnf-completion-buffer-name))))

(run-hooks 'hnf-mode-load-hook)

(provide 'hnf-mode)
;;; hnf-mode.el ends here
