;;; yoshirin.el
(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.
Note that you have to cache in advance the cookie for the site so as
to make this command do the login authentication automatically.
To do that:
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)
(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![](\"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 "\\(?:![](\"cid:[^\"]+\"[^)
]*>\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"
(if (natnump yoshirin-font-size)
(format "\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 "\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"))
;; Remove paragraph separators around images.
(goto-char (point-min))
(while (re-search-forward "\n\\(\n![](\"cid:[^)
]+>\\)\n\n"
nil t)
(replace-match "
\\1
\n"))
(goto-char (point-max))
(insert (if (natnump yoshirin-font-size) "
\n" "")
"\n\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))))