Skip to content
Permalink
Browse files

pick up mail address from received mails

  • Loading branch information...
redguardtoo committed May 17, 2019
1 parent b60887d commit 507365996972164c964c95eb7e501b91b3951a3a
Showing with 164 additions and 42 deletions.
  1. +48 −0 .gitignore
  2. +18 −0 README.org
  3. +98 −42 dianyou.el
@@ -0,0 +1,48 @@
*.tar

### https://raw.github.com/github/gitignore/073727ccd9b0ec0b39440fb7673034f04f5d1302/Global/Emacs.gitignore

# -*- mode: gitignore; -*-
*~
\#*\#
/.emacs.desktop
/.emacs.desktop.lock
*.elc
auto-save-list
tramp
.\#*

# Org-mode
.org-id-locations
*_archive

# flymake-mode
*_flymake.*

# eshell files
/eshell/history
/eshell/lastdir

# elpa packages
/elpa/

# reftex files
*.rel

# AUCTeX auto folder
/auto/

# cask packages
.cask/


### https://raw.github.com/github/gitignore/073727ccd9b0ec0b39440fb7673034f04f5d1302/Global/Vim.gitignore

[._]*.s[a-w][a-z]
[._]s[a-w][a-z]
*.un~
Session.vim
.netrwhist
*~

*.elc
@@ -0,0 +1,18 @@
* dianyou 0.0.2

