email-eww

email-eww.el (13139B)

---

 ;;; -*- lexical-binding: t -*-
 ;;;
 ;;; email-eww.el
 ;;;
 ;;; Emacs library to send region or eww buffer by email.
 ;;;
 ;;; Author: Tomas Hlavaty <tom at logand dot com>
 ;;;
 ;;; License: GPL v3 or later
 ;;;
 ;;; Inspired by
 ;;; http://kitchingroup.cheme.cmu.edu/blog/2014/06/08/Better-integration-of-org-mode-and-email/
 
 (defcustom email-eww-from
   ""
   "Sender email address."
   :group 'email-eww
   :type 'string)
 
 (defcustom email-eww-to
   ""
   "Recipient email address."
   :group 'email-eww
   :type 'string)
 
 (defun email-string (string &optional url title in-reply-to)
   (compose-mail email-eww-to
                 (or title
                     (with-temp-buffer
                       (insert string)
                       (goto-char (point-min))
                       (end-of-line)
                       (buffer-substring (point-min) (point))))
                 `(("From" . ,email-eww-from)
                   ("In-Reply-To" . ,in-reply-to)))
   (message-goto-body)
   (when url
     (insert url)
     (insert "\n\n"))
   (insert string)
   (message-goto-to))
 
 (defun email-region (start end)
   "Send region as the body of an email."
   (interactive "r")
   (let ((string (buffer-substring start end)))
     (email-string string
                   (or (plist-get eww-data :url)
                       (buffer-name (current-buffer)))
                   (plist-get eww-data :title))))
 
 (defun clean-up-ycombinator ()
   (forward-line)
   (kill-line 2)
   (cond
    ((search-forward "Ask HN" nil t)
     )
    ((search-forward "comment" nil t)
     (beginning-of-line))
    )
   (let ((start (point)))
     (cond
      ((search-forward "add comment" nil t)
       (beginning-of-line)
       (forward-line)
       (delete-region start (point)))
      ))
   (goto-char (point-max))
   (search-backward "reply")
   (forward-line)
   (delete-region (point) (point-max))
   (message-goto-body)
   (unless (bolp)
     (forward-line 1))
   (delete-whitespace-rectangle (point) (point-max) nil)
   (message-goto-body)
   (flush-lines "^reply$" (point) (point-max)))
 
 (defun clean-up-reddit ()
   (forward-line 2)
   (let ((start (point)))
     (cond
      ((search-forward "Posted by" nil t)
       (beginning-of-line)
       (forward-line)
       (delete-region start (point)))
      ((search-forward-regexp "^submitted" nil t)
       (beginning-of-line)
       (forward-line -1)
       (backward-paragraph)
       (delete-region start (point)))
      ))
   (goto-char (point-max))
   (or (search-backward "Community Details" nil t)
       (search-backward "* reply"))
   (beginning-of-line)
   (delete-region (point) (point-max))
   (message-goto-body)
   (flush-lines "^share$" (point) (point-max))
   (flush-lines "^save$" (point) (point-max))
   (flush-lines "^hide$" (point) (point-max))
   (flush-lines "^report$" (point) (point-max))
   (flush-lines "^search$" (point) (point-max))
   (flush-lines "^Reply$" (point) (point-max))
   (flush-lines "^reportSave$" (point) (point-max))
   (flush-lines "^Sort by$" (point) (point-max))
   (flush-lines "^best$" (point) (point-max))
   (flush-lines "^besttopnewcontroversialoldq&a$" (point) (point-max))
   (flush-lines "^* permalink$" (point) (point-max))
   (flush-lines "^* embed$" (point) (point-max))
   (flush-lines "^* save$" (point) (point-max))
   (flush-lines "^* parent$" (point) (point-max))
   (flush-lines "^* report$" (point) (point-max))
   (flush-lines "^* give gold$" (point) (point-max))
   (flush-lines "^* share$" (point) (point-max))
   (flush-lines "^Post a comment!$" (point) (point-max))
   (flush-lines "^Create an account$" (point) (point-max))
   (flush-lines "^* reply$" (point) (point-max))
   (flush-lines "^*$" (point) (point-max))
   ;;(delete-blank-lines)
   (while (search-forward-regexp "\\(^\\s-*$\\)\n" nil t)
     (replace-match "\n")
     (unless (= (point) (point-max))
       (forward-char 1))))
 
 (defun clean-up-faz () ;; TODO Artikel auf einer Seite lesen
   (forward-line 2)
   (let ((start (point)))
     (goto-char (point-max))
     (or (search-backward "Mehr zum Thema" nil t)
         (search-backward "* Submit Submit"))
     (forward-line -1)
     (delete-region (point) (point-max))
     (goto-char (point-max))
     (search-backward "Abo")
     (beginning-of-line)
     (forward-line 2)
     (delete-region start (point)))
   (message-goto-body))
 
 (defun clean-up-mmnews ()
   (forward-line 2)
   (let ((start (point)))
     (forward-line)
     (search-forward-regexp "^[*]$" nil t)
     (forward-line 4)
     (delete-region start (point))
     ;;
     (goto-char (point-max))
     (or (search-backward "Wissen macht reich:" nil t)
         (search-backward "Neue Videos:" nil t))
     (beginning-of-line)
     (forward-line -1)
     (delete-region (point) (point-max)))
   (message-goto-body))
 
 (defun clean-up-voanews ()
   (forward-line 2)
   (let ((start (point)))
     (search-forward "Print this page")
     (beginning-of-line)
     (forward-line 3)
     (delete-region start (point))
     (search-forward "Related Stories")
     (forward-line -3)
     (delete-region (point) (point-max)))
   (message-goto-body))
 
 (defun clean-up-guardian ()
   (forward-line 2)
   (let ((start (point)))
     (goto-char (point-max))
     (search-backward-regexp "^Topics")
     (delete-region (point) (point-max))
     (goto-char start)
     (or (search-forward "Last modified" nil t)
         (search-forward "First published" nil t)
         (search-forward-regexp "^Published")
         )
     (or (search-backward "Submit" nil t)
         (search-backward-regexp "^* ")
         )
     (beginning-of-line)
     (forward-line 1)
     (delete-region start (point)))
   (message-goto-body))
 
 (defun clean-up-wikipedia ()
   (or (search-forward "Retrieved from" nil t)
       (search-forward "Abgerufen von" nil t))
   (beginning-of-line)
   (delete-region (point) (point-max))
   (message-goto-body))
 
 (defun clean-up-stackoverflow ()
   (forward-line 2)
   (let ((start (point)))
     (search-forward "Ask Question" nil t)
     (beginning-of-line)
     (search-backward "Learn more" nil t)
     (beginning-of-line)
     (forward-line 3)
     (delete-region (point) start))
   (goto-char (point-max))
   (search-backward "Add a comment" nil t)
   (beginning-of-line)
   (delete-region (point) (point-max))
   (message-goto-body))
 
 (defun clean-up-schneier ()
   (forward-line 2)
   (let ((start (point)))
     (search-forward "HomeBlog" nil t)
     (beginning-of-line)
     (forward-line 2)
     (delete-region (point) start))
   (goto-char (point-max))
   (search-backward "Atom Feed" nil t)
   (beginning-of-line)
   (delete-region (point) (point-max))
   (message-goto-body))
 
 (defun clean-up-counterpunch ()
   (forward-line 2)
   (let ((start (point)))
     (search-forward "Submit" nil t)
     (beginning-of-line)
     (forward-line 1)
     (delete-region (point) start))
   (goto-char (point-max))
   (search-backward "New from" nil t)
   (beginning-of-line)
   (delete-region (point) (point-max))
   (message-goto-body))
 
 (defun clean-up-wallstreetonparade ()
   (forward-line 1)
   (let ((start (point)))
     (search-forward "Search for:" nil t)
     (beginning-of-line)
     (forward-line 1)
     (forward-paragraph 1)
     (delete-region (point) start))
   (goto-char (point-max))
   (search-backward "Bookmark the permalink." nil t)
   (beginning-of-line)
   (delete-region (point) (point-max))
   (message-goto-body))
 
 (defun clean-up-cnn ()
   (forward-line 1)
   (let ((start (point)))
     (search-forward "Follow CNN" nil t)
     (beginning-of-line)
     (forward-paragraph 2)
     (delete-region (point) start))
   (goto-char (point-max))
   (search-backward "Submit" nil t)
   (beginning-of-line)
   (delete-region (point) (point-max))
   (message-goto-body))
 
 (defun clean-up-commondreams ()
   (forward-line 1)
   (let ((start (point)))
     (or (search-forward "(Photo" nil t)
         (search-forward "A project of Common Dreams" nil t))
     (beginning-of-line)
     (forward-paragraph 2)
     (delete-region (point) start))
   (goto-char (point-max))
   (or (search-backward "From Your Site Articles" nil t)
       (search-backward "SUBSCRIBE TO OUR FREE NEWSLETTER" nil t))
   (beginning-of-line)
   (delete-region (point) (point-max))
   (message-goto-body))
 
 (defun clean-up-wsws ()
   (forward-line 1)
   (let ((start (point)))
     (search-forward "* Donate" nil t)
     (beginning-of-line)
     (forward-paragraph)
     (delete-region (point) start))
   (goto-char (point-max))
   (or
    (search-backward "The World Socialist Web Site is the voice" nil t)
    (search-backward "Sign up for " nil t)
    (search-backward "Read more" nil t)
    (search-backward "Join the fight for socialism" nil t)
    (search-backward "Only by building an independent movement" nil t)
    )
   (beginning-of-line)
   (delete-region (point) (point-max))
   (message-goto-body))
 
 (defun clean-up-zsposepneho ()
   (forward-line 1)
   (let ((start (point)))
     (search-forward "Publikováno" nil t)
     (beginning-of-line)
     (backward-paragraph 2)
     (delete-region (point) start))
   (goto-char (point-max))
   (search-backward "Rychle k cíli" nil t)
   (beginning-of-line)
   (forward-line -1)
   (delete-region (point) (point-max))
   (message-goto-body))
 
 (defun clean-up-euractiv ()
   (forward-line 1)
   (let ((start (point)))
     (cond
      ((search-forward "Est. " nil t)
       (beginning-of-line)
       (backward-paragraph 3)
       (delete-region (point) start))
      ((search-forward "Content-Type:")
       (backward-paragraph 3)
       (delete-region (point) start)))
     ;; tail
     (goto-char (point-max))
     (or
      (search-backward "Euractiv is part of the Trust Project" nil t)
      (search-backward "Topics" nil t)
      (search-backward "Read more with Euractiv" nil t)
      )
     (when (< start (point))
       (beginning-of-line)
       (forward-line -1)
       (backward-paragraph 1)
       (delete-region (point) (point-max)))
     ;; whitespace
     (goto-char start)
     (while (re-search-forward "^[ \t]+" nil t)
       (replace-match "")))
   (message-goto-body))
 
 (defun clean-up-infomigrants ()
   (forward-line 1)
   (let ((start (point)))
     (search-forward "Published on : " nil t)
     (beginning-of-line)
     (backward-paragraph 2)
     (delete-region (point) start)
     ;; tail
     (goto-char (point-max))
     (search-backward "More articles" nil t)
     (beginning-of-line)
     (forward-line -1)
     (delete-region (point) (point-max))
     ;; other
     (goto-char start)
     (while (re-search-forward "^*\n" nil t)
       (replace-match ""))
     (goto-char start)
     (while (re-search-forward "^Also read: " nil t)
       (beginning-of-line)
       (forward-line -1)
       (kill-paragraph 1))
     )
   (message-goto-body))
 
 (defun email-eww ()
   (interactive)
   (let ((content (buffer-string))
         (title (or (plist-get eww-data :title)
                    (buffer-name (current-buffer))))
         (url (plist-get eww-data :url)))
     (compose-mail email-eww-to title `(("From" . ,email-eww-from)))
     (message-goto-body)
     (when url
       (insert url)
       (insert "\n\n"))
     (insert content)
     (message-goto-body)
     (delete-trailing-whitespace)
     (message-goto-body)
     (cond
      ((string-match "news.ycombinator.com" url)
       (clean-up-ycombinator))
      ((string-match "reddit.com" url)
       (clean-up-reddit))
      ((string-match "faz.net" url)
       (clean-up-faz))
      ((string-match "mmnews.de" url)
       (clean-up-mmnews))
      ((string-match "voanews.com" url)
       (clean-up-voanews))
      ((string-match "guardian.com" url)
       (clean-up-guardian))
      ((string-match "wikipedia.org" url)
       (clean-up-wikipedia))
      ((or (string-match "stackoverflow.com" url)
           (string-match "stackexchange.com" url))
       (clean-up-stackoverflow))
      ((string-match "schneier.com" url)
       (clean-up-schneier))
      ((string-match "counterpunch.org" url)
       (clean-up-counterpunch))
      ((string-match "wallstreetonparade.com" url)
       (clean-up-wallstreetonparade))
      ((string-match "cnn.com" url)
       (clean-up-cnn))
      ((string-match "commondreams.org" url)
       (clean-up-commondreams))
      ((string-match "wsws.org" url)
       (clean-up-wsws))
      ((string-match "zsposepneho.cz" url)
       (clean-up-zsposepneho))
      ((string-match "euractiv.com" url)
       (clean-up-euractiv))
      ((string-match "infomigrants.net" url)
       (clean-up-infomigrants))
      )
     (goto-char (point-max))
     (delete-blank-lines)
     (message-goto-to)
     (current-buffer)))
 
 (defun email-w3m (url)
   (when url
     (let ((b (get-buffer-create url)))
       (shell-command (concat "w3m -dump " (shell-quote-argument url)) b b)
       (with-current-buffer b
         (email-region (point-min) (point-max))
         (message-goto-body)
         (insert url)
         (insert "\n\n")
         (cond
          ((or
            (string-match "serverfault.com" url)
            (string-match "stackexchange.com" url)
            (string-match "stackoverflow.com" url)
            (string-match "superuser.com" url)
            )
           (search-forward "Ask Question" nil t)
           (beginning-of-line)
           (backward-paragraph 1)
           (beginning-of-line)
           (forward-line 3)
           (delete-region (point) start)
           (clean-up-stackoverflow)))
         (message-goto-to)))))
 (provide 'email-eww)