;;; yoshirin.el
(defvar yoshirin-login-name nil
  "*Login name used to login to nicovideo.jp.")

(defvar yoshirin-login-password nil
  "*Password used to login to nicovideo.jp.")

(defvar yoshirin-login-url "https://account.nicovideo.jp/api/v1/login"
  "*Url to login to.")

(defvar yoshirin-font-size nil
  "*An integer specifying the font size, or nil.")

(defvar yoshirin-image-scale nil
  "*A number of percent that specifies the scale of images, or nil.
This specifies how images are scaled against the screen width.")

(defun my-gnus-summary-copy-article-as-html (n)
  "Copy article(s) and transform to html in the current group.
This command was designed for reading the 小林よしのりライジング mail
magazine[1] comfortably.

You have to set `yoshirin-login-name' and `yoshirin-login-password'
properly in order to make this command work.  If you don't like to set
them, do the following steps in order to cache in advance the cookie
for the site so as to make this command do the login authentication
automatically:

1. Find an image url in the body of a mail.
2. Open it by using eww.
3. Enter a user name and a password.
4. Eval: (url-cookie-write-file)

Then the cookie will be saved in the ~/.emacs.d/url/cookies file.
You may want to do it again when the cookie is expired or for some
reason.

\[1] http://ch.nicovideo.jp/blog/ch1014"
  (interactive "P")
  (require 'mailcap)
  ;; Login
  (when (and yoshirin-login-name yoshirin-login-password)
    (require 'url)
    (let* ((url-request-method "POST")
	   (url-request-extra-headers
	    '(("Content-Type" . "application/x-www-form-urlencoded")))
	   (url-request-data
	    (format "mail_tel=%s&password=%s"
		    (url-hexify-string yoshirin-login-name)
		    (url-hexify-string yoshirin-login-password)))
	   (buffer (url-retrieve-synchronously yoshirin-login-url
					       nil nil 10)))
      (when buffer
	(kill-buffer buffer)
	(url-cookie-write-file))))
  ;;
  (let ((articles (gnus-summary-work-articles n))
	(threading gnus-show-threads)
	(case-fold-search t)
	(gnus-treat-fill-long-lines nil)
	article id images last url type buffer buffers)
    (gnus-summary-toggle-threads -1)
    (while articles
      (setq article (pop articles)
	    id 0
	    images nil)
      (gnus-summary-goto-subject article)
      (gnus-summary-copy-article 1 gnus-newsgroup-name)
      (gnus-summary-reselect-current-group t)
      (goto-char (point-max))
      (forward-line -1)
      (setq last (gnus-summary-article-number))
      (gnus-summary-edit-article)
      ;; Why is this necessary?
      (when (eq major-mode 'gnus-summary-mode)
	(set-buffer gnus-article-buffer))
      (article-narrow-to-head)
      (message-remove-header "^X-Content-Length:\\|^Lines:" t)
      (goto-char (point-max))
      (widen)
      (narrow-to-region (point) (point-max))
      (skip-chars-forward "\n")
      (delete-region (point-min) (point))
      (insert "\n")
      (goto-char (point-min))
      (while (re-search-forward "^[\t 　]+\n" nil t)
	(replace-match "\n"))
      (goto-char (point-min))
      (while (re-search-forward "\n\n\\(\n+\\)" nil t)
	(delete-region (match-beginning 1) (match-end 1)))
      (goto-char (point-max))
      (skip-chars-backward "\n")
      (insert "\n")
      (delete-region (point) (point-max))
      ;; Insert images
      (goto-char (point-min))
      (while (re-search-forward
	      "[\t\n 　]*\\[画像\\][\t\n 　]*\\(https?:[^\t\n 　]+\\)[^\n]*\n*"
	      nil t)
	(setq url (match-string 1))
	(when (and (setq type (file-name-extension url))
		   (setq type (cdr (assoc (concat "." (downcase type))
					  mailcap-mime-extensions))))
	  (setq id (1+ id))
	  (push (list id type url) images)
	  (delete-region (match-beginning 0) (match-end 0))
	  (insert (format "\n\n<img src=\"cid:%d\"%s>\n\n"
			  id
			  (if (natnump yoshirin-image-scale)
			      (format " width=\"%d%%\"" yoshirin-image-scale)
			    "")))))
      (goto-char (point-min))
      (while (re-search-forward "\\(?:<img src=\"cid:[^\"]+\"[^>]*>\n+\\)+"
				nil t)
	(insert (prog1
		    (mapconcat 'identity
			       (save-match-data
				 (split-string (match-string 0) "\n+" t))
			       "<br>\n")
		  (delete-region (match-beginning 0) (match-end 0))))
	(insert "\n\n"))
      ;; Insert links
      (goto-char (point-min))
      (while (re-search-forward "https?:[^\t\n 　]+" nil t)
	(insert (prog1
		    (concat "<a href=\"" (match-string 0) "\">&lt;"
			    (match-string 0) "&gt;</a>")
		  (delete-region (match-beginning 0) (match-end 0)))))
      (goto-char (point-min))
      (forward-line 1)
      (insert "<#multipart type=related start=\"<0>\">
<#part type=text/html id=\"<0>\" nofile=yes>
<html>\n<body>\n"
	      (if (natnump yoshirin-font-size)
		  (format "<font size=\"%d\">\n" yoshirin-font-size)
		""))
      ;; Insert newlines and separate paragraphs.  In the original
      ;; article, paragraphs are separated with two or more newlines.
      (while (re-search-forward
	      "^[\t\n 　]*[^\n<][^\n]*\\(?:\n[\t 　]*[^\n<][^\n]*\\)*\n*"
	      nil t)
	(insert "<p>\n"
		(prog1
		    (mapconcat 'identity
			       (save-match-data
				 (split-string (match-string 0) "\n" t))
			       "<br>\n")
		  (delete-region (match-beginning 0) (match-end 0))))
	(insert "\n</p>\n"))
      ;; Remove paragraph separators around images.
      (goto-char (point-min))
      (while (re-search-forward "\n</p>\\(\n<img src=\"cid:[^>]+>\\)\n<p>\n"
				nil t)
	(replace-match "<br>\\1<br>\n"))
      (goto-char (point-max))
      (insert (if (natnump yoshirin-font-size) "</font>\n" "")
	      "</body>\n</html>\n<#/part>\n")
      (dolist (image (nreverse images))
	(if (setq buffer (url-retrieve-synchronously (nth 2 image)))
	    (progn
	      (with-current-buffer buffer
		(goto-char (point-min))
		(re-search-forward "\\(?:\r?\n\\)\\(?:\r?\n\\)+" nil t)
		(delete-region (point-min) (point)))
	      (insert (format "<#part type=%s id=\"<%d>\"\
 disposition=inline buffer=\"%s\">\n<#/part>\n"
			      (nth 1 image) (car image) (buffer-name buffer))))
	  (with-current-buffer (setq buffer (generate-new-buffer " *mml*"))
	    (insert (format "<%s>\n" (nth 2 image))))
	  (insert (format "<#part type=text/plain id=\"<%d>\"\
 disposition=inline buffer=\"%s\">\n<#/part>\n"
			  (car image) (buffer-name buffer))))
	(push buffer buffers))
      (insert "<#/multipart>\n")
      (widen)
      (gnus-article-edit-done)
      (while buffers
	(kill-buffer (pop buffers))))
    (when last
      (when threading
	(gnus-summary-toggle-threads 1))
      (gnus-summary-reselect-current-group t)
      (gnus-summary-goto-subject last)
      (gnus-summary-show-article))))