;; included in diary cvs since 2001 Aug 19.

;; Emacs LISP script for writing HTML diary inside EMACS.
;; Copyright 2001-2005 Junichi Uekawa <dancer@netfort.gr.jp>

(provide 'dancer-diary)

(defvar dancer-diary-diary-title-japanese
  "つれづれ日記" 
  "The title string for the diary page for Japanese dancer-diary")
(defvar dancer-diary-diary-title-english
  "Diary for "
  "The title string for the diary page for English dancer-diary,
make sure that this string ends with a space, or it will look funny")
(defvar dancer-diary-category-alist
  '(("Life" . 1))
  "Associated list storing the possible list of categories")

(defvar dancer-diary-thisurl-prefix 
  "http://unconfigured.org/"
  "The URL prefix, such as http://www.netfort.gr.jp/~dancer/diary/")

(defvar dancer-diary-thismonth-update t
  "Update current-month diary index or not.")

(defvar dancer-diary-rss-author nil
  "The name of the author for rss entry")
(defvar dancer-diary-rss-title "dancer-diary recent entries"
  "The name of the author for rss entry")

(defvar dancer-diary-punctuation-stop-marks-regexp
  "\\([^?？.．。]*.\\)" 
  "Punctuation marks for stopping the title text.")

(add-to-list 'auto-mode-alist '("diary/[^/]*\.html\.ja$" . dancer-diary-japanese-mode))
(add-to-list 'auto-mode-alist '("diary/[^/]*\.html\.en$" . dancer-diary-english-mode))

(defvar dancer-diary-google-analytics-code
  ;; start google analytics code
  (concat
"    <!-- Google tag (gtag.js) -->\n"
"    <script async src=\"https://www.googletagmanager.com/gtag/js?id=G-JF5M03V0KR\"></script>\n"
"    <script>\n"
"  window.dataLayer = window.dataLayer || [];\n"
"  function gtag(){dataLayer.push(arguments);}\n"
"  gtag('js', new Date());\n"

"  gtag('config', 'G-JF5M03V0KR');\n"
"    </script>\n"
;; end google analytics code
)
  "Google Analytics code")

(defun dancer-diary-internal-make-local-variable ()
  "An internal function to make local variables for ths major mode."
  (mapcar 'make-local-variable '(
				 dancer-diary-category-alist
				 dancer-diary-create-template-html-function
				 dancer-diary-currentmonth-string
				 dancer-diary-diary-title-english
				 dancer-diary-diary-title-japanese
				 dancer-diary-html-filename-postfix
				 dancer-diary-index-html
				 dancer-diary-insert-topindex-function
				 dancer-diary-last-update-string
				 dancer-diary-rss-author
				 dancer-diary-rss-title
				 dancer-diary-string-thismonth-diaryindex
				 dancer-diary-string-today-function 
				 dancer-diary-thismonth-filename-string
				 dancer-diary-thismonth-update
				 dancer-diary-thisurl-prefix
				 dancer-diary-update-date-function
				 )))

(define-derived-mode dancer-diary-english-mode html-mode "DDiaryE"
  "Major mode for editing diary in english html file
Commands:
  \\[dancer-diary-insert-new-entry] New diary entry
  \\[dancer-diary-insert-local-img] Insert img tag for local file
  \\[dancer-diary-insert-local-link] Insert link with local file.
  \\[dancer-diary-insert-local-url] Insert URL
  \\[dancer-diary-insert-local-url-with-trackback] Insert URL with trackback

\\{dancer-diary-english-mode-map}
"
  (dancer-diary-internal-make-local-variable)

  (setq dancer-diary-insert-topindex-function
	'(dancer-diary-english-insert-topindex))
  (setq dancer-diary-create-template-html-function
	'(dancer-diary-create-template-html-english))
  
  (setq dancer-diary-html-filename-postfix ".html.en")
  (setq dancer-diary-index-html "index.html.en")
  (setq dancer-diary-currentmonth-string "This month's diary")
  (setq dancer-diary-last-update-string "Last update: ")
  (setq dancer-diary-string-today-function '(dancer-diary-string-today-english))
  (setq dancer-diary-todo-section-english
	(concat "    <div class=\"todo\">\n"
	"      <h2>Plans</h2>\n"
	"      <ul>\n"
	"      </ul>\n"
	"    </div>\n"))

  ;; load the config before action
  (load (concat default-directory "dancer-diary-config.el") t)

  ;; variables that need to be updated
  (setq dancer-diary-update-date-function 
	'(lambda () ""
	   (progn
	     (setq dancer-diary-thismonth-filename-string (concat (dancer-diary-indexdatelocal-now) dancer-diary-html-filename-postfix))
	     (setq dancer-diary-string-thismonth-diaryindex 
		   (concat 
		    "Diary in " (dancer-diary-string-thismonth-english)
		    ))
	     )))
  (funcall dancer-diary-update-date-function)
  ;;(dancer-diary-expand-images)
  )

(define-derived-mode dancer-diary-japanese-mode html-mode "DDiaryJ" 
  "Major mode for editing diary in Japanese html file
Commands:
  \\[dancer-diary-insert-new-entry] 新しい日記のエントリ
  \\[dancer-diary-insert-local-img] イメージを追加
  \\[dancer-diary-insert-local-link] ローカルファイルへのリンクを追加
  \\[dancer-diary-insert-local-url] URLを挿入
  \\[dancer-diary-insert-local-url-with-trackback] トラックバックつきでURLを挿入

\\{dancer-diary-japanese-mode-map}
編集用のモードです。
"
  (dancer-diary-internal-make-local-variable)

  (setq dancer-diary-insert-topindex-function
	'(dancer-diary-japanese-insert-topindex))
  (setq dancer-diary-create-template-html-function
	'(dancer-diary-create-template-html-japanese))

  (setq dancer-diary-html-filename-postfix ".html.ja")
  (setq dancer-diary-index-html "index.html.ja")
  (setq dancer-diary-currentmonth-string "今月の日記")
  (setq dancer-diary-last-update-string "最終更新時間：")
  (setq dancer-diary-string-today-function '(dancer-diary-string-today-japanese))
  (setq dancer-diary-todo-section-japanese
	(concat "    <div class=\"todo\">\n"
	"      <h2>予定</h2>\n"
	"      <ul>\n"
	"      </ul>\n"
	"    </div>\n"))

  ;; load the config before action
  (load (concat default-directory "dancer-diary-config.el") t)

  ;; variables that need to be updated
  (setq dancer-diary-update-date-function 
	'(lambda () "" 
	   (progn
	     (setq dancer-diary-thismonth-filename-string (concat (dancer-diary-indexdatelocal-now) dancer-diary-html-filename-postfix))
	     (setq dancer-diary-string-thismonth-diaryindex 
		   (concat 
		    (dancer-diary-string-thismonth-japanese) "の日記"
		    ))
	     )))
  (funcall dancer-diary-update-date-function)
  ;;(dancer-diary-expand-images)
)

(define-key dancer-diary-english-mode-map
  "\C-c\C-j" 'dancer-diary-conditional-insert-entry)
(define-key dancer-diary-english-mode-map
  "\C-c\C-m" 'dancer-diary-insert-url)
(define-key dancer-diary-english-mode-map
  "\C-cil" 'dancer-diary-insert-local-link)
(define-key dancer-diary-english-mode-map
  "\C-cii" 'dancer-diary-insert-local-img)
(define-key dancer-diary-english-mode-map
  "\C-ciu" 'dancer-diary-insert-local-url)
(define-key dancer-diary-english-mode-map
  "\C-ciU" 'dancer-diary-insert-local-url-with-trackback)
(define-key dancer-diary-english-mode-map
  "\C-cir" 'dancer-diary-generate-rdf)

(define-key dancer-diary-japanese-mode-map
  "\C-c\C-j" 'dancer-diary-conditional-insert-entry)
(define-key dancer-diary-japanese-mode-map
  "\C-c\C-m" 'dancer-diary-insert-url)
(define-key dancer-diary-japanese-mode-map
  "\C-cil" 'dancer-diary-insert-local-link)
(define-key dancer-diary-japanese-mode-map
  "\C-cii" 'dancer-diary-insert-local-img)
(define-key dancer-diary-japanese-mode-map
  "\C-ciu" 'dancer-diary-insert-local-url)
(define-key dancer-diary-japanese-mode-map
  "\C-ciU" 'dancer-diary-insert-local-url-with-trackback)
(define-key dancer-diary-japanese-mode-map
  "\C-cir" 'dancer-diary-generate-rdf)



					;common routines

(defun dancer-diary-internal-update-index ()
  "update index.html"
  (let ((current-dancer-diary-string-thismonth-diaryindex dancer-diary-string-thismonth-diaryindex))
    (save-current-buffer
      (set-buffer (find-file-noselect dancer-diary-index-html t nil))
      (goto-line 1)
      (if (and dancer-diary-thismonth-update (search-forward "<p class=\"currentdiary\">"))
	  (progn
	    ;;update the last-updated
	    (delete-region (progn (beginning-of-line) (point)) (progn (end-of-line) (point)))
					;remove the original line.
	    (insert (concat		;insert new information
		     "    <p class=\"currentdiary\">"
		     "<a href=\""
		     dancer-diary-thismonth-filename-string
		     "\">"
		     dancer-diary-currentmonth-string
		     "</a> "
		     "</p>"
		     ))))
	
      ;; update the month-listing, if things do not exist.
      (if (not (search-forward
		(concat "<li><a href=\"" dancer-diary-thismonth-filename-string "\">") nil t nil)
	       )
	  ;;the link was not found, add it.
	  (if (search-forward "<!-- past diary links -->" nil t nil)
	      (progn
		(beginning-of-line)
		(insert (concat
			 "      <li>"
			 "<a href=\""
			 dancer-diary-thismonth-filename-string
			 "\">"
			 current-dancer-diary-string-thismonth-diaryindex
			 "</a>"
			 "</li>\n"
			       )))
	    )
	)
      (save-buffer))))


(defun dancer-diary-conditional-insert-entry (category-string)
  "Insert some entry, conditionally creating a new entry, if the right file is being opened.

  Returns the buffer of the new blog entry, with the current point before </p>"
  (interactive (list (completing-read "Category: " dancer-diary-category-alist nil t)))
  (funcall dancer-diary-update-date-function) ;update current date
  (if (not (equal (file-name-nondirectory (buffer-file-name)) dancer-diary-thismonth-filename-string))
      (progn				; The curret month's diary is not the current buffer.
	(if (file-exists-p dancer-diary-thismonth-filename-string)
	    (find-file dancer-diary-thismonth-filename-string) ;find this month's diary!
	  ;; Otherwise, create the file from a template, and then find-file later ?
	  (find-file dancer-diary-thismonth-filename-string) ;create the file
	  (eval dancer-diary-create-template-html-function) ;edit it.
	  )
	)
    )
	
  ;; Enter an entry, This may have switched to a new buffer.
  (save-excursion
    (goto-line 1)
    (if (not (search-forward (concat "<h3>" (eval dancer-diary-string-today-function) "</h3>") nil t nil ) )
					;if this string does not already exist.
	(dancer-insert-date)		; insert the date
      ))
  (dancer-diary-insert-new-entry category-string)
  (current-buffer))

(defun dancer-skip-to-first-diary-entry ()
  (goto-line 1)
  (if (search-forward "<div class=\"today\">" nil t)	
      (beginning-of-line)		; this is all..
    (progn  			;otherwise look for <hr>
     (search-forward "<hr>")
     (end-of-line)
     (insert "\n")
     )
    )
  )

(defun dancer-diary-insert-new-entry (category-string)
  "New entry for today's diary. Called every time an entry is made"

  (let* ((anchor-string (concat (dancer-diary-string-today-cryptic) "-" (substring (current-time-string) 11 19))))
    (goto-line 1)
    (search-forward "<div class=\"today\">")
    (search-forward "</div>")
    (previous-line 1)
    (end-of-line)
    (insert (concat 
	     "\n        <p><tt class=\"timestring\">" 
	     (substring (current-time-string) 11 19)
	     "</tt>\n"
	     "          <a href=\""
	     dancer-diary-thisurl-prefix
	     "daily/"
	     (dancer-diary-string-today-cryptic)
	     dancer-diary-html-filename-postfix
	     "#" anchor-string "\" name=\""
	     anchor-string
	     "\" >#</a>\n"
	     "          <tt class=\"category\">" 
	     category-string
	     "</tt>\n\n        </p>"))
    (previous-line 1)
    (dancer-diary-internal-update-index)	;update the index.html file.
    ))

(defun dancer-insert-date-body ()
  (insert
  (concat "      <div class=\"today\">\n"
	  "        <a name=\"" (dancer-diary-string-today-cryptic)
	  "\"></a><h3>"
	  (eval dancer-diary-string-today-function ) "</h3>\n" ;
	  "      </div>\n")
   )
  (previous-line 1)
)

(defun dancer-insert-date ()
  "insert date"
  (interactive)
  (dancer-skip-to-first-diary-entry)
  (dancer-insert-date-body )
  )

					;english files

(defun dancer-diary-string-thismonth-english ()
  "Return string for this year/month in English"
  (let* ((time (current-time-string))
	 (monthname (substring time 4 7))
	 (year (substring time 20 24))
	 )
    (concat monthname ". " year)
    )
  )

(defun dancer-diary-string-today-english ()
  (let* ((time (current-time-string))
	 (monthname (substring time 4 7))
	 (day (string-to-number (substring time 8 10)))
	 (year (substring time 20 24))
	 (dayofweek (substring time 0 3))
	 )
    (concat (number-to-string day) " " monthname " " year " (" dayofweek ")" )
    )
  )

					;japanese commands


(defun dancer-diary-string-thismonth-japanese ()
  "return this year/month name in Japanese"
  (let* ((time (current-time-string))
	 (month (dancer-diary-getmonthnumstr (substring time 4 7)))
	 (year (substring time 20 24))
	 )
    (concat year "年" month "月" )
    )  
)

(defun dancer-diary-string-today-japanese ()
  "Return today's date string in Japanese"
  (let* ((time (current-time-string))
	 (month (dancer-diary-getmonthnumstr (substring time 4 7)))
	 (day (string-to-number (substring time 8 10)))
	 (year (substring time 20 24))
	 (dayofweek (substring time 0 3))
	 )
    (concat year "年" month "月" (number-to-string day) "日 ("
	    (dancer-diary-getweekjap dayofweek) "曜日)")))

(defun dancer-diary-getmonthnumstr (monthname)
  "Returns a string representation of the numerical representation of month."
  (let* (
	 (index (string-match
		 monthname "JanFebMarAprMayJunJulAugSepOctNovDec"))
	 (month (+ 1 (/ index 3)))
	 )
    (number-to-string month)
    )
  )

(defun dancer-diary-getweekjap (weekname)
  "Returns a Japanese representation of week from English representation."
  (let* (
	 (index (string-match
		 weekname "MonTueWedThuFriSatSun"))
	 (week (/ index 3))
	 )
    (substring "月火水木金土日" week (+ 1 week))))
				       
(defun dancer-diary-string-today-cryptic ()
  "Get a cryptic diary string, in the form of YYYY-MMM-DD"
  (let* ((time (current-time-string))
	 (monthname (substring time 4 7))
	 (day (string-to-number (substring time 8 10)))
	 (year (substring time 20 24)))
    (concat year "-" monthname "-" (number-to-string day))
  ))

(defun dancer-diary-indexdatelocal-next ()
  "Create a next-month monthname."
  (let* ((time (file-name-sans-extension (file-name-nondirectory (buffer-file-name))))
	  (monthname (substring time 4 6))
	  (year (substring time 0 4))
	  )
       (concat 
	(if (eq (string-to-number monthname) 12)
	    (number-to-string (+ (string-to-number year) 1))
	  year)
	(if (eq (string-to-number monthname) 12)
	    "01"
					; for months 1-11 -> 2-12
	  (concat 
	   (if (<= (string-to-number monthname) 8) ;add a 0
	       "0")
	   (number-to-string (+ (string-to-number monthname) 1))
	   )))))

(defun dancer-diary-indexdatelocal-now () ;this month.
  "Create a this-month monthname string in the format YYYYMM"
  (let* ((time (current-time-string))
	 (month (dancer-diary-getmonthnumstr (substring time 4 7)))
	 (year (substring time 20 24))
	 )
    (concat
     year
     (concat 
      (if (<= (string-to-number month) 9) ;add a 0
	  "0")
      month
      ))))


(defun dancer-diary-indexdatelocal-prev ()
  "Create a prev-month monthname."
  (let* ((time (file-name-sans-extension (file-name-nondirectory (buffer-file-name))))
	  (monthname (substring time 4 6))
	  (year (substring time 0 4))
	  )
       (concat 
	(if (eq (string-to-number monthname) 1)
	    (number-to-string (- (string-to-number year) 1))
	  year)
	(if (eq (string-to-number monthname) 1)
	    "12"
					; for months 2-12 -> 1-11
	  (concat
	   (if (<= (string-to-number monthname) 10) ;add a 0
	       "0")
	   (number-to-string (- (string-to-number monthname) 1))
	   )))))



;; Inserting topindex parts.
;; 

(defun dancer-diary-japanese-insert-topindex ()
  "Insert the top indexing entry created from the filename, for next, prev, and other-language
This function is for Japanese"  
  (insert (concat "    <div class=\"toplinks\">\n"
		  "      <a class=\"toplinks\" href=\"index.html.ja\">目次</a>\n"
		  "      <a class=\"toplinks\" href=\""
		  (dancer-diary-indexdatelocal-prev)
		  ".html.ja\">先月</a>\n"
		  "      <a class=\"toplinks\" href=\""
		  (dancer-diary-indexdatelocal-next)
		  ".html.ja\">来月</a>\n"
		  "      <a class=\"toplinks\" href=\""
		  (file-name-sans-extension (file-name-nondirectory (buffer-file-name)))
		  ".en\">English</a>\n"
		  "    </div>\n"
)))

(defun dancer-diary-english-insert-topindex ()
  "Insert the top indexing entry created from the filename, for next, prev, and other-language
This function is for English"
  (insert (concat "    <div class=\"toplinks\">\n"
		  "      <a class=\"toplinks\" href=\"index.html.en\">Home</a>\n"
		  "      <a class=\"toplinks\" href=\""
		  (dancer-diary-indexdatelocal-prev)
		  ".html.en\">Prev</a>\n"
		  "      <a class=\"toplinks\" href=\""
		  (dancer-diary-indexdatelocal-next)
		  ".html.en\">Next</a>\n"
		  "      <a class=\"toplinks\" href=\""
		  (file-name-sans-extension (file-name-nondirectory (buffer-file-name)))
		  ".ja\">Japanese</a>\n"
		  "    </div>\n"
)))

(defun dancer-diary-insert-topindex ()
  "Inserts topindex, this function requries 
  dancer-diary-insert-topindex-function to be set to 
dancer-diary-english-insert-topindex or dancer-diary-japanese-insert-topindex" 
  (interactive)
  (if (boundp 'dancer-diary-insert-topindex-function) 
      (eval dancer-diary-insert-topindex-function)
    "Error: please enter dancer-diary mode"
    )
  )


(defun dancer-diary-create-template-html-japanese ()
  "Create a template html content for dancer diary."
  (kill-region (point-min) (point-max))
  (insert (concat 			;Insert the template string.
"<!DOCTYPE html>\n"
"<html>\n"
"  <head>\n"
"    <link rel=\"stylesheet\" type=\"text/css\" href=\"diary.css\">\n"
"    <meta HTTP-EQUIV=\"content-type\" CONTENT=\"text/html; charset=utf-8\">\n"
"    <title>" dancer-diary-diary-title-japanese "</title>\n"
dancer-diary-google-analytics-code
"  </head>\n"
"\n"
"  <body>\n"
"    <h1>" dancer-diary-diary-title-japanese " " (dancer-diary-string-thismonth-japanese) "</h1>\n"
))
  (dancer-diary-japanese-insert-topindex)
  (insert (concat 
	   dancer-diary-todo-section-japanese
"    \n"
"    <div class=\"daily\">\n"
"      <h2>毎日</h2>\n"
"      <hr></hr>\n"
"      <hr></hr>\n"
"      <address><a href=\"mailto:dancer@netfort.gr.jp\">Junichi Uekawa</a></address>\n"
"      <!-- Created: " (current-time-string) " -->\n"
"    </div>\n"
"  </body>\n"
"</html>\n"
))
  (setq buffer-file-coding-system 'utf-8)
)

(defun dancer-diary-create-template-html-english ()
  "Create a template html content for dancer diary."
  (kill-region (point-min) (point-max))
  (insert (concat 			;Insert the template string.
"<!DOCTYPE html>\n"
"<html>\n"
"  <head>\n"
"    <link rel=\"stylesheet\" type=\"text/css\" href=\"diary.css\">\n"
"    <meta HTTP-EQUIV=\"content-type\" CONTENT=\"text/html; charset=utf-8\">\n"
"    <title>" dancer-diary-diary-title-english (dancer-diary-string-thismonth-english)  "</title>\n"
dancer-diary-google-analytics-code
"  </head>\n"
"\n"
"  <body>\n"
"    <h1>" dancer-diary-diary-title-english " " (dancer-diary-string-thismonth-english) "</h1>\n"
))
  (dancer-diary-english-insert-topindex)
  (insert (concat 
	   dancer-diary-todo-section-english
"    <div class=\"daily\">\n"
"      <h2>daily blurbs</h2>\n"
"      <hr></hr>\n"
"      <hr></hr>\n"
"      <address><a href=\"mailto:dancer@netfort.gr.jp\">Junichi Uekawa</a></address>\n"
"      <!-- Created: " (current-time-string) " -->\n"
"    </div>\n"
"  </body>\n"
"</html>\n"
))
)


;; input helper routine.

(defun dancer-diary-insert-url (urladdress)
  "insert a URL with the A tag, and insert the URL itself into the diary,
interactively."
  (interactive "MURL: ")
  (insert 
   (concat "<a href=\"" urladdress "\">"
	   urladdress "</a>")))

;; image expansion. Display the graphics when they are found
(defun dancer-diary-expand-images ()
  "Expand images from diary IMG tag inside the buffer."
  (interactive)
  (let* ((pos (point))
         (regexp (format "src=\"\\(.*\\.\\(jpg\\|png\\|gif\\)\\)\"")))
    (while (re-search-forward regexp nil t)
      (let* ((start (match-beginning 0))
             (end (match-end 0))
             (filename (match-string 1))
             (image (cons 'image (cdr (create-image (expand-file-name filename))))))
        (add-text-properties start end
                             (list 'display image
                                   'intangible image
                                   'rear-nonsticky (list 'display)))))
    (goto-char pos)))

(defun dancer-diary-insert-local-link (file-path)
  "Insert a link to local file."
  (interactive (list (let* ((insert-default-directory nil))
		       (read-file-name "html filename: "))))
  (insert (concat 
	   "<a href=\"" file-path "\">")))

(defun dancer-diary-insert-local-img (file-path)
  "Insert a link to local image file."
  (interactive (list (let* ((insert-default-directory nil))
		       (read-file-name "image filename: "))))
  (insert (concat 
	   "<img src=\"" file-path "\" width=\"40%\">")))

(defun dancer-diary-insert-local-url (file-path)
  "Insert a URL as <a href>."
  (interactive "MURL: ")
  (insert (concat 
	   "<a href=\"" file-path "\">")))

(defun dancer-diary-insert-local-url-with-trackback (urladdress &optional username password)
  "Trackback to URLADDRESS and add a URL link with A tag."
  (interactive "MURL (with trackback): \nMUsername: \nMPassword: \n")
  (save-excursion
    (if (re-search-backward "<a href=\"\\([^\"]*\\)\" name=[^>]*>#</a>" nil t)
	(dancer-diary-send-trackbackping urladdress (match-string 1) username password)
      (error "Cannot find current entry's URL")))
  (dancer-diary-insert-local-url urladdress))


;;; START  experimental category support
(defun dancer-diary-internal-get-used-categories (my-data-string-alist my-available-categories-alist)
  "Get the list of categories that are used"
  (if my-data-string-alist 
      (progn 
	(add-to-list 'my-available-categories-alist (caar my-data-string-alist))
	(dancer-diary-internal-get-used-categories (cdr my-data-string-alist) my-available-categories-alist))
    my-available-categories-alist))

;; the data is of the form: 
;; (topic-index name-directive(a-name=) filename)
(defun dancer-diary-internal-list-categories-start-dump-category (search-string my-data-string-alist)
  "Insert a category-link"
  (if my-data-string-alist
      (progn 
	(if (string= search-string (caar my-data-string-alist))
	    (progn
	      (insert "  <div class=\"categoryitem\"><a href=\"" (caddar my-data-string-alist) "#" (cadar my-data-string-alist) "\">" 
		      (cadar my-data-string-alist)
		      "</a></div>\n")))
	(dancer-diary-internal-list-categories-start-dump-category search-string (cdr my-data-string-alist)))))

(defun dancer-diary-internal-list-categories-start-dump (my-available-categories-alist my-data-string-alist)
  "Dump the list of categories to the output"
  (if my-available-categories-alist
      (progn
	(insert (concat 
		 "<div class=\"categorytopic\">"
		 "<div class=\"categorytitle\">"
		 (car my-available-categories-alist)
		 "</div>\n"))
	(dancer-diary-internal-list-categories-start-dump-category (car my-available-categories-alist) my-data-string-alist)
	(insert "</div>\n")
	(dancer-diary-internal-list-categories-start-dump (cdr my-available-categories-alist) my-data-string-alist))))
      
(defun dancer-diary-internal-list-categories (current-file-name data-string-alist)
  "Find the list of categories inside a file, and return the contents of the file. 
 in the form: (topic-index name-directive(a-name=) filename)
"
  (set-buffer (find-file-noselect current-file-name))
  (save-excursion 
    (goto-line 1) 
    (while (re-search-forward "<tt class=\"category\">\\([^<]+\\)" nil t)
      (let* ((category-str (match-string 1)))
	(save-excursion
	  (re-search-backward "<a name=\"\\([^\"]+\\)\">")
	  (let* ((date-link (match-string 1)))
	    (add-to-list 'data-string-alist
			 (list category-str date-link current-file-name)))))))
  data-string-alist)

(defun dancer-diary-internal-categories-wildcard (wildcard)
  "Browse through all files specified with the wildcard and list the available categories in HTML"
  (save-current-buffer
    (let* ((dirlist (directory-files default-directory nil wildcard))
	   (data-string-alist nil))
      (dolist (nowfile dirlist)
	(setq data-string-alist (dancer-diary-internal-list-categories nowfile data-string-alist)))
      (pop-to-buffer "*category-list-select*")
      (kill-region (point-min) (point-max))
      (dancer-diary-internal-list-categories-start-dump
       (dancer-diary-internal-get-used-categories data-string-alist nil) 
       data-string-alist))))
  
(defun dancer-diary-internal-categories-japanese ()
  "Browse through all html.ja files and list the available categories in HTML"
  (interactive)
  (dancer-diary-internal-categories-wildcard "[0-9]*\\.html\\.ja$"))

(defun dancer-diary-internal-categories-english ()
  "Browse through all html.en files and list the available categories in HTML"
  (interactive)
  (dancer-diary-internal-categories-wildcard "[0-9]+\\.html\\.en$"))

;;; END  experimental category support


(defun dancer-diary-get-trackbackurl (targeturl username password)
  "Obtain trackback URL for TARGETURL."
  (let* (trackback-cgi)
    (with-temp-buffer
      (if username
	  (call-process "wget" nil 
			(current-buffer) nil 
			"-o" "/dev/null"
			"-O" "-"
			(concat "--http-user=" username)
			(concat "--http-passwd=" password)
			targeturl)
	(call-process "wget" nil 
		      (current-buffer) nil 
		      "-o" "/dev/null"
		      "-O" "-"
		      targeturl))
      (beginning-of-buffer)
      (if (re-search-forward "<[rR][dD][fF]:[rR][dD][fF]" nil t)
	  (if (re-search-forward "trackback:ping=\"\\([^\"]+\\)\"" nil t)
	      (setq trackback-cgi (match-string 1))
	    (error "Could not find trackback:ping entry"))
	(error "Could not find RDF entry"))
      trackback-cgi)))

(defun dancer-diary-httpauth-getdigest (username password)
  "Get USERNAME and PASSWORD and return base64-encoded string"
  (with-temp-buffer
    (insert (concat username ":" password))
    (base64-encode-region (point-min) (point-max))
    (buffer-string)))

(defun dancer-diary-send-trackbackping (target-url origin-url username password)
  "Send trackback ping to TARGET-URL from ORIGIN-URL.
"
  (interactive 
   "MTarget URL: \nMOrigin URL: \nMUsername (blank if none): \nMPassword (blank if none): \n")
  (if (eq 0 (length username)) 
      (setq username nil))
  (let* (networkprocess target-cgi remoteaddress remotedir encoded-string)
    (setq target-cgi (dancer-diary-get-trackbackurl target-url username password))
    (with-temp-buffer 			;obtain the HTTP server and dir
      (insert target-cgi)
      (beginning-of-buffer)
      (re-search-forward "http://\\([^/]+\\)\\(/.*\\)")
      (setq remoteaddress (match-string 1))
      (setq remotedir (match-string 2)))
    (with-temp-buffer
      (setq process-name (open-network-stream "dancer-diary-http-put-process" (current-buffer) remoteaddress "http"))
      (setq encoded-string (concat "url=" origin-url))
      (process-send-string 
       process-name 
       (concat
	"POST " target-cgi " HTTP/1.1\n" 
	"Host: " remoteaddress "\n"
	(if username
	    (concat "Authorization: Basic " (dancer-diary-httpauth-getdigest username password) "\n"))
	"Content-Type: application/x-www-form-urlencoded\n"
	"Content-Length: " (number-to-string (length encoded-string)) "\n\n"
	encoded-string)))))

;;; BEGIN RDF generator
(defun dancer-diary-generate-rdf ()
  "Generate RDF text for current buffer. 
The created file will be called recententry.rdf"
  (dancer-diary-generate-rdf-internal "recententry.rdf" "UTF-8"))

(defun dancer-diary-generate-rdf-internal (recententryrdf myrssencoding)
  "Generate RDF text for current buffer. 
The created file will be called RECENTENTRYRDF"
  (interactive)
  (save-excursion 
    (let* (bstring 
	   start-of-main-text (counter 10) list-of-rdf-items full-url date-string month-string 
	   (rss-creator (or dancer-diary-rss-author "unknown"))
	   currentdiaryurl day-string category)
      ;; obtain the list of data.
      (beginning-of-buffer)
      (while (and
	      (> counter 0) 
	      (re-search-forward "<p><tt class=\"timestring\">[^<]*</tt>[^<]*<a href=\"\\([^\"]*\\)\" name=\"\\([^\"]*\\)\"[^>]*>[^<]*</a>[^<]*<tt class=\"category\">\\([^<]*\\)</tt>" nil t))
	(setq counter (- counter 1))
	(setq start-of-main-text (match-end 0))
	(setq date-string (match-string 2))
	(setq full-url (match-string 1))
	(setq category (match-string 3))

	(setq bstring (buffer-substring start-of-main-text (re-search-forward "</p>" nil t)))

	;; 0: full URL
	;; 1: full text
	;; 2: headline
	;; 3: time 
	;; 4: category
	;; 5: full-encoded text (to be in CDATA)
	(push 
	 (append 
	  (list full-url)	;URL
	  (progn 				;full text
	    (with-temp-buffer			;create tagless text
	      (insert bstring)
	      (beginning-of-buffer)
	      (while (re-search-forward "<[^>]*>" nil t)
		(replace-match ""))
	      (beginning-of-buffer)
	      (while (re-search-forward "\\([\t\r\n]\\|  \\)" nil t)
		(replace-match ""))
	      (beginning-of-buffer)
	      (if (re-search-forward (concat dancer-diary-punctuation-stop-marks-regexp "\\(.*\\)") nil t)
		  `(,(match-string 2) ,(match-string 1))
		`(,(buffer-string) ,(buffer-string)))))
	  (list 
	   (with-temp-buffer
	     (insert date-string)
	     ;; replace - with T
	     (beginning-of-buffer)
	     (re-search-forward "\\([^-]+-[^-]+-[^-]+\\)\\(-\\)")
	     (replace-match "\\1T")
	     ;; month-name replace
	     (beginning-of-buffer)
	     (re-search-forward "\\([A-Z][a-z][a-z]\\)")
	     (setq month-string (match-string 1))
	     (replace-match "")
	     (let* ((numeric-month (dancer-diary-getmonthnumstr month-string)))
	       (if (= 1 (length numeric-month))
		   (insert "0"))	;month names are 07 08 .. etc.
	       (insert numeric-month))
	     ;; try to append "0" before day string if it's 1-digit.
	     (re-search-forward "-\\([0-9]+\\)")
	     (setq day-string (match-string 1))
	     (replace-match "-")
	     (if (= 1 (length day-string))
		 (insert "0"))
	     (insert day-string)
	   
	     (end-of-buffer)
	     (insert "+09:00")
	     (buffer-string)))
	  (list category) ;; add category here.
	  (list bstring) ;; add the plain content here.
	  )
	 
	 list-of-rdf-items))

      ;; get the URL before switching to the new buffer.
      (setq currentdiaryurl
	    (concat dancer-diary-thisurl-prefix 
		    (file-name-nondirectory buffer-file-name)))
	    
      ;; start writing to new file.
      (set-buffer (find-file-noselect recententryrdf))
      (delete-region (point-min) (point-max))
      (insert (concat "<?xml version=\"1.0\" encoding=\"" myrssencoding "\"?>\n"
		      "<rdf:RDF "
		      " xmlns=\"http://purl.org/rss/1.0/\""
		      " xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\""
		      " xmlns:content=\"http://purl.org/rss/1.0/modules/content/\""
		      " xmlns:dc=\"http://purl.org/dc/elements/1.1/\" >\n"
		      "  <channel rdf:about=\"" 	     
		      currentdiaryurl
		      "\">\n"
		      "    <title>" 
		      dancer-diary-rss-title
		      "</title>\n"
		      "    <link>" 
		      currentdiaryurl
		      "</link>\n"
		      "    <description>showing latest 10 </description>\n"
		      "    <items>\n"
		      "      <rdf:Seq>\n"
		      ))
      (dolist (current-rdf-item (reverse list-of-rdf-items))
	(insert
	 (concat 
	  "        <rdf:li rdf:resource=\"" (nth 0 current-rdf-item) "\" />\n")))
      (insert "      </rdf:Seq>\n    </items>\n  </channel>\n")
      (dolist (current-rdf-item (reverse list-of-rdf-items))
	(insert
	 (concat 
	  "  <item rdf:about=\"" (nth 0 current-rdf-item) "\">\n"
	  "    <title>" (nth 2 current-rdf-item) "</title>\n"
	  "    <link>" (nth 0 current-rdf-item) "</link>\n"
	  "    <description>" (nth 1 current-rdf-item) "</description>\n"
	  "    <content:encoded><![CDATA[" (nth 5 current-rdf-item) "]]></content:encoded>\n"
	  "    <dc:subject>" (nth 4 current-rdf-item) "</dc:subject>\n"
	  "    <dc:creator>" rss-creator "</dc:creator>\n"
	  "    <dc:date>" (nth 3 current-rdf-item) "</dc:date>\n"
	  "  </item>\n")))
      (insert "</rdf:RDF>\n"))
    (let* ((coding-system-for-write 'utf-8))
      (save-buffer))))
;;; END RDF generator

;;; BEGIN daily generator
(defun dancer-diary-daily-generate ()
  "Generate daily diary info, under directory ./daily/"
  (save-excursion 
    (beginning-of-buffer)
    (let ((first-file-p t)
	  (parent-buffer-file-name buffer-file-name)
	  (my-dancer-diary-html-filename-postfix dancer-diary-html-filename-postfix) 
	  start-of-today end-of-today output-file-buffer bufstring subject-string
	  next-buffer-filename current-buffer-filename first-buffer-filename)
      (while (search-forward "<div class=\"today\">" nil t)
	(setq start-of-today (point))
	(re-search-forward "<a name=\"\\([^\"]*\\)\"></a>")
	(setq output-file-buffer
	      (find-file-noselect
	       (concat 
		default-directory "daily/"
		(setq current-buffer-filename 
		      (concat (match-string 1) dancer-diary-html-filename-postfix)))))
	(re-search-forward "</div>")
	(setq end-of-today (- (point) 7))	;remove </div>
	(setq bufstring (buffer-substring start-of-today end-of-today))

	;; try to replace a href, img src links.
	(with-temp-buffer
	  (insert bufstring)
	  (beginning-of-buffer)
	  (while (re-search-forward "a [^>]*href=\"\\([^\"]*\\)\"" nil t)
	    (if (save-match-data
		  (if (string-match "^https?:" (match-string 1))
		      nil ;; do not need this.
		    t))
		(progn
		  ;; this is not http:// string.
		  (goto-char (match-beginning 1))
		  (insert "../"))))
	  (beginning-of-buffer)
	  (while (re-search-forward "img [^>]*src=\"\\([^\"]*\\)\"" nil t)
	    (if (save-match-data
		  (if (string-match "^https?:" (match-string 1))
		      nil ;; do not need this.
		    t))
		(progn
		  ;; this is not http:// string.
		  (goto-char (match-beginning 1))
		  (insert "../"))))

	  ;; get the subject string for this
	  (beginning-of-buffer)
	  ;; this will not correctly get subject line that contains <a href> etc. 
	  (re-search-forward
	   (concat "<tt class=\"category\">[^<]*</tt>" dancer-diary-punctuation-stop-marks-regexp))
	  (setq subject-string (match-string 1))
	  (setq bufstring (buffer-string)))

	(save-current-buffer
	  (set-buffer output-file-buffer)
	  (delete-region (point-min) (point-max))
	  (insert 
	   "<!DOCTYPE html>\n"
	   "<html>\n"
	   "  <head>\n"
	   "    <link rel=\"stylesheet\" type=\"text/css\" href=\"../diary.css\">\n"
	   "    <meta HTTP-EQUIV=\"content-type\" CONTENT=\"text/html; charset=utf-8\">\n"
	   "    <title>" subject-string "</title>\n"
	   dancer-diary-google-analytics-code
	   "  </head>\n"
	   "  <body>\n"
	   "    <div class=\"toplinks\">\n"
	   "      <a class=\"toplinks\" href=\"" (file-relative-name parent-buffer-file-name) "\">back</a>\n"
	   "    <!-- dancer_diary_prev_link -->"
	   (if next-buffer-filename
	       (concat "      <a class=\"toplinks\" href=\"" next-buffer-filename "\">next</a>\n")
	     "")
	   "    </div>\n"
	   "    <div class=\"daily\">\n"
	   "      <div class=\"today\">\n"
	   )
	  (insert bufstring)
	  (insert 
	   "        </div>\n"
	   "      <address><a href=\"mailto:dancer@netfort.gr.jp\">Junichi Uekawa</a></address>\n"
	   "<!-- Created: " (current-time-string) " -->\n"
	   "    </div>\n"
	   "  </body>\n"
	   "</html>\n"
	   )
	  (save-buffer)
	  (if first-file-p
	      (progn 
		(setq first-file-p nil)
		(setq first-buffer-filename current-buffer-filename)
		)

	    ;; insert this page link to other page
	    (find-file next-buffer-filename)
	    (beginning-of-buffer)
	    (search-forward "<!-- dancer_diary_prev_link -->")
	    (insert 
	     (concat "      <a class=\"toplinks\" href=\"" current-buffer-filename "\">prev</a>\n"))
	    (save-buffer))
	  (setq next-buffer-filename current-buffer-filename)))
      
      ;; copy index.html
      (find-file (concat  default-directory "daily/" first-buffer-filename))
      (write-file (concat default-directory "index" my-dancer-diary-html-filename-postfix)))))
;;; END daily generator