;;;  nikki.el ---- 日記管理用 elisp
;; Copyright (C) 1990-1993, 1999 Hiroshi TANAKA,

;; Author:  Hiroshi TANAKA <tanarin@kh.rim.or.jp>
;;          KANEDEA Hirokazu <kinta@mail.chabashira.co.jp>
;; Version: ver.0.1

;; Nikki is a free software in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU General Public
;; License published by the Free Software Foundation; either version
;; 2 or the any later versions (if exists) of the License.

;; You should have received a copy of the GNU General Public License
;; along with Lookup; if not, write to the Free Software Foundation,
;; Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

;;; Commentary:

;; nikki.el は、田中宏さんが Nemacs/Mule 用に書かれた
;; スケジュール管理用の elisp、 schedule.el を元に、
;; 金田が日記管理用に改造を加えたものです。
;; Emacs20 以外での動作確認はしていません。

;; nikki.el をもとに更に改良．ndiary の日記ファイルを読むことができるようにした
;;(defun schedule-get-filename-format (dir year month) を変更のこと

;;
;; Global Variables
;;

(require 'ndiary-mode)

(defvar schedule-search-word ""
  "検索用語収納変数")

(defvar schedule-hide-mode t
  "徹底的に余分なものを消す")

(defvar schedule-dir "~/diary"
  "* default \"Schedule\" directory")

(defvar schedule-title "スケジュール"
  "*Default tile of \"Schedule\" buffer.")

(defvar schedule-holiday-file ".holiday"
  "* holiday setup file")

(defvar schedule-end-of-week 0
  "*Last-day of week.
   If a week begins at Sunday, set 6 (==Saturday) for it.")

(defvar schedule-yank-variable nil
  "Schedule Yank variable.")

(defvar schedule-temporary-buffer "*Schedule Work Buffer*"
  "Working buffer name for Schedule tool.")

(defvar schedule-week-name-list
;  '("Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat")
  '("日" "月" "火" "水" "木" "金" "土")
  "Day of the week.")

(defvar schedule-system-holiday-assoc
  '(((1 1)	"元旦"	nil	t)
    ((1 15)	"成人の日"	nil	t)
    ((2 11)	"建国記念日"	nil	t)
    ((3 21)	"春分の日"	nil	t)	;; 3/20 or 21
    ((4 29)	"みどりの日"	nil	t)
    ((5 3)	"憲法記念日"	nil	t)
    ((5 4)	"国民の祝日"	nil	t)
    ((5 5)	"子供の日"	nil	t)
    ((7 20)     "海の日"        nil     t)
    ((9 15)	"敬老の日"	nil	t)
    ((9 23)	"秋分の日"	nil	t)
    ((10 10)	"体育の日"	nil	t)
    ((11 3)	"文化の日"	nil	t)
    ((11 23)	"勤労感謝の日"	nil	t)
    ((12 23)	"天皇誕生日"	nil	t))
  "System holiday association list. Each element is
     ((MONTH DAY) \"HOLIDAY_NAME\" YEAR NON_WORKDAY_P).")

(defvar schedule-user-holiday-assoc nil
  "User defined holiday association list.
   Format is the same as 'schedule-system-holiday-assoc.")

(defvar schedule-face-alist
  '((schedule-workday-face  "green" nil nil nil)
    (schedule-saturday-face "blue" nil nil nil)
    (schedule-holiday-face  "red" nil nil nil))
  "日付の face のリスト
     face名                表示色 背景色 bold italic")

(defvar schedule-use-short-name t
  "Enable to use \"scm\" as an alias of \"schedule\".
  If there's another command named \"scm\", set nil.")

(defvar schedule-edit-other-frame nil
  "別フレームで編集する")

(defvar schedule-position 5
  "最上段からＮ行目に日付を表示する。nil ならスクロールさせない。")

(defvar schedule-gengou-p t
  "Use Japanese GENGOU for year name.")

(defvar schedule-hide-p nil
  "Hide schedule string in the summary buffer or not.")

(defvar schedule-summary-mode-p nil
  "詳細モードと概略モードの切り替えスイッチ")

(defvar schedule-summary-search-mode-p nil
  "詳細モードと概略モード時の検索モード切り替えスイッチ")

(defvar schedule-show-borders nil
  "Show border lines between date lines in the summary buffer.")

(defvar schedule-mode-map nil
  "Keymap table for Schedule mode.")

(defvar schedule-edit-mode-map nil
  "Keymap table for Schedule Edit mode.")

(defvar schedule-mode-hook nil
  "Hooks for Schedule mode.")

(defvar schedule-edit-mode-hook nil
  "Hooks for Schedule Edit mode.")

(defvar schedule-save-hook nil
  "Hooks for Schedule Edit mode.")

;;
;; 日付行の色の定義
;;
(let ((alist schedule-face-alist) 
      (idx 0)
      entry name fore back bold italic)
  (while (setq entry (nth idx alist))
    (setq name (nth 0 entry)
	  fore (nth 1 entry)
	  back (nth 2 entry)
	  bold (nth 3 entry)
	  italic (nth 4 entry))
    (make-face name)
    (if fore (set-face-foreground name fore))
    (if back (set-face-background name back))
    (if bold (set-face-bold-p name bold))
    (if italic (set-face-italic-p name italic))
    (setq idx (1+ idx))))

;;
;; Interface
;;
(defun schedule (&optional arg)
  "Schedule management tool.
  file format for \"schedule\" is compatible with xcal.
  If ARG is non-nil, schedule ask year and month.
  If ARG is '(quote (16))' (C-u C-u), schedule ask hide or not."
  (interactive "P")
  (let ((config (current-window-configuration))
	time)
    (setq schedule-dr schedule-dir)
    (setq schedule-ttl schedule-title)
    (if (not arg)
	(setq time (schedule-get-time (current-time-string)))
      (setq time (schedule-read-time))
      (and (equal arg '(16))
	   (setq schedule-hide-p (y-or-n-p "Hide schedule?"))))
    (schedule-setup)
    (schedule-open time config)))

(and
 schedule-use-short-name
 (defun scm (arg)
   "This command just calls 'schedule.
  Because the command name \"schedule\" is too long, \"scm\" may be
  convenient to activate schedule tool.
  (\"scm\" is an abbreviation of \"SChedule Manager\")"
   (interactive "P")
   (call-interactively 'schedule arg)))

(defun schedule-quit ()
  "Quit from \"schedule\" and restore window configuration."
  (interactive)
  (let ((config schedule-prev-conf))
    (schedule-exit)
    (set-window-configuration config)))

(defun schedule-next-line (arg)
  "Move cursor to the next day."
  (interactive "P")
  (if arg (setq arg (prefix-numeric-value arg))
    (setq arg 1))
  (schedule-forward-line arg))

(defun schedule-prev-line (arg)
  "Move cursor to the previous day."
  (interactive "P")
  (if arg (setq arg (prefix-numeric-value arg))
    (setq arg 1))
  (schedule-forward-line (- arg)))

(defun schedule-forward-page ()
  "Move cursor forward 10 days."
  (interactive)
  (schedule-forward-line 10))

(defun schedule-backward-page ()
  "Move cursor backward 10 days."
  (interactive)
  (schedule-forward-line -10))

(defun schedule-next-month (arg)
  "Goto next month.
   Cursor point will be on the 1th day if ARG is non-nil, else on the
   same day as the current cursor positon."
  (interactive "P")
  (schedule-forward-month 1 arg))

(defun schedule-prev-month (arg)
  "Goto previous month.
   Cursor point will be on the last day if ARG is non-nil, else on the
   same day as the current cursor positon."
  (interactive "P")
  (schedule-forward-month -1 arg))

(defun schedule-jump-month ()
  "Jump to specified month."
  (interactive)
  (let ((time (schedule-read-time))
	(conf schedule-prev-conf))
    (schedule-exit)
    (schedule-open time conf t)))

(defun schedule-toggle-hide (arg)
  "Hide schedule or show (toggle)."
  (interactive "P")
  (setq schedule-hide-p (or arg (not schedule-hide-p)))
  (schedule-open schedule-current-time
		 schedule-prev-conf t))

(defun schedule-toggle-summary-mode (arg)
    "詳細モードと概略モードを切り替える"
  (interactive "P")
  (setq schedule-summary-mode-p (or arg (not schedule-summary-mode-p)))
  (schedule-open schedule-current-time
		 schedule-prev-conf t))

(defun schedule-kill-data ()
  "Kill current data."
  (interactive)
  (let* ((date (schedule-get-current-date))
	 (file (format schedule-filename-format date))
	 (time schedule-current-time))
    (if (and 
	 (y-or-n-p (format "%d月%d日のデータを消しますか？" (car time) date))
	 (file-exists-p file))
	(progn
	  (schedule-yank-file-contents file)
	  (delete-file file)
	  (schedule-open schedule-current-time
			 schedule-prev-conf t)))
    (message "")))

(defun schedule-yank-data ()
  "Copy current data to yank buffer."
  (interactive)
  (let* ((date (schedule-get-current-date))
	 (file (format schedule-filename-format date))
	 (time schedule-current-time))
    (if (file-exists-p file)
	(progn
	  (schedule-yank-file-contents file)
	  (message "%d月%d日のデータを記憶しました" (car time) date))
      (message "%d月%d日にデータはありません" (car time) date)
      (beep))))

(defun schedule-copy-data ()
  "Copy yank data to current date."
  (interactive)
  (let* ((date (schedule-get-current-date))
	 (file (format schedule-filename-format date))
	 (time schedule-current-time))
    (if (schedule-copy-yanked-contents file)
;;    (if (schedule-yank-file-contents file)
	  (schedule-open schedule-current-time
			 schedule-prev-conf t)
      (message "コピーできません"))))

(defun schedule-edit-schedule ()
  "Open Edit buffer. To return to the summary buffer, type C-cC-c."
  (interactive)
  (let* ((date (or (schedule-get-current-date)
		   (string-to-int (read-string "What day? : "))))
	 (file (format schedule-filename-format date))
	 (time schedule-current-time)
	 (year (car (cdr time)))
	 (yeardir (schedule-get-year-dir year))
	 (ndir schedule-dr)
	 (config schedule-prev-conf)
	 (buffer (current-buffer))
	 (dir (expand-file-name (file-name-directory file)))
	 (pconf (current-window-configuration)))

    (if (not (file-accessible-directory-p yeardir))
	(make-directory yeardir t))
    (if (not (file-accessible-directory-p dir))
	(make-directory dir t))
    (if schedule-edit-other-frame
	(find-file-other-frame file)
        (find-file file))
    (make-local-variable 'schedule-dr)
    (make-local-variable 'schedule-current-time)
    (make-local-variable 'schedule-prev-conf)
    (make-local-variable 'schedule-edit-prev-buffer)
    (make-local-variable 'schedule-edit-prev-conf)
    (setq schedule-current-time (schedule-time-reset time nil nil date)
	  schedule-prev-conf config
	  schedule-edit-prev-buffer buffer
	  schedule-edit-prev-conf pconf
	  schedule-dr ndir)
    (rename-buffer (schedule-edit-buffer-name time date))
    (setq mode-line-buffer-identification
	  (schedule-edit-buffer-ident time date))
    (schedule-edit-mode)))

(defun schedule-edit-copy-data ()
  "Copy yanked data to the current Edit Buffer."
  (interactive)
  (if schedule-yank-variable
      (insert schedule-yank-variable)
    (messsage "データが記憶されていません")))

(defun schedule-edit-quit ()
  "Save data and quit Edit Buffer, then return to the Summary Buffer."
  (interactive)
  (let ((buffer (current-buffer))
	(file (buffer-file-name))
	(frame (selected-frame))
	(require-final-newline t)
	size)
;    (schedule-edit-adjust-buffer)
    (setq size (buffer-size))
    (and schedule-save-hook
	 (run-hooks 'schedule-save-hook))
    (save-buffer)

    (schedule-edit-back-to-summary)
    (if schedule-edit-other-frame
	(delete-frame frame))
    (kill-buffer buffer)
    (and (zerop size)
	 (file-exists-p file)
	 (delete-file file))))

(defun schedule-edit-cancel ()
  "Kill data and quit Edit Buffer, then return to the Summary Buffer."
  (interactive)
  (let ((buffer (current-buffer))
	(buffer-modified-p nil))
    (schedule-edit-back-to-summary)
    (kill-buffer buffer)))

(defun schedule-add-holiday ()
  "Add user-holiday data."
  (interactive)
  (let* ((date (or (schedule-get-current-date)
		   (string-to-int (read-string "What day? : "))))
	 (time schedule-current-time)
	 data name nwp)
    (setq schedule-current-time (schedule-time-reset time nil nil date))
    (setq name (read-string "何の日ですか？（RETは省略）" nil))
    (if (zerop (length name)) (setq name nil))
    (setq nwp (y-or-n-p "休日ですか？"))
    (if (or name nwp)
	(schedule-add-holiday-data schedule-current-time name nwp))))

(defun schedule-delete-holiday ()
  "Delete user-holiday data."
  (interactive)
  (let* ((date (or (schedule-get-current-date)
		   (string-to-int (read-string "What day? : "))))
	 (time schedule-current-time))
    (setq schedule-current-time (schedule-time-reset time nil nil date))
    (schedule-delete-holiday-data schedule-current-time)))
;;
;; Functions
;;
(defun schedule-open (time config &optional ndwp)
  "Open \"schedule\" Summary Buffer."
  (let* ((month (car time))
	 (year (car (cdr time)))
	 (day (max (min (or (car (cdr (cdr time))) 1)
			(schedule-day-number month year))
		   1))
	 (dir (schedule-get-year-dir year))
	 (ndir schedule-dr)
	 (ttl schedule-ttl)
	 (buffer (get-buffer-create
		  (schedule-summary-buffer-name month year))))
    ;;(if (not (file-exists-p dir))
    ;;(call-process "mkdir" nil nil nil dir))
    ;;(if (not (file-directory-p dir))
    ;;(error "%s はディレクトリぢゃないよ" dir)
      (switch-to-buffer buffer)
      (setq buffer-read-only t)
      (setq truncate-lines nil)
      (make-local-variable 'schedule-dr)
      (make-local-variable 'schedule-ttl)
      (make-local-variable 'schedule-filename-format)
      (make-local-variable 'schedule-current-time)
      (make-local-variable 'schedule-prev-conf)
      
      (setq schedule-filename-format 
	    (schedule-get-filename-format dir year month)
	    schedule-current-time time
	    schedule-prev-conf config
	    schedule-dr ndir
	    schedule-ttl ttl)
      (let ((buffer-read-only nil))
	(if (not (zerop (buffer-size)))
	    (delete-region (point-min) (point-max)))
	(schedule-make-summary-buffer month year)
	(setq mode-line-buffer-identification
	      (schedule-summary-buffer-ident month year))
	(set-buffer-modified-p nil))
      (or ndwp (delete-other-windows))
      (schedule-move-cursor-on-the-day day)
      (schedule-recenter)

      (schedule-mode)))
;;)

(defun schedule-exit ()
  "Kill current Summary Buffer."
  (kill-buffer (current-buffer)))

(defun schedule-setup ()
  (let ((dir (expand-file-name schedule-dr)))
    (if (not (file-exists-p schedule-dr))
	(if (y-or-n-p
	     (format "ディレクトリ\"%s\"がありません。作りますか？" dir))
	    (call-process "mkdir" nil nil nil dir)
	  (error "No Schedule Directory."))
      (schedule-read-holiday-file))))

(defun schedule-make-summary-buffer (month year)
  "Make Summary Buffer."
  (let ((dnum (schedule-day-number month year))
	(date 1)
	(dow (schedule-day-of-week month 1 year))
	(mname (if schedule-gengou-p
		   (format "%s年%2d月" (schedule-gengou-year year month) month)
		 (format "%6d年%2d月" year month))))
    ;; title
    (insert "\n          ******* " schedule-ttl "  " mname " *******\n")
    (insert "---------------------------------------"
	    "---------------------------------\n")
    ;; summary lines
    (while (<= date dnum)
      (schedule-insert-summary-line date month year dow)
      (setq date (1+ date))
      (setq dow (% (1+ dow) 7)))
    ;; bottom line
    (and (not schedule-show-borders)
	 (not (= dow (% (1+ schedule-end-of-week) 7)))
	 (insert "---------------------------------------"
		 "---------------------------------\n"))))

(defun schedule-insert-summary-line (date month year dow)
  "Make Summary line."
  (let* ((fname (format schedule-filename-format date))
	 (index (schedule-get-index date month year dow))
	 (idx (car index))
	 (msg (nth 1 index)))
    (put-text-property 0
		       (length idx)
		       'face
		       (cond ((schedule-holiday-p date month year dow)
			      'schedule-holiday-face)
			     ((= dow 6) 'schedule-saturday-face)
			     (t 'schedule-workday-face))
		       idx)
    (save-restriction
      (narrow-to-region (point) (point))
      ;; insert day label and holiday messages.
      (insert idx "\n")
      (mapcar '(lambda (arg) (insert "《" arg "》 " )) msg)
      ;; 日付けに色をつける
;      (while msg
;	(insert "《" (car msg) "》" "\n")
;	(setq msg (cdr msg)))
      ;; insert file contents if file exists.
      (and (file-exists-p fname)
	   (save-restriction
	     (narrow-to-region (point)(point))
	     (schedule-insert-file-contents fname)
;	   (save-excursion (schedule-insert-file-contents fname))
	     (goto-char (point-min))
	     (and schedule-hide-p
		  (while (not (eobp))
		    (let ((beg (point)))
		      (end-of-line)
		      (let ((len (- (point) beg)))
			(delete-region beg (point))
			(while (> len 0)
			  (insert "■") (setq len (- len 2)))
			(forward-line 1)))))))
;			(forward-line 1))))))
      ;; indent
      (goto-char (point-min))
      (end-of-line)
      (delete-char 1)	; join 2 lines
; for mule
;      (indent-rigidly (point) (point-max) (length idx))
;      (let ((clmn (current-column)))
;	(indent-rigidly (point) (point-max) clmn))
      (goto-char (point-max))
      (or (bolp) (newline))
      (or schedule-summary-mode-p (newline))
      (if (= dow schedule-end-of-week)
	  (insert "==================================================《"
		  (if schedule-gengou-p
		      (format
		       "%s年%2d月" (schedule-gengou-year year month) month)
		    (format "%6d年%2d月" year month))
		  "》======\n")
	(and schedule-show-borders
	     (insert "------------------------------------------------------------------------\n"))))))
;

(defun schedule-forward-month (arg &optional flag)
  "Goto next ARGth month.
   Cursor point will be on the 1th day if ARG is positive, else on the
   last day of the month.
   If FLAG is non-nil, cursor will move on the same day as the prev. day"
  (let* ((time (schedule-time-month-plus schedule-current-time arg))
	 (month (car time))
	 (year (car (cdr time)))
	 (date (schedule-get-current-date))
	 (config schedule-prev-conf))
    (schedule-exit)
    (schedule-open
     (list (car time)
	   (car (cdr time))
	   (if flag date
	     (if (> arg 0) 1 (schedule-day-number month year))))
     config
     t)))

(defun schedule-forward-line (arg)
  "Goto next ARGth day."
  (let ((date (or (schedule-get-current-date) 1))
	(pnt (point)))
    (if (and (= arg 1) (= date (schedule-day-number
				(car schedule-current-time)
				(car (cdr schedule-current-time)))))
	(schedule-forward-month 1)
      (if (and (= arg -1) (= date 1))
	  (schedule-forward-month -1)
	(progn
	  (setq date (if (> arg 0)
			 (min (+ date arg)
			      (schedule-day-number (car schedule-current-time)
						   (car (cdr schedule-current-time))))
		       (max (+ date arg) 1)))
	  (schedule-move-cursor-on-the-day date)
	  (schedule-recenter))))))

(defun schedule-move-cursor-on-the-day (day)
  "Move cursor on the current day."
  (let ((ptn (if (not day) "^\\(【\\|［\\)01 "
	       (format "^\\(【\\|［\\)%02d " day))))
    (goto-char (point-min))
    (if (re-search-forward ptn nil t)
	(goto-char (match-beginning 0))
	(goto-char (point-min))))
  (setq schedule-current-time
	(schedule-time-reset schedule-current-time nil nil day)))

(defun schedule-recenter ()
  "Similar to 'recenter', but considering window height."
  (if (and schedule-position (not schedule-summary-mode-p))
      (recenter schedule-position)))
;  (let ((ln (count-lines (point) (point-max)))
;	 (wh (window-height)))
;    (if (< (+ ln ln) wh)
;	 (recenter (- wh ln 1))
;      (recenter (/ wh 2)))))

(defun schedule-buffer-exist-p (buffer)
  "BUFFER exists or not."
  (let ((list (buffer-list)) ret)
    (while (and list (not ret))
      (if (eq (car list) buffer)
	  (setq ret t)
	(setq list (cdr list))))
    ret))

(defun schedule-yank-file-contents (file)
  "Copy FILE contents into schedule-yank-variable."
  (save-excursion
    (let ((buffer (get-buffer-create schedule-temporary-buffer)))
      (set-buffer buffer)
      (widen) (delete-region (point-min) (point-max))
      (schedule-insert-file-contents file)
      (setq schedule-yank-variable
	    (buffer-substring (point-min) (point-max))))))

(defun schedule-copy-yanked-contents (file)
  "Append yanked data to the FILE."
  (if (stringp schedule-yank-variable)
      (save-excursion
	(let ((buffer (get-buffer-create schedule-temporary-buffer)))
	  (set-buffer buffer)
	  (widen) (delete-region (point-min) (point-max))
	  (insert schedule-yank-variable)
	  (append-to-file (point-min) (point-max) file))
	t)
    nil))

;(defun schedule-edit-adjust-buffer ()
;  "Remove empty lines in the Edit Buffer."
;  (goto-char (point-min))
;  (replace-regexp "^\n" ""))

(defun schedule-edit-back-to-summary ()
  "Goto Summary Buffer if exists.
  If no Summary Buffer exists, open it."
  (let ((pconf schedule-edit-prev-conf))
    (if (schedule-buffer-exist-p schedule-edit-prev-buffer)
	(schedule-edit-back-to-buffer schedule-edit-prev-buffer)
      (schedule-open schedule-current-time schedule-prev-conf))
    (save-excursion
      (set-window-configuration pconf))
    (schedule-recenter)))

(defun schedule-edit-back-to-buffer (buffer)
  "Switch to BUFFER."
  (set-buffer buffer)
  (pop-to-buffer buffer)
  (schedule-open schedule-current-time schedule-prev-conf))

(defun schedule-insert-file-contents (file)
  "Insert FILE contents."
  (save-restriction
    (narrow-to-region (point) (point))
    (insert-file-contents file)
    
    ;; 指定トピックのみを表示させる
    (goto-char (point-min))
    (if schedule-summary-search-mode-p
	(let ((beg (point)))
	  (while (re-search-forward
		  (concat "^○.*"
			  schedule-search-word
			  ".*$") nil t)
	    (progn
	      (beginning-of-line)
	      (delete-region beg (point))
	      (end-of-line)
	      (if (re-search-forward "^○" nil t)
		  (beginning-of-line)
		(goto-char (point-max)))
	      (setq beg (point))
	      )
	    (delete-region beg (point)))
	  (delete-region beg (point-max))))

    (goto-char (point-min))
    (if schedule-summary-mode-p       ;概略モードの時に本文を消す
	(let ((beg (point)) (co 0))
	  (while (re-search-forward "^○" nil t)
	    (progn
	      (beginning-of-line)
	      (delete-region beg (point))
	      (if (= co 0)
		  (setq co 1)
		(insert "/"))
	      (end-of-line)
	      (setq beg (point))
	      ))
	  (delete-region beg (point-max)))
      (goto-char (point-max)))

    (or (zerop (current-column))
	(insert "\n"))
    
    (goto-char (point-min))
    (while
	(re-search-forward
	 "<a href=\"\\([^\"]+\\)\">\\([^>]+\\)</a>" nil t)
      (let ((url (buffer-substring (match-beginning 1) (match-end 1)))
	    (text (buffer-substring (match-beginning 2) (match-end 2))))
      (delete-region (match-beginning 0) (match-end 0))
      (insert (concat text "(" url ")"))))

    (goto-char (point-min))
    ;; 余計なものは消してしまえ
    ;; 読むのにリンクやISBNなんて邪魔じゃあ
    (while
	(re-search-forward
	 "\\(\\(^・[^\n:]+:[^\n]+\n\\)\\|\\(<a href=\"[^\"]+\">\\)\\)\\|\\((ISBN[-X0-9]+)\n\\)"
	 nil t)
      (delete-region (match-beginning 0) (match-end 0)))

    (goto-char (point-min))
    (while
	(re-search-forward
	 "\n[\n]+" nil t)
      (progn (delete-region (match-beginning 0) (match-end 0))
	     (insert "\n\n")))

    (if schedule-hide-mode
	(progn
	  (let ((beg) (end))
	    (goto-char (point-min))
	    (while (re-search-forward "^Code:.*$" nil t)
		(progn
		  (beginning-of-line)
		  (setq beg (point))
		  (if (re-search-forward "^$" nil t)
		      (setq end (point))
		    (setq end (point-max)))
		  (delete-region beg end)
		  (insert "*** Code is here! ***\n"))))))
    
    (goto-char (point-min))
    (while
	(re-search-forward
	 "\n" nil t)
      (progn (delete-region (match-beginning 0) (match-end 0))
	     (insert "\n\n")))

    (setq fill-column 80)
    (fill-region (point-min) (point-max))
    
    (goto-char (point-min))
    (while
	(re-search-forward
	 "\n\n" nil t)
      (progn (delete-region (match-beginning 0) (match-end 0))
	     (insert "\n")))
    )
  )
;;    (while (re-search-forward "^\n" nil t)
;;      (delete-region (match-beginning 0) (1+ (match-beginning 0))))))

(defun schedule-summary-buffer-name (month year)
  "Get Summary Buffer name."
  (format "Schedule Summary %d-%d \"%s\"" year month schedule-dr))

(defun schedule-summary-buffer-ident (month year)
  "Get Summary Buffer name."
  (if schedule-gengou-p
      (format " %s {%s年 %d月} \"%s\""
	      schedule-ttl 
	      (schedule-gengou-year year month) month schedule-dr)
    (format " %s {%d年 %d月} \"%s\"" schedule-ttl year month schedule-dr)))

(defun schedule-edit-buffer-name (time date)
  "Get Edit Buffer name."
  (format "Schedule EDIT %d-%d-%d"
	  (nth 1 time) (car time) date))

(defun schedule-edit-buffer-ident (time date)
  "Get Edit Buffer name."
  (if schedule-gengou-p
      (format " Schedule EDIT {%s年%2d月%2d日}"
	      (schedule-gengou-year (nth 1 time) (car time)) (car time) date)
    (format "Schedule EDIT {%2d年%2d月%2d日}"
	    (nth 1 time) (car time) date)))

(defun schedule-get-year-dir (year)
  "Get directory name for YEAR."
  (expand-file-name (format"%s/%d" schedule-dr year)))

(defun schedule-get-month-dir (year month)
  "Get directory name for YEAR."
  (expand-file-name (format"%s/%d/%02d/" schedule-dr year month)))

(defun schedule-get-filename-format (dir year month)
  "Get file-name format (regexp)."
  ;; original xcal format
;  (format "%s/xc%%d%s%d" dir (schedule-int-to-month month) year)
  ;; tacchan@flab's local format
;;  (format "%s/xc%02d-%02d-%%02d" dir year month)
  (format "%s/%02d/%02d%02d%%02d.diary" dir month year month)
)

(defun schedule-get-index (date month year &optional dow)
  "Get index string for each day."
  (or dow (setq dow (schedule-day-of-week month date year)))
  (let ((hp (schedule-holiday-p date month year dow))
	(hname (schedule-holiday-name date month year)))
    (list (if hp
	      (format "【%02d %s】" date (nth dow schedule-week-name-list))
	    (format "［%02d %s］" date (nth dow schedule-week-name-list)))
	  hname)))

(defun schedule-get-current-date ()
  "Get current day."
  (end-of-line)
  (if (re-search-backward "^\\(【\\|［\\)\\(..\\) " nil t)
      (string-to-int (buffer-substring (match-beginning 2) (match-end 2)))
    (beginning-of-line)
    (if (re-search-forward "^\\(【\\|［\\)\\(..\\) " nil t)
	(string-to-int (buffer-substring (match-beginning 2) (match-end 2)))
      nil)))

(defun schedule-read-holiday-file ()
  "Read holiday file and reset holiday assoc."
  (let* ((hfile (expand-file-name
		 (concat (file-name-as-directory schedule-dr)
			 schedule-holiday-file)))
	 (buffer (find-file-noselect hfile)))
    (if (not buffer)
	(error "Cannot open holiday file %s" hfile)
      (save-excursion
	(set-buffer buffer)
	(or (zerop (buffer-size))
	    (save-buffer))
	(schedule-holiday-to-assoc-format)))))

(defun schedule-holiday-to-assoc-format ()
  (setq schedule-user-holiday-assoc nil)
  (goto-char (point-min))
  (let (month day name year nwp)
    (while
	(re-search-forward
	 "^[ \t]*\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\(.*\\)[ \t]+\\([0-9]+\\|-\\)[ \t]+\\([nt]\\)$"
	 nil t)
      (setq month
	    (string-to-int (buffer-substring (match-beginning 1) (match-end 1))))
      (setq day
	    (string-to-int (buffer-substring (match-beginning 2) (match-end 2))))
      (setq name (buffer-substring (match-beginning 3) (match-end 3)))
      (setq year (buffer-substring (match-beginning 4) (match-end 4)))
      (setq nwp (buffer-substring (match-beginning 5) (match-end 5)))
      (and (string-equal name "-") (setq name nil))
      (if (string-equal year "-")
	  (setq year nil)
	(setq year (string-to-int year)))
      (if (string-equal nwp "t")
	  (setq nwp t)
	(setq nwp nil))
      (setq schedule-user-holiday-assoc
	    (cons (list (list month day) name year nwp)
		  schedule-user-holiday-assoc)))))

(defun schedule-get-holiday-data (date month year alist)
  "Get holiday list."
  (let ((alst alist) lst)
    (while alst
      (let* ((data (car alst))
             (ydata (car (cdr (cdr data)))))
        (and (equal (car data) (list month date))
             (or (not ydata) (= ydata year))
             (setq lst (cons (list (car (cdr data))
                                   (car (cdr (cdr (cdr data))))) lst)))
        (setq alst (cdr alst))))
    lst))

(defun schedule-holiday-name (date month year)
  "Get holiday name."
  (let (data list)
    (setq data (schedule-get-holiday-data
		date month year schedule-user-holiday-assoc))
    (while data
      (let ((ndata (car data)))
        (and (car ndata)
             (setq list (cons (car ndata) list))))
      (setq data (cdr data)))
    (setq data (schedule-get-holiday-data
		date month year schedule-system-holiday-assoc))
    (while data
      (let ((ndata (car data)))
        (and (car ndata)
             (setq list (cons (car ndata) list))))
      (setq data (cdr data)))
    list))

(defun schedule-holiday-p (date month year &optional dow)
  "Holiday (= non work day) or not."
  (or dow (setq dow (schedule-day-of-week month day year)))
  (let ((ret (or (zerop dow)))
        data)
    (setq data (schedule-get-holiday-data
                  date month year schedule-system-holiday-assoc))
    (while data
      (if (not (car (cdr (car data))))
          (setq data (cdr data))
        (setq ret t)
        (setq data nil)))
    (setq data (schedule-get-holiday-data
                  date month year schedule-user-holiday-assoc))
    (while data
      (let ((ndata (car data)))
        (if (car ndata)
	    (progn
	      (and (car (cdr ndata))
		   (setq ret t))
	      (setq data (cdr data)))
          (setq ret (car (cdr ndata)))
          (setq data nil))))
    ret))

(defun schedule-add-holiday-data (time name nwp)
  (schedule-write-holiday-data
   (schedule-make-holiday-data time name nwp)))

(defun schedule-make-holiday-data (time name nwp)
  (list (list (nth 0 time) (nth 2 time)) name (nth 1 time) nwp))

(defun schedule-delete-holiday-data (time)
  (let ((hdata (schedule-get-holiday-data
		(nth 2 time) (car time) (nth 1 time)
		schedule-user-holiday-assoc)))
    (if (and (assoc nil hdata)
	     (nth 2 (assoc nil hdata)))
	(schedule-delete-nwp schedule-current-time))
    (schedule-write-holiday-data
     (schedule-make-holiday-data schedule-current-time nil nil))))

(defun schedule-write-holiday-data (data)
  "Write holiday data to the file."
  (let* ((hfile (expand-file-name
		 (concat (file-name-as-directory schedule-dr)
			 schedule-holiday-file)))
	 (buffer (find-file-noselect hfile)))
    (if (not buffer)
	(error "Cannot open holiday file %s" hfile)
      (save-excursion
	(set-buffer buffer)
	(goto-char (point-max))
	(insert (int-to-string (car (car data))) "\t"
		(int-to-string (nth 1 (car data))) "\t"
		(or (nth 1 data) "-") "\t"
		(if (nth 2 data) (int-to-string (nth 2 data)) "-") "\t"
		(if (nth 3 data) "t" "n") "\n")
	(setq schedule-user-holiday-assoc
	      (cons data schedule-user-holiday-assoc))
	(save-buffer)))))

(defun schedule-delete-nwp (time)
  "Delete nwp data."
  (let* ((hfile (expand-file-name
		 (concat (file-name-as-directory schedule-dr)
			 schedule-holiday-file)))
	 (buffer (find-file-noselect hfile))
	 (date (nth 2 time))
	 (month (car time))
	 (year (nth 1 time)))
    (if (not buffer)
	(error "Cannot open holiday file %s" hfile)
      (save-excursion
	(set-buffer buffer)
	(goto-char (point-min))
	(if (re-search-forward
	     (concat "^[ \t]*" (int-to-string month)
		     "[ \t]+" (int-to-string date)
		     "[ \t]+-[ \t]+\\(" (int-to-string year)
		     "\\|-\\)[ \t]+n$")
	     nil t)
	    (delete-region (match-beginning 0) (1+ (match-end 0))))
	(save-buffer)
	(schedule-holiday-to-assoc-format)))))
;;
;; Time functions
;;
(defun schedule-read-time ()
  "Ask user year and month."
  (let* ((time (schedule-get-time (current-time-string)))
	 (year (read-string "何年？ : " (int-to-string (car (cdr time)))))
	 (month (read-string "何月？ : " (int-to-string (car time)))))
    (if (string-equal month "")
	(setq month (car time))
      (setq month (string-to-int month)))
    (if (string-equal year "")
	(setq year (car (cdr time)))
      (setq year (string-to-int year)))
    (list month year 1)))

(defun schedule-get-time (str)
  "Make time list by TIMESTRING.
    such as '(month year day)."
  (let ((month (substring str 4 7))
	(year (substring str 20 24))
	(day (substring str 8 10)))
    (list (schedule-month-to-int month)
	  (string-to-int year)
	  (string-to-int day))))

(defun schedule-time-reset (time month year day)
  "Make \"time\" list."
  (let ((mnth (car time))
	(yr (nth 1 time))
	(dy (nth 2 time)))
    (list (or month mnth) (or year yr) (or day dy))))
	
(defun schedule-month-to-int (month)
  "Get month from month-name."
  (cdr (assoc month
	      '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4)
		("May" . 5) ("Jun" . 6) ("Jul" . 7) ("Aug" . 8)
		("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12)))))

(defun schedule-int-to-month (month)
  "Get month-name from month."
  (nth (1- month)
       '("Jan" "Feb" "Mar" "Apr" "May" "Jun"
	 "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")))

(defun schedule-time-month-plus (time plus)
  "Calculate \"time\" + PLUS months."
  (let ((month (+ (car time) plus))
	(year (car (cdr time)))
	(rest (cdr (cdr time))))
    (while (< month 1)
      (setq month (+ month 12))
      (setq year (1- year)))
    (while (> month 12)
      (setq month (- month 12))
      (setq year (1+ year)))
    (cons month (cons year rest))))

(defun schedule-day-number (month year)
  "Get number of the day for each month."
  (if (and (= month 2) (schedule-uruu-p year))
      29
    (nth (1- month)
	 '(31 28 31 30 31 30 31 31 30 31 30 31))))

(defun schedule-uruu-p (year)
  "Uruu-doshi or not."
;  (zerop (% year 4)))
  (or (and (zerop (% year 4)) (not (zerop (% year 100))))
      (zerop (% year 400))))

(defun schedule-day-of-week (month day year)
  (let* ((ly (if (schedule-uruu-p year) 1 0))
	 (dn (- (+ day (* 31 (1- month)))
		(if (> month 2) (- (/ (+ 23 (* 4 month)) 10) ly) 0)))
	 (cr (* (/ (1- year) 100) 3))
	 (adn (- (+ dn (* 365 (1- year)) (/ (1- year) 4))
		 (if (zerop (% cr 4)) (/ cr 4) (1+ (/ cr 4))))))
    (% adn 7)))

(defun schedule-gengou-year (year month)
  "Get Japanese Gengou year."
  (if (< year 1926) (format "%6d" year)
    (if (= year 1926)
	(if (< month 12) "大正15" "昭和元")
      (if (< year 1989) (format "昭和%2d" (- year 1925))
	(if (= year 1989)
	    (if (= month 1) "昭和64" "平成元")
	  (format "平成%2d" (- year 1988)))))))
;;
;; Mode Definitions
;;
(defun schedule-mode ()
  "Major mode for \"schedule\" Summary Buffer.

Commands:
\\[schedule-edit-schedule]		edit schedule about the day where cursor on.
\\[schedule-quit]		quit
\\[schedule-next-month]		go to  next month.
\\[schedule-prev-month]		go back to prev month.
\\[schedule-jump-month]		jump to another month.

Map:\\{schedule-mode-map}"
  (setq schedule-mode-map (schedule-make-default-keymap))
  (setq major-mode 'schedule-mode)
  (setq mode-name "Schedule")
  
  (use-local-map schedule-mode-map)
  (and schedule-mode-hook
       (run-hooks 'schedule-mode-hook)))

(defun schedule-make-default-keymap ()
  "Make default keymap for \"schedule\"Summary mode."
  (let ((map (make-keymap)))
    (suppress-keymap map)
    (define-key map "x" 'schedule-toggle-hide-mode)
    (define-key map "c" 'schedule-copy-data)
    (define-key map "d" 'schedule-kill-data)
    (define-key map "e" 'schedule-edit-schedule)
    (define-key map "h" 'schedule-toggle-hide)
    (define-key map "j" 'schedule-jump-month)
    (define-key map "n" 'schedule-next-line)
    (define-key map "N" 'schedule-forward-page)
    (define-key map "p" 'schedule-prev-line)
    (define-key map "P" 'schedule-backward-page)
    (define-key map "v" 'schedule-toggle-summary-mode)
    (define-key map "q" 'schedule-quit)
    (define-key map "y" 'schedule-yank-data)

    (define-key map "o" 'schedule-open-diary-dir)
    (define-key map "g" 'schedule-jump-month)
    (define-key map "s" 'schedule-search-word-switch)
    (define-key map " " 'schedule-scroll-up)
    (define-key map "b" 'schedule-scroll-down)
    (define-key map "<" 'beginning-of-buffer)
    (define-key map ">" 'end-of-buffer)

    ;;    (define-key map "\^M" 'schedule-next-month)
    (define-key map "\M-n" 'schedule-next-month)
;    (define-key map "\^H" 'schedule-prev-month)
    (define-key map "\M-p" 'schedule-prev-month)
    (define-key map "\^C\^C" 'schedule-quit)
    map))

(defun schedule-edit-mode ()
  "Major mode for \"schedule\" Edit Buffer.

Commands:
\\[schedule-edit-quit]		quit
\\[schedule-edit-cancel]		cancel

Map is: \\{schedule-edit-mode-map}"
  (setq schedule-edit-mode-map (schedule-edit-make-default-keymap))
  (use-local-map schedule-edit-mode-map)
  (setq major-mode 'schedule-edit-mode)
  (setq mode-name "Schedule Edit")
  (and schedule-edit-mode-hook
       (run-hooks 'schedule-edit-mode-hook)))

(defun schedule-edit-make-default-keymap ()
  "Make default keymap for \"schedule\" Edit mode."
  (let ((map (make-keymap)))
    (define-key map "\^C\^C" 'schedule-edit-quit)
    (define-key map "\^C\^Q" 'schedule-edit-cancel)
    (define-key map "\^C\^Y" 'schedule-edit-copy-data)
    (define-key map "\C-ce" 'ndiary-encode-region)
    (define-key map "\C-cp" 'ndiary-preview)
    (define-key map "\C-m" 'ndiary-newline-and-indent)
    (define-key map "\M-\C-m" 'ndiary-newline-and-indent-dt)
    map))

(defun schedule-search-word-switch ()
  (interactive)
  (if schedule-summary-search-mode-p
      (setq schedule-summary-search-mode-p nil)
    (progn
      (setq schedule-search-word
	    (read-from-minibuffer "Input Word: " schedule-search-word))
      (setq schedule-summary-search-mode-p t)))
  (schedule-open schedule-current-time
		 schedule-prev-conf t))

(defun schedule-open-diary-dir ()
  (interactive)
  (let ((time schedule-current-time)
	(month)
	(year)
	(dir))
    (setq month (car time))
    (setq year (car (cdr time)))
    (setq dir (schedule-get-month-dir year month))
    (dired dir)))

(defun schedule-scroll-up ()
  (interactive)
  (save-excursion
    (if (pos-visible-in-window-p (point-max))
	(schedule-forward-month 1)
      (scroll-up))))

(defun schedule-scroll-down ()
  (interactive)
  (save-excursion
    (if (pos-visible-in-window-p (point-min))
	(schedule-forward-month -1)
      (scroll-down))))

(defun schedule-toggle-hide-mode ()
  (interactive)
  (setq schedule-hide-mode (not schedule-hide-mode))
    (schedule-open schedule-current-time
		 schedule-prev-conf t))

(provide 'schedule)