[[http://melpa.org/#/dianyou][file:http://melpa.org/packages/dianyou-badge.svg]] [[http://stable.melpa.org/#/dianyou][file:http://stable.melpa.org/packages/dianyou-badge.svg]]

Search and analyze mails in Gnus

* Install
Place [[https://raw.githubusercontent.com/redguardtoo/dianyou/master/dianyou.el][dianyou.el]] under [[https://www.emacswiki.org/emacs/LoadPath][Load Path]]. Then add =(require 'dianyou)= to your configuration.
* Usage
=M-x dianyou-group-make-nnir-group= to search mail in any Gnus buffer. It's similar to =gnus-group-make-nnir-group= but supports shortcuts when using [[https://tools.ietf.org/html/rfc3501#section-6.4.4][IMAP search command]].

For example, input =s 2w f John=, then select "imap" when asked how to search. Mails from John sent since 2 weeks ago are returned.

=M-x dianyou-insert-email-address-from-received-mails= to insert email address from received mails.

The accessed email address is automatically stored in variable =dianyou-email-address-history=, which could be persisted by [[https://github.com/jwiegley/session][session]].
* Contact me
Report bug at [[https://github.com/redguardtoo/dianyou]].
@@ -1,9 +1,9 @@
;;; dianyou.el --- Analyze mails in Gnus
;;; dianyou.el --- Search and analyze mails in Gnus

;; Copyright (C) 2019 Chen Bin
;;
;; Version: 0.0.1
;; Keywords: email
;; Version: 0.0.2
;; Keywords: mail
;; Author: Chen Bin <chenbin DOT sh AT gmail DOT com>
;; URL: http://github.com/usrname/dianyou
;; Package-Requires: ((emacs "24.4"))
@@ -27,11 +27,16 @@
;;; Commentary:

;; `dianyou-group-make-nnir-group' to search mails.
;; `dianyou-insert-email-address-from-received-mails' to insert email address.

;;; Code:
(require 'gnus-group)
(require 'gnus-topic)
(require 'gnus-sum)
(require 'gnus-util)
(require 'nnir)
(require 'gnus-srvr)
(require 'cl-lib)

(defvar dianyou-email-address-history nil "Email address history.")

(defvar dianyou-debug nil "Print debug information.")

@@ -144,7 +149,7 @@
(interactive)
(let* ((q (read-string "Query: " nil 'nnir-search-history))
(words (split-string q " "))
(query (string-join (mapcar 'dianyou-translate words) " ")))
(query (mapconcat 'identity (mapcar 'dianyou-translate words) " ")))
(if dianyou-debug (message "query=%s" query))
query))

@@ -167,14 +172,14 @@

;;;###autoload
(defun dianyou-group-make-nnir-group ()
"Create an nnir group.
"Search emails like `gnus-group-make-nnir-group'.
Prompt for search query and determine groups to search as follows:
In *Server* buffer search all groups belonging to current server;
In *Group* buffer search marked groups, or the current group,
In *Server* buffer, search all groups belonging to current server;
In *Group* buffer, search marked groups, or the current group,
or all the groups under the current topic;
In *Summary* buffer search the group current buffer belonging to.
In *Summary* buffer, search the group current buffer belonging to.
The IMAP search syntax supports shortcut and more date format:
IMAP search syntax supports shortcut and more date format:
\"t\" equals \"TO\".
\"b\" equals \"BEFORE\".
\"e\" equals \"TEXT\".
@@ -219,50 +224,72 @@ See https://tools.ietf.org/html/rfc3501#section-6.4.4 for IMAP SEARCH spec."
(setq y1 (replace-regexp-in-string " *([^ ]*) *" "" (if y y ""))))
(string= x1 y1)))

;;;#autoload
(defun dianyou-summary-extract-email-address(regexp)
"Extract email address from email to/cc/from field in *Summary* buffer.
REGEXP is pattern to exclude email address.
For example, 'Tom|gmail' excludes address containing \"Tom\" or \"gmail\".
Final result is inserted into `kill-ring' and returned."
(interactive
(let* ((regexp (read-regexp "Regex to exclude mail address (OPTIONAL):")))
(list regexp)))
(defun dianyou-add-address (address list regexp)
"Add ADDRESS into LIST and return it.
The email address should not match REGEXP."
(cond
((or (not address)
; No empty strings
(string= address "")
;; exclude address
(and regexp (not (string= regexp "")) (string-match regexp address)))
list)
(t
(setq list (add-to-list 'list address)))))

(let* ((rlt "") (i 0) header cc-to)
;;;###autoload
(defun dianyou-all-email-address (&optional exclude-regexp quiet)
"Return all email address extracted from received mails.
Email address matching EXCLUDE-REGEXP is excluded from final result.
If QUIET is t, show no progress report when extracting email address."
(let* (str (i 0) header cc-to cands)
(dolist (d gnus-newsgroup-data)
(setq header (gnus-data-header d))
(setq i (+ 1 i))
(if (= (mod i 100) 0) (message "%s mails scanned ..." i))
(when (vectorp header)
(if (setq cc-to (mail-header-extra header))
;; (message "cc-to=%s cc=%s" cc-to (assoc 'Cc cc-to))
(setq rlt (concat rlt
(setq str (concat str
(cdr (assoc 'To cc-to))
", "
(cdr (assoc 'Cc cc-to))
", ")))
(setq rlt (concat rlt (if (string= "" rlt) "" ", ")
(setq str (concat str (if (string= "" str) "" ", ")
(mail-header-from header) ", "))))
;; trim trailing ", "
(setq rlt (split-string (replace-regexp-in-string (rx (* (any ", ")) eos)
""
rlt) ", *"))

;; remove empty strings
(setq rlt (delq nil (remove-if (lambda (s) (or (not s) (string= "" s)))
rlt)))

;; sanity check
(unless str (setq str ""))

;; filter some address
(dolist (r (split-string (replace-regexp-in-string "[ ,]*\\'"
""
str) ", *"))
(setq cands (dianyou-add-address r cands exclude-regexp)))

;; remove actually duplicated mails
(setq rlt (delq nil (remove-duplicates rlt
:test 'dianyou-test-two-email-address
:from-end t)))
;; exclude mails
(when (and regexp (not (string= regexp "")))
(setq rlt (delq nil (remove-if `(lambda (s)
(string-match (concat "\\("
(replace-regexp-in-string "|" "\\\\|" ,regexp)
"\\)") s))
rlt))))
(setq cands (delq nil (cl-remove-duplicates cands
:test 'dianyou-test-two-email-address
:from-end t)))
cands))

;;;###autoload
(defun dianyou-summary-extract-email-address(regexp)
"Extract email address from email to/cc/from field in *Summary* buffer.
REGEXP is pattern to exclude email address.
For example, 'Tom|gmail' excludes address containing \"Tom\" or \"gmail\".
Final result is inserted into `kill-ring' and returned."
(interactive
(let* ((regexp (read-regexp "Regex to exclude mail address (OPTIONAL):")))
(list regexp)))

;; convert into Emacs Lisp regular expression
(when (and regexp (not (string= regexp "")))
(setq regexp (concat "\\("
(replace-regexp-in-string "|" "\\\\|" regexp)
"\\)")))

(let* ((rlt (dianyou-all-email-address regexp)))
(cond
((> (length rlt) 0)
(kill-new (mapconcat 'identity rlt ", "))
@@ -271,5 +298,34 @@ Final result is inserted into `kill-ring' and returned."
(message "NO email address is found.")))
rlt))

;;;###autoload
(defun dianyou-get-all-email-addresses ()
"Get all email addresses in received mails and update history."
(let* ((all-addresses (dianyou-all-email-address))
(cands (cond
((and dianyou-email-address-history all-addresses)
(append dianyou-email-address-history
all-addresses))
(dianyou-email-address-history
dianyou-email-address-history)
(t
(setq dianyou-email-address-history all-addresses)))))
(cond
((and cands (> (length cands) 0))
(setq dianyou-email-address-history
(delq nil (cl-remove-duplicates cands
:test 'dianyou-test-two-email-address
:from-end t))))
(t
nil))))

;;;###autoload
(defun dianyou-insert-email-address-from-received-mails()
"Insert email address from received mails."
(interactive)
(let* ((email-address (completing-read "Insert email address: "
(dianyou-get-all-email-addresses))))
(if email-address (insert email-address))))

(provide 'dianyou)
;;; dianyou.el ends here
;;; dianyou.el ends here

0 comments on commit 5073659

Please sign in to comment.
You can’t perform that action at this time.