;; -*- Mode: Emacs-Lisp -*-
;; $Id: hnf-mode.el,v 2.9 1999/10/30 18:23:19 ari Exp $
;;
;; [HyperNikkiFile mode]
;;  (c)1998-1999 Akihiro Arisawa <ari@nijino.com>
;;		 http://www.nijino.com/ari/
;;
;; 【できること】
;; 1. hnfを編集時にTABでいろいろと補完ができます。
;; 2. font-lockを使ってhnfをカラー表示します。
;; 3. M-x hnf で ~/diary/1999/d19990107.hnf 等、その日のhnfを開きます。
;;    C-u M-x hnf で、、、説明が面倒なんで使ってみてください(^^;
;; 4. NEWやSUBのリンクのnameを表示、及び、kill-ringへ挿入できます。
;;    また、リンク先のファイルをオープンできます。(相対パスで指定時のみ)
;; 5. namazu.elからnamazu_for_hnsで検索した結果からファイルを開けます。
;; 6. M-x calendarと連携ができます。
;; 7. その他、いろいろ。
;;
;; 【設定などなど】
;; 必須の設定は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-directorypを必要に応じて
;;    設定します。設定すべき値は変数のコメントを参照してください。
;;    例) (setq hnf:diary-dir "~/diary")
;;	  (setq hnf:html-dir "~/public_html/diary")
;;	  (setq hnf:diary-year-directoryp 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-cf) を
;;     使います。また、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-ct) を使います。
;;     フォーマットは hnf:time-format で変更できます。
;;
;;     また hnf:write-file-insert-time(C-cs)を評価すると、ファイルの末尾に
;;     時間を挿入しファイルを保存します。
;;
;; 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-edit "hnf-mode" nil t)
;;
;;     また、hnf-modeからC-cnで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(C-cb) で
;;     Web Browserが起動します。
;;     例) (setq hnf:diary-url "http://www.nijino.com/ari/diary/")
;;
;; 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/
;;
;; 【その他】
;; このプログラムは、free softwareです。GPL2 のもとに、このプログラムを再配布
;; したり改変したりしてもかまいません。
;; このプログラムによって起こる結果についていかなる保証も行いません。
;;

(require 'custom)

(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:document-root "/usr/local/apache/htdocs"
  "WebサーバのDocumentRootを指定します。"
  :group 'hnf
  :type 'directory)

(defcustom hnf:diary-year-directoryp 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 t
  "font-lockを使うかどうかの指定をします。"
  :group 'hnf
  :type 'boolean)

(defcustom hnf:complete-command-insert-space 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: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]+\\)" 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-ch" 'hnf:command-help)
  (define-key hnf-mode-map "\C-c=" 'hnf:get-link)
  (define-key hnf-mode-map "\C-cf" 'hnf:link-find-file)
  (define-key hnf-mode-map "\C-ct" 'hnf:insert-time)
  (define-key hnf-mode-map "\C-cs" 'hnf:write-file-insert-time)
  (define-key hnf-mode-map "\C-cb" 'hnf:browse-diary)
  (define-key hnf-mode-map "\C-c\C-b" 'hnf:browse-recent-diary)
  )

;;;###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
      (progn
	(require 'font-lock)
	(make-local-variable 'font-lock-defaults)
	(setq font-lock-defaults '(hnf:font-lock-keywords t))
	(turn-on-font-lock)))
  (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-directoryp
			    (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)))

(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-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:insert-time ()
  "時間を挿入します。"
  (interactive)
  (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-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-directoryp 
				(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-directoryp
	       (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)
  (require 'browse-url)
  (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ではありません。")
      (require 'browse-url)
      (browse-url (concat hnf:diary-url "?"
			  (mapconcat 'identity date-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'以前の時間であれば
前日の同時刻の`current-time'を返します。"
  (let ((time (current-time)))
    (if (not (numberp days-ago)) (setq days-ago 0))
    (if (< (nth 2 (decode-time (current-time))) hnf:hour-not-today)
	(setq days-ago (1+ days-ago)))
    (hnf:time-float (- (hnf:float-time time) days-ago (* days-ago 24 60 60)))))

(defun hnf:format-time-string (time-format &optional time)
  "`format-time-string'と同等です。ただし、`hnf:hour-not-today'以前の時間で
あれば、%Hは24を足した値となります。"
  (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 (and (string= sub-format "%H")
		      (< (setq hour (nth 2 (decode-time time))) 
			 hnf:hour-not-today))
		 (format "%d" (+ hour 24))
	       (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)
  "補完を行います。"
  (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 (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)
