path: root/mu4e/mu4e-contacts.el

;;; mu4e-contacts.el -- part of mu4e -*- lexical-binding: t -*-

;; Copyright (C) 2022 Dirk-Jan C. Binnema

;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>

;; This file is not part of GNU Emacs.

;; mu4e is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; mu4e is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with mu4e.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Utility functions used in the mu4e

;;; Code:
(require 'cl-lib)
(require 'mu4e-helpers)
(require 'mu4e-update)


;;; Configuration
(defcustom mu4e-compose-complete-addresses t
  "Whether to do auto-completion of e-mail addresses."
  :type 'boolean
  :group 'mu4e-compose)

(defcustom mu4e-compose-complete-only-personal nil
  "Whether to consider only \"personal\" e-mail addresses for completion.
That is, addresses from messages where user was explicitly in one
of the address fields (this excludes mailing list messages).
These addresses are the ones specified with \"mu init\"."
  :type 'boolean
  :group 'mu4e-compose)

(defcustom mu4e-compose-complete-only-after "2018-01-01"
  "Consider only contacts last seen after this date.

Date must be a string of the form YYYY-MM-DD.

This is useful for limiting a potentially enormous set of
contacts for auto-completion to just those that are present in
the e-mail corpus in recent times. Set to nil to not have any
time-based restriction."
  :type 'string
  :group 'mu4e-compose)

(defcustom mu4e-compose-complete-max nil
  "Consider only the top-n contacts.
After considering the other
constraints (`mu4e-compose-complete-addresses' and
`mu4e-compose-complete-only-after'), pick only the highest-ranked
<n>.

This reduces start-up time and memory usage. Set to nil for no
limits."
  :type 'string
  :group 'mu4e-compose)

;; names and mail-addresses can be mapped onto their canonical
;; counterpart.  use the customizeable function
;; mu4e-canonical-contact-function to do that.  below the identity
;; function for mapping a contact onto the canonical one.
(defun mu4e-contact-identity (contact)
  "Return the name and the mail-address of a CONTACT.
It is used as the identity function for converting contacts to
their canonical counterpart; useful as an example."
  (let ((name (plist-get contact :name))
        (mail (plist-get contact :mail)))
    (list :name name :mail mail)))

(make-obsolete-variable 'mu4e-contact-rewrite-function
                        "mu4e-contact-process-function (see docstring)"
			"mu4e 1.3.2")
(make-obsolete-variable 'mu4e-compose-complete-ignore-address-regexp
                        "mu4e-contact-process-function (see docstring)"
			"mu4e 1.3.2")

(defcustom mu4e-contact-process-function
  (lambda(addr)
    (cond
     ((string-match-p "reply" addr)
      ;; no-reply adresses are not useful of course, but neither are are
      ;; reply-xxxx addresses since they're autogenerated only useful for direct
      ;; replies.
      nil)
     (t addr)))
  "Function for processing contact information for use in auto-completion.

The function receives the contact as a string, e.g \"Foo Bar
   <foo.bar@example.com>\" \"cuux@example.com\"

The function should return either:
- nil: do not use this contact for completion
- the (possibly rewritten) address, which must be
an RFC-2822-compatible e-mail address."
  :type 'function
  :group 'mu4e-compose)

(defcustom mu4e-compose-reply-ignore-address
  '("no-?reply")
  "Addresses to prune when doing wide replies.

This can be a regexp matching the address, a list of regexps or a
predicate function. A value of nil keeps all the addresses."
  :type '(choice
          (const nil)
          function
          string
          (repeat string))
  :group 'mu4e-compose)


;;; Internal variables
(defvar mu4e--contacts-tstamp "0"
  "Timestamp for the most recent contacts update." )

(defvar mu4e--contacts-set nil
  "Set with the full contact addresses for autocompletion.")

;;; user mail address
(defun mu4e-personal-addresses(&optional no-regexp)
  "Get the list user's personal addresses, as passed to mu init.
The address are either plain e-mail address or /regular
 expressions/. When NO-REGEXP is non-nil, do not include regexp
 address patterns (if any)."
  (seq-remove
   (lambda(addr) (and no-regexp (string-match-p "^/.*/" addr)))
   (when (mu4e-server-properties)
     (plist-get (mu4e-server-properties) :personal-addresses))))

(defun mu4e-personal-address-p (addr)
  "Is ADDR a personal address?
Evaluate to nil if ADDR matches any of the personal addresses.
Uses (mu4e-personal-addresses) for the addresses with both the plain
addresses and /regular expressions/."
  (when addr
    (seq-find
     (lambda (m)
       (if (string-match "/\\(.*\\)/" m)
           (let ((rx (match-string 1 m))
                 (case-fold-search t))
             (if (string-match rx addr) t nil))
         (eq t (compare-strings addr nil nil m nil nil 'case-insensitive))))
     (mu4e-personal-addresses))))

(define-obsolete-function-alias 'mu4e-user-mail-address-p
  'mu4e-personal-address-p "1.5.5")


;; don't use the older vars anymore
(make-obsolete-variable 'mu4e-user-mail-address-regexp
                        'mu4e-user-mail-address-list "0.9.9.x")
(make-obsolete-variable 'mu4e-my-email-addresses
                        'mu4e-user-mail-address-list "0.9.9.x")
(make-obsolete-variable 'mu4e-user-mail-address-list
                        "determined by server; see `mu4e-personal-addresses'."
			"1.3.8")


;; Helpers


;;; RFC2822 handling of phrases in mail-addresses
;;
;; The optional display-name contains a phrase, it sits before the
;; angle-addr as specified in RFC2822 for email-addresses in header
;; fields.  Contributed by jhelberg.

(defun mu4e--rfc822-phrase-type (ph)
  "Return an atom or quoted-string for the phrase PH.
This checks for empty string first. Then quotes around the phrase
\(returning symbol `rfc822-quoted-string'). Then whether there is
a quote inside the phrase (returning symbol
`rfc822-containing-quote').

The reverse of the RFC atext definition is then tested. If it
matches, nil is returned, if not, it returns a symbol
`rfc822-atom'."
  (cond
   ((= (length ph) 0) 'rfc822-empty)
   ((= (aref ph 0) ?\")
    (if (string-match "\"\\([^\"\\\n]\\|\\\\.\\|\\\\\n\\)*\"" ph)
        'rfc822-quoted-string
      'rfc822-containing-quote)) ; starts with quote, but doesn't end with one
   ((string-match-p "[\"]" ph) 'rfc822-containing-quote)
   ((string-match-p "[\000-\037()\*<>@,;:\\\.]+" ph) nil)
   (t 'rfc822-atom)))

(defun mu4e--rfc822-quote-phrase (ph)
  "Quote an RFC822 phrase PH only if necessary.
Atoms and quoted strings don't need quotes. The rest do.  In
case a phrase contains a quote, it will be escaped."
  (let ((type (mu4e--rfc822-phrase-type ph)))
    (cond
     ((eq type 'rfc822-atom) ph)
     ((eq type 'rfc822-quoted-string) ph)
     ((eq type 'rfc822-containing-quote)
      (format "\"%s\""
              (replace-regexp-in-string "\"" "\\\\\"" ph)))
     (t (format "\"%s\"" ph)))))

(defsubst mu4e-contact-name (contact)
  "Get the name of this CONTACT, or nil."
  (plist-get contact :name))

(defsubst mu4e-contact-email (contact)
  "Get the name of this CONTACT, or nil."
  (plist-get contact :email))

(defsubst mu4e-contact-cons (contact)
  "Convert a CONTACT plist into a old-style (name . email)."
    (cons
     (mu4e-contact-name contact)
     (mu4e-contact-email contact)))

(defsubst mu4e-contact-make (name email)
  "Creata contact plist from NAME and EMAIL."
    `(:name ,name :email ,email))

(defun mu4e-contact-full (contact)
  "Get the full combination of name and email address from CONTACT."
  (let* ((email (mu4e-contact-email contact))
	 (name (mu4e-contact-name contact)))
    (if (and name (> (length name) 0))
	(format "%s <%s>" (mu4e--rfc822-quote-phrase name) email)
      email)))


(defun mu4e--update-contacts (contacts &optional tstamp)
  "Receive a sorted list of CONTACTS newer than TSTAMP.
Update an internal set with it.

This is used by the completion function in mu4e-compose."
  (let ((n 0))
    (unless mu4e--contacts-set
      (setq mu4e--contacts-set (make-hash-table :test 'equal :weakness nil
                                           :size (length contacts))))
    (dolist (contact contacts)
      (cl-incf n)
      (when (functionp mu4e-contact-process-function)
	(setq contact (funcall mu4e-contact-process-function contact)))
      (when contact ;; note the explicit deccode; the strings we get are
		      ;; utf-8, but emacs doesn't know yet.
        (puthash (decode-coding-string contact 'utf-8) t mu4e--contacts-set)))
    (setq mu4e--contacts-tstamp (or tstamp "0"))
    (unless (zerop n)
      (mu4e-index-message "Contacts updated: %d; total %d"
                          n (hash-table-count mu4e--contacts-set)))))

(defun mu4e-contacts-info ()
  "Display information about the contacts-cache.
For testing/debugging."
  (interactive)
  (with-current-buffer (get-buffer-create "*mu4e-contacts-info*")
    (erase-buffer)
    (insert (format "complete addresses:        %s\n"
		    (if mu4e-compose-complete-addresses "yes" "no")))
    (insert (format "only personal addresses:   %s\n"
                    (if mu4e-compose-complete-only-personal "yes" "no")))
    (insert (format "only addresses seen after: %s\n"
                    (or mu4e-compose-complete-only-after "no restrictions")))

    (when mu4e--contacts-set
      (insert (format "number of contacts cached: %d\n\n"
                      (hash-table-count mu4e--contacts-set)))
      (maphash (lambda (contact _)
		 (insert (format "%s\n" contact))) mu4e--contacts-set))
    (pop-to-buffer "*mu4e-contacts-info*")))

(declare-function mu4e--server-contacts  "mu4e-server")

(defun mu4e--request-contacts-maybe ()
  "Maybe update the set of contacts for autocompletion.