;;; 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\n\n"
id
(if (natnump yoshirin-image-scale)
(format " width=\"%d%%\"" yoshirin-image-scale)
"")))))
(goto-char (point-min))
(while (re-search-forward "\\(?:
]*>\n+\\)+"
nil t)
(insert (prog1
(mapconcat 'identity
(save-match-data
(split-string (match-string 0) "\n+" t))
"
\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 "<"
(match-string 0) ">")
(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>
\n
\n"
(prog1
(mapconcat 'identity
(save-match-data
(split-string (match-string 0) "\n" t))
"
\n")
(delete-region (match-beginning 0) (match-end 0))))
(insert "\n
\n"
nil t)
(replace-match "
\\1
\n"))
(goto-char (point-max))
(insert (if (natnump yoshirin-font-size) "