bbdb-20200102.403.tar

bbdb-20200102.403/0000755000175000017500000000000013643253543010702 5ustar  cbcbbbdb-20200102.403/dir0000644000175000017500000000117113643253537011406 0ustar  cbcbThis is the file .../info/dir, which contains the
topmost node of the Info hierarchy, called (dir)Top.
The first time you invoke Info you start off looking at this node.

File: dir,	Node: Top	This is the top of the INFO tree

  This (the Directory node) gives a menu of major topics.
  Typing "q" exits, "H" lists all Info commands, "d" returns here,
  "h" gives a primer for first-timers,
  "mEmacs<Return>" visits the Emacs manual, etc.

  In Emacs, you can click mouse button 2 on a menu item or cross reference
  to select it.

* Menu:

Emacs misc features
* BBDB: (bbdb).                 Insidious Big Brother Database (BBDB).
bbdb-20200102.403/bbdb-tex.el0000644000175000017500000005702413643253537012726 0ustar  cbcb;;; bbdb-tex.el --- feed BBDB into LaTeX  -*- lexical-binding: t -*-

;; Copyright (C) 2010-2017  Free Software Foundation, Inc.

;; Authors: Boris Goldowsky <boris@cs.rochester.edu>
;;          Dirk Grunwald <grunwald@cs.colorado.edu>
;;          Luigi Semenzato <luigi@paris.cs.berkeley.edu>

;; This file is part of the Insidious Big Brother Database (aka BBDB),

;; BBDB 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.

;; BBDB 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 BBDB.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This file lets you feed BBDB into LaTeX.
;; See the BBDB info manual for documentation.
;;
;; In the *BBDB* buffer, type M-x `bbdb-tex' to convert the listing
;; to LaTeX format.
;;
;; TeX macros appearing in the output:
;;   \name{first}{last}
;;   \organization{foo bar}
;;   \affix{foo bar}
;;   \aka{foo bar}
;;   \phone{key}{123 456 7890}
;;   \address{key}{foo bar}
;;   \mail{foo@bar.com}{Smith <foo@bar.com>}
;;   \xfield{key}{value}
;; Each macro may appear multiple times.
;;
;; The detailed grammar of the output is defined in `bbdb-tex-alist'.
;; The output starts with a prolog where you can specify LaTeX packages
;; and other customizations in the usual way.  The above macros should get
;; defined, too. By default, this happens in the style file bbdb.sty that
;; is shipped with BBDB.
;;
;; The body of the output contains the BBDB records.  Usually, the records
;; are placed inside some "bbdb" environment.  You can customize which fields
;; of each record should appear in the listing and in which order.
;; Also, you can put separators between individual fields.  A separator macro
;; can also separate records when the first character of the last name differs
;; from the first character of the last name of the previous record.
;; The listing ends with an epilog.

;; A few notes on "advanced usage" of `bbdb-tex':
;;
;; It should be possible to use `bbdb-tex' with all the bells and whistles
;; of LaTeX by loading the appropriate LaTeX style files and packages or
;; embedding the output of `bbdb-tex' into more complex LaTeX documents.
;; For this you can customize the rules in `bbdb-tex-alist' and use
;; customized style files for interpreting the TeX macros used by `bbdb-tex'.
;;
;; Generally, lisp customizations for `bbdb-tex' are intended to provide control
;; of *what* appears in the TeX listing.  But there are no lisp customization
;; options to control the actual layout that should be handled by LaTeX.
;; BBDB is shipped with one basic LaTeX style file bbdb.sty to handle
;; the TeX macros listed above.  You should customize this LaTeX style file
;; to match your taste and / or your needs.  Note also that `bbdb-tex-alist'
;; allows you to specify an arbitrary number of rules that may use different
;; style files for the above TeX macros.

;; Generally, it will be advantageous to make all relevant style files
;; and packages known to LaTeX by putting them in the appropriate directories
;; of your TeX installation.  Likely, the user variable `bbdb-tex-path'
;; should not be used in such advanced cases.  The main purpose of the
;; inlining mechanism provided via `bbdb-tex-path' is that we can ship
;; and install BBDB without worrying about the tricky question where to
;; (auto-) install the basic style file bbdb.sty shipped with BBDB so that
;; TeX finds it.  Most often, it will be best to manually install even bbdb.sty
;; in a directory where TeX finds it and bind `bbdb-tex-path' to t to fully
;; suppress the inlining.
;;
;; Before generating the TeX output, the field values of a record are massaged
;; by `bbdb-tex-field' that passes these values by default to `bbdb-tex-replace',
;; see also `bbdb-tex-replace-list'.  Instead the user may also define functions
;; `bbdb-tex-output-...' that take precedence, see `bbdb-tex-field'.
;;
;; `bbdb-tex' understands one new BBDB xfield: tex-name, see also
;; `bbdb-tex-name'.  If this xfield is defined for a record,
;; this will be used for the TeXed listing instead of the name field
;; of that record.  The value of the xfield tex-name is used verbatim,
;; it does not see `bbdb-tex-field' and `bbdb-tex-replace-list'.
;;
;;
;; This program was adapted for BBDB by Boris Goldowsky
;; <boris@cs.rochester.edu> and Dirk Grunwald
;; <grunwald@cs.colorado.edu> using a TeX format designed by Luigi
;; Semenzato <luigi@paris.cs.berkeley.edu>.
;; We are also grateful to numerous people on the bbdb-info
;; mailing list for suggestions and bug reports.

;;; Code:

(require 'bbdb)
(require 'bbdb-com)

;;; Variables:

(defcustom bbdb-tex-name 'tex-name
  "Xfield holding the name in TeX format.
The string in this field gets split into first and last name
using `bbdb-separator-alist'.  The separator defaults to \"#\"."
  :group 'bbdb-utilities-tex
  :type '(symbol :tag "Xfield"))

(defcustom bbdb-tex-alist
  `((multi-line
     (demand (or address phone))
     (prolog ,(concat "\\documentclass{article}\n\\usepackage{bbdb}\n"
                      "\\usepackage{multicol}\n"
                      "\\begin{document}\n\\begin{multicols}{2}"))
     (record "\\begin{bbdbrecord}" name organization ; affix aka
             (address t) (phone t) (mail t)
             (xfields t nil
                      (omit ,bbdb-tex-name mail-alias creation-date timestamp))
             "\\end{bbdbrecord}\n")
     (separator "\\bbdbseparator{%s}\n")
     (epilog ,(concat "\\noindent\\hrulefill\\\\\nPrinted \\today\n"
                      "\\end{multicols}\n\\end{document}"))
     (options (bbdb-tex-linebreak "\\\\\\\\\n")
              (bbdb-tex-address-layout 2)))

    (one-line
     (demand phone)
     (prolog ,(concat "\\documentclass{article}\n\\usepackage{bbdb}\n"
                      "\\begin{document}\n\\begin{bbdb}{llllll}"))
     (record name "&" (organization 1) "&" (phone 2 "&") "&" (mail 1)
             "&" (address 1) "\\\\")
     (separator "\\bbdbseparator{%s}")
     (epilog "\\end{bbdb}\n\\end{document}")
     (options (bbdb-tex-linebreak ", ")
              (bbdb-tex-address-layout 3)))

    (phone
     (demand phone)
     (prolog ,(concat "\\documentclass{article}\n\\usepackage{bbdb}\n"
                      "\\begin{document}\n\\begin{bbdb}{ll}"))
     (record name "&" (phone 2 "&") "\\\\")
     (separator "\\bbdbseparator{%s}")
     (epilog "\\end{bbdb}\n\\end{document}")
     (options (bbdb-tex-linebreak ", ")
              (bbdb-tex-address-layout 3)))

    (example ; another rule with more examples
     (demand (or address phone))
     (prolog ,(concat "\\documentclass{article}\n\\usepackage{bbdb}\n"
                      "\\usepackage{multicol}\n"
                      "\\begin{document}\n\\begin{multicols}{2}"))
     (record "\\begin{bbdbrecord}" name organization
             (address 1 nil (omit "work"))
             (phone 2 nil (admit "home" "cell"))
             (mail t)
             (birthday t)
             (xfields t nil
                      (omit ,bbdb-tex-name mail-alias creation-date timestamp))
             "\\end{bbdbrecord}\n")
     (separator "\\bbdbseparator{%s}\n")
     (epilog ,(concat "\\noindent\\hrulefill\\\\\nPrinted \\today\n"
                      "\\end{multicols}\n\\end{document}"))
     (options (bbdb-tex-linebreak "\\\\\\\\\n")
              (bbdb-tex-address-layout 2))))

  "Alist of rules for passing BBDB to LaTeX.
Each rule has the form (RULE LIST1 LIST2 ...).
The symbol RULE identifies the rule.
The remainder are lists LIST that should have one of these forms:

 (demand FORM)

  Here FORM is a lisp expression.  A record will be TeXed only
  if evaluating FORM yields a non-nil value for this record.
  When FORM is evaluated, the symbols name, affix, organization, mail,
  phone, address, and xfields are set to the corresponding values
  of this record; these symbols are nil if the respective field
  does not exist for this record.

 (prolog STRING)

  The string STRING is inserted at the beginning of the buffer.
  If STRING contains the substring \"\\usepackage{foo}\" and
  a file \"foo.sty\" exists within `bbdb-tex-path', replace
  \"\\usepackage{foo}\" with the content of the file \"foo.sty\",
  surrounded by \"\\makeatletter\" and \"\\makeatother\".
  Note: This fails with more sophisticated LaTeX style files
  using, e.g., optional arguments for the \"\\usepackage\" macro.

 (record ELT1 ELT2 ...)

  Here ELT may be one of the following:

  IF ELT is name, this expands to \"\\name{first}{last}\"

  If ELT is affix, organization, or aka, ELT expands to \"\\ELT{value}\".
    Here the elements of ELT are concatenated to get one value.

  If ELT is the key of an xfield, ELT expands to \"\\xfield{ELT}{value}\".

  If ELT is a string, this is inserted \"as is\" in the TeX buffer.

  ELT may also be a loop (FLD COUNT [SEPARATOR] [OPT...])
  looping over the values of FLD.

  If FLD is mail, this expands to \"\\mail{short}{long}\",
    such as \"\\mail{foo@bar.com}{Smith <foo@bar.com>}\",
  If FLD is phone, this expands to \"\\phone{key}{number}\"
  If FLD is address, this expands to \"\\address{key}{value}\".
  If FLD is xfields, this expands to \"\\xfield{key}{value}\".
  If FLD is the key of an xfield, split the value of FLD
    using `bbdb-separator-alist' to generate a list of values,
    which then expand to \"\\xfield{FLD}{value}\".

  If COUNT is a number, process at most COUNT values of FLD.
  IF COUNT is t, process all values of FLD.

  If SEPARATOR is non-nil, it is a string that is inserted between
  the values of FLD.  Insert COUNT - 1 instances of SEPARATOR,
  even if there are fewer values of FLD.

  If FLD is mail, phone, address, or xfields,
  OPT may be a list (admit KEY ...) or (omit KEY ...).
  Then a value is admitted or omitted if its key KEY is listed here.

 (separator STRING)

  When the first letter of the records' sortkey increases compared with
  the previous record in the TeX listing, the new letter is formatted
  using the format string STRING to generate a separator macro.

 (epilog STRING)

  The string STRING is inserted at the end of the buffer."
  :group 'bbdb-utilities-TeX
  :type '(repeat (cons (symbol :tag "rule")
                       (repeat
                        (choice (cons :tag "demand" (const demand) sexp)
                                (list :tag "prolog" (const prolog) string)
                                (cons :tag "record" (const record) sexp)
                                (list :tag "separator" (const separator) string)
                                (list :tag "epilog" (const epilog) string)
                                (cons :tag "options" (const options) sexp))))))

(defcustom bbdb-tex-rule-default 'multi-line
  "Default rule for BBDB tex.
This symbol should be a key in `bbdb-tex-alist'."
  :group 'bbdb-utilities-tex
  :type '(symbol :tag "rule"))

;; FIXME
;; (defcustom bbdb-tex-empty-fields nil
;;   "If non-nil generate TeX output even for empty fields."
;;   :group 'bbdb-utilities-tex)

(defcustom bbdb-tex-replace-list
  '(("[#$%&_]" . "\\\\\\&")
    ("<" . "\\\\textless ")
    (">" . "\\\\textgreater ")
    ("~" . "\\\\textasciitilde ")
    ("{" . "\\\\textbraceleft ")
    ("}" . "\\\\textbraceright "))
  "Replacement list for TeX's special characters.
Each element is of the form (REGEXP . REPLACE)."
  :group 'bbdb-utilities-tex
  :type '(repeat (cons regexp string)))

(defcustom bbdb-tex-linebreak "\\\\\\\\\n"
  "Replacement for linebreaks."
  :group 'bbdb-utilities-tex
  :type 'string)

(defcustom bbdb-tex-address-format-list bbdb-address-format-list
  "List of address formatting rules for `bbdb-tex'.
Each element may take the same values as in `bbdb-address-format-list'.
The elements EDIT of `bbdb-address-format-list' are ignored."
  :group 'bbdb-utilities-tex
  :type '(repeat (list (choice (const :tag "Default" t)
                               (function :tag "Function")
                               (repeat (string)))
                       (choice (string)
                               (function :tag "Function"))
                       (choice (string)
                               (function :tag "Function"))
                       (choice (string)
                               (function :tag "Function")))))

(defcustom bbdb-tex-address-layout 2
  "Address layout according to `bbdb-tex-address-format-list'.
2 is multi-line layout, 3 is one-line layout."
  :group 'bbdb-utilities-TeX
  :type '(choice (const :tag "multi-line" 2)
                 (const :tag "one-line" 3)))

(defcustom bbdb-tex-file "~/bbdb.tex"
  "Default file name for TeXing BBDB."
  :group 'bbdb-utilities-tex
  :type 'file)

;;; Internal variables

(defvar bbdb-tex-rule-last bbdb-tex-rule-default
  "Last rule used for TeXing BBDB.")

(defvar bbdb-tex-file-last bbdb-tex-file
  "Last used TeX file")

;;; Functions:

;; While we use `bbdb-tex-replace' only once in `bbdb-tex-field',
;; we keep it as a separate function so that it can also be used
;; inside user-defined functions `bbdb-tex-output-...'.
(defun bbdb-tex-replace (string)
  "Apply replacement rules `bbdb-tex-replace-list' to STRING.
Also, replace linebreaks by `bbdb-tex-linebreak'."
  (if (not string)
      ""
    (dolist (elt bbdb-tex-replace-list)
      (setq string (replace-regexp-in-string (car elt) (cdr elt) string)))
    (replace-regexp-in-string "\n" bbdb-tex-linebreak string)))

(defun bbdb-tex-field (field str)
  "Massage string STR for LaTeX.
By default, STR is passed to `bbdb-tex-replace'.
The user may also define a function `bbdb-tex-output-FIELD'
that takes precedence."
  (let ((fun (intern-soft (format "bbdb-tex-output-%s" field))))
    (if fun
        (funcall fun str)
      (bbdb-tex-replace str))))

(defun bbdb-tex-list (list rule fun)
  "Use function FUN to generate output for LIST according to RULE.
LIST is a list of field values such as a list of addresses.
RULE is an element of a record list as in `bbdb-tex-alist'
used to select the elements of LIST that get processed by calling FUN."
  (let ((admit (cdr (assq 'admit rule)))
        (omit (cdr (assq 'omit rule)))
        (num (if (numberp (nth 1 rule)) (nth 1 rule)))
        (sep (if (nth 2 rule) (concat (nth 2 rule) "\n")))
        (i -1)
        new-list elt)

    ;; Select the relevant elements of LIST.
    (cond (admit
           (dolist (l list)
             (if (member (elt l 0) admit)
                 (push l new-list)))
           (setq new-list (nreverse new-list)))

          (omit
           (dolist (l list)
             (unless (member (elt l 0) omit)
               (push l new-list)))
           (setq new-list (nreverse new-list)))

          (t
           (setq new-list list)))

    (cond ((not num)
           (insert (mapconcat fun new-list (or sep ""))))
          ((not sep)
           (while (and (< (setq i (1+ i)) num)
                       (setq elt (pop new-list)))
             (insert (funcall fun elt))))
          (t
           (while (< (setq i (1+ i)) num)
             (if (setq elt (pop new-list))
                 (insert (funcall fun elt)))
             (if (< (1+ i) num)
                 (insert sep)))))))

;;;###autoload
(defun bbdb-tex (records file rule)
  "Generate FILE for TeXing RECORDS.
Interactively, use BBDB prefix \
\\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.
RULE should be an element of `bbdb-tex-alist'."
  (interactive
   (list (bbdb-do-records)
         (read-file-name
          (format "TeX file: (default %s) "
                  (abbreviate-file-name bbdb-tex-file-last))
          (file-name-directory bbdb-tex-file-last)
          bbdb-tex-file-last)
         (intern (completing-read (format "Rule: (default %s) "
                                          bbdb-tex-rule-last)
                                  bbdb-tex-alist nil t
                                  nil nil (symbol-name bbdb-tex-rule-last)))))
  ;; Remember our choice for `bbdb-tex-file-last'.
  (setq bbdb-tex-file-last (expand-file-name file))

  (find-file bbdb-tex-file-last)
  (let* ((buffer-undo-list t)
         (rule (assq rule bbdb-tex-alist))
         (demand (nth 1 (assq 'demand rule)))
         (separator (nth 1 (assq 'separator rule)))
         current-letter p-symbols p-values)
    (erase-buffer)

    ;; Options
    (dolist (option (cdr (assq 'options rule)))
      (push (car option) p-symbols)
      (push (cadr option) p-values))
    (cl-progv p-symbols p-values

      ;; Prolog
      (let ((prolog (nth 1 (assq 'prolog rule))))
        (when prolog
          (insert prolog)
          (when (consp bbdb-tex-path)
            (goto-char (point-min))
            (while (re-search-forward "\\\\usepackage[ \t\n]*{\\([^}]+\\)}" nil t)
              (let ((sty (locate-file (match-string 1) bbdb-tex-path '(".sty"))))
                (when sty
                  (replace-match (format "\n\\\\makeatletter\n%% begin %s\n%% end %s\n\\\\makeatother\n" sty sty))
                  (save-excursion
                    (forward-line -2)
                    (insert-file-contents sty))))))
          (goto-char (point-max))
          (unless (bolp) (insert "\n"))
          (insert "% end BBDB prolog\n")))

      ;; Process Records
      (dolist (record (bbdb-record-list records))
        (let* ((first-letter
                (substring (bbdb-record-sortkey record) 0 1))
               (firstname (bbdb-record-firstname record))
               (lastname (bbdb-record-lastname record))
               (name    (bbdb-record-name record))
               (name-lf (bbdb-record-name-lf record))
               (organization (bbdb-record-organization record))
               (affix   (bbdb-record-affix record))
               (aka     (bbdb-record-aka record))
               (mail    (bbdb-record-mail record))
               (phone   (bbdb-record-phone record))
               (address (bbdb-record-address record))
               (xfields (bbdb-record-xfields record))
               (lex-env `((firstname . ,firstname) (lastname . ,lastname)
                          (name . ,name) (name-lf . ,name-lf) (aka . ,aka)
                          (organization . ,organization) (affix . ,affix)
                          (mail . ,mail) (phone . ,phone)
                          (address . ,address) (xfields . ,xfields)))
               (bbdb-address-format-list bbdb-tex-address-format-list))

          ;; A record is processed only if the form DEMAND
          ;; evaluates to a non-nil value.
          (when (or (not demand)
                    (eval demand lex-env))

            ;; Separator
            (if (and separator
                     (not (and current-letter
                               (equal first-letter current-letter))))
                (insert (format separator (upcase first-letter)) "\n"))
            (setq current-letter first-letter)

            (dolist (elt (cdr (assq 'record rule)))
              (cond ((stringp elt)
                     (insert elt "\n"))

                    ((eq elt 'name) ; name of record
                     (let ((tex-name (and bbdb-tex-name
                                          (bbdb-record-field record bbdb-tex-name)))
                           (fmt "\\name{%s}{%s}\n"))
                       (if tex-name
                           (let ((first-last (bbdb-split bbdb-tex-name tex-name)))
                             (cond ((eq 2 (length first-last))
                                    (insert (format fmt (car first-last) (cadr first-last))))
                                   ((eq 1 (length first-last))
                                    (insert (format fmt "" (car first-last))))
                                   (t (error "TeX name %s cannot be split" tex-name))))
                         (insert (format fmt
                                         (bbdb-tex-field 'firstname firstname)
                                         (bbdb-tex-field 'lastname  lastname))))))

                    ;; organization, affix or aka as single string
                    ((memq elt '(organization affix aka))
                     (let ((val (bbdb-record-field record elt)))
                       (if val
                           (insert (format "\\%s{%s}\n" elt
                                           (bbdb-tex-field elt (bbdb-concat elt val)))))))

                    ;; organization, affix or aka as list of strings
                    ((memq (car elt) '(organization affix aka))
                     (bbdb-tex-list
                      (bbdb-record-field record (car elt))
                      elt
                      `(lambda (o)
                         (format "\\%s{%s}\n" ',(car elt)
                                 (bbdb-tex-field ',(car elt) o)))))

                    ((eq (car elt) 'mail) ; mail
                     (bbdb-tex-list
                      mail elt
                      (lambda (m)
                        (format "\\mail{%s}{%s}\n"
                                ;; No processing of plain mail address
                                (nth 1 (bbdb-decompose-bbdb-address m))
                                (bbdb-tex-field 'mail m)))))

                    ((eq (car elt) 'address) ; address
                     (bbdb-tex-list
                      address elt
                      (lambda (a)
                        (format "\\address{%s}{%s}\n"
                                (bbdb-tex-field 'address-label (bbdb-address-label a))
                                (bbdb-tex-field 'address (bbdb-format-address
                                                          a bbdb-tex-address-layout))))))

                    ((eq (car elt) 'phone) ; phone
                     (bbdb-tex-list
                      phone elt
                      (lambda (p)
                        (format "\\phone{%s}{%s}\n"
                                (bbdb-tex-field 'phone-label (bbdb-phone-label p))
                                (bbdb-tex-field 'phone (bbdb-phone-string p))))))

                    ((eq (car elt) 'xfields) ; list of xfields
                     (bbdb-tex-list
                      (bbdb-record-field record 'xfields)
                      elt
                      (lambda (x)
                        (format "\\xfield{%s}{%s}\n"
                                (bbdb-tex-field 'xfield-label (symbol-name (car x)))
                                (bbdb-tex-field 'xfield (cdr x))))))

                    ((symbolp elt) ; xfield as single string
                     ;; The value of an xfield may be a sexp instead of a string.
                     ;; Ideally, a sexp should be formatted by `pp-to-string',
                     ;; then printed verbatim.
                     (let ((val (format "%s" (bbdb-record-field record elt))))
                       (if val
                           (insert (format "\\xfield{%s}{%s}\n" elt
                                           (bbdb-tex-field elt (bbdb-concat elt val)))))))

                    ((consp elt) ; xfield as list of strings
                     (bbdb-tex-list
                      (bbdb-split (car elt)
                                  (format "%s" (bbdb-record-field record (car elt))))
                      elt
                      `(lambda (x)
                         (format "\\xfield{%s}{%s}\n" ',(car elt)
                                 (bbdb-tex-field ',(car elt) x)))))

                    (t (error "Rule `%s' undefined" elt)))))))

      ;; Epilog
      (let ((epilog (nth 1 (assq 'epilog rule))))
        (when epilog
          (insert "% begin BBDB epilog\n" epilog)
          (unless (bolp) (insert "\n"))))))
  (setq buffer-undo-list nil)
  (save-buffer))

(provide 'bbdb-tex)

;;; bbdb-tex.el ends here
bbdb-20200102.403/bbdb-rmail.el0000644000175000017500000000331413643253537013223 0ustar  cbcb;;; bbdb-rmail.el --- BBDB interface to Rmail -*- lexical-binding: t -*-

;; Copyright (C) 2010-2018  Free Software Foundation, Inc.

;; This file is part of the Insidious Big Brother Database (aka BBDB),

;; BBDB 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.

;; BBDB 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 BBDB.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;; This file contains the BBDB interface to Rmail.
;;; See the BBDB info manual for documentation.

;;; Code:

(require 'bbdb)
(require 'bbdb-com)
(require 'bbdb-mua)
(require 'rmailsum)

;;;###autoload
(defun bbdb-insinuate-rmail ()
  "Hook BBDB into RMAIL.
Do not call this in your init file.  Use `bbdb-initialize'."
  ;; Do we need keybindings for more commands?  Suggestions welcome.
  ;; (define-key rmail-mode-map ":" 'bbdb-mua-display-records)
  ;; (define-key rmail-mode-map "'" 'bbdb-mua-display-recipients)
  (define-key rmail-mode-map ":" 'bbdb-mua-display-sender)
  (define-key rmail-mode-map ";" 'bbdb-mua-edit-field-sender)
  ;; (define-key rmail-mode-map ";" 'bbdb-mua-edit-field-recipients)
  (define-key rmail-summary-mode-map ":" 'bbdb-mua-display-sender)
  (define-key rmail-summary-mode-map ";" 'bbdb-mua-edit-field-sender))

(provide 'bbdb-rmail)

;;; bbdb-rmail.el ends here
bbdb-20200102.403/bbdb-site.el0000644000175000017500000000341013643253540013052 0ustar  cbcb;;; bbdb-site.el.in --- site-specific variables for BBDB -*- lexical-binding: t -*-

;; Copyright (C) 2010-2017  Free Software Foundation, Inc.

;; This file is part of the Insidious Big Brother Database (aka BBDB),

;; BBDB 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.

;; BBDB 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 BBDB.  If not, see <http://www.gnu.org/licenses/>.

;;; Code:

(defconst bbdb-version "@PACKAGE_VERSION@" "Version of BBDB.")

(if (< emacs-major-version 24)
  (error "BBDB %s requires GNU Emacs 24 or later" bbdb-version))

(defcustom bbdb-tex-path
  (let* ((default "@pkgdatadir@")
         (dir (cond ((file-accessible-directory-p default)
                     default)
                    (load-file-name
                     (expand-file-name "tex/" (file-name-directory load-file-name)))
                    (t
                     (let ((f (locate-file "tex/bbdb.sty" load-path)))
                       (if f (file-name-directory f)))))))
    (if dir (list dir)))
  "List of directories with the BBDB TeX files.
If this is t assume that these files reside in directories
that are part of the regular TeX search path."
  :group 'bbdb-utilities-tex
  :type '(choice (const :tag "Files in TeX path" t)
                 (repeat (directory :tag "Directory"))))

(provide 'bbdb-site)

;;; bbdb-site.el.in ends here
bbdb-20200102.403/bbdb-anniv.el0000644000175000017500000002453713643253540013236 0ustar  cbcb;;; bbdb-anniv.el --- get anniversaries from BBDB -*- lexical-binding: t -*-

;; Copyright (C) 2011-2017  Free Software Foundation, Inc.

;; This file is part of the Insidious Big Brother Database (aka BBDB),

;; BBDB 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.

;; BBDB 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 BBDB.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;; Anniversaries are stored in xfields as defined via `bbdb-anniv-alist'.
;; Each such field may contain multiple anniversaries entries with separators
;; defined via `bbdb-separator-alist' (newlines by default).
;; Each anniversary entry is a string DATE followed by optional TEXT.
;; DATE may take the same format as the date of ordinary diary entries.
;; In particular, `calendar-date-style' is obeyed via `diary-date-forms'.
;; If `bbdb-anniv-alist' has a non-nil FORM for this type of anniversary,
;; FORM is used to display the anniversary entry in the diary buffer.
;; If FORM is nil, TEXT is used instead to display the anniversary entry
;; in the diary buffer.
;;
;; To display BBDB anniversaries in the Emacs diary,
;; call `bbdb-initialize' with arg `anniv'.
;;
;; See the BBDB info manual for documentation.

;;; Code:

(require 'bbdb)
(require 'bbdb-com)
(require 'diary-lib)
(eval-when-compile
  (require 'cl-lib))

(defcustom bbdb-anniv-alist
  '((birthday . "%n's %d%s birthday")
    (wedding  . "%n's %d%s wedding anniversary")
    (anniversary))
  "Alist of rules for formatting anniversaries in the diary buffer.
Each element is of the form (LABEL . FORM).
LABEL is the xfield where this type of anniversaries is stored.
FORM is a format string with the following substitutions:
  %n  name of the record
  %d  number of years
  %s  ordinal suffix (st, nd, rd, th) for the year.
  %t  the optional text following the date string in field LABEL.
If FORM is nil, use the text following the date string in field LABEL
as format string."
  :type '(repeat (cons :tag "Rule"
                       (symbol :tag "Label")
                       (choice (string)
                               (const nil))))
  :group 'bbdb-utilities-anniv)

;; `bbdb-anniv-diary-entries' becomes a member of  `diary-list-entries-hook'.
;; When this hook is run by `diary-list-entries', the variable `original-date'
;; is bound to the value of arg DATE of `diary-list-entries'.
;; Also, `number' is arg NUMBER of `diary-list-entries'.
;; `diary-list-entries' selects the entries for NUMBER days starting with DATE.

(defvar original-date) ; defined in diary-lib
(with-no-warnings (defvar number)) ; defined in diary-lib

;;;###autoload
(defun bbdb-anniv-diary-entries ()
  "Add anniversaries from BBDB records to `diary-list-entries'.
This obeys `calendar-date-style' via `diary-date-forms'.
To enable this feature, put the following into your .emacs:

 \(add-hook 'diary-list-entries-hook 'bbdb-anniv-diary-entries)"
  ;; Loop over NUMBER dates starting from ORGINAL-DATE.
  (let* ((num-date (1- (calendar-absolute-from-gregorian original-date)))
         (end-date (+ num-date number)))
    (while (<= (setq num-date (1+ num-date)) end-date)
      (let* ((date (calendar-gregorian-from-absolute num-date))
             (dd (calendar-extract-day date))
             (mm (calendar-extract-month date))
             (yy (calendar-extract-year date))
             ;; We construct a regexp that only uses shy groups,
             ;; except for the part of the regexp matching the year.
             ;; This way we can grab the year from the date string.
             (year "\\([0-9]+\\)\\|\\*")
             (dayname (format "%s\\|%s\\.?" (calendar-day-name date)
                              (calendar-day-name date 'abbrev)))
             (lex-env `((day . ,(format "0*%d" dd))
                        (month . ,(format "0*%d" mm)) (year . ,year)
                        (dayname . ,dayname)
                        (monthname . ,(format "%s\\|%s" (calendar-month-name mm)
                                              (calendar-month-name mm 'abbrev)))))
             ;; Require that the matched date is at the beginning of the string.
             (fmt (format "\\`%s?\\(?:%%s\\)"
                          (regexp-quote diary-nonmarking-symbol)))
             date-forms)

        (cl-flet ((fun (date-form)
                       (push (cons (format fmt
                                           (mapconcat (lambda (form) (eval form lex-env))
                                                      (if (eq (car date-form) 'backup)
                                                          (cdr date-form) date-form)
                                                      "\\)\\(?:"))
                                   (eq (car date-form) 'backup))
                             date-forms)))
          (mapc #'fun diary-date-forms)

          ;; The anniversary of February 29 is considered to be March 1
          ;; in non-leap years.  So we search for February 29, too.
          (when (and (= mm 3) (= dd 1)
                     (not (calendar-leap-year-p yy)))
            (setq lex-env `((day . "0*29") (month . "0*2") (year . ,year)
                            (dayname . ,dayname)
                            (monthname . ,(format "%s\\|%s" (calendar-month-name 2)
                                                  (calendar-month-name 2 'abbrev)))))
            (mapc #'fun diary-date-forms)))

        (dolist (record (bbdb-records))
          (dolist (rule bbdb-anniv-alist)
            (dolist (anniv (bbdb-record-xfield-split record (car rule)))
              (let ((date-forms date-forms)
                    (anniv-string (concat anniv " X")) ; for backup forms
                    (case-fold-search t)
                    form yr text)
                (while (setq form (pop date-forms))
                  (when (string-match (car form) anniv-string)
                    (setq date-forms nil
                          yr (match-string 1 anniv-string)
                          yr (if (and yr (string-match-p "[0-9]+" yr))
                                 (- yy (string-to-number yr))
                               100) ; as in `diary-anniversary'
                          ;; For backup forms we should search backward in
                          ;; anniv-string from (match-end 0) for "\\<".
                          ;; That gets too complicated here!
                          ;; Yet for the default value of `diary-date-forms'
                          ;; this would matter only if anniv-string started
                          ;; with a time. That is rather rare for anniversaries.
                          ;; Then we may simply step backward by one character.
                          text (substring anniv-string (if (cdr form) ; backup
                                                           (1- (match-end 0))
                                                         (match-end 0))
                                          -1)
                          text (replace-regexp-in-string "\\`[ \t]+" "" text)
                          text (replace-regexp-in-string "[ \t]+\\'" "" text))
                    (if (cdr rule)
                        (setq text (replace-regexp-in-string "%t" text (cdr rule))))
                    ;; Add the anniversaries to `diary-entries-list'.
                    (if (and (numberp yr) (< 0 (length text)))
                        (diary-add-to-list
                         date
                         ;; `diary-add-to-list' expects an arg SPECIFIER for being
                         ;; able to jump to the location of the entry in the diary
                         ;; file.  Here we only have BBDB records.  So we use
                         ;; an empty string for SPECIFIER, but instead we `propertize'
                         ;; the STRING passed to `diary-add-to-list'.
                         (propertize
                          (format
                           ;; Text substitution similar to `diary-anniversary'.
                           (replace-regexp-in-string "%n" (bbdb-record-name record) text)
                           yr (diary-ordinal-suffix yr))
                          'diary-goto-entry (list 'bbdb-display-records (list record)))
                         ""))))))))))))

;; based on `diary-goto-entry'
(defun bbdb-anniv-goto-entry (button)
  "Jump to the diary entry for the BUTTON at point.
The character at point may have a text property `diary-goto-entry'
which should be a list (FUNCTION ARG1 ARG2 ...).  Then call FUNCTION
with args ARG1, ARG2, ... to locate the entry.  Otherwise follow
the rules used by `diary-goto-entry'."
  (let* ((fun-call (get-text-property (overlay-start button)
                                      'diary-goto-entry))
         (locator (button-get button 'locator))
         (marker (car locator))
         markbuf file)
    (cond (fun-call
           (apply (car fun-call) (cdr fun-call)))
          ;; If marker pointing to diary location is valid, use that.
          ((and marker (setq markbuf (marker-buffer marker)))
           (pop-to-buffer markbuf)
           (goto-char (marker-position marker)))
          ;; Marker is invalid (eg buffer has been killed).
          ((and (setq file (cadr locator))
                (file-exists-p file)
                (find-file-other-window file))
           (when (eq major-mode (default-value 'major-mode)) (diary-mode))
           (goto-char (point-min))
           (if (re-search-forward (format "%s.*\\(%s\\)"
                                          (regexp-quote (nth 2 locator))
                                          (regexp-quote (nth 3 locator)))
                                  nil t)
               (goto-char (match-beginning 1))))
          (t
           (message "Unable to locate this diary entry")))))

;; `diary-goto-entry-function' is rather inflexible if multiple packages
;; want to use it for its purposes: this variable can be hijacked
;; only once.  Here our function `bbdb-anniv-goto-entry' should work
;; for other packages, too.
(setq diary-goto-entry-function 'bbdb-anniv-goto-entry)

(provide 'bbdb-anniv)

;;; bbdb-anniv.el ends here
bbdb-20200102.403/bbdb.info0000644000175000017500000017723513643253540012464 0ustar  cbcbThis is bbdb.info, produced by makeinfo version 6.5 from bbdb.texi.

This file documents the Insidious Big Brother Database (BBDB)

   Copyright (C) 2011-2017 Free Software Foundation, Inc.

     Permission is granted to copy, distribute and/or modify this
     document under the terms of the GNU Free Documentation License,
     Version 1.3 or any later version published by the Free Software
     Foundation; with the Invariant Section being "GNU GENERAL PUBLIC
     LICENSE," A copy of the license is included in the section entitled
     "GNU Free Documentation License."
INFO-DIR-SECTION Emacs misc features
START-INFO-DIR-ENTRY
* BBDB: (bbdb).                 Insidious Big Brother Database (BBDB).
END-INFO-DIR-ENTRY


File: bbdb.info,  Node: Top,  Next: First Chapter,  Prev: (dir),  Up: (dir)

BBDB User Manual
****************

This file documents the Insidious Big Brother Database (BBDB)

   Copyright (C) 2011-2017 Free Software Foundation, Inc.

     Permission is granted to copy, distribute and/or modify this
     document under the terms of the GNU Free Documentation License,
     Version 1.3 or any later version published by the Free Software
     Foundation; with the Invariant Section being "GNU GENERAL PUBLIC
     LICENSE," A copy of the license is included in the section entitled
     "GNU Free Documentation License."

* Menu:

* First Chapter::               The first chapter is the only chapter
                         in this sample.

Appendices
* Copying::                     The GNU General Public License gives you permission
                         to redistribute GNU Emacs on certain terms;
                         it also explains that there is no warranty.
* GNU Free Documentation License::  The license for this documentation.
* Index::                       Complete index.





File: bbdb.info,  Node: First Chapter,  Next: Copying,  Prev: Top,  Up: Top

1 First Chapter
***************

This is the first chapter.

   Here is a numbered list.

  1. This is the first item.

  2. This is the second item.


File: bbdb.info,  Node: Copying,  Next: GNU Free Documentation License,  Prev: First Chapter,  Up: Top

Appendix A GNU GENERAL PUBLIC LICENSE
*************************************

                        Version 3, 29 June 2007

     Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>

     Everyone is permitted to copy and distribute verbatim copies of this
     license document, but changing it is not allowed.

Preamble
========

The GNU General Public License is a free, copyleft license for software
and other kinds of works.

   The licenses for most software and other practical works are designed
to take away your freedom to share and change the works.  By contrast,
the GNU General Public License is intended to guarantee your freedom to
share and change all versions of a program--to make sure it remains free
software for all its users.  We, the Free Software Foundation, use the
GNU General Public License for most of our software; it applies also to
any other work released this way by its authors.  You can apply it to
your programs, too.

   When we speak of free software, we are referring to freedom, not
price.  Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
them if you wish), that you receive source code or can get it if you
want it, that you can change the software or use pieces of it in new
free programs, and that you know you can do these things.

   To protect your rights, we need to prevent others from denying you
these rights or asking you to surrender the rights.  Therefore, you have
certain responsibilities if you distribute copies of the software, or if
you modify it: responsibilities to respect the freedom of others.

   For example, if you distribute copies of such a program, whether
gratis or for a fee, you must pass on to the recipients the same
freedoms that you received.  You must make sure that they, too, receive
or can get the source code.  And you must show them these terms so they
know their rights.

   Developers that use the GNU GPL protect your rights with two steps:
(1) assert copyright on the software, and (2) offer you this License
giving you legal permission to copy, distribute and/or modify it.

   For the developers' and authors' protection, the GPL clearly explains
that there is no warranty for this free software.  For both users' and
authors' sake, the GPL requires that modified versions be marked as
changed, so that their problems will not be attributed erroneously to
authors of previous versions.

   Some devices are designed to deny users access to install or run
modified versions of the software inside them, although the manufacturer
can do so.  This is fundamentally incompatible with the aim of
protecting users' freedom to change the software.  The systematic
pattern of such abuse occurs in the area of products for individuals to
use, which is precisely where it is most unacceptable.  Therefore, we
have designed this version of the GPL to prohibit the practice for those
products.  If such problems arise substantially in other domains, we
stand ready to extend this provision to those domains in future versions
of the GPL, as needed to protect the freedom of users.

   Finally, every program is threatened constantly by software patents.
States should not allow patents to restrict development and use of
software on general-purpose computers, but in those that do, we wish to
avoid the special danger that patents applied to a free program could
make it effectively proprietary.  To prevent this, the GPL assures that
patents cannot be used to render the program non-free.

   The precise terms and conditions for copying, distribution and
modification follow.

TERMS AND CONDITIONS
====================

  0. Definitions.

     "This License" refers to version 3 of the GNU General Public
     License.

     "Copyright" also means copyright-like laws that apply to other
     kinds of works, such as semiconductor masks.

     "The Program" refers to any copyrightable work licensed under this
     License.  Each licensee is addressed as "you".  "Licensees" and
     "recipients" may be individuals or organizations.

     To "modify" a work means to copy from or adapt all or part of the
     work in a fashion requiring copyright permission, other than the
     making of an exact copy.  The resulting work is called a "modified
     version" of the earlier work or a work "based on" the earlier work.

     A "covered work" means either the unmodified Program or a work
     based on the Program.

     To "propagate" a work means to do anything with it that, without
     permission, would make you directly or secondarily liable for
     infringement under applicable copyright law, except executing it on
     a computer or modifying a private copy.  Propagation includes
     copying, distribution (with or without modification), making
     available to the public, and in some countries other activities as
     well.

     To "convey" a work means any kind of propagation that enables other
     parties to make or receive copies.  Mere interaction with a user
     through a computer network, with no transfer of a copy, is not
     conveying.

     An interactive user interface displays "Appropriate Legal Notices"
     to the extent that it includes a convenient and prominently visible
     feature that (1) displays an appropriate copyright notice, and (2)
     tells the user that there is no warranty for the work (except to
     the extent that warranties are provided), that licensees may convey
     the work under this License, and how to view a copy of this
     License.  If the interface presents a list of user commands or
     options, such as a menu, a prominent item in the list meets this
     criterion.

  1. Source Code.

     The "source code" for a work means the preferred form of the work
     for making modifications to it.  "Object code" means any non-source
     form of a work.

     A "Standard Interface" means an interface that either is an
     official standard defined by a recognized standards body, or, in
     the case of interfaces specified for a particular programming
     language, one that is widely used among developers working in that
     language.

     The "System Libraries" of an executable work include anything,
     other than the work as a whole, that (a) is included in the normal
     form of packaging a Major Component, but which is not part of that
     Major Component, and (b) serves only to enable use of the work with
     that Major Component, or to implement a Standard Interface for
     which an implementation is available to the public in source code
     form.  A "Major Component", in this context, means a major
     essential component (kernel, window system, and so on) of the
     specific operating system (if any) on which the executable work
     runs, or a compiler used to produce the work, or an object code
     interpreter used to run it.

     The "Corresponding Source" for a work in object code form means all
     the source code needed to generate, install, and (for an executable
     work) run the object code and to modify the work, including scripts
     to control those activities.  However, it does not include the
     work's System Libraries, or general-purpose tools or generally
     available free programs which are used unmodified in performing
     those activities but which are not part of the work.  For example,
     Corresponding Source includes interface definition files associated
     with source files for the work, and the source code for shared
     libraries and dynamically linked subprograms that the work is
     specifically designed to require, such as by intimate data
     communication or control flow between those subprograms and other
     parts of the work.

     The Corresponding Source need not include anything that users can
     regenerate automatically from other parts of the Corresponding
     Source.

     The Corresponding Source for a work in source code form is that
     same work.

  2. Basic Permissions.

     All rights granted under this License are granted for the term of
     copyright on the Program, and are irrevocable provided the stated
     conditions are met.  This License explicitly affirms your unlimited
     permission to run the unmodified Program.  The output from running
     a covered work is covered by this License only if the output, given
     its content, constitutes a covered work.  This License acknowledges
     your rights of fair use or other equivalent, as provided by
     copyright law.

     You may make, run and propagate covered works that you do not
     convey, without conditions so long as your license otherwise
     remains in force.  You may convey covered works to others for the
     sole purpose of having them make modifications exclusively for you,
     or provide you with facilities for running those works, provided
     that you comply with the terms of this License in conveying all
     material for which you do not control copyright.  Those thus making
     or running the covered works for you must do so exclusively on your
     behalf, under your direction and control, on terms that prohibit
     them from making any copies of your copyrighted material outside
     their relationship with you.

     Conveying under any other circumstances is permitted solely under
     the conditions stated below.  Sublicensing is not allowed; section
     10 makes it unnecessary.

  3. Protecting Users' Legal Rights From Anti-Circumvention Law.

     No covered work shall be deemed part of an effective technological
     measure under any applicable law fulfilling obligations under
     article 11 of the WIPO copyright treaty adopted on 20 December
     1996, or similar laws prohibiting or restricting circumvention of
     such measures.

     When you convey a covered work, you waive any legal power to forbid
     circumvention of technological measures to the extent such
     circumvention is effected by exercising rights under this License
     with respect to the covered work, and you disclaim any intention to
     limit operation or modification of the work as a means of
     enforcing, against the work's users, your or third parties' legal
     rights to forbid circumvention of technological measures.

  4. Conveying Verbatim Copies.

     You may convey verbatim copies of the Program's source code as you
     receive it, in any medium, provided that you conspicuously and
     appropriately publish on each copy an appropriate copyright notice;
     keep intact all notices stating that this License and any
     non-permissive terms added in accord with section 7 apply to the
     code; keep intact all notices of the absence of any warranty; and
     give all recipients a copy of this License along with the Program.

     You may charge any price or no price for each copy that you convey,
     and you may offer support or warranty protection for a fee.

  5. Conveying Modified Source Versions.

     You may convey a work based on the Program, or the modifications to
     produce it from the Program, in the form of source code under the
     terms of section 4, provided that you also meet all of these
     conditions:

       a. The work must carry prominent notices stating that you
          modified it, and giving a relevant date.

       b. The work must carry prominent notices stating that it is
          released under this License and any conditions added under
          section 7.  This requirement modifies the requirement in
          section 4 to "keep intact all notices".

       c. You must license the entire work, as a whole, under this
          License to anyone who comes into possession of a copy.  This
          License will therefore apply, along with any applicable
          section 7 additional terms, to the whole of the work, and all
          its parts, regardless of how they are packaged.  This License
          gives no permission to license the work in any other way, but
          it does not invalidate such permission if you have separately
          received it.

       d. If the work has interactive user interfaces, each must display
          Appropriate Legal Notices; however, if the Program has
          interactive interfaces that do not display Appropriate Legal
          Notices, your work need not make them do so.

     A compilation of a covered work with other separate and independent
     works, which are not by their nature extensions of the covered
     work, and which are not combined with it such as to form a larger
     program, in or on a volume of a storage or distribution medium, is
     called an "aggregate" if the compilation and its resulting
     copyright are not used to limit the access or legal rights of the
     compilation's users beyond what the individual works permit.
     Inclusion of a covered work in an aggregate does not cause this
     License to apply to the other parts of the aggregate.

  6. Conveying Non-Source Forms.

     You may convey a covered work in object code form under the terms
     of sections 4 and 5, provided that you also convey the
     machine-readable Corresponding Source under the terms of this
     License, in one of these ways:

       a. Convey the object code in, or embodied in, a physical product
          (including a physical distribution medium), accompanied by the
          Corresponding Source fixed on a durable physical medium
          customarily used for software interchange.

       b. Convey the object code in, or embodied in, a physical product
          (including a physical distribution medium), accompanied by a
          written offer, valid for at least three years and valid for as
          long as you offer spare parts or customer support for that
          product model, to give anyone who possesses the object code
          either (1) a copy of the Corresponding Source for all the
          software in the product that is covered by this License, on a
          durable physical medium customarily used for software
          interchange, for a price no more than your reasonable cost of
          physically performing this conveying of source, or (2) access
          to copy the Corresponding Source from a network server at no
          charge.

       c. Convey individual copies of the object code with a copy of the
          written offer to provide the Corresponding Source.  This
          alternative is allowed only occasionally and noncommercially,
          and only if you received the object code with such an offer,
          in accord with subsection 6b.

       d. Convey the object code by offering access from a designated
          place (gratis or for a charge), and offer equivalent access to
          the Corresponding Source in the same way through the same
          place at no further charge.  You need not require recipients
          to copy the Corresponding Source along with the object code.
          If the place to copy the object code is a network server, the
          Corresponding Source may be on a different server (operated by
          you or a third party) that supports equivalent copying
          facilities, provided you maintain clear directions next to the
          object code saying where to find the Corresponding Source.
          Regardless of what server hosts the Corresponding Source, you
          remain obligated to ensure that it is available for as long as
          needed to satisfy these requirements.

       e. Convey the object code using peer-to-peer transmission,
          provided you inform other peers where the object code and
          Corresponding Source of the work are being offered to the
          general public at no charge under subsection 6d.

     A separable portion of the object code, whose source code is
     excluded from the Corresponding Source as a System Library, need
     not be included in conveying the object code work.

     A "User Product" is either (1) a "consumer product", which means
     any tangible personal property which is normally used for personal,
     family, or household purposes, or (2) anything designed or sold for
     incorporation into a dwelling.  In determining whether a product is
     a consumer product, doubtful cases shall be resolved in favor of
     coverage.  For a particular product received by a particular user,
     "normally used" refers to a typical or common use of that class of
     product, regardless of the status of the particular user or of the
     way in which the particular user actually uses, or expects or is
     expected to use, the product.  A product is a consumer product
     regardless of whether the product has substantial commercial,
     industrial or non-consumer uses, unless such uses represent the
     only significant mode of use of the product.

     "Installation Information" for a User Product means any methods,
     procedures, authorization keys, or other information required to
     install and execute modified versions of a covered work in that
     User Product from a modified version of its Corresponding Source.
     The information must suffice to ensure that the continued
     functioning of the modified object code is in no case prevented or
     interfered with solely because modification has been made.

     If you convey an object code work under this section in, or with,
     or specifically for use in, a User Product, and the conveying
     occurs as part of a transaction in which the right of possession
     and use of the User Product is transferred to the recipient in
     perpetuity or for a fixed term (regardless of how the transaction
     is characterized), the Corresponding Source conveyed under this
     section must be accompanied by the Installation Information.  But
     this requirement does not apply if neither you nor any third party
     retains the ability to install modified object code on the User
     Product (for example, the work has been installed in ROM).

     The requirement to provide Installation Information does not
     include a requirement to continue to provide support service,
     warranty, or updates for a work that has been modified or installed
     by the recipient, or for the User Product in which it has been
     modified or installed.  Access to a network may be denied when the
     modification itself materially and adversely affects the operation
     of the network or violates the rules and protocols for
     communication across the network.

     Corresponding Source conveyed, and Installation Information
     provided, in accord with this section must be in a format that is
     publicly documented (and with an implementation available to the
     public in source code form), and must require no special password
     or key for unpacking, reading or copying.

  7. Additional Terms.

     "Additional permissions" are terms that supplement the terms of
     this License by making exceptions from one or more of its
     conditions.  Additional permissions that are applicable to the
     entire Program shall be treated as though they were included in
     this License, to the extent that they are valid under applicable
     law.  If additional permissions apply only to part of the Program,
     that part may be used separately under those permissions, but the
     entire Program remains governed by this License without regard to
     the additional permissions.

     When you convey a copy of a covered work, you may at your option
     remove any additional permissions from that copy, or from any part
     of it.  (Additional permissions may be written to require their own
     removal in certain cases when you modify the work.)  You may place
     additional permissions on material, added by you to a covered work,
     for which you have or can give appropriate copyright permission.

     Notwithstanding any other provision of this License, for material
     you add to a covered work, you may (if authorized by the copyright
     holders of that material) supplement the terms of this License with
     terms:

       a. Disclaiming warranty or limiting liability differently from
          the terms of sections 15 and 16 of this License; or

       b. Requiring preservation of specified reasonable legal notices
          or author attributions in that material or in the Appropriate
          Legal Notices displayed by works containing it; or

       c. Prohibiting misrepresentation of the origin of that material,
          or requiring that modified versions of such material be marked
          in reasonable ways as different from the original version; or

       d. Limiting the use for publicity purposes of names of licensors
          or authors of the material; or

       e. Declining to grant rights under trademark law for use of some
          trade names, trademarks, or service marks; or

       f. Requiring indemnification of licensors and authors of that
          material by anyone who conveys the material (or modified
          versions of it) with contractual assumptions of liability to
          the recipient, for any liability that these contractual
          assumptions directly impose on those licensors and authors.

     All other non-permissive additional terms are considered "further
     restrictions" within the meaning of section 10.  If the Program as
     you received it, or any part of it, contains a notice stating that
     it is governed by this License along with a term that is a further
     restriction, you may remove that term.  If a license document
     contains a further restriction but permits relicensing or conveying
     under this License, you may add to a covered work material governed
     by the terms of that license document, provided that the further
     restriction does not survive such relicensing or conveying.

     If you add terms to a covered work in accord with this section, you
     must place, in the relevant source files, a statement of the
     additional terms that apply to those files, or a notice indicating
     where to find the applicable terms.

     Additional terms, permissive or non-permissive, may be stated in
     the form of a separately written license, or stated as exceptions;
     the above requirements apply either way.

  8. Termination.

     You may not propagate or modify a covered work except as expressly
     provided under this License.  Any attempt otherwise to propagate or
     modify it is void, and will automatically terminate your rights
     under this License (including any patent licenses granted under the
     third paragraph of section 11).

     However, if you cease all violation of this License, then your
     license from a particular copyright holder is reinstated (a)
     provisionally, unless and until the copyright holder explicitly and
     finally terminates your license, and (b) permanently, if the
     copyright holder fails to notify you of the violation by some
     reasonable means prior to 60 days after the cessation.

     Moreover, your license from a particular copyright holder is
     reinstated permanently if the copyright holder notifies you of the
     violation by some reasonable means, this is the first time you have
     received notice of violation of this License (for any work) from
     that copyright holder, and you cure the violation prior to 30 days
     after your receipt of the notice.

     Termination of your rights under this section does not terminate
     the licenses of parties who have received copies or rights from you
     under this License.  If your rights have been terminated and not
     permanently reinstated, you do not qualify to receive new licenses
     for the same material under section 10.

  9. Acceptance Not Required for Having Copies.

     You are not required to accept this License in order to receive or
     run a copy of the Program.  Ancillary propagation of a covered work
     occurring solely as a consequence of using peer-to-peer
     transmission to receive a copy likewise does not require
     acceptance.  However, nothing other than this License grants you
     permission to propagate or modify any covered work.  These actions
     infringe copyright if you do not accept this License.  Therefore,
     by modifying or propagating a covered work, you indicate your
     acceptance of this License to do so.

  10. Automatic Licensing of Downstream Recipients.

     Each time you convey a covered work, the recipient automatically
     receives a license from the original licensors, to run, modify and
     propagate that work, subject to this License.  You are not
     responsible for enforcing compliance by third parties with this
     License.

     An "entity transaction" is a transaction transferring control of an
     organization, or substantially all assets of one, or subdividing an
     organization, or merging organizations.  If propagation of a
     covered work results from an entity transaction, each party to that
     transaction who receives a copy of the work also receives whatever
     licenses to the work the party's predecessor in interest had or
     could give under the previous paragraph, plus a right to possession
     of the Corresponding Source of the work from the predecessor in
     interest, if the predecessor has it or can get it with reasonable
     efforts.

     You may not impose any further restrictions on the exercise of the
     rights granted or affirmed under this License.  For example, you
     may not impose a license fee, royalty, or other charge for exercise
     of rights granted under this License, and you may not initiate
     litigation (including a cross-claim or counterclaim in a lawsuit)
     alleging that any patent claim is infringed by making, using,
     selling, offering for sale, or importing the Program or any portion
     of it.

  11. Patents.

     A "contributor" is a copyright holder who authorizes use under this
     License of the Program or a work on which the Program is based.
     The work thus licensed is called the contributor's "contributor
     version".

     A contributor's "essential patent claims" are all patent claims
     owned or controlled by the contributor, whether already acquired or
     hereafter acquired, that would be infringed by some manner,
     permitted by this License, of making, using, or selling its
     contributor version, but do not include claims that would be
     infringed only as a consequence of further modification of the
     contributor version.  For purposes of this definition, "control"
     includes the right to grant patent sublicenses in a manner
     consistent with the requirements of this License.

     Each contributor grants you a non-exclusive, worldwide,
     royalty-free patent license under the contributor's essential
     patent claims, to make, use, sell, offer for sale, import and
     otherwise run, modify and propagate the contents of its contributor
     version.

     In the following three paragraphs, a "patent license" is any
     express agreement or commitment, however denominated, not to
     enforce a patent (such as an express permission to practice a
     patent or covenant not to sue for patent infringement).  To "grant"
     such a patent license to a party means to make such an agreement or
     commitment not to enforce a patent against the party.

     If you convey a covered work, knowingly relying on a patent
     license, and the Corresponding Source of the work is not available
     for anyone to copy, free of charge and under the terms of this
     License, through a publicly available network server or other
     readily accessible means, then you must either (1) cause the
     Corresponding Source to be so available, or (2) arrange to deprive
     yourself of the benefit of the patent license for this particular
     work, or (3) arrange, in a manner consistent with the requirements
     of this License, to extend the patent license to downstream
     recipients.  "Knowingly relying" means you have actual knowledge
     that, but for the patent license, your conveying the covered work
     in a country, or your recipient's use of the covered work in a
     country, would infringe one or more identifiable patents in that
     country that you have reason to believe are valid.

     If, pursuant to or in connection with a single transaction or
     arrangement, you convey, or propagate by procuring conveyance of, a
     covered work, and grant a patent license to some of the parties
     receiving the covered work authorizing them to use, propagate,
     modify or convey a specific copy of the covered work, then the
     patent license you grant is automatically extended to all
     recipients of the covered work and works based on it.

     A patent license is "discriminatory" if it does not include within
     the scope of its coverage, prohibits the exercise of, or is
     conditioned on the non-exercise of one or more of the rights that
     are specifically granted under this License.  You may not convey a
     covered work if you are a party to an arrangement with a third
     party that is in the business of distributing software, under which
     you make payment to the third party based on the extent of your
     activity of conveying the work, and under which the third party
     grants, to any of the parties who would receive the covered work
     from you, a discriminatory patent license (a) in connection with
     copies of the covered work conveyed by you (or copies made from
     those copies), or (b) primarily for and in connection with specific
     products or compilations that contain the covered work, unless you
     entered into that arrangement, or that patent license was granted,
     prior to 28 March 2007.

     Nothing in this License shall be construed as excluding or limiting
     any implied license or other defenses to infringement that may
     otherwise be available to you under applicable patent law.

  12. No Surrender of Others' Freedom.

     If conditions are imposed on you (whether by court order, agreement
     or otherwise) that contradict the conditions of this License, they
     do not excuse you from the conditions of this License.  If you
     cannot convey a covered work so as to satisfy simultaneously your
     obligations under this License and any other pertinent obligations,
     then as a consequence you may not convey it at all.  For example,
     if you agree to terms that obligate you to collect a royalty for
     further conveying from those to whom you convey the Program, the
     only way you could satisfy both those terms and this License would
     be to refrain entirely from conveying the Program.

  13. Use with the GNU Affero General Public License.

     Notwithstanding any other provision of this License, you have
     permission to link or combine any covered work with a work licensed
     under version 3 of the GNU Affero General Public License into a
     single combined work, and to convey the resulting work.  The terms
     of this License will continue to apply to the part which is the
     covered work, but the special requirements of the GNU Affero
     General Public License, section 13, concerning interaction through
     a network will apply to the combination as such.

  14. Revised Versions of this License.

     The Free Software Foundation may publish revised and/or new
     versions of the GNU General Public License from time to time.  Such
     new versions will be similar in spirit to the present version, but
     may differ in detail to address new problems or concerns.

     Each version is given a distinguishing version number.  If the
     Program specifies that a certain numbered version of the GNU
     General Public License "or any later version" applies to it, you
     have the option of following the terms and conditions either of
     that numbered version or of any later version published by the Free
     Software Foundation.  If the Program does not specify a version
     number of the GNU General Public License, you may choose any
     version ever published by the Free Software Foundation.

     If the Program specifies that a proxy can decide which future
     versions of the GNU General Public License can be used, that
     proxy's public statement of acceptance of a version permanently
     authorizes you to choose that version for the Program.

     Later license versions may give you additional or different
     permissions.  However, no additional obligations are imposed on any
     author or copyright holder as a result of your choosing to follow a
     later version.

  15. Disclaimer of Warranty.

     THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
     APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE
     COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS"
     WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED,
     INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
     MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE
     RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.
     SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
     NECESSARY SERVICING, REPAIR OR CORRECTION.

  16. Limitation of Liability.

     IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
     WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES
     AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR
     DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
     CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
     THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA
     BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
     PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
     PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF
     THE POSSIBILITY OF SUCH DAMAGES.

  17. Interpretation of Sections 15 and 16.

     If the disclaimer of warranty and limitation of liability provided
     above cannot be given local legal effect according to their terms,
     reviewing courts shall apply local law that most closely
     approximates an absolute waiver of all civil liability in
     connection with the Program, unless a warranty or assumption of
     liability accompanies a copy of the Program in return for a fee.

END OF TERMS AND CONDITIONS
===========================

How to Apply These Terms to Your New Programs
=============================================

If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.

   To do so, attach the following notices to the program.  It is safest
to attach them to the start of each source file to most effectively
state the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.

     ONE LINE TO GIVE THE PROGRAM'S NAME AND A BRIEF IDEA OF WHAT IT DOES.
     Copyright (C) YEAR NAME OF AUTHOR

     This program 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.

     This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.

   Also add information on how to contact you by electronic and paper
mail.

   If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:

     PROGRAM Copyright (C) YEAR NAME OF AUTHOR
     This program comes with ABSOLUTELY NO WARRANTY; for details type 'show w'.
     This is free software, and you are welcome to redistribute it
     under certain conditions; type 'show c' for details.

   The hypothetical commands 'show w' and 'show c' should show the
appropriate parts of the General Public License.  Of course, your
program's commands might be different; for a GUI interface, you would
use an "about box".

   You should also get your employer (if you work as a programmer) or
school, if any, to sign a "copyright disclaimer" for the program, if
necessary.  For more information on this, and how to apply and follow
the GNU GPL, see <http://www.gnu.org/licenses/>.

   The GNU General Public License does not permit incorporating your
program into proprietary programs.  If your program is a subroutine
library, you may consider it more useful to permit linking proprietary
applications with the library.  If this is what you want to do, use the
GNU Lesser General Public License instead of this License.  But first,
please read <http://www.gnu.org/philosophy/why-not-lgpl.html>.


File: bbdb.info,  Node: GNU Free Documentation License,  Next: Index,  Prev: Copying,  Up: Top

Appendix B GNU Free Documentation License
*****************************************

                     Version 1.3, 3 November 2008

     Copyright (C) 2000, 2001, 2002, 2007, 2008, 2009 Free Software Foundation, Inc.
     <http://fsf.org/>

     Everyone is permitted to copy and distribute verbatim copies
     of this license document, but changing it is not allowed.

  0. PREAMBLE

     The purpose of this License is to make a manual, textbook, or other
     functional and useful document "free" in the sense of freedom: to
     assure everyone the effective freedom to copy and redistribute it,
     with or without modifying it, either commercially or
     noncommercially.  Secondarily, this License preserves for the
     author and publisher a way to get credit for their work, while not
     being considered responsible for modifications made by others.

     This License is a kind of "copyleft", which means that derivative
     works of the document must themselves be free in the same sense.
     It complements the GNU General Public License, which is a copyleft
     license designed for free software.

     We have designed this License in order to use it for manuals for
     free software, because free software needs free documentation: a
     free program should come with manuals providing the same freedoms
     that the software does.  But this License is not limited to
     software manuals; it can be used for any textual work, regardless
     of subject matter or whether it is published as a printed book.  We
     recommend this License principally for works whose purpose is
     instruction or reference.

  1. APPLICABILITY AND DEFINITIONS

     This License applies to any manual or other work, in any medium,
     that contains a notice placed by the copyright holder saying it can
     be distributed under the terms of this License.  Such a notice
     grants a world-wide, royalty-free license, unlimited in duration,
     to use that work under the conditions stated herein.  The
     "Document", below, refers to any such manual or work.  Any member
     of the public is a licensee, and is addressed as "you".  You accept
     the license if you copy, modify or distribute the work in a way
     requiring permission under copyright law.

     A "Modified Version" of the Document means any work containing the
     Document or a portion of it, either copied verbatim, or with
     modifications and/or translated into another language.

     A "Secondary Section" is a named appendix or a front-matter section
     of the Document that deals exclusively with the relationship of the
     publishers or authors of the Document to the Document's overall
     subject (or to related matters) and contains nothing that could
     fall directly within that overall subject.  (Thus, if the Document
     is in part a textbook of mathematics, a Secondary Section may not
     explain any mathematics.)  The relationship could be a matter of
     historical connection with the subject or with related matters, or
     of legal, commercial, philosophical, ethical or political position
     regarding them.

     The "Invariant Sections" are certain Secondary Sections whose
     titles are designated, as being those of Invariant Sections, in the
     notice that says that the Document is released under this License.
     If a section does not fit the above definition of Secondary then it
     is not allowed to be designated as Invariant.  The Document may
     contain zero Invariant Sections.  If the Document does not identify
     any Invariant Sections then there are none.

     The "Cover Texts" are certain short passages of text that are
     listed, as Front-Cover Texts or Back-Cover Texts, in the notice
     that says that the Document is released under this License.  A
     Front-Cover Text may be at most 5 words, and a Back-Cover Text may
     be at most 25 words.

     A "Transparent" copy of the Document means a machine-readable copy,
     represented in a format whose specification is available to the
     general public, that is suitable for revising the document
     straightforwardly with generic text editors or (for images composed
     of pixels) generic paint programs or (for drawings) some widely
     available drawing editor, and that is suitable for input to text
     formatters or for automatic translation to a variety of formats
     suitable for input to text formatters.  A copy made in an otherwise
     Transparent file format whose markup, or absence of markup, has
     been arranged to thwart or discourage subsequent modification by
     readers is not Transparent.  An image format is not Transparent if
     used for any substantial amount of text.  A copy that is not
     "Transparent" is called "Opaque".

     Examples of suitable formats for Transparent copies include plain
     ASCII without markup, Texinfo input format, LaTeX input format,
     SGML or XML using a publicly available DTD, and standard-conforming
     simple HTML, PostScript or PDF designed for human modification.
     Examples of transparent image formats include PNG, XCF and JPG.
     Opaque formats include proprietary formats that can be read and
     edited only by proprietary word processors, SGML or XML for which
     the DTD and/or processing tools are not generally available, and
     the machine-generated HTML, PostScript or PDF produced by some word
     processors for output purposes only.

     The "Title Page" means, for a printed book, the title page itself,
     plus such following pages as are needed to hold, legibly, the
     material this License requires to appear in the title page.  For
     works in formats which do not have any title page as such, "Title
     Page" means the text near the most prominent appearance of the
     work's title, preceding the beginning of the body of the text.

     The "publisher" means any person or entity that distributes copies
     of the Document to the public.

     A section "Entitled XYZ" means a named subunit of the Document
     whose title either is precisely XYZ or contains XYZ in parentheses
     following text that translates XYZ in another language.  (Here XYZ
     stands for a specific section name mentioned below, such as
     "Acknowledgements", "Dedications", "Endorsements", or "History".)
     To "Preserve the Title" of such a section when you modify the
     Document means that it remains a section "Entitled XYZ" according
     to this definition.

     The Document may include Warranty Disclaimers next to the notice
     which states that this License applies to the Document.  These
     Warranty Disclaimers are considered to be included by reference in
     this License, but only as regards disclaiming warranties: any other
     implication that these Warranty Disclaimers may have is void and
     has no effect on the meaning of this License.

  2. VERBATIM COPYING

     You may copy and distribute the Document in any medium, either
     commercially or noncommercially, provided that this License, the
     copyright notices, and the license notice saying this License
     applies to the Document are reproduced in all copies, and that you
     add no other conditions whatsoever to those of this License.  You
     may not use technical measures to obstruct or control the reading
     or further copying of the copies you make or distribute.  However,
     you may accept compensation in exchange for copies.  If you
     distribute a large enough number of copies you must also follow the
     conditions in section 3.

     You may also lend copies, under the same conditions stated above,
     and you may publicly display copies.

  3. COPYING IN QUANTITY

     If you publish printed copies (or copies in media that commonly
     have printed covers) of the Document, numbering more than 100, and
     the Document's license notice requires Cover Texts, you must
     enclose the copies in covers that carry, clearly and legibly, all
     these Cover Texts: Front-Cover Texts on the front cover, and
     Back-Cover Texts on the back cover.  Both covers must also clearly
     and legibly identify you as the publisher of these copies.  The
     front cover must present the full title with all words of the title
     equally prominent and visible.  You may add other material on the
     covers in addition.  Copying with changes limited to the covers, as
     long as they preserve the title of the Document and satisfy these
     conditions, can be treated as verbatim copying in other respects.

     If the required texts for either cover are too voluminous to fit
     legibly, you should put the first ones listed (as many as fit
     reasonably) on the actual cover, and continue the rest onto
     adjacent pages.

     If you publish or distribute Opaque copies of the Document
     numbering more than 100, you must either include a machine-readable
     Transparent copy along with each Opaque copy, or state in or with
     each Opaque copy a computer-network location from which the general
     network-using public has access to download using public-standard
     network protocols a complete Transparent copy of the Document, free
     of added material.  If you use the latter option, you must take
     reasonably prudent steps, when you begin distribution of Opaque
     copies in quantity, to ensure that this Transparent copy will
     remain thus accessible at the stated location until at least one
     year after the last time you distribute an Opaque copy (directly or
     through your agents or retailers) of that edition to the public.

     It is requested, but not required, that you contact the authors of
     the Document well before redistributing any large number of copies,
     to give them a chance to provide you with an updated version of the
     Document.

  4. MODIFICATIONS

     You may copy and distribute a Modified Version of the Document
     under the conditions of sections 2 and 3 above, provided that you
     release the Modified Version under precisely this License, with the
     Modified Version filling the role of the Document, thus licensing
     distribution and modification of the Modified Version to whoever
     possesses a copy of it.  In addition, you must do these things in
     the Modified Version:

       A. Use in the Title Page (and on the covers, if any) a title
          distinct from that of the Document, and from those of previous
          versions (which should, if there were any, be listed in the
          History section of the Document).  You may use the same title
          as a previous version if the original publisher of that
          version gives permission.

       B. List on the Title Page, as authors, one or more persons or
          entities responsible for authorship of the modifications in
          the Modified Version, together with at least five of the
          principal authors of the Document (all of its principal
          authors, if it has fewer than five), unless they release you
          from this requirement.

       C. State on the Title page the name of the publisher of the
          Modified Version, as the publisher.

       D. Preserve all the copyright notices of the Document.

       E. Add an appropriate copyright notice for your modifications
          adjacent to the other copyright notices.

       F. Include, immediately after the copyright notices, a license
          notice giving the public permission to use the Modified
          Version under the terms of this License, in the form shown in
          the Addendum below.

       G. Preserve in that license notice the full lists of Invariant
          Sections and required Cover Texts given in the Document's
          license notice.

       H. Include an unaltered copy of this License.

       I. Preserve the section Entitled "History", Preserve its Title,
          and add to it an item stating at least the title, year, new
          authors, and publisher of the Modified Version as given on the
          Title Page.  If there is no section Entitled "History" in the
          Document, create one stating the title, year, authors, and
          publisher of the Document as given on its Title Page, then add
          an item describing the Modified Version as stated in the
          previous sentence.

       J. Preserve the network location, if any, given in the Document
          for public access to a Transparent copy of the Document, and
          likewise the network locations given in the Document for
          previous versions it was based on.  These may be placed in the
          "History" section.  You may omit a network location for a work
          that was published at least four years before the Document
          itself, or if the original publisher of the version it refers
          to gives permission.

       K. For any section Entitled "Acknowledgements" or "Dedications",
          Preserve the Title of the section, and preserve in the section
          all the substance and tone of each of the contributor
          acknowledgements and/or dedications given therein.

       L. Preserve all the Invariant Sections of the Document, unaltered
          in their text and in their titles.  Section numbers or the
          equivalent are not considered part of the section titles.

       M. Delete any section Entitled "Endorsements".  Such a section
          may not be included in the Modified Version.

       N. Do not retitle any existing section to be Entitled
          "Endorsements" or to conflict in title with any Invariant
          Section.

       O. Preserve any Warranty Disclaimers.

     If the Modified Version includes new front-matter sections or
     appendices that qualify as Secondary Sections and contain no
     material copied from the Document, you may at your option designate
     some or all of these sections as invariant.  To do this, add their
     titles to the list of Invariant Sections in the Modified Version's
     license notice.  These titles must be distinct from any other
     section titles.

     You may add a section Entitled "Endorsements", provided it contains
     nothing but endorsements of your Modified Version by various
     parties--for example, statements of peer review or that the text
     has been approved by an organization as the authoritative
     definition of a standard.

     You may add a passage of up to five words as a Front-Cover Text,
     and a passage of up to 25 words as a Back-Cover Text, to the end of
     the list of Cover Texts in the Modified Version.  Only one passage
     of Front-Cover Text and one of Back-Cover Text may be added by (or
     through arrangements made by) any one entity.  If the Document
     already includes a cover text for the same cover, previously added
     by you or by arrangement made by the same entity you are acting on
     behalf of, you may not add another; but you may replace the old
     one, on explicit permission from the previous publisher that added
     the old one.

     The author(s) and publisher(s) of the Document do not by this
     License give permission to use their names for publicity for or to
     assert or imply endorsement of any Modified Version.

  5. COMBINING DOCUMENTS

     You may combine the Document with other documents released under
     this License, under the terms defined in section 4 above for
     modified versions, provided that you include in the combination all
     of the Invariant Sections of all of the original documents,
     unmodified, and list them all as Invariant Sections of your
     combined work in its license notice, and that you preserve all
     their Warranty Disclaimers.

     The combined work need only contain one copy of this License, and
     multiple identical Invariant Sections may be replaced with a single
     copy.  If there are multiple Invariant Sections with the same name
     but different contents, make the title of each such section unique
     by adding at the end of it, in parentheses, the name of the
     original author or publisher of that section if known, or else a
     unique number.  Make the same adjustment to the section titles in
     the list of Invariant Sections in the license notice of the
     combined work.

     In the combination, you must combine any sections Entitled
     "History" in the various original documents, forming one section
     Entitled "History"; likewise combine any sections Entitled
     "Acknowledgements", and any sections Entitled "Dedications".  You
     must delete all sections Entitled "Endorsements."

  6. COLLECTIONS OF DOCUMENTS

     You may make a collection consisting of the Document and other
     documents released under this License, and replace the individual
     copies of this License in the various documents with a single copy
     that is included in the collection, provided that you follow the
     rules of this License for verbatim copying of each of the documents
     in all other respects.

     You may extract a single document from such a collection, and
     distribute it individually under this License, provided you insert
     a copy of this License into the extracted document, and follow this
     License in all other respects regarding verbatim copying of that
     document.

  7. AGGREGATION WITH INDEPENDENT WORKS

     A compilation of the Document or its derivatives with other
     separate and independent documents or works, in or on a volume of a
     storage or distribution medium, is called an "aggregate" if the
     copyright resulting from the compilation is not used to limit the
     legal rights of the compilation's users beyond what the individual
     works permit.  When the Document is included in an aggregate, this
     License does not apply to the other works in the aggregate which
     are not themselves derivative works of the Document.

     If the Cover Text requirement of section 3 is applicable to these
     copies of the Document, then if the Document is less than one half
     of the entire aggregate, the Document's Cover Texts may be placed
     on covers that bracket the Document within the aggregate, or the
     electronic equivalent of covers if the Document is in electronic
     form.  Otherwise they must appear on printed covers that bracket
     the whole aggregate.

  8. TRANSLATION

     Translation is considered a kind of modification, so you may
     distribute translations of the Document under the terms of section
     4.  Replacing Invariant Sections with translations requires special
     permission from their copyright holders, but you may include
     translations of some or all Invariant Sections in addition to the
     original versions of these Invariant Sections.  You may include a
     translation of this License, and all the license notices in the
     Document, and any Warranty Disclaimers, provided that you also
     include the original English version of this License and the
     original versions of those notices and disclaimers.  In case of a
     disagreement between the translation and the original version of
     this License or a notice or disclaimer, the original version will
     prevail.

     If a section in the Document is Entitled "Acknowledgements",
     "Dedications", or "History", the requirement (section 4) to
     Preserve its Title (section 1) will typically require changing the
     actual title.

  9. TERMINATION

     You may not copy, modify, sublicense, or distribute the Document
     except as expressly provided under this License.  Any attempt
     otherwise to copy, modify, sublicense, or distribute it is void,
     and will automatically terminate your rights under this License.

     However, if you cease all violation of this License, then your
     license from a particular copyright holder is reinstated (a)
     provisionally, unless and until the copyright holder explicitly and
     finally terminates your license, and (b) permanently, if the
     copyright holder fails to notify you of the violation by some
     reasonable means prior to 60 days after the cessation.

     Moreover, your license from a particular copyright holder is
     reinstated permanently if the copyright holder notifies you of the
     violation by some reasonable means, this is the first time you have
     received notice of violation of this License (for any work) from
     that copyright holder, and you cure the violation prior to 30 days
     after your receipt of the notice.

     Termination of your rights under this section does not terminate
     the licenses of parties who have received copies or rights from you
     under this License.  If your rights have been terminated and not
     permanently reinstated, receipt of a copy of some or all of the
     same material does not give you any rights to use it.

  10. FUTURE REVISIONS OF THIS LICENSE

     The Free Software Foundation may publish new, revised versions of
     the GNU Free Documentation License from time to time.  Such new
     versions will be similar in spirit to the present version, but may
     differ in detail to address new problems or concerns.  See
     <http://www.gnu.org/copyleft/>.

     Each version of the License is given a distinguishing version
     number.  If the Document specifies that a particular numbered
     version of this License "or any later version" applies to it, you
     have the option of following the terms and conditions either of
     that specified version or of any later version that has been
     published (not as a draft) by the Free Software Foundation.  If the
     Document does not specify a version number of this License, you may
     choose any version ever published (not as a draft) by the Free
     Software Foundation.  If the Document specifies that a proxy can
     decide which future versions of this License can be used, that
     proxy's public statement of acceptance of a version permanently
     authorizes you to choose that version for the Document.

  11. RELICENSING

     "Massive Multiauthor Collaboration Site" (or "MMC Site") means any
     World Wide Web server that publishes copyrightable works and also
     provides prominent facilities for anybody to edit those works.  A
     public wiki that anybody can edit is an example of such a server.
     A "Massive Multiauthor Collaboration" (or "MMC") contained in the
     site means any set of copyrightable works thus published on the MMC
     site.

     "CC-BY-SA" means the Creative Commons Attribution-Share Alike 3.0
     license published by Creative Commons Corporation, a not-for-profit
     corporation with a principal place of business in San Francisco,
     California, as well as future copyleft versions of that license
     published by that same organization.

     "Incorporate" means to publish or republish a Document, in whole or
     in part, as part of another Document.

     An MMC is "eligible for relicensing" if it is licensed under this
     License, and if all works that were first published under this
     License somewhere other than this MMC, and subsequently
     incorporated in whole or in part into the MMC, (1) had no cover
     texts or invariant sections, and (2) were thus incorporated prior
     to November 1, 2008.

     The operator of an MMC Site may republish an MMC contained in the
     site under CC-BY-SA on the same site at any time before August 1,
     2009, provided the MMC is eligible for relicensing.

ADDENDUM: How to use this License for your documents
====================================================

To use this License in a document you have written, include a copy of
the License in the document and put the following copyright and license
notices just after the title page:

       Copyright (C)  YEAR  YOUR NAME.
       Permission is granted to copy, distribute and/or modify this document
       under the terms of the GNU Free Documentation License, Version 1.3
       or any later version published by the Free Software Foundation;
       with no Invariant Sections, no Front-Cover Texts, and no Back-Cover
       Texts.  A copy of the license is included in the section entitled ``GNU
       Free Documentation License''.

   If you have Invariant Sections, Front-Cover Texts and Back-Cover
Texts, replace the "with...Texts."  line with this:

         with the Invariant Sections being LIST THEIR TITLES, with
         the Front-Cover Texts being LIST, and with the Back-Cover Texts
         being LIST.

   If you have Invariant Sections without Cover Texts, or some other
combination of the three, merge those two alternatives to suit the
situation.

   If your document contains nontrivial examples of program code, we
recommend releasing these examples in parallel under your choice of free
software license, such as the GNU General Public License, to permit
their use in free software.


File: bbdb.info,  Node: Index,  Prev: GNU Free Documentation License,  Up: Top

Index
*****

[index]
* Menu:

* chapter, first:                        First Chapter.         (line 6)
* index entry, another:                  First Chapter.         (line 6)



Tag Table:
Node: Top726
Node: First Chapter1827
Node: Copying2057
Node: GNU Free Documentation License39623
Node: Index64769

End Tag Table
bbdb-20200102.403/bbdb-mu4e.el0000644000175000017500000000304013643253540012757 0ustar  cbcb;;; bbdb-mu4e.el --- BBDB interface to mu4e -*- lexical-binding: t -*-

;; Copyright (C) 2015-2017  Free Software Foundation, Inc.

;; This file is part of the Insidious Big Brother Database (aka BBDB),

;; BBDB 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.

;; BBDB 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 BBDB.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;; This file contains the BBDB interface to mu4e.
;; See the BBDB info manual for documentation.

;;; Code:

(require 'bbdb)
(if t (require 'mu4e-view))

(defvar mu4e-view-mode-map)

;;;###autoload
(defun bbdb-insinuate-mu4e ()
  "Hook BBDB into mu4e.
Do not call this in your init file.  Use `bbdb-initialize'."
  ;; Tackle headers later
  ;; (define-key mu4e-headers-mode-map ":" 'bbdb-mua-display-sender)
  ;; (define-key mu4e-headers-mode-map ";" 'bbdb-mua-edit-field-sender)
  ;; Do we need keybindings for more commands?  Suggestions welcome.
  (define-key mu4e-view-mode-map ":" 'bbdb-mua-display-sender)
  (define-key mu4e-view-mode-map ";" 'bbdb-mua-edit-field-sender))

(provide 'bbdb-mu4e)

;;; bbdb-mu4e.el ends here
bbdb-20200102.403/bbdb-vm-aux.el0000644000175000017500000003216313643253537013340 0ustar  cbcb;;; bbdb-vm-aux.el --- aux parts of BBDB interface to VM -*- lexical-binding: t -*-

;; Copyright (C) 1991, 1992, 1993 Jamie Zawinski <jwz@netscape.com>.
;; Copyright (C) 2010-2017 Roland Winkler <winkler@gnu.org>

;; This file is part of the Insidious Big Brother Database (aka BBDB),

;; BBDB 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.

;; BBDB 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 BBDB.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;; This file contains auxiliary parts of the BBDB interface to VM.
;; See the BBDB info manual for documentation.

;;; Code:

(require 'bbdb)
(require 'bbdb-com)
(require 'bbdb-mua)

(when t     ;Don't require during compilation, since VM might not be installed!
  (require 'vm-autoloads)
  (require 'vm)
  (require 'vm-motion)
  (require 'vm-summary)
  (require 'vm-mime)
  (require 'vm-vars)
  (require 'vm-macro)
  (require 'vm-message)
  (require 'vm-misc))

(declare-function vm-su-from "vm-summary" (m))
(declare-function vm-su-to "vm-summary" (m))
(declare-function vm-su-to-names "vm-summary" (m))
(declare-function vm-su-full-name "vm-summary" (m))
(declare-function vm-add-message-labels "vm-undo" (string count))
(declare-function vm-decode-mime-encoded-words-in-string "vm-mime" (string))

(defvar vm-summary-uninteresting-senders)          ;In vm-vars
(defvar vm-summary-uninteresting-senders-arrow)    ;In vm-vars
(defvar vm-auto-folder-alist)                      ;In vm-vars
(defvar vm-virtual-folder-alist)                   ;In vm-vars
(defvar vm-folder-directory)                       ;In vm-vars
(defvar vm-primary-inbox)                          ;In vm-vars

;; By Alastair Burt <burt@dfki.uni-kl.de>
;; vm 5.40 and newer support a new summary format, %U<letter>, to call
;; a user-provided function.  Use "%-17.17UB" instead of "%-17.17F" to
;; have your VM summary buffers display BBDB's idea of the sender's full
;; name instead of the name (or lack thereof) in the message itself.

;; RW: this is a VM-specific version of `bbdb-mua-summary-unify'
;; which respects `vm-summary-uninteresting-senders'.

;;;###autoload
(defun vm-summary-function-B (m)
  "For VM message M return the BBDB name of the sender.
Respect `vm-summary-uninteresting-senders'."
  (if vm-summary-uninteresting-senders
        (if (let ((case-fold-search t))
              (string-match vm-summary-uninteresting-senders (vm-su-from m)))
            (concat vm-summary-uninteresting-senders-arrow
                    (or (bbdb/vm-alternate-full-name (vm-su-to m))
                        (vm-decode-mime-encoded-words-in-string
                         (vm-su-to-names m))))
          (or (bbdb/vm-alternate-full-name (vm-su-from m))
              (vm-su-full-name m)))
    (or (bbdb/vm-alternate-full-name (vm-su-from m))
        (vm-decode-mime-encoded-words-in-string (vm-su-full-name m)))))

(defun bbdb/vm-alternate-full-name (address)
  (if address
      (let* ((data (bbdb-extract-address-components address))
             (record (car (bbdb-message-search (car data) (cadr data)))))
        (if record
            (or (bbdb-record-xfield record 'mail-name)
                (bbdb-record-name record))))))



;;;###autoload
(defcustom bbdb/vm-auto-folder-headers '("From:" "To:" "CC:")
  "The headers used by `bbdb/vm-auto-folder'.
The order in this list is the order how matching will be performed."
  :group 'bbdb-mua-vm
  :type '(repeat (string :tag "header name")))

;;;###autoload
(defcustom bbdb/vm-auto-folder-field 'vm-folder
  "The xfield which `bbdb/vm-auto-folder' searches for."
  :group 'bbdb-mua-vm
  :type 'symbol)

;;;###autoload
(defcustom bbdb/vm-virtual-folder-field 'vm-virtual
  "The xfield which `bbdb/vm-virtual-folder' searches for."
  :group 'bbdb-mua-vm
  :type 'symbol)

;;;###autoload
(defcustom bbdb/vm-virtual-real-folders nil
  "Real folders used for defining virtual folders.
If nil use `vm-primary-inbox'."
  :group 'bbdb-mua-vm
  :type '(choice (const :tag "Use vm-primary-inbox" nil)
                 (repeat (string :tag "Real folder"))))

;;;###autoload
(defun bbdb/vm-auto-folder ()
  "Add entries to `vm-auto-folder-alist' for the records in BBDB.
For each record that has a `vm-folder' xfield, add an element
\(MAIL-REGEXP . FOLDER-NAME) to `vm-auto-folder-alist'.
The element gets added to the sublists of `vm-auto-folder-alist'
specified in `bbdb/vm-auto-folder-headers'.
MAIL-REGEXP matches the mail addresses of the BBDB record.
The value of the `vm-folder' xfield becomes FOLDER-NAME.
The `vm-folder' xfield is defined via `bbdb/vm-auto-folder-field'.

Add this function to `bbdb-before-save-hook' and your .vm."
  (interactive)
  (let ((records ; Collect BBDB records with a vm-folder xfield.
          (delq nil
                (mapcar (lambda (r)
                          (if (bbdb-record-xfield r bbdb/vm-auto-folder-field)
                              r))
                        (bbdb-records))))
         folder-list folder-name mail-regexp)
    ;; Add (MAIL-REGEXP . FOLDER-NAME) pair to this sublist of `vm-auto-folder-alist'
    (dolist (header bbdb/vm-auto-folder-headers)
      ;; create the folder-list in `vm-auto-folder-alist' if it does not exist
      (unless (setq folder-list (assoc header vm-auto-folder-alist))
        (push (list header) vm-auto-folder-alist)
        (setq folder-list (assoc header vm-auto-folder-alist)))
      (dolist (record records)
        ;; Ignore everything past a comma
        (setq folder-name (car (bbdb-record-xfield-split
                                record bbdb/vm-auto-folder-field))
              ;; quote all the mail addresses for the record and join them
              mail-regexp (regexp-opt (bbdb-record-mail record)))
        ;; In general, the values of xfields are strings (required for editing).
        ;; If we could set the value of `bbdb/vm-auto-folder-field' to a symbol,
        ;; it could be a function that is called with arg record to calculate
        ;; the value of folder-name.
        ;; (if (functionp folder-name)
        ;;     (setq folder-name (funcall folder-name record)))
        (unless (or (string= "" mail-regexp)
                    (assoc mail-regexp folder-list))
          ;; Convert relative into absolute file names using
          ;; `vm-folder-directory'.
          (unless (file-name-absolute-p folder-name)
            (setq folder-name (abbreviate-file-name
                               (expand-file-name folder-name
                                                 vm-folder-directory))))
          ;; nconc modifies the list in place
          (nconc folder-list (list (cons mail-regexp folder-name))))))))

;;;###autoload
(defun bbdb/vm-virtual-folder ()
  "Create `vm-virtual-folder-alist' according to the records in BBDB.
For each record that has a `vm-virtual' xfield, add or modify the
corresponding VIRTUAL-FOLDER-NAME element of `vm-virtual-folder-alist'.

  (VIRTUAL-FOLDER-NAME ((FOLDER-NAME ...)
                        (author-or-recipient MAIL-REGEXP)))

VIRTUAL-FOLDER-NAME is the first element of the `vm-virtual' xfield.
FOLDER-NAME ... are either the remaining elements of the `vm-virtual' xfield,
or `bbdb/vm-virtual-real-folders' or `vm-primary-inbox'.
MAIL-REGEXP matches the mail addresses of the BBDB record.
The `vm-virtual' xfield is defined via `bbdb/vm-virtual-folder-field'.

Add this function to `bbdb-before-save-hook' and your .vm."
  (interactive)
  (let (real-folders mail-regexp folder val tmp)
    (dolist (record (bbdb-records))
      (when (setq val (bbdb-record-xfield-split
                       record bbdb/vm-virtual-folder-field))
        (setq mail-regexp (regexp-opt (bbdb-record-mail record)))
        (unless (string= "" mail-regexp)
          (setq folder (car val)
                real-folders (mapcar
                              (lambda (f)
                                (if (file-name-absolute-p f) f
                                  (abbreviate-file-name
                                   (expand-file-name f vm-folder-directory))))
                              (or (cdr val) bbdb/vm-virtual-real-folders
                                  (list vm-primary-inbox)))
                ;; Either extend the definition of an already defined
                ;; virtual folder or define a new virtual folder
                tmp (or (assoc folder vm-virtual-folder-alist)
                        (car (push (list folder) vm-virtual-folder-alist)))
                tmp (or (assoc real-folders (cdr tmp))
                        (car (setcdr tmp (cons (list real-folders)
                                               (cdr tmp)))))
                tmp (or (assoc 'author-or-recipient (cdr tmp))
                        (car (setcdr tmp (cons (list 'author-or-recipient)
                                               (cdr tmp))))))
          (cond ((not (cdr tmp))
                 (setcdr tmp (list mail-regexp)))
                ((not (string-match (regexp-quote mail-regexp)
                                    (cadr tmp)))
                 (setcdr tmp (list (concat (cadr tmp) "\\|" mail-regexp))))))))))


;; RW: Adding custom labels to VM messages allows one to create,
;; for example, virtual folders.  The following code creates
;; the required labels in a rather simplistic way, checking merely
;; whether the sender's BBDB record uses a certain mail alias.
;; (Note that `bbdb/vm-virtual-folder' can achieve the same goal,
;; yet this requires a second xfield that must be kept up-to-date, too.)
;; To make auto labels yet more useful, the code could allow more
;; sophisticated schemes, too.  Are there real-world applications
;; for this?

;;; Howard Melman, contributed Jun 16 2000
(defcustom bbdb/vm-auto-add-label-list nil
  "List used by `bbdb/vm-auto-add-label' to automatically label VM messages.
Its elements may be strings used both as the xfield value to check for
and as the label to apply to the message.
If an element is a cons pair (VALUE . LABEL), VALUE is the xfield value
to search for and LABEL is the label to apply."
  :group 'bbdb-mua-vm
  :type 'list)

(defcustom bbdb/vm-auto-add-label-field bbdb-mail-alias-field
  "Xfields used by `bbdb/vm-auto-add-label' to automatically label messages.
This is either a single BBDB xfield or a list of xfields that
`bbdb/vm-auto-add-label' uses to check for labels to apply to a message.
Defaults to `bbdb-mail-alias-field' which defaults to `mail-alias'."
  :group 'bbdb-mua-vm
  :type '(choice symbol list))

;;;###autoload
(defun bbdb/vm-auto-add-label (record)
  "Automatically add labels to VM messages.
Add this to `bbdb-notice-record-hook' to check the messages noticed by BBDB.
If the value of `bbdb/vm-auto-add-label-field' in the sender's BBDB record
matches a value in `bbdb/vm-auto-add-label-list' then a VM label will be added
to the message.  Such VM labels can be used, e.g., to mark messages via
`vm-mark-matching-messages' or to define virtual folders via
`vm-create-virtual-folder'

Typically `bbdb/vm-auto-add-label-field' and `bbdb/vm-auto-add-label-list'
refer to mail aliases FOO used with multiple records.  This adds a label FOO
to all incoming messages matching FOO.  Then VM can create a virtual folder
for these messages.  The concept of combining multiple recipients of an
outgoing message in one mail alias thus gets extended to incoming messages
from different senders."
  ;; This could go into `vm-arrived-message-hook' to check messages only once.
  (if (eq major-mode 'vm-mode)
      (let* ((xvalues
              ;; Inspect the relevant fields of RECORD
              (append
               (mapcar (lambda (field)
                         (bbdb-record-xfield-split record field))
                       (cond ((listp bbdb/vm-auto-add-label-field)
                              bbdb/vm-auto-add-label-field)
                             ((symbolp bbdb/vm-auto-add-label-field)
                              (list bbdb/vm-auto-add-label-field))
                             (t (error "Bad value for bbdb/vm-auto-add-label-field"))))))
             ;; Collect the relevant labels from `bbdb/vm-auto-add-label-list'
             (labels
              (delq nil
                    (mapcar (lambda (l)
                              (cond ((stringp l)
                                     (if (member l xvalues)
                                         l))
                                    ((and (consp l)
                                          (stringp (car l))
                                          (stringp (cdr l)))
                                     (if (member (car l) xvalues)
                                         (cdr l)))
                                    (t
                                     (error "Malformed bbdb/vm-auto-add-label-list"))))
                            bbdb/vm-auto-add-label-list))))
        (if labels
            (vm-add-message-labels
             (mapconcat 'identity labels " ") 1)))))

(provide 'bbdb-vm-aux)

;;; bbdb-vm-aux.el ends here
bbdb-20200102.403/bbdb-sc.el0000644000175000017500000002133713643253540012523 0ustar  cbcb;;; bbdb-sc.el --- BBDB interface to Supercite -*- lexical-binding: t -*-

;; Copyright (C) 1991, 1992 Jamie Zawinski <jwz@netscape.com>.
;; Copyright (C) 2010-2017 Roland Winkler <winkler@gnu.org>

;; This file is part of the Insidious Big Brother Database (aka BBDB),

;; BBDB 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.

;; BBDB 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 BBDB.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;; This file contains the BBDB interface to Supercite (sc)

;; This file was written by Martin Sjolin <marsj@ida.liu.se>
;; based on the original code by Tom Tromey <tromey@busco.lanl.gov>.
;; Thanks to Richard Stanton <stanton@haas.berkeley.edu> for ideas
;; for improvements and to Michael D. Carney  <carney@ltx-tr.com>
;; for testing and feedback.

;; This file adds the ability to define attributions for Supercite in BBDB
;; and it enables you to retrieve your standard attribution from BBDB.
;; If the From header in the mail message to which you are replying only
;; contains the mail address, the sender's name is looked up in BBDB.
;; The attribution is stored in the xfield `attribution' (unless you
;; have changed `bbdb-sc-attribution-field').

;; To enable supercite support for BBDB, call `bbdb-initialize' with arg `sc'.
;; Also customize supercite as follows:
;; (1) Add element "sc-consult" to `sc-preferred-attribution-list'
;;     (note that order matters!), e.g.,
;;
;;   (setq sc-preferred-attribution-list
;;         '("sc-lastchoice" "x-attribution" "sc-consult"
;;           "initials" "firstname" "lastname"))
;;
;; (2) The variable `sc-attrib-selection-list' should include an element
;;
;;   (add-to-list 'sc-attrib-selection-list
;;                '("from" ((".*" . (bbdb-sc-get-attrib
;;                                   (sc-mail-field "from"))))))
;;
;; (3) Set `sc-mail-glom-frame' as follows to fetch the sender's name from BBDB
;;     if there is only a plain mail address in the From field of the mail message,
;;     e.g.,
;;
;;  (setq sc-mail-glom-frame
;;        '((begin                        (setq sc-mail-headers-start (point)))
;;          ("^From "                     (sc-mail-check-from) nil nil)
;;          ("^x-attribution:[ \t]+.*$"   (sc-mail-fetch-field t) nil t)
;;          ("^\\S +:.*$"                 (sc-mail-fetch-field) nil t)
;;          ("^$"                         (list 'abort '(step . 0)))
;;          ("^[ \t]+"                    (sc-mail-append-field))
;;          (sc-mail-warn-if-non-rfc822-p (sc-mail-error-in-mail-field))
;;          (end                          (progn
;;                                          (bbdb-sc-update-from)
;;                                          (setq sc-mail-headers-end (point))))))

;;; Code:

(require 'bbdb-com)
(require 'bbdb-mua)
(require 'supercite)

(defcustom bbdb-sc-attribution-field 'attribution
  "The BBDB xfield used for Supercite attribution."
  :group 'bbdb-utilities-sc
  :type '(symbol :tag "Field name"))
(define-obsolete-variable-alias 'bbdb/sc-attribution-field
  'bbdb-sc-attribution-field)

(defcustom bbdb-sc-update-records-p 'search
  "How `bbdb-sc-set-attrib' updates BBDB records automatically.
This may take the same values as arg UPDATE-P of `bbdb-update-records'."
  :group 'bbdb-utilities-sc
  :type '(choice (const :tag "do nothing" nil)
                 (const :tag "search for existing records" search)
                 (const :tag "update existing records" update)
                 (const :tag "query annotation of all messages" query)
                 (const :tag "annotate all messages" create)
                 (function :tag "User-defined function")))

(defcustom bbdb-sc-update-attrib-p 'query
 "How `bbdb-sc-set-attrib' updates the attribution field.
Allowed values include
 nil    Do not create or modify the attribution field
 query  Query before creating or modifying the attribution field.
 t      Create or modify the attribution field."
 :group 'bbdb-utilities-sc
 :type '(choice (const :tag "Do nothing" nil)
                (const :tag "Query before updating the attribution field" query)
                (const :tag "Update the attribution field" t)))

;;; Internal variables
(defvar bbdb-sc-last-attrib ""
 "Last attribution used by Supercite.
Used to compare against citation selected by the user.")

(defun bbdb-sc-get-attrib (mail)
  "Get the Supercite attribution from BBDB.
MAIL is the mail address to look for in BBDB."
  ;; We could store in `sc-mail-info' from which record we grabbed
  ;; this attribution.  Yet we do not know whether `bbdb-sc-set-attrib'
  ;; will want to use the same record.
  (let* ((address (bbdb-extract-address-components mail))
         (record (bbdb-message-search (car address)
                                      (cadr address))))
    ;; FIXME: What to do if we have multiple matching records?
    (when (cdr record)
      (message "Multiple records match %s" mail)
      (sit-for 1))
    (if record
        (bbdb-record-field (car record) bbdb-sc-attribution-field))))
(define-obsolete-function-alias 'bbdb/sc-consult-attr 'bbdb-sc-get-attrib)

(defun bbdb-sc-set-attrib ()
  "Store attribution in BBDB."
  (let ((from (bbdb-extract-address-components (sc-mail-field "from")))
        (attrib (sc-mail-field "sc-attribution"))
        bbdb-notice-mail-hook record)
    (when (and from attrib bbdb-sc-update-attrib-p
               (not (string-equal attrib bbdb-sc-last-attrib))
               (setq record (bbdb-update-records (list from)
                                                 bbdb-sc-update-records-p)))
      ;; FIXME: What to do if we have multiple matching records?
      (when (cdr record)
        (message "Multiple records match %s" from)
        (sit-for 1))
      (setq record (car record))
      (let ((old (bbdb-record-field record bbdb-sc-attribution-field)))
        ;; Do nothing if the new value equals the old value
        (when (and (not (and old (string-equal old attrib)))
                   (or (not (eq bbdb-sc-update-attrib-p 'query))
                       (y-or-n-p (format (if (bbdb-record-field
                                              record bbdb-sc-attribution-field)
                                             "Change attribution for %s to %s?"
                                           "For %s add attribution %s?")
                                         (bbdb-record-name record) attrib))))
          (bbdb-record-set-field record bbdb-sc-attribution-field attrib)
          (bbdb-change-record record))))))
(define-obsolete-function-alias 'bbdb/sc-set-attr 'bbdb-sc-set-attrib)

;;;###autoload
(defun bbdb-sc-update-from ()
  "Update the \"from\" field in `sc-mail-info'.
If the \"from\" field in `sc-mail-info' contains only a plain mail address,
complement the \"from\" field in `sc-mail-info' with the sender's name in BBDB."
  (let* ((from (sc-mail-field "from"))
         ;; Do not use `bbdb-extract-address-components' that can "invent" names.
         (address (and from (bbdb-decompose-bbdb-address from)))
         ;; FIXME: Should we always update the sender's name in `sc-mail-info'
         ;; if it does not agree with what BBDB says?
         (record (if (and (cadr address) (not (car address)))
                     (bbdb-message-search nil (cadr address))))
         ;; FIXME: What to do if we have multiple matching records?
         (_ (when (cdr record)
              (message "Multiple records match %s" from)
              (sit-for 1)))
         (name (and record (bbdb-record-name (car record)))))
    (if name
        (setcdr (assoc-string "from" sc-mail-info t)
                (format "%s <%s>" name (cadr address))))))
(define-obsolete-function-alias 'bbdb/sc-default 'bbdb-sc-update-from)

;; Insert our hooks

;; Dammit, supercite!  It runs `sc-attribs-postselect-hook' in an
;; environment with the local variable `attribution' that we rely on.
(with-no-warnings (defvar attribution))

;;;###autoload
(defun bbdb-insinuate-sc ()
  "Hook BBDB into Supercite.
Do not call this in your init file.  Use `bbdb-initialize'.
However, this is not the full story.  See bbdb-sc.el for how to fully hook
BBDB into Supercite."
  (add-hook 'sc-post-hook 'bbdb-sc-set-attrib)
  (add-hook 'sc-attribs-postselect-hook
            (lambda ()
              (setq bbdb-sc-last-attrib
                    (if sc-downcase-p
                        (downcase attribution)
                      attribution)))))

(provide 'bbdb-sc)

;;; bbdb-sc.el ends here
bbdb-20200102.403/bbdb-vm.el0000644000175000017500000000733113643253537012544 0ustar  cbcb;;; bbdb-vm.el --- BBDB interface to VM -*- lexical-binding: t -*-

;; Copyright (C) 2010-2017  Free Software Foundation, Inc.

;; This file is part of the Insidious Big Brother Database (aka BBDB),

;; BBDB 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.

;; BBDB 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 BBDB.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;; This file contains the BBDB interface to VM.
;; See the BBDB info manual for documentation.

;;; Code:

(require 'bbdb)
(require 'bbdb-com)
(require 'bbdb-mua)

(when t     ;Don't require during compilation, since VM might not be installed!
  (require 'vm-autoloads)
  (require 'vm-summary)
  (require 'vm-mime)
  (require 'vm-vars))

(declare-function vm-get-header-contents "vm-summary"
                  (message header-name-regexp &optional clump-sep))
(declare-function vm-decode-mime-encoded-words-in-string "vm-mime"
                  (string))
(declare-function vm-su-interesting-full-name "vm-summary" (m))
(declare-function vm-su-from "vm-summary" (m))
(defvar vm-message-pointer)             ;In vm-vars
(defvar vm-mode-map)                    ;In vm-vars

;;;###autoload
(defun bbdb/vm-header (header)
  (save-current-buffer
    (vm-select-folder-buffer)
    (vm-get-header-contents (car vm-message-pointer)
                            (concat header ":"))))

;;;###autoload
(defun bbdb-insinuate-vm ()
  "Hook BBDB into VM.
Do not call this in your init file.  Use `bbdb-initialize'."
  (define-key vm-mode-map ":" 'bbdb-mua-display-records)
  (define-key vm-mode-map "`" 'bbdb-mua-display-sender)
  (define-key vm-mode-map "'" 'bbdb-mua-display-recipients)
  (define-key vm-mode-map ";" 'bbdb-mua-edit-field-sender)
  ;; Do we need keybindings for more commands?  Suggestions welcome.
  ;; (define-key vm-mode-map "'" 'bbdb-mua-edit-field-recipients)
  (define-key vm-mode-map "/" 'bbdb)
  ;; `mail-mode-map' is the parent of `vm-mail-mode-map'.
  ;; So the following is also done by `bbdb-insinuate-mail'.
  (if (and bbdb-complete-mail (boundp 'vm-mail-mode-map))
      (define-key vm-mail-mode-map "\M-\t" 'bbdb-complete-mail))

  ;; Set up user field for use in `vm-summary-format'
  ;; (1) Big solution: use whole name
  (if bbdb-mua-summary-unify-format-letter
      (defalias (intern (concat "vm-summary-function-"
                                bbdb-mua-summary-unify-format-letter))
        (lambda (m) (bbdb-mua-summary-unify
                ;; VM does not give us the original From header.
                ;; So we have to work backwards.
                (let ((name (vm-decode-mime-encoded-words-in-string
                             (vm-su-interesting-full-name m)))
                      (mail (vm-su-from m)))
                  (if (string= name mail) mail
                    (format "\"%s\" <%s>" name mail)))))))

  ;; (2) Small solution: a mark for messages whos sender is in BBDB.
  (if bbdb-mua-summary-mark-format-letter
      (defalias (intern (concat "vm-summary-function-"
                                bbdb-mua-summary-mark-format-letter))
        ;; VM does not give us the original From header.
        ;; So we assume that the mail address is sufficient to identify
        ;; the BBDB record of the sender.
        (lambda (m) (bbdb-mua-summary-mark (vm-su-from m))))))

(provide 'bbdb-vm)

;;; bbdb-vm.el ends here
bbdb-20200102.403/bbdb-wl.el0000644000175000017500000000372413643253540012540 0ustar  cbcb;;; bbdb-wl.el --- BBDB interface to Wanderlust -*- lexical-binding: t -*-

;; Copyright (C) 2015-2018  Free Software Foundation, Inc.

;; This file is part of the Insidious Big Brother Database (aka BBDB),

;; BBDB 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.

;; BBDB 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 BBDB.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;; This file contains the BBDB interface to Wl.
;; See the BBDB info manual for documentation.

;;; Code:

(require 'bbdb)
(require 'bbdb-mua)

(defvar wl-summary-mode-map)
(defvar wl-draft-mode-map)
(defvar wl-summary-buffer-name)
(defvar wl-summary-buffer-elmo-folder)
(eval-and-compile
  (autoload 'wl-summary-message-number "wl-summary")
  (autoload 'elmo-message-entity "elmo-msgdb")
  (autoload 'elmo-message-entity-field "elmo-msgdb"))

;;;###autoload
(defun bbdb/wl-header (header)
  (with-current-buffer wl-summary-buffer-name
    (elmo-message-entity-field
     (elmo-message-entity wl-summary-buffer-elmo-folder
                          (wl-summary-message-number))
     (intern (downcase header))
     'string)))

;;;###autoload
(defun bbdb-insinuate-wl ()
  "Hook BBDB into Wanderlust."
  (define-key wl-summary-mode-map (kbd ":") #'bbdb-mua-display-sender)
  (define-key wl-summary-mode-map (kbd ";") #'bbdb-mua-edit-field-sender)
  (when bbdb-complete-mail
    (define-key wl-draft-mode-map (kbd "M-;") #'bbdb-complete-mail)
    (define-key wl-draft-mode-map (kbd "M-<tab>") #'bbdb-complete-mail)))

(provide 'bbdb-wl)

;;; bbdb-wl.el ends here
bbdb-20200102.403/bbdb-ispell.el0000644000175000017500000001157413643253537013416 0ustar  cbcb;;; bbdb-ispell.el --- export names from BBDB to personal ispell dictionaries -*- lexical-binding: t -*-

;; Copyright (C) 2011-2017  Free Software Foundation, Inc.

;; Author: Ivan Kanis <ivan.kanis@googlemail.com>

;; This file is part of the Insidious Big Brother Database (aka BBDB),

;; BBDB 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.

;; BBDB 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 BBDB.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Names are often not recognized by the standard ispell dictionaries.
;; `bbdb-ispell-export' exports the names from your BBDB records to your
;; personal ispell dictionaries.
;; The personal dictionaries are in `bbdb-ispell-dictionary-list'
;; The BBDB fields for this are in `bbdb-ispell-field-list'.
;; Exclude words via `bbdb-ispell-min-word-length' and `bbdb-ispell-ignore-re'.
;;
;; Bugs:
;; Save your personal directories before running this code.  I had my
;; dictionary truncated while debugging.  It shouldn't happen
;; but better be safe than sorry...
;;
;; See the BBDB info manual for documentation.

;;; Code:

(require 'ispell)
(require 'bbdb)

(defcustom bbdb-ispell-dictionary-list '("default")
  "List of ispell personal dictionaries.
Allowed elements are as in the return value of `ispell-valid-dictionary-list'."
  :group 'bbdb-utilities-ispell
  :type (cons 'set (mapcar (lambda (dict) `(string ,dict))
                           (ispell-valid-dictionary-list))))

(defcustom bbdb-ispell-field-list '(name organization aka)
  "List of fields of each BBDB record considered for the personal dictionary."
  :group 'bbdb-utilities-ispell
  :type (list 'repeat
              (append '(choice) (mapcar (lambda (field) `(const ,field))
                                        '(name organization affix aka address))
                      '((symbol :tag "xfield")))))

(defcustom bbdb-ispell-min-word-length 3
  "Words with fewer characters are ignored."
  :group 'bbdb-utilities-ispell
  :type 'number)

(defcustom bbdb-ispell-ignore-re "[^[:alpha:]]"
  "Words matching this regexp are ignored."
  :group 'bbdb-utilities-ispell
  :type 'regexp)

;; Internal variable
(defvar bbdb-ispell-word-list nil
  "List of words extracted from the BBDB records.")

;;;###autoload
(defun bbdb-ispell-export ()
  "Export BBDB records to ispell personal dictionaries."
  (interactive)
  (message "Exporting to personal dictionary...")
  (let (bbdb-ispell-word-list)
    ;; Collect words from BBDB records.
    (dolist (record (bbdb-records))
      (dolist (field bbdb-ispell-field-list)
        (bbdb-ispell-collect-words (bbdb-record-field record field))))

    ;; Update personal dictionaries
    (dolist (dict (or bbdb-ispell-dictionary-list '("default")))
      (ispell-change-dictionary dict)
      ;; Initialize variables and dicts alists
      (ispell-set-spellchecker-params)
      (ispell-init-process)
      ;; put in verbose mode
      (ispell-send-string "%\n")
      (let (new)
        (dolist (word (delete-dups bbdb-ispell-word-list))
          (ispell-send-string (concat "^" word "\n"))
          (while (progn
                   (ispell-accept-output)
                   (not (string= "" (car ispell-filter)))))
          ;; remove extra \n
          (setq ispell-filter (cdr ispell-filter))
          (when (and ispell-filter
                     (listp ispell-filter)
                     (not (eq (ispell-parse-output (car ispell-filter)) t)))
            ;; ok the word doesn't exist, add it
            (ispell-send-string (concat "*" word "\n"))
            (setq new t)))
        (when new
          ;; Save dictionary:
          ;; aspell doesn't tell us when it completed the saving.
          ;; So we send it another word for spellchecking.
          (ispell-send-string "#\n^hello\n")
          (while (progn
                   (ispell-accept-output)
                   (not (string= "" (car ispell-filter)))))))))
  (message "Exporting to personal dictionary...done"))

(defun bbdb-ispell-collect-words (field)
  "Parse BBDB FIELD and collect words in `bbdb-ispell-word-list'."
  ;; Ignore everything in FIELD that is not a string or a sequence.
  (cond ((stringp field)
         (dolist (word (split-string field))
           (if (and (>= (length word) bbdb-ispell-min-word-length)
                    (not (string-match bbdb-ispell-ignore-re word)))
               (push word bbdb-ispell-word-list))))
        ((sequencep field) (mapc 'bbdb-ispell-collect-words field))))

(provide 'bbdb-ispell)

;;; bbdb-ispell.el ends here
bbdb-20200102.403/bbdb-gnus.el0000644000175000017500000000534113643253540013067 0ustar  cbcb;;; bbdb-gnus.el --- BBDB interface to Gnus -*- lexical-binding: t -*-

;; Copyright (C) 2010-2017  Free Software Foundation, Inc.

;; This file is part of the Insidious Big Brother Database (aka BBDB),

;; BBDB 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.

;; BBDB 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 BBDB.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;; This file contains the BBDB interface to Gnus.
;;; See the BBDB info manual for documentation.

;;; Code:

(require 'bbdb)
(require 'bbdb-com)
(require 'bbdb-mua)
(require 'gnus)

;;; Insinuation

;;;###autoload
(defun bbdb-insinuate-gnus ()
  "Hook BBDB into Gnus.
Do not call this in your init file.  Use `bbdb-initialize'."
  ;; `bbdb-mua-display-sender' fails in *Article* buffers, where
  ;; `gnus-article-read-summary-keys' provides an additional wrapper
  ;; that restores the window configuration.
  (define-key gnus-summary-mode-map ":" 'bbdb-mua-display-sender)
  (define-key gnus-article-mode-map ":" 'bbdb-mua-display-sender)
  ;; For `bbdb-mua-edit-field-sender' it is probably OK if
  ;;`gnus-article-read-summary-keys' restores the window configuration.
  (define-key gnus-summary-mode-map ";" 'bbdb-mua-edit-field-sender)
  (define-key gnus-article-mode-map ";" 'bbdb-mua-edit-field-sender)
  ;; Do we need keybindings for more commands?  Suggestions welcome.
  ;; (define-key gnus-summary-mode-map ":" 'bbdb-mua-display-records)
  ;; (define-key gnus-summary-mode-map "'" 'bbdb-mua-display-recipients)
  ;; (define-key gnus-summary-mode-map ";" 'bbdb-mua-edit-field-recipients)

  ;; Set up user field for use in `gnus-summary-line-format'
  ;; (1) Big solution: use whole name
  (if bbdb-mua-summary-unify-format-letter
      (defalias (intern (concat "gnus-user-format-function-"
                                bbdb-mua-summary-unify-format-letter))
        (lambda (header)
          (bbdb-mua-summary-unify (mail-header-from header)))))

  ;; (2) Small solution: a mark for messages whose sender is in BBDB.
  (if bbdb-mua-summary-mark-format-letter
      (defalias (intern (concat "gnus-user-format-function-"
                                bbdb-mua-summary-mark-format-letter))
        (lambda (header)
          (bbdb-mua-summary-mark (mail-header-from header))))))

(provide 'bbdb-gnus)

;;; bbdb-gnus.el ends here
bbdb-20200102.403/bbdb-gnus-aux.el0000644000175000017500000003776513643253537013707 0ustar  cbcb;;; bbdb-gnus-aux.el --- aux parts of BBDB interface to Gnus -*- lexical-binding: t -*-

;; Copyright (C) 1991, 1992, 1993 Jamie Zawinski <jwz@netscape.com>.
;; Copyright (C) 2010-2017 Roland Winkler <winkler@gnu.org>

;; This file is part of the Insidious Big Brother Database (aka BBDB),

;; BBDB 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.

;; BBDB 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 BBDB.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;; This file contains auxiliary parts of the BBDB interface to Gnus.
;; See the BBDB info manual for documentation.

;;; Code:

(require 'bbdb)
(require 'bbdb-com)
(require 'bbdb-mua)
(require 'gnus)

(eval-and-compile
  (autoload 'message-make-domain "message"))

;; Scoring

;; RW 2017-11-16: Does this scoring currently work at all?
;; How is this code supposed to hook into Gnus?

(defcustom bbdb/gnus-score-field 'gnus-score
  "This variable contains the name of the BBDB field which should be
checked for a score to add to the mail addresses in the same record."
  :group 'bbdb-mua-gnus-scoring
  :type 'symbol)

(defcustom bbdb/gnus-score-default nil
  "If this is set, then every mail address in the BBDB that does not have
an associated score field will be assigned this score.  A value of nil
implies a default score of zero."
  :group 'bbdb-mua-gnus-scoring
  :type '(choice (const :tag "Do not assign default score" nil)
                 (integer :tag "Assign this default score" 0)))

(defvar bbdb/gnus-score-default-internal nil
  "Internal variable for detecting changes to
`bbdb/gnus-score-default'.  You should not set this variable directly -
set `bbdb/gnus-score-default' instead.")

(defvar bbdb/gnus-score-alist nil
  "The text version of the scoring structure returned by
bbdb/gnus-score.  This is built automatically from the BBDB.")

(defvar bbdb/gnus-score-rebuild-alist t
  "Set to t to rebuild bbdb/gnus-score-alist on the next call to
bbdb/gnus-score.  This will be set automatically if you change a BBDB
record which contains a gnus-score field.")

;;;###autoload
(defun bbdb/gnus-score-invalidate-alist (record)
  "This function is called through `bbdb-after-change-hook',
and sets `bbdb/gnus-score-rebuild-alist' to t if the changed
record contains a gnus-score field."
  (if (bbdb-record-xfield record bbdb/gnus-score-field)
      (setq bbdb/gnus-score-rebuild-alist t)))
(add-hook 'bbdb-after-change-hook 'bbdb/gnus-score-invalidate-alist)
;; (setq gnus-score-find-score-files-function
;;  (if (boundp 'gnus-score-find-score-files-function)
;;      (cond ((functionp gnus-score-find-score-files-function)
;;             (list gnus-score-find-score-files-function 'bbdb/gnus-score))
;;            ((listp gnus-score-find-score-files-function)
;;             (append gnus-score-find-score-files-function 'bbdb/gnus-score))
;;            (t 'bbdb/gnus-score))
;;    'bbdb/gnus-score))

;;;###autoload
(defun bbdb/gnus-score (group)
  "This returns a score alist for Gnus.  A score pair will be made for
every member of the mail field in records which also have a gnus-score
field.  This allows the BBDB to serve as a supplemental global score
file, with the advantage that it can keep up with multiple and changing
addresses better than the traditionally static global scorefile."
  (list (list
         (condition-case nil
             (read (bbdb/gnus-score-as-text group))
           (error (setq bbdb/gnus-score-rebuild-alist t)
                  (message "Problem building BBDB score table.")
                  (ding) (sit-for 2)
                  nil)))))

(defun bbdb/gnus-score-as-text (_group)
  "Returns a SCORE file format string built from the BBDB."
  (cond ((or (cond ((/= (or bbdb/gnus-score-default 0)
                        (or bbdb/gnus-score-default-internal 0))
                    (setq bbdb/gnus-score-default-internal
                          bbdb/gnus-score-default)
                    t))
             (not bbdb/gnus-score-alist)
             bbdb/gnus-score-rebuild-alist)
         (setq bbdb/gnus-score-rebuild-alist nil)
         (setq bbdb/gnus-score-alist
               (concat "((touched nil) (\"from\"\n"
                       (mapconcat
                        (lambda (record)
                          (let ((score (or (bbdb-record-xfield record bbdb/gnus-score-field)
                                           bbdb/gnus-score-default))
                                (mail (bbdb-record-mail record)))
                            (when (and score mail)
                              (mapconcat
                               (lambda (address)
                                 (format "(\"%s\" %s)\n" address score))
                               mail ""))))
                        (bbdb-records) "")
                       "))"))))
  bbdb/gnus-score-alist)

;; from Brian Edmonds' gnus-bbdb.el
;;
;; Splitting / filing with gnus-folder
;;
;; To use this feature, you need to put this file somewhere in your
;; load-path and add the following lines of code to your .gnus file:
;;
;; (setq nnmail-split-methods 'bbdb/gnus-split-method)
;;
;; You should also examine the variables defvar'd below and customize
;; them to your taste.  They're listed roughly in descending likelihood
;; of your wanting to change them.  Once that is done, you need to add
;; filing information to your BBDB.  There are two fields of interest:
;;
;; 1. gnus-private.  This field contains the name of the group in which
;;    mail to you from any of the addresses associated with this record
;;    will be filed.  Also, any self-copies of mail you send any of the
;;    same addresses will be filed here.
;; 2. gnus-public.  This field is used to keep mail from mailing lists
;;    out of the private mailboxes.  It should be added to a record for
;;    the list submission address, and is formatted as follows:
;;      "group regexp"
;;    where group is where mail from the list should be filed, and
;;    regexp is a regular expression which is checked against the
;;    envelope sender (from the From_ header) to verify that this is
;;    the copy which came from the list.  For example, the entry for
;;    the ding mailing list might be:
;;      "mail.emacs.ding ding-request@ifi.uio.no"
;;    Yes, the second part *is* a regexp, so those dots may match
;;    something other than dots.  Sue me.
;;
;; Note that you can also specify a gnus-private field for mailing list
;; addresses, in which case self-copies of mail you send to the list
;; will be filed there.  Also, the field names can be changed below if
;; the defaults are not hip enough for you.  Lastly, if you specify a
;; gnus-private field for your *own* BBDB record, then all self-copies
;; of mail you send will be filed to that group.
;;
;; This documentation should probably be expanded and moved to a
;; separate file, but it's late, and *I* know what I'm trying to
;; say. :)

(defcustom bbdb/gnus-split-default-group "mail.misc"
  "If the BBDB does not indicate any group to spool a message to, it will
be spooled to this group.  If `bbdb/gnus-split-crosspost-default' is not
nil, and if the BBDB did not indicate a specific group for one or more
addresses, messages will be crossposted to this group in addition to any
group(s) which the BBDB indicated."
  :group 'bbdb-mua-gnus-splitting
  :type  'string)

(defcustom bbdb/gnus-split-nomatch-function nil
  "This function will be called after searching the BBDB if no place to
file the message could be found.  It should return a group name (or list
of group names) -- `nnmail-split-fancy' as provided with Gnus is an
excellent choice."
  :group 'bbdb-mua-gnus-splitting
  :type  'function)

(defcustom bbdb/gnus-split-myaddr-regexp
  (concat "^" (user-login-name) "$\\|^"
          (user-login-name) "@\\([-a-z0-9]+\\.\\)*"
          (or (message-make-domain) (system-name) "") "$")
  "This regular expression should match your address as found in the
From header of your mail."
  :group 'bbdb-mua-gnus-splitting
  :type  'regexp)

(defcustom bbdb/gnus-split-crosspost-default nil
  "If this variable is not nil, then if the BBDB could not identify a
group for every mail address, messages will be filed in
`bbdb/gnus-split-default-group' in addition to any group(s) which the BBDB
identified."
  :group 'bbdb-mua-gnus-splitting
  :type  'boolean)

(defcustom bbdb/gnus-split-private-field 'gnus-private
  "This variable is used to determine the xfield to reference to find the
associated group when saving private mail for a mail address known to
the BBDB.  The value of the xfield should be the name of a mail group."
  :group 'bbdb-mua-gnus-splitting
  :type  'symbol)

(defcustom bbdb/gnus-split-public-field 'gnus-public
  "This variable is used to determine the xfield to reference to find the
associated group when saving non-private mail (received from a mailing
list) for a mail address known to the BBDB.  The value of the xfield
should be the name of a mail group, followed by a space, and a regular
expression to match on the envelope sender to verify that this mail came
from the list in question."
  :group 'bbdb-mua-gnus-splitting
  :type  'symbol)

;; The split function works by assigning one of four spooling priorities
;; to each group that is associated with an address in the message.  The
;; priorities are assigned as follows:
;;
;; 0. This priority is assigned when crosspost-default is nil to To/Cc
;;    addresses which have no private group defined in the BBDB.  If the
;;    user's own address has no private group defined, then it will
;;    always be given this priority.
;; 1. This priority is assigned to To/Cc addresses which have a private
;;    group defined in the BBDB.  If crosspost-default is not nil, then
;;    To/Cc addresses which have no private group will also be assigned
;;    this priority.  This is also assigned to the user's own address in
;;    the From position if a private group is defined for it.
;; 2. This priority is assigned to From addresses which have a private
;;    group defined in the BBDB, except for the user's own address as
;;    described under priorities 0 and 1.
;; 3. This priority is assigned to To/Cc addresses which have a public
;;    group defined in the BBDB, and whose associated regular expression
;;    matches the envelope sender (found in the header From_).
;;
;; The split function evaluates the spool priority for each address in
;; the headers of the message, and returns as a list all the groups
;; associated with the addresses which share the highest calculated
;; priority.

;;;###autoload
(defun bbdb/gnus-split-method ()
  "This function expects to be called in a buffer which contains a mail
message to be spooled, and the buffer should be narrowed to the message
headers.  It returns a list of groups to which the message should be
spooled, using the addresses in the headers and information from BBDB."
  (let ((prq (list (list 0) (list 1) (list 2) (list 3))))
    ;; the From: header is special
    (let* ((hdr (or (mail-fetch-field "resent-from")
                    (mail-fetch-field "from")
                    (user-login-name)))
           (rv (bbdb/gnus-split-to-group hdr t)))
      (setcdr (nth (cdr rv) prq) (list (car rv))))
    ;; do the rest of the headers
    (let ((hdr (or (concat (or (mail-fetch-field "resent-to" nil t)
                               (mail-fetch-field "to" nil t))
                           ", "
                           (mail-fetch-field "cc" nil t)
                           ", "
                           (mail-fetch-field "apparently-to" nil t))
                   "")))
      (dolist (address (bbdb-extract-address-components hdr t))
        (let* ((rv (bbdb/gnus-split-to-group address))
               (pr (nth (cdr rv) prq)))
          (unless (member-ignore-case (car rv) pr)
            (setcdr pr (cons (car rv) (cdr pr)))))))
    ;; find the highest non-empty queue
    (setq prq (reverse prq))
    (while (and prq (not (cdr (car prq)))) (setq prq (cdr prq)))
    ;; and return...
    (if (not (or (not (cdr (car prq)))
                 (and (equal (cdr (car prq)) (list bbdb/gnus-split-default-group))
                      (symbolp bbdb/gnus-split-nomatch-function)
                      (fboundp bbdb/gnus-split-nomatch-function))))
        (cdr (car prq))
      (goto-char (point-min))
      (funcall bbdb/gnus-split-nomatch-function))))

(defun bbdb/gnus-split-to-group (address &optional source)
  "This function is called from `bbdb/gnus-split-method' in order to
determine the group and spooling priority for a single address."
  (condition-case nil
      (let* ((tmp (bbdb-extract-address-components address))
             (mail (cadr tmp))
             (record (car (bbdb-message-search (car tmp) mail)))
             public private rgx)
        (when record
          (setq private (bbdb-record-xfield record bbdb/gnus-split-private-field)
                public (bbdb-record-xfield record bbdb/gnus-split-public-field))
          (if (and public (not source) (string-match "^\\([^ ]+\\) \\(.*\\)$" public))
              (setq rgx (substring public (match-beginning 2) (match-end 2))
                    public (substring public (match-beginning 1) (match-end 1)))
            (setq public nil)))
        (cond
         ((and rgx public
               (goto-char (point-min))
               (re-search-forward "^From: \\([^ \n]+\\)[ \n]" nil t)
               (string-match rgx (buffer-substring (match-beginning 1)
                                                   (match-end 1))))
          (cons public 3))
         (private
          (cons private
                (- 1 (if source -1 0)
                   (if (string-match bbdb/gnus-split-myaddr-regexp mail) 1 0))))
         (t
          (cons bbdb/gnus-split-default-group
                (cond ((string-match bbdb/gnus-split-myaddr-regexp mail) 0)
                      (source 2)
                      (bbdb/gnus-split-crosspost-default 1)
                      (t 0))))))
    (error (cons bbdb/gnus-split-default-group 0))))

;;
;; Imap support (Uwe Brauer)
;;
;;;###autoload
(defun bbdb/gnus-nnimap-folder-list-from-bbdb ()
  "Return a list of \( \"From\" mail-regexp imap-folder-name\) tuples
based on the contents of the bbdb.

The folder-name is the value of the 'imap attribute of the BBDB record;
the mail-regexp consists of all the mail addresses for the BBDB record
concatenated with OR.  Records without an 'imap attribute are ignored.

Here  is an example of a relevant BBDB record:

Uwe Brauer
           mail: oub@mat.ucm.es
           imap: testimap

This function uses `regexp-opt' to generate the mail-regexp which automatically
`regexp-quote's its arguments.  Please note: in order that this will work
with the `nnimap-split-fancy' method you have to use macros, that is your setting
will look like:

\(setq nnimap-split-rule  'nnimap-split-fancy
       nnimap-split-inbox \"INBOX\"
       nnimap-split-fancy
       `\(| ,@\(bbdb/gnus-nnimap-folder-list-from-bbdb\)
            ... \)\)

Note that `\( is the backquote, NOT the quote '\(."

  (let (;; the value of the 'imap attribute of a bbdb record
        folder-attr
        ;; a regexp matching all the mail addresses from a bbdb record
        mail-regexp
        ;; the list of (folder mail) tuples to return
        new-elmnt-list)
    ;; Loop over BBDB records.  If an imap attribute exists for
    ;; the record, generate a regexp matching all the mail addresses
    ;; and add a tuple (folder mail-regexp) to the new-elmnt-list
    (dolist (record (bbdb-records))
      (when (setq folder-attr (bbdb-record-xfield record 'imap))
        (setq mail-regexp (regexp-opt (mapcar 'downcase
                                              (bbdb-record-mail record))))
        (unless (string= "" mail-regexp)
          (push (list "From" mail-regexp folder-attr)
                new-elmnt-list))))
    new-elmnt-list))

(provide 'bbdb-gnus-aux)

;;; bbdb-gnus-aux.el ends here
bbdb-20200102.403/bbdb-migrate.el0000644000175000017500000002734413643253537013560 0ustar  cbcb;;; bbdb-migrate.el --- migration functions for BBDB -*- lexical-binding: t -*-

;; Copyright (C) 2010-2017  Free Software Foundation, Inc.

;; This file is part of the Insidious Big Brother Database (aka BBDB),

;; BBDB 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.

;; BBDB 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 BBDB.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;; This file contains the migration functions for BBDB.
;;; See the BBDB info manual for documentation.

;; Changes in `bbdb-file-format':
;;   3  Date format for `creation-date' and `timestamp' changed
;;      from "dd mmm yy" (ex: 25 Sep 97) to "yyyy-mm-dd" (ex: 1997-09-25).
;;   4  Country field added.
;;   5  Streets are lists.
;;   6  Postcodes are plain strings.
;;   7  New field `affix'.  Organizations are a list.
;;      Xfields is always a list.
;;  (8  Skipped format in "official BBDB": Some BBDB users introduced
;;      an xfield uuid in their format 8.  To bring them back, we jump
;;      straight from 7 to 9.)
;;   9  New field uuid.  Make `creation-date' and `timestamp' immutable fields.


;;; Code:

(require 'bbdb)

;;; Migrating the BBDB

(defvar bbdb-migrate-uuid-xfield 'uuid
  "Xfield holding a uuid in file format 8.")

;;;###autoload
(defun bbdb-migrate (records old)
  "Migrate RECORDS from format OLD to `bbdb-file-format'."
  ;; Some BBDB files were corrupted by random outer layers of
  ;; parentheses surrounding the actual correct data.  We attempt to
  ;; compensate for this.
  (while (and (consp records)
	      (listp (car records))
	      (null (cdr records)))
    (setq records (car records)))

  ;; `bbdb-migrate-lambda' uses the usual functions to access and set
  ;; the fields of a record.  So if a new record format changes
  ;; the set of fields, we need to make these changes first.

  ;; Format 7: Add new field `affix'.
  (if (< old 7)
      (let (new-records)
        (dolist (record records)
          (push (vector (elt record 0) (elt record 1) nil
                        (elt record 2) (elt record 3) (elt record 4)
                        (elt record 5) (elt record 6) (elt record 7)
                        (elt record 8))
                new-records))
        (setq records (nreverse new-records))))

  ;; Format 9: New field `uuid'.
  ;; Make `creation-date' and `timestamp' immutable fields.
  (if (< old 9)
      (let (new-records)
        (dolist (record records)
          (let ((uuid (or (cdr (assq bbdb-migrate-uuid-xfield (elt record 8)))
                          (bbdb-uuid)))
                (creation-date (or (cdr (assq 'creation-date (elt record 8)))
                                   (format-time-string bbdb-time-stamp-format nil t)))
                (timestamp (or (cdr (assq 'timestamp (elt record 8)))
                               (format-time-string bbdb-time-stamp-format nil t))))
            (push (vector (elt record 0) (elt record 1) (elt record 2)
                          (elt record 3) (elt record 4) (elt record 5)
                          (elt record 6) (elt record 7)
                          (let ((xfields (elt record 8)))
                            (dolist (elt '(uuid creation-date timestamp))
                              (setq xfields (assq-delete-all elt xfields)))
                            xfields)
                          uuid creation-date timestamp
                          (elt record 9))
                  new-records)))
        (setq records (nreverse new-records))))

  (mapc (bbdb-migrate-lambda old) records)
  records)

(defconst bbdb-migrate-alist
  '((3 (bbdb-record-xfields bbdb-record-set-xfields
        bbdb-migrate-dates))
    (4 (bbdb-record-address bbdb-record-set-address
        bbdb-migrate-add-country))
    (5 (bbdb-record-address bbdb-record-set-address
        bbdb-migrate-streets-to-list))
    (6 (bbdb-record-address bbdb-record-set-address
        bbdb-migrate-postcode-to-string))
    (7 (bbdb-record-xfields bbdb-record-set-xfields
        bbdb-migrate-xfields-to-list)
       (bbdb-record-organization bbdb-record-set-organization
        bbdb-migrate-organization-to-list)))
  ;; Formats 8 and 9: do nothing
  "Alist (VERSION . CHANGES).
CHANGES is a list with elements (GET SET FUNCTION) that expands
to action (SET record (FUNCTION (GET record))).")

(defun bbdb-migrate-lambda (old)
  "Return the function to migrate from OLD to `bbdb-file-format'.
The manipulations are defined by `bbdb-migrate-alist'."
  (let (spec)
    (while (<= old bbdb-file-format)
      (setq spec (append spec (cdr (assoc old bbdb-migrate-alist)))
            old (1+ old)))
    `(lambda (record)
       ,@(mapcar (lambda (change)
                   ;; (SET record (FUNCTION (GET record)))
                   `(,(nth 1 change) record ; SET
                     (,(nth 2 change) ; FUNCTION
                      (,(nth 0 change) record)))) ; GET
                 spec)
       record)))

(defun bbdb-migrate-postcode-to-string (addresses)
  "Make all postcodes plain strings.
This uses the code that used to be in `bbdb-address-postcode'."
  ;; apply the function to all addresses in the list and return a
  ;; modified list of addresses
  (mapcar (lambda (address)
            (let ((postcode (bbdb-address-postcode address)))
              (bbdb-address-set-postcode
               address
               (cond ((stringp postcode)
                      postcode)
                     ;; nil or zero
                     ((or (zerop postcode)
                          (null postcode))
                      "")
                     ;; a number
                     ((numberp postcode)
                      (format "%d" postcode))
                     ;; list with two strings
                     ((and (stringp (nth 0 postcode))
                           (stringp (nth 1 postcode)))
                      ;; the second string starts with 4 digits
                      (if (string-match "^[0-9][0-9][0-9][0-9]"
                                        (nth 1 postcode))
                          (format "%s-%s" (nth 0 postcode) (nth 1 postcode))
                        ;; ("abc" "efg")
                        (format "%s %s" (nth 0 postcode) (nth 1 postcode))))
                     ;; list with two numbers
                     ((and (integerp (nth 0 postcode))
                           (integerp (nth 1 postcode)))
                      (format "%05d-%04d" (nth 0 postcode) (nth 1 postcode)))
                     ;; list with a string and a number
                     ((and (stringp (nth 0 postcode))
                           (integerp (nth 1 postcode)))
                      (format "%s-%d" (nth 0 postcode) (nth 1 postcode)))
                     ;; ("SE" (123 45))
                     ((and (stringp (nth 0 postcode))
                           (integerp (nth 0 (nth 1 postcode)))
                           (integerp (nth 1 (nth 1 postcode))))
                      (format "%s-%d %d" (nth 0 postcode) (nth 0 (nth 1 postcode))
                              (nth 1 (nth 1 postcode))))
                     ;; last possibility
                     (t (format "%s" postcode)))))
            address)
          addresses))

(defun bbdb-migrate-dates (xfields)
  "Change date formats.
Formats are changed in timestamp and creation-date fields from
\"dd mmm yy\" to \"yyyy-mm-dd\"."
  (unless (stringp xfields)
    (mapc (lambda (xfield)
            (when (memq (car xfield) '(creation-date timestamp))
              (bbdb-migrate-date xfield)))
          xfields)
    xfields))

(defun bbdb-migrate-date (field)
  "Convert date field FIELD from \"dd mmm yy\" to \"yyyy-mm-dd\"."
  (let* ((date (cdr field))
         (parsed (timezone-parse-date (concat date " 00:00:00"))))
    ;; If `timezone-parse-date' cannot make sense of its arg DATE
    ;; it returns ["0" "0" "0" "0" nil].
    (if (equal parsed ["0" "0" "0" "0" nil])
        (setq parsed (timezone-parse-date date)))
    (when (equal parsed ["0" "0" "0" "0" nil])
      (cond ((string-match
              "^\\([0-9]\\{4\\}\\)[-/]\\([ 0-9]?[0-9]\\)[-/]\\([ 0-9]?[0-9]\\)" date)
             (setq parsed (vector (match-string 1 date) (match-string 2 date)
                                  (match-string 3 date))))
            ((string-match
              "^\\([ 0-9]?[0-9]\\)[-/]\\([ 0-9]?[0-9]\\)[-/]\\([0-9]\\{4\\}\\)" date)
             (setq parsed (vector (match-string 3 date) (match-string 1 date)
                                  (match-string 2 date))))))

    ;; We need numbers for the following sanity check
    (dotimes (i 3)
      (if (stringp (aref parsed i))
          (aset parsed i (string-to-number (aref parsed i)))))

    ;; Sanity check
    (if (and (< 0 (aref parsed 0))
             (< 0 (aref parsed 1)) (< (aref parsed 1) 13)
             (< 0 (aref parsed 2))
             (<= (aref parsed 2)
                 (timezone-last-day-of-month (aref parsed 1) (aref parsed 0))))
        (setcdr field (format "%04d-%02d-%02d" (aref parsed 0)
                              (aref parsed 1) (aref parsed 2)))
      (error "BBDB cannot parse %s header value %S for upgrade"
             field date))))

(defun bbdb-migrate-add-country (addrl)
  "Add a country field to each address in the address list."
  (mapcar (lambda (address) (vconcat address [bbdb-default-country])) addrl))

(defun bbdb-migrate-streets-to-list (addrl)
  "Convert the streets to a list."
  (mapcar (lambda (address)
            (vector (aref address 0) ; key
                    (delq nil (delete "" ; nuke empties
                                      (list (aref address 1) ; street1
                                            (aref address 2) ; street2
                                            (aref address 3))));street3
                    (aref address 4) ; city
                    (aref address 5) ; state
                    (aref address 6) ; postcode
                    (aref address 7))) ; country
          addrl))

(defun bbdb-migrate-xfields-to-list (xfields)
  "Migrate XFIELDS to list."
  (if (stringp xfields)
      `((notes . ,xfields))
    xfields))

(defun bbdb-migrate-organization-to-list (organization)
  "Migrate ORGANIZATION to list."
  (if (stringp organization)
      (bbdb-split 'organization organization)
    organization))

;;;###autoload
(defun bbdb-undocumented-variables (&optional name-space message)
  "Return list of undocumented variables in NAME-SPACE.
NAME-SPACE defaults to \"bbdb-\".  Use a prefix arg to specify NAME-SPACE
interactively.  If MESSAGE is non-nil (as in interactive calls) display
the list in the message area.

This command may come handy to identify BBDB variables in your init file
that are not used anymore by the current version of BBDB.  Yet this fails
for outdated BBDB variables that are set via your personal `custom-file'."
  (interactive (list (if current-prefix-arg
                         (read-string "Name space: ")) t))
  (let ((re (concat "\\`" (or name-space "bbdb-"))) list)
    (mapatoms (lambda (vv)
                (if (and (boundp vv)
                         (string-match re (symbol-name vv))
                         (not (get vv 'variable-documentation))
                         (not (get vv 'byte-obsolete-variable)))
                    (push vv list))))
    (if message
        (if list
            (apply 'message (concat "Undocumented variables: "
                                    (mapconcat (lambda (_m) "%s") list " ")) list)
          (message "No undocumented variables `%s...'" name-space)))
    list))

(provide 'bbdb-migrate)

;;; bbdb-migrate.el ends here
bbdb-20200102.403/doclicense.info0000644000175000017500000006076213643253540013677 0ustar  cbcbThis is doclicense.info, produced by makeinfo version 6.5 from
doclicense.texi.

                     Version 1.3, 3 November 2008

     Copyright (C) 2000, 2001, 2002, 2007, 2008, 2009 Free Software Foundation, Inc.
     <http://fsf.org/>

     Everyone is permitted to copy and distribute verbatim copies
     of this license document, but changing it is not allowed.

  0. PREAMBLE

     The purpose of this License is to make a manual, textbook, or other
     functional and useful document "free" in the sense of freedom: to
     assure everyone the effective freedom to copy and redistribute it,
     with or without modifying it, either commercially or
     noncommercially.  Secondarily, this License preserves for the
     author and publisher a way to get credit for their work, while not
     being considered responsible for modifications made by others.

     This License is a kind of "copyleft", which means that derivative
     works of the document must themselves be free in the same sense.
     It complements the GNU General Public License, which is a copyleft
     license designed for free software.

     We have designed this License in order to use it for manuals for
     free software, because free software needs free documentation: a
     free program should come with manuals providing the same freedoms
     that the software does.  But this License is not limited to
     software manuals; it can be used for any textual work, regardless
     of subject matter or whether it is published as a printed book.  We
     recommend this License principally for works whose purpose is
     instruction or reference.

  1. APPLICABILITY AND DEFINITIONS

     This License applies to any manual or other work, in any medium,
     that contains a notice placed by the copyright holder saying it can
     be distributed under the terms of this License.  Such a notice
     grants a world-wide, royalty-free license, unlimited in duration,
     to use that work under the conditions stated herein.  The
     "Document", below, refers to any such manual or work.  Any member
     of the public is a licensee, and is addressed as "you".  You accept
     the license if you copy, modify or distribute the work in a way
     requiring permission under copyright law.

     A "Modified Version" of the Document means any work containing the
     Document or a portion of it, either copied verbatim, or with
     modifications and/or translated into another language.

     A "Secondary Section" is a named appendix or a front-matter section
     of the Document that deals exclusively with the relationship of the
     publishers or authors of the Document to the Document's overall
     subject (or to related matters) and contains nothing that could
     fall directly within that overall subject.  (Thus, if the Document
     is in part a textbook of mathematics, a Secondary Section may not
     explain any mathematics.)  The relationship could be a matter of
     historical connection with the subject or with related matters, or
     of legal, commercial, philosophical, ethical or political position
     regarding them.

     The "Invariant Sections" are certain Secondary Sections whose
     titles are designated, as being those of Invariant Sections, in the
     notice that says that the Document is released under this License.
     If a section does not fit the above definition of Secondary then it
     is not allowed to be designated as Invariant.  The Document may
     contain zero Invariant Sections.  If the Document does not identify
     any Invariant Sections then there are none.

     The "Cover Texts" are certain short passages of text that are
     listed, as Front-Cover Texts or Back-Cover Texts, in the notice
     that says that the Document is released under this License.  A
     Front-Cover Text may be at most 5 words, and a Back-Cover Text may
     be at most 25 words.

     A "Transparent" copy of the Document means a machine-readable copy,
     represented in a format whose specification is available to the
     general public, that is suitable for revising the document
     straightforwardly with generic text editors or (for images composed
     of pixels) generic paint programs or (for drawings) some widely
     available drawing editor, and that is suitable for input to text
     formatters or for automatic translation to a variety of formats
     suitable for input to text formatters.  A copy made in an otherwise
     Transparent file format whose markup, or absence of markup, has
     been arranged to thwart or discourage subsequent modification by
     readers is not Transparent.  An image format is not Transparent if
     used for any substantial amount of text.  A copy that is not
     "Transparent" is called "Opaque".

     Examples of suitable formats for Transparent copies include plain
     ASCII without markup, Texinfo input format, LaTeX input format,
     SGML or XML using a publicly available DTD, and standard-conforming
     simple HTML, PostScript or PDF designed for human modification.
     Examples of transparent image formats include PNG, XCF and JPG.
     Opaque formats include proprietary formats that can be read and
     edited only by proprietary word processors, SGML or XML for which
     the DTD and/or processing tools are not generally available, and
     the machine-generated HTML, PostScript or PDF produced by some word
     processors for output purposes only.

     The "Title Page" means, for a printed book, the title page itself,
     plus such following pages as are needed to hold, legibly, the
     material this License requires to appear in the title page.  For
     works in formats which do not have any title page as such, "Title
     Page" means the text near the most prominent appearance of the
     work's title, preceding the beginning of the body of the text.

     The "publisher" means any person or entity that distributes copies
     of the Document to the public.

     A section "Entitled XYZ" means a named subunit of the Document
     whose title either is precisely XYZ or contains XYZ in parentheses
     following text that translates XYZ in another language.  (Here XYZ
     stands for a specific section name mentioned below, such as
     "Acknowledgements", "Dedications", "Endorsements", or "History".)
     To "Preserve the Title" of such a section when you modify the
     Document means that it remains a section "Entitled XYZ" according
     to this definition.

     The Document may include Warranty Disclaimers next to the notice
     which states that this License applies to the Document.  These
     Warranty Disclaimers are considered to be included by reference in
     this License, but only as regards disclaiming warranties: any other
     implication that these Warranty Disclaimers may have is void and
     has no effect on the meaning of this License.

  2. VERBATIM COPYING

     You may copy and distribute the Document in any medium, either
     commercially or noncommercially, provided that this License, the
     copyright notices, and the license notice saying this License
     applies to the Document are reproduced in all copies, and that you
     add no other conditions whatsoever to those of this License.  You
     may not use technical measures to obstruct or control the reading
     or further copying of the copies you make or distribute.  However,
     you may accept compensation in exchange for copies.  If you
     distribute a large enough number of copies you must also follow the
     conditions in section 3.

     You may also lend copies, under the same conditions stated above,
     and you may publicly display copies.

  3. COPYING IN QUANTITY

     If you publish printed copies (or copies in media that commonly
     have printed covers) of the Document, numbering more than 100, and
     the Document's license notice requires Cover Texts, you must
     enclose the copies in covers that carry, clearly and legibly, all
     these Cover Texts: Front-Cover Texts on the front cover, and
     Back-Cover Texts on the back cover.  Both covers must also clearly
     and legibly identify you as the publisher of these copies.  The
     front cover must present the full title with all words of the title
     equally prominent and visible.  You may add other material on the
     covers in addition.  Copying with changes limited to the covers, as
     long as they preserve the title of the Document and satisfy these
     conditions, can be treated as verbatim copying in other respects.

     If the required texts for either cover are too voluminous to fit
     legibly, you should put the first ones listed (as many as fit
     reasonably) on the actual cover, and continue the rest onto
     adjacent pages.

     If you publish or distribute Opaque copies of the Document
     numbering more than 100, you must either include a machine-readable
     Transparent copy along with each Opaque copy, or state in or with
     each Opaque copy a computer-network location from which the general
     network-using public has access to download using public-standard
     network protocols a complete Transparent copy of the Document, free
     of added material.  If you use the latter option, you must take
     reasonably prudent steps, when you begin distribution of Opaque
     copies in quantity, to ensure that this Transparent copy will
     remain thus accessible at the stated location until at least one
     year after the last time you distribute an Opaque copy (directly or
     through your agents or retailers) of that edition to the public.

     It is requested, but not required, that you contact the authors of
     the Document well before redistributing any large number of copies,
     to give them a chance to provide you with an updated version of the
     Document.

  4. MODIFICATIONS

     You may copy and distribute a Modified Version of the Document
     under the conditions of sections 2 and 3 above, provided that you
     release the Modified Version under precisely this License, with the
     Modified Version filling the role of the Document, thus licensing
     distribution and modification of the Modified Version to whoever
     possesses a copy of it.  In addition, you must do these things in
     the Modified Version:

       A. Use in the Title Page (and on the covers, if any) a title
          distinct from that of the Document, and from those of previous
          versions (which should, if there were any, be listed in the
          History section of the Document).  You may use the same title
          as a previous version if the original publisher of that
          version gives permission.

       B. List on the Title Page, as authors, one or more persons or
          entities responsible for authorship of the modifications in
          the Modified Version, together with at least five of the
          principal authors of the Document (all of its principal
          authors, if it has fewer than five), unless they release you
          from this requirement.

       C. State on the Title page the name of the publisher of the
          Modified Version, as the publisher.

       D. Preserve all the copyright notices of the Document.

       E. Add an appropriate copyright notice for your modifications
          adjacent to the other copyright notices.

       F. Include, immediately after the copyright notices, a license
          notice giving the public permission to use the Modified
          Version under the terms of this License, in the form shown in
          the Addendum below.

       G. Preserve in that license notice the full lists of Invariant
          Sections and required Cover Texts given in the Document's
          license notice.

       H. Include an unaltered copy of this License.

       I. Preserve the section Entitled "History", Preserve its Title,
          and add to it an item stating at least the title, year, new
          authors, and publisher of the Modified Version as given on the
          Title Page.  If there is no section Entitled "History" in the
          Document, create one stating the title, year, authors, and
          publisher of the Document as given on its Title Page, then add
          an item describing the Modified Version as stated in the
          previous sentence.

       J. Preserve the network location, if any, given in the Document
          for public access to a Transparent copy of the Document, and
          likewise the network locations given in the Document for
          previous versions it was based on.  These may be placed in the
          "History" section.  You may omit a network location for a work
          that was published at least four years before the Document
          itself, or if the original publisher of the version it refers
          to gives permission.

       K. For any section Entitled "Acknowledgements" or "Dedications",
          Preserve the Title of the section, and preserve in the section
          all the substance and tone of each of the contributor
          acknowledgements and/or dedications given therein.

       L. Preserve all the Invariant Sections of the Document, unaltered
          in their text and in their titles.  Section numbers or the
          equivalent are not considered part of the section titles.

       M. Delete any section Entitled "Endorsements".  Such a section
          may not be included in the Modified Version.

       N. Do not retitle any existing section to be Entitled
          "Endorsements" or to conflict in title with any Invariant
          Section.

       O. Preserve any Warranty Disclaimers.

     If the Modified Version includes new front-matter sections or
     appendices that qualify as Secondary Sections and contain no
     material copied from the Document, you may at your option designate
     some or all of these sections as invariant.  To do this, add their
     titles to the list of Invariant Sections in the Modified Version's
     license notice.  These titles must be distinct from any other
     section titles.

     You may add a section Entitled "Endorsements", provided it contains
     nothing but endorsements of your Modified Version by various
     parties--for example, statements of peer review or that the text
     has been approved by an organization as the authoritative
     definition of a standard.

     You may add a passage of up to five words as a Front-Cover Text,
     and a passage of up to 25 words as a Back-Cover Text, to the end of
     the list of Cover Texts in the Modified Version.  Only one passage
     of Front-Cover Text and one of Back-Cover Text may be added by (or
     through arrangements made by) any one entity.  If the Document
     already includes a cover text for the same cover, previously added
     by you or by arrangement made by the same entity you are acting on
     behalf of, you may not add another; but you may replace the old
     one, on explicit permission from the previous publisher that added
     the old one.

     The author(s) and publisher(s) of the Document do not by this
     License give permission to use their names for publicity for or to
     assert or imply endorsement of any Modified Version.

  5. COMBINING DOCUMENTS

     You may combine the Document with other documents released under
     this License, under the terms defined in section 4 above for
     modified versions, provided that you include in the combination all
     of the Invariant Sections of all of the original documents,
     unmodified, and list them all as Invariant Sections of your
     combined work in its license notice, and that you preserve all
     their Warranty Disclaimers.

     The combined work need only contain one copy of this License, and
     multiple identical Invariant Sections may be replaced with a single
     copy.  If there are multiple Invariant Sections with the same name
     but different contents, make the title of each such section unique
     by adding at the end of it, in parentheses, the name of the
     original author or publisher of that section if known, or else a
     unique number.  Make the same adjustment to the section titles in
     the list of Invariant Sections in the license notice of the
     combined work.

     In the combination, you must combine any sections Entitled
     "History" in the various original documents, forming one section
     Entitled "History"; likewise combine any sections Entitled
     "Acknowledgements", and any sections Entitled "Dedications".  You
     must delete all sections Entitled "Endorsements."

  6. COLLECTIONS OF DOCUMENTS

     You may make a collection consisting of the Document and other
     documents released under this License, and replace the individual
     copies of this License in the various documents with a single copy
     that is included in the collection, provided that you follow the
     rules of this License for verbatim copying of each of the documents
     in all other respects.

     You may extract a single document from such a collection, and
     distribute it individually under this License, provided you insert
     a copy of this License into the extracted document, and follow this
     License in all other respects regarding verbatim copying of that
     document.

  7. AGGREGATION WITH INDEPENDENT WORKS

     A compilation of the Document or its derivatives with other
     separate and independent documents or works, in or on a volume of a
     storage or distribution medium, is called an "aggregate" if the
     copyright resulting from the compilation is not used to limit the
     legal rights of the compilation's users beyond what the individual
     works permit.  When the Document is included in an aggregate, this
     License does not apply to the other works in the aggregate which
     are not themselves derivative works of the Document.

     If the Cover Text requirement of section 3 is applicable to these
     copies of the Document, then if the Document is less than one half
     of the entire aggregate, the Document's Cover Texts may be placed
     on covers that bracket the Document within the aggregate, or the
     electronic equivalent of covers if the Document is in electronic
     form.  Otherwise they must appear on printed covers that bracket
     the whole aggregate.

  8. TRANSLATION

     Translation is considered a kind of modification, so you may
     distribute translations of the Document under the terms of section
     4.  Replacing Invariant Sections with translations requires special
     permission from their copyright holders, but you may include
     translations of some or all Invariant Sections in addition to the
     original versions of these Invariant Sections.  You may include a
     translation of this License, and all the license notices in the
     Document, and any Warranty Disclaimers, provided that you also
     include the original English version of this License and the
     original versions of those notices and disclaimers.  In case of a
     disagreement between the translation and the original version of
     this License or a notice or disclaimer, the original version will
     prevail.

     If a section in the Document is Entitled "Acknowledgements",
     "Dedications", or "History", the requirement (section 4) to
     Preserve its Title (section 1) will typically require changing the
     actual title.

  9. TERMINATION

     You may not copy, modify, sublicense, or distribute the Document
     except as expressly provided under this License.  Any attempt
     otherwise to copy, modify, sublicense, or distribute it is void,
     and will automatically terminate your rights under this License.

     However, if you cease all violation of this License, then your
     license from a particular copyright holder is reinstated (a)
     provisionally, unless and until the copyright holder explicitly and
     finally terminates your license, and (b) permanently, if the
     copyright holder fails to notify you of the violation by some
     reasonable means prior to 60 days after the cessation.

     Moreover, your license from a particular copyright holder is
     reinstated permanently if the copyright holder notifies you of the
     violation by some reasonable means, this is the first time you have
     received notice of violation of this License (for any work) from
     that copyright holder, and you cure the violation prior to 30 days
     after your receipt of the notice.

     Termination of your rights under this section does not terminate
     the licenses of parties who have received copies or rights from you
     under this License.  If your rights have been terminated and not
     permanently reinstated, receipt of a copy of some or all of the
     same material does not give you any rights to use it.

  10. FUTURE REVISIONS OF THIS LICENSE

     The Free Software Foundation may publish new, revised versions of
     the GNU Free Documentation License from time to time.  Such new
     versions will be similar in spirit to the present version, but may
     differ in detail to address new problems or concerns.  See
     <http://www.gnu.org/copyleft/>.

     Each version of the License is given a distinguishing version
     number.  If the Document specifies that a particular numbered
     version of this License "or any later version" applies to it, you
     have the option of following the terms and conditions either of
     that specified version or of any later version that has been
     published (not as a draft) by the Free Software Foundation.  If the
     Document does not specify a version number of this License, you may
     choose any version ever published (not as a draft) by the Free
     Software Foundation.  If the Document specifies that a proxy can
     decide which future versions of this License can be used, that
     proxy's public statement of acceptance of a version permanently
     authorizes you to choose that version for the Document.

  11. RELICENSING

     "Massive Multiauthor Collaboration Site" (or "MMC Site") means any
     World Wide Web server that publishes copyrightable works and also
     provides prominent facilities for anybody to edit those works.  A
     public wiki that anybody can edit is an example of such a server.
     A "Massive Multiauthor Collaboration" (or "MMC") contained in the
     site means any set of copyrightable works thus published on the MMC
     site.

     "CC-BY-SA" means the Creative Commons Attribution-Share Alike 3.0
     license published by Creative Commons Corporation, a not-for-profit
     corporation with a principal place of business in San Francisco,
     California, as well as future copyleft versions of that license
     published by that same organization.

     "Incorporate" means to publish or republish a Document, in whole or
     in part, as part of another Document.

     An MMC is "eligible for relicensing" if it is licensed under this
     License, and if all works that were first published under this
     License somewhere other than this MMC, and subsequently
     incorporated in whole or in part into the MMC, (1) had no cover
     texts or invariant sections, and (2) were thus incorporated prior
     to November 1, 2008.

     The operator of an MMC Site may republish an MMC contained in the
     site under CC-BY-SA on the same site at any time before August 1,
     2009, provided the MMC is eligible for relicensing.

ADDENDUM: How to use this License for your documents
====================================================

To use this License in a document you have written, include a copy of
the License in the document and put the following copyright and license
notices just after the title page:

       Copyright (C)  YEAR  YOUR NAME.
       Permission is granted to copy, distribute and/or modify this document
       under the terms of the GNU Free Documentation License, Version 1.3
       or any later version published by the Free Software Foundation;
       with no Invariant Sections, no Front-Cover Texts, and no Back-Cover
       Texts.  A copy of the license is included in the section entitled ``GNU
       Free Documentation License''.

   If you have Invariant Sections, Front-Cover Texts and Back-Cover
Texts, replace the "with...Texts."  line with this:

         with the Invariant Sections being LIST THEIR TITLES, with
         the Front-Cover Texts being LIST, and with the Back-Cover Texts
         being LIST.

   If you have Invariant Sections without Cover Texts, or some other
combination of the three, merge those two alternatives to suit the
situation.

   If your document contains nontrivial examples of program code, we
recommend releasing these examples in parallel under your choice of free
software license, such as the GNU General Public License, to permit
their use in free software.



Tag Table:

End Tag Table
bbdb-20200102.403/bbdb.el0000644000175000017500000063726413643253537012142 0ustar  cbcb;;; bbdb.el --- core of BBDB -*- lexical-binding: t -*-

;; Copyright (C) 2010-2019  Free Software Foundation, Inc.

;; Maintainer: Roland Winkler <winkler@gnu.org>
;; Version: 3.2
;; Package-Requires: ((emacs "24"))

;; This file is part of the Insidious Big Brother Database (aka BBDB),

;; BBDB 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.

;; BBDB 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 BBDB.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This file is the core of the Insidious Big Brother Database (aka BBDB),
;; See the BBDB info manual for documentation.
;;
;;  -----------------------------------------------------------------------
;; |  There is a mailing list for discussion of BBDB:                      |
;; |         bbdb-user@nongnu.org                                          |
;; |  To join, go to https://lists.nongnu.org/mailman/listinfo/bbdb-user   |
;; |                                                                       |
;; |  When joining this list or reporting bugs, please mention which       |
;; |  version of BBDB you have.                                            |
;;  -----------------------------------------------------------------------

;;; Code:

(require 'timezone)
(require 'bbdb-site)

;; When running BBDB, we have (require 'bbdb-autoloads)
(declare-function widget-group-match "wid-edit")
(declare-function bbdb-migrate "bbdb-migrate")
(declare-function bbdb-do-records "bbdb-com")
(declare-function bbdb-append-display-p "bbdb-com")
(declare-function bbdb-toggle-records-layout "bbdb-com")
(declare-function bbdb-dwim-mail "bbdb-com")
(declare-function bbdb-layout-prefix "bbdb-com")
(declare-function bbdb-completing-read-records "bbdb-com")
(declare-function bbdb-merge-records "bbdb-com")
(declare-function mail-position-on-field "sendmail")
(declare-function vm-select-folder-buffer "vm-folder")

;; cannot use autoload for variables...
(defvar message-mode-map) ;; message.el
(defvar mail-mode-map) ;; sendmail.el
(defvar gnus-article-buffer) ;; gnus-art.el

;; Custom groups

(defgroup bbdb nil
  "The Insidious Big Brother Database."
  :group 'news
  :group 'mail)

(defgroup bbdb-record-display nil
  "Variables that affect the display of BBDB records"
  :group 'bbdb)

(defgroup bbdb-record-edit nil
  "Variables that affect the editing of BBDB records"
  :group 'bbdb)

(defgroup bbdb-sendmail nil
  "Variables that affect sending mail."
  :group 'bbdb)

(defgroup bbdb-mua nil
  "Variables that specify the BBDB-MUA interface"
  :group 'bbdb)

(defgroup bbdb-mua-gnus nil
  "Gnus-specific BBDB customizations"
  :group 'bbdb-mua)
(put 'bbdb-mua-gnus 'custom-loads '(bbdb-gnus))

(defgroup bbdb-mua-gnus-scoring nil
  "Gnus-specific scoring BBDB customizations"
  :group 'bbdb-mua-gnus)
(put 'bbdb-mua-gnus-scoring 'custom-loads '(bbdb-gnus))

(defgroup bbdb-mua-gnus-splitting nil
  "Gnus-specific splitting BBDB customizations"
  :group 'bbdb-mua-gnus)
(put 'bbdb-mua-gnus-splitting 'custom-loads '(bbdb-gnus))

(defgroup bbdb-mua-vm nil
  "VM-specific BBDB customizations"
  :group 'bbdb-mua)
(put 'bbdb-mua-vm 'custom-loads '(bbdb-vm))

(defgroup bbdb-mua-message nil
  "Message-specific BBDB customizations"
  :group 'bbdb-mua)
(put 'bbdb-mua-message 'custom-loads '(bbdb-message))

(defgroup bbdb-utilities nil
  "Customizations for BBDB Utilities"
  :group 'bbdb)

(defgroup bbdb-utilities-dialing nil
  "BBDB Customizations for phone number dialing"
  :group 'bbdb)

(defgroup bbdb-utilities-tex nil
  "Customizations for TeXing BBDB."
  :group 'bbdb)
(put 'bbdb-utilities-tex 'custom-loads '(bbdb-tex))

(defgroup bbdb-utilities-anniv nil
  "Customizations for BBDB Anniversaries"
  :group 'bbdb-utilities)
(put 'bbdb-utilities-anniv 'custom-loads '(bbdb-anniv))

(defgroup bbdb-utilities-ispell nil
  "Customizations for BBDB ispell interface"
  :group 'bbdb-utilities)
(put 'bbdb-utilities-ispell 'custom-loads '(bbdb-ispell))

(defgroup bbdb-utilities-snarf nil
  "Customizations for BBDB snarf"
  :group 'bbdb-utilities)
(put 'bbdb-utilities-snarf 'custom-loads '(bbdb-snarf))

(defgroup bbdb-utilities-pgp nil
  "Customizations for BBDB pgp"
  :group 'bbdb-utilities)
(put 'bbdb-utilities-pgp 'custom-loads '(bbdb-pgp))

(defgroup bbdb-utilities-sc nil
  "Customizations for using Supercite with the BBDB."
  :group 'bbdb-utilities
  :prefix "bbdb-sc")
(put 'bbdb-utilities-sc 'custom-loads '(bbdb-sc))

;;; Customizable variables
(defcustom bbdb-file (locate-user-emacs-file "bbdb" ".bbdb")
  "The name of the Insidious Big Brother Database file."
  :group 'bbdb
  :type 'file)

;; This should be removed, and the following put in place:
;; a hierarchical structure of bbdb files, some perhaps read-only,
;; perhaps caching in the local bbdb. This way one could have, e.g. an
;; organization address book, with each person having access to it, and
;; then a local address book with personal stuff in it.
(defcustom bbdb-file-remote nil
  "The remote file to save the BBDB database to.
When this is non-nil, it should be a file name.
When BBDB reads `bbdb-file', it also checks this file,
and if it is newer than `bbdb-file', it loads this file.
When BBDB writes `bbdb-file', it also writes this file.

This feature allows one to keep the database in one place while using
different computers, thus reducing the need for merging different files."
  :group 'bbdb
  :type '(choice (const :tag "none" nil)
                 (file :tag "remote file name")))

(defcustom bbdb-file-remote-save-always t
  "If t `bbdb-file-remote' is saved automatically when `bbdb-file' is saved.
When nil, ask."
  :group 'bbdb
  :type 'boolean)

(defcustom bbdb-read-only nil
  "If t then BBDB will not modify `bbdb-file'.
If you have more than one Emacs running at the same time, you might want
to set this to t in all but one of them."
  :group 'bbdb
  :type '(choice (const :tag "Database is read-only" t)
                 (const :tag "Database is writable" nil)))

(defcustom bbdb-auto-revert nil
  "If t revert unchanged database without querying.
If t and `bbdb-file' has changed on disk, while the database
has not been modified inside Emacs, revert the database automatically.
If nil or the database has been changed inside Emacs, always query
before reverting."
  :group 'bbdb
  :type '(choice (const :tag "Revert unchanged database without querying" t)
                 (const :tag "Ask before reverting database" nil)))

(defcustom bbdb-check-auto-save-file nil
  "If t BBDB will check its auto-save file.
If this file is newer than `bbdb-file', BBDB will offer to revert."
  :group 'bbdb
  :type '(choice (const :tag "Check auto-save file" t)
                 (const :tag "Do not check auto-save file" nil)))

(defcustom bbdb-before-save-hook nil
  "Hook run before saving `bbdb-file'."
  :group 'bbdb
  :type 'hook)

(defcustom bbdb-after-save-hook nil
  "Hook run after saving `bbdb-file'."
  :group 'bbdb
  :type 'hook)

(defcustom bbdb-create-hook nil
  "*Hook run each time a new BBDB record is created.
Run with one argument, the new record.  This is called before the record is
added to the database, followed by a call of `bbdb-change-hook'.

If a record has been created by analyzing a mail message, hook functions
can use the variable `bbdb-update-records-address' to determine the header
and class of the mail address according to `bbdb-message-headers'."
  :group 'bbdb
  :type 'hook)

(defcustom bbdb-change-hook nil
  "*Hook run each time a BBDB record is changed.
Run with one argument, the record.  This is called before the database
is modified.  If a new bbdb record is created, `bbdb-create-hook' is called
first, followed by a call of this hook."
  :group 'bbdb
  :type 'hook)

(defcustom bbdb-merge-records-function #'bbdb-merge-records
  "If non-nil, a function for merging two records.
This function is called when loading a record into BBDB that has the same uuid
as an exisiting record.
This function should take two arguments RECORD1 and RECORD2, with RECORD2
being the already existing record.  It should merge RECORD1 into RECORD2,
and return RECORD2."
  :group 'bbdb
  :type 'function)

(defcustom bbdb-time-stamp-format "%Y-%m-%d %T %z"
  "The BBDB time stamp format.  See `format-time-string'.
This function is called with arg UNIVERSAL being non-nil."
  :group 'bbdb
  :type 'string)

(defcustom bbdb-after-change-hook nil
  "Hook run each time a BBDB record is changed.
Run with one argument, the record.  This is called after the database
is modified.  So if you want to modify a record when it is created or changed,
use instead `bbdb-create-hook' and / or `bbdb-change-hook'."
  :group 'bbdb
  :type 'hook)

(defcustom bbdb-after-read-db-hook nil
  "Hook run (with no arguments) after `bbdb-file' is read.
Note that this can be called more than once if the BBDB is reverted."
  :group 'bbdb
  :type 'hook)

(defcustom bbdb-initialize-hook nil
  "Normal hook run after the BBDB initialization function `bbdb-initialize'."
  :group 'bbdb
  :type 'hook)

(defcustom bbdb-mode-hook nil
  "Normal hook run when the *BBDB* buffer is created."
  :group 'bbdb
  :type 'hook)

(defcustom bbdb-silent nil
  "If t, BBDB suppresses all its informational messages and queries.
Be very very certain you want to set this to t, because it will suppress
queries to alter record names, assign names to addresses, etc.
Lisp Hackers: See also `bbdb-silent-internal'."
  :group 'bbdb
  :type '(choice (const :tag "Run silently" t)
                 (const :tag "Disable silent running" nil)))

(defcustom bbdb-info-file nil
  "Location of the bbdb info file, if it's not in the standard place."
  :group 'bbdb
  :type '(choice (const :tag "Standard location" nil)
                 (file :tag "Nonstandard location")))


;;; Record display

(defcustom bbdb-pop-up-window-size 0.5
  "Vertical size of BBDB window (vertical split).
If it is an integer number, it is the number of lines used by BBDB.
If it is a fraction between 0.0 and 1.0 (inclusive), it is the fraction
of the tallest existing window that BBDB will take over.
If it is t use `display-buffer'/`pop-to-buffer' to create the BBDB window.
See also `bbdb-mua-pop-up-window-size'."
  :group 'bbdb-record-display
  :type '(choice (number :tag "BBDB window size")
                 (const :tag "Use `pop-to-buffer'" t)))

(defcustom bbdb-dedicated-window nil
  "Make *BBDB* window a dedicated window.
Allowed values include nil (not dedicated) 'bbdb (weakly dedicated)
and t (strongly dedicated)."
  :group 'bbdb-record-display
  :type '(choice (const :tag "BBDB window not dedicated" nil)
                 (const :tag "BBDB window weakly dedicated" bbdb)
                 (const :tag "BBDB window strongly dedicated" t)))

(defcustom bbdb-layout-alist
  '((one-line           (order     . (phone mail-alias mail notes))
                        (name-end  . 24)
                        (toggle    . t))
    (multi-line         (omit      . (uuid creation-date timestamp
                                           name-format name-face))
                        (toggle    . t)
                        (indentation . 21))
    (pop-up-multi-line  (omit      . (uuid creation-date timestamp
                                           name-format name-face))
                        (indentation . 21))
    (full-multi-line    (indentation . 21)))
  "Alist describing each display layout.
The format of an element is (LAYOUT-NAME OPTION-ALIST).

By default there are four different layout types used by BBDB, which are
`one-line', `multi-line', `pop-up-multi-line' (used for pop-ups) and
`full-multi-line' (showing all fields of a record).

OPTION-ALIST specifies the options for the layout.  Valid options are:

                           ------- Availability --------
    Format                  one-line        multi-line        default if unset
------------------------------------------------------------------------------
 (toggle . BOOL)                 +               +              nil
 (order . FIELD-LIST)            +               +              '(phone ...)
 (omit . FIELD-LIST)             +               +              nil
 (name-end . INTEGER)            +               -              40
 (indentation . INTEGER)         -               +              21
 (primary . BOOL)                -               +              nil
 (display-p . FUNCTION)          +               +              nil

- toggle: controls if this layout is included when toggeling the layout
- order: defines a user specific order for the fields, where t is a place
  holder for all remaining fields
- omit: is a list of xfields which should not be displayed
  or t to exclude all xfields except those listed in the order option
- name-end: sets the column where the name should end in one-line layout.
- indentation: sets the level of indentation for multi-line display.
- primary: controls whether only the primary mail is shown or all are shown.
- display-p: a function controlling whether the record is to be displayed.

When you add a new layout FOO, you can write a corresponding layout
function `bbdb-display-record-layout-FOO'.  If you do not write your own
layout function, the multi-line layout will be used."
  :group 'bbdb-record-display
  :type
  `(repeat
    (cons :tag "Layout Definition"
          (choice :tag "Layout type"
                  (const one-line)
                  (const multi-line)
                  (const pop-up-multi-line)
                  (const full-multi-line)
                  (symbol))
          (set :tag "Properties"
               (cons :tag "Order"
                     (const :tag "List of fields to order by" order)
                     (repeat (choice (const phone)
                                     (const address)
                                     (const mail)
                                     (const AKA)
                                     (const notes)
                                     (symbol :tag "other")
                                     (const :tag "Remaining fields" t))))
               (choice :tag "Omit"
                       :value (omit . nil)
                       (cons :tag "List of fields to omit"
                             (const :tag "Fields not to display" omit)
                             (repeat (choice (const phone)
                                             (const address)
                                             (const mail)
                                             (const AKA)
                                             (const notes)
                                             (symbol :tag "other"))))
                       (const :tag "Exclude all fields except those listed in the order note" t))
               (cons :tag "Indentation"
                     :value (indentation . 14)
                     (const :tag "Level of indentation for multi-line layout"
                            indentation)
                     (number :tag "Column"))
               (cons :tag "End of name field"
                     :value (name-end . 24)
                     (const :tag "The column where the name should end in one-line layout"
                            name-end)
                     (number :tag "Column"))
               (cons :tag "Toggle"
                     (const :tag "The layout is included when toggling layout" toggle)
                     boolean)
               (cons :tag "Primary Mail Only"
                     (const :tag "Only the primary mail address is included" primary)
                     boolean)
               (cons :tag "Display-p"
                     (const :tag "Show only records passing this test" display-p)
                     (choice (const :tag "No test" nil)
                             (function :tag "Predicate")))))))

(defcustom bbdb-layout 'multi-line
  "Default display layout."
  :group 'bbdb-record-display
  :type '(choice (const one-line)
                 (const multi-line)
                 (const full-multi-line)
                 (symbol)))

(defcustom bbdb-pop-up-layout 'pop-up-multi-line
  "Default layout for pop-up BBDB buffers (mail, news, etc.)."
  :group 'bbdb-record-display
  :type '(choice (const one-line)
                 (const multi-line)
                 (const full-multi-line)
                 (symbol)))

(defcustom bbdb-wrap-column nil
  "Wrap column for multi-line display.  If nil do not wrap lines."
  :group 'bbdb-record-display
  :type '(choice (const :tag "No line wrapping" nil)
                 (number :tag "Wrap column")))

(defcustom bbdb-case-fold-search (default-value 'case-fold-search)
  "Value of `case-fold-search' used by BBDB and friends.
This variable lets the case-sensitivity of the BBDB commands
be different from standard commands like command `isearch-forward'."
  :group 'bbdb-record-display
  :type 'boolean)

(defcustom bbdb-name-format 'first-last
  "Format for displaying names.
If first-last names are displayed as \"Firstname Lastname\".
If last-first names are displayed as \"Lastname, Firstname\".
This can be overriden per record via the xfield name-format,
which should take the same values.
See also `bbdb-read-name-format'."
  :group 'bbdb-record-display
  :type '(choice (const :tag "Firstname Lastname" first-last)
                 (const :tag "Lastname, Firstname" last-first)))

;; See http://en.wikipedia.org/wiki/Postal_address
;; http://www.upu.int/en/activities/addressing/postal-addressing-systems-in-member-countries.html
(defcustom bbdb-address-format-list
  '((("Argentina") "spcSC" "@%s\n@%p, @%c@, %S@\n%C@" "@%c@")
    (("Australia") "scSpC" "@%s\n@%c@ %S@ %p@\n%C@" "@%c@")
    (("Austria" "Germany" "Spain" "Switzerland")
     "spcSC" "@%s\n@%p @%c@ (%S)@\n%C@" "@%c@")
    (("Canada") "scSCp" "@%s\n@%c@, %S@\n%C@ %p@" "@%c@")
    (("China") "scpSC" "@%s\n@%c@\n%p@ %S@\n%C@" "@%c@") ; English format
    ; (("China") "CpScs" "@%C @%p\n@%S @%c@ %s@" "@%c@") ; Chinese format
    (("India") "scpSC" "@%s\n@%c@ %p@ (%S)@\n%C@" "@%c@")
    (("USA") "scSpC" "@%s\n@%c@, %S@ %p@\n%C@" "@%c@")
    (t bbdb-edit-address-default bbdb-format-address-default "@%c@"))
  "List of address editing and formatting rules for BBDB.
Each rule is a list (IDENTIFIER EDIT FORMAT FORMAT).
The first rule for which IDENTIFIER matches an address is used for editing
and formatting the address.

IDENTIFIER may be a list of countries.
IDENTIFIER may also be a function that is called with one arg, the address
to be used.  The rule applies if the function returns non-nil.
See `bbdb-address-continental-p' for an example.
If IDENTIFIER is t, this rule always applies.  Usually, this should be
the last rule that becomes a fall-back (default).

EDIT may be a function that is called with one argument, the address.
See `bbdb-edit-address-default' for an example.

EDIT may also be an editting format string.  It is a string containing
the five letters s, c, p, S, and C that specify the order for editing
the five elements of an address:

s  streets
c  city
p  postcode
S  state
C  country

The first FORMAT of each rule is used for multi-line layout, the second FORMAT
is used for one-line layout.

FORMAT may be a function that is called with one argument, the address.
See `bbdb-format-address-default' for an example.

FORMAT may also be a format string.  It consists of formatting elements
separated by a delimiter defined via the first (and last) character of FORMAT.
Each formatting element may contain one of the following format specifiers:

%s  streets (used repeatedly for each street part)
%c  city
%p  postcode
%S  state
%C  country

A formatting element will be applied only if the corresponding part
of the address is a non-empty string.

See also `bbdb-tex-address-format-list'."
  :group 'bbdb-record-display
  :type '(repeat (list (choice (const :tag "Default" t)
                               (function :tag "Function")
                               (repeat (string)))
                       (choice (string)
                               (function :tag "Function"))
                       (choice (string)
                               (function :tag "Function"))
                       (choice (string)
                               (function :tag "Function")))))

(defcustom bbdb-continental-postcode-regexp
  "^\\s *[A-Z][A-Z]?\\s *-\\s *[0-9][0-9][0-9]"
  "Regexp matching continental postcodes.
Used by address format identifier `bbdb-address-continental-p'.
The regexp should match postcodes of the form CH-8052, NL-2300RA,
and SE-132 54."
  :group 'bbdb-record-display
  :type 'regexp)

(defcustom bbdb-default-separator '("[,;]" ", ")
  "The default field separator.  It is a list (SPLIT-RE JOIN).
This is used for fields which do not have an entry in `bbdb-separator-alist'.
Whitespace surrounding SPLIT-RE is ignored."
  :group 'bbdb-record-display
  :type '(list regexp string))

(defcustom bbdb-separator-alist
  '((record "\n\n" "\n\n") ; used by `bbdb-copy-fields-as-kill'
    (name-first-last "[ ,;]" " ") (name-last-first "[ ,;]" ", ")
    (name-field ":\n" ":\n") ; used by `bbdb-copy-fields-as-kill'
    (phone "[,;]" ", ") (address ";\n" ";\n") ; ditto
    (organization "[,;]" ", ") (affix "[,;]"  ", ") (aka "[,;]" ", ")
    (mail "[,;]" ", ") (mail-alias "[,;]" ", ") (vm-folder "[,;]" ", ")
    (birthday "\n" "\n") (wedding "\n" "\n") (anniversary "\n" "\n")
    (notes "\n" "\n") (tex-name "#" " # "))
  "Alist of field separators.
Each element is of the form (FIELD SPLIT-RE JOIN).
Whitespace surrounding SPLIT-RE is ignored.
For fields lacking an entry here `bbdb-default-separator' is used instead."
  :group 'bbdb-record-display
  :type '(repeat (list symbol regexp string)))

(defcustom bbdb-user-menu-commands nil
  "User defined menu entries which should be appended to the BBDB menu.
This should be a list of menu entries.
When set to a function, it is called with two arguments RECORD and FIELD
and it should either return nil or a list of menu entries.
Used by `bbdb-mouse-menu'."
  :group 'bbdb-record-display
  :type 'sexp)

(defcustom bbdb-display-hook nil
  "Hook run after the *BBDB* is filled in."
  :group 'bbdb-record-display
  :type 'hook)

(defcustom bbdb-multiple-buffers nil
  "When non-nil we create a new buffer of every buffer causing pop-ups.
You can also set this to a function returning a buffer name.
Here a value may be the predefined function `bbdb-multiple-buffers-default'."
  :group 'bbdb-record-display
  :type '(choice (const :tag "Disabled" nil)
                 (function :tag "Enabled" bbdb-multiple-buffers-default)
                 (function :tag "User defined function")))

(defcustom bbdb-image nil
  "If non-nil display records with an image.
If a symbol this should be an xfield holding the name of the image file
associated with the record.  If it is `name' or `fl-name', the first and last
name of the record are used as file name.  If it is `lf-name', the last and
first name of the record are used as file name.
If a function it is called with one arg, the record, and it should return
the name of the image file.
The file is searched in the directories in `bbdb-image-path'.
File name suffixes are appended according to `bbdb-image-suffixes'.
See `locate-file'."
  :group 'bbdb-record-display
  :type '(choice (const :tag "Disabled" nil)
                 (function :tag "User defined function")
                 (symbol :tag "Record field")))

(defcustom bbdb-image-path nil
  "List of directories to search for `bbdb-image'."
  :group 'bbdb-record-display
  :type '(repeat (directory)))

(defcustom bbdb-image-suffixes '(".png" ".jpg" ".gif" ".xpm")
  "List of file name suffixes searched for `bbdb-image'."
  :group 'bbdb-record-display
  :type '(repeat (string :tag "File suffix")))

(defcustom bbdb-read-name-format 'fullname
  "Default format for reading names via `bbdb-read-name'.
If it is 'first-last read first and last name separately.
If it is 'last-first read last and first name separately.
With any other value read full name at once.
See also `bbdb-name-format'."
  :group 'bbdb-record-display
  :type '(choice (const :tag "Firstname Lastname" first-last)
                 (const :tag "Lastname, Firstname" last-first)
                 (const :tag "Full name" fullname)))


;;; Record editing
(defcustom bbdb-lastname-prefixes
 '("von" "de" "di")
  "List of lastname prefixes recognized in name fields.
Used to enhance dividing name strings into firstname and lastname parts.
Case is ignored."
  :group 'bbdb-record-edit
  :type '(repeat string))

(defcustom bbdb-lastname-re
  (concat "[- \t]*\\(\\(?:\\<"
          (regexp-opt bbdb-lastname-prefixes)
          ;; multiple last names concatenated by `-'
          "\\>[- \t]+\\)?\\(?:\\w+[ \t]*-[ \t]*\\)*\\w+\\)\\'")
  "Regexp matching the last name of a full name.
Its first parenthetical subexpression becomes the last name."
  :group 'bbdb-record-edit
  :type 'regexp)

(defcustom bbdb-lastname-suffixes
 '("Jr" "Sr" "II" "III")
  "List of lastname suffixes recognized in name fields.
Used to dividing name strings into firstname and lastname parts.
All suffixes are complemented by optional `.'.  Case is ignored."
  :group 'bbdb-record-edit
  :type '(repeat string))

(defcustom bbdb-lastname-suffix-re
  (concat "[-,. \t/\\]+\\("
          (regexp-opt bbdb-lastname-suffixes)
          ;; suffices are complemented by optional `.'.
          "\\.?\\)\\W*\\'")
  "Regexp matching the suffix of a last name.
Its first parenthetical subexpression becomes the suffix."
  :group 'bbdb-record-edit
  :type 'regexp)

(defcustom bbdb-default-domain nil
  "Default domain to append when reading a new mail address.
If a mail address does not contain `[@%!]', append @`bbdb-default-domain' to it.

The address is not altered if `bbdb-default-domain' is nil
or if a prefix argument is given to the command `bbdb-insert-field'."
  :group 'bbdb-record-edit
  :type '(choice (const :tag "none" nil)
                 (string :tag "Default Domain")))

(defcustom bbdb-phone-style 'nanp
  "Phone numbering plan assumed by BBDB.
The value 'nanp refers to the North American Numbering Plan.
The value nil refers to a free-style numbering plan.

You can have both styles of phone number in your database by providing a
prefix argument to the command `bbdb-insert-field'."
  :group 'bbdb-record-edit
  :type '(choice (const :tag "NANP" nanp)
                 (const :tag "none" nil)))

(defcustom bbdb-default-area-code nil
  "Default area code to use when reading a new phone number.
This variable also affects dialing."
  :group 'bbdb-record-edit
  :type '(choice (const :tag "none" nil)
                 (integer :tag "Default Area Code"))
  :set (lambda( symb val )
         (if (or (and (stringp val)
                      (string-match "^[0-9]+$" val))
                 (integerp val)
                 (null val))
             (set symb val)
           (error "%s must contain digits only." symb))))

(defcustom bbdb-allow-duplicates nil
  "When non-nil BBDB allows records with duplicate names and email addresses.
In rare cases, this may lead to confusion with BBDB's MUA interface."
  :group 'bbdb-record-edit
  :type 'boolean)

(defcustom bbdb-default-label-list '("home" "work" "other")
  "Default list of labels for Address and Phone fields."
  :group 'bbdb-record-edit
  :type '(repeat string))

(defcustom bbdb-address-label-list bbdb-default-label-list
  "List of labels for Address field."
  :group 'bbdb-record-edit
  :type '(repeat string))

(defcustom bbdb-phone-label-list '("home" "work" "cell" "other")
  "List of labels for Phone field."
  :group 'bbdb-record-edit
  :type '(repeat string))

(defcustom bbdb-default-country "Emacs";; what do you mean, it's not a country?
  "Default country to use if none is specified."
  :group 'bbdb-record-edit
  :type '(choice (const :tag "None" nil)
                 (string :tag "Default Country")))

(defcustom bbdb-check-postcode t
  "If non-nil, require legal postcodes when entering an address.
The format of legal postcodes is determined by the variable
`bbdb-legal-postcodes'."
  :group 'bbdb-record-edit
  :type 'boolean)

(defcustom bbdb-legal-postcodes
  '(;; empty string
    "^$"
    ;; Matches 1 to 6 digits.
    "^[ \t\n]*[0-9][0-9]?[0-9]?[0-9]?[0-9]?[0-9]?[ \t\n]*$"
    ;; Matches 5 digits and 3 or 4 digits.
    "^[ \t\n]*\\([0-9][0-9][0-9][0-9][0-9]\\)[ \t\n]*-?[ \t\n]*\\([0-9][0-9][0-9][0-9]?\\)[ \t\n]*$"
    ;; Match postcodes for Canada, UK, etc. (result is ("LL47" "U4B")).
    "^[ \t\n]*\\([A-Za-z0-9]+\\)[ \t\n]+\\([A-Za-z0-9]+\\)[ \t\n]*$"
    ;; Match postcodes for continental Europe.  Examples "CH-8057"
    ;; or "F - 83320" (result is ("CH" "8057") or ("F" "83320")).
    ;; Support for "NL-2300RA" added at request from Carsten Dominik
    ;; <dominik@astro.uva.nl>
    "^[ \t\n]*\\([A-Z]+\\)[ \t\n]*-?[ \t\n]*\\([0-9]+ ?[A-Z]*\\)[ \t\n]*$"
    ;; Match postcodes from Sweden where the five digits are grouped 3+2
    ;; at the request from Mats Lofdahl <MLofdahl@solar.stanford.edu>.
    ;; (result is ("SE" (133 36)))
    "^[ \t\n]*\\([A-Z]+\\)[ \t\n]*-?[ \t\n]*\\([0-9]+\\)[ \t\n]+\\([0-9]+\\)[ \t\n]*$")
  "List of regexps that match legal postcodes.
Whether this is used at all depends on the variable `bbdb-check-postcode'."
  :group 'bbdb-record-edit
  :type '(repeat regexp))

(defcustom bbdb-default-xfield 'notes
  "Default xfield when editing BBDB records."
  :group 'bbdb-record-edit
  :type '(symbol :tag "Xfield"))

(defcustom bbdb-edit-foo (cons bbdb-default-xfield 'current-fields)
  "Fields to edit with command `bbdb-edit-foo'.
This is a cons pair (WITHOUT-PREFIX . WITH-PREFIX).
The car is used if the command is called without a prefix.
The cdr is used if the command is called with a prefix.

WITHOUT-PREFIX and WITH-PREFIX may take the values:
 name            The full name
 affix           The list of affixes
 organization    The list of organizations
 aka             the list of AKAs
 mail            the list of email addresses
 phone           the list of phone numbers
 address         the list of addresses
 current-fields  Read the field to edit using a completion table
                   that includes all fields of the current record.
 all-fields      Read the field to edit using a completion table
                   that includes all fields currently known to BBDB.

Any other symbol is interpreted as the label of an xfield."
  :group 'bbdb-record-edit
  :type '(cons (symbol :tag "Field without prefix")
               (symbol :tag "Field with prefix")))


;;; MUA interface

(defcustom bbdb-annotate-field bbdb-default-xfield
  "Field to annotate via `bbdb-annotate-record' and friends.
This may take the values:
 affix           The list of affixes
 organization    The list of organizations
 aka             the list of AKAs
 mail            the list of email addresses
 all-fields      Read the field to edit using a completion table
                   that includes all fields currently known to BBDB.

Any other symbol is interpreted as the label of an xfield."
  :group 'bbdb-mua
  :type '(symbol :tag "Field to annotate"))

(defcustom bbdb-mua-edit-field bbdb-default-xfield
  "Field to edit with command `bbdb-mua-edit-field' and friends.
This may take the values:
 name            The full name
 affix           The list of affixes
 organization    The list of organizations
 aka             the list of AKAs
 mail            the list of email addresses
 all-fields      Read the field to edit using a completion table
                   that includes all fields currently known to BBDB.

Any other symbol is interpreted as the label of an xfield."
  :group 'bbdb-mua
  :type '(symbol :tag "Field to edit"))

(defcustom bbdb-mua-update-interactive-p '(search . query)
  "How BBDB's interactive MUA commands update BBDB records.
This is a cons pair (WITHOUT-PREFIX . WITH-PREFIX).
The car is used if the command is called without a prefix.
The cdr is used if the command is called with a prefix (and if the prefix
        is not used for another purpose).

WITHOUT-PREFIX and WITH-PREFIX may take the values
\(here ADDRESS is an email address found in a message):
 nil          Do nothing.
 search       Search for existing records matching ADDRESS.
 update       Search for existing records matching ADDRESS;
                update name and mail field if necessary.
 query        Search for existing records matching ADDRESS;
                query for creation of a new record if the record does not exist.
 create or t  Search for existing records matching ADDRESS;
                create a new record if it does not yet exist.
 a function   This functions will be called with no arguments.
                It should return one of the above values.
 read         Read the value interactively."
  :group 'bbdb-mua
  :type '(cons (choice (const :tag "do nothing" nil)
                       (const :tag "search for existing records" search)
                       (const :tag "update existing records" update)
                       (const :tag "query annotation of all messages" query)
                       (const :tag "annotate all messages" create)
                       (function :tag "User-defined function")
                       (const :tag "read arg interactively" read))
               (choice (const :tag "do nothing" nil)
                       (const :tag "search for existing records" search)
                       (const :tag "update existing records" update)
                       (const :tag "query annotation of all messages" query)
                       (const :tag "annotate all messages" create)
                       (function :tag "User-defined function")
                       (const :tag "read arg interactively" read))))

(defcustom bbdb-mua-auto-update-p 'bbdb-select-message
  "How `bbdb-mua-auto-update' updates BBDB records automatically.

Allowed values are (here ADDRESS is an email address found in a message):
 nil          Do nothing.
 search       Search for existing records matching ADDRESS.
 update       Search for existing records matching ADDRESS;
                update name and mail field if necessary.
 query        Search for existing records matching ADDRESS;
                query for creation of a new record if the record does not exist.
 create or t  Search for existing records matching ADDRESS;
                create a new record if it does not yet exist.
 a function   This functions will be called with no arguments.
                It should return one of the above values.
                For an example, see `bbdb-select-message' with
                `bbdb-mua-update-records-p', `bbdb-accept-message-alist'
                and `bbdb-ignore-message-alist'.

To initiate auto-updating of BBDB records, call `bbdb-mua-auto-update-init'
for the respective MUAs in your init file."
  :group 'bbdb-mua
  :type '(choice (const :tag "do nothing" nil)
                 (const :tag "search for existing records" search)
                 (const :tag "update existing records" update)
                 (const :tag "query annotation of all messages" query)
                 (const :tag "annotate all messages" create)
                 (function :tag "User-defined function")))

(defcustom bbdb-update-records-p 'search
  "Return value for `bbdb-select-message' and friends.
These functions can select messages for further processing by BBDB,
The amount of subsequent processing is determined by `bbdb-update-records-p'.

Allowed values are (here ADDRESS is an email address selected
by `bbdb-select-message'):
 nil          Do nothing.
 search       Search for existing records matching ADDRESS.
 update       Search for existing records matching ADDRESS;
                update name and mail field if necessary.
 query        Search for existing records matching ADDRESS;
                query for creation of a new record if the record does not exist.
 create or t  Search for existing records matching ADDRESS;
                create a new record if it does not yet exist.
 a function   This functions will be called with no arguments.
                It should return one of the above values."
  ;; Also: Used for communication between `bbdb-update-records'
  ;; and `bbdb-query-create'.
  :group 'bbdb-mua
  :type '(choice (const :tag "do nothing" nil)
                 (const :tag "search for existing records" search)
                 (const :tag "update existing records" update)
                 (const :tag "query annotation of all messages" query)
                 (const :tag "annotate all messages" create)
                 (function :tag "User-defined function")))

(defcustom bbdb-message-headers
  '((sender     "From" "Resent-From" "Reply-To" "Sender")
    (recipients "Resent-To" "Resent-CC" "To" "CC" "BCC"))
  "Alist of headers to search for sender and recipients mail addresses.
Each element is of the form

  (CLASS HEADER ...)

The symbol CLASS defines a class of headers.
The strings HEADER belong to CLASS."
  :group 'bbdb-mua
  :type 'list)

(defcustom bbdb-message-all-addresses nil
  "If t `bbdb-update-records' returns all mail addresses of a message.
Otherwise this function returns only the first mail address of each message."
  :group 'bbdb-mua
  :type 'boolean)

(defcustom bbdb-message-try-all-headers nil
  "If t try all message headers to extract an email address from a message.
Several BBDB commands extract either the sender or the recipients' email
addresses from a message according to `bbdb-message-headers'.  If BBDB does not
find any email address in this subset of message headers (for example, because
an email address is excluded because of `bbdb-user-mail-address-re')
but `bbdb-message-try-all-headers' is t, then these commands will also consider
the email addresses in the remaining headers."
  :group 'bbdb-mua
  :type 'boolean)

(defcustom bbdb-accept-message-alist t
  "Alist describing which messages to automatically create BBDB records for.
The format of this alist is
   ((HEADER-NAME . REGEXP) ...)
For example, if
   ((\"From\" . \"@.*\\.maximegalon\\.edu\")
    (\"Subject\" . \"time travel\"))
BBDB records are only created for messages sent by people at Maximegalon U.,
or people posting about time travel.
If t accept all messages.  If nil do not accept any messages.

See also `bbdb-ignore-message-alist', which has the opposite effect."
  :group 'bbdb-mua
  :type '(repeat (cons
                  (string :tag "Header name")
                  (regexp :tag "Regexp to match on header value"))))

(defcustom bbdb-ignore-message-alist nil
  "Alist describing which messages not to automatically create BBDB records for.
The format of this alist is
   ((HEADER-NAME . REGEXP) ... )
For example, if
   ((\"From\" . \"mailer-daemon\")
    ((\"To\" \"CC\") . \"mailing-list-1\\\\|mailing-list-2\"))
no BBDB records are created for messages from any mailer daemon,
or messages sent to or CCed to either of two mailing lists.
If t ignore all messages.  If nil do not ignore any messages.

See also `bbdb-accept-message-alist', which has the opposite effect."
  :group 'bbdb-mua
  :type '(repeat (cons
                  (string :tag "Header name")
                  (regexp :tag "Regexp to match on header value"))))

(defcustom bbdb-user-mail-address-re
  (and (stringp user-mail-address)
       (string-match "\\`\\([^@]*\\)\\(@\\|\\'\\)" user-mail-address)
       (concat "\\<" (regexp-quote (match-string 1 user-mail-address)) "\\>"))
  "A regular expression matching your mail addresses.
Several BBDB commands extract either the sender or the recipients' email
addresses from a message according to `bbdb-message-headers'.  Yet an email
address will be ignored if it matches `bbdb-user-mail-address-re'.  This way
the commands will not operate on your own record.
See also `bbdb-message-try-all-headers'."
  :group 'bbdb-mua
  :type '(regexp :tag "Regexp matching your mail addresses"))

(defcustom bbdb-add-name 'query
  "How to handle new names for existing BBDB records.
This handles messages where the real name differs from the name
in a BBDB record with the same mail address, as in \"John Smith <jqs@frob.com>\"
versus \"John Q. Smith <jqs@frob.com>\".
Allowed values are:
 t           Automatically change the name to the new value.
 query       Query whether to use the new name.
 nil         Ignore the new name.
 a number    Number of seconds BBDB displays the name mismatch.
               (without further action).
 a function  This is called with two args, the record and the new name.
               It should return one of the above values.
 a regexp    If the new name matches this regexp ignore it.
               Otherwise query to add it.
See also `bbdb-add-aka'."
  :group 'bbdb-mua
  :type '(choice (const :tag "Automatically use the new name" t)
                 (const :tag "Query for name changes" query)
                 (const :tag "Ignore the new name" nil)
                 (integer :tag "Number of seconds to display name mismatch")
                 (function :tag "Function for analyzing name handling")
                 (regexp :tag "If the new name matches this regexp ignore it.")))

(defcustom bbdb-add-aka 'query
  "How to handle alternate names for existing BBDB records.
Allowed values are:
 t           Automatically store alternate names as AKA.
 query       Query whether to store alternate names as an AKA.
 nil         Ignore alternate names.
 a function  This is called with two args, the record and the new name.
               It should return one of the above values.
 a regexp    If the alternate name matches this regexp ignore it.
               Otherwise query to add it.
See also `bbdb-add-name'."
  :group 'bbdb-mua
  :type '(choice (const :tag "Automatically store alternate names as AKA" t)
                 (const :tag "Query for alternate names" query)
                 (const :tag "Ignore alternate names" nil)
                 (function :tag "Function for alternate name handling")
                 (regexp :tag "If the alternate name matches this regexp ignore it.")))

(defcustom bbdb-add-mails 'query
  "How to handle new mail addresses for existing BBDB records.
This handles messages where the mail address differs from the mail addresses
in a BBDB record with the same name as in \"John Q. Smith <jqs@foo.com>\"
versus \"John Q. Smith <jqs@bar.com>\".
Allowed values are:
 t           Automatically add new mail addresses to the list of mail addresses.
 query       Query whether to add it.
 nil         Ignore new mail addresses.
 a number    Number of seconds BBDB displays the new address
               (without further action).
 a function  This is called with two args, the record and the new mail address.
               It should return one of the above values.
 a regexp    If the new mail address matches this regexp ignore the new address.
               Otherwise query to add it.
See also `bbdb-new-mails-primary' and `bbdb-ignore-redundant-mails'."
  :group 'bbdb-mua
  :type '(choice (const :tag "Automatically add new mail addresses" t)
                 (const :tag "Query before adding new mail addresses" query)
                 (const :tag "Never add new mail addresses" nil)
                 (number :tag "Number of seconds to display new addresses")
                 (function :tag "Function for analyzing name handling")
                 (regexp :tag "If the new address matches this regexp ignore it.")))

(defcustom bbdb-new-mails-primary 'query
  "Where to put new mail addresses for existing BBDB records.
A new mail address may either become the new primary mail address,
when it is put at the beginning of the list of mail addresses.
Or the new mail address is added at the end of the list of mail addresses.
Allowed values are:
 t           Make a new address automatically the primary address.
 query       Query whether to make it the primary address.
 nil         Add the new address to the end of the list.
 a function  This is called with two args, the record and the new mail address.
               It should return one of the above values.
 a regexp    If the new mail address matches this regexp put it at the end.
               Otherwise query to make it the primary address.
See also `bbdb-add-mails'."
  :group 'bbdb-mua
  :type '(choice (const :tag "New address automatically made primary" t)
                 (const :tag "Query before making a new address primary" query)
                 (const :tag "Do not make new address primary" nil)
                 (function :tag "Function for analyzing primary handling")
                 (regexp :tag "If the new mail address matches this regexp put it at the end.")))

(defcustom bbdb-canonicalize-mail-function #'bbdb-string-trim
  "If non-nil, it should be a function of one arg: a mail address string.
When BBDB \"notices\" a message, the corresponding mail addresses are passed
to this function first.  It acts as a kind of \"filter\" to transform
the mail addresses before they are compared against or added to the database.
See `bbdb-canonicalize-mail-1' for a more complete example.
If this function returns nil, BBDB assumes that there is no mail address.

See also `bbdb-ignore-redundant-mails'."
  :group 'bbdb-mua
  :type 'function)

(define-obsolete-variable-alias 'bbdb-canonicalize-redundant-mails
  'bbdb-ignore-redundant-mails "3.0")
(defcustom bbdb-ignore-redundant-mails 'query
  "How to handle redundant mail addresses for existing BBDB records.
For example, \"foo@bar.baz.com\" is redundant w.r.t. \"foo@baz.com\".
This affects two things, whether a new redundant mail address is added
to BBDB and whether an old mail address, which has become redundant
because of a newly added mail address, is removed from BBDB.

Allowed values are:
 t           Automatically ignore redundant mail addresses.
 query       Query whether to ignore them.
 nil         Do not ignore redundant mail addresses.
 a number    Number of seconds BBDB displays redundant mail addresses
               (without further action).
 a function  This is called with two args, the record and the new mail address.
               It should return one of the above values.
 a regexp    If the new mail address matches this regexp never ignore
               this mail address.  Otherwise query to ignore it.
See also `bbdb-add-mails' and `bbdb-canonicalize-mail-function'."
  :group 'bbdb-mua
  :type '(choice (const :tag "Automatically ignore redundant mail addresses" t)
                 (const :tag "Query whether to ignore them" query)
                 (const :tag "Do not ignore redundant mail addresses" nil)
                 (number :tag "Number of seconds to display redundant addresses")
                 (function :tag "Function for handling redundant mail addresses")
                 (regexp :tag "If the new address matches this regexp never ignore it.")))

(defcustom bbdb-message-clean-name-function #'bbdb-message-clean-name-default
  "Function to clean up the name in the header of a message.
It takes one argument, the name as extracted by
`mail-extract-address-components'."
  :group 'bbdb-mua
  :type 'function)

(defcustom bbdb-message-mail-as-name t
  "If non-nil use mail address of message as fallback for name of new records."
  :group 'bbdb-mua
  :type 'boolean)

(defcustom bbdb-notice-mail-hook nil
  "Hook run each time a mail address of a record is \"noticed\" in a message.
This means that the mail address in a message belongs to an existing BBDB record
or to a record BBDB has created for the mail address.

Run with one argument, the record.  It is up to the hook function
to determine which MUA is used and to act appropriately.
Hook functions can use the variable `bbdb-update-records-address'
to determine the header and class of the mail address according
to `bbdb-message-headers'.  See `bbdb-auto-notes' for how to annotate records
using `bbdb-update-records-address' and the headers of a mail message.

If a message contains multiple mail addresses belonging to one BBDB record,
this hook is run for each mail address.  Use `bbdb-notice-record-hook'
if you want to notice each record only once per message."
  :group 'bbdb-mua
  :type 'hook)

(defcustom bbdb-notice-record-hook nil
  "Hook run each time a BBDB record is \"noticed\" in a message.
This means that one of the mail addresses in a message belongs to an existing
record or it is a record BBDB has created for the mail address.  If a message
contains multiple mail addresses belonging to one BBDB record, this hook
is nonetheless run only once.  Use `bbdb-notice-mail-hook' if you want to run
a hook function for each mail address in a message.

Hook is run with one argument, the record."
  :group 'bbdb-mua
  :type 'hook)

(define-widget 'bbdb-alist-with-header 'group
  "My group"
  :match 'bbdb-alist-with-header-match
  :value-to-internal (lambda (_widget value)
                       (if value (list (car value) (cdr value))))
  :value-to-external (lambda (_widget value)
                       (if value (append (list (car value)) (cadr value)))))

(defun bbdb-alist-with-header-match (widget value)
  (widget-group-match widget
                      (widget-apply widget :value-to-internal value)))

(defvar bbdb-auto-notes-rules-expanded nil
  "Expanded `bbdb-auto-notes-rules'.") ; Internal variable

(defcustom bbdb-auto-notes-rules nil
  "List of rules for adding notes to records of mail addresses of messages.
This automatically annotates the BBDB record of the sender or recipient
of a message based on the value of a header such as the Subject header.
This requires that `bbdb-notice-mail-hook' contains `bbdb-auto-notes'
and that the record already exists or `bbdb-update-records-p' returns such that
the record will be created.  Messages matching `bbdb-auto-notes-ignore-messages'
are ignored.

The elements of this list are

   (MUA FROM-TO HEADER ANNOTATE ...)
   (FROM-TO HEADER ANNOTATE ...)
   (HEADER ANNOTATE ...)

MUA is the active MUA or a list of MUAs (see `bbdb-mua').
If MUA is missing or t, use this rule for all MUAs.

FROM-TO is a list of headers and/or header classes as in `bbdb-message-headers'.
The record corresponding to a mail address of a message is considered for
annotation if this mail address was found in a header matching FROM-TO.
If FROM-TO is missing or t, records for each mail address are considered
irrespective of where the mail address was found in a message.

HEADER is a message header that is considered for generating the annotation.

ANNOTATE may take the following values:

  (REGEXP . STRING)       [this is equivalent to (REGEXP notes STRING)]
  (REGEXP FIELD STRING)
  (REGEXP FIELD STRING REPLACE)

REGEXP must match the value of HEADER for generating an annotation.
However, if the value of HEADER also matches an element of
`bbdb-auto-notes-ignore-headers' no annotation is generated.

The annotation will be added to FIELD of the respective record.
FIELD defaults to `bbdb-default-xfield'.

STRING defines a replacement for the match of REGEXP in the value of HEADER.
It may contain \\& or \\N specials used by `replace-match'.
The resulting string becomes the annotation.
If STRING is an integer N, the Nth matching subexpression is used.
If STRING is a function, it will be called with one arg, the value of HEADER.
The return value (which must be a string) is then used.

If REPLACE is t, the resulting string replaces the old contents of FIELD.
If it is nil, the string is appended to the contents of FIELD (unless the
annotation is already part of the content of field).

For example,

   ((\"To\" (\"-vm@\" . \"VM mailing list\"))
    (\"Subject\" (\"sprocket\" . \"mail about sprockets\")
               (\"you bonehead\" . \"called me a bonehead\")))

will cause the text \"VM mailing list\" to be added to the notes field
of the records corresponding to anyone you get mail from via one of the VM
mailing lists.

If multiple clauses match the message, all of the corresponding strings
will be added.

See also variables `bbdb-auto-notes-ignore-messages' and
`bbdb-auto-notes-ignore-headers'.

For speed-up, the function `bbdb-auto-notes' actually use expanded rules
stored in the internal variable `bbdb-auto-notes-rules-expanded'.
If you change the value of `bbdb-auto-notes-rules' outside of customize,
set `bbdb-auto-notes-rules-expanded' to nil, so that the expanded rules
will be re-evaluated."
  :group 'bbdb-mua
  :set (lambda (symbol value)
         (set-default symbol value)
         (setq bbdb-auto-notes-rules-expanded nil))
  :type '(repeat
          (bbdb-alist-with-header
           (repeat (choice
                    (const sender)
                    (const recipients)))
           (string :tag "Header name")
           (repeat (choice
                    (cons :tag "Value Pair"
                          (regexp :tag "Regexp to match on header value")
                          (string :tag "String for notes if regexp matches"))
                    (list :tag "Replacement list"
                          (regexp :tag "Regexp to match on header value")
                          (choice :tag "Record field"
                                  (const notes :tag "xfields")
                                  (const organization :tag "Organization")
                                  (symbol :tag "Other"))
                          (choice :tag "Regexp match"
                                  (string :tag "Replacement string")
                                  (integer :tag "Subexpression match")
                                  (function :tag "Callback Function"))
                          (choice :tag "Replace previous contents"
                                  (const :tag "No" nil)
                                  (const :tag "Yes" t))))))))

(defcustom bbdb-auto-notes-ignore-messages nil
  "List of rules for ignoring entire messages in `bbdb-auto-notes'.
The elements may have the following values:
  a function  This function is called with one arg, the record
              that would be annotated.
              Ignore this message if the function returns non-nil.
              This function may use `bbdb-update-records-address'.
  MUA         Ignore messages from MUA (see `bbdb-mua').
  (HEADER . REGEXP)  Ignore messages where HEADER matches REGEXP.
              For example,  (\"From\" . bbdb-user-mail-address-re)
              disables any recording of notes for mail addresses
              found in messages coming from yourself, see
              `bbdb-user-mail-address-re'.
  (MUA HEADER REGEXP)  Ignore messages from MUA where HEADER
              matches REGEXP.
See also `bbdb-auto-notes-ignore-headers'."
  :group 'bbdb-mua
  :type '(repeat (cons
                  (string :tag "Header name")
                  (regexp :tag "Regexp to match on header value"))))

(defcustom bbdb-auto-notes-ignore-headers nil
  "Alist of headers and regexps to ignore in `bbdb-auto-notes'.
Each element is of the form

    (HEADER . REGEXP)

For example,

    (\"Organization\" . \"^Gatewayed from\\\\\|^Source only\")

will exclude the phony `Organization:' headers in GNU mailing-lists
gatewayed to gnu.* newsgroups.
See also `bbdb-auto-notes-ignore-messages'."
  :group 'bbdb-mua
  :type '(repeat (cons
                  (string :tag "Header name")
                  (regexp :tag "Regexp to match on header value"))))

(define-obsolete-variable-alias 'bbdb-message-pop-up 'bbdb-mua-pop-up "3.0")
(defcustom bbdb-mua-pop-up t
  "If non-nil, display an auto-updated BBDB window while using a MUA.
If 'horiz, stack the window horizontally if there is room.
If this is nil, BBDB is updated silently.

See also `bbdb-mua-pop-up-window-size' and `bbdb-horiz-pop-up-window-size'."
  :group 'bbdb-mua
  :type '(choice (const :tag "MUA BBDB window stacked vertically" t)
                 (const :tag "MUA BBDB window stacked horizontally" horiz)
                 (const :tag "No MUA BBDB window" nil)))

(defcustom bbdb-mua-pop-up-window-size bbdb-pop-up-window-size
  "Vertical size of MUA pop-up BBDB window (vertical split).
If it is an integer number, it is the number of lines used by BBDB.
If it is a fraction between 0.0 and 1.0 (inclusive), it is the fraction
of the tallest existing window that BBDB will take over.
If it is t use `pop-to-buffer' to create the BBDB window.
See also `bbdb-pop-up-window-size'."
  :group 'bbdb-mua
  :type '(choice (number :tag "BBDB window size")
                 (const :tag "Use `pop-to-buffer'" t)))

(defcustom bbdb-horiz-pop-up-window-size '(112 . 0.3)
  "Horizontal size of a MUA pop-up BBDB window (horizontal split).
It is a cons pair (TOTAL . BBDB-SIZE).
The window that will be considered for horizontal splitting must have
at least TOTAL columns. BBDB-SIZE is the horizontal size of the BBDB window.
If it is an integer number, it is the number of columns used by BBDB.
If it is a fraction between 0 and 1, it is the fraction of the
window width that BBDB will take over."
  :group 'bbdb-mua
  :type '(cons (number :tag "Total number of columns")
               (number :tag "Horizontal size of BBDB window")))


;;; xfields processing
(define-obsolete-variable-alias 'bbdb-notes-sort-order 'bbdb-xfields-sort-order "3.0")
(defcustom bbdb-xfields-sort-order
  '((notes . 0) (url . 1) (ftp . 2) (gopher . 3) (telnet . 4) (mail-alias . 5)
    (mail-folder . 6) (lpr . 7))
  "The order for sorting the xfields.
If an xfield is not in the alist, it is assigned weight 100, so all xfields
with weights less then 100 will be in the beginning, and all xfields with
weights more than 100 will be in the end."
  :group 'bbdb-mua
  :type '(repeat (cons
                  (symbol :tag "xfield")
                  (number :tag "Weight"))))

(define-obsolete-variable-alias 'bbdb-merge-notes-function-alist
  'bbdb-merge-xfield-function-alist "3.0")
(defcustom bbdb-merge-xfield-function-alist nil
  "Alist defining merging functions for particular xfields.
Each element is of the form (LABEL . MERGE-FUN).
For merging xfield LABEL, this will use MERGE-FUN."
  :group 'bbdb-mua
  :type '(repeat (cons
                  (symbol :tag "xfield")
                  (function :tag "merge function"))))

(defcustom bbdb-mua-summary-unification-list
  '(name mail message-name message-mail message-address)
  "List of FIELDs considered by `bbdb-mua-summary-unify'.
For the RECORD matching the address of a message, `bbdb-mua-summary-unify'
returns the first non-empty field value matching an element FIELD from this list.
Each element FIELD may be a valid argument of `bbdb-record-field' for RECORD.
In addition, this list may also include the following elements:
  message-name     The name in the address of the message
  message-mail     The mail in the address of the message
  message-address  The complete address of the message
These provide a fallback if a message does not have a matching RECORD
or if some FIELD of RECORD is empty."
  :group 'bbdb-mua
  :type '(repeat (symbol :tag "Field")))

(defcustom bbdb-mua-summary-mark-field 'mark-char
  "BBDB xfield whose value is used to mark message addresses known to BBDB.
This may also be a function, called with one arg, the record, which should
return the mark.  See `bbdb-mua-summary-mark' and `bbdb-mua-summary-unify'.
See also `bbdb-mua-summary-mark'."
  :group 'bbdb-mua-gnus
  :type 'symbol)

(defcustom bbdb-mua-summary-mark "+"
  "Default mark for message addresses known to BBDB.
If nil do not mark message addresses known to BBDB.
See `bbdb-mua-summary-mark' and `bbdb-mua-summary-unify'.
See also `bbdb-mua-summary-mark-field'."
  :group 'bbdb-mua
  :type '(choice (string :tag "Mark used")
                 (const :tag "Do not mark known posters" nil)))

(defcustom bbdb-mua-summary-unify-format-letter "B"
  "Letter required for `bbdb-mua-summary-unify' in the MUA Summary format string.
For Gnus, combine it with the %u specifier in `gnus-summary-line-format'
\(see there), for example use \"%U%R%z%I%(%[%4L: %-23,23uB%]%) %s\\n\".
For VM, combine it with the %U specifier in `vm-summary-format' (see there),
for example, use \"%n %*%a %-17.17UB %-3.3m %2d %4l/%-5c %I\\\"%s\\\"\\n\".
This customization of `gnus-summary-line-format' / `vm-summary-format'
is required to use `bbdb-mua-summary-unify'.
Currently no other MUAs support this BBDB feature."
  :group 'bbdb-mua
  :type 'string)

(defcustom bbdb-mua-summary-mark-format-letter "b"
  "Letter required for `bbdb-mua-summary-mark' in the MUA Summary format string.
For Gnus, combine it with the %u specifier in `gnus-summary-line-format'
\(see there), for example, use \"%U%R%z%I%(%[%4L: %ub%-23,23f%]%) %s\\n\".
For VM, combine it with the %U specifier in `vm-summary-format' (see there),
for example, use \"%n %*%a %Ub%-17.17F %-3.3m %2d %4l/%-5c %I\\\"%s\\\"\\n\".
This customization of `gnus-summary-line-format' / `vm-summary-format'
is required to use `bbdb-mua-summary-mark'.
Currently no other MUAs support this BBDB feature."
  :group 'bbdb-mua
  :type 'string)


;;; Sending mail
(defcustom bbdb-mail-user-agent mail-user-agent
  "Mail user agent used by BBDB.
Allowed values are those allowed for `mail-user-agent'."
  :group 'bbdb-sendmail
  :type '(radio (function-item :tag "Message package"
                               :format "%t\n"
                               message-user-agent)
                (function-item :tag "Mail package"
                               :format "%t\n"
                               sendmail-user-agent)
                (function-item :tag "Emacs interface to MH"
                               :format "%t\n"
                               mh-e-user-agent)
                (function-item :tag "Message with full Gnus features"
                               :format "%t\n"
                               gnus-user-agent)
                (function-item :tag "VM"
                               :format "%t\n"
                               vm-user-agent)
                (function :tag "Other")
                (const :tag "Default" nil)))

(defcustom bbdb-mail-name-format 'first-last
  "Format for names when sending mail.
If first-last format names as \"Firstname Lastname\".
If last-first format names as \"Lastname, Firstname\".
If `bbdb-mail-name' returns the full name as a single string, this takes
precedence over `bbdb-mail-name-format'.  Likewise, if the mail address itself
includes a name, this is not reformatted."
  :group 'bbdb-sendmail
  :type '(choice (const :tag "Firstname Lastname" first-last)
                 (const :tag "Lastname, Firstname" last-first)))

(defcustom bbdb-mail-name 'mail-name
  "Xfield holding the full name for a record when sending mail.
This may also be a function taking one argument, a record.
If it returns the full mail name as a single string, this is used \"as is\".
If it returns a cons pair (FIRST . LAST) with the first and last name
for this record, these are formatted obeying `bbdb-mail-name-format'."
  :group 'bbdb-sendmail
  :type '(choice (symbol :tag "xfield")
                 (function :tag "mail name function")))

(defcustom bbdb-mail-alias-field 'mail-alias
  "Xfield holding the mail alias for a record.
Used by `bbdb-mail-aliases'.  See also `bbdb-mail-alias'."
  :group 'bbdb-sendmail
  :type 'symbol)

(defcustom bbdb-mail-alias 'first
  "Defines which mail aliases are generated for a BBDB record.
first: Generate one alias \"<alias>\" that expands to the first mail address
       of a record.
star:  Generate a second alias \"<alias>*\" that expands to all mail addresses
       of a record.
all:   Generate the aliases \"<alias>\" and \"<alias>*\" (as for 'star)
       and aliases \"<alias>n\" for each mail address, where n is the position
       of the mail address of a record."
  :group 'bbdb-sendmail
  :type '(choice (symbol :tag "Only first" first)
                 (symbol :tag "<alias>* for all mails" star)
                 (symbol :tag "All aliases" all)))

(defcustom bbdb-mail-avoid-redundancy nil
  "Mail address to use for BBDB records when sending mail.
If non-nil do not use full name in mail address when same as mail.
If value is mail-only never use full name."
  :group 'bbdb-sendmail
  :type '(choice (const :tag "Allow redundancy" nil)
                 (const :tag "Never use full name" mail-only)
                 (const :tag "Avoid redundancy" t)))

(defcustom bbdb-complete-mail t
  "If t MUA insinuation provides key binding for command `bbdb-complete-mail'."
  :group 'bbdb-sendmail
  :type 'boolean)

(defcustom bbdb-completion-list t
  "Controls the behaviour of `bbdb-complete-mail'.
If a list of symbols, it specifies which fields to complete.  Symbols include
  fl-name (= first and last name)
  lf-name (= last and first name)
  organization
  aka
  mail (= all email addresses of each record)
  primary (= first email address of each record)
If t, completion is done for all of the above.
If nil, no completion is offered."
  ;; These symbols match the fields for which BBDB provides entries in
  ;; `bbdb-hashtable'.
  :group 'bbdb-sendmail
  :type '(choice (const :tag "No Completion" nil)
                 (const :tag "Complete across all fields" t)
                 (repeat :tag "Field"
                         (choice (const fl-name)
                                 (const lf-name)
                                 (const aka)
                                 (const organization)
                                 (const primary)
                                 (const mail)))))

(defcustom bbdb-complete-mail-allow-cycling nil
  "If non-nil cycle mail addresses when calling `bbdb-complete-mail'."
  :group 'bbdb-sendmail
  :type 'boolean)

(defcustom bbdb-complete-mail-hook nil
  "List of functions called after a sucessful completion."
  :group 'bbdb-sendmail
  :type 'hook)

(defcustom bbdb-mail-abbrev-expand-hook nil
  ;; Replacement for function `mail-abbrev-expand-hook'.
  "Function (not hook) run each time an alias is expanded.
The function is called with two args the alias and the list
of corresponding mail addresses."
  :group 'bbdb-sendmail
  :type 'function)

(defcustom bbdb-completion-display-record t
  "If non-nil `bbdb-complete-mail' displays the BBDB record after completion."
  :group 'bbdb-sendmail
  :type '(choice (const :tag "Update the BBDB buffer" t)
                 (const :tag "Do not update the BBDB buffer" nil)))


;;;Dialing
(defcustom bbdb-dial-local-prefix-alist
  '(((if (integerp bbdb-default-area-code)
         (format "(%03d)" bbdb-default-area-code)
       (or bbdb-default-area-code ""))
     . ""))
  "Mapping to remove local prefixes from numbers.
If this is non-nil, it should be an alist of
\(PREFIX . REPLACEMENT) elements. The first part of a phone number
matching the regexp returned by evaluating PREFIX will be replaced by
the corresponding REPLACEMENT when dialing."
  :group 'bbdb-utilities-dialing
  :type 'sexp)

(defcustom bbdb-dial-local-prefix nil
  "Local prefix digits.
If this is non-nil, it should be a string of digits which your phone
system requires before making local calls (for example, if your phone system
requires you to dial 9 before making outside calls.) In BBDB's
opinion, you're dialing a local number if it starts with a 0 after
processing `bbdb-dial-local-prefix-alist'."
  :group 'bbdb-utilities-dialing
  :type '(choice (const :tag "No digits required" nil)
                 (string :tag "Dial this first" "9")))

(defcustom bbdb-dial-long-distance-prefix nil
  "Long distance prefix digits.
If this is non-nil, it should be a string of digits which your phone
system requires before making a long distance call (one not in your local
area code).  For example, in some areas you must dial 1 before an area
code. Note that this is used to replace the + sign in phone numbers
when dialling (international dialing prefix.)"
  :group 'bbdb-utilities-dialing
  :type '(choice (const :tag "No digits required" nil)
                 (string :tag "Dial this first" "1")))

(defcustom bbdb-dial-function #'bbdb--dial-default
  "If non-nil this should be a function used for dialing phone numbers.
This function is used by `bbdb-dial-number'.  It requires one
argument which is a string for the number that is dialed.
If nil then `bbdb-dial-number' uses the tel URI syntax passed to `browse-url'
to make the call."
  :group 'bbdb-utilities-dialing
  :type 'function)

(defun bbdb--dial-default (phone-string)
  (browse-url (concat "tel:" phone-string)))

;; Faces for font-lock
(defgroup bbdb-faces nil
  "Faces used by BBDB."
  :group 'bbdb
  :group 'faces)

(defface bbdb-name
  '((t (:inherit font-lock-function-name-face)))
  "Face used for BBDB names."
  :group 'bbdb-faces)

;; KEY needs to match the value of the xfield name-face, which is a string.
;; To avoid confusion, we make KEY a string, too, though symbols might be
;; faster.
(defcustom bbdb-name-face-alist nil
  "Alist used for font-locking the name of a record.
Each element should be a cons cell (KEY . FACE) with string KEY and face FACE.
To use FACE for font-locking the name of a record,
the xfield name-face of this record should have the value KEY.
The value of name-face may also be a face which is then used directly.
If none of these schemes succeeds, the face `bbdb-name' is used."
  :group 'bbdb-faces
  :type '(repeat (cons (symbol :tag "Key") (face :tag "Face"))))

(defface bbdb-organization
  '((t (:inherit font-lock-comment-face)))
  "Face used for BBDB names."
  :group 'bbdb-faces)

(defface bbdb-field-name
  '((t (:inherit font-lock-variable-name-face)))
  "Face used for BBDB names."
  :group 'bbdb-faces)

;;; Internal variables
(eval-and-compile
  (defvar bbdb-debug t
    "Enable debugging if non-nil during compile time.
You really should not disable debugging.  But it will speed things up."))

(defconst bbdb-file-format 9
  "BBDB file format.")

(defconst bbdb-record-type
  '(vector (or string (const nil)) ; first name
           (or string (const nil)) ; last name
           (repeat string) ; affix
           (repeat string) ; aka
           (repeat string) ; organization
           (repeat (or (vector string string)
                       (vector string integer integer integer integer))) ; phone
           (repeat (vector string (repeat string) string string
                           string string)) ; address
           (repeat string) ; mail
           (repeat (cons symbol sexp)) ; xfields
           (cons symbol string) ; uuid
           (cons symbol string) ; creation-date
           (cons symbol string) ; timestamp
           sexp) ; cache
  "Pseudo-code for the structure of a record.  Used by `bbdb-check-type'.")

(defconst bbdb-file-coding-system 'utf-8
  "Coding system used for reading and writing `bbdb-file'.")

(defvar bbdb-mail-aliases-need-rebuilt nil
  "Non-nil if mail aliases need to be rebuilt.")

(defvar bbdb-buffer nil "Buffer visiting `bbdb-file'.")

(defvar bbdb-buffer-name "*BBDB*" "Name of the BBDB buffer.")

(defvar bbdb-silent-internal nil
  "Bind this to t to quiet things down - do not set it.
See also `bbdb-silent'.")

(declare-function bbdb-insinuate-gnus "bbdb-gnus" ())
(declare-function bbdb-insinuate-mh "bbdb-mhe" ())
(declare-function bbdb-insinuate-rmail "bbdb-rmail" ())
(declare-function bbdb-insinuate-vm "bbdb-vm" ())
(declare-function bbdb-insinuate-mail "bbdb-message" ())
(declare-function bbdb-insinuate-message "bbdb-message" ())
(declare-function bbdb-insinuate-mu4e "bbdb-m4e" ())
(declare-function bbdb-insinuate-sc "bbdb-sc" ())
(declare-function bbdb-pgp "bbdb-pgp" ())
(declare-function bbdb-insinuate-wl "bbdb-wl" ())
(declare-function bbdb-anniv-diary-entries "bbdb-anniv" ())

(define-obsolete-variable-alias 'bbdb-init-forms
  'bbdb-init-functions "3.0")
(defvar bbdb-init-functions
  `((gnus                       ; gnus 3.15 or newer
     ,(lambda () (add-hook 'gnus-startup-hook #'bbdb-insinuate-gnus)))
    (mh-e                       ; MH-E
     ,(lambda () (add-hook 'mh-folder-mode-hook #'bbdb-insinuate-mh)))
    (rmail                      ; RMAIL
     ,(lambda () (add-hook 'rmail-mode-hook #'bbdb-insinuate-rmail)))
    (vm                        ; newer versions of vm do not have `vm-load-hook'
     ,(lambda () (eval-after-load "vm" '(bbdb-insinuate-vm))))
    (mail                       ; the standard mail user agent
     ,(lambda () (add-hook 'mail-setup-hook #'bbdb-insinuate-mail)))
    (sendmail
     ,(lambda () (message "BBDB: sendmail insinuation deprecated.  Use mail.")
            (add-hook 'mail-setup-hook #'bbdb-insinuate-mail)))
    (message                    ; the gnus mail user agent
     ,(lambda () (add-hook 'message-setup-hook #'bbdb-insinuate-message)))
    (mu4e                       ; the mu4e user agent
     ,(lambda () (add-hook 'mu4e-main-mode-hook #'bbdb-insinuate-mu4e)))

    (sc                         ; supercite
     ,(lambda () (add-hook 'sc-load-hook #'bbdb-insinuate-sc)))
    (anniv                      ; anniversaries
     ,(lambda () (add-hook 'diary-list-entries-hook #'bbdb-anniv-diary-entries)))
    (pgp                        ; pgp-mail
     ,(lambda ()
        (add-hook 'message-send-hook #'bbdb-pgp)
        (add-hook 'mail-send-hook #'bbdb-pgp)))
    (wl
     ,(lambda () (add-hook 'wl-init-hook #'bbdb-insinuate-wl))))
  "Alist mapping features to insinuation functions.")

(defvar bbdb-search-invert nil
  "Bind this variable to t in order to invert the result of `bbdb-search'.")

(defvar bbdb-do-all-records nil
  "Controls the behavior of the command `bbdb-do-all-records'.")

(defvar bbdb-append-display nil
  "Controls the behavior of the command `bbdb-append-display'.")

(defvar bbdb-offer-to-create nil
  "For communication between `bbdb-update-records' and `bbdb-query-create'.")

(defvar bbdb-update-records-address nil
  "For communication between `bbdb-update-records' and `bbdb-query-create'.
It is a list with elements (NAME MAIL HEADER HEADER-CLASS MUA).")

;;; Buffer-local variables for the database.
(defvar bbdb-records nil
  "BBDB records list.
In buffer `bbdb-file' this list includes all records.
In the *BBDB* buffers it includes the records that are actually displayed
and its elements are (RECORD DISPLAY-FORMAT MARKER-POS).")
(make-variable-buffer-local 'bbdb-records)

(defvar bbdb-changed-records nil
  "List of records that has been changed since BBDB was last saved.
Use `bbdb-search-changed' to display these records.")

(defvar bbdb-end-marker nil
  "Marker holding the buffer position of the end of the last record.")

(defvar bbdb-hashtable (make-hash-table :test 'equal)
  "Hash table for BBDB records.
Hashes the fields first-last-name, last-first-name, organization, aka, and mail.")

(defvar bbdb-uuid-table (make-hash-table :test 'equal)
  "Hash table for uuid's of BBDB records.")

(defvar bbdb-xfield-label-list nil
  "List of labels for xfields.")

(defvar bbdb-organization-list nil
  "List of organizations known to BBDB.")

(defvar bbdb-street-list nil
  "List of streets known to BBDB.")

(defvar bbdb-city-list nil
  "List of cities known to BBDB.")

(defvar bbdb-state-list nil
  "List of states known to BBDB.")

(defvar bbdb-postcode-list nil
  "List of post codes known to BBDB.")

(defvar bbdb-country-list nil
  "List of countries known to BBDB.")

(defvar bbdb-modeline-info (make-vector 6 nil)
  "Precalculated mode line info for BBDB commands.
This is a vector [APPEND-M APPEND INVERT-M INVERT ALL-M ALL].
APPEND-M is the mode line info if `bbdb-append-display' is non-nil.
INVERT-M is the mode line info if `bbdb-search-invert' is non-nil.
ALL-M is the mode line info if `bbdb-do-all-records' is non-nil.
APPEND, INVERT, and ALL appear in the message area.")

(defvar bbdb-update-unchanged-records nil
  "If non-nil update unchanged records in the database.
Normally calls of `bbdb-change-hook' and updating of a record are suppressed,
if an editing command did not really change the record.  Bind this to t
if you want to call `bbdb-change-hook' and update the record unconditionally.")

;;; Keymap
(defvar bbdb-mode-map
  (let ((km (make-sparse-keymap)))
    (define-key km "*"          'bbdb-do-all-records)
    (define-key km "+"          'bbdb-append-display)
    (define-key km "!"          'bbdb-search-invert)
    (define-key km "a"          'bbdb-add-mail-alias)
    (define-key km "A"          'bbdb-mail-aliases)
    (define-key km "c"          'bbdb-create)
    (define-key km "e"          'bbdb-edit-field)
    (define-key km ";"          'bbdb-edit-foo)
    (define-key km "n"          'bbdb-next-record)
    (define-key km "p"          'bbdb-prev-record)
    (define-key km "N"          'bbdb-next-field)
    (define-key km "\t"         'bbdb-next-field) ; TAB
    (define-key km "P"          'bbdb-prev-field)
    (define-key km "\d"         'bbdb-prev-field) ; DEL
    (define-key km "d"          'bbdb-delete-field-or-record)
    (define-key km "\C-k"       'bbdb-delete-field-or-record)
    (define-key km "i"          'bbdb-insert-field)
    (define-key km "s"          'bbdb-save)
    (define-key km "\C-x\C-s"   'bbdb-save)
    (define-key km "t"          'bbdb-toggle-records-layout)
    (define-key km "T"          'bbdb-display-records-completely)
    (define-key km "o"          'bbdb-omit-record)
    (define-key km "m"          'bbdb-mail)
    (define-key km "M"          'bbdb-mail-address)
    (define-key km "\M-d"       'bbdb-dial)
    (define-key km "h"          'bbdb-info)
    (define-key km "?"          'bbdb-help)
    ;; (define-key km "q"       'quit-window) ; part of `special-mode' bindings
    (define-key km "\C-x\C-t"   'bbdb-transpose-fields)
    (define-key km "Cr"         'bbdb-copy-records-as-kill)
    (define-key km "Cf"         'bbdb-copy-fields-as-kill)
    (define-key km "u"          'bbdb-browse-url)
    (define-key km "\C-c\C-t"   'bbdb-tex)
    (define-key km "="          'delete-other-windows)

    ;; Search keys
    (define-key km "b"          'bbdb)
    (define-key km "/1"         'bbdb-display-records)
    (define-key km "/n"         'bbdb-search-name)
    (define-key km "/o"         'bbdb-search-organization)
    (define-key km "/p"         'bbdb-search-phone)
    (define-key km "/a"         'bbdb-search-address)
    (define-key km "/m"         'bbdb-search-mail)
    (define-key km "/N"         'bbdb-search-xfields)
    (define-key km "/x"         'bbdb-search-xfields)
    (define-key km "/c"         'bbdb-search-changed)
    (define-key km "/d"         'bbdb-search-duplicates)
    (define-key km "\C-xnw"     'bbdb-display-all-records)
    (define-key km "\C-xnd"     'bbdb-display-current-record)

    (define-key km [delete]     'scroll-down) ; 24.1: part of `special-mode'
    (define-key km " "          'scroll-up)   ; 24.1: part of `special-mode'

    (define-key km [mouse-3]    'bbdb-mouse-menu)
    (define-key km [mouse-2]    (lambda (event)
                                  ;; Toggle record layout
                                  (interactive "e")
                                  (save-excursion
                                    (posn-set-point (event-end event))
                                    (bbdb-toggle-records-layout
                                     (bbdb-do-records t) current-prefix-arg))))
    km)
  "Keymap for Insidious Big Brother Database.
This is a child of `special-mode-map'.")

(easy-menu-define
  bbdb-menu bbdb-mode-map "BBDB Menu"
  '("BBDB"
    ("Display"
     ["Previous field" bbdb-prev-field t]
     ["Next field" bbdb-next-field t]
     ["Previous record" bbdb-prev-record t]
     ["Next record" bbdb-next-record t]
     "--"
     ["Show all records" bbdb-display-all-records t]
     ["Show current record" bbdb-display-current-record t]
     ["Omit record" bbdb-omit-record t]
     "--"
     ["Toggle layout" bbdb-toggle-records-layout t]
     ["Show all fields" bbdb-display-records-completely t])
    ("Searching"
     ["General search" bbdb t]
     ["Search one record" bbdb-display-records t]
     ["Search name" bbdb-search-name t]
     ["Search organization" bbdb-search-organization t]
     ["Search phone" bbdb-search-phone t]
     ["Search address" bbdb-search-address t]
     ["Search mail" bbdb-search-mail t]
     ["Search xfields" bbdb-search-xfields t]
     ["Search changed records" bbdb-search-changed t]
     ["Search duplicates" bbdb-search-duplicates t]
     "--"
     ["Old time stamps" bbdb-timestamp-older t]
     ["New time stamps" bbdb-timestamp-newer t]
     ["Old creation date" bbdb-creation-older t]
     ["New creation date" bbdb-creation-newer t]
     ["Creation date = time stamp" bbdb-creation-no-change t]
     "--"
     ["Append search" bbdb-append-display t]
     ["Invert search" bbdb-search-invert t])
    ("Mail"
     ["Send mail" bbdb-mail t]
     ["Save mail address" bbdb-mail-address t]
     "--"
     ["Add mail alias" bbdb-add-mail-alias t]
     ["(Re-)Build mail aliases" bbdb-mail-aliases t])
    ("Use database"
     ["Prefix: do all records" bbdb-do-all-records t]
     "--"
     ["Send mail" bbdb-mail t]
     ["Dial phone number" bbdb-dial t]
     ["Browse URL" bbdb-browse-url t]
     ["Copy records as kill" bbdb-copy-records-as-kill t]
     ["Copy fields as kill" bbdb-copy-fields-as-kill t]
     "--"
     ["TeX records" bbdb-tex t])
    ("Manipulate database"
     ["Prefix: do all records" bbdb-do-all-records t]
     "--"
     ["Create new record" bbdb-create t]
     ["Edit current field" bbdb-edit-field t]
     ["Insert new field" bbdb-insert-field t]
     ["Edit some field" bbdb-edit-foo t]
     ["Transpose fields" bbdb-transpose-fields t]
     ["Delete record or field" bbdb-delete-field-or-record t]
     "--"
     ["Sort addresses" bbdb-sort-addresses t]
     ["Sort phones" bbdb-sort-phones t]
     ["Sort xfields" bbdb-sort-xfields t]
     ["Merge records" bbdb-merge-records t]
     ["Sort database" bbdb-sort-records t]
     ["Delete duplicate mails" bbdb-delete-redundant-mails t]
     "--"
     ["Save BBDB" bbdb-save t]
     ["Revert BBDB" revert-buffer t])
    ("Help"
     ["Brief help" bbdb-help t]
     ["BBDB Manual" bbdb-info t])
    "--"
    ["Quit" quit-window t]))

(defvar bbdb-completing-read-mails-map
  (let ((map (copy-keymap minibuffer-local-completion-map)))
    (define-key map " " 'self-insert-command)
    (define-key map "\t" 'bbdb-complete-mail)
    (define-key map "\M-\t" 'bbdb-complete-mail)
    map)
  "Keymap used by `bbdb-completing-read-mails'.")



;;; Helper functions

(defun bbdb-warn (&rest args)
  "Display a message at the bottom of the screen.
ARGS are passed to `message'."
  (ding t)
  (apply #'message args))

(defun bbdb-string-trim (string &optional null)
  "Remove leading and trailing whitespace and all properties from STRING.
If STRING is nil return an empty string unless NULL is non-nil."
  (if (null string)
      (unless null "")
    (setq string (substring-no-properties string))
    (if (string-match "\\`[ \t\n]+" string)
        (setq string (substring-no-properties string (match-end 0))))
    (if (string-match "[ \t\n]+\\'" string)
        (setq string (substring-no-properties string 0 (match-beginning 0))))
    (unless (and null (string= "" string))
      string)))

(defsubst bbdb-string= (str1 str2)
  "Return t if strings STR1 and STR2 are equal, ignoring case."
  (and (stringp str1) (stringp str2)
       (eq t (compare-strings str1 0 nil str2 0 nil t))))

(defun bbdb-split (separator string)
  "Split STRING into list of substrings bounded by matches for SEPARATORS.
SEPARATOR may be a regexp.  SEPARATOR may also be a symbol
\(a field name).  Then look up the value in `bbdb-separator-alist'
or use `bbdb-default-separator'.
Whitespace around SEPARATOR is ignored unless SEPARATOR matches
the string \" \\t\\n\".
Almost the inverse function of `bbdb-concat'."
  (if (symbolp separator)
      (setq separator (car (or (cdr (assq separator bbdb-separator-alist))
                               bbdb-default-separator))))
  (if (<= 24.4 (string-to-number emacs-version))
      ;; `split-string' applied to an empty STRING gives nil.
      (split-string string separator t
                    (unless (string-match separator " \t\n") "[ \t\n]*"))
    (unless (string-match separator " \t\n")
      (setq separator (concat "[ \t\n]*" separator "[ \t\n]*")))
    (split-string (bbdb-string-trim string) separator t)))

(defun bbdb-concat (separator &rest strings)
  "Concatenate STRINGS to a string sticking in SEPARATOR.
STRINGS may be strings or lists of strings.  Empty strings are ignored.
SEPARATOR may be a string.
SEPARATOR may also be a symbol (a field name).  Then look up the value
of SEPARATOR in `bbdb-separator-alist' or use `bbdb-default-separator'.
The inverse function of `bbdb-split'."
  (if (symbolp separator)
      (setq separator (nth 1 (or (cdr (assq separator bbdb-separator-alist))
                                 bbdb-default-separator))))
  (mapconcat #'identity
             (delete "" (apply #'append (mapcar (lambda (x) (if (stringp x)
                                                                (list x) x))
                                                strings)))
             separator))

(defun bbdb-list-strings (list)
  "Remove all elements from LIST which are not non-empty strings."
  (let (new-list)
    (dolist (elt list)
      (if (and (stringp elt) (not (string= "" elt)))
          (push elt new-list)))
    (nreverse new-list)))

;; A call of `indent-region' swallows any indentation
;; that might be part of the field itself.  So we indent manually.
(defsubst bbdb-indent-string (string column)
  "Indent nonempty lines in STRING to COLUMN (except first line).
This happens in addition to any pre-defined indentation of STRING."
  (replace-regexp-in-string "\n\\([^\n]\\)"
                            (concat "\n" (make-string column ?\s) "\\1")
                            string))

(defun bbdb-read-string (prompt &optional init collection require-match)
  "Read a string, trimming whitespace and text properties.
PROMPT is a string to prompt with.
INIT appears as initial input which is useful for editing existing records.
COLLECTION and REQUIRE-MATCH have the same meaning as in `completing-read'."
  (bbdb-string-trim
   (if collection
       ;; Hack: In `minibuffer-local-completion-map' remove
       ;; the binding of SPC to `minibuffer-complete-word'
       ;; and of ? to `minibuffer-completion-help'.
       ;; FIXME: Explain why we don't want to use the bindings of SPC and ?
       (minibuffer-with-setup-hook
           (lambda ()
             (use-local-map
              (let ((map (make-sparse-keymap)))
                (set-keymap-parent map (current-local-map))
                (define-key map " " nil)
                (define-key map "?" nil)
                map)))
         (completing-read prompt collection nil require-match init))
     (read-string prompt init))))

;; The following macros implement variants of `pushnew' (till emacs 24.2)
;; or `cl-pushnew' (since emacs 24.3).  To be compatible with older and newer
;; versions of emacs we use our own macros.  We call these macros often.
;; So we keep them simple.  Nothing fancy is needed here.
(defmacro bbdb-pushnew (element listname)
  "Add ELEMENT to the value of LISTNAME if it isn't there yet.
The test for presence of ELEMENT is done with `equal'.
The return value is the new value of LISTNAME."
  `(let ((elt ,element))
     (if (member elt ,listname)
         ,listname
       (setq ,listname (cons elt ,listname)))))

(defmacro bbdb-pushnewq (element listname)
  "Add ELEMENT to the value of LISTNAME if it isn't there yet.
The test for presence of ELEMENT is done with `eq'.
The return value is the new value of LISTNAME."
  `(let ((elt ,element))
     (if (memq elt ,listname)
         ,listname
       (setq ,listname (cons elt ,listname)))))

(defmacro bbdb-pushnewt (element listname)
  "Add ELEMENT to the value of LISTNAME if it isn't there yet and non-nil.
The test for presence of ELEMENT is done with `equal'.
The return value is the new value of LISTNAME."
  `(let ((elt ,element))
     (if (or (not elt)
             (member elt ,listname))
         ,listname
       (setq ,listname (cons elt ,listname)))))

(defun bbdb-current-record (&optional full)
  "Return the record point is at.
If FULL is non-nil record includes the display information."
  (unless (eq major-mode 'bbdb-mode)
    (error "This only works while in BBDB buffers."))
  (let ((num (get-text-property (if (and (not (bobp)) (eobp))
                                    (1- (point)) (point))
                                'bbdb-record-number))
        record)
    (unless num (error "Not a BBDB record"))
    (setq record (nth num bbdb-records))
    (if full record (car record))))

(defun bbdb-current-field ()
  "Return current field point is on."
  (unless (bbdb-current-record) (error "Not a BBDB record"))
  (get-text-property (point) 'bbdb-field))

(defmacro bbdb-debug (&rest body)
  "Excecute BODY just like `progn' with debugging capability.
Debugging is enabled if variable `bbdb-debug' is non-nil during compile.
You really should not disable debugging.  But it will speed things up."
  (declare (indent 0))
  (if bbdb-debug ; compile-time switch
      `(let ((debug-on-error t))
         ,@body)))

;; inspired by `gnus-bind-print-variables'
(defmacro bbdb-with-print-loadably (&rest body)
  "Bind print-* variables for BBDB and evaluate BODY.
This macro is used with `prin1', `prin1-to-string', etc. in order to ensure
printed Lisp objects are loadable by BBDB."
  (declare (indent 0))
  `(let ((print-escape-newlines t) ;; BBDB needs this!
         print-escape-nonascii print-escape-multibyte
         print-quoted print-length print-level)
         ;; print-circle print-gensym
         ;; print-continuous-numbering
         ;; print-number-table
         ;; float-output-format
     ,@body))

(defun bbdb-timestamp (_record)
  ""
  (unless (get 'bbdb-timestamp 'bbdb-obsolete)
    (put 'bbdb-timestamp 'bbdb-obsolete t)
    (message "Function `bbdb-timestamp' is obsolete.  Remove it from any hooks.")
    (sit-for 2)))
(make-obsolete 'bbdb-timestamp nil "2017-08-09")

(defun bbdb-creation-date (_record)
  ""
  (unless (get 'bbdb-creation-date 'bbdb-obsolete)
    (put 'bbdb-creation-date 'bbdb-obsolete t)
    (message "Function `bbdb-creation-date' is obsolete.  Remove it from any hooks.")
    (sit-for 2)))
(make-obsolete 'bbdb-creation-date nil "2017-08-09")

;; Copied from org-id.el
(defun bbdb-uuid ()
  "Return string with random (version 4) UUID."
  (let ((rnd (md5 (format "%s%s%s%s%s%s%s"
			  (random)
			  (current-time)
			  (user-uid)
			  (emacs-pid)
			  (user-full-name)
			  user-mail-address
			  (recent-keys)))))
    (format "%s-%s-4%s-%s%s-%s"
	    (substring rnd 0 8)
	    (substring rnd 8 12)
	    (substring rnd 13 16)
	    (format "%x"
		    (logior
		     #b10000000
		     (logand
		      #b10111111
		      (string-to-number
		       (substring rnd 16 18) 16))))
	    (substring rnd 18 20)
	    (substring rnd 20 32))))

(defun bbdb-multiple-buffers-default ()
  "Default function for guessing a name for new *BBDB* buffers.
May be used as value of variable `bbdb-multiple-buffers'."
  (save-current-buffer
    (cond ((memq major-mode '(vm-mode vm-summary-mode vm-presentation-mode
                                      vm-virtual-mode))
           (vm-select-folder-buffer)
           (buffer-name))
          ((memq major-mode '(gnus-summary-mode gnus-group-mode))
           (set-buffer gnus-article-buffer)
           (buffer-name))
          ((memq major-mode '(mail-mode vm-mail-mode message-mode))
           "message composition"))))

(defsubst bbdb-add-job (spec record string)
  "Internal function: Evaluate SPEC for RECORD and STRING.
If SPEC is a function call it with args RECORD and STRING.  Return value.
If SPEC is a regexp, return 'query unless SPEC matches STRING.
Otherwise return SPEC.
Used with variable `bbdb-add-name' and friends."
  (cond ((functionp spec)
         (funcall spec record string))
        ((stringp spec)
         (unless (string-match spec string) 'query)) ; be least aggressive
        (spec)))

(defsubst bbdb-eval-spec (spec prompt)
  "Internal function: Evaluate SPEC using PROMPT.
Return t if either SPEC equals t, or SPEC equals 'query and `bbdb-silent'
is non-nil or `y-or-no-p' returns t using PROMPT.
Used with return values of `bbdb-add-job'."
  (or (eq spec t)
      (and (eq spec 'query)
           (or bbdb-silent (y-or-n-p prompt)))))

(defun bbdb-clean-address-components (components)
  "Clean mail address COMPONENTS.
COMPONENTS is a list (FULL-NAME CANONICAL-ADDRESS) as returned
by `mail-extract-address-components'.
Pass FULL-NAME through `bbdb-message-clean-name-function'
and CANONICAL-ADDRESS through `bbdb-canonicalize-mail-function'."
  (list (if (car components)
            (funcall (or bbdb-message-clean-name-function #'identity)
                     (car components)))
        (if (cadr components)
            (funcall (or bbdb-canonicalize-mail-function #'bbdb-string-trim)
                     (cadr components)))))

(defun bbdb-extract-address-components (address &optional all)
  "Given an RFC-822 address ADDRESS, extract full name and canonical address.
This function behaves like `mail-extract-address-components', but it passes
its return value through `bbdb-clean-address-components'.
See also `bbdb-decompose-bbdb-address'."
  (if all
      (mapcar #'bbdb-clean-address-components
              (mail-extract-address-components address t))
    (bbdb-clean-address-components (mail-extract-address-components address))))

;; Inspired by `gnus-extract-address-components' from gnus-utils.
(defun bbdb-decompose-bbdb-address (mail)
  "Given an RFC-822 address MAIL, extract full name and canonical address.
In general, this function behaves like the more sophisticated function
`mail-extract-address-components'.  Yet for an address `<Joe_Smith@foo.com>'
lacking a real name the latter function returns the name \"Joe Smith\".
This is useful when analyzing the headers of email messages we receive
from the outside world.  Yet when analyzing the mail addresses stored
in BBDB, this pollutes the mail-aka space.  So we define here
an intentionally much simpler function for decomposing the names
and canonical addresses in the mail field of BBDB records."
  (let (name address)
    ;; First find the address - the thing with the @ in it.
    (cond (;; Check `<foo@bar>' first in order to handle the quite common
	   ;; form `"abc@xyz" <foo@bar>' (i.e. `@' as part of a comment)
	   ;; correctly.
	   (string-match "<\\([^@ \t<>]+[!@][^@ \t<>]+\\)>" mail)
	   (setq address (match-string 1 mail)))
	  ((string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" mail)
	   (setq address (match-string 0 mail))))
    ;; Then check whether the `name <address>' format is used.
    (and address
	 ;; Linear white space is not required.
	 (string-match (concat "[ \t]*<" (regexp-quote address) ">") mail)
	 (setq name (substring mail 0 (match-beginning 0)))
         ;; Strip any quotes mail the name.
         (string-match "^\".*\"$" name)
         (setq name (substring name 1 (1- (match-end 0)))))
    ;; If not, then check whether the `address (name)' format is used.
    (or name
	(and (string-match "(\\([^)]+\\))" mail)
	     (setq name (match-string 1 mail))))
    (list (if (equal name "") nil name) (or address mail))))

;;; Massage of mail addresses

(defcustom bbdb-canonical-hosts
  ;; Example
  (regexp-opt '("cs.cmu.edu" "ri.cmu.edu"))
  "Regexp matching the canonical part of the domain part of a mail address.
If the domain part of a mail address matches this regexp, the domain
is replaced by the substring that actually matched this address.

Used by  `bbdb-canonicalize-mail-1'.  See also `bbdb-ignore-redundant-mails'."
  :group 'bbdb-mua
  :type '(regexp :tag "Regexp matching sites"))

(defun bbdb-canonicalize-mail-1 (address)
  "Example of `bbdb-canonicalize-mail-function'.
However, this function is too specific to be useful for the general user.
Take it as a source of inspiration for what can be done."
  (setq address (bbdb-string-trim address))
  (cond
   ;; Rewrite mail-drop hosts.
   ;; RW: The following is now also handled by `bbdb-ignore-redundant-mails'
   ((string-match
     (concat "\\`\\([^@%!]+@\\).*\\.\\(" bbdb-canonical-hosts "\\)\\'")
     address)
    (concat (match-string 1 address) (match-string 2 address)))
   ;;
   ;; Here at Lucid, our workstation names sometimes get into our mail
   ;; addresses in the form "jwz%thalidomide@lucid.com" (instead of simply
   ;; "jwz@lucid.com").  This removes the workstation name.
   ((string-match "\\`\\([^@%!]+\\)%[^@%!.]+@\\(lucid\\.com\\)\\'" address)
    (concat (match-string 1 address) "@" (match-string 2 address)))
   ;;
   ;; Another way that our local mailer is misconfigured: sometimes addresses
   ;; which should look like "user@some.outside.host" end up looking like
   ;; "user%some.outside.host" or even "user%some.outside.host@lucid.com"
   ;; instead.  This rule rewrites it into the original form.
   ((string-match "\\`\\([^@%]+\\)%\\([^@%!]+\\)\\(@lucid\\.com\\)?\\'" address)
    (concat (match-string 1 address) "@" (match-string 2 address)))
   ;;
   ;; Sometimes I see addresses like "foobar.com!user@foobar.com".
   ;; That's totally redundant, so this rewrites it as "user@foobar.com".
   ((string-match "\\`\\([^@%!]+\\)!\\([^@%!]+[@%]\\1\\)\\'" address)
    (match-string 2 address))
   ;;
   ;; Sometimes I see addresses like "foobar.com!user".  Turn it around.
   ((string-match "\\`\\([^@%!.]+\\.[^@%!]+\\)!\\([^@%]+\\)\\'" address)
    (concat (match-string 2 address) "@" (match-string 1 address)))
   ;;
   ;; The mailer at hplb.hpl.hp.com tends to puke all over addresses which
   ;; pass through mailing lists which are maintained there: it turns normal
   ;; addresses like "user@foo.com" into "user%foo.com@hplb.hpl.hp.com".
   ;; This reverses it.  (I actually could have combined this rule with
   ;; the similar lucid.com rule above, but then the regexp would have been
   ;; more than 80 characters long...)
   ((string-match "\\`\\([^@!]+\\)%\\([^@%!]+\\)@hplb\\.hpl\\.hp\\.com\\'"
          address)
    (concat (match-string 1 address) "@" (match-string 2 address)))
   ;;
   ;; Another local mail-configuration botch: sometimes mail shows up
   ;; with addresses like "user@workstation", where "workstation" is a
   ;; local machine name.  That should really be "user" or "user@netscape.com".
   ;; (I'm told this one is due to a bug in SunOS 4.1.1 sendmail.)
   ((string-match "\\`\\([^@%!]+\\)[@%][^@%!.]+\\'" address)
    (match-string 1 address))
   ;;
   ;; Sometimes I see addresses like "foo%somewhere%uunet.uu.net@somewhere.else".
   ;; This is silly, because I know that I can send mail to uunet directly.
   ((string-match ".%uunet\\.uu\\.net@[^@%!]+\\'" address)
    (concat (substring address 0 (+ (match-beginning 0) 1)) "@UUNET.UU.NET"))
   ;;
   ;; Otherwise, leave it as it is.
   (t address)))

(defun bbdb-message-clean-name-default (name)
  "Default function for `bbdb-message-clean-name-function'.
This strips garbage from the user full NAME string."
  ;; Remove leading non-alpha chars
  (if (string-match "\\`[^[:alpha:]]+" name)
      (setq name (substring name (match-end 0))))

  (if (string-match "^\\([^@]+\\)@" name)
      ;; The name is really a mail address and we use the part preceeding "@".
      ;; Everything following "@" is ignored.
      (setq name (match-string 1 name)))

  ;; Replace "firstname.surname" by "firstname surname".
  ;; Do not replace ". " with " " because that could be an initial.
  (setq name (replace-regexp-in-string "\\.\\([^ ]\\)" " \\1" name))

  ;; Replace tabs, spaces, and underscores with a single space.
  (setq name (replace-regexp-in-string "[ \t\n_]+" " " name))

  ;; Remove trailing comments separated by "(" or " [-#]"
  ;; This does not work all the time because some of our friends in
  ;; northern europe have brackets in their names...
  (if (string-match "[^ \t]\\([ \t]*\\((\\| [-#]\\)\\)" name)
      (setq name (substring name 0 (match-beginning 1))))

  ;; Remove phone extensions (like "x1234" and "ext. 1234")
  (let ((case-fold-search t))
    (setq name (replace-regexp-in-string
                "\\W+\\(x\\|ext\\.?\\)\\W*[-0-9]+" "" name)))

  ;; Remove trailing non-alpha chars
  (if (string-match "[^[:alpha:]]+\\'" name)
      (setq name (substring name 0 (match-beginning 0))))

  ;; Remove text properties
  (substring-no-properties name))

;; BBDB data structure
(defmacro bbdb-defstruct (name &rest elts)
  ;; FIXME: Use cl-defstruct instead!
  "Define two functions to operate on vector NAME for each symbol ELT in ELTS.
The function bbdb-NAME-ELT returns the element ELT in vector NAME.
The function bbdb-NAME-set-ELT sets ELT.
Also define a constant bbdb-NAME-length that holds the number of ELTS
in vector NAME."
  (declare (indent 1))
  (let* ((count 0)
         (sname (symbol-name name))
         (uname (upcase sname))
         (cname (concat "bbdb-" sname "-"))
         body)
    (dolist (elt elts)
      (let* ((selt (symbol-name elt))
             (setname  (intern (concat cname "set-" selt))))
        (push (list 'defsubst (intern (concat cname selt)) `(,name)
                    (format "For BBDB %s read element %i `%s'."
                            uname count selt)
                    ;; Use `elt' instead of `aref' so that these functions
                    ;; also work for the `bbdb-record-type' pseudo-code.
                    `(elt ,name ,count))
              body)
        (push (list 'defsubst setname `(,name value)
                    (format "For BBDB %s set element %i `%s' to VALUE.  \
Return VALUE.
Do not call this function directly.  Call instead `bbdb-record-set-field'
which ensures the integrity of the database.  Also, this makes your code
more robust with respect to possible future changes of BBDB's innermost
internals."
                            uname count selt)
                    `(aset ,name ,count value))
              body))
      (setq count (1+ count)))
    (push (list 'defconst (intern (concat cname "length")) count
                (concat "Length of BBDB `" sname "'."))
          body)
    (cons 'progn body)))

;; Define RECORD:
(bbdb-defstruct record
  firstname lastname affix aka organization phone address mail xfields
  uuid creation-date timestamp cache)

;; Define PHONE:
(bbdb-defstruct phone
  label area exchange suffix extension)

;; Define ADDRESS:
(bbdb-defstruct address
  label streets city state postcode country)

;; Define record CACHE:
;; - fl-name (first and last name of the person referred to by the record),
;; - lf-name (last and first name of the person referred to by the record),
;; - mail-aka (list of names associated with mail addresses)
;; - mail-canon (list of canonical mail addresses)
;; - sortkey (the concatenation of the elements used for sorting the record),
;; - marker  (position of beginning of record in `bbdb-file')
(bbdb-defstruct cache
  fl-name lf-name mail-aka mail-canon sortkey marker)

(defsubst bbdb-record-mail-aka (record)
  "Record cache function: Return mail-aka for RECORD."
  (bbdb-cache-mail-aka (bbdb-record-cache record)))

(defsubst bbdb-record-mail-canon (record)
  "Record cache function: Return mail-canon for RECORD."
  (bbdb-cache-mail-canon (bbdb-record-cache record)))

(defun bbdb-empty-record ()
  "Return a new empty record structure with a cache.
It is the caller's responsibility to make the new record known to BBDB."
  (let ((record (make-vector bbdb-record-length nil)))
    (bbdb-record-set-cache record (make-vector bbdb-cache-length nil))
    record))

;; `bbdb-hashtable' associates with each KEY a list of matching records.
;; KEY includes fl-name, lf-name, organizations, AKAs and email addresses.
;; When loading the database the hash table is initialized by calling
;; `bbdb-register-record' for each record.  This function is also called
;; when adding new records to the database.
;; `bbdb-delete-record-internal' with arg REMHASH non-nil removes a record
;; from the hash table (besides deleting the record from the database).
;; When an existing record is modified, the code that modifies the record
;; needs to update the hash table, too.  This includes removing the outdated
;; associations between KEYs and record as well as adding the new associations.
;; This is one reason to modify records by calling `bbdb-record-set-field'
;; which properly updates the hash table.
;; The hash table can be accessed via `bbdb-gethash'
;; and via functions like `completing-read'.

(defun bbdb-puthash (key record)
  "Associate RECORD with KEY in `bbdb-hashtable'.
KEY must be a string or nil.  Empty strings and nil are ignored."
  (if (and key (not (string= "" key))) ; do not hash empty strings
      (let* ((key (downcase key))
             (records (gethash key bbdb-hashtable)))
        (puthash key (if records (bbdb-pushnewq record records)
                       (list record))
                 bbdb-hashtable))))

(defun bbdb-gethash (key &optional predicate)
  "Return list of records associated with KEY in `bbdb-hashtable'.
KEY must be a string or nil.  Empty strings and nil are ignored.
PREDICATE may take the same values as `bbdb-completion-list'."
  (when (and key (not (string= "" key)))
    (let* ((key (downcase key))
           (all-records (gethash key bbdb-hashtable))
           records)
      (if (or (not predicate) (eq t predicate))
          all-records
        (dolist (record all-records)
          (if (catch 'bbdb-hash-ok
                (bbdb-hash-p key record predicate))
              (push record records)))
        records))))

(defun bbdb-hash-p (key record predicate)
  "Throw `bbdb-hash-ok' non-nil if KEY matches RECORD acording to PREDICATE.
PREDICATE may take the same values as the elements of `bbdb-completion-list'."
  (if (and (memq 'fl-name predicate)
           (bbdb-string= key (or (bbdb-record-name record) "")))
      (throw 'bbdb-hash-ok 'fl-name))
  (if (and (memq 'lf-name predicate)
           (bbdb-string= key (or (bbdb-record-name-lf record) "")))
      (throw 'bbdb-hash-ok 'lf-name))
  (if (memq 'organization predicate)
      (mapc (lambda (organization) (if (bbdb-string= key organization)
                                       (throw 'bbdb-hash-ok 'organization)))
            (bbdb-record-organization record)))
  (if (memq 'aka predicate)
      (mapc (lambda (aka) (if (bbdb-string= key aka)
                              (throw 'bbdb-hash-ok 'aka)))
            (bbdb-record-field record 'aka-all)))
  (if (and (memq 'primary predicate)
           (bbdb-string= key (car (bbdb-record-mail-canon record))))
      (throw 'bbdb-hash-ok 'primary))
  (if (memq 'mail predicate)
      (mapc (lambda (mail) (if (bbdb-string= key mail)
                               (throw 'bbdb-hash-ok 'mail)))
            (bbdb-record-mail-canon record)))
  nil)

(defun bbdb-remhash (key record)
  "Remove RECORD from list of records associated with KEY.
KEY must be a string or nil.  Empty strings and nil are ignored."
  (if (and key (not (string= "" key)))
      (let* ((key (downcase key))
             (records (gethash key bbdb-hashtable)))
        (when records
          (setq records (delq record records))
          (if records
              (puthash key records bbdb-hashtable)
            (remhash key bbdb-hashtable))))))

(defun bbdb-puthash-mail (record)
  "For RECORD put mail into `bbdb-hashtable'."
  (let (mail-aka mail-canon address)
    (dolist (mail (bbdb-record-mail record))
      (setq address (bbdb-decompose-bbdb-address mail))
      (when (car address)
        (push (car address) mail-aka)
        (bbdb-puthash (car address) record))
      (push (nth 1 address) mail-canon)
      (bbdb-puthash (nth 1 address) record))
    (bbdb-cache-set-mail-aka (bbdb-record-cache record)
                             (nreverse mail-aka))
    (bbdb-cache-set-mail-canon (bbdb-record-cache record)
                               (nreverse mail-canon))))

(defun bbdb-hash-update (record old new)
  "Update hash for RECORD.  Remove OLD, insert NEW.
Both OLD and NEW are lists of values."
  (dolist (elt old)
    (bbdb-remhash elt record))
  (dolist (elt new)
    (bbdb-puthash elt record)))

(defun bbdb-check-name (name &optional record warn)
  "Check whether NAME is a valid name.
This throws an error if NAME is already used by another record
and `bbdb-allow-duplicates' is nil.
NAME may be a string, a cons (FIRST . LAST) or a list of name strings.
If RECORD is non-nil, NAME may correspond to RECORD without raising an error.
If WARN is non-nil, issue a warning instead of raising an error."
  ;; Are there other useful checks for names beyond checking for duplicates?
  (unless bbdb-allow-duplicates
    (cl-flet ((fun (name)
                   (let* ((tmp (bbdb-gethash name '(fl-name lf-name aka)))
                          (records (if record (remq record tmp) tmp)))
                     (if records
                         ;; Be verbose as the duplicates may be AKAs.
                         (let ((msg (format "Name `%s' is already in BBDB: %s"
                                            name (mapconcat #'bbdb-record-name
                                                            records ", "))))
                           (if (not warn)
                               (error msg)
                             (message msg)
                             (sit-for 1)))))))
      (cond ((stringp name)
             (fun name))
            ((and (consp name) (stringp (cdr name)))
             (fun (bbdb-concat 'name-first-last (car name) (cdr name))))
            (t (mapc #'fun name))))))

(defun bbdb-check-mail (mail &optional record warn)
  "Check whether MAIL is a valid mail address.
This throws an error if MAIL is already used by another record
and `bbdb-allow-duplicates' is nil.
MAIL may be a mail string or a list of mail strings.
If RECORD is non-nil, MAIL may appear in RECORD without raising an error.
If WARN is non-nil, issue a warning instead of raising an error."
  ;; Are there other useful checks for mail addresses beyond checking
  ;; for duplicates?
  (unless bbdb-allow-duplicates
    (dolist (m (if (listp mail) mail (list mail)))
      (let* ((tmp (bbdb-gethash (nth 1 (bbdb-decompose-bbdb-address m))
                                '(mail)))
             (records (if record (remq record tmp) tmp)))
        (if records
            (let ((msg (format "Mail `%s' is already in BBDB: %s" m
                               (mapconcat #'bbdb-record-name records ", "))))
              (if (not warn)
                  (error msg)
                (message msg)
                (sit-for 1))))))))

(defun bbdb-record-name (record)
  "Record cache function: Return the full name FIRST_LAST of RECORD.
Return empty string if both the first and last name are nil.
If the name is not available in the name cache, the name cache value
is generated and stored."
  (or (bbdb-cache-fl-name (bbdb-record-cache record))
      ;; Build the name cache for a record.
      (bbdb-record-set-name record t t)))

(defun bbdb-record-name-lf (record)
  "Record cache function: Return the full name LAST_FIRST of RECORD.
If the name is not available in the name cache, the name cache value
is generated and stored."
  (or (bbdb-cache-lf-name (bbdb-record-cache record))
      ;; Build the name cache for a record.
      (progn (bbdb-record-set-name record t t)
             (bbdb-cache-lf-name (bbdb-record-cache record)))))

(defun bbdb-record-set-name (record first last)
  "Record cache function: For RECORD set full name based on FIRST and LAST.
If FIRST or LAST are t use respective existing entries of RECORD.
Set full name in cache and hash.  Return first-last name."
  (let* ((cache (bbdb-record-cache record))
         (fl-name (bbdb-cache-fl-name cache))
         (lf-name (bbdb-cache-lf-name cache)))
    (if fl-name (bbdb-remhash fl-name record))
    (if lf-name (bbdb-remhash lf-name record)))
  (if (eq t first)
      (setq first (bbdb-record-firstname record))
    (bbdb-record-set-firstname record first))
  (if (eq t last)
      (setq last (bbdb-record-lastname record))
    (bbdb-record-set-lastname record last))
  (let ((fl-name (bbdb-concat 'name-first-last first last))
        (lf-name (bbdb-concat 'name-last-first last first))
        (cache (bbdb-record-cache record)))
    ;; Set cache of RECORD
    (bbdb-cache-set-fl-name cache fl-name)
    (bbdb-cache-set-lf-name cache lf-name)
    ;; Set hash.  For convenience, the hash contains the full name
    ;; as first-last and last-fist.
    (bbdb-puthash fl-name record)
    (bbdb-puthash lf-name record)
    fl-name))

(defun bbdb-record-sortkey (record)
  "Record cache function: Return the sortkey for RECORD.
Set and store it if necessary."
  (or (bbdb-cache-sortkey (bbdb-record-cache record))
      (bbdb-record-set-sortkey record)))

(defun bbdb-record-set-sortkey (record)
  "Record cache function: Set and return RECORD's sortkey."
  (bbdb-cache-set-sortkey
   (bbdb-record-cache record)
   (downcase
    (bbdb-concat "" (bbdb-record-lastname record)
                 (bbdb-record-firstname record)
                 (bbdb-record-organization record)))))

(defsubst bbdb-record-marker (record)
  "Record cache function: Return the marker for RECORD."
  (bbdb-cache-marker (bbdb-record-cache record)))

(defsubst bbdb-record-set-marker (record marker)
  "Record cache function: Set and return RECORD's MARKER."
  (bbdb-cache-set-marker (bbdb-record-cache record) marker))

(defsubst bbdb-record-xfield (record label)
  "For RECORD return value of xfield LABEL.
Return nil if xfield LABEL is undefined."
  (cdr (assq label (bbdb-record-xfields record))))

;; The values of xfields are normally strings.  The following function
;; comes handy if we want to treat these values as symbols.
(defun bbdb-record-xfield-intern (record label)
  "For RECORD return interned value of xfield LABEL.
Return nil if xfield LABEL does not exist."
  (let ((value (bbdb-record-xfield record label)))
    ;; If VALUE is not a string, return whatever it is.
    (if (stringp value) (intern value) value)))

(defun bbdb-record-xfield-string (record label)
  "For RECORD return value of xfield LABEL as string.
Return nil if xfield LABEL does not exist."
  (let ((value (bbdb-record-xfield record label)))
    (if (string-or-null-p value)
        value
      (let ((print-escape-newlines t))
        (prin1-to-string value)))))

(defsubst bbdb-record-xfield-split (record label)
  "For RECORD return value of xfield LABEL split as a list.
Splitting is based on `bbdb-separator-alist'."
  (let ((val (bbdb-record-xfield record label)))
    (cond ((stringp val) (bbdb-split label val))
          (val (error "Cannot split `%s'" val)))))

(defun bbdb-record-set-xfield (record label value)
  "For RECORD set xfield LABEL to VALUE.
If VALUE is nil or an empty string, remove xfield LABEL from RECORD.
Return VALUE."
  ;; In principle we can also have xfield labels `name' or `mail', etc.
  ;; Yet the actual code would get rather confused.  So we throw an error.
  (if (memq label '(name firstname lastname affix organization
                         mail aka phone address xfields))
      (error "xfield label `%s' illegal" label))
  (if (eq label 'mail-alias)
      (setq bbdb-mail-aliases-need-rebuilt 'edit))
  (if (stringp value) (setq value (bbdb-string-trim value t)))
  (let ((old-xfield (assq label (bbdb-record-xfields record))))
    ;; Do nothing if both OLD-XFIELD and VALUE are nil.
    (cond ((and old-xfield value) ; update
           (setcdr old-xfield value))
          (value ; new xfield
           (bbdb-pushnewq label bbdb-xfield-label-list)
           (bbdb-record-set-xfields record
                                    (append (bbdb-record-xfields record)
                                            (list (cons label value)))))
          (old-xfield ; remove
           (bbdb-record-set-xfields record
                                    (delq old-xfield
                                          (bbdb-record-xfields record))))))
  value)

(defun bbdb-check-type (object type &optional abort extended)
  "Return non-nil if OBJECT is of type TYPE.
TYPE is a pseudo-code as in `bbdb-record-type'.
If ABORT is non-nil, abort with error message if type checking fails.
If EXTENDED is non-nil, consider extended atomic types which may include
symbols, numbers, markers, and strings."
  (let (tmp)
    ;; Add more predicates?  Compare info node `(elisp.info)Type Predicates'.
    (or (cond ((eq type 'symbol) (symbolp object))
              ((eq type 'integer) (integerp object))
              ((eq type 'marker) (markerp object))
              ((eq type 'number) (numberp object))
              ((eq type 'string) (stringp object))
              ((eq type 'sexp) t) ; matches always
              ((eq type 'face) (facep object))
              ;; not quite a type
              ((eq type 'bound) (and (symbolp object) (boundp object)))
              ((eq type 'function) (functionp object))
              ((eq type 'vector) (vectorp object))
              ((and extended
                    (cond ((symbolp type) (setq tmp (eq type object)) t)
                          ((or (numberp type) (markerp type))
                           (setq tmp (= type object)) t)
                          ((stringp type)
                           (setq tmp (and (stringp object)
                                          (string= type object))) t)))
               tmp)
              ((not (consp type))
               (error "Atomic type `%s' undefined" type))
              ((eq 'const (setq tmp (car type)))
               (equal (nth 1 type) object))
              ((eq tmp 'cons)
               (and (consp object)
                    (bbdb-check-type (car object) (nth 1 type) abort extended)
                    (bbdb-check-type (cdr object) (nth 2 type) abort extended)))
              ((eq tmp 'list)
               (and (listp object)
                    (eq (length (cdr type)) (length object))
                    (let ((type (cdr type)) (object object) (ok t))
                      (while type
                        (unless (bbdb-check-type (pop object) (pop type)
                                                 abort extended)
                          (setq ok nil type nil)))
                      ok)))
              ((eq tmp 'repeat)
               (and (listp object)
                    (let ((tp (nth 1 type)) (object object) (ok t))
                      (while object
                        (unless (bbdb-check-type (pop object) tp abort extended)
                          (setq ok nil object nil)))
                      ok)))
              ((eq tmp 'vector)
               (and (vectorp object)
                    (let* ((i 0) (type (cdr type))
                           (ok (eq (length object) (length type))))
                      (when ok
                        (while type
                          (if (bbdb-check-type (aref object i) (pop type)
                                               abort extended)
                              (setq i (1+ i))
                            (setq ok nil type nil)))
                        ok))))
              ((eq tmp 'or) ; like customize `choice' type
               (let ((type (cdr type)) ok)
                 (while type
                   (if (bbdb-check-type object (pop type) nil extended)
                       (setq ok t type nil)))
                 ok))
              ;; User-defined predicate
              ((eq tmp 'user-p) (funcall (nth 1 type) object))
              (t (error "Compound type `%s' undefined" tmp)))
        (and abort
             (error "Type mismatch: expect %s, got `%s'" type object)))))

;; (bbdb-check-type 'bar 'symbol)
;; (bbdb-check-type 'bar 'bar)
;; (bbdb-check-type "foo" 'symbol t)
;; (bbdb-check-type "foo" '(or symbol string))
;; (bbdb-check-type nil '(const nil))
;; (bbdb-check-type '(bar . "foo") '(cons symbol string))
;; (bbdb-check-type '(bar "foo") '(list symbol string))
;; (bbdb-check-type '("bar" "foo") '(repeat string))
;; (bbdb-check-type (vector 'bar "foo") '(vector symbol string))
;; (bbdb-check-type (vector 'bar "foo") 'vector)
;; (bbdb-check-type '(bar (bar . "foo")) '(list symbol (cons symbol string)))
;; (bbdb-check-type '("aa" . "bb") '(or (const nil) (cons string string)) t)
;; (bbdb-check-type nil '(or nil (cons string string)) t t)
;; (bbdb-check-type "foo" '(user-p (lambda (a) (stringp a))))
;; (bbdb-check-type 'set 'function)

(defun bbdb-record-field (record field)
  "For RECORD return the value of FIELD.

FIELD may take the following values
 firstname     Return the first name of RECORD
 lastname      Return the last name of RECORD
 name          Return the full name of RECORD (first name first)
 name-lf       Return the full name of RECORD (last name first)
 affix         Return the list of affixes
 organization  Return the list of organizations
 aka           Return the list of AKAs
 aka-all       Return the list of AKAs plus mail-akas.
 mail          Return the list of email addresses
 mail-aka      Return the list of name parts in mail addresses
 mail-canon    Return the list of canonical mail addresses.
 phone         Return the list of phone numbers
 address       Return the list of addresses
 uuid          Return the uuid of RECORD
 creation-date Return the creation-date
 timestamp     Return the timestamp
 xfields       Return the list of all xfields

Any other symbol is interpreted as the label for an xfield.
Then return the value of this xfield.

See also `bbdb-record-set-field'."
  (cond ((eq field 'firstname) (bbdb-record-firstname record))
        ((eq field 'lastname) (bbdb-record-lastname record))
        ((eq field 'name)     (bbdb-record-name record))
        ((eq field 'name-lf)  (bbdb-record-name-lf record))
        ((eq field 'affix)    (bbdb-record-affix record))
        ((eq field 'organization)  (bbdb-record-organization record))
        ((eq field 'mail)     (bbdb-record-mail record))
        ((eq field 'mail-canon) (bbdb-record-mail-canon record)) ; derived (cached) field
        ((eq field 'mail-aka) (bbdb-record-mail-aka record)) ; derived (cached) field
        ((eq field 'aka)      (bbdb-record-aka record))
        ((eq field 'aka-all)  (append (bbdb-record-aka record) ; derived field
                                      (bbdb-record-mail-aka record)))
        ((eq field 'phone)    (bbdb-record-phone record))
        ((eq field 'address)  (bbdb-record-address record))
        ((eq field 'uuid)     (bbdb-record-uuid record))
        ((eq field 'creation-date) (bbdb-record-creation-date record))
        ((eq field 'timestamp) (bbdb-record-timestamp record))
        ;; Return all xfields
        ((eq field 'xfields)  (bbdb-record-xfields record))
        ;; Return xfield FIELD (e.g., `notes') or nil if FIELD is not defined.
        ((symbolp field) (bbdb-record-xfield record field))
        (t (error "Unknown field type `%s'" field))))
(define-obsolete-function-alias 'bbdb-record-get-field #'bbdb-record-field "3.0")

(defun bbdb-record-set-field (record field value &optional merge check)
  "For RECORD set FIELD to VALUE.  Return VALUE.
If MERGE is non-nil, merge VALUE with the current value of FIELD.
If CHECK is non-nil, check syntactically whether FIELD may take VALUE.
This function also updates the hash table.  However, it does not update
RECORD in the database.  Use `bbdb-change-record' for that.

FIELD may take the following values
 firstname     VALUE is the first name of RECORD
 lastname      VALUE is the last name of RECORD
 name          VALUE is the full name of RECORD either as one string
                 or as a cons pair (FIRST . LAST)
 affix         VALUE is the list of affixes
 organization  VALUE is the list of organizations
 aka           VALUE is the list of AKAs
 mail          VALUE is the list of email addresses
 phone         VALUE is the list of phone numbers
 address       VALUE is the list of addresses
 uuid          VALUE is the uuid of RECORD
 creation-date VALUE is the creation-date
 timestamp     VALUE is the timestamp
 xfields       VALUE is the list of all xfields

Any other symbol is interpreted as the label for an xfield.
Then VALUE is the value of this xfield.

See also `bbdb-record-field'."
  (bbdb-editable)
  (if (memq field '(name-lf mail-aka mail-canon aka-all))
      (error "`%s' is not allowed as the name of a field" field))
  (let ((record-type (cdr bbdb-record-type)))
    (cond ((eq field 'firstname) ; First name
           (if merge (error "Does not merge names"))
           (if check (bbdb-check-type value (bbdb-record-firstname record-type) t))
           (bbdb-check-name (cons value (bbdb-record-lastname record)) record)
           (bbdb-record-set-name record value t))

          ;; Last name
          ((eq field 'lastname)
           (if merge (error "Does not merge names"))
           (if check (bbdb-check-type value (bbdb-record-lastname record-type) t))
           (bbdb-check-name (cons (bbdb-record-firstname record) value) record)
           (bbdb-record-set-name record t value))

          ;; Name
          ((eq field 'name)
           (if merge (error "Does not merge names"))
           (if (stringp value)
               (setq value (bbdb-divide-name value))
             (if check (bbdb-check-type value '(cons string string) t)))
           (bbdb-check-name value record)
           (bbdb-record-set-name record (car value) (cdr value)))

          ;; Affix
          ((eq field 'affix)
           (if merge (setq value (bbdb-merge-lists (bbdb-record-affix record)
                                                   value 'bbdb-string=)))
           (if check (bbdb-check-type value (bbdb-record-affix record-type) t))
           (setq value (bbdb-list-strings value))
           (bbdb-record-set-affix record value))

          ;; Organization
          ((eq field 'organization)
           (if merge (setq value (bbdb-merge-lists (bbdb-record-organization record)
                                                   value 'bbdb-string=)))
           (if check (bbdb-check-type value (bbdb-record-organization record-type) t))
           (setq value (bbdb-list-strings value))
           (bbdb-hash-update record (bbdb-record-organization record) value)
           (dolist (organization value)
             (bbdb-pushnew organization bbdb-organization-list))
           (bbdb-record-set-organization record value))

          ;; AKA
          ((eq field 'aka)
           (if merge (setq value (bbdb-merge-lists (bbdb-record-aka record)
                                                   value 'bbdb-string=)))
           (if check (bbdb-check-type value (bbdb-record-aka record-type) t))
           (setq value (bbdb-list-strings value))
           (bbdb-check-name value record)
           (bbdb-hash-update record (bbdb-record-aka record) value)
           (bbdb-record-set-aka record value))

          ;; Mail
          ((eq field 'mail)
           (if merge (setq value (bbdb-merge-lists (bbdb-record-mail record)
                                                   value 'bbdb-string=)))
           (if check (bbdb-check-type value (bbdb-record-mail record-type) t))
           (setq value (bbdb-list-strings value))
           (bbdb-check-mail value record)
           (dolist (aka (bbdb-record-mail-aka record))
             (bbdb-remhash aka record))
           (dolist (mail (bbdb-record-mail-canon record))
             (bbdb-remhash mail record))
           (bbdb-record-set-mail record value)
           (bbdb-puthash-mail record))

          ;; Phone
          ((eq field 'phone)
           (if merge (setq value (bbdb-merge-lists (bbdb-record-phone record)
                                                   value 'equal)))
           (if check (bbdb-check-type value (bbdb-record-phone record-type) t))
           (dolist (phone value)
             (bbdb-pushnew (bbdb-phone-label phone) bbdb-phone-label-list))
           (bbdb-record-set-phone record value))

          ;; Address
          ((eq field 'address)
           (if merge (setq value (bbdb-merge-lists (bbdb-record-address record)
                                                   value 'equal)))
           (if check (bbdb-check-type value (bbdb-record-address record-type) t))
           (dolist (address value)
             (bbdb-pushnew (bbdb-address-label address) bbdb-address-label-list)
             (mapc (lambda (street) (bbdb-pushnewt street bbdb-street-list))
                   (bbdb-address-streets address))
             (bbdb-pushnewt (bbdb-address-city address) bbdb-city-list)
             (bbdb-pushnewt (bbdb-address-state address) bbdb-state-list)
             (bbdb-pushnewt (bbdb-address-postcode address) bbdb-postcode-list)
             (bbdb-pushnewt (bbdb-address-country address) bbdb-country-list))
           (bbdb-record-set-address record value))

          ;; uuid
          ((eq field 'uuid)
           ;; MERGE not meaningful
           (if check (bbdb-check-type value (bbdb-record-uuid record-type) t))
           (let ((old-uuid (bbdb-record-uuid record)))
             (unless (string= old-uuid value)
               (remhash old-uuid bbdb-uuid-table)
               (bbdb-record-set-uuid record value)
               (puthash value record bbdb-uuid-table))))

          ;; creation-date
          ((eq field 'creation-date)
           ;; MERGE not meaningful
           (if check (bbdb-check-type value (bbdb-record-creation-date record-type) t))
           (bbdb-record-set-creation-date record value))

          ;; timestamp
          ((eq field 'timestamp)
           ;; MERGE not meaningful
           (if check (bbdb-check-type value (bbdb-record-timestamp record-type) t))
           (bbdb-record-set-timestamp record value))

          ;; all xfields
          ((eq field 'xfields)
           (if merge
               (let ((xfields (bbdb-record-xfields record))
                     xfield)
                 (dolist (nv value)
                   (if (setq xfield (assq (car nv) xfields))
                       (setcdr xfield (bbdb-merge-xfield
                                       (car nv) (cdr xfield) (cdr nv)))
                     (setq xfields (append xfields (list nv)))))
                 (setq value xfields)))
           (if check (bbdb-check-type value (bbdb-record-xfields record-type) t))
           (let (new-xfields)
             (dolist (xfield value)
               ;; Ignore junk
               (when (and (cdr xfield) (not (equal "" (cdr xfield))))
                 (push xfield new-xfields)
                 (bbdb-pushnewq (car xfield) bbdb-xfield-label-list)))
             (bbdb-record-set-xfields record (nreverse new-xfields))))

          ;; Single xfield
          ((symbolp field)
           (if merge
               (setq value (bbdb-merge-xfield field (bbdb-record-xfield record field)
                                              value)))
           ;; The following test always succeeds
           ;; (if check (bbdb-check-type value 'sexp t))
           ;; This removes xfield FIELD if its value is nil.
           (bbdb-record-set-xfield record field value))

          (t (error "Unknown field type `%s'" field)))))

;; Currently unused (but possible entry for `bbdb-merge-xfield-function-alist')
(defun bbdb-merge-concat (string1 string2 &optional separator)
  "Return the concatenation of STRING1 and STRING2.
SEPARATOR defaults to \"\\n\"."
  (concat string1 (or separator "\n") string2))

;; Currently unused (but possible entry for `bbdb-merge-xfield-function-alist')
(defun bbdb-merge-concat-remove-duplicates (string1 string2)
  "Concatenate STRING1 and STRING2, but remove duplicate lines."
  (let ((lines (split-string string1 "\n")))
    (dolist (line (split-string string2 "\n"))
      (bbdb-pushnew line lines))
    (bbdb-concat "\n" lines)))

(defun bbdb-merge-string-least (string1 string2)
  "Return the string out of STRING1 and STRING2 that is `string-lessp'."
  (if (string-lessp string1 string2)
      string1
    string2))

(defun bbdb-merge-string-most (string1 string2)
  "Return the string out of STRING1 and STRING2 that is not `string-lessp'."
  (if (string-lessp string1 string2)
      string2
    string1))

(defun bbdb-merge-lists (l1 l2 cmp)
  "Merge two lists L1 and L2 based on comparison CMP.
An element from L2 is added to L1 if CMP returns nil for all elements of L1.
If L1 or L2 are not lists, they are replaced by (list L1) and (list L2)."
  (let (merge)
    (unless (listp l1) (setq l1 (list l1)))
    (dolist (e2 (if (listp l2) l2 (list l2)))
      (let ((ll1 l1) e1 fail)
        (while (setq e1 (pop ll1))
          (if (funcall cmp e1 e2)
              (setq ll1 nil
                    fail t)))
        (unless fail (push e2 merge))))
    (append l1 (nreverse merge))))

(defun bbdb-merge-xfield (label value1 value2)
  "For LABEL merge VALUE1 with VALUE2.
If LABEL has an entry in `bbdb-merge-xfield-function-alist', use it.
If VALUE1 or VALUE2 is a substring of the other, return the longer one.
Otherwise use `bbdb-concat'.  Return nil if we have nothing to merge."
  (if (stringp value1) (setq value1 (bbdb-string-trim value1 t)))
  (if (stringp value2) (setq value2 (bbdb-string-trim value2 t)))
  (cond ((and value1 value2)
         (let ((fun (cdr (assq label bbdb-merge-xfield-function-alist))))
           (cond (fun (funcall fun value1 value2))
                 ((not (and (stringp value1) (stringp value2)))
                  (cons value1 value2)) ; concatenate lists
                 ((string-match (regexp-quote value1) value2) value2)
                 ((string-match (regexp-quote value2) value1) value1)
                 (t (bbdb-concat label value1 value2)))))
        (value1)
        (value2)))

;;; Parsing other things

(defun bbdb-divide-name (string)
  "Divide STRING into a first name and a last name.
Case is ignored.  Return name as (FIRST . LAST).
LAST is always a string (possibly empty).  FIRST may be nil."
  (let ((case-fold-search t)
        first suffix)
    ;; Separate a suffix.
    (if (string-match bbdb-lastname-suffix-re string)
        (setq suffix (concat " " (match-string 1 string))
              string (substring string 0 (match-beginning 0))))
    (cond ((string-match "\\`\\(.+\\),[ \t\n]*\\(.+\\)\\'" string)
           ;; If STRING contains a comma, this probably means that STRING
           ;; is of the form "Last, First".
           (setq first (match-string 2 string)
                 string (match-string 1 string)))
          ((string-match bbdb-lastname-re string)
           (setq first (and (not (zerop (match-beginning 0)))
                            (substring string 0 (match-beginning 0)))
                 string (match-string 1 string))))
    (cons (and first (bbdb-string-trim first))
          (bbdb-string-trim (concat string suffix)))))

(defun bbdb-parse-postcode (string)
  "Check whether STRING is a legal postcode.
Do this only if `bbdb-check-postcode' is non-nil."
  (if bbdb-check-postcode
      (let ((postcodes bbdb-legal-postcodes) re done)
        (while (setq re (pop postcodes))
          (if (string-match re string)
              (setq done t postcodes nil)))
        (if done string
          (error "not a valid postcode.")))
    string))

(defun bbdb-phone-string (phone)
  "Massage string PHONE into a standard format."
  ;; Phone numbers should come in two forms:
  (if (= 2 (length phone))
      ;; (1) ["where" "the number"]
      (if (stringp (aref phone 1))
          (aref phone 1)
        (error "Not a valid phone number: %s" (aref phone 1)))
    ;; (2) ["where" 415 555 1212 99]
    (unless (and (integerp (aref phone 2))
                 (integerp (aref phone 3)))
      (error "Not an NANP number: %s %s" (aref phone 2) (aref phone 3)))
    (concat (if (/= 0 (bbdb-phone-area phone))
                (format "(%03d) " (bbdb-phone-area phone))
                "")
            (if (/= 0 (bbdb-phone-exchange phone))
                (format "%03d-%04d"
                        (bbdb-phone-exchange phone) (bbdb-phone-suffix phone))
                "")
            (if (and (bbdb-phone-extension phone)
                     (/= 0 (bbdb-phone-extension phone)))
                (format " x%d" (bbdb-phone-extension phone))
                ""))))

(defsubst bbdb-record-lessp (record1 record2)
  (string< (bbdb-record-sortkey record1)
           (bbdb-record-sortkey record2)))

(defmacro bbdb-error-retry (&rest body)
  "Repeatedly execute BODY ignoring errors till no error occurs."
  `(catch '--bbdb-error-retry--
     (while t
       (condition-case --c--
           (throw '--bbdb-error-retry-- (progn ,@body))
         (error (ding)
                (message "Error: %s" (nth 1 --c--))
                (sit-for 2))))))


;;; Reading and Writing the BBDB

(defun bbdb-buffer ()
  "Return buffer that visits the BBDB file `bbdb-file'.
Ensure that this buffer is in sync with `bbdb-file'.
Revert the buffer if necessary.
If `bbdb-file-remote' is non-nil and it is newer than `bbdb-file',
copy it to `bbdb-file'."
  (unless (buffer-live-p bbdb-buffer)
    (if (and bbdb-file-remote
             (file-newer-than-file-p bbdb-file-remote bbdb-file))
        (copy-file bbdb-file-remote bbdb-file t t))

    (with-current-buffer (setq bbdb-buffer (find-file-noselect bbdb-file))

      ;; Check whether auto-save file is newer than `bbdb-file'
      ;; Do this only when reading `bbdb-file'.
      (let ((auto-save-file (make-auto-save-file-name)))
        (when (and bbdb-check-auto-save-file
                   (file-newer-than-file-p auto-save-file buffer-file-name))
          (recover-file buffer-file-name) ; this queries
          (bury-buffer) ; `recover-file' selects `bbdb-buffer'
          (auto-save-mode 1) ; turn auto-save back on
          ;; Delete auto-save file even if the user rejected to recover it,
          ;; so we do not keep asking.
          (condition-case nil
              (delete-file auto-save-file)
            (file-error nil))))))

  ;; Make sure `bbdb-buffer' is not out of sync with disk.
  (with-current-buffer bbdb-buffer
    (cond ((verify-visited-file-modtime))
          ((bbdb-revert-buffer))
          ;; This is the case where `bbdb-file' has changed; the buffer
          ;; has changed as well; and the user has answered "no" to the
          ;; "flush your changes and revert" question.  The only other
          ;; alternative is to save the file right now.  If they answer
          ;; no to the following question, they will be asked the
          ;; preceeding question again and again some large (but finite)
          ;; number of times.  `bbdb-buffer' is called a lot, you see...
          ((buffer-modified-p)
           ;; this queries
           (bbdb-save t t))
          (t ; Buffer and file are inconsistent, but we let them stay that way
           (message "Continuing with inconsistent BBDB buffers")))

    ;; `bbdb-revert-buffer' kills all local variables.
    (unless (assq 'bbdb-records (buffer-local-variables))
      ;; We are reading / reverting `bbdb-buffer'.
      (set (make-local-variable 'revert-buffer-function)
           #'bbdb-revert-buffer)

      (setq buffer-file-coding-system bbdb-file-coding-system
            buffer-read-only bbdb-read-only
            bbdb-mail-aliases-need-rebuilt 'parse
            bbdb-changed-records nil)

      ;; `bbdb-before-save-hook' and `bbdb-after-save-hook' are user variables.
      ;; To avoid confusion, we hide the hook functions `bbdb-before-save'
      ;; and `bbdb-after-save' from the user as these are essential for BBDB.
      (dolist (fun (cons #'bbdb-before-save bbdb-before-save-hook))
        (add-hook 'before-save-hook fun nil t))
      (dolist (fun (cons #'bbdb-after-save bbdb-after-save-hook))
        (add-hook 'after-save-hook fun nil t))

      (clrhash bbdb-hashtable)
      (clrhash bbdb-uuid-table)

      (if (/= (point-min) (point-max))
          (bbdb-parse-records) ; normal case: nonempty db
        ;; Empty db: the following does not require `insert-before-markers'
        ;; because there are no db-markers in this buffer.
        (insert (format (concat ";; -*- mode: Emacs-Lisp; coding: %s; -*-"
                                "\n;;; file-format: %d\n")
                        bbdb-file-coding-system bbdb-file-format))
        ;; We pretend that `bbdb-buffer' is still unmodified,
        ;; so that we will (auto-)save it only if we also add records to it.
        (set-buffer-modified-p nil)
        (setq bbdb-end-marker (point-marker)
              ;; Setting `bbdb-records' makes it buffer-local,
              ;; so that we can use it as a test whether we have
              ;; initialized BBDB.
              bbdb-records nil))

      (run-hooks 'bbdb-after-read-db-hook)))

  ;; return `bbdb-buffer'
  bbdb-buffer)

(defmacro bbdb-with-db-buffer (&rest body)
  "Execute the forms in BODY with `bbdb-buffer' temporarily current.
If `bbdb-debug' was non-nil at compile-time, and `bbdb-buffer' is visible
in a window, temporarilly switch to that window.  So when we come out,
that window has been scrolled to the record we have just modified."
  (declare (indent 0))
  (if bbdb-debug
      `(let* ((buffer (bbdb-buffer))
              (window (get-buffer-window buffer)))
         (if window
             (with-selected-window window
               ,@body)
           (with-current-buffer buffer
             ,@body)))
    `(with-current-buffer (bbdb-buffer)
       ,@body)))

(defun bbdb-editable ()
  "Ensure that BBDB is editable, otherwise throw an error.
If BBDB is out of sync try to revert.
BBDB is not editable if it is read-only."
  (if bbdb-read-only (error "BBDB is read-only"))
  (let ((buffer (bbdb-buffer))) ; this reverts if necessary / possible
    ;; Is the following possible?  Superfluous tests do not hurt.
    ;; It is relevant only for editing commands in a BBDB buffer,
    ;; but not for MUA-related editing functions.
    (if (and (eq major-mode 'bbdb-mode)
             bbdb-records
             (not (memq (caar bbdb-records)
                        (with-current-buffer buffer bbdb-records))))
        (error "BBDB is out of sync")))
  t)

;;;###autoload
(defsubst bbdb-records ()
  "Return a list of all BBDB records; read in and parse the db if necessary.
This function also notices if the corresponding file on disk has been modified."
  (with-current-buffer (bbdb-buffer)
    bbdb-records))

(defun bbdb-revert-buffer (&optional ignore-auto noconfirm)
  "The `revert-buffer-function' for `bbdb-buffer' visiting `bbdb-file'.
IGNORE-AUTO and NOCONFIRM have same meaning as in `revert-buffer'.
See also variable `bbdb-auto-revert'.
Return t if the reversion was successful (or not needed).
Return nil otherwise."
  (interactive (list (not current-prefix-arg))) ; as in `revert-buffer'
  (unless (buffer-live-p bbdb-buffer)
    (error "No live BBDB buffer to revert"))
  (with-current-buffer bbdb-buffer
    (cond ((not buffer-file-number)
           ;; We have not yet created `bbdb-file'
           (when (or noconfirm
                     (yes-or-no-p "Flush your changes? "))
             (erase-buffer)
             (kill-all-local-variables)  ; clear database
             (bbdb-buffer)               ; re-initialize
             (set-buffer-modified-p nil)
             (bbdb-undisplay-records t)))
          ;; If nothing has changed do nothing, return t.
          ((and (verify-visited-file-modtime)
                (not (buffer-modified-p))))
          ((or (and (not (verify-visited-file-modtime bbdb-buffer))
                    ;; File changed on disk
                    (or noconfirm
                        (and bbdb-auto-revert
                             (not (buffer-modified-p)))
                        (yes-or-no-p
                         (if (buffer-modified-p)
                             "BBDB changed on disk; flush your changes and revert? "
                           "BBDB changed on disk; revert? "))))
               (and (verify-visited-file-modtime bbdb-buffer)
                    ;; File not changed on disk, but buffer modified
                    (buffer-modified-p)
                    (or noconfirm
                        (yes-or-no-p "Flush your changes and revert BBDB? "))))
           (unless (file-exists-p bbdb-file)
             (error "BBDB: file %s no longer exists" bbdb-file))
           (kill-all-local-variables)  ; clear database
           ;; `revert-buffer-function' has the permanent-local property
           ;; So to avoid looping, we need to bind it to nil explicitly.
           (let (revert-buffer-function)
             (revert-buffer ignore-auto t))
           (bbdb-buffer)                      ; re-initialize
           (bbdb-undisplay-records t)
           t)))) ; return nil if the user rejected to revert

(defun bbdb-goto-first-record ()
  "Go to where first record begins,  Move to end of file if no records."
  (goto-char (point-min))
  (if (search-forward "\n[" nil 'move)
      (forward-char -1)))

(defun bbdb-parse-records ()
  "Parse BBDB records and initialize various internal variables.
If `bbdb-file' uses an outdated format, migrate to `bbdb-file-format'."
  (save-excursion
    (save-restriction
      (widen)
      (bbdb-goto-first-record)
      (let* ((file (abbreviate-file-name buffer-file-name))
             (file-format (save-excursion
                            (if (re-search-backward
                                 "^;+[ \t]*file-\\(format\\|version\\):[ \t]*\\([0-9]+\\)[ \t]*$" nil t)
                                (string-to-number (match-string 2))
                              ;; No file-format line.
                              (error "BBDB corrupted: no file-format line"))))
             (migrate (< file-format bbdb-file-format))
             records)
        (if (> file-format bbdb-file-format)
            (error "%s understands file format %s but not %s."
                   (bbdb-version) bbdb-file-format file-format))

        (if (and migrate
                 (not (yes-or-no-p
                       (format (concat "Migrate `%s' to BBDB file format %s "
                                       "(back-up recommended)? ")
                               file bbdb-file-format))))
            (progn
              (message "Abort loading %s" file)
              (sleep-for 2)
              (setq bbdb-records nil
                    ;; Avoid unexpected surprises
                    buffer-read-only t)
              'abort)

          (or (eobp) (looking-at "\\[")
              (error "BBDB corrupted: no following bracket"))

          (unless bbdb-silent (message "Parsing BBDB file `%s'..." file))

          ;; narrow the buffer to skip over the rubbish before the first record.
          (narrow-to-region (point) (point-max))
          (let ((modp (buffer-modified-p))
                ;; Make sure those parens get cleaned up.
                ;; This code had better stay simple!
                (inhibit-quit t)
                (buffer-undo-list t)
                buffer-read-only)
            (goto-char (point-min)) (insert "(\n")
            (goto-char (point-max)) (insert "\n)")
            (goto-char (point-min))
            (unwind-protect
                (setq records (read (current-buffer)))
              (goto-char (point-min)) (delete-char 2)
              (goto-char (point-max)) (delete-char -2)
              (set-buffer-modified-p modp)))
          (widen)

          ;; Migrate if `bbdb-file' is outdated.
          (if migrate (setq records (bbdb-migrate records file-format)))

          ;; We could first set `bbdb-phone-label-list' and
          ;; `bbdb-address-label-list' to their customized values.  Bother?
          (setq bbdb-records records
                bbdb-xfield-label-list nil
                bbdb-organization-list nil
                bbdb-street-list nil
                bbdb-city-list nil
                bbdb-state-list nil
                bbdb-postcode-list nil
                bbdb-country-list nil)

          (bbdb-goto-first-record)
          (dolist (record records)
            ;; We assume that the markers for each record need to go at each
            ;; newline.  If this is not the case, things can go *very* wrong.
            (bbdb-debug
              (unless (looking-at "\\[")
                (error "BBDB corrupted: junk between records at %s" (point))))

            (bbdb-cache-set-marker
             (bbdb-record-set-cache record (make-vector bbdb-cache-length nil))
             (point-marker))
            (forward-line 1)

            ;; Every record must have a unique uuid in `bbdb-uuid-table'.
            (if (gethash (bbdb-record-uuid record) bbdb-uuid-table)
                ;; Is there a more useful action than throwing an error?
                ;; We are just loading BBDB, so we are not yet ready
                ;; for sophisticated solutions.
                (error "Duplicate UUID %s" (bbdb-record-uuid record)))
            ;; With `bbdb-allow-duplicates' nil, BBDB would become unusable
            ;; if duplicates threw an error upon loading BBDB.  Thus we only
            ;; issue a message.
            (bbdb-register-record record t))

          ;; Note that `bbdb-xfield-label-list' serves two purposes:
          ;;  - check whether an xfield is new to BBDB
          ;;  - list of known xfields for minibuffer completion
          ;; Only in the latter case, we might want to exclude
          ;; those xfields that are handled automatically.
          ;; So the following is not a satisfactory solution.

          ;; (dolist (label (bbdb-layout-get-option 'multi-line 'omit))
          ;;   (setq bbdb-xfield-label-list (delq label bbdb-xfield-label-list)))

          ;; `bbdb-end-marker' allows to put comments at the end of `bbdb-file'
          ;; that are ignored.
          (setq bbdb-end-marker (point-marker))

          (when migrate
            (dolist (record bbdb-records)
              (bbdb-overwrite-record-internal record))
            ;; update file format
            (goto-char (point-min))
            (if (re-search-forward (format "^;;; file-\\(version\\|format\\): %d$"
                                           file-format)
                                   nil t)
                (replace-match (format ";;; file-format: %d" bbdb-file-format))))

          (unless bbdb-silent (message "Parsing BBDB file `%s'...done" file))
          bbdb-records)))))

(defun bbdb-register-record (record &optional warn)
  "Register RECORD with BBDB.
This performs the registration (including hash tables and cache) required both
for records that are loaded from the database and for new records added to BBDB.
If `bbdb-allow-duplicates' is nil, this throws an error if the name,
an aka or mail address of RECORD is already in BBDB.  If WARN is non-nil,
issue a warning instead.
Do not call this function directly.  Call instead `bbdb-change-record'."
  (bbdb-check-name (cons (bbdb-record-firstname record)
                         (bbdb-record-lastname record))
                   record warn)
  (bbdb-check-mail (bbdb-record-mail record) record warn)

  ;; If `bbdb-allow-duplicates' is non-nil, we allow that two records
  ;; (with different uuids) refer to the same person (same name etc.).
  ;; Such duplicate records are always hashed.
  ;; Otherwise, an unhashed record would not be available for things
  ;; like completion (and we would not know which record to keeep
  ;; and which one to hide).  We trust the user she knows what
  ;; she wants if she keeps duplicate records in the database though
  ;; `bbdb-allow-duplicates' is nil.
  (bbdb-puthash (bbdb-record-name record) record)
  (bbdb-puthash (bbdb-record-name-lf record) record)
  (dolist (organization (bbdb-record-organization record))
    (bbdb-puthash organization record))
  (dolist (aka (bbdb-record-aka record))
    (bbdb-puthash aka record))
  (bbdb-puthash-mail record)
  (puthash (bbdb-record-uuid record) record bbdb-uuid-table)

  ;; Update the completion lists
  (dolist (phone (bbdb-record-phone record))
    (bbdb-pushnew (bbdb-phone-label phone) bbdb-phone-label-list))
  (dolist (address (bbdb-record-address record))
    (bbdb-pushnew (bbdb-address-label address) bbdb-address-label-list)
    (mapc (lambda (street) (bbdb-pushnewt street bbdb-street-list))
          (bbdb-address-streets address))
    (bbdb-pushnewt (bbdb-address-city address) bbdb-city-list)
    (bbdb-pushnewt (bbdb-address-state address) bbdb-state-list)
    (bbdb-pushnewt (bbdb-address-postcode address) bbdb-postcode-list)
    (bbdb-pushnewt (bbdb-address-country address) bbdb-country-list))
  (dolist (xfield (bbdb-record-xfields record))
    (bbdb-pushnewq (car xfield) bbdb-xfield-label-list))
  (dolist (organization (bbdb-record-organization record))
    (bbdb-pushnew organization bbdb-organization-list)))

(defun bbdb-before-save ()
  "Run before saving `bbdb-file' as buffer-local part of `before-save-hook'."
  (when (and bbdb-file-remote
             (or bbdb-file-remote-save-always
                 (y-or-n-p (format "Save the remote BBDB file %s too? "
                                   bbdb-file-remote))))
    ;; Write the current buffer `bbdb-file' into `bbdb-file-remote'.
    (let ((coding-system-for-write bbdb-file-coding-system))
      (write-region (point-min) (point-max) bbdb-file-remote))))

(defun bbdb-after-save ()
  "Run after saving `bbdb-file' as buffer-local part of `after-save-hook'."
  (setq bbdb-changed-records nil)
  (dolist (buffer (buffer-list))
    (with-current-buffer buffer
      (if (eq major-mode 'bbdb-mode)
          (set-buffer-modified-p nil)))))

(defun bbdb-change-record (record &rest ignored)
  "Update the database after a change of RECORD.
Return RECORD if RECORD got changed compared with the database,
return nil otherwise.
Register RECORD if it is new.  If RECORD is not new, it is the caller's
responsibility to update this information for RECORD.  (This is ensured
if the fields of RECORD are modified by calling `bbdb-record-set-field'.)
Redisplay RECORD if it is not new.

Args IGNORED are ignored and their use is discouraged.
They are present only for backward compatibility."
  (when (and ignored (get 'bbdb-change-record 'bbdb-outdated))
    (put 'bbdb-change-record 'bbdb-outdated t)
    (message "Outdated usage of `bbdb-change-record'")
    (sit-for 2))

  (if bbdb-read-only
      (error "The Insidious Big Brother Database is read-only."))
  ;; The call of `bbdb-records' checks file synchronization.
  ;; If RECORD refers to an existing record that has been changed,
  ;; yet in the meanwhile we reverted the BBDB file, then RECORD
  ;; no longer refers to a record in `bbdb-records'.  RECORD will then
  ;; be treated as new, when we try to merge it with the known record.
  (let ((tail (memq record (bbdb-records))))
    (if tail ; RECORD is not new
        ;; If the string we currently have for RECORD in `bbdb-buffer'
        ;; is `equal' to the string we would write to `bbdb-buffer',
        ;; we really did not change RECORD at all.  So we don't update RECORD
        ;; unless `bbdb-update-unchanged-records' tells us to do so anyway.
        ;; Also, we only call `bbdb-change-hook' and `bbdb-after-change-hook'
        ;; if RECORD got changed.
        (when (or bbdb-update-unchanged-records
                  (not (string= (bbdb-with-db-buffer
                                  (buffer-substring-no-properties
                                   (bbdb-record-marker record)
                                   (1- (if (cdr tail)
                                           (bbdb-record-marker (cadr tail))
                                         bbdb-end-marker))))
                                (let ((cache (bbdb-record-cache record))
                                      (inhibit-quit t))
                                  (bbdb-record-set-cache record nil)
                                  (prog1 (bbdb-with-print-loadably
                                           (prin1-to-string record))
                                    (bbdb-record-set-cache record cache))))))
          (bbdb-record-set-timestamp
           record (format-time-string bbdb-time-stamp-format nil t))
          (run-hook-with-args 'bbdb-change-hook record)
          (let ((sort (not (equal (bbdb-cache-sortkey (bbdb-record-cache record))
                                  (bbdb-record-set-sortkey record)))))
            (if (not sort) ;; If we do not need to sort, overwrite RECORD.
                (bbdb-overwrite-record-internal record)
              ;; Since we need to sort, delete then insert RECORD.
              ;; Do not mess with the hash tables here.
              ;; We assume they got updated by the caller.
              (bbdb-delete-record-internal record)
              (bbdb-insert-record-internal record))
            (bbdb-pushnewq record bbdb-changed-records)
            (run-hook-with-args 'bbdb-after-change-hook record)
            (bbdb-redisplay-record-globally record sort))
          record)

      ;; Record is new and not yet in BBDB.
      (unless (bbdb-record-cache record)
        (bbdb-record-set-cache record (make-vector bbdb-cache-length nil)))
      (unless (bbdb-record-uuid record)
        (bbdb-record-set-uuid record (bbdb-uuid)))
      (unless (bbdb-record-creation-date record)
        (bbdb-record-set-creation-date
         record (format-time-string bbdb-time-stamp-format nil t))
        (run-hook-with-args 'bbdb-create-hook record))

      (let ((old-record (gethash (bbdb-record-uuid record) bbdb-uuid-table)))
        (if old-record
            ;; RECORD is really OLD-RECORD.  Merge and return OLD-RECORD.
            (funcall (or bbdb-merge-records-function #'bbdb-merge-records)
                     record old-record)

          ;; RECORD is really new.
          (bbdb-record-set-timestamp
           record (format-time-string bbdb-time-stamp-format nil t))
          (run-hook-with-args 'bbdb-change-hook record)
          (bbdb-register-record record) ; Call this earlier?
          (bbdb-insert-record-internal record)
          (bbdb-pushnewq record bbdb-changed-records)
          (run-hook-with-args 'bbdb-after-change-hook record)
          record)))))

(defun bbdb-delete-record-internal (record &optional completely)
  "Delete RECORD in the database file.
With COMPLETELY non-nil, also undisplay RECORD and remove it
from the hash table."
  (unless (bbdb-record-marker record) (error "BBDB: marker absent"))
  (if completely (bbdb-redisplay-record-globally record nil t))
  (bbdb-with-db-buffer
    (barf-if-buffer-read-only)
    (let ((tail (memq record bbdb-records))
          (inhibit-quit t))
      (unless tail (error "BBDB record absent: %s" record))
      (delete-region (bbdb-record-marker record)
                     (if (cdr tail)
                         (bbdb-record-marker (car (cdr tail)))
                       bbdb-end-marker))
      (setq bbdb-records (delq record bbdb-records))
      (when completely
        (bbdb-remhash (bbdb-record-name record) record)
        (bbdb-remhash (bbdb-record-name-lf record) record)
        (dolist (organization (bbdb-record-organization record))
          (bbdb-remhash organization record))
        (dolist (mail (bbdb-record-mail-canon record))
          (bbdb-remhash mail record))
        (dolist (aka (bbdb-record-field record 'aka-all))
          (bbdb-remhash aka record))))))

(defun bbdb-insert-record-internal (record)
  "Insert RECORD into the database file.  Return RECORD.
Do not call this function directly, call instead `bbdb-change-record'
that calls the hooks, too."
  (unless (bbdb-record-marker record)
    (bbdb-record-set-marker record (make-marker)))
  (bbdb-with-db-buffer
    (barf-if-buffer-read-only)
    ;; splice record into `bbdb-records'
    (bbdb-debug (if (memq record bbdb-records)
                    (error "BBDB record not unique: - %s" record)))
    (if (or (not bbdb-records) ; first record in new database
            (bbdb-record-lessp record (car bbdb-records)))
        (push record bbdb-records)
      (let ((records bbdb-records))
        (while (and (cdr records)
                    (bbdb-record-lessp (nth 1 records) record))
          (setq records (cdr records)))
        (setcdr records (cons record (cdr records)))))

    (let ((next (car (cdr (memq record bbdb-records)))))
      (goto-char (if next
                     (bbdb-record-marker next)
                   bbdb-end-marker)))
    ;; Before writing the record, remove the cache (we do not want that
    ;; written to the file.)  After writing, put the cache back and update
    ;; the cache's marker.
    (let ((cache (bbdb-record-cache record))
          (point (point))
          (inhibit-quit t))
      (bbdb-debug
        (if (= point (point-min))
            (error "Inserting at point-min (%s)" point))
        (if (and (/= point bbdb-end-marker)
                 (not (looking-at "^\\[")))
            (error "Not inserting before a record (%s)" point)))
      (bbdb-record-set-cache record nil)
      (insert-before-markers
       (bbdb-with-print-loadably (prin1-to-string record)) "\n")
      (set-marker (bbdb-cache-marker cache) point)
      (bbdb-record-set-cache record cache))
    record))

(defun bbdb-overwrite-record-internal (record)
  "Overwrite RECORD in the database file.  Return RECORD.
Do not call this function directly, call instead `bbdb-change-record'
that calls the hooks, too."
  (bbdb-with-db-buffer
    (barf-if-buffer-read-only)
    (let* ((tail (memq record bbdb-records))
           (_ (unless tail (error "BBDB record absent: %s" record)))
           (cache (bbdb-record-cache record))
           (inhibit-quit t))
      (bbdb-debug
        (if (<= (bbdb-cache-marker cache) (point-min))
            (error "Cache marker is %s" (bbdb-cache-marker cache))))
      (goto-char (bbdb-cache-marker cache))
      (bbdb-debug
        (if (and (/= (point) bbdb-end-marker)
                 (not (looking-at "\\[")))
            (error "Not inserting before a record (%s)" (point))))

      (bbdb-record-set-cache record nil)
      (insert (bbdb-with-print-loadably (prin1-to-string record)) "\n")
      (delete-region (point)
                     (if (cdr tail)
                         (bbdb-record-marker (car (cdr tail)))
                       bbdb-end-marker))
      (bbdb-record-set-cache record cache)

      (bbdb-debug
        (if (<= (if (cdr tail)
                    (bbdb-record-marker (car (cdr tail)))
                  bbdb-end-marker)
                (bbdb-record-marker record))
            (error "Overwrite failed")))

      record)))

;; Record formatting:
;; This does not insert anything into the *BBDB* buffer,
;; which is handled in a second step by the display functions.

(defun bbdb-layout-get-option (layout option)
  "For LAYOUT return value of OPTION according to `bbdb-layout-alist'."
  (let ((layout-spec (if (listp layout)
                         layout
                       (assq layout bbdb-layout-alist)))
        option-value)
    (and layout-spec
         (setq option-value (assq option layout-spec))
         (cdr option-value))))

(defun bbdb-address-continental-p (address)
  "Return non-nil if ADDRESS is a continental address.
This is done by comparing the postcode to `bbdb-continental-postcode-regexp'.

This is a possible identifying function for
`bbdb-address-format-list' and `bbdb-tex-address-format-list'."
  (string-match bbdb-continental-postcode-regexp
                (bbdb-address-postcode address)))

;; This function can provide some guidance for writing
;; your own address formatting function
(defun bbdb-format-address-default (address)
  "Return formatted ADDRESS as a string.
This is the default format; it is used in the US, for example.
The result looks like this:
       label: street
              street
              ...
              city, state postcode
              country.

This function is a possible formatting function for
`bbdb-address-format-list'."
  (let ((country (bbdb-address-country address))
        (streets (bbdb-address-streets address)))
    (concat (if streets
                (concat (mapconcat #'identity streets "\n") "\n"))
            (bbdb-concat ", " (bbdb-address-city address)
                         (bbdb-concat " " (bbdb-address-state address)
                                      (bbdb-address-postcode address)))
            (unless (or (not country) (string= "" country))
              (concat "\n" country)))))

(defun bbdb-format-address (address layout)
  "Format ADDRESS using LAYOUT.  Return result as a string.
The formatting rules are defined in `bbdb-address-format-list'."
  (let ((list bbdb-address-format-list)
        (country (bbdb-address-country address))
        elt string)
    (while (and (not string) (setq elt (pop list)))
      (let ((identifier (car elt))
            (format (nth layout elt))
            ;; recognize case for format identifiers
            case-fold-search str)
        (when (or (eq t identifier) ; default
                  (and (functionp identifier)
                       (funcall identifier address))
                  (and country
                       (listp identifier)
                       ;; ignore case for countries
                       (member-ignore-case country identifier)))
          (cond ((functionp format)
                 (setq string (funcall format address)))
                ((stringp format)
                 (setq string "")
                 (dolist (form (split-string (substring format 1 -1)
                                             (substring format 0 1) t))
                   (cond ((string-match "%s" form) ; street
                          (mapc (lambda (s) (setq string (concat string (format form s))))
                                (bbdb-address-streets address)))
                         ((string-match "%c" form) ; city
                          (unless (or (not (setq str (bbdb-address-city address))) (string= "" str))
                            (setq string (concat string (format (replace-regexp-in-string "%c" "%s" form) str)))))
                         ((string-match "%p" form) ; postcode
                          (unless (or (not (setq str (bbdb-address-postcode address))) (string= "" str))
                            (setq string (concat string (format (replace-regexp-in-string "%p" "%s" form) str)))))
                         ((string-match "%S" form) ; state
                          (unless (or (not (setq str (bbdb-address-state address))) (string= "" str))
                            (setq string (concat string (format (replace-regexp-in-string "%S" "%s" form t) str)))))
                         ((string-match "%C" form) ; country
                          (unless (or (not country) (string= ""  country))
                            (setq string (concat string (format (replace-regexp-in-string "%C" "%s" form t) country)))))
                         (t (error "Malformed address format element %s" form)))))
                (t (error "Malformed address format %s" format))))))
    (unless string
      (error "No match of `bbdb-address-format-list'"))
    string))

;;; Record display:
;; This inserts formatted (pieces of) records into the BBDB buffer.

(defsubst bbdb-field-property (start field)
  "Set text property bbdb-field of text between START and point to FIELD."
  (put-text-property start (point) 'bbdb-field field))

(defsubst bbdb-display-text (text field &optional face)
  "Insert TEXT at point.  Set its text property bbdb-field to FIELD.
If FACE is non-nil, also add face FACE."
  (let ((start (point)))
    (insert text)
    (bbdb-field-property start field)
    (if face (put-text-property start (point) 'face face))))

(defun bbdb-display-list (list field &optional terminator face indent)
  "Insert elements of LIST at point.
For inserted text, set text property bbdb-field to FIELD.
If TERMINATOR is non-nil use it to terminate the inserted text.
If FACE is non-nil use it as FACE for inserted text.
If INDENT and `bbdb-wrap-column' are integers, insert line breaks in between
elements of LIST if otherwise inserted text exceeds `bbdb-wrap-column'."
  ;; `truncate-lines' is fine for one-line layout.  But it is annyoing
  ;; for records that are displayed with multi-line layout.
  ;; Non-nil `word-wrap' would be much nicer.  How can we switch between
  ;; non-nil `truncate-lines' and non-nil `word-wrap' on a per-record basis?
  ;; The following code is an alternative solution using `bbdb-wrap-column'.
  (let* ((separator (nth 1 (or (cdr (assq field bbdb-separator-alist))
                               bbdb-default-separator)))
         (indent-flag (and (integerp bbdb-wrap-column)
                           (integerp indent)))
         (prefix (if indent-flag
                     (concat separator "\n" (make-string indent ?\s))))
        elt)
    (while (setq elt (pop list))
      (bbdb-display-text elt (list field elt) face)
      (cond ((and list indent-flag
                  (> (+ (current-column) (length (car list)))
                     bbdb-wrap-column))
             (bbdb-display-text prefix (list field) face))
            (list
             (bbdb-display-text separator (list field) face))
            (terminator
             (bbdb-display-text terminator (list field) face))))))

(defun bbdb-display-name-organization (record)
  "Insert name, affix, and organization of RECORD.
If RECORD has an xfield name-face, its value is used for font-locking name.
The value of name-face may be a face that is used directly.
The value may also be a key in `bbdb-name-face-alist'.  Then the
corresponding cdr is used.  If none of these schemes succeeds the face
`bbdb-face' is used."
  ;; Should this be further customizable?  We could build the following
  ;; from a customizable list containing function calls and strings.
  ;; Name
  (let ((name (if (eq 'last-first
                      (or (bbdb-record-xfield-intern record 'name-format)
                          bbdb-name-format))
                  (bbdb-record-name-lf record)
                ;; default: Firstname Lastname
                (bbdb-record-name record)))
        (name-face (bbdb-record-xfield record 'name-face)))
    (if (string= "" name) (setq name "???"))
    (bbdb-display-text name (list 'name name)
                       (if name-face
                           (cond ((facep name-face) name-face)
                                 ((cdr (assoc name-face bbdb-name-face-alist)))
                                 (t 'bbdb-name))
                         'bbdb-name)))
  ;; Affix
  (let ((affix (bbdb-record-affix record)))
    (when affix
      (insert ", ")
      (bbdb-display-list affix 'affix)))
  ;; Organization
  (let ((organization (bbdb-record-organization record)))
    (when organization
      (insert " - ")
      (bbdb-display-list organization 'organization nil
                         'bbdb-organization)))
  ;; Image
  (if (and bbdb-image (display-images-p))
      (let ((image (cond ((functionp bbdb-image)
                          (funcall bbdb-image record))
                         ((memq bbdb-image '(name fl-name))
                          (bbdb-record-name record))
                         ((eq bbdb-image 'lf-name)
                          (bbdb-record-name-lf record))
                         (t
                          (bbdb-record-xfield record bbdb-image)))))
        (when (and image
                   (setq image (locate-file image bbdb-image-path
                                            bbdb-image-suffixes))
                   (setq image (create-image image)))
          (insert " ")
          (insert-image image)))))

(defun bbdb-display-record-one-line (record layout field-list)
  "Format RECORD for the one-line FORMAT using LAYOUT.
See `bbdb-layout-alist' for more info on layouts.
FIELD-LIST is the list of actually displayed FIELDS."
  ;; Name, affix, and organizations
  (bbdb-display-name-organization record)
  (let ((name-end (or (bbdb-layout-get-option layout 'name-end)
                      40))
        (start (line-beginning-position)))
    (when (> (- (point) start -1) name-end)
      (put-text-property (+ start name-end -4) (point) 'invisible t)
      (insert "..."))
    (indent-to name-end))
  ;; rest of the fields
  (let (formatfun start)
    (dolist (field field-list)
      (cond (;; customized formatting
             (setq formatfun (intern-soft (format "bbdb-display-%s-one-line" field)))
             (funcall formatfun record))
            ;; phone
            ((eq field 'phone)
             (let ((phones (bbdb-record-phone record)) phone)
               (if phones
                   (while (setq phone (pop phones))
                     (bbdb-display-text (format "%s " (aref phone 0))
                                        `(phone ,phone field-label)
                                        'bbdb-field-name)
                     (bbdb-display-text (format "%s%s" (aref phone 1)
                                                (if phones " " "; "))
                                        `(phone ,phone))))))
            ;; address
            ((eq field 'address)
             (dolist (address (bbdb-record-address record))
               (setq start (point))
               (insert (bbdb-format-address address 3))
               (bbdb-field-property start `(address ,address))
               (insert "; ")))
            ;; mail
            ((eq field 'mail)
             (let ((mail (bbdb-record-mail record)))
               (if mail
                   (bbdb-display-list (if (bbdb-layout-get-option layout 'primary)
                                          (list (car mail)) mail)
                                      'mail "; "))))
            ;; AKA
            ((eq field 'aka)
             (let ((aka (bbdb-record-aka record)))
               (if aka
                   (bbdb-display-list aka 'aka "; "))))
            ;; uuid
            ((eq field 'uuid)
             (let ((uuid (bbdb-record-uuid record)))
               (bbdb-display-text (format "%s; " uuid) `(uuid ,uuid))))
            ;; creation-date
            ((eq field 'creation-date)
             (let ((creation-date (bbdb-record-creation-date record)))
               (bbdb-display-text (format "%s; " creation-date) `(creation-date ,creation-date))))
            ;; timestamp
            ((eq field 'timestamp)
             (let ((timestamp (bbdb-record-timestamp record)))
               (bbdb-display-text (format "%s; " timestamp) `(timestamp ,timestamp))))
            ;; xfields
            (t
             (let* ((xfield (assq field (bbdb-record-xfields record)))
                    (value (cdr xfield)))
               (if value
                   (bbdb-display-text
                    (concat (if (stringp value)
                                (replace-regexp-in-string
                                 "\n" "; " value)
                              ;; value of xfield is a sexp
                              (let ((print-escape-newlines t))
                                (prin1-to-string value)))
                            "; ")
                    `(xfields ,xfield)))))))
    ;; delete the trailing "; "
    (if (looking-back "; " nil)
        (backward-delete-char 2))
    (insert "\n")))

(defun bbdb-display-record-multi-line (record layout field-list)
  "Format RECORD for the multi-line FORMAT using LAYOUT.
See `bbdb-layout-alist' for more info on layouts.
FIELD-LIST is the list of actually displayed FIELDS."
  (bbdb-display-name-organization record)
  (insert "\n")
  (let* ((indent (or (bbdb-layout-get-option layout 'indentation) 21))
         ;; The format string FMT adds three extra characters.
         ;; So we subtract those from the value of INDENT.
         (fmt (format " %%%ds: " (- indent 3)))
         start formatfun)
    (dolist (field field-list)
      (setq start (point))
      (cond (;; customized formatting
             (setq formatfun (intern-soft (format "bbdb-display-%s-multi-line" field)))
             (funcall formatfun record indent))
            ;; phone
            ((eq field 'phone)
             (dolist (phone (bbdb-record-phone record))
               (bbdb-display-text (format fmt (concat "phone ("
                                                      (bbdb-phone-label phone)
                                                      ")"))
                                  `(phone ,phone field-label)
                                  'bbdb-field-name)
               (bbdb-display-text (concat (bbdb-phone-string phone) "\n")
                                  `(phone ,phone))))
            ;; address
            ((eq field 'address)
             (dolist (address (bbdb-record-address record))
               (bbdb-display-text (format fmt (concat "address ("
                                                      (bbdb-address-label address)
                                                      ")"))
                                  `(address ,address field-label)
                                  'bbdb-field-name)
               (setq start (point))
               (insert (bbdb-indent-string (bbdb-format-address address 2) indent)
                       "\n")
               (bbdb-field-property start `(address ,address))))
            ;; mail
            ((eq field 'mail)
             (let ((mail (bbdb-record-mail record)))
               (when mail
                 (bbdb-display-text (format fmt "mail") '(mail nil field-label)
                                    'bbdb-field-name)
                 (bbdb-display-list (if (bbdb-layout-get-option layout 'primary)
                                        (list (car mail)) mail)
                                    'mail "\n" nil indent))))
            ;; AKA
            ((eq field 'aka)
             (let ((aka (bbdb-record-aka record)))
               (when aka
                 (bbdb-display-text (format fmt "AKA") '(aka nil field-label)
                                    'bbdb-field-name)
                 (bbdb-display-list aka 'aka "\n"))))
            ;; uuid
            ((eq field 'uuid)
             (let ((uuid (bbdb-record-uuid record)))
               (bbdb-display-text (format fmt "uuid") `(uuid ,uuid field-label)
                                  'bbdb-field-name)
               (bbdb-display-text (format "%s\n" uuid) `(uuid ,uuid))))
            ;; creation-date
            ((eq field 'creation-date)
             (let ((creation-date (bbdb-record-creation-date record)))
               (bbdb-display-text (format fmt "creation-date") `(creation-date ,creation-date field-label)
                                  'bbdb-field-name)
               (bbdb-display-text (format "%s\n" creation-date) `(creation-date ,creation-date))))
            ;; timestamp
            ((eq field 'timestamp)
             (let ((timestamp (bbdb-record-timestamp record)))
               (bbdb-display-text (format fmt "timestamp") `(timestamp ,timestamp field-label)
                                  'bbdb-field-name)
               (bbdb-display-text (format "%s\n" timestamp) `(timestamp ,timestamp))))
            ;; xfields
            (t
             (let* ((xfield (assq field (bbdb-record-xfields record)))
                    (value (cdr xfield)))
               (when value
                 (bbdb-display-text (format fmt field)
                                    `(xfields ,xfield field-label)
                                    'bbdb-field-name)
                 (setq start (point))
                 (insert (bbdb-indent-string
                          (if (stringp value)
                              value
                            ;; value of xfield is a sexp
                            (let ((string (pp-to-string value)))
                              (if (string-match "[ \t\n]+\\'" string)
                                  (substring-no-properties
                                   string 0 (match-beginning 0))
                                string)))
                          indent) "\n")
                 (bbdb-field-property start `(xfields ,xfield)))))))
    (insert "\n")))

(defalias 'bbdb-display-record-full-multi-line
  'bbdb-display-record-multi-line)

(defalias 'bbdb-display-record-pop-up-multi-line
  'bbdb-display-record-multi-line)

(defun bbdb-display-record (record layout number)
  "Insert a formatted RECORD into the current buffer at point.
LAYOUT can be a symbol describing a layout in `bbdb-layout-alist'.
If it is nil, use `bbdb-layout'.
NUMBER is the number of RECORD among the displayed records.
Move point to the end of the inserted record."
  (unless layout (setq layout bbdb-layout))
  (unless (assq layout bbdb-layout-alist)
    (error "Unknown layout `%s'" layout))
  (let ((display-p  (bbdb-layout-get-option layout 'display-p))
        (omit-list  (bbdb-layout-get-option layout 'omit)) ; omitted fields
        (order-list (bbdb-layout-get-option layout 'order)); requested field order
        (all-fields (append '(phone address mail aka) ; default field order
                            (mapcar #'car (bbdb-record-xfields record))
                            '(uuid creation-date timestamp)))
        (beg (point))
        format-function field-list)
    (when (or (not display-p)
              (and display-p
                   (funcall display-p)))
      (if (functionp omit-list)
          (setq omit-list (funcall omit-list record layout)))
      (if (functionp order-list)
          (setq order-list (funcall order-list record layout)))
      ;; first omit unwanted fields
      (when (and omit-list (or (not order-list) (memq t order-list)))
        (if (listp omit-list)
            ;; show all fields except those listed here
            (dolist (omit omit-list)
              (setq all-fields (delq omit all-fields)))
          (setq all-fields nil))) ; show nothing
      ;; then order them
      (cond ((not order-list)
             (setq field-list all-fields))
            ((not (memq t order-list))
             (setq field-list order-list))
            (t
             (setq order-list (reverse order-list)
                   all-fields (delq nil (mapcar (lambda (f)
                                                  (unless (memq f order-list)
                                                    f))
                                                all-fields)))
             (dolist (order order-list)
               (if (eq t order)
                   (setq field-list (append all-fields field-list))
                 (push order field-list)))))
      ;; call the actual format function
      (setq format-function
            (intern-soft (format "bbdb-display-record-%s" layout)))
      (if (functionp format-function)
          (funcall format-function record layout field-list)
        (bbdb-display-record-multi-line record layout field-list))
      (put-text-property beg (point) 'bbdb-record-number number))))

(defun bbdb-display-records (records &optional layout append
                                     select horiz-p)
  "Display RECORDS using LAYOUT.
If APPEND is non-nil append RECORDS to the already displayed records.
Otherwise RECORDS overwrite the displayed records.
SELECT and HORIZ-P have the same meaning as in `bbdb-pop-up-window'."
  (interactive (list (bbdb-completing-read-records "Display records: ")
                     (bbdb-layout-prefix)))
  (if (bbdb-append-display-p) (setq append t))
  ;; `bbdb-redisplay-record' calls `bbdb-display-records'
  ;; with display information already amended to RECORDS.
  (unless (or (null records)
              (consp (car records)))
    ;; add layout and a marker to the local list of records
    (setq layout (or layout bbdb-layout)
          records (mapcar (lambda (record)
                            (list record layout (make-marker)))
                          records)))

  (let ((first-new (caar records)) ; first new record
        new-name)

    ;; If `bbdb-multiple-buffers' is non-nil we create a new BBDB buffer
    ;; when not already within one.  The new buffer name starts with a space,
    ;; i.e. it does not clutter the buffer list.
    (when (and bbdb-multiple-buffers
               (not (assq 'bbdb-buffer-name (buffer-local-variables))))
      (setq new-name (concat " *BBDB " (if (functionp bbdb-multiple-buffers)
                                           (funcall bbdb-multiple-buffers)
                                         (buffer-name))
                              "*"))
      ;; `bbdb-buffer-name' becomes buffer-local in the current buffer
      ;; as well as in the buffer `bbdb-buffer-name'
      (set (make-local-variable 'bbdb-buffer-name) new-name))

    (with-current-buffer (get-buffer-create bbdb-buffer-name) ; *BBDB*
      ;; If we are appending RECORDS to the ones already displayed,
      ;; then first remove any duplicates, and then sort them.
      (if append
          (let ((old-rec (mapcar #'car bbdb-records)))
            (dolist (record records)
              (unless (memq (car record) old-rec)
                (push record bbdb-records)))
            (setq records
                  (sort bbdb-records
                        (lambda (x y) (bbdb-record-lessp (car x) (car y)))))))

      (bbdb-mode)
      ;; Normally `bbdb-records' is the only BBDB-specific buffer-local variable
      ;; in the *BBDB* buffer.  It is intentionally not permanent-local.
      ;; A value of nil indicates that we need to (re)process the records.
      (setq bbdb-records records)
      (if new-name
          (set (make-local-variable 'bbdb-buffer-name) new-name))

      (unless (or bbdb-silent-internal bbdb-silent)
        (message "Formatting BBDB..."))
      (let ((record-number 0)
            buffer-read-only all-records)
        (erase-buffer)
        (bbdb-debug (setq all-records (bbdb-records)))
        (dolist (record records)
          (bbdb-debug (unless (memq (car record) all-records)
                        (error "Record %s does not exist" (car record))))
          (set-marker (nth 2 record) (point))
          (bbdb-display-record (nth 0 record) (nth 1 record) record-number)
          (setq record-number (1+ record-number)))

        (run-hooks 'bbdb-display-hook))

      (unless (or bbdb-silent-internal bbdb-silent)
        (message "Formatting BBDB...done."))
      (set-buffer-modified-p nil)

      (bbdb-pop-up-window select horiz-p)
      (if (not first-new)
          (goto-char (point-min))
        ;; Put point on first new record in *BBDB* buffer.
        (goto-char (nth 2 (assq first-new bbdb-records)))
        (set-window-start (get-buffer-window (current-buffer)) (point))))))

(defun bbdb-undisplay-records (&optional all-buffers)
  "Undisplay records in *BBDB* buffer, leaving this buffer empty.
If ALL-BUFFERS is non-nil undisplay records in all BBDB buffers."
  (dolist (buffer (cond (all-buffers (buffer-list))
                        ((let ((buffer (get-buffer bbdb-buffer-name)))
                           (and (buffer-live-p buffer) (list buffer))))))
    (with-current-buffer buffer
      (when (eq major-mode 'bbdb-mode)
        (let (buffer-read-only)
          (erase-buffer))
        (setq bbdb-records nil)
        (set-buffer-modified-p nil)))))

(defun bbdb-redisplay-record (record &optional sort delete-p)
  "Redisplay RECORD in current BBDB buffer.
If SORT is t, usually because RECORD has a new sortkey, re-sort
the displayed records.
If DELETE-P is non-nil RECORD is removed from the BBDB buffer."
  ;; For deletion in the *BBDB* buffer we use the full information
  ;; about the record in the database. Therefore, we need to delete
  ;; the record in the *BBDB* buffer before deleting the record in
  ;; the database.
  ;; FIXME: If point is initially inside RECORD, `bbdb-redisplay-record'
  ;; puts point at the beginning of the redisplayed RECORD.
  ;; Ideally, `bbdb-redisplay-record' should put point such that it
  ;; matches the previous value `bbdb-ident-point'.
  (let ((full-record (assq record bbdb-records)))
    (unless full-record
      (error "Record `%s' not displayed" (bbdb-record-name record)))
    (if (and sort (not delete-p))
        ;; FIXME: For records requiring re-sorting it may be more efficient
        ;; to insert these records in their proper location instead of
        ;; re-displaying all records.
        (bbdb-display-records (list record) nil t)
      (let ((marker (nth 2 full-record))
            (end-marker (nth 2 (car (cdr (memq full-record bbdb-records)))))
            buffer-read-only record-number)
        ;; If point is inside record, put it at the beginning of the record.
        (if (and (<= marker (point))
                 (< (point) (or end-marker (point-max))))
            (goto-char marker))
        (save-excursion
          (goto-char marker)
          (setq record-number (get-text-property (point) 'bbdb-record-number))
          (unless delete-p
            ;; First insert the reformatted record, then delete the old one,
            ;; so that the marker of this record cannot collapse with the
            ;; marker of the subsequent record
            (bbdb-display-record (car full-record) (nth 1 full-record)
                                 record-number))
          (delete-region (point) (or end-marker (point-max)))
          ;; If we deleted a record we need to update the subsequent
          ;; record numbers.
          (when delete-p
            (let* ((markers (append (mapcar (lambda (x) (nth 2 x))
                                            (cdr (memq full-record bbdb-records)))
                                    (list (point-max))))
                   (start (pop markers)))
              (dolist (end markers)
                (put-text-property start end
                                   'bbdb-record-number record-number)
                (setq start end
                      record-number (1+ record-number))))
            (setq bbdb-records (delq full-record bbdb-records)))
          (run-hooks 'bbdb-display-hook))))))

(defun bbdb-redisplay-record-globally (record &optional sort delete-p)
  "Redisplay RECORD in all BBDB buffers.
If SORT is t, usually because RECORD has a new sortkey, re-sort
the displayed records.
If DELETE-P is non-nil RECORD is removed from the BBDB buffers."
  (dolist (buffer (buffer-list))
    (with-current-buffer buffer
      (if (and (eq major-mode 'bbdb-mode)
               (memq record (mapcar #'car bbdb-records)))
          (let ((window (get-buffer-window bbdb-buffer-name)))
            (if window
                (with-selected-window window
                  (bbdb-redisplay-record record sort delete-p))
              (bbdb-redisplay-record record sort delete-p)))))))
(define-obsolete-function-alias 'bbdb-maybe-update-display
  #'bbdb-redisplay-record-globally "3.0")


;;; window configuration hackery
(defun bbdb-pop-up-window (&optional select horiz-p)
  "Display *BBDB* buffer by popping up a new window.
Finds the largest window on the screen, splits it, displaying the
*BBDB* buffer in the bottom `bbdb-pop-up-window-size' lines (unless
the *BBDB* buffer is already visible, in which case do nothing.)
Select this window if SELECT is non-nil.

If `bbdb-mua-pop-up' is 'horiz, and the first window matching
the predicate HORIZ-P is wider than the car of `bbdb-horiz-pop-up-window-size'
then the window will be split horizontally rather than vertically."
  (let ((buffer (get-buffer bbdb-buffer-name)))
    (unless buffer
      (error "No %s buffer to display" bbdb-buffer-name))
    (cond ((let ((window (get-buffer-window buffer t)))
             ;; We already have a BBDB window so that at most we select it
             (and window
                  (or (not select) (select-window window)))))

          ;; try horizontal split
          ((and (eq bbdb-mua-pop-up 'horiz)
                horiz-p
                (>= (frame-width) (car bbdb-horiz-pop-up-window-size))
                (let ((window-list (window-list))
                      (b-width (cdr bbdb-horiz-pop-up-window-size))
                      (search t) s-window)
                  (while (and (setq s-window (pop window-list))
                              (setq search (not (funcall horiz-p s-window)))))
                  (unless (or search (<= (window-width s-window)
                                         (car bbdb-horiz-pop-up-window-size)))
                    (condition-case nil ; `split-window' might fail
                        (let ((window (split-window
                                       s-window
                                       (if (integerp b-width)
                                           (- (window-width s-window) b-width)
                                         (round (* (- 1 b-width) (window-width s-window))))
                                       t))) ; horizontal split
                          (set-window-buffer window buffer)
                          (cond (bbdb-dedicated-window
                                 (set-window-dedicated-p window bbdb-dedicated-window))
                                ((fboundp 'display-buffer-record-window) ; GNU Emacs >= 24.1
                                 (set-window-prev-buffers window nil)
                                 (display-buffer-record-window 'window window buffer)))
                          (if select (select-window window))
                          t)
                      (error nil))))))

          ((eq t bbdb-pop-up-window-size)
           (bbdb-pop-up-window-simple buffer select))

          (t ;; vertical split
           (let* ((window (selected-window))
                  (window-height (window-height window)))
             ;; find the tallest window...
             (mapc (lambda (w)
                     (let ((w-height (window-height w)))
                       (if (> w-height window-height)
                           (setq window w window-height w-height))))
                   (window-list))
             (condition-case nil
                 (progn
                   (unless (eql bbdb-pop-up-window-size 1.0)
                     (setq window (split-window ; might fail
                                   window
                                   (if (integerp bbdb-pop-up-window-size)
                                       (- window-height 1 ; for mode line
                                          (max window-min-height bbdb-pop-up-window-size))
                                     (round (* (- 1 bbdb-pop-up-window-size)
                                               window-height))))))
                   (set-window-buffer window buffer) ; might fail
                   (cond (bbdb-dedicated-window
                          (set-window-dedicated-p window bbdb-dedicated-window))
                         ((and (fboundp 'display-buffer-record-window) ; GNU Emacs >= 24.1
                               (not (eql bbdb-pop-up-window-size 1.0)))
                          (set-window-prev-buffers window nil)
                          (display-buffer-record-window 'window window buffer)))
                   (if select (select-window window)))
               (error (bbdb-pop-up-window-simple buffer select))))))))

(defun bbdb-pop-up-window-simple (buffer select)
  "Display BUFFER in some window, selecting it if SELECT is non-nil.
If `bbdb-dedicated-window' is non-nil, mark the window as dedicated."
  (let ((window (if select
                    (progn (pop-to-buffer buffer)
                           (get-buffer-window))
                  (display-buffer buffer))))
    (if bbdb-dedicated-window
        (set-window-dedicated-p window bbdb-dedicated-window))))


;;; BBDB mode

;;;###autoload
(define-derived-mode bbdb-mode special-mode "BBDB"
  "Major mode for viewing and editing the Insidious Big Brother Database.
Letters no longer insert themselves.  Numbers are prefix arguments.
You can move around using the usual cursor motion commands.
\\<bbdb-mode-map>
\\[bbdb-add-mail-alias]\t Add new mail alias to visible records or \
remove it.
\\[bbdb-edit-field]\t Edit the field on the current line.
\\[bbdb-delete-field-or-record]\t Delete the field on the \
current line.  If the current line is the\n\t first line of a record, then \
delete the entire record.
\\[bbdb-insert-field]\t Insert a new field into the current record.  \
Note that this\n\t will let you add new fields of your own as well.
\\[bbdb-transpose-fields]\t Swap the field on the current line with the \
previous field.
\\[bbdb-dial]\t Dial the current phone field.
\\[bbdb-next-record], \\[bbdb-prev-record]\t Move to the next or the previous \
displayed record, respectively.
\\[bbdb-create]\t Create a new record.
\\[bbdb-toggle-records-layout]\t Toggle whether the current record is displayed in a \
one-line\n\t listing, or a full multi-line listing.
\\[bbdb-do-all-records]\\[bbdb-toggle-records-layout]\t Do that \
for all displayed records.
\\[bbdb-merge-records]\t Merge the contents of the current record with \
some other, and then\n\t delete the current record.
\\[bbdb-omit-record]\t Remove the current record from the display without \
deleting it from\n\t the database.  This is often a useful thing to do \
before using one\n\t of the `*' commands.
\\[bbdb]\t Search for records in the database (on all fields).
\\[bbdb-search-mail]\t Search for records by mail address.
\\[bbdb-search-organization]\t Search for records by organization.
\\[bbdb-search-xfields]\t Search for records by xfields.
\\[bbdb-search-name]\t Search for records by name.
\\[bbdb-search-changed]\t Display records that have changed since the database \
was saved.
\\[bbdb-mail]\t Compose mail to the person represented by the \
current record.
\\[bbdb-do-all-records]\\[bbdb-mail]\t Compose mail \
to everyone whose record is displayed.
\\[bbdb-save]\t Save the BBDB file to disk.
\\[bbdb-tex]\t Create a TeX listing of the current record.
\\[bbdb-do-all-records]\\[bbdb-tex]\t Do that for all \
displayed record.
\\[other-window]\t Move to another window.
\\[bbdb-info]\t Read the Info documentation for BBDB.
\\[bbdb-help]\t Display a one line command summary in the echo area.
\\[bbdb-browse-url]\t Visit Web sites listed in the `url' field(s) of the current \
record.

For address completion using the names and mail addresses in the database:
\t in Mail mode, type \\<mail-mode-map>\\[bbdb-complete-mail].
\t in Message mode, type \\<message-mode-map>\\[bbdb-complete-mail].

Important variables:
\t `bbdb-auto-revert'
\t `bbdb-ignore-redundant-mails'
\t `bbdb-case-fold-search'
\t `bbdb-completion-list'
\t `bbdb-default-area-code'
\t `bbdb-default-domain'
\t `bbdb-layout'
\t `bbdb-file'
\t `bbdb-phone-style'
\t `bbdb-check-auto-save-file'
\t `bbdb-pop-up-layout'
\t `bbdb-pop-up-window-size'
\t `bbdb-add-name'
\t `bbdb-add-aka'
\t `bbdb-add-mails'
\t `bbdb-new-mails-primary'
\t `bbdb-read-only'
\t `bbdb-mua-pop-up'
\t `bbdb-user-mail-address-re'

There are numerous hooks.  M-x apropos ^bbdb.*hook RET

\\{bbdb-mode-map}"
  (setq buffer-undo-list t ;; No need to keep an undo list in *BBDB* buffer
        truncate-lines t
        default-directory (file-name-directory bbdb-file)
        mode-line-buffer-identification
        (list 24 (buffer-name) "  "
              '(:eval (format "%d/%d/%d"
                              (1+ (or (get-text-property
                                       (point) 'bbdb-record-number)
                                      -1))
                              (length bbdb-records)
                              ;; This code gets called a lot.
                              ;; So we keep it as simple as possible.
                              (with-current-buffer bbdb-buffer
                                (length bbdb-records))))
              '(:eval (concat "  "
                              (bbdb-concat " " (elt bbdb-modeline-info 0)
                                           (elt bbdb-modeline-info 2)
                                           (elt bbdb-modeline-info 4)))))
        mode-line-modified
        ;; For the mode-line we want to be fast. So we skip the checks
        ;; performed by `bbdb-with-db-buffer'.
        '(:eval (if (buffer-modified-p bbdb-buffer)
                    (if bbdb-read-only "%*" "**")
                  (if bbdb-read-only "%%" "--"))))
  ;; `bbdb-revert-buffer' acts on `bbdb-buffer'.  Yet this command is usually
  ;; called from the *BBDB* buffer.
  (set (make-local-variable 'revert-buffer-function)
       #'bbdb-revert-buffer)
  ;; FIXME: Really?  Why?
  (add-hook 'post-command-hook #'force-mode-line-update nil t))



(defun bbdb-sendmail-menu (record)
  "Menu items for email addresses of RECORD."
  (let ((mails (bbdb-record-mail record)))
    (list
     (if (cdr mails)
         ;; Submenu for multiple mail addresses
         (cons "Send mail to..."
               (mapcar (lambda (address)
                         (vector address `(bbdb-compose-mail
                                           ,(bbdb-dwim-mail record address))
                                 t))
                       mails))
       ;; Single entry for single mail address
       (vector (concat "Send mail to " (car mails))
               `(bbdb-compose-mail ,(bbdb-dwim-mail record (car mails)))
               t)))))

(defun bbdb-field-menu (record field)
  "Menu items specifically for FIELD of RECORD."
  (let ((type (car field)))
    (append
     (list
      (format "Commands for %s Field:"
              (cond ((eq type 'xfields)
                     (format "\"%s\"" (symbol-name (car (nth 1 field)))))
                    ((eq type 'name) "Name")
                    ((eq type 'affix) "Affix")
                    ((eq type 'organization) "Organization")
                    ((eq type 'aka) "Alternate Names")
                    ((eq type 'mail) "Mail Addresses")
                    ((memq type '(address phone))
                     (format "\"%s\" %s" (aref (nth 1 field) 0)
                             (capitalize (symbol-name type)))))))
     (cond ((eq type 'phone)
            (list (vector (concat "Dial " (bbdb-phone-string (nth 1 field)))
                          `(bbdb-dial ',field nil) t)))
           ((eq type 'xfields)
            (let* ((field (cadr field))
                   (type (car field)))
              (cond ((eq type 'url )
                     (list (vector (format "Browse \"%s\"" (cdr field))
                                   `(bbdb-browse-url ,record) t)))))))
     '(["Edit Field" bbdb-edit-field t])
     (unless (eq type 'name)
       '(["Delete Field" bbdb-delete-field-or-record t])))))

(defun bbdb-insert-field-menu (record)
  "Submenu for inserting a new field for RECORD."
  (cons "Insert New Field..."
        (mapcar
         (lambda (field)
           (if (stringp field) field
             (vector (symbol-name field)
                     `(bbdb-insert-field
                       ,record ',field (bbdb-read-field ,record ',field
                                                        ,current-prefix-arg))
                     (not (or (and (eq field 'affix) (bbdb-record-affix record))
                              (and (eq field 'organization)
                                   (bbdb-record-organization record))
                              (and (eq field 'mail) (bbdb-record-mail record))
                              (and (eq field 'aka) (bbdb-record-aka record))
                              (assq field (bbdb-record-xfields record)))))))
         (append '(affix organization aka phone address mail)
                 '("--") bbdb-xfield-label-list))))

(defun bbdb-mouse-menu (event)
  "BBDB mouse menu for EVENT,"
  (interactive "e")
  (mouse-set-point event)
  (let* ((record (bbdb-current-record))
         (field  (bbdb-current-field))
         (menu (if (and record field (functionp bbdb-user-menu-commands))
                   (funcall bbdb-user-menu-commands record field)
                 bbdb-user-menu-commands)))
    (if record
        (popup-menu
         (append
          (list
           (format "Commands for record \"%s\":" (bbdb-record-name record))
           ["Delete Record" bbdb-delete-records t]
           ["Toggle Record Display Layout" bbdb-toggle-records-layout t]
           (if (and (not (eq 'full-multi-line
                             (nth 1 (assq record bbdb-records))))
                    (bbdb-layout-get-option 'multi-line 'omit))
               ["Fully Display Record" bbdb-display-records-completely t])
           ["Omit Record" bbdb-omit-record t]
           ["Merge Record" bbdb-merge-records t])
          (if (bbdb-record-mail record)
              (bbdb-sendmail-menu record))
          (list "--" (bbdb-insert-field-menu record))
          (if field
              (cons "--" (bbdb-field-menu record field)))
          (if menu
              (append '("--" "User Defined Commands") menu)))))))



(defun bbdb-scan-property (property predicate n)
  "Scan for change of PROPERTY matching PREDICATE for N times.
Return position of beginning of matching interval."
  (let ((fun (if (< 0 n) 'next-single-property-change
               'previous-single-property-change))
        (limit (if (< 0 n) (point-max) (point-min)))
        (nn (abs n))
        (i 0)
        (opoint (point))
        npoint)
    ;; For backward search, move point to beginning of interval with PROPERTY.
    (if (and (<= n 0)
             (< (point-min) opoint)
             (let ((prop (get-text-property opoint property)))
               (and (eq prop (get-text-property (1- opoint) property))
                    (funcall predicate prop))))
        (setq opoint (previous-single-property-change opoint property nil limit)))
    (if (zerop n)
        opoint ; Return beginning of interval point is in
      (while (and (< i nn)
                  (let (done)
                    (while (and (not done)
                                (setq npoint (funcall fun opoint property nil limit)))
                      (cond ((and (/= opoint npoint)
                                  (funcall predicate (get-text-property
                                                      npoint property)))
                             (setq opoint npoint done t))
                            ((= opoint npoint)
                             ;; Search reached beg or end of buffer: abort.
                             (setq done t i nn npoint nil))
                            (t (setq opoint npoint))))
                    done))
        (setq i (1+ i)))
      npoint)))

(defun bbdb-next-record (n)
  "Move point to the beginning of the next BBDB record.
With prefix N move forward N records."
  (interactive "p")
  (let ((npoint (bbdb-scan-property 'bbdb-record-number 'integerp n)))
    (if npoint (goto-char npoint)
      (error "No %s record" (if (< 0 n) "next" "previous")))))

(defun bbdb-prev-record (n)
  "Move point to the beginning of the previous BBDB record.
With prefix N move backwards N records."
  (interactive "p")
  (bbdb-next-record (- n)))

(defun bbdb-next-field (n)
  "Move point to next (sub)field.
With prefix N move forward N (sub)fields."
  (interactive "p")
  (let ((npoint (bbdb-scan-property
                 'bbdb-field
                 (lambda (p) (and (nth 1 p)
                                  (not (eq (nth 2 p) 'field-label))))
                 n)))
    (if npoint (goto-char npoint)
      (error "No %s field" (if (< 0 n) "next" "previous")))))

(defun bbdb-prev-field (n)
  "Move point to previous (sub)field.
With prefix N move backwards N (sub)fields."
  (interactive "p")
  (bbdb-next-field (- n)))

(defun bbdb-save (&optional prompt noisy)
  "Save the BBDB if it is modified.
If PROMPT is non-nil prompt before saving.
If NOISY is non-nil as in interactive calls issue status messages."
  (interactive (list nil t))
  (bbdb-with-db-buffer
    (if (buffer-modified-p)
        (if (or (not prompt)
                (y-or-n-p
                 (if bbdb-read-only
                     "Save the BBDB, even though it is supposedly read-only? "
                   "Save the BBDB now? ")))
            (save-buffer))
      (if noisy (message "(No BBDB changes need to be saved)")))))

;;;###autoload
(defun bbdb-version (&optional arg)
  "Return string describing the version of BBDB.
With prefix ARG, insert string at point."
  (interactive (list (or (and current-prefix-arg 1) t)))
  (let* ((version
          (if (string-match "\\`[ \t\n]*[1-9]" bbdb-version)
              bbdb-version
            (let ((source (find-function-noselect 'bbdb-version)))
              (if source
                  (with-current-buffer (car source)
                    (prog1 (save-excursion
                             (goto-char (point-min))
                             (when (re-search-forward
                                    "^;;+ *Version: \\(.*\\)" nil t)
                               (match-string-no-properties 1)))
                      (unless (get-buffer-window nil t)
                        (kill-buffer (current-buffer)))))))))
         (version-string (format "BBDB version %s" (or version "<unknown>"))))
    (cond ((numberp arg) (insert (message version-string)))
          ((eq t arg) (message version-string))
          (t version-string))))



(defun bbdb-sort-records ()
  "Sort BBDB database.
This is not needed when using BBDB itself.  It might be necessary,
however, after having used other programs to add records to the BBDB."
  (interactive)
  (let* ((records (copy-sequence (bbdb-records))))
    (bbdb-with-db-buffer
      (setq bbdb-records (sort bbdb-records 'bbdb-record-lessp))
      (if (equal records bbdb-records)
          (message "BBDB already sorted properly")
        (message "BBDB was mis-sorted; fixing...")
        (bbdb-goto-first-record)
        (delete-region (point) bbdb-end-marker)
        (let ((buf (current-buffer))
              (inhibit-quit t) ; really, don't mess with this
              cache)
          (dolist (record bbdb-records)
            ;; Before printing the record, remove cache (we do not want that
            ;; written to the file.)  Ater writing, put the cache back
            ;; and update the cache's marker.
            (setq cache (bbdb-record-cache record))
            (set-marker (bbdb-cache-marker cache) (point))
            (bbdb-record-set-cache record nil)
            (bbdb-with-print-loadably (prin1 record buf))
            (bbdb-record-set-cache record cache)
            (insert ?\n)))
        (dolist (buffer (buffer-list))
          (with-current-buffer buffer
            (if (eq major-mode 'bbdb-mode)
                ; Redisplay all records
                (bbdb-display-records nil nil t))))
        (message "BBDB was mis-sorted; fixing...done")))))



;;;###autoload
(defun bbdb-initialize (&rest muas)
  "Initialize BBDB for MUAS and miscellaneous packages.
List MUAS may include the following symbols to initialize the respective
mail/news readers, composers, and miscellaneous packages:
  gnus       Gnus mail/news reader.
  mh-e       MH-E mail reader.
  mu4e       Mu4e mail reader.
  rmail      Rmail mail reader.
  vm         VM mail reader.
  mail       Mail (M-x mail).
  message    Message mode.
  wl         Wanderlust mail reader.

  anniv      Anniversaries in Emacs diary.

  sc         Supercite.  However, this is not the full story.
               See bbdb-sc.el for how to fully hook BBDB into Supercite.

  pgp        PGP support:  this adds `bbdb-pgp' to `message-send-hook'
               and `mail-send-hook' so that `bbdb-pgp' runs automatically
               when a message is sent.
               Yet see info node `(message)Signing and encryption'
               why you might not want to rely for encryption on a hook
               function which runs just before the message is sent,
               that is, you might want to call the command `bbdb-pgp' manually,
               then call `mml-preview'.

See also `bbdb-mua-auto-update-init'.  The latter is a separate function
as this allows one to initialize the auto update feature for some MUAs only,
for example only for outgoing messages."
  (dolist (mua muas)
    (let ((init (cadr (assq mua bbdb-init-functions))))
      ;; Should we make sure that each insinuation happens only once?
      (cond
       ((functionp init) (funcall init))
       (init (eval init t))             ;Old-style "form".
       (t
        (bbdb-warn "Do not know how to insinuate `%s'" mua)))))
  (run-hooks 'bbdb-initialize-hook))


(provide 'bbdb)

;;; bbdb.el ends here
bbdb-20200102.403/bbdb-message.el0000644000175000017500000000420313643253537013541 0ustar  cbcb;;; bbdb-message.el --- BBDB interface to Mail Composition Packages. -*- lexical-binding: t -*-

;; Copyright (C) 2010-2017  Free Software Foundation, Inc.

;; This file is part of the Insidious Big Brother Database (aka BBDB),

;; BBDB 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.

;; BBDB 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 BBDB.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;; This file contains the BBDB interface to Mail Composition Packages.
;;; See the BBDB info manual for documentation.

;;; Code:

(require 'bbdb)
(require 'message)
(require 'sendmail)

;;;###autoload
(defun bbdb-insinuate-message ()
  "Hook BBDB into Message Mode.
Do not call this in your init file.  Use `bbdb-initialize'."
  ;; Suggestions welcome: What are good keybindings for the following
  ;; commands that do not collide with existing bindings?
  ;; (define-key message-mode-map "'" 'bbdb-mua-display-recipients)
  ;; (define-key message-mode-map ";" 'bbdb-mua-edit-field-recipients)
  ;; (define-key message-mode-map "/" 'bbdb)
  (if bbdb-complete-mail
      (define-key message-mode-map "\M-\t" 'bbdb-complete-mail)))

;;;###autoload
(defun bbdb-insinuate-mail ()
  "Hook BBDB into Mail Mode.
Do not call this in your init file.  Use `bbdb-initialize'."
  ;; Suggestions welcome: What are good keybindings for the following
  ;; commands that do not collide with existing bindings?
  ;; (define-key mail-mode-map "'" 'bbdb-mua-display-recipients)
  ;; (define-key mail-mode-map ";" 'bbdb-mua-edit-field-recipients)
  ;; (define-key mail-mode-map "/" 'bbdb)
  (if bbdb-complete-mail
      (define-key mail-mode-map "\M-\t" 'bbdb-complete-mail)))

(provide 'bbdb-message)

;;; bbdb-message.el ends here
bbdb-20200102.403/bbdb-com.el0000644000175000017500000037673213643253537012716 0ustar  cbcb;;; bbdb-com.el --- user-level commands of BBDB -*- lexical-binding: t -*-

;; Copyright (C) 2010-2019  Free Software Foundation, Inc.

;; This file is part of the Insidious Big Brother Database (aka BBDB),

;; BBDB 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.

;; BBDB 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 BBDB.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;; This file contains most of the user-level interactive commands for BBDB.
;; See the BBDB info manual for documentation.

;;; Code:

(require 'bbdb)
(require 'mailabbrev)

(eval-and-compile
  (autoload 'build-mail-aliases "mailalias")
  (autoload 'browse-url-url-at-point "browse-url"))

(require 'crm)
(defvar bbdb-crm-local-completion-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map crm-local-completion-map)
    (define-key map " " 'self-insert-command)
    map)
  "Keymap used for BBDB crm completions.")

(defun bbdb-get-records (prompt)
  "If inside the *BBDB* buffer get the current records.
In other buffers ask the user."
  (if (string= bbdb-buffer-name (buffer-name))
      (bbdb-do-records)
    (bbdb-completing-read-records prompt)))

;; Note about the arg RECORDS of various BBDB commands:
;;  - Usually, RECORDS is a list of records.  (Interactively,
;;    this list of records is set up by `bbdb-do-records'.)
;;  - If these commands are used, e.g., in `bbdb-create-hook' or
;;    `bbdb-change-hook', they will be called with one arg, a single record.
;; So depending on context the value of RECORDS will be a single record
;; or a list of records, and we want to handle both cases.
;; So we pass RECORDS to `bbdb-record-list' to handle both cases.
(defun bbdb-record-list (records &optional full)
  "Ensure that RECORDS is a list of records.
If RECORDS is a single record turn it into a list.
If FULL is non-nil, assume that RECORDS include display information."
  (if records
      (if full
          (if (vectorp (car records)) (list records) records)
        (if (vectorp records) (list records) records))))

;; Note about BBDB prefix commands:
;; `bbdb-do-all-records', `bbdb-append-display' and `bbdb-search-invert'
;; are fake prefix commands. They need not precede the main commands.
;; Also, `bbdb-append-display' can act on multiple commands.

(defun bbdb-prefix-message ()
  "Display a message about selected BBDB prefix commands."
  (let ((msg (bbdb-concat " " (elt bbdb-modeline-info 1)
                          (elt bbdb-modeline-info 3)
                          (elt bbdb-modeline-info 5))))
    (unless (string= "" msg) (message "%s" msg))))

;;;###autoload
(defun bbdb-do-all-records (&optional arg)
  "Command prefix for operating on all records currently displayed.
With prefix ARG a positive number, operate on all records.
With prefix ARG a negative number, operate on current record only.
This only works for certain commands."
  (interactive "P")
  (setq bbdb-do-all-records
        (or (and (numberp arg) (< 0 arg))
            (and (not (numberp arg)) (not bbdb-do-all-records))))
  (aset bbdb-modeline-info 4 (if bbdb-do-all-records "all"))
  (aset bbdb-modeline-info 5
        (if bbdb-do-all-records
            (substitute-command-keys
             "\\<bbdb-mode-map>\\[bbdb-do-all-records]")))
  (bbdb-prefix-message))

;;;###autoload
(defun bbdb-do-records (&optional full)
  "Return list of records to operate on.
Normally this list includes only the current record.
It includes all currently displayed records if the command prefix \
\\<bbdb-mode-map>\\[bbdb-do-all-records] is used.
If FULL is non-nil, the list of records includes display information."
  (if bbdb-do-all-records
      (progn
        (setq bbdb-do-all-records nil)
        (aset bbdb-modeline-info 4 nil)
        (aset bbdb-modeline-info 5 nil)
        (if full bbdb-records (mapcar #'car bbdb-records)))
    (list (bbdb-current-record full))))

;;;###autoload
(defun bbdb-append-display-p ()
  "Return variable `bbdb-append-display' and reset."
  (let ((job (cond ((eq t bbdb-append-display))
                   ((numberp bbdb-append-display)
                    (setq bbdb-append-display (1- bbdb-append-display))
                    (if (zerop bbdb-append-display)
                        (setq bbdb-append-display nil))
                    t)
                   (bbdb-append-display
                    (setq bbdb-append-display nil)
                    t))))
    (cond ((numberp bbdb-append-display)
           (aset bbdb-modeline-info 0
                 (format "(add %dx)" bbdb-append-display)))
          ((not bbdb-append-display)
           (aset bbdb-modeline-info 0 nil)
           (aset bbdb-modeline-info 1 nil)))
    job))

;;;###autoload
(defun bbdb-append-display (&optional arg)
  "Toggle appending next searched records in the *BBDB* buffer.
With prefix ARG \\[universal-argument] always append.
With ARG a positive number append for that many times.
With ARG a negative number do not append."
  (interactive "P")
  (setq bbdb-append-display
        (cond ((and arg (listp arg)) t)
              ((and (numberp arg) (< 1 arg)) arg)
              ((or (and (numberp arg) (< arg 0)) bbdb-append-display) nil)
              (t 'once)))
  (aset bbdb-modeline-info 0
        (cond ((numberp bbdb-append-display)
               (format "(add %dx)" bbdb-append-display))
              ((eq t bbdb-append-display) "Add")
              (bbdb-append-display "add")
              (t nil)))
  (aset bbdb-modeline-info 1
        (if bbdb-append-display
            (substitute-command-keys
             "\\<bbdb-mode-map>\\[bbdb-append-display]")))
  (bbdb-prefix-message))

(defsubst bbdb-layout-prefix ()
  "Set the LAYOUT arg interactively using the prefix arg."
  (cond ((eq current-prefix-arg 0) 'one-line)
        (current-prefix-arg 'multi-line)
        (t bbdb-layout)))

(defun bbdb-search-invert-p ()
  "Return variable `bbdb-search-invert' and set it to nil.
To set it again, use command `bbdb-search-invert'."
  (let ((result bbdb-search-invert))
    (setq bbdb-search-invert nil)
    (aset bbdb-modeline-info 2 nil)
    (aset bbdb-modeline-info 3 nil)
    result))

;;;###autoload
(defun bbdb-search-invert (&optional arg)
  "Toggle inversion of the next search command.
With prefix ARG a positive number, invert next search.
With prefix ARG a negative number, do not invert next search."
  (interactive "P")
  (setq bbdb-search-invert
        (or (and (numberp arg) (< 0 arg))
            (and (not (numberp arg)) (not bbdb-search-invert))))
  (aset bbdb-modeline-info 2 (if bbdb-search-invert "inv"))
  (aset bbdb-modeline-info 3 (if bbdb-search-invert
                                 (substitute-command-keys
                                  "\\<bbdb-mode-map>\\[bbdb-search-invert]")))
  (bbdb-prefix-message))

(defmacro bbdb-search (records &rest spec)
  "Search RECORDS for fields matching SPEC.
The following keywords are supported in SPEC to search fields in RECORDS
matching the regexps RE:

:name RE          Match RE against first-last name.
:name-fl RE       Match RE against last-first name.
:all-names RE     Match RE against first-last, last-first, and aka.
:affix RE         Match RE against affixes.
:aka RE           Match RE against akas.
:organization RE  Match RE against organizations.
:mail RE          Match RE against mail addresses.
:xfield RE        Match RE against `bbdb-default-xfield'.
                  RE may also be a cons (LABEL . REGEXP).
                  Then REGEXP is matched against xfield LABEL.
                  If LABEL is '* then RE is matched against all xfields.
:creation-date RE Match RE against creation-date.
:timestamp RE     Match RE against timestamp.

Each of these keywords may appear multiple times.
Other keywords:

:bool FUN         Combine the search for multiple fields using FUN.
                  FUN must be a function that takes as many arguments
                  as there are search keywords in SPEC, for example
                  `or' (match either field, the default)
                  or `and' (match all fields).
:invert VAL       Invert the search if VAL is non-nil.
                  The default is the return value of `bbdb-search-invert-p'.
:case-fold VAL    Searches ignore case if VAL is non-nil.
                  The default is the value of `bbdb-case-fold-search'.

See also `bbdb-message-search' for fast searches using `bbdb-hashtable'
but not allowing for regexps.

For backward compatibility, SPEC may also consist of the optional args
  NAME ORGANIZATION MAIL XFIELD PHONE ADDRESS
which is equivalent to
  :all-names NAME :organization ORGANIZATION :mail MAIL
  :xfield XFIELD :phone PHONE :address ADDRESS
This usage is discouraged."
  (when (not (keywordp (car spec)))
    ;; Old format for backward compatibility
    (unless (get 'bbdb-search 'bbdb-outdated)
      (put 'bbdb-search 'bbdb-outdated t)
      (message "Outdated usage of `bbdb-search'")
      (sit-for 2))
    (let (newspec val)
      (dolist (key '(:all-names :organization :mail :xfield :phone :address))
        (if (setq val (pop spec))
            (push (list key val) newspec)))
      (setq spec (apply #'append newspec))))

  ;; The following defaults are motivated historically by the use
  ;; of `bbdb-search' in interactive commands.
  ;; Non-interactively these defaults may not always be useful.
  (let ((bool 'or) ; default
        (case-fold 'bbdb-case-fold-search) ; default
        (invert '(bbdb-search-invert-p)) ; default
        (sym-list (let ((count 0))
                    (mapcar (lambda (_)
                              (make-symbol
                               (format "bbdb-re-%d" (setq count (1+ count)))))
                            spec)))
        keyw re-list clauses)

    ;; Check keys.
    (while (keywordp (setq keyw (car spec)))
      (setq spec (cdr spec))
      (pcase keyw
	(`:name
         (let ((sym (pop sym-list)))
           (push `(,sym ,(pop spec)) re-list)
           (push `(string-match ,sym (bbdb-record-name record)) clauses)))

	(`:name-lf
         (let ((sym (pop sym-list)))
           (push `(,sym ,(pop spec)) re-list)
           (push `(string-match ,sym (bbdb-record-name-lf record)) clauses)))

	(`:all-names
         (let ((sym (pop sym-list)))
           (push `(,sym ,(pop spec)) re-list)
           (push `(or (string-match ,sym (bbdb-record-name record))
                      (string-match ,sym (bbdb-record-name-lf record))
                      (let ((akas (bbdb-record-field record 'aka-all))
                            aka done)
                        (while (and (setq aka (pop akas)) (not done))
                          (setq done (string-match ,sym aka)))
                        done))
                 clauses)))

	(`:affix
         (let ((sym (pop sym-list)))
           (push `(,sym ,(pop spec)) re-list)
           (push `(let ((affixs (bbdb-record-field record 'affix-all))
                        affix done)
                    (if affix
                        (while (and (setq affix (pop affixs)) (not done))
                          (setq done (string-match ,sym affix)))
                      ;; so that "^$" matches records without affix
                      (setq done (string-match ,sym "")))
                    done)
                 clauses)))

	(`:aka
         (let ((sym (pop sym-list)))
           (push `(,sym ,(pop spec)) re-list)
           (push `(let ((akas (bbdb-record-field record 'aka-all))
                        aka done)
                    (if aka
                        (while (and (setq aka (pop akas)) (not done))
                          (setq done (string-match ,sym aka)))
                      ;; so that "^$" matches records without aka
                      (setq done (string-match ,sym "")))
                    done)
                 clauses)))

	(`:organization
         (let ((sym (pop sym-list)))
           (push `(,sym ,(pop spec)) re-list)
           (push `(let ((organizations (bbdb-record-organization record))
                        org done)
                    (if organizations
                        (while (and (setq org (pop organizations)) (not done))
                          (setq done (string-match ,sym org)))
                      ;; so that "^$" matches records without organizations
                      (setq done (string-match ,sym "")))
                    done)
                 clauses)))

	(`:phone
         (let ((sym (pop sym-list)))
           (push `(,sym ,(pop spec)) re-list)
           (push `(let ((phones (bbdb-record-phone record))
                        ph done)
                    (if phones
                        (while (and (setq ph (pop phones)) (not done))
                          (setq done (string-match ,sym
                                                   (bbdb-phone-string ph))))
                      ;; so that "^$" matches records without phones
                      (setq done (string-match ,sym "")))
                    done)
                 clauses)))

	(`:address
         (let ((sym (pop sym-list)))
           (push `(,sym ,(pop spec)) re-list)
           (push `(let ((addresses (bbdb-record-address record))
                        a done)
                    (if addresses
                        (while (and (setq a (pop addresses)) (not done))
                          (setq done (string-match ,sym
                                                   (bbdb-format-address a 2))))
                      ;; so that "^$" matches records without addresses
                      (setq done (string-match ,sym "")))
                    done)
                 clauses)))

	(`:mail
         (let ((sym (pop sym-list)))
           (push `(,sym ,(pop spec)) re-list)
           (push `(let ((mails (bbdb-record-mail record))
                        (case-fold-search t) ; there is no case for mails
                        m done)
                    (if mails
                        (while (and (setq m (pop mails)) (not done))
                          (setq done (string-match ,sym m)))
                      ;; so that "^$" matches records without mail
                      (setq done (string-match ,sym "")))
                    done)
                 clauses)))

	(`:xfield
         (let ((sym (pop sym-list)))
           (push `(,sym ,(pop spec)) re-list)
           (push `(cond ((stringp ,sym)
                         ;; check xfield `bbdb-default-xfield'
                         ;; "^$" matches records without notes field
                         (string-match ,sym
                                       (or (bbdb-record-xfield-string
                                            record bbdb-default-xfield) "")))
                        ((eq (car ,sym) '*)
                         ;; check all xfields
                         (let ((labels bbdb-xfield-label-list) done tmp)
                           (while (and (not done) labels)
                             (setq tmp (bbdb-record-xfield-string record (car labels))
                                   done (and tmp (string-match (cdr ,sym)
                                                               tmp))
                                   labels (cdr labels)))
                           done))
                        (t ; check one field
                         (string-match (cdr ,sym)
                                       (or (bbdb-record-xfield-string
                                            record (car ,sym)) ""))))
                 clauses)))

	(`:creation-date
         (let ((sym (pop sym-list)))
           (push `(,sym ,(pop spec)) re-list)
           (push `(string-match ,sym (bbdb-record-creation-date record))
                 clauses)))

	(`:timestamp
         (let ((sym (pop sym-list)))
           (push `(,sym ,(pop spec)) re-list)
           (push `(string-match ,sym (bbdb-record-timestamp record))
                 clauses)))

        (`:bool
         (setq bool (pop spec)))

        (`:invert
         (setq invert (pop spec)))

        (`:case-fold
         (setq case-fold (pop spec)))

        ;; Do we need other keywords?

        (_ (error "Keyword `%s' undefined" keyw))))

    ;; The clauses have the same order as the keywords.
    (setq clauses (nreverse clauses))

    ;; Silly me!  For the keyword :bool, we used to use double-quoted
    ;; arguments like ":bool 'or".  Strip off one quote to preserve
    ;; backward compatibility.
    (if (eq 'quote (car-safe bool))
        (setq bool (cadr bool)))

    (let ((not-invert (make-symbol "not-invert"))
          (matches (make-symbol "matches")))
      `(let ((case-fold-search ,case-fold)
             (,not-invert (not ,invert))
             ,@re-list ,matches)
         (dolist (record ,records)
           (unless (eq ,not-invert (not (,bool ,@clauses)))
             (push record ,matches)))
         (nreverse ,matches)))))

(defun bbdb-search-read (&optional field)
  "Read regexp to search FIELD values of records.
When region is active make it the default string to match."
  (let ((default (if (and (region-active-p)
                          (< (region-beginning) (region-end)))
                     (regexp-quote
                      (buffer-substring-no-properties
                       (region-beginning) (region-end))))))
    (prog1 (read-string (format "Search records%s %smatching regexp: %s"
                                (if field (concat " with " field) "")
                                (if bbdb-search-invert "not " "")
                                (if default (format "(default %s) " default) ""))
                        nil nil default)
      (if default (deactivate-mark)))))

;;;###autoload
(defun bbdb (regexp &optional layout)
  "Display all records in the BBDB matching REGEXP
in either the name(s), organization, address, phone, mail, or xfields."
  (interactive (list (bbdb-search-read) (bbdb-layout-prefix)))
  (let ((records (bbdb-search (bbdb-records) :all-names regexp
                              :organization regexp :mail regexp
                              :xfield (cons '* regexp)
                              :phone regexp :address regexp :bool or)))
    (if records
        (bbdb-display-records records layout nil t)
      (message "No records matching '%s'" regexp))))

;;;###autoload
(defun bbdb-search-name (regexp &optional layout)
  "Display all records in the BBDB matching REGEXP in the name
\(or ``alternate'' names\)."
  (interactive (list (bbdb-search-read "names") (bbdb-layout-prefix)))
  (bbdb-display-records (bbdb-search (bbdb-records) :all-names regexp) layout))

;;;###autoload
(defun bbdb-search-organization (regexp &optional layout)
  "Display all records in the BBDB matching REGEXP in the organization field."
  (interactive (list (bbdb-search-read "organization") (bbdb-layout-prefix)))
  (bbdb-display-records (bbdb-search (bbdb-records) :organization regexp)
                        layout))

;;;###autoload
(defun bbdb-search-address (regexp &optional layout)
  "Display all records in the BBDB matching REGEXP in the address fields."
  (interactive (list (bbdb-search-read "address") (bbdb-layout-prefix)))
  (bbdb-display-records (bbdb-search (bbdb-records) :address regexp)
                        layout))

;;;###autoload
(defun bbdb-search-mail (regexp &optional layout)
  "Display all records in the BBDB matching REGEXP in the mail address."
  (interactive (list (bbdb-search-read "mail address") (bbdb-layout-prefix)))
  (bbdb-display-records (bbdb-search (bbdb-records) :mail regexp) layout))

;;;###autoload
(defun bbdb-search-phone (regexp &optional layout)
  "Display all records in the BBDB matching REGEXP in the phones field."
  (interactive (list (bbdb-search-read "phone") (bbdb-layout-prefix)))
  (bbdb-display-records
   (bbdb-search (bbdb-records) :phone regexp) layout))

;;;###autoload
(defun bbdb-search-xfields (field regexp &optional layout)
  "Display all BBDB records for which xfield FIELD matches REGEXP."
  (interactive
   (let ((field (completing-read "Xfield to search (RET for all): "
                                 (mapcar #'list bbdb-xfield-label-list) nil t)))
     (list (if (string= field "") '* (intern field))
           (bbdb-search-read (if (string= field "")
                                   "any xfield"
                                 field))
           (bbdb-layout-prefix))))
  (bbdb-display-records (bbdb-search (bbdb-records) :xfield (cons field regexp))
                        layout))
(define-obsolete-function-alias 'bbdb-search-notes #'bbdb-search-xfields "3.0")

;;;###autoload
(defun bbdb-search-changed (&optional layout)
  ;; FIXME: "changes" in BBDB lingo are often called "modifications"
  ;; in Emacs lingo
  "Display records which have been changed since BBDB was last saved."
  (interactive (list (bbdb-layout-prefix)))
  (if (bbdb-search-invert-p)
      (let (unchanged-records)
        (dolist (record (bbdb-records))
          (unless (memq record bbdb-changed-records)
            (push record unchanged-records)))
        (bbdb-display-records unchanged-records layout))
    (bbdb-display-records bbdb-changed-records layout)))

(defun bbdb-search-prog (fun &optional layout)
  "Search records using function FUN.
FUN is called with one argument, the record, and should return
the record to be displayed or nil otherwise."
  (bbdb-display-records (delq nil (mapcar fun (bbdb-records))) layout))


;; clean-up functions

;; Sometimes one gets mail from foo@bar.baz.com, and then later gets mail
;; from foo@baz.com.  At this point, one would like to delete the bar.baz.com
;; address, since the baz.com address is obviously superior.

(defun bbdb-mail-redundant-re (mail)
  "Return a regexp matching redundant variants of email address MAIL.
For example, \"foo@bar.baz.com\" is redundant w.r.t. \"foo@baz.com\".
Return nil if MAIL is not a valid plain email address.
In particular, ignore addresses \"Joe Smith <foo@baz.com>\"."
  (let* ((match (string-match "\\`\\([^ ]+\\)@\\(.+\\)\\'" mail))
         (name (and match (match-string 1 mail)))
         (host (and match (match-string 2 mail))))
    (if (and name host)
        (concat (regexp-quote name) "@.*\\." (regexp-quote host)))))

(defun bbdb-delete-redundant-mails (records &optional query update)
  "Delete redundant or duplicate mails from RECORDS.
For example, \"foo@bar.baz.com\" is redundant w.r.t. \"foo@baz.com\".
Duplicates may (but should not) occur if we feed BBDB automatically.
Interactively, use BBDB prefix \
\\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.
If QUERY is non-nil (as in interactive calls, unless we use a prefix arg)
query before deleting the redundant mail addresses.
If UPDATE is non-nil (as in interactive calls) update the database.
Otherwise, this is the caller's responsiblity.

Noninteractively, this may be used as an element of `bbdb-notice-record-hook'
or `bbdb-change-hook'.  However, see also `bbdb-ignore-redundant-mails',
which is probably more suited for your needs."
  (interactive (list (bbdb-do-records) (not current-prefix-arg) t))
  (bbdb-editable)
  (dolist (record (bbdb-record-list records))
    (let (mails redundant okay)
      ;; We do not look at the canonicalized mail addresses of RECORD.
      ;; An address "Joe Smith <foo@baz.com>" can only be entered manually
      ;; into BBDB, and we assume that this is what the user wants.
      ;; Anyway, if a mail field contains all the elements
      ;; foo@baz.com, "Joe Smith <foo@baz.com>", "Jonathan Smith <foo@baz.com>"
      ;; we do not know which address to keep and which ones to throw.
      (dolist (mail (bbdb-record-mail record))
        (if (assoc-string mail mails t) ; duplicate mail address
            (push mail redundant)
          (push mail mails)))
      (let ((mail-re (delq nil (mapcar #'bbdb-mail-redundant-re mails)))
            (case-fold-search t))
        (if (not (cdr mail-re)) ; at most one mail-re address to consider
            (setq okay (nreverse mails))
          (setq mail-re (concat "\\`\\(?:" (mapconcat #'identity mail-re "\\|")
                                "\\)\\'"))
          (dolist (mail mails)
            (if (string-match mail-re mail) ; redundant mail address
                (push mail redundant)
              (push mail okay)))))
      (let ((form (format "redundant mail%s %s"
                          (if (< 1 (length redundant)) "s" "")
                          (bbdb-concat 'mail (nreverse redundant)))))
        (when (and redundant
                   (or (not query)
                       (y-or-n-p (format "Delete %s: " form))))
          (unless query (message "Deleting %s" form))
          (bbdb-record-set-field record 'mail okay)
          (when update
            (bbdb-change-record record)))))))
(define-obsolete-function-alias 'bbdb-delete-duplicate-mails
  #'bbdb-delete-redundant-mails "3.0")

(defun bbdb-search-duplicates (&optional fields)
  "Search all records that have duplicate entries for FIELDS.
The list FIELDS may contain the symbols `name', `mail', and `aka'.
If FIELDS is nil use all these fields.  With prefix, query for FIELDS.
The search results are displayed in the BBDB buffer.
The command `bbdb-merge-records' may come handy for merging duplicate
records."
  (interactive (list (if current-prefix-arg
                         (list (intern (completing-read "Field: "
                                                        '("name" "mail" "aka")
                                                        nil t))))))
  (setq fields (or fields '(name mail aka)))
  (let (hash ret)
    (dolist (record (bbdb-records))

      (when (and (memq 'name fields)
                 (bbdb-record-name record)
                 (setq hash (bbdb-gethash (bbdb-record-name record)
                                          '(fl-name lf-name aka)))
                 (> (length hash) 1))
        (setq ret (append hash ret))
        (message "BBDB record `%s' has duplicate name."
                 (bbdb-record-name record))
        (sit-for 0))

      (if (memq 'mail fields)
          (dolist (mail (bbdb-record-mail-canon record))
              (setq hash (bbdb-gethash mail '(mail)))
              (when (> (length hash) 1)
                (setq ret (append hash ret))
                (message "BBDB record `%s' has duplicate mail `%s'."
                         (bbdb-record-name record) mail)
                (sit-for 0))))

      (if (memq 'aka fields)
          (dolist (aka (bbdb-record-aka record))
            (setq hash (bbdb-gethash aka '(fl-name lf-name aka)))
            (when (> (length hash) 1)
              (setq ret (append hash ret))
              (message "BBDB record `%s' has duplicate aka `%s'"
                       (bbdb-record-name record) aka)
              (sit-for 0)))))

    (bbdb-display-records (sort (delete-dups ret)
                                'bbdb-record-lessp))))

(defun bbdb-fix-records (records)
  "Fix broken RECORDS.
Interactively, use BBDB prefix \
\\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'."
  (interactive (list (bbdb-do-records)))
  (bbdb-editable)
  (dolist (record (bbdb-record-list records))
    ;; For the fields which take a list of strings (affix, organization,
    ;; aka, and mail) `bbdb=record-set-field' calls `bbdb-list-strings'
    ;; which removes all elements from such a list which are not non-empty
    ;; strings.  This should fix most problems with these fields.
    (bbdb-record-set-field record 'affix (bbdb-record-affix record))
    (bbdb-record-set-field record 'organization (bbdb-record-organization record))
    (bbdb-record-set-field record 'aka (bbdb-record-aka record))
    (bbdb-record-set-field record 'mail (bbdb-record-mail record))
    (bbdb-change-record record))
  (bbdb-sort-records))

(defun bbdb-touch-records (records)
  "Touch RECORDS by calling `bbdb-change-hook' unconditionally.
Interactively, use BBDB prefix \
\\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'."
  (interactive (list (bbdb-do-records)))
  (bbdb-editable)
  (let ((bbdb-update-unchanged-records t))
    (dolist (record (bbdb-record-list records))
      (bbdb-change-record record))))

;;; Time-based functions

(defmacro bbdb-compare-records (cmpval label compare)
  "Builds a lambda comparison function that takes one argument, RECORD.
RECORD is returned if (COMPARE VALUE CMPVAL) is t, where VALUE
is the value of field LABEL of RECORD."
  `(lambda (record)
     (let ((val (bbdb-record-field record ,label)))
       (if (and val (,compare val ,cmpval))
           record))))

(defsubst bbdb-string> (a b)
  (not (or (string= a b)
           (string< a b))))

;;;###autoload
(defun bbdb-timestamp-older (date &optional layout)
  "Display records with timestamp older than DATE.
DATE must be in yyyy-mm-dd format."
  (interactive (list (read-string "Timestamp older than: (yyyy-mm-dd) ")
                     (bbdb-layout-prefix)))
  (bbdb-search-prog (bbdb-compare-records date 'timestamp string<) layout))

;;;###autoload
(defun bbdb-timestamp-newer (date &optional layout)
  "Display records with timestamp newer than DATE.
DATE must be in yyyy-mm-dd format."
  (interactive (list (read-string "Timestamp newer than: (yyyy-mm-dd) ")
                     (bbdb-layout-prefix)))
  (bbdb-search-prog (bbdb-compare-records date 'timestamp bbdb-string>) layout))

;;;###autoload
(defun bbdb-creation-older (date &optional layout)
  "Display records with creation-date older than DATE.
DATE must be in yyyy-mm-dd format."
  (interactive (list (read-string "Creation older than: (yyyy-mm-dd) ")
                     (bbdb-layout-prefix)))
  (bbdb-search-prog (bbdb-compare-records date 'creation-date string<) layout))

;;;###autoload
(defun bbdb-creation-newer (date &optional layout)
  "Display records with creation-date newer than DATE.
DATE must be in yyyy-mm-dd format."
  (interactive (list (read-string "Creation newer than: (yyyy-mm-dd) ")
                     (bbdb-layout-prefix)))
  (bbdb-search-prog (bbdb-compare-records date 'creation-date bbdb-string>) layout))

;;;###autoload
(defun bbdb-creation-no-change (&optional layout)
  "Display records that have the same timestamp and creation-date."
  (interactive (list (bbdb-layout-prefix)))
  (bbdb-search-prog
   ;; RECORD is bound in `bbdb-compare-records'.
   (bbdb-compare-records (bbdb-record-timestamp record)
                         'creation-date string=)
   layout))

;;; Parsing phone numbers
;; XXX this needs expansion to handle international prefixes properly
;; i.e. +353-number without discarding the +353 part. Problem being
;; that this will necessitate yet another change in the database
;; format for people who are using north american numbers.

(defsubst bbdb-subint (string num)
  "Used for parsing phone numbers."
  (string-to-number (match-string num string)))

(defun bbdb-parse-phone (string &optional style)
  "Parse a phone number from STRING and return a list of integers the form
\(area-code exchange number extension).
This is both lenient and strict in what it will parse - whitespace may
appear (or not) between any of the groups of digits, parentheses around the
area code are optional, as is a dash between the exchange and number, and
a '1' preceeding the area code; but there must be three digits in the area
code and exchange, and four in the number (if they are present).
All of these are unambigously parsable:

  ( 415 ) 555 - 1212 x123   -> (415 555 1212 123)
  (415)555-1212 123         -> (415 555 1212 123)
  (1-415) 555-1212 123      -> (415 555 1212 123)
  1 (415)-555-1212 123      -> (415 555 1212 123)
  555-1212 123              -> (0 555 1212 123)
  555 1212                  -> (0 555 1212 0)
  415 555 1212              -> (415 555 1212 0)
  1 415 555 1212            -> (415 555 1212 0)
  5551212                   -> (0 555 1212 0)
  4155551212                -> (415 555 1212 0)
  4155551212123             -> (415 555 1212 123)
  5551212x123               -> (0 555 1212 123)
  1234                      -> (0 0 0 1234)

Note that \"4151212123\" is ambiguous; it could be interpreted either as
\"(415) 121-2123\" or as \"415-1212 x123\".

Return a list containing four numbers or one string."

  ;; RW: Missing parts of NANP numbers are replaced by zeros.
  ;; Is this always correct?  What about an extension zero?
  ;; Should we use nil instead of zeros?
  (unless style (setq style bbdb-phone-style))
  (let ((area-regexp (concat "(?[ \t]*\\+?1?[ \t]*[-\(]?[ \t]*[-\(]?[ \t]*"
                             "\\([2-9][0-9][0-9]\\)[ \t]*)?[-./ \t]*"))
        (main-regexp (concat "\\([1-9][0-9][0-9]\\)[ \t]*[-.]?[ \t]*"
                             "\\([0-9][0-9][0-9][0-9]\\)[ \t]*"))
        (ext-regexp "x?[ \t]*\\([0-9]+\\)[ \t]*"))
    (cond ((not (eq style 'nanp))
           (list (bbdb-string-trim string)))
          ((string-match ;; (415) 555-1212 x123
            (concat "^[ \t]*" area-regexp main-regexp ext-regexp "$") string)
           (list (bbdb-subint string 1) (bbdb-subint string 2)
                 (bbdb-subint string 3) (bbdb-subint string 4)))
          ;; (415) 555-1212
          ((string-match (concat "^[ \t]*" area-regexp main-regexp "$") string)
           (list (bbdb-subint string 1) (bbdb-subint string 2)
                 (bbdb-subint string 3) 0))
          ;; 555-1212 x123
          ((string-match (concat "^[ \t]*" main-regexp ext-regexp "$") string)
           (list 0 (bbdb-subint string 1) (bbdb-subint string 2)
                 (bbdb-subint string 3)))
          ;; 555-1212
          ((string-match (concat "^[ \t]*" main-regexp "$") string)
           (list 0 (bbdb-subint string 1) (bbdb-subint string 2) 0))
          ;; x123
          ((string-match (concat "^[ \t]*" ext-regexp "$") string)
           (list 0 0 0 (bbdb-subint string 1)))
          ;; We trust the user she knows what she wants
          (t (list (bbdb-string-trim string))))))

(defun bbdb-message-search (name mail)
  "Return list of BBDB records matching NAME and/or MAIL.
First try to find a record matching both NAME and MAIL.
If this fails try to find a record matching MAIL.
If this fails try to find a record matching NAME.
NAME may match FIRST_LAST, LAST_FIRST or AKA.

This function performs a fast search using `bbdb-hashtable'.
NAME and MAIL must be strings or nil.
See `bbdb-search' for searching records with regexps."
  (when (or name mail)
    (bbdb-buffer)  ; make sure database is loaded and up-to-date
    (let ((mrecords (if mail (bbdb-gethash mail '(mail))))
          (nrecords (if name (bbdb-gethash name '(fl-name lf-name aka)))))
      ;; (1) records matching NAME and MAIL
      (or (and mrecords nrecords
               (let (records)
                 (dolist (record nrecords)
                   (mapc (lambda (mr) (if (and (eq record mr)
                                               (not (memq record records)))
                                          (push record records)))
                         mrecords))
                 records))
          ;; (2) records matching MAIL
          mrecords
          ;; (3) records matching NAME
          nrecords))))

(defun bbdb-read-record (&optional first-and-last)
  "Read and return a new BBDB record.
Does not insert it into the database or update the hashtables,
but does ensure that there will not be name collisions."
  (bbdb-editable)
  (let ((record (bbdb-empty-record)))
    (let (name)
      (bbdb-error-retry
       (setq name (bbdb-read-name first-and-last))
       (bbdb-check-name name))
      (bbdb-record-set-firstname record (car name))
      (bbdb-record-set-lastname record (cdr name)))

    ;; organization
    (bbdb-record-set-organization record (bbdb-read-organization))

    ;; mail
    (let (mail)
      (bbdb-error-retry
       (setq mail (bbdb-split 'mail (bbdb-read-string "E-Mail Addresses: ")))
       (bbdb-check-mail mail))
      (bbdb-record-set-mail record mail))

    ;; address
    (let (addresses label)
      (while (not (string= ""
                           (setq label
                                 (bbdb-read-string
                                  "Snail Mail Address Label [RET when done]: "
                                  nil bbdb-address-label-list))))
        ;; Here we could also already update the completion lists.  Bother?
        (push (bbdb-record-edit-address nil label) addresses))
      (bbdb-record-set-address record (nreverse addresses)))

    ;; phones
    (let (phones label)
      (while (not (string= ""
                           (setq label
                                 (bbdb-read-string
                                  "Phone Label [RET when done]: "
                                  nil bbdb-phone-label-list))))
        (push (bbdb-record-edit-phone nil label) phones))
      (bbdb-record-set-phone record (nreverse phones)))

    ;; `bbdb-default-xfield'
    (let ((xfield (bbdb-read-xfield bbdb-default-xfield)))
      (unless (string= "" xfield)
        (bbdb-record-set-xfields
         record (list (cons bbdb-default-xfield xfield)))))

    record))

(defun bbdb-read-name (&optional first-and-last dfirst dlast)
  "Read name for a record from minibuffer.
FIRST-AND-LAST controls the reading mode:
If it is 'first-last read first and last name separately.
If it is 'last-first read last and first name separately.
If it is 'fullname read full name at once.
If it is t read name parts separately, obeying `bbdb-read-name-format' if possible.
Otherwise use `bbdb-read-name-format'.
DFIRST and DLAST are default values for the first and last name.
Return cons with first and last name."
  (unless (memq first-and-last '(first-last last-first fullname))
    ;; We do not yet know how to read the name
    (setq first-and-last
          (if (and first-and-last
                   (not (memq bbdb-read-name-format '(first-last last-first))))
              'first-last
            bbdb-read-name-format)))
  (let ((name (cond ((eq first-and-last 'last-first)
                     (let (fn ln)
                       (setq ln (bbdb-read-string "Last Name: " dlast)
                             fn (bbdb-read-string "First Name: " dfirst))
                       (cons fn ln)))
                    ((eq first-and-last 'first-last)
                     (cons (bbdb-read-string "First Name: " dfirst)
                           (bbdb-read-string "Last Name: " dlast)))
                    (t
                     (bbdb-divide-name (bbdb-read-string
                                        "Name: " (bbdb-concat 'name-first-last
                                                              dfirst dlast)))))))
    (if (string= (car name) "") (setcar name nil))
    (if (string= (cdr name) "") (setcdr name nil))
    name))

;;;###autoload
(defun bbdb-create (record)
  "Add a new RECORD to BBDB.
When called interactively read all relevant info.
Do not call this from a program; call `bbdb-create-internal' instead."
  (interactive (list (bbdb-read-record current-prefix-arg)))
  (bbdb-change-record record)
  (bbdb-display-records (list record)))

(defsubst bbdb-split-maybe (separator string)
  "Split STRING into list of substrings bounded by matches for SEPARATORS.
If STRING is a list, return STRING.  Throw error if STRING is neither a string
nor a list."
  (cond ((stringp string)
         (bbdb-split separator string))
        ((listp string) string)
        (t (error "Cannot convert %s to list" string))))

;;;###autoload
(defun bbdb-create-internal (&rest spec)
  "Add a new record to the database and return it.

The following keywords are supported in SPEC:
:name VAL          String or a cons cell (FIRST . LAST), the name of the person.
                   An error is thrown if VAL is already in use
                   and `bbdb-allow-duplicates' is nil.
:affix VAL         List of strings.
:aka VAL           List of strings.
                   An error is thrown if an aka in VAL is already in use
                   and `bbdb-allow-duplicates' is nil.
:organization VAL  List of strings.
:mail VAL          String with comma-separated mail address
                   or a list of strings.
                   An error is thrown if a mail address in VAL is already
                   in use and `bbdb-allow-duplicates' is nil.
:phone VAL         List of phone-number objects.  A phone-number is a vector
                   [\"label\" area-code prefix suffix extension-or-nil]
                   or [\"label\" \"phone-number\"]
:address VAL       List of addresses.  An address is a vector of the form
                   \[\"label\" (\"line1\" \"line2\" ... ) \"City\"
                   \"State\" \"Postcode\" \"Country\"].
:xfields VAL       Alist associating symbols with strings.
:uuid VAL          String, the uuid.
:creation-date VAL String, the creation date.
:check             If present, throw an error if a field value is not
                   syntactically correct."
  (bbdb-editable)

  (when (not (keywordp (car spec)))
    ;; Old format for backward compatibility (BBDB version < 3.2)
    (unless (get 'bbdb-create-internal 'bbdb-outdated)
      (put 'bbdb-create-internal 'bbdb-outdated t)
      (message "Outdated usage of `bbdb-create-internal'")
      (sit-for 2))
    (let (newspec val)
      (dolist (key '(:name :affix :aka :organization :mail :phone :address
                           :xfields))
        (if (setq val (pop spec))
            (push (list key val) newspec)))
      (if (setq val (pop spec))
          (push (list :check) newspec))
      (setq spec (apply #'append newspec))))

  (let ((record (bbdb-empty-record))
        (record-type (cdr bbdb-record-type))
        (check (prog1 (memq :check spec)
                 (setq spec (delq :check spec))))
        keyw)

    ;; Check keys.
    (while (keywordp (setq keyw (car spec)))
      (setq spec (cdr spec))
      (pcase keyw
	(`:name
         (let ((name (pop spec)))
           (cond ((stringp name)
                  (setq name (bbdb-divide-name name)))
                 (check (bbdb-check-type name '(or (const nil)
                                                   (cons string string))
                                         t)))
           (bbdb-check-name name) ; check for duplicates
           (bbdb-record-set-firstname record (car name))
           (bbdb-record-set-lastname record (cdr name))))

        (`:affix
         (let ((affix (bbdb-split-maybe 'affix (pop spec))))
           (if check (bbdb-check-type affix (bbdb-record-affix record-type) t))
           (bbdb-record-set-affix record affix)))

        (`:organization
         (let ((organization (bbdb-split-maybe 'organization (pop spec))))
           (if check (bbdb-check-type
                      organization (bbdb-record-organization record-type) t))
           (bbdb-record-set-organization record organization)))

        (`:aka
         (let ((aka (bbdb-split-maybe 'aka (pop spec))))
           (if check (bbdb-check-type aka (bbdb-record-aka record-type) t))
           (bbdb-check-name aka)
           (bbdb-record-set-aka record aka)))

        (`:mail
         (let ((mail (bbdb-split-maybe 'mail (pop spec))))
           (if check (bbdb-check-type mail (bbdb-record-mail record-type) t))
           (bbdb-check-mail mail)
           (bbdb-record-set-mail record mail)))

        (`:phone
         (let ((phone (pop spec)))
           (if check (bbdb-check-type phone (bbdb-record-phone record-type) t))
           (bbdb-record-set-phone record phone)))

        (`:address
         (let ((address (pop spec)))
           (if check (bbdb-check-type address (bbdb-record-address record-type) t))
           (bbdb-record-set-address record address)))

        (`:xfields
         (let ((xfields (pop spec)))
           (if check (bbdb-check-type xfields (bbdb-record-xfields record-type) t))
           (bbdb-record-set-xfields record xfields)))

        (`:uuid
         (let ((uuid (pop spec)))
           (if check (bbdb-check-type uuid (bbdb-record-uuid record-type) t))
           (bbdb-record-set-uuid record uuid)))

        (`:creation-date
         (let ((creation-date (pop spec)))
           (if check (bbdb-check-type
                      creation-date (bbdb-record-creation-date record-type) t))
           (bbdb-record-set-creation-date record creation-date)))

        (_ (error "Keyword `%s' undefined" keyw))))

    (bbdb-change-record record)))

;;;###autoload
(defun bbdb-insert-field (record field value)
  "For RECORD, add a new FIELD with value VALUE.
Interactively, read FIELD and VALUE; RECORD is the current record.
A non-nil prefix arg is passed on to `bbdb-read-field' as FLAG (see there)."
  (interactive
   (let* ((_ (bbdb-editable))
          (record (or (bbdb-current-record)
                      (error "Point not on a record")))
          (list (append bbdb-xfield-label-list
                        '(affix organization aka phone address mail)))
          (field "")
          (completion-ignore-case t)
          (present (mapcar #'car (bbdb-record-xfields record))))
     (if (bbdb-record-affix record) (push 'affix present))
     (if (bbdb-record-organization record) (push 'organization present))
     (if (bbdb-record-mail record) (push 'mail present))
     (if (bbdb-record-aka record) (push 'aka present))
     (dolist (field present)
       (setq list (remq field list)))
     (setq list (mapcar #'symbol-name list))
     (while (string= field "")
       (setq field (downcase (completing-read "Insert Field: " list))))
     (setq field (intern field))
     (if (memq field present)
         (error "Field \"%s\" already exists" field))
     (list record field (bbdb-read-field record field current-prefix-arg))))

  (cond (;; affix
         (eq field 'affix)
         (if (bbdb-record-affix record)
             (error "Affix field exists already"))
         (if (stringp value)
             (setq value (bbdb-split 'affix value)))
         (bbdb-record-set-field record 'affix value))
        ;; organization
        ((eq field 'organization)
         (if (bbdb-record-organization record)
             (error "Organization field exists already"))
         (if (stringp value)
             (setq value (bbdb-split 'organization value)))
         (bbdb-record-set-field record 'organization value))
        ;; phone
        ((eq field 'phone)
         (bbdb-record-set-field record 'phone
                                (nconc (bbdb-record-phone record)
                                       (list value))))
        ;; address
        ((eq field 'address)
         (bbdb-record-set-field record 'address
                                (nconc (bbdb-record-address record)
                                       (list value))))
        ;; mail
        ((eq field 'mail)
         (if (bbdb-record-mail record)
             (error "Mail field exists already"))
         (if (stringp value)
             (setq value (bbdb-split 'mail value)))
         (bbdb-record-set-field record 'mail value))
        ;; AKA
        ((eq field 'aka)
         (if (bbdb-record-aka record)
             (error "Alternate names field exists already"))
         (if (stringp value)
             (setq value (bbdb-split 'aka value)))
         (bbdb-record-set-field record 'aka value))
        ;; xfields
        ((assq field (bbdb-record-xfields record))
         (error "Xfield \"%s\" already exists" field))
        (t
         (bbdb-record-set-xfield record field value)))
  (unless (bbdb-change-record record)
    (message "Record unchanged")))

(defun bbdb-read-field (record field &optional flag)
  "For RECORD read new FIELD interactively.
- The phone number style is controlled via `bbdb-phone-style'.
  A prefix FLAG inverts the style,
- If a mail address lacks a domain, append `bbdb-default-domain'
  if this variable non-nil.  With prefix FLAG do not alter the mail address.
- The value of an xfield is a string.  With prefix FLAG the value may be
  any lisp object."
  (let* ((init-f (intern-soft (concat "bbdb-init-" (symbol-name field))))
         (init (if (and init-f (functionp init-f))
                   (funcall init-f record))))
    (cond (;; affix
           (eq field 'affix) (bbdb-read-string "Affix: " init))
          ;; organization
          ((eq field 'organization) (bbdb-read-organization init))
          ;; mail
          ((eq field 'mail)
           (let ((mail (bbdb-read-string "Mail: " init)))
             (if (string-match "^mailto:" mail)
                 (setq mail (substring mail (match-end 0))))
             (if (or (not bbdb-default-domain)
                     flag (string-match "[@%!]" mail))
                 mail
               (concat mail "@" bbdb-default-domain))))
          ;; AKA
          ((eq field 'aka) (bbdb-read-string "Alternate Names: " init))
          ;; Phone
          ((eq field 'phone)
           (let ((bbdb-phone-style
                  (if flag (if (eq bbdb-phone-style 'nanp) nil 'nanp)
                    bbdb-phone-style)))
             (bbdb-record-edit-phone)))
          ;; Address
          ((eq field 'address)
           (bbdb-record-edit-address))
          ;; xfield
          ((or (memq field bbdb-xfield-label-list)
               ;; New xfield
               (y-or-n-p
                (format "\"%s\" is an unknown field name.  Define it? " field))
               (error "Aborted"))
           (bbdb-read-xfield field init flag)))))

;;;###autoload
(defun bbdb-edit-field (record field &optional value flag)
  "Edit the contents of FIELD of RECORD.
If point is in the middle of a multi-line field (e.g., address),
then the entire field is edited, not just the current line.
For editing phone numbers or addresses, VALUE must be the phone number
or address that gets edited. An error is thrown when attempting to edit
a phone number or address with VALUE being nil.

- The value of an xfield is a string.  With prefix FLAG the value may be
  any lisp object."
  (interactive
   (save-excursion
     (bbdb-editable)
     ;; when at the end of the line take care of it
     (if (and (eolp) (not (bobp)) (not (bbdb-current-field)))
         (backward-char 1))
     (let* ((field-l (bbdb-current-field))
            (field (car field-l))
            (value (nth 1 field-l)))
       (unless field (error "Point not in a field"))
       (list (bbdb-current-record)
             (if (memq field '(name affix organization aka mail phone address
                                    uuid creation-date timestamp))
                 field ; not an xfield
               (elt value 0)) ; xfield
             value current-prefix-arg))))
  (let (edit-str)
    (cond ((memq field '(firstname lastname xfields))
           ;; FIXME: We could also edit first and last names.
           (error "Field `%s' not editable this way." field))
          ((eq field 'name)
           (bbdb-error-retry
            (bbdb-record-set-field
             record 'name
             (bbdb-read-name
              (if flag
                  ;; Here we try to obey the name-format xfield for
                  ;; editing the name field.  Is this useful?  Or is this
                  ;; irritating overkill and we better obey consistently
                  ;; `bbdb-read-name-format'?
                  (or (bbdb-record-xfield-intern record 'name-format)
                      flag))
              (bbdb-record-firstname record)
              (bbdb-record-lastname record)))))

          ((eq field 'phone)
           (unless value (error "No phone specified"))
           (bbdb-record-set-field
            record field
            ;; Splice new phone value into list of phones.
            (let ((phones (bbdb-record-phone record)))
              (setcar (memq value phones)
                      (bbdb-record-edit-phone value))
              phones)))
          ((eq field 'address)
           (unless value (error "No address specified"))
           (bbdb-record-edit-address value nil flag)
           (bbdb-record-set-field record field (bbdb-record-address record)))
          ((eq field 'organization)
           (bbdb-record-set-field
            record field
            (bbdb-read-organization
             (bbdb-concat field (bbdb-record-organization record)))))
          ((setq edit-str (assq field '((affix . "Affix")
                                        (mail . "Mail") (aka . "AKA"))))
           (bbdb-record-set-field
            record field
            (bbdb-split field (bbdb-read-string
                               (format "%s: " (cdr edit-str))
                               (bbdb-concat field
                                            (bbdb-record-field record field))))))
          ((eq field 'uuid)
           (bbdb-record-set-field
            record 'uuid (bbdb-read-string "uuid (edit at your own risk): " (bbdb-record-uuid record))))
          ((eq field 'creation-date)
           (bbdb-record-set-field
            record 'creation-date
            (bbdb-read-string "creation-date: " (bbdb-record-creation-date record))))
          ;; The timestamp is set automatically whenever we save a modified record.
          ;; So any editing gets overwritten.
          ((eq field 'timestamp)) ; do nothing
          (t ; xfield
           (bbdb-record-set-xfield
            record field
            (bbdb-read-xfield field (bbdb-record-xfield record field) flag))))
    (cond ((eq field 'timestamp)
           (message "timestamp not editable"))
          ((bbdb-change-record record))
          (t (message "Record unchanged")))))

(defun bbdb-edit-foo (record field &optional nvalue)
  "For RECORD edit some FIELD (mostly interactively).
FIELD may take the same values as the elements of the variable `bbdb-edit-foo'.
If FIELD is 'phone or 'address, NVALUE should be an integer in order to edit
the NVALUEth phone or address field; otherwise insert a new phone or address
field.

Interactively, if called without a prefix, the value of FIELD is the car
of the variable `bbdb-edit-foo'.  When called with a prefix, the value
of FIELD is the cdr of this variable.  Then use minibuffer completion
to select the field."
  (interactive
   (let* ((_ (bbdb-editable))
          (record (bbdb-current-record))
          (tmp (if current-prefix-arg (cdr bbdb-edit-foo) (car bbdb-edit-foo)))
          (field (if (memq tmp '(current-fields all-fields))
                     ;; Do not require match so that we can define new xfields.
                     (intern (completing-read
                              "Edit field: "
                              (mapcar #'list (if (eq tmp 'all-fields)
                                                 (append '(name affix organization aka mail phone address uuid creation-date)
                                                         bbdb-xfield-label-list)
                                               (append (if (bbdb-record-affix record) '(affix))
                                                       (if (bbdb-record-organization record) '(organization))
                                                       (if (bbdb-record-aka record) '(aka))
                                                       (if (bbdb-record-mail record) '(mail))
                                                       (if (bbdb-record-phone record) '(phone))
                                                       (if (bbdb-record-address record) '(address))
                                                       (mapcar #'car (bbdb-record-xfields record))
                                                       '(name uuid creation-date))))))
                   tmp))
          ;; Multiple phone and address fields may use the same label.
          ;; So we cannot use these labels to uniquely identify
          ;; a phone or address field.  So instead we number these fields
          ;; consecutively.  But we do use the labels to annotate the numbers
          ;; (available starting from GNU Emacs 24.1).
          (nvalue (cond ((eq field 'phone)
                         (let* ((phones (bbdb-record-phone record))
                                (collection (cons (cons "new" "new phone #")
                                                  (mapcar (lambda (n)
                                                            (cons (format "%d" n) (bbdb-phone-label (nth n phones))))
                                                          (number-sequence 0 (1- (length phones))))))
                                (completion-extra-properties
                                 `(:annotation-function
                                   (lambda (s) (format "  (%s)" (cdr (assoc s ',collection)))))))
                           (if (< 0 (length phones))
                               (completing-read "Phone field: " collection nil t)
                             "new")))
                        ((eq field 'address)
                         (let* ((addresses (bbdb-record-address record))
                                (collection (cons (cons "new" "new address")
                                                  (mapcar (lambda (n)
                                                            (cons (format "%d" n) (bbdb-address-label (nth n addresses))))
                                                          (number-sequence 0 (1- (length addresses))))))
                                (completion-extra-properties
                                 `(:annotation-function
                                   (lambda (s) (format "  (%s)" (cdr (assoc s ',collection)))))))
                           (if (< 0 (length addresses))
                               (completing-read "Address field: " collection nil t)
                             "new"))))))
     (list record field (and (stringp nvalue)
                             (if (string= "new" nvalue)
                                 'new
                               (string-to-number nvalue))))))

  (if (memq field '(firstname lastname name-lf aka-all mail-aka mail-canon))
      (error "Field `%s' illegal" field))
  (let ((value (if (numberp nvalue)
                   (nth nvalue (cond ((eq field 'phone) (bbdb-record-phone record))
                                     ((eq field 'address) (bbdb-record-address record))
                                     (t (error "%s: nvalue %s meaningless" field nvalue)))))))
    (if (and (numberp nvalue) (not value))
        (error "%s: nvalue %s out of range" field nvalue))
    (if (or (memq field '(name uuid creation-date))
            (and (eq field 'affix) (bbdb-record-affix record))
            (and (eq field 'organization) (bbdb-record-organization record))
            (and (eq field 'mail) (bbdb-record-mail record))
            (and (eq field 'aka) (bbdb-record-aka record))
            (assq field (bbdb-record-xfields record))
            value)
        (bbdb-edit-field record field value)
      (bbdb-insert-field record field
                         (bbdb-read-field record field)))))

(defun bbdb-read-xfield (field &optional init sexp)
  "Read xfield FIELD with optional INIT.
This calls bbdb-read-xfield-FIELD if it exists."
  (let ((read-fun (intern-soft (format "bbdb-read-xfield-%s" field))))
    (cond ((fboundp read-fun)
           (funcall read-fun init))
          ((and (not sexp) (string-or-null-p init))
           (bbdb-read-string (format "%s: " field) init))
          (t (read-minibuffer (format "%s (sexp): " field)
                              (prin1-to-string init))))))

(defun bbdb-read-organization (&optional init)
  "Read organization."
  (if (string< "24.3" (substring emacs-version 0 4))
      (let ((crm-separator
             (concat "[ \t\n]*"
                     (cadr (assq 'organization bbdb-separator-alist))
                     "[ \t\n]*"))
            (crm-local-completion-map bbdb-crm-local-completion-map))
        (completing-read-multiple "Organizations: " bbdb-organization-list
                                  nil nil init))
    (bbdb-split 'organization (bbdb-read-string "Organizations: " init))))

;; The name `bbdb-read-address' might fit better.
(defun bbdb-record-edit-address (&optional address label ignore-country)
  "Edit and return ADDRESS.
If LABEL is nil, edit the label sub-field of the address as well.
If the country field of ADDRESS is nonempty and IGNORE-COUNTRY is nil,
use the rule from `bbdb-address-format-list' matching this country.
Otherwise, use the default rule according to `bbdb-address-format-list'."
  (unless address
    (setq address (make-vector bbdb-address-length nil)))
  (unless label
    (setq label (bbdb-read-string "Label: "
                                  (bbdb-address-label address)
                                  bbdb-address-label-list)))
  (let ((country (or (bbdb-address-country address) ""))
        new-addr edit)
    (unless (or ignore-country (string= "" country))
      (let ((list bbdb-address-format-list)
            identifier elt)
        (while (and (not edit) (setq elt (pop list)))
          (setq identifier (car elt))
          (if (or (and (listp identifier)
                       (member-ignore-case country identifier))
                  (and (functionp identifier)
                       (funcall identifier address)))
              (setq edit (nth 1 elt))))))
    (unless edit
      (setq edit (nth 1 (assq t bbdb-address-format-list))))
    (unless edit (error "No address editing function defined"))
    (if (functionp edit)
        (setq new-addr (funcall edit address))
      (setq new-addr (make-vector 5 ""))
      (dolist (elt (string-to-list edit))
        (cond ((eq elt ?s)
               (aset new-addr 0 (bbdb-edit-address-street
                                 (bbdb-address-streets address))))
              ((eq elt ?c)
               (aset new-addr 1 (bbdb-read-string
                                 "City: " (bbdb-address-city address)
                                 bbdb-city-list)))
              ((eq elt ?S)
               (aset new-addr 2 (bbdb-read-string
                                 "State: " (bbdb-address-state address)
                                 bbdb-state-list)))
              ((eq elt ?p)
               (aset new-addr 3
                     (bbdb-error-retry
                      (bbdb-parse-postcode
                       (bbdb-read-string
                        "Postcode: " (bbdb-address-postcode address)
                        bbdb-postcode-list)))))
              ((eq elt ?C)
               (aset new-addr 4
                     (bbdb-read-string
                      "Country: " (or (bbdb-address-country address)
                                      bbdb-default-country)
                      bbdb-country-list))))))
    (bbdb-address-set-label address label)
    (bbdb-address-set-streets address (elt new-addr 0))
    (bbdb-address-set-city address (elt new-addr 1))
    (bbdb-address-set-state address (elt new-addr 2))
    (bbdb-address-set-postcode address (elt new-addr 3))
    (if (string= "" (bbdb-concat "" (elt new-addr 0) (elt new-addr 1)
                                 (elt new-addr 2) (elt new-addr 3)
                                 (elt new-addr 4)))
        ;; User did not enter anything. this causes a display bug.
        ;; The following is a temporary fix.  Ideally, we would simply discard
        ;; the entire address, but that requires bigger hacking.
        (bbdb-address-set-country address "Emacs")
      (bbdb-address-set-country address (elt new-addr 4)))
    address))

(defun bbdb-edit-address-street (streets)
  "Edit list STREETS."
  (let ((n 0) street list)
    (while (not (string= "" (setq street
                                  (bbdb-read-string
                                   (format "Street, line %d: " (1+ n))
                                   (nth n streets) bbdb-street-list))))
      (push street list)
      (setq n (1+ n)))
    (reverse list)))

;; This function can provide some guidance for writing your own
;; address editing function for `bbdb-address-format-list'.
;; Such a function should return a list or vector with five elements,
;; a list of streets, city, state, postcode, country.
;; These elements should be strings or nil.
(defun bbdb-edit-address-default (address)
  "Function for editing ADDRESS to be used by `bbdb-address-format-list'.
The sub-fields and the prompts used are:
Street, line n:  (nth n street)
City:            city
State:           state
Postcode:        postcode
Country:         country"
  (list (bbdb-edit-address-street (bbdb-address-streets address))
        (bbdb-read-string "City: " (bbdb-address-city address) bbdb-city-list)
        (bbdb-read-string "State: " (bbdb-address-state address)
                          bbdb-state-list)
        (bbdb-error-retry
         (bbdb-parse-postcode
          (bbdb-read-string "Postcode: " (bbdb-address-postcode address)
                            bbdb-postcode-list)))
        (bbdb-read-string "Country: " (or (bbdb-address-country address)
                                          bbdb-default-country)
                          bbdb-country-list)))

;; The name `bbdb-read-phone' might fit better.
(defun bbdb-record-edit-phone (&optional phone label)
  "Edit and return PHONE.
If LABEL is nil, edit the label sub-field of PHONE as well."
  ;; Phone numbers are special.  They are vectors with either
  ;; two or four elements.  We do not know whether after editing PHONE
  ;; we still have a number requiring the same format as PHONE.
  ;; So we throw away the argument PHONE and return a new vector.
  (apply #'vector
         (or label
             (bbdb-read-string "Label: "
                               (and phone (bbdb-phone-label phone))
                               bbdb-phone-label-list))
         (bbdb-error-retry
          (bbdb-parse-phone
           (read-string "Phone: "
                        (or (and phone (bbdb-phone-string phone))
                            (and (integerp bbdb-default-area-code)
                                 (format "(%03d) "
                                         bbdb-default-area-code))))))))

;; (bbdb-list-transpose '(a b c d) 1 3)
(defun bbdb-list-transpose (list i j)
  "For LIST transpose elements I and J destructively.
I and J start with zero.  Return the modified LIST."
  (if (eq i j)
      list ; ignore that i, j could be invalid
    (let (a b c)
      ;; Travel down LIST only once
      (if (> i j) (setq a i i j j a)); swap
      (setq a (nthcdr i list)
            b (nthcdr (- j i) a)
            c (car b))
      (unless b (error "Args %i, %i beyond length of list." i j))
      (setcar b (car a))
      (setcar a c)
      list)))

(defun bbdb-ident-point (&optional point)
  "Return identifier (RECNUM FIELD NUM) for position POINT.
If POINT is nil use current value of point.
RECNUM is the number of the record (starting from zero).
FIELD is the field type.
If FIELD's value is a list, NUM is the position of the subfield within FIELD.
If any of these terms is not defined at POINT, the respective value is nil."
  (unless point (setq point (point)))
  (let ((recnum (get-text-property point 'bbdb-record-number))
        (field (get-text-property point 'bbdb-field)))
    (cond ((not field)
           (list recnum nil nil))
          ((eq (car field) 'name)
           (list recnum 'name nil))
          ((not (nth 1 field))
           (list recnum (car field) nil))
          (t
           (let* ((record (car (nth recnum bbdb-records)))
                  (fields (bbdb-record-field record (car field)))
                  (val (nth 1 field))
                  (num 0) done elt)
             ;; For xfields we only check the label because the rest of VAL
             ;; can be anything.  (xfields are unique within a record.)
             (if (eq 'xfields (car field))
                 (setq val (car val)
                       fields (mapcar #'car fields)))
             (while (and (not done) (setq elt (pop fields)))
               (if (eq val elt)
                   (setq done t)
                 (setq num (1+ num))))
             (unless done (error "Field %s not found" val))
             (list recnum (car field) num))))))

;;;###autoload
(defun bbdb-transpose-fields (arg)
  "Transpose previous and current field of a BBDB record.
With numeric prefix ARG, take previous field and move it past ARG fields.
With region active or ARG 0, transpose field point is in and field mark is in.

Both fields must be in the same record, and must be of the same basic type
\(that is, you can use this command to change the order in which phone numbers
or email addresses are listed, but you cannot use it to make an address appear
before a phone number; the order of field types is fixed).

If the current field is the name field, transpose first and last name,
irrespective of the value of ARG."
  ;; This functionality is inspired by `transpose-lines'.
  (interactive "p")
  (bbdb-editable)
  (let* ((ident (bbdb-ident-point))
         (record (and (car ident) (car (nth (car ident) bbdb-records))))
         num1 num2)
    (cond ((not (car ident))
           (error "Point not in BBDB record"))
          ((not (nth 1 ident))
           (error "Point not in BBDB field"))
          ((eq 'name (nth 1 ident))
           ;; Transpose firstname and lastname
           (bbdb-record-set-name record (bbdb-record-lastname record)
                                 (bbdb-record-firstname record)))
          ((not (integerp arg))
           (error "Arg `%s' not an integer" arg))
          ((not (nth 2 ident))
           (error "Point not in a transposable field"))
          (t
           (if (or (use-region-p) (zerop arg))
               (let ((ident2 (bbdb-ident-point
                              (or (mark) (error "No mark set in this buffer")))))
                 (unless (and (eq (car ident) (car ident2))
                              (eq (cadr ident) (cadr ident2))
                              (integerp (nth 2 ident2)))
                   (error "Mark (or point) not on transposable field"))
                 (setq num1 (nth 2 ident)
                       num2 (nth 2 ident2)))
             (setq num1 (1- (nth 2 ident))
                   num2 (+ num1 arg))
             (if (or (< (min num1 num2) 0)
                     (>= (max num1 num2) (length (bbdb-record-field
                                                  record (nth 1 ident)))))
                 (error "Cannot transpose fields of different types")))
           (bbdb-record-set-field
            record (nth 1 ident)
            (bbdb-list-transpose (bbdb-record-field record (nth 1 ident))
                                 num1 num2))))
    (bbdb-change-record record)))

;;;###autoload
(defun bbdb-delete-field-or-record (records field &optional noprompt)
  "For RECORDS delete FIELD.
If FIELD is the `name' field, delete RECORDS from datanbase.
Interactively, use BBDB prefix \
\\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records',
and FIELD is the field point is on.
If prefix NOPROMPT is non-nil, do not confirm deletion."
  ;; The value of FIELD is whatever `bbdb-current-field' returns.
  ;; This way we can identify more accurately what really needs
  ;; to be done.
  (interactive
   (list (bbdb-do-records) (bbdb-current-field) current-prefix-arg))
  (bbdb-editable)
  (unless field (error "Not a field"))
  (setq records (bbdb-record-list records))
  (let* ((type (car field))
         (type-x (if (eq type 'xfields)
                     (car (nth 1 field))
                   type)))
    (if (eq type 'name)
        (bbdb-delete-records records noprompt)
      (if (memq type '(firstname lastname))
          (error "Cannot delete field `%s'" type))
      (dolist (record records)
        (when (or noprompt
                  (y-or-n-p (format "delete this `%s' field (of %s)? "
                                    type-x (bbdb-record-name record))))
          (cond ((memq type '(phone address))
                 (bbdb-record-set-field
                  record type
                  ;; We use `delete' which deletes all phone and address
                  ;; fields equal to the current one.  This works for
                  ;; multiple records.
                  (delete (nth 1 field)
                          (bbdb-record-field record type))))
                ((memq type '(affix organization mail aka))
                 (bbdb-record-set-field record type nil))
                ((eq type 'xfields)
                 (bbdb-record-set-xfield record type-x nil))
                (t (error "Unknown field %s" type)))
          (bbdb-change-record record))))))

;;;###autoload
(defun bbdb-delete-records (records &optional noprompt)
  "Delete RECORDS.
Interactively, use BBDB prefix \
\\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.
If prefix NOPROMPT is non-nil, do not confirm deletion."
  (interactive (list (bbdb-do-records) current-prefix-arg))
  (bbdb-editable)
  (let ((all-records (bbdb-with-db-buffer bbdb-records)))
    (dolist (record (bbdb-record-list records))
      (cond ((not (memq record all-records))
             ;; Possibly we changed RECORD before deleting it.
             ;; Otherwise, do nothing if RECORD is unknown to BBDB.
             (setq bbdb-changed-records (delq record bbdb-changed-records)))
            ((or noprompt
                 (y-or-n-p (format "Delete the BBDB record of %s? "
                                   (or (bbdb-record-name record)
                                       (car (bbdb-record-mail record))))))
             (bbdb-delete-record-internal record t)
             (setq bbdb-changed-records (delq record bbdb-changed-records)))))))

;;;###autoload
(defun bbdb-display-all-records (&optional layout)
  "Show all records.
If invoked in a *BBDB* buffer point stays on the currently visible record.
Inverse of `bbdb-display-current-record'."
  (interactive (list (bbdb-layout-prefix)))
  (let ((current (ignore-errors (bbdb-current-record))))
    (bbdb-display-records (bbdb-records) layout)
    (when (setq current (assq current bbdb-records))
      (redisplay) ; Strange display bug??
      (goto-char (nth 2 current)))))
      ;; (set-window-point (selected-window) (nth 2 current)))))

;;;###autoload
(defun bbdb-display-current-record (&optional layout)
  "Narrow to current record.  Inverse of `bbdb-display-all-records'."
  (interactive (list (bbdb-layout-prefix)))
  (bbdb-display-records (list (bbdb-current-record)) layout))

(defun bbdb-change-records-layout (records layout)
  (dolist (record records)
    (unless (eq layout (nth 1 record))
      (setcar (cdr record) layout)
      (bbdb-redisplay-record (car record)))))

;;;###autoload
(defun bbdb-toggle-records-layout (records &optional arg)
  "Toggle layout of RECORDS (elided or expanded).
Interactively, use BBDB prefix \
\\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.
With prefix ARG 0, RECORDS are displayed elided.
With any other non-nil ARG, RECORDS are displayed expanded."
  (interactive (list (bbdb-do-records t) current-prefix-arg))
  (let* ((record (bbdb-current-record))
         (current-layout (nth 1 (assq record bbdb-records)))
         (layout-alist
          ;; Try to consider only those layouts that have the `toggle'
          ;; option set
          (or (delq nil (mapcar (lambda (l)
                                    (if (and (assq 'toggle l)
                                             (cdr (assq 'toggle l)))
                                        l))
                                  bbdb-layout-alist))
              bbdb-layout-alist))
         (layout
          (cond ((eq arg 0)
                 'one-line)
                ((null current-layout)
                 'multi-line)
                 ;; layout is not the last element of layout-alist
                 ;; and we switch to the following element of layout-alist
                ((caar (cdr (memq (assq current-layout layout-alist)
                                  layout-alist))))
                (t ; layout is the last element of layout-alist
                 ;;  and we switch to the first element of layout-alist
                 (caar layout-alist)))))
    (message "Using %S layout" layout)
    (bbdb-change-records-layout (bbdb-record-list records t) layout)))

;;;###autoload
(defun bbdb-display-records-completely (records)
  "Display RECORDS using layout `full-multi-line' (i.e., display all fields).
Interactively, use BBDB prefix \
\\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'."
  (interactive (list (bbdb-do-records t)))
  (let* ((record (bbdb-current-record))
         (current-layout (nth 1 (assq record bbdb-records)))
         (layout (if (not (eq current-layout 'full-multi-line))
                     'full-multi-line
                   'multi-line)))
    (bbdb-change-records-layout (bbdb-record-list records t) layout)))

;;;###autoload
(defun bbdb-display-records-with-layout (records layout)
  "Display RECORDS using LAYOUT.
Interactively, use BBDB prefix \
\\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'."
  (interactive
   (list (bbdb-do-records t)
         (intern (completing-read "Layout: "
                                  (mapcar (lambda (i)
                                            (list (symbol-name (car i))))
                                          bbdb-layout-alist)))))
  (bbdb-change-records-layout (bbdb-record-list records t) layout))

;;;###autoload
(defun bbdb-omit-record (n)
  "Remove current record from the display without deleting it from BBDB.
With prefix N, omit the next N records.  If negative, omit backwards."
  (interactive "p")
  (let ((num  (get-text-property (if (and (not (bobp)) (eobp))
                                     (1- (point)) (point))
                                 'bbdb-record-number)))
    (if (> n 0)
        (setq n (min n (- (length bbdb-records) num)))
      (setq n (min (- n) num))
      (bbdb-prev-record n))
    (dotimes (_i n)
      (bbdb-redisplay-record (bbdb-current-record) nil t))))

;;; Fixing up bogus records

;;;###autoload
(defun bbdb-merge-records (record1 record2)
  "Merge RECORD1 into RECORD2, then delete RECORD1 and return RECORD2.
If both records have name fields ask which one to use.
Concatenate other fields, ignoring duplicates.
RECORD1 need not be known to BBDB, its hash and cache are ignored.
Update hash and cache for RECORD2.

Interactively, RECORD1 is the current record; prompt for RECORD2.
With prefix, RECORD2 defaults to the first record with the same name."
  (interactive
   (let* ((_ (bbdb-editable))
          (record1 (bbdb-current-record))
          (name (bbdb-record-name record1))
          (record2 (and current-prefix-arg
                           ;; take the first record with the same name
                           (car (delq record1
                                      (bbdb-search (bbdb-records) :all-names name))))))
     (when record2
       (message "Merge current record with duplicate record `%s'" name)
       (sit-for 1))
     (list record1
           (or record2
               (bbdb-completing-read-record
                (format "merge record \"%s\" into: "
                        (or (bbdb-record-name record1)
                            (car (bbdb-record-mail record1))
                            "???"))
                (list record1))))))

  (bbdb-editable)
  (cond ((eq record1 record2) (error "Records are equal"))
        ((null record2) (error "No record to merge with")))

  ;; Merge names
  (let* ((new-name (bbdb-record-name record2))
         (old-name (bbdb-record-name record1))
         (old-aka  (bbdb-record-aka  record1))
         extra-name
         (name
          (cond ((or (string= "" old-name)
                     (bbdb-string= old-name new-name))
                 (cons (bbdb-record-firstname record2)
                       (bbdb-record-lastname record2)))
                ((string= "" new-name)
                 (cons (bbdb-record-firstname record1)
                       (bbdb-record-lastname record1)))
                (t (prog1
                       (if (y-or-n-p
                            (format "Use name \"%s\" instead of \"%s\"? "
                                    old-name new-name))
                           (progn
                             (setq extra-name new-name)
                             (cons (bbdb-record-firstname record1)
                                   (bbdb-record-lastname record1)))
                         (setq extra-name old-name)
                         (cons (bbdb-record-firstname record2)
                               (bbdb-record-lastname record2)))
                     (unless (bbdb-eval-spec
                              (bbdb-add-job bbdb-add-aka record2 extra-name)
                              (format "Keep \"%s\" as an alternate name? "
                                      extra-name))
                       (setq extra-name nil)))))))

    (bbdb-record-set-name record2 (car name) (cdr name))

    (if extra-name (push extra-name old-aka))
    ;; It is better to delete RECORD1 at the end.
    ;; So we must temporarily allow duplicates in RECORD2.
    (let ((bbdb-allow-duplicates t))
      (bbdb-record-set-field record2 'aka old-aka t)))

  ;; Merge other stuff
  (bbdb-record-set-field record2 'affix
                         (bbdb-record-affix record1) t)
  (bbdb-record-set-field record2 'organization
                         (bbdb-record-organization record1) t)
  (bbdb-record-set-field record2 'phone
                         (bbdb-record-phone record1) t)
  (bbdb-record-set-field record2 'address
                         (bbdb-record-address record1) t)
  (let ((bbdb-allow-duplicates t))
    (bbdb-record-set-field record2 'mail
                           (bbdb-record-mail record1) t))
  (bbdb-record-set-field record2 'xfields
                         (bbdb-record-xfields record1) t)

  ;; `bbdb-delete-records' does nothing if RECORD1 is not known to BBDB.
  (bbdb-delete-records (list record1) 'noprompt)
  (bbdb-change-record record2)
  record2)

;; The following sorting functions are also intended for use
;; in `bbdb-change-hook'.  Then they will be called with one arg, the record.

;;;###autoload
(defun bbdb-sort-addresses (records &optional update)
  "Sort the addresses in RECORDS according to the label.
Interactively, use BBDB prefix \
\\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.
If UPDATE is non-nil (as in interactive calls) update the database.
Otherwise, this is the caller's responsiblity (for example, when used
in `bbdb-change-hook')."
  (interactive (list (bbdb-do-records) t))
  (bbdb-editable)
  (dolist (record (bbdb-record-list records))
    (bbdb-record-set-address
     record (sort (bbdb-record-address record)
                  (lambda (xx yy) (string< (aref xx 0) (aref yy 0)))))
    (if update
        (bbdb-change-record record))))

;;;###autoload
(defun bbdb-sort-phones (records &optional update)
  "Sort the phones in RECORDS according to the label.
Interactively, use BBDB prefix \
\\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.
If UPDATE is non-nil (as in interactive calls) update the database.
Otherwise, this is the caller's responsiblity (for example, when used
in `bbdb-change-hook')."
  (interactive (list (bbdb-do-records) t))
  (bbdb-editable)
  (dolist (record (bbdb-record-list records))
    (bbdb-record-set-phone
     record (sort (bbdb-record-phone record)
                  (lambda (xx yy) (string< (aref xx 0) (aref yy 0)))))
    (if update
        (bbdb-change-record record))))

;;;###autoload
(defun bbdb-sort-xfields (records &optional update)
  "Sort the xfields in RECORDS according to `bbdb-xfields-sort-order'.
Interactively, use BBDB prefix \
\\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.
If UPDATE is non-nil (as in interactive calls) update the database.
Otherwise, this is the caller's responsiblity (for example, when used
in `bbdb-change-hook')."
  (interactive (list (bbdb-do-records) t))
  (bbdb-editable)
  (dolist (record (bbdb-record-list records))
    (bbdb-record-set-xfields
     record (sort (bbdb-record-xfields record)
                  (lambda (a b)
                    (< (or (cdr (assq (car a) bbdb-xfields-sort-order)) 100)
                       (or (cdr (assq (car b) bbdb-xfields-sort-order)) 100)))))
    (if update
        (bbdb-change-record record))))
(define-obsolete-function-alias 'bbdb-sort-notes #'bbdb-sort-xfields "3.0")

;;; Send-Mail interface

;;;###autoload
(defun bbdb-dwim-mail (record &optional mail)
  ;; Do What I Mean!
  "Return a string to use as the mail address of RECORD.
The name in the mail address is formatted obeying `bbdb-mail-name-format'
and `bbdb-mail-name'.  However, if both the first name and last name
are constituents of the address as in John.Doe@Some.Host,
and `bbdb-mail-avoid-redundancy' is non-nil, then the address is used as is
and `bbdb-mail-name-format' and `bbdb-mail-name' are ignored.
If `bbdb-mail-avoid-redundancy' is 'mail-only the name is never included.
MAIL may be a mail address to be used for RECORD.
If MAIL is an integer, use the MAILth mail address of RECORD.
If MAIL is nil use the first mail address of RECORD."
  (unless mail
    (let ((mails (bbdb-record-mail record)))
      (setq mail (or (and (integerp mail) (nth mail mails))
                     (car mails)))))
  (unless mail (error "Record has no mail addresses"))
  (let (name fn ln)
    (cond ((let ((address (bbdb-decompose-bbdb-address mail)))
             ;; We need to know whether we should quote the name part of MAIL
             ;; because of special characters.
             (if (car address)
                 (setq mail (cadr address)
                       name (car address)
                       ln name))))
          ((functionp bbdb-mail-name)
           (setq name (funcall bbdb-mail-name record))
           (if (consp name)
               (setq fn (car name) ln (cdr name)
                     name (if (eq bbdb-mail-name-format 'first-last)
                              (bbdb-concat 'name-first-last fn ln)
                            (bbdb-concat 'name-last-first ln fn)))
             (let ((pair (bbdb-divide-name name)))
               (setq fn (car pair) ln (cdr pair)))))
          ((setq name (bbdb-record-xfield record bbdb-mail-name))
           (let ((pair (bbdb-divide-name name)))
             (setq fn (car pair) ln (cdr pair))))
          (t
           (setq name (if (eq bbdb-mail-name-format 'first-last)
                          (bbdb-record-name record)
                        (bbdb-record-name-lf record))
                 fn (bbdb-record-firstname record)
                 ln (bbdb-record-lastname  record))))
    (if (or (not name) (equal "" name)
            (eq 'mail-only bbdb-mail-avoid-redundancy)
            (and bbdb-mail-avoid-redundancy
                 (cond ((and fn ln)
                        (let ((fnq (regexp-quote fn))
                              (lnq (regexp-quote ln)))
                          (or (string-match (concat "\\`[^!@%]*\\b" fnq
                                                    "\\b[^!%@]+\\b" lnq "\\b")
                                            mail)
                            (string-match (concat "\\`[^!@%]*\\b" lnq
                                                  "\\b[^!%@]+\\b" fnq "\\b")
                                          mail))))
                       ((or fn ln)
                        (string-match (concat "\\`[^!@%]*\\b"
                                              (regexp-quote (or fn ln)) "\\b")
                                      mail)))))
        mail
      ;; If the name contains backslashes or double-quotes, backslash them.
      (setq name (replace-regexp-in-string "[\\\"]" "\\\\\\&" name))
      ;; If the name contains control chars or RFC822 specials, it needs
      ;; to be enclosed in quotes.  This quotes a few extra characters as
      ;; well (!,%, and $) just for common sense.
      ;; `define-mail-alias' uses regexp "[^- !#$%&'*+/0-9=?A-Za-z^_`{|}~]".
      (format (if (string-match "[][[:cntrl:]\177()<>@,;:.!$%[:nonascii:]]" name)
                  "\"%s\" <%s>"
                "%s <%s>")
              name mail))))

(defun bbdb-compose-mail (&rest args)
  "Start composing a mail message to send.
Use `bbdb-mail-user-agent' or (if nil) use `mail-user-agent'.
ARGS are passed to `compose-mail'."
  (let ((mail-user-agent (or bbdb-mail-user-agent mail-user-agent)))
    (apply #'compose-mail args)))

;;;###autoload
(defun bbdb-mail (records &optional subject n verbose)
  "Compose a mail message to RECORDS (optional: using SUBJECT).
Interactively, use BBDB prefix \
\\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.
By default, the first mail addresses of RECORDS are used.
If prefix N is a number, use Nth mail address of RECORDS (starting from 1).
If prefix N is C-u (t noninteractively) use all mail addresses of RECORDS.
If VERBOSE is non-nil (as in interactive calls) be verbose."
  (interactive (list (bbdb-do-records) nil
                     (or (consp current-prefix-arg)
                         current-prefix-arg)
                     t))
  (setq records (bbdb-record-list records))
  (if (not records)
      (if verbose (message "No records"))
    (let ((to (bbdb-mail-address records n nil verbose)))
      (unless (string= "" to)
        (bbdb-compose-mail to subject)))))

(defun bbdb-mail-address (records &optional n kill-ring-save verbose)
  "Return mail addresses of RECORDS as a string.
Interactively, use BBDB prefix \
\\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.
By default, the first mail addresses of RECORDS are used.
If prefix N is a number, use Nth mail address of RECORDS (starting from 1).
If prefix N is C-u (t noninteractively) use all mail addresses of RECORDS.
If KILL-RING-SAVE is non-nil (as in interactive calls), copy mail addresses
to kill ring.  If VERBOSE is non-nil (as in interactive calls) be verbose."
  (interactive (list (bbdb-do-records)
                     (or (consp current-prefix-arg)
                         current-prefix-arg)
                     t t))
  (setq records (bbdb-record-list records))
  (if (not records)
      (progn (if verbose (message "No records")) "")
    (let ((good "") bad)
      (dolist (record records)
        (let ((mails (bbdb-record-mail record)))
          (cond ((not mails)
                 (push record bad))
                ((eq n t)
                 (setq good (bbdb-concat ",\n\t"
                                         good
                                         (mapcar (lambda (mail)
                                                   (bbdb-dwim-mail record mail))
                                                 mails))))
                (t
                 (setq good (bbdb-concat ",\n\t" good
                            (bbdb-dwim-mail record (or (and (numberp n)
                                                            (nth (1- n) mails))
                                                       (car mails)))))))))
      (when (and bad verbose)
        (message "No mail addresses for %s."
                 (mapconcat #'bbdb-record-name (nreverse bad) ", "))
        (unless (string= "" good) (sit-for 2)))
      (when (and kill-ring-save (not (string= good "")))
        (kill-new good)
        (if verbose (message "%s" good)))
      good)))

;; Is there better way to yank selected mail addresses from the BBDB
;; buffer into a message buffer?  We need some kind of a link between
;; the BBDB buffer and the message buffer, where the mail addresses
;; are supposed to go. Then we could browse the BBDB buffer and copy
;; selected mail addresses from the BBDB buffer into a message buffer.

(defun bbdb-mail-yank ()
  "CC the people displayed in the *BBDB* buffer on this mail message.
The primary mail of each of the records currently listed in the
*BBDB* buffer will be appended to the CC: field of the current buffer."
  (interactive)
  (let ((addresses (with-current-buffer bbdb-buffer-name
                     (delq nil
                           (mapcar (lambda (x)
                                     (if (bbdb-record-mail (car x))
                                         (bbdb-dwim-mail (car x))))
                                   bbdb-records))))
        (case-fold-search t))
    (goto-char (point-min))
    (if (re-search-forward "^CC:[ \t]*" nil t)
        ;; We have a CC field. Move to the end of it, inserting a comma
        ;; if there are already addresses present.
        (unless (eolp)
          (end-of-line)
          (while (looking-at "\n[ \t]")
            (forward-char) (end-of-line))
          (insert ",\n")
          (indent-relative))
      ;; Otherwise, if there is an empty To: field, move to the end of it.
      (unless (and (re-search-forward "^To:[ \t]*" nil t)
                   (eolp))
        ;; Otherwise, insert an empty CC: field.
        (end-of-line)
        (while (looking-at "\n[ \t]")
          (forward-char) (end-of-line))
        (insert "\nCC:")
        (indent-relative)))
    ;; Now insert each of the addresses on its own line.
    (while addresses
      (insert (car addresses))
      (when (cdr addresses) (insert ",\n") (indent-relative))
      (setq addresses (cdr addresses)))))
(define-obsolete-function-alias 'bbdb-yank-addresses #'bbdb-mail-yank "3.0")

;;; completion

;;;###autoload
(defun bbdb-completion-predicate (key records)
  "For use as the third argument to `completing-read'.
Obey `bbdb-completion-list'."
  (cond ((null bbdb-completion-list)
         nil)
        ((eq t bbdb-completion-list)
         t)
        (t
         (catch 'bbdb-hash-ok
           (dolist (record records)
             (bbdb-hash-p key record bbdb-completion-list))
           nil))))

(defun bbdb-completing-read-records (prompt &optional omit-records)
  "Read and return list of records from the bbdb.
Completion is done according to `bbdb-completion-list'.  If the user
just hits return, nil is returned.  Otherwise, a valid response is forced."
  (let* ((completion-ignore-case t)
         (string (completing-read prompt bbdb-hashtable
                                  'bbdb-completion-predicate t)))
    (unless (string= "" string)
      (let (records)
        (dolist (record (gethash string bbdb-hashtable))
          (if (not (memq record omit-records))
              (push record records)))
        (delete-dups records)))))

(defun bbdb-completing-read-record (prompt &optional omit-records)
  "Prompt for and return a single record from the bbdb;
completion is done according to `bbdb-completion-list'.  If the user
just hits return, nil is returned. Otherwise, a valid response is forced.
If OMIT-RECORDS is non-nil it should be a list of records to dis-allow
completion with."
  (let ((records (bbdb-completing-read-records prompt omit-records)))
    (cond ((eq (length records) 1)
           (car records))
          ((> (length records) 1)
           (bbdb-display-records records 'one-line)
           (let* ((count (length records))
                  (result (completing-read
                           (format "Which record (1-%s): " count)
                           (mapcar #'number-to-string (number-sequence 1 count))
                           nil t)))
             (nth (1- (string-to-number result)) records))))))

;;;###autoload
(defun bbdb-completing-read-mails (prompt &optional init)
  "Like `read-string', but allows `bbdb-complete-mail' style completion."
  (read-from-minibuffer prompt init
                        bbdb-completing-read-mails-map))

(defconst bbdb-quoted-string-syntax-table
  (let ((st (make-syntax-table)))
    (modify-syntax-entry ?\\ "\\" st)
    (modify-syntax-entry ?\" "\"" st)
    st)
  "Syntax-table to parse matched quotes.  Used by `bbdb-complete-mail'.")

;;;###autoload
(defun bbdb-complete-mail (&optional beg cycle-completion-buffer)
  "In a mail buffer, complete the user name or mail before point.
Completion happens up to the preceeding colon, comma, or BEG.
Return non-nil if there is a valid completion, else return nil.

Completion behaviour obeys `bbdb-completion-list' (see there).
If what has been typed matches a unique BBDB record, insert an address
formatted by `bbdb-dwim-mail' (see there).  Also, display this record
if `bbdb-completion-display-record' is non-nil,
If what has been typed is a valid completion but does not match
a unique record, display a list of completions.
If the completion is done and `bbdb-complete-mail-allow-cycling' is t
then cycle through the mails for the matching record.  If BBDB
would format a given address different from what we have in the mail buffer,
the first round of cycling reformats the address accordingly, then we cycle
through the mails for the matching record.
With prefix CYCLE-COMPLETION-BUFFER non-nil, display a list of all mails
available for cycling.

Set the variable `bbdb-complete-mail' non-nil for enabling this feature
as part of the MUA insinuation."
  (interactive (list nil current-prefix-arg))

  (bbdb-buffer) ; Make sure the database is initialized.

  ;; Completion should begin after the preceding comma (separating
  ;; two addresses) or colon (separating the header field name
  ;; from the header field body).  We want to ignore these characters
  ;; if they appear inside a quoted string (RFC 5322, Sec. 3.2.4).
  ;; Note also that a quoted string may span multiple lines
  ;; (RFC 5322, Sec. 2.2.3).
  ;; So to be save, we go back to the beginning of the header field body
  ;; (past the colon, when we are certainly not inside a quoted string),
  ;; then we parse forward, looking for commas not inside a quoted string
  ;; and positioned before END.  - This fails with an unbalanced quote.
  ;; But an unbalanced quote is bound to fail anyway.
  (when (and (not beg)
             (<= (point)
                 (save-restriction ; `mail-header-end'
                   (widen)
                   (save-excursion
                     (rfc822-goto-eoh)
                     (point)))))
    (let ((end (point))
          start pnt state)
      (save-excursion
        ;; A header field name must appear at the beginning of a line,
        ;; and it must be terminated by a colon.
        (re-search-backward "^[^ \t\n:][^:]*:[ \t\n]+")
        (setq beg (match-end 0)
              start beg)
        (goto-char beg)
        ;; If we are inside a syntactically correct header field,
        ;; all continuation lines in between the field name and point
        ;; must begin with a white space character.
        (if (re-search-forward "\n[^ \t]" end t)
            ;; An invalid header is identified via BEG set to nil.
            (setq beg nil)
          ;; Parse field body up to END
          (with-syntax-table bbdb-quoted-string-syntax-table
            (while (setq pnt (re-search-forward ",[ \t\n]*" end t))
              (setq state (parse-partial-sexp start pnt nil nil state)
                    start pnt)
              (unless (nth 3 state) (setq beg pnt))))))))

  ;; Do we have a meaningful way to set BEG if we are not in a message header?
  (unless beg
    (message "Not a valid buffer position for mail completion")
    (sit-for 1))

  (let* ((end (point))
         (done (unless beg 'nothing))
         (orig (and beg (buffer-substring beg end)))
         (completion-ignore-case t)
         (completion (and orig
                          (try-completion orig bbdb-hashtable
                                          'bbdb-completion-predicate)))
         all-completions dwim-completions one-record)

    (unless done
      ;; We get fooled if a partial COMPLETION matches "," (for example,
      ;; a comma in lf-name).  Such a partial COMPLETION cannot be protected
      ;; by quoting.  Then the comma gets interpreted as BEG.
      ;; So we never perform partial completion beyond the first comma.
      ;; This works even if we have just one record matching ORIG (thus
      ;; allowing dwim-completion) because ORIG is a substring of COMPLETION
      ;; even after COMPLETION got truncated; and ORIG by itself must be
      ;; sufficient to identify this record.
      ;; Yet if multiple records match ORIG we can only offer a *Completions*
      ;; buffer.
      (if (and (stringp completion)
               (string-match "," completion))
          (setq completion (substring completion 0 (match-beginning 0))))

      (setq all-completions (all-completions orig bbdb-hashtable
                                             'bbdb-completion-predicate))
      ;; Resolve the records matching ORIG:
      ;; Multiple completions may match the same record
      (let ((records (delete-dups
                      (apply #'append (mapcar (lambda (compl)
                                                (gethash compl bbdb-hashtable))
                                              all-completions)))))
        ;; Is there only one matching record?
        (setq one-record (and (not (cdr records))
                              (car records))))

      ;; Clean up *Completions* buffer window, if it exists
      (let ((window (get-buffer-window "*Completions*")))
        (if (window-live-p window)
            (quit-window nil window)))

      (cond
       ;; Match for a single record
       (one-record
        (let ((completion-list (if (eq t bbdb-completion-list)
                                   '(fl-name lf-name mail aka organization)
                                 bbdb-completion-list))
              (mails (bbdb-record-mail one-record))
              mail elt)
          (if (not mails)
              (progn
                (message "Matching record has no mail field")
                (sit-for 1)
                (setq done 'nothing))

            ;; Determine the mail address of ONE-RECORD to use for ADDRESS.
            ;; Do we have a preferential order for the following tests?
            ;; (1) If ORIG matches name, AKA, or organization of ONE-RECORD,
            ;;     then ADDRESS will be the first mail address of ONE-RECORD.
            (if (try-completion orig
                                (append
                                 (if (memq 'fl-name completion-list)
                                     (list (or (bbdb-record-name one-record) "")))
                                 (if (memq 'lf-name completion-list)
                                     (list (or (bbdb-record-name-lf one-record) "")))
                                 (if (memq 'aka completion-list)
                                     (bbdb-record-field one-record 'aka-all))
                                 (if (memq 'organization completion-list)
                                     (bbdb-record-organization one-record))))
                (setq mail (car mails)))
            ;; (2) If ORIG matches one or multiple mail addresses of ONE-RECORD,
            ;;     then we take the first one matching ORIG.
            ;;     We got here with MAIL nil only if `bbdb-completion-list'
            ;;     includes 'mail or 'primary.
            (unless mail
              (while (setq elt (pop mails))
                (if (try-completion orig (list elt))
                    (setq mail elt
                          mails nil))))
            ;; This error message indicates a bug!
            (unless mail (error "No match for %s" orig))

            (let ((dwim-mail (bbdb-dwim-mail one-record mail)))
              (if (string= dwim-mail orig)
                  ;; We get here if `bbdb-mail-avoid-redundancy' is 'mail-only
                  ;; and `bbdb-completion-list' includes 'mail.
                  (unless (and bbdb-complete-mail-allow-cycling
                               (< 1 (length (bbdb-record-mail one-record))))
                    (setq done 'unchanged))
                ;; Replace the text with the expansion
                (delete-region beg end)
                (insert dwim-mail)
                (bbdb-complete-mail-cleanup dwim-mail beg)
                (setq done 'unique))))))

       ;; Partial completion
       ((and (stringp completion)
             (not (bbdb-string= orig completion)))
        (delete-region beg end)
        (insert completion)
        (setq done 'partial))

       ;; Partial match not allowing further partial completion
       (completion
        (let ((completion-list (if (eq t bbdb-completion-list)
                                   '(fl-name lf-name mail aka organization)
                                 bbdb-completion-list)))
          ;; Now collect all the dwim-addresses for each completion.
          ;; Add it if the mail is part of the completions
          (dolist (key all-completions)
            (dolist (record (gethash key bbdb-hashtable))
              (let ((mails (bbdb-record-mail record))
                    accept)
                (when mails
                  (dolist (field completion-list)
                    (cond ((eq field 'fl-name)
                           (if (bbdb-string= key (bbdb-record-name record))
                               (push (car mails) accept)))
                          ((eq field 'lf-name)
                           (if (bbdb-string= key (bbdb-cache-lf-name
                                                  (bbdb-record-cache record)))
                               (push (car mails) accept)))
                          ((eq field 'aka)
                           (if (member-ignore-case key (bbdb-record-field
                                                        record 'aka-all))
                               (push (car mails) accept)))
                          ((eq field 'organization)
                           (if (member-ignore-case key (bbdb-record-organization
                                                        record))
                               (push (car mails) accept)))
                          ((eq field 'primary)
                           (if (bbdb-string= key (car mails))
                               (push (car mails) accept)))
                          ((eq field 'mail)
                           (dolist (mail mails)
                             (if (bbdb-string= key mail)
                                 (push mail accept))))))
                  (dolist (mail (delete-dups accept))
                    (push (bbdb-dwim-mail record mail) dwim-completions))))))

          (setq dwim-completions (sort (delete-dups dwim-completions)
                                       'string-lessp))
          (cond ((not dwim-completions)
                 (message "Matching record has no mail field")
                 (sit-for 1)
                 (setq done 'nothing))
                ;; DWIM-COMPLETIONS may contain only one element,
                ;; if multiple completions match the same record.
                ;; Then we may proceed with DONE set to `unique'.
                ((eq 1 (length dwim-completions))
                 (delete-region beg end)
                 (insert (car dwim-completions))
                 (bbdb-complete-mail-cleanup (car dwim-completions) beg)
                 (setq done 'unique))
                (t (setq done 'choose)))))))

    ;; By now, we have considered all possiblities to perform a completion.
    ;; If nonetheless we haven't done anything so far, consider cycling.
    ;;
    ;; Completion and cycling are really two very separate things.
    ;; Completion is controlled by the user variable `bbdb-completion-list'.
    ;; Cycling assumes that ORIG already holds a valid RFC 822 mail address.
    ;; Therefore cycling may consider different records than completion.
    (when (and (not done) bbdb-complete-mail-allow-cycling)
      ;; find the record we are working on.
      (let* ((address (bbdb-extract-address-components orig))
             (record (car (bbdb-message-search
                           (car address) (cadr address)))))
        (if (and record
                 (setq dwim-completions
                       (mapcar (lambda (m) (bbdb-dwim-mail record m))
                               (bbdb-record-mail record))))
            (cond ((and (= 1 (length dwim-completions))
                        (string= orig (car dwim-completions)))
                   (setq done 'unchanged))
                  (cycle-completion-buffer ; use completion buffer
                   (setq done 'cycle-choose))
                  ;; Reformatting / Clean up:
                  ;; If the canonical mail address (nth 1 address)
                  ;; matches the Nth canonical mail address of RECORD,
                  ;; but ORIG is not `equal' to (bbdb-dwim-mail record n),
                  ;; then we replace ORIG by (bbdb-dwim-mail record n).
                  ;; For example, the address "JOHN SMITH <FOO@BAR.COM>"
                  ;; gets reformatted as "John Smith <foo@bar.com>".
                  ;; We attempt this reformatting before the yet more
                  ;; aggressive proper cycling.
                  ((let* ((cmails (bbdb-record-mail-canon record))
                          (len (length cmails))
                          mail dwim-mail)
                     (while (and (not done)
                                 (setq mail (pop cmails)))
                       (when (and (bbdb-string= mail (nth 1 address)) ; ignore case
                                  (not (string= orig (setq dwim-mail
                                                           (nth (- len 1 (length cmails))
                                                                dwim-completions)))))
                         (delete-region beg end)
                         (insert dwim-mail)
                         (bbdb-complete-mail-cleanup dwim-mail beg)
                         (setq done 'reformat)))
                     done))

                  (t
                   ;; ORIG is `equal' to an element of DWIM-COMPLETIONS
                   ;; Use the next element of DWIM-COMPLETIONS.
                   (let ((dwim-mail (or (nth 1 (member orig dwim-completions))
                                        (nth 0 dwim-completions))))
                     ;; replace with new mail address
                     (delete-region beg end)
                     (insert dwim-mail)
                     (bbdb-complete-mail-cleanup dwim-mail beg)
                     (setq done 'cycle)))))))

    (when (member done '(choose cycle-choose))
      ;; Pop up a completions window using DWIM-COMPLETIONS.
      ;; `completion-in-region' does not work here as DWIM-COMPLETIONS
      ;; is not a collection for completion in the usual sense, but it
      ;; is really a list of replacements.
      (let ((status (not (eq (selected-window) (minibuffer-window))))
            (completion-base-position (list beg end))
            ;; We first call the default value of
            ;; `completion-list-insert-choice-function'
            ;; before performing our own stuff.
            (completion-list-insert-choice-function
             ;; FIXME: Use closure instead of backquoted lambda!
             `(lambda (beg end text)
                ,(if (boundp 'completion-list-insert-choice-function)
                     `(funcall ',completion-list-insert-choice-function
                               beg end text))
                (bbdb-complete-mail-cleanup text beg))))
        (if status (message "Making completion list..."))
        (with-output-to-temp-buffer "*Completions*"
          (display-completion-list dwim-completions))
        (if status (message "Making completion list...done"))))

    ;; If DONE is `nothing' return nil so that possibly some other code
    ;; can take over.
    (unless (eq done 'nothing)
      done)))

;;;###autoload
(define-obsolete-function-alias 'bbdb-complete-name #'bbdb-complete-mail "3.0")

(defun bbdb-complete-mail-cleanup (mail beg)
  "Clean up after inserting MAIL at position BEG.
If we are past `fill-column', wrap at the previous comma."
  (if (and (not (auto-fill-function))
           (>= (current-column) fill-column))
      (save-excursion
        (goto-char beg)
        (when (search-backward "," (line-beginning-position) t)
          (forward-char 1)
          (insert "\n")
          (indent-relative)
          (if (looking-at "[ \t\n]+")
              (delete-region (point) (match-end 0))))))
  (if (or bbdb-completion-display-record bbdb-complete-mail-hook)
      (let* ((address (bbdb-extract-address-components mail))
             (records (bbdb-message-search (car address) (nth 1 address))))
        ;; Update the *BBDB* buffer if desired.
        (if bbdb-completion-display-record
            (let ((bbdb-silent-internal t))
              ;; FIXME: This pops up *BBDB* before removing *Completions*
              (bbdb-display-records records nil t)))
        ;; `bbdb-complete-mail-hook' may access MAIL, ADDRESS, and RECORDS.
        ;; FIXME: Now that we use lexical-binding, these vars can't be accessed
        ;; any more.  Maybe we should just change the doc!?
        (run-hooks 'bbdb-complete-mail-hook))))

;;; interface to mail-abbrevs.el.

;;;###autoload
(defun bbdb-mail-aliases (&optional force-rebuilt noisy)
  "Define mail aliases for the records in the database.
Define a mail alias for every record that has a `mail-alias' field
which is the contents of that field.
If there are multiple comma-separated words in the `mail-alias' field,
then all of those words will be defined as aliases for that person.

If multiple records in the database have the same mail alias,
then that alias expands to a comma-separated list of the mail addresses
of all of these people.
Add this command to `mail-setup-hook'.

Mail aliases are (re)built only if `bbdb-mail-aliases-need-rebuilt' is non-nil
because the database was newly loaded or it has been edited.
Rebuilding the aliases is enforced if prefix FORCE-REBUILT is t."
  (interactive (list current-prefix-arg t))
  ;; Build `mail-aliases' if not yet done.
  ;; Note: `mail-abbrevs-setup' rebuilds the mail-aliases only if
  ;; `mail-personal-alias-file' has changed.  So it would not do anything
  ;; if we want to rebuild the mail-aliases because of changes in BBDB.
  (if (or force-rebuilt (eq t mail-aliases)) (build-mail-aliases))

  ;; We should be cleverer here and instead of rebuilding all aliases
  ;; we should just do what's necessary, i.e. remove deleted records
  ;; and add new records
  ;; Calling `bbdb-records' can change `bbdb-mail-aliases-need-rebuilt'
  (let ((records (bbdb-search (bbdb-records) :xfield (cons bbdb-mail-alias-field ".")))
        results match)
    (if (not (or force-rebuilt bbdb-mail-aliases-need-rebuilt))
        (if noisy (message "BBDB mail alias: nothing to do"))
      (setq bbdb-mail-aliases-need-rebuilt nil)

      ;; collect an alist of (alias rec1 [rec2 ...])
      (dolist (record records)
        (if (bbdb-record-mail record)
            (dolist (alias (bbdb-record-xfield-split record bbdb-mail-alias-field))
              (if (setq match (assoc alias results))
                  ;; If an alias appears more than once, we collect all records
                  ;; that refer to it.
                  (nconc match (list record))
                (push (list alias record) results)))
          (unless bbdb-silent
            (bbdb-warn "record %S has no mail address, but the aliases: %s"
                       (bbdb-record-name record)
                       (bbdb-record-xfield record bbdb-mail-alias-field))
            (sit-for 1))))

      ;; Iterate over the results and create the aliases
      (dolist (result results)
        (let* ((aliasstem (car result))
               (expansions
                (if (cddr result)
                    ;; for group aliases we just take all the primary mails
                    ;; and define only one expansion!
                    (list (mapconcat #'bbdb-dwim-mail
                                     (cdr result) mail-alias-separator-string))
                  ;; this is an alias for a single person so deal with it
                  ;; according to `bbdb-mail-alias'
                  (let* ((record (nth 1 result))
                         (mails (bbdb-record-mail record)))
                    (if (or (eq 'first bbdb-mail-alias)
                            (not (cdr mails)))
                        ;; Either we want to define only one alias for
                        ;; the first mail address or there is anyway
                        ;; only one address.  In either case, we take
                        ;; take only the first address.
                        (list (bbdb-dwim-mail record (car mails)))
                      ;; We need to deal with more than one mail address...
                      (let* ((all (mapcar (lambda (m) (bbdb-dwim-mail record m))
                                          mails))
                             (star (bbdb-concat mail-alias-separator-string all)))
                        (if (eq 'star bbdb-mail-alias)
                            (list star (car all))
                          ;; if `bbdb-mail-alias' is 'all, we create
                          ;; two aliases for the primary mail address
                          (cons star (cons (car all) all))))))))
               (count -1) ; n=-1: <alias>*;  n=0: <alias>;  n>0: <alias>n
               (len (length expansions))
               alias f-alias)

          ;; create the aliases for each expansion
          (dolist (expansion expansions)
            (cond ((or (= 1 len)
                       (= count 0))
                   (setq alias aliasstem))
                  ((= count -1) ;; all the mails of a record
                   (setq alias (concat aliasstem "*")))
                  (t ;; <alias>n for each mail of a record
                   (setq alias (format "%s%s" aliasstem count))))
            (setq count (1+ count))

            (bbdb-pushnew (cons alias expansion) mail-aliases)

            (define-mail-abbrev alias expansion)
            
            (unless (setq f-alias (abbrev-symbol alias mail-abbrevs))
              (error "Cannot find the alias"))

            ;; `define-mail-abbrev' initializes f-alias to be
            ;; `mail-abbrev-expand-hook'. We replace this by
            ;; `bbdb-mail-abbrev-expand-hook'
            ;; FIXME: Use proper accessor instead of `symbol-function'.
            (unless (eq (symbol-function f-alias) #'mail-abbrev-expand-hook)
              (error "mail-aliases contains unexpected hook %s"
                     (symbol-function f-alias)))
            ;; `bbdb-mail-abbrev-hook' is called with mail addresses instead of
            ;; bbdb records to avoid keeping pointers to records, which would
            ;; lose if the database was reverted.
            ;; `bbdb-mail-abbrev-hook' uses `bbdb-message-search' to convert
            ;; these mail addresses to records, which is plenty fast.
            ;; FIXME: The value of arg MAILS for `bbdb-mail-abbrev-hook'
            ;; is wrong. Currently it is based on the list of records that have
            ;; referenced ALIASTEM and we simply take the first mail address
            ;; from each of these records.
            ;; Then `bbdb-message-search' will find the correct records
            ;; (assuming that each mail address appears only once in the
            ;; database).  Nonethless, arg MAILS for `bbdb-mail-abbrev-hook'
            ;; does not, in general, contain the actual mail addresses
            ;; of EXPANSION.  So what we would need is to go back from
            ;; EXPANSION to the mail addresses it contains (which is tricky
            ;; because mail addresses in the database can be shortcuts for
            ;; the addresses in EXPANSION).
            ;; FIXME: Use a closure rather than a backquoted lambda!
            (fset f-alias `(lambda ()
                             (bbdb-mail-abbrev-expand-hook
                              ,alias
                              ',(mapcar (lambda (r) (car (bbdb-record-mail r)))
                                        (cdr result))))))))

      (if noisy (message "BBDB mail alias: rebuilding done")))))

(defun bbdb-mail-abbrev-expand-hook (alias mails)
  (run-hook-with-args 'bbdb-mail-abbrev-expand-hook alias mails)
  (mail-abbrev-expand-hook)
  (when bbdb-completion-display-record
    (let ((bbdb-silent-internal t))
      (bbdb-display-records
       (apply #'append
              (mapcar (lambda (mail) (bbdb-message-search nil mail)) mails))
       nil t))))

(defun bbdb-get-mail-aliases ()
  "Return a list of mail aliases used in the BBDB."
  (let ((records (bbdb-search (bbdb-records) :xfield (cons bbdb-mail-alias-field ".")))
        result)
    (dolist (record records)
      (dolist (alias (bbdb-record-xfield-split record bbdb-mail-alias-field))
        (bbdb-pushnew alias result)))
    result))

;;;###autoload
(defsubst bbdb-mail-alias-list (alias)
  (if (stringp alias)
      (bbdb-split bbdb-mail-alias-field alias)
    alias))

(defun bbdb-add-mail-alias (records &optional alias delete)
  "Add ALIAS to RECORDS.
If prefix DELETE is non-nil, remove ALIAS from RECORDS.
Interactively, use BBDB prefix \
\\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.
Arg ALIAS is ignored if list RECORDS contains more than one record.
Instead read ALIAS interactively for each record in RECORDS.
If the function `bbdb-init-mail-alias' is defined, it is called with
one arg RECORD to define the default value for ALIAS of RECORD."
  (interactive (list (bbdb-do-records) nil current-prefix-arg))
  (bbdb-editable)
  (setq records (bbdb-record-list records))
  (if (< 1 (length records)) (setq alias nil))
  (let* ((tmp (intern-soft
               (concat "bbdb-init-" (symbol-name bbdb-mail-alias-field))))
         (init-f (if (functionp tmp) tmp)))
    (dolist (record records)
      (let ((r-a-list (bbdb-record-xfield-split record bbdb-mail-alias-field))
            (alias alias)
            a-list)
        (if alias
            (setq a-list (bbdb-mail-alias-list alias))
          (when init-f
            (setq a-list (bbdb-mail-alias-list (funcall init-f record))
                  alias (if a-list (bbdb-concat bbdb-mail-alias-field a-list))))
          (let ((crm-separator
                 (concat "[ \t\n]*"
                         (cadr (assq bbdb-mail-alias-field bbdb-separator-alist))
                         "[ \t\n]*"))
                (crm-local-completion-map bbdb-crm-local-completion-map)
                (prompt (format "%s mail alias:%s " (if delete "Remove" "Add")
                                (if alias (format " (default %s)" alias) "")))
                (collection (if delete
                                (or r-a-list (error "Record has no alias"))
                              (bbdb-get-mail-aliases))))
            (setq a-list (if (string< "24.3" (substring emacs-version 0 4))
                             (completing-read-multiple prompt collection nil
                                                       delete nil nil alias)
                          (bbdb-split bbdb-mail-alias-field
                                      (completing-read prompt collection nil
                                                       delete nil nil alias))))))
        (dolist (a a-list)
          (if delete
              (setq r-a-list (delete a r-a-list))
            ;; Add alias only if it is not there yet
            (bbdb-pushnew a r-a-list)))
        ;; This also handles `bbdb-mail-aliases-need-rebuilt'
        (bbdb-record-set-xfield record bbdb-mail-alias-field
                                (bbdb-concat bbdb-mail-alias-field r-a-list))
        (bbdb-change-record record)))))

;;; Dialing numbers from BBDB

(defun bbdb-dial-number (phone-string)
  "Dial the number specified by PHONE-STRING.
This uses the tel URI syntax passed to `browse-url' to make the call.
If `bbdb-dial-function' is non-nil then that is called to make the phone call."
  (interactive "sDial number: ")
  (funcall (or bbdb-dial-function #'bbdb--dial-default) phone-string))

;;;###autoload
(defun bbdb-dial (phone force-area-code)
  "Dial the number at point.
If the point is at the beginning of a record, dial the first phone number.
Use rules from `bbdb-dial-local-prefix-alist' unless prefix FORCE-AREA-CODE
is non-nil.  Do not dial the extension."
  (interactive (list (bbdb-current-field) current-prefix-arg))
  (if (eq (car-safe phone) 'name)
      (setq phone (car (bbdb-record-phone (bbdb-current-record)))))
  (if (eq (car-safe phone) 'phone)
      (setq phone (car (cdr phone))))
  (or (vectorp phone) (error "Not on a phone field"))

  (let ((number (bbdb-phone-string phone))
        shortnumber)

    ;; cut off the extension
    (if (string-match "x[0-9]+$" number)
        (setq number (substring number 0 (match-beginning 0))))

    (unless force-area-code
      (let ((alist bbdb-dial-local-prefix-alist) prefix)
        (while (setq prefix (pop alist))
          (if (string-match (concat "^" (eval (car prefix) t)) number)
              (setq shortnumber (concat (cdr prefix)
                                        (substring number (match-end 0)))
                    alist nil)))))

    (if shortnumber
        (setq number shortnumber)

      ;; This is terrifically Americanized...
      ;; Leading 0 => local number (?)
      (if (and bbdb-dial-local-prefix
               (string-match "^0" number))
          (setq number (concat bbdb-dial-local-prefix number)))

      ;; Leading + => long distance/international number
      (if (and bbdb-dial-long-distance-prefix
               (string-match "^\\+" number))
          (setq number (concat bbdb-dial-long-distance-prefix " "
                               (substring number 1)))))

    (unless bbdb-silent
      (message "Dialing %s" number))
    (bbdb-dial-number number)))

;;; url interface

;;;###autoload
(defun bbdb-browse-url (records &optional which)
  "Brwose URLs stored in the `url' field of RECORDS.
Interactively, use BBDB prefix \
\\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.
Prefix WHICH specifies which URL in field `url' is used (starting from 0).
Default is the first URL."
  (interactive (list (bbdb-get-records "Visit (URL): ")
                     (and current-prefix-arg
                          (prefix-numeric-value current-prefix-arg))))
  (unless which (setq which 0))
  (dolist (record (bbdb-record-list records))
    (let ((url (bbdb-record-xfield-split record 'url)))
      (when url
        (setq url (read-string "fetch: " (nth which url)))
        (unless (string= "" url)
          (browse-url url))))))

;;;###autoload
(defun bbdb-grab-url (record url)
  "Grab URL and store it in RECORD."
  (interactive (let ((url (browse-url-url-at-point)))
                 (unless url (error "No URL at point"))
                 (list (bbdb-completing-read-record
                        (format "Add `%s' for: " url))
                       url)))
  (bbdb-record-set-field record 'url url t)
  (bbdb-change-record record)
  (bbdb-display-records (list record)))

;;; Copy to kill ring

;;;###autoload
(defun bbdb-copy-records-as-kill (records)
  "Copy RECORDS to kill ring.
Interactively, use BBDB prefix \
\\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'."
  (interactive (list (bbdb-do-records t)))
  (let (drec)
    (dolist (record (bbdb-record-list records t))
      (push (buffer-substring (nth 2 record)
                              (or (nth 2 (car (cdr (memq record bbdb-records))))
                                  (point-max)))
            drec))
    (kill-new (replace-regexp-in-string
               "[ \t\n]*\\'" "\n"
               (mapconcat #'identity (nreverse drec) "")))))

;;;###autoload
(defun bbdb-copy-fields-as-kill (records field &optional num)
  "For RECORDS copy values of FIELD at point to kill ring.
If FIELD is an address or phone with a label, copy only field values
with the same label.  With numeric prefix NUM, if the value of FIELD
is a list, copy only the NUMth list element.
Interactively, use BBDB prefix \
\\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'."
  (interactive
   (list (bbdb-do-records t) (bbdb-current-field)
         (and current-prefix-arg
              (prefix-numeric-value current-prefix-arg))))
  (unless field (error "Not a field"))
  (let* ((type (if (eq (car field) 'xfields)
                   (car (nth 1 field))
                 (car field)))
         (label (if (memq type '(phone address))
                    (aref (cadr field) 0)))
	 (ident (and (< 1 (length records))
                     (not (eq type 'name))))
	 val-list)
    (dolist (record (bbdb-record-list records))
      (let ((raw-val (bbdb-record-field (car record) type))
            value)
        (if raw-val
            (cond ((eq type 'phone)
                   (dolist (elt raw-val)
                     (if (equal label (aref elt 0))
                         (push (bbdb-phone-string elt) value)))
                   (setq value (bbdb-concat 'phone (nreverse value))))
                  ((eq type 'address)
                   (dolist (elt raw-val)
                     (if (equal label (aref elt 0))
                         (push (bbdb-format-address
                                elt (if (eq (nth 1 record) 'one-line) 3 2))
                               value)))
                   (setq value (bbdb-concat 'address (nreverse value))))
                  ((consp raw-val)
                   (setq value (if num (nth num raw-val)
                                 (bbdb-concat type raw-val))))
                  (t (setq value raw-val))))
        (if value
            (push (if ident
                      (bbdb-concat 'name-field
                                   (bbdb-record-name (car record)) value)
                    value) val-list))))
    (let ((str (bbdb-concat 'record (nreverse val-list))))
      (kill-new str)
      (message "%s" str))))

;;; Help and documentation

;;;###autoload
(defun bbdb-info ()
  (interactive)
  (info (format "(%s)Top" (or bbdb-info-file "bbdb"))))

;;;###autoload
(defun bbdb-help ()
  (interactive)
  (message (substitute-command-keys "\\<bbdb-mode-map>\
new field: \\[bbdb-insert-field]; \
edit field: \\[bbdb-edit-field]; \
delete field: \\[bbdb-delete-field-or-record]; \
mode help: \\[describe-mode]; \
info: \\[bbdb-info]")))

(provide 'bbdb-com)

;;; bbdb-com.el ends here
bbdb-20200102.403/bbdb-snarf.el0000644000175000017500000004467713643253537013251 0ustar  cbcb;;; bbdb-snarf.el --- convert free-form text to BBDB records -*- lexical-binding: t -*-

;; Copyright (C) 2010-2017  Free Software Foundation, Inc.

;; This file is part of the Insidious Big Brother Database (aka BBDB),

;; BBDB 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.

;; BBDB 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 BBDB.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; The commands `bbdb-snarf', `bbdb-snarf-yank' and `bbdb-snarf-paragraph'
;; create BBDB records by picking the name, addresses, phones, etc.
;; out of a (buffer) string.  Things are recognized by context (e.g., URLs
;; start with http:// or www.).  See `bbdb-snarf-rule-alist' for details.
;;
;; The rule `eu' should work out of the box for many continental
;; European countries.  It can be further customized by defining
;; a suitable postcode regexp passed to `bbdb-snarf-address-eu'.
;; `mail' is a simple rule that can pick a single mail address from,
;; say, a long list of mail addresses in a message.
;;
;; RW: `bbdb-snarf' is an interesting proof of concept.  Yet I find
;; its snarfing algorithms often too simplistic to be useful in real life.
;; How can this possibly be improved?  Suggestions welcome.

;;; Code:

(require 'bbdb-com)

(defcustom bbdb-snarf-rule-alist
  '((us bbdb-snarf-surrounding-space
        bbdb-snarf-phone-nanp
        bbdb-snarf-url
        bbdb-snarf-mail
        bbdb-snarf-empty-lines
        bbdb-snarf-name
        bbdb-snarf-address-us
        bbdb-snarf-empty-lines
        bbdb-snarf-notes
        bbdb-snarf-name-mail) ; currently useless
    (eu bbdb-snarf-surrounding-space
        bbdb-snarf-phone-eu
        bbdb-snarf-url
        bbdb-snarf-mail
        bbdb-snarf-empty-lines
        bbdb-snarf-name
        bbdb-snarf-address-eu
        bbdb-snarf-empty-lines
        bbdb-snarf-notes
        bbdb-snarf-name-mail) ; currently useless
   (mail bbdb-snarf-mail-address))
  "Alist of rules for snarfing.
Each rule is of the form (KEY FUNCTION FUNCTION ...).
The symbol KEY identifies the rule, see also `bbdb-snarf-rule-default'.

Snarfing is a cumulative process.  The text is copied to a temporary
snarf buffer that becomes current during snarfing.
Each FUNCTION is called with one arg, the RECORD we are snarfing,
and with point at the beginning of the snarf buffer.  FUNCTION should populate
the fields of RECORD.  It may delete the part of the snarf buffer
that it has processed so that the remaining FUNCTIONs operate only
on those parts that were not yet snarfed.  The order of the FUNCTION calls
in a rule is then crucial.
Unlike other parts of BBDB, FUNCTIONs need not update the cache and
hash table for RECORD which is done at the end by `bbdb-snarf'."
  :group 'bbdb-utilities-snarf
  :type '(repeat (cons (symbol :tag "Key")
                       (repeat (function :tag "Snarf function")))))

(defcustom bbdb-snarf-rule-default 'us
  "Default rule for snarfing."
  :group 'bbdb-utilities-snarf
  :type 'symbol)

(defcustom bbdb-snarf-name-regexp
  "^[ \t'\"]*\\([- .,[:word:]]*[[:word:]]\\)"
  "Regexp matching a name.  Case is ignored.
The first subexpression becomes the name."
  :group 'bbdb-utilities-snarf
  :type 'regexp)

(defcustom bbdb-snarf-mail-regexp
  (concat "\\(?:\\(?:mailto:\\|e?mail:?\\)[ \t]*\\)?"
          "<?\\([^ \t\n<]+@[^ \t\n>]+\\)>?")
  "Regexp matching a mail address.  Case is ignored.
The first subexpression becomes the mail address."
  :group 'bbdb-utilities-snarf
  :type 'regexp)

(defcustom bbdb-snarf-phone-nanp-regexp
  (concat "\\(?:phone:?[ \t]*\\)?"
          "\\(\\(?:([2-9][0-9][0-9])[-. ]?\\|[2-9][0-9][0-9][-. ]\\)?"
          "[0-9][0-9][0-9][-. ][0-9][0-9][0-9][0-9]"
          "\\(?: *\\(?:x\\|ext\\.?\\) *[0-9]+\\)?\\)")
  "Regexp matching a NANP phone number.  Case is ignored.
NANP is the North American Numbering Plan used in North and Central America.
The first subexpression becomes the phone number."
  :group 'bbdb-utilities-snarf
  :type 'regexp)

(defcustom bbdb-snarf-phone-eu-regexp
  (concat "\\(?:phone?:?[ \t]*\\)?"
          "\\(\\(?:\\+[1-9]\\|(\\)[-0-9()\s]+\\)")
  "Regexp matching a European phone number.
The first subexpression becomes the phone number."
  :group 'bbdb-utilities-snarf
  :type 'regexp)

(defcustom bbdb-snarf-postcode-us-regexp
  ;; US postcode appears at end of line
  (concat "\\(\\<[0-9][0-9][0-9][0-9][0-9]"
          "\\(-[0-9][0-9][0-9][0-9]\\)?"
          "\\>\\)$")
  "Regexp matching US postcodes.
The first subexpression becomes the postcode."
  :group 'bbdb-utilities-snarf
  :type 'regexp)

(defcustom bbdb-snarf-address-us-country nil
  "Country to use for US addresses.  If nil leave country blank."
  :group 'bbdb-utilities-snarf
  :type '(choice (const :tag "Leave blank" nil)
                 (string :tag "Country")))

(defcustom bbdb-snarf-postcode-eu-regexp
  "^\\([0-9][0-9][0-9][0-9][0-9]?\\)" ; four or five digits
  "Regexp matching many European postcodes.
`bbdb-snarf-address-eu' assumes that the address appears at the beginning
of a line followed by the name of the city."
  :group 'bbdb-utilities-snarf
  :type 'regexp)

(defcustom bbdb-snarf-address-eu-country nil
  "Country to use for EU addresses.  If nil leave country blank."
  :group 'bbdb-utilities-snarf
  :type '(choice (const :tag "Leave blank" nil)
                 (string :tag "Country")))

(defcustom bbdb-snarf-default-label-alist
  '((phone . "work") (address . "work"))
  "Default labels for snarfing.
This is an alist where each element is a cons pair (FIELD . LABEL).
The symbol FIELD denotes a record field like `phone' or `address'.
The string LABEL denotes the default label for FIELD."
  :group 'bbdb-utilities-snarf
  :type '(repeat (cons (symbol :tag "Field")
                       (string :tag "Label"))))

(defcustom bbdb-snarf-url 'url
  "What xfield BBDB should use for URLs, or nil to not snarf URLs."
  :group 'bbdb-utilities-snarf
  :type 'symbol)

(defcustom bbdb-snarf-url-regexp "\\(\\(?:http://\\|www\\.\\)[^ \t\n]+\\)"
  "Regexp matching a URL.  Case is ignored.
The first subexpression becomes the URL."
  :group 'bbdb-utilities-snarf
  :type 'regexp)

(defun bbdb-snarf-surrounding-space (_record)
  "Discard beginning and trailing space when snarfing RECORD."
  (while (re-search-forward "^[ \t]+" nil t)
    (replace-match ""))
  (goto-char (point-min))
  (while (re-search-forward "\\s-+$" nil t)
    (replace-match "")))

(defun bbdb-snarf-empty-lines (_record)
  "Discard empty lines when snarfing RECORD."
  (while (re-search-forward "^[ \t]*\n" nil t)
    (replace-match "")))

(defun bbdb-snarf-name (record)
  "Snarf name for RECORD."
  (if (and (not (bbdb-record-lastname record))
           (let ((case-fold-search t))
             (re-search-forward bbdb-snarf-name-regexp nil t)))
      (let ((name (match-string 1)))
        (replace-match "")
        (setq name (bbdb-divide-name name))
        (bbdb-record-set-firstname record (car name))
        (bbdb-record-set-lastname record (cdr name)))))

(defun bbdb-snarf-name-mail (record)
  "Snarf name from mail address for RECORD."
  ;; Fixme: This is currently useless because `bbdb-snarf-mail-regexp'
  ;; cannot handle names in RFC 5322-like addresses "John Smith <foo@bar.com>".
  (let ((name (bbdb-record-lastname record)))
    (when (and (not name)
               (bbdb-record-mail record)
               (setq name (car (bbdb-extract-address-components
                                (car (bbdb-record-mail record)))))
               (setq name (bbdb-divide-name name)))
      (bbdb-record-set-firstname record (car name))
      (bbdb-record-set-lastname record (cadr name)))))

(defun bbdb-snarf-mail-address (record)
  "Snarf name and mail address for RECORD."
  ;; The voodoo of `mail-extract-address-components' makes
  ;; the following quite powerful.  If this function is used as part of
  ;; a more complex rule, the buffer should be narrowed appropriately.
  (let* ((data (bbdb-extract-address-components (buffer-string)))
         (name (and (car data) (bbdb-divide-name (car data)))))
    (bbdb-record-set-firstname record (car name))
    (bbdb-record-set-lastname  record (cdr name))
    (bbdb-record-set-mail record (list (cadr data)))
    (delete-region (point-min) (point-max))))

(defun bbdb-snarf-mail (record)
  "Snarf mail addresses for RECORD.
This uses the first subexpresion of `bbdb-snarf-mail-regexp'."
  (let ((case-fold-search t) mails)
    (while (re-search-forward bbdb-snarf-mail-regexp nil t)
      (push (match-string 1) mails)
      (replace-match ""))
    (bbdb-record-set-mail record (nconc (bbdb-record-mail record) mails))))

(defun bbdb-snarf-label (field)
  "Extract the label before point, or return default label for FIELD."
  (save-match-data
    (if (looking-back "\\(?:^\\|[,:]\\)\\([^\n,:]+\\):[ \t]*"
                      (line-beginning-position))
        (prog1 (match-string 1)
          (delete-region (match-beginning 1) (match-end 0)))
      (cdr (assq field bbdb-snarf-default-label-alist)))))

(defun bbdb-snarf-phone-nanp (record)
  "Snarf NANP phone numbers for RECORD.
NANP is the North American Numbering Plan used in North and Central America.
This uses the first subexpresion of `bbdb-snarf-phone-nanp-regexp'."
  (let ((case-fold-search t) phones)
    (while (re-search-forward bbdb-snarf-phone-nanp-regexp nil t)
      (goto-char (match-beginning 0))
      (if (save-match-data
            (looking-back "[0-9A-Z]" nil)) ;; not really an NANP phone number
          (goto-char (match-end 0))
        (push (vconcat (list (bbdb-snarf-label 'phone))
                       (save-match-data
                         (bbdb-parse-phone (match-string 1))))
              phones)
        (replace-match "")))
    (bbdb-record-set-phone record (nconc (bbdb-record-phone record)
                                         (nreverse phones)))))

(defun bbdb-snarf-phone-eu (record &optional phone-regexp)
  "Snarf European phone numbers for RECORD.
PHONE-REGEXP is the regexp to match a phone number.
It defaults to `bbdb-snarf-phone-eu-regexp'."
  (let ((case-fold-search t) phones)
    (while (re-search-forward (or phone-regexp
                                  bbdb-snarf-phone-eu-regexp) nil t)
      (goto-char (match-beginning 0))
      (push (vector (bbdb-snarf-label 'phone)
                    (match-string 1))
            phones)
      (replace-match ""))
    (bbdb-record-set-phone record (nconc (bbdb-record-phone record)
                                         (nreverse phones)))))

(defun bbdb-snarf-streets (address)
  "Snarf streets for ADDRESS.  This assumes a narrowed region."
  (bbdb-address-set-streets address (bbdb-split "\n" (buffer-string)))
  (delete-region (point-min) (point-max)))

(defun bbdb-snarf-address-us (record)
  "Snarf a US address for RECORD."
  (let ((address (make-vector bbdb-address-length nil)))
    (cond ((re-search-forward bbdb-snarf-postcode-us-regexp nil t)
           ;; Streets, City, State Postcode
           (save-restriction
             (narrow-to-region (point-min) (match-end 0))
             ;; Postcode
             (goto-char (match-beginning 0))
             (bbdb-address-set-postcode address
              (bbdb-parse-postcode (match-string 1)))
             ;; State
             (skip-chars-backward " \t")
             (let ((pos (point)))
               (skip-chars-backward "^ \t,")
               (bbdb-address-set-state address (buffer-substring (point) pos)))
             ;; City
             (skip-chars-backward " \t,")
             (let ((pos (point)))
               (beginning-of-line)
               (bbdb-address-set-city address (buffer-substring (point) pos)))
             ;; Toss it
             (forward-char -1)
             (delete-region (point) (point-max))
             ;; Streets
             (goto-char (point-min))
             (bbdb-snarf-streets address)))
          ;; Try for just Streets, City, State
          ((let (case-fold-search)
             (re-search-forward "^\\(.*\\), \\([A-Z][A-Za-z]\\)$" nil t))
           (bbdb-address-set-city address (match-string 1))
           (bbdb-address-set-state address (match-string 2))
           (replace-match "")
           (save-restriction
             (narrow-to-region (point-min) (match-beginning 0))
             (goto-char (point-min))
             (bbdb-snarf-streets address))))
    (when (bbdb-address-city address)
      (if bbdb-snarf-address-us-country
          (bbdb-address-set-country address bbdb-snarf-address-us-country))
      ;; Fixme: There are no labels anymore.  `bbdb-snarf-streets' snarfed
      ;; everything that was left!
      (bbdb-address-set-label address (bbdb-snarf-label 'address))
      (bbdb-record-set-address record
                               (nconc (bbdb-record-address record)
                                      (list address))))))

(defun bbdb-snarf-address-eu (record &optional postcode-regexp country)
  "Snarf a European address for RECORD.
POSTCODE-REGEXP is a regexp matching the postcode assumed to appear
at the beginning of a line followed by the name of the city.  This format
is used in many continental European countries.
POSTCODE-REGEXP defaults to `bbdb-snarf-postcode-eu-regexp'.
COUNTRY is the country to use.  It defaults to `bbdb-snarf-address-eu-country'."
  (when (re-search-forward (or postcode-regexp
                               bbdb-snarf-postcode-eu-regexp) nil t)
    (let ((address (make-vector bbdb-address-length nil)))
      (save-restriction
        (goto-char (match-end 0))
        (narrow-to-region (point-min) (line-end-position))
        ;; Postcode
        (bbdb-address-set-postcode address (match-string 1))
        ;; City
        (skip-chars-forward " \t")
        (bbdb-address-set-city address (buffer-substring (point) (point-max)))
        ;; Toss it
        (delete-region (match-beginning 0) (point-max))
        ;; Streets
        (goto-char (point-min))
        (bbdb-snarf-streets address))
      (unless country (setq country bbdb-snarf-address-eu-country))
      (if country (bbdb-address-set-country address country))
      (bbdb-address-set-label address (bbdb-snarf-label 'address))
      (bbdb-record-set-address record
                               (nconc (bbdb-record-address record)
                                      (list address))))))

(defun bbdb-snarf-url (record)
  "Snarf URL for RECORD.
This uses the first subexpresion of `bbdb-snarf-url-regexp'."
  (when (and bbdb-snarf-url
             (let ((case-fold-search t))
               (re-search-forward bbdb-snarf-url-regexp nil t)))
    (bbdb-record-set-xfields
     record
     (nconc (bbdb-record-xfields record)
            (list (cons bbdb-snarf-url (match-string 1)))))
    (replace-match "")))

(defun bbdb-snarf-notes (record)
  "Snarf notes for RECORD."
  (when (/= (point-min) (point-max))
    (bbdb-record-set-xfields
     record
     (nconc (bbdb-record-xfields record)
            (list (cons bbdb-default-xfield (buffer-string)))))
    (erase-buffer)))

(defsubst bbdb-snarf-rule-interactive ()
  "Read snarf rule interactively."
  (intern
   (completing-read
    (format "Rule: (default `%s') " bbdb-snarf-rule-default)
    bbdb-snarf-rule-alist nil t nil nil
    (symbol-name bbdb-snarf-rule-default))))

;;;###autoload
(defun bbdb-snarf-paragraph (pos &optional rule)
  "Snarf BBDB record from paragraph around position POS using RULE.
The paragraph is the one that contains POS or follows POS.
Interactively POS is the position of point.
RULE defaults to `bbdb-snarf-rule-default'.
See `bbdb-snarf-rule-alist' for details."
  (interactive (list (point) (bbdb-snarf-rule-interactive)))
  (bbdb-snarf (save-excursion
                (goto-char pos)
                ;; similar to `mark-paragraph'
                (let ((end (progn (forward-paragraph 1) (point))))
                  (buffer-substring-no-properties
                   (progn (backward-paragraph 1) (point))
                   end)))
              rule))

;;;###autoload
(defun bbdb-snarf-yank (&optional rule)
  "Snarf a BBDB record from latest kill using RULE.
The latest kill may also be a window system selection, see `current-kill'.
RULE defaults to `bbdb-snarf-rule-default'.
See `bbdb-snarf-rule-alist' for details."
  (interactive (list (bbdb-snarf-rule-interactive)))
  (bbdb-snarf (current-kill 0) rule))

;;;###autoload
(defun bbdb-snarf (string &optional rule)
  "Snarf a BBDB record in STRING using RULE.  Display and return this record.
Interactively, STRING is the current region.
RULE defaults to `bbdb-snarf-rule-default'.
See `bbdb-snarf-rule-alist' for details."
  (interactive
   (list (buffer-substring-no-properties (region-beginning) (region-end))
         (bbdb-snarf-rule-interactive)))

  (bbdb-editable)
  (let ((record (bbdb-empty-record)))
    (with-current-buffer (get-buffer-create " *BBDB Snarf*")
      (erase-buffer)
      (insert (substring-no-properties string))
      (mapc (lambda (fun)
              (goto-char (point-min))
              (funcall fun record))
            (cdr (assq (or rule bbdb-snarf-rule-default)
                       bbdb-snarf-rule-alist))))
    (let ((old-record (car (bbdb-message-search
                            (bbdb-concat 'name-first-last
                                         (bbdb-record-firstname record)
                                         (bbdb-record-lastname record))
                            (car (bbdb-record-mail record))))))
      ;; Install RECORD after searching for OLD-RECORD
      (bbdb-change-record record)
      (if old-record (bbdb-merge-records old-record record)))
    (bbdb-display-records (list record))
    record))

;; Some test cases
;;
;; US:
;;
;; another test person
;; 1234 Gridley St.
;; Los Angeles, CA 91342
;; 555-1212
;; test@person.net
;; http://www.foo.bar/
;; other stuff about this person
;;
;; test person
;; 1234 Gridley St.
;; St. Los Angeles, CA 91342-1234
;; 555-1212
;; <test@person.net>
;;
;; x test person
;; 1234 Gridley St.
;; Los Angeles, California 91342-1234
;; work: 555-1212
;; home: 555-1213
;; test@person.net
;;
;; y test person
;; 1234 Gridley St.
;; Los Angeles, CA
;; 555-1212
;; test@person.net
;;
;; z test person
;; 555-1212
;; test@person.net
;;
;; EU:
;;
;; Maja Musterfrau
;; Strasse 15
;; 12345 Ort
;; +49 12345
;; phon: (110) 123 456
;; mobile: (123) 456 789
;; xxx.xxx@xxxx.xxx
;; http://www.xxx.xx
;; notes bla bla bla

(provide 'bbdb-snarf)

;;; bbdb-snarf.el ends here
bbdb-20200102.403/gpl.info0000644000175000017500000011114713643253540012343 0ustar  cbcbThis is gpl.info, produced by makeinfo version 6.5 from gpl.texi.

                        Version 3, 29 June 2007

     Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>

     Everyone is permitted to copy and distribute verbatim copies of this
     license document, but changing it is not allowed.

Preamble
========

The GNU General Public License is a free, copyleft license for software
and other kinds of works.

   The licenses for most software and other practical works are designed
to take away your freedom to share and change the works.  By contrast,
the GNU General Public License is intended to guarantee your freedom to
share and change all versions of a program--to make sure it remains free
software for all its users.  We, the Free Software Foundation, use the
GNU General Public License for most of our software; it applies also to
any other work released this way by its authors.  You can apply it to
your programs, too.

   When we speak of free software, we are referring to freedom, not
price.  Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
them if you wish), that you receive source code or can get it if you
want it, that you can change the software or use pieces of it in new
free programs, and that you know you can do these things.

   To protect your rights, we need to prevent others from denying you
these rights or asking you to surrender the rights.  Therefore, you have
certain responsibilities if you distribute copies of the software, or if
you modify it: responsibilities to respect the freedom of others.

   For example, if you distribute copies of such a program, whether
gratis or for a fee, you must pass on to the recipients the same
freedoms that you received.  You must make sure that they, too, receive
or can get the source code.  And you must show them these terms so they
know their rights.

   Developers that use the GNU GPL protect your rights with two steps:
(1) assert copyright on the software, and (2) offer you this License
giving you legal permission to copy, distribute and/or modify it.

   For the developers' and authors' protection, the GPL clearly explains
that there is no warranty for this free software.  For both users' and
authors' sake, the GPL requires that modified versions be marked as
changed, so that their problems will not be attributed erroneously to
authors of previous versions.

   Some devices are designed to deny users access to install or run
modified versions of the software inside them, although the manufacturer
can do so.  This is fundamentally incompatible with the aim of
protecting users' freedom to change the software.  The systematic
pattern of such abuse occurs in the area of products for individuals to
use, which is precisely where it is most unacceptable.  Therefore, we
have designed this version of the GPL to prohibit the practice for those
products.  If such problems arise substantially in other domains, we
stand ready to extend this provision to those domains in future versions
of the GPL, as needed to protect the freedom of users.

   Finally, every program is threatened constantly by software patents.
States should not allow patents to restrict development and use of
software on general-purpose computers, but in those that do, we wish to
avoid the special danger that patents applied to a free program could
make it effectively proprietary.  To prevent this, the GPL assures that
patents cannot be used to render the program non-free.

   The precise terms and conditions for copying, distribution and
modification follow.

TERMS AND CONDITIONS
====================

  0. Definitions.

     "This License" refers to version 3 of the GNU General Public
     License.

     "Copyright" also means copyright-like laws that apply to other
     kinds of works, such as semiconductor masks.

     "The Program" refers to any copyrightable work licensed under this
     License.  Each licensee is addressed as "you".  "Licensees" and
     "recipients" may be individuals or organizations.

     To "modify" a work means to copy from or adapt all or part of the
     work in a fashion requiring copyright permission, other than the
     making of an exact copy.  The resulting work is called a "modified
     version" of the earlier work or a work "based on" the earlier work.

     A "covered work" means either the unmodified Program or a work
     based on the Program.

     To "propagate" a work means to do anything with it that, without
     permission, would make you directly or secondarily liable for
     infringement under applicable copyright law, except executing it on
     a computer or modifying a private copy.  Propagation includes
     copying, distribution (with or without modification), making
     available to the public, and in some countries other activities as
     well.

     To "convey" a work means any kind of propagation that enables other
     parties to make or receive copies.  Mere interaction with a user
     through a computer network, with no transfer of a copy, is not
     conveying.

     An interactive user interface displays "Appropriate Legal Notices"
     to the extent that it includes a convenient and prominently visible
     feature that (1) displays an appropriate copyright notice, and (2)
     tells the user that there is no warranty for the work (except to
     the extent that warranties are provided), that licensees may convey
     the work under this License, and how to view a copy of this
     License.  If the interface presents a list of user commands or
     options, such as a menu, a prominent item in the list meets this
     criterion.

  1. Source Code.

     The "source code" for a work means the preferred form of the work
     for making modifications to it.  "Object code" means any non-source
     form of a work.

     A "Standard Interface" means an interface that either is an
     official standard defined by a recognized standards body, or, in
     the case of interfaces specified for a particular programming
     language, one that is widely used among developers working in that
     language.

     The "System Libraries" of an executable work include anything,
     other than the work as a whole, that (a) is included in the normal
     form of packaging a Major Component, but which is not part of that
     Major Component, and (b) serves only to enable use of the work with
     that Major Component, or to implement a Standard Interface for
     which an implementation is available to the public in source code
     form.  A "Major Component", in this context, means a major
     essential component (kernel, window system, and so on) of the
     specific operating system (if any) on which the executable work
     runs, or a compiler used to produce the work, or an object code
     interpreter used to run it.

     The "Corresponding Source" for a work in object code form means all
     the source code needed to generate, install, and (for an executable
     work) run the object code and to modify the work, including scripts
     to control those activities.  However, it does not include the
     work's System Libraries, or general-purpose tools or generally
     available free programs which are used unmodified in performing
     those activities but which are not part of the work.  For example,
     Corresponding Source includes interface definition files associated
     with source files for the work, and the source code for shared
     libraries and dynamically linked subprograms that the work is
     specifically designed to require, such as by intimate data
     communication or control flow between those subprograms and other
     parts of the work.

     The Corresponding Source need not include anything that users can
     regenerate automatically from other parts of the Corresponding
     Source.

     The Corresponding Source for a work in source code form is that
     same work.

  2. Basic Permissions.

     All rights granted under this License are granted for the term of
     copyright on the Program, and are irrevocable provided the stated
     conditions are met.  This License explicitly affirms your unlimited
     permission to run the unmodified Program.  The output from running
     a covered work is covered by this License only if the output, given
     its content, constitutes a covered work.  This License acknowledges
     your rights of fair use or other equivalent, as provided by
     copyright law.

     You may make, run and propagate covered works that you do not
     convey, without conditions so long as your license otherwise
     remains in force.  You may convey covered works to others for the
     sole purpose of having them make modifications exclusively for you,
     or provide you with facilities for running those works, provided
     that you comply with the terms of this License in conveying all
     material for which you do not control copyright.  Those thus making
     or running the covered works for you must do so exclusively on your
     behalf, under your direction and control, on terms that prohibit
     them from making any copies of your copyrighted material outside
     their relationship with you.

     Conveying under any other circumstances is permitted solely under
     the conditions stated below.  Sublicensing is not allowed; section
     10 makes it unnecessary.

  3. Protecting Users' Legal Rights From Anti-Circumvention Law.

     No covered work shall be deemed part of an effective technological
     measure under any applicable law fulfilling obligations under
     article 11 of the WIPO copyright treaty adopted on 20 December
     1996, or similar laws prohibiting or restricting circumvention of
     such measures.

     When you convey a covered work, you waive any legal power to forbid
     circumvention of technological measures to the extent such
     circumvention is effected by exercising rights under this License
     with respect to the covered work, and you disclaim any intention to
     limit operation or modification of the work as a means of
     enforcing, against the work's users, your or third parties' legal
     rights to forbid circumvention of technological measures.

  4. Conveying Verbatim Copies.

     You may convey verbatim copies of the Program's source code as you
     receive it, in any medium, provided that you conspicuously and
     appropriately publish on each copy an appropriate copyright notice;
     keep intact all notices stating that this License and any
     non-permissive terms added in accord with section 7 apply to the
     code; keep intact all notices of the absence of any warranty; and
     give all recipients a copy of this License along with the Program.

     You may charge any price or no price for each copy that you convey,
     and you may offer support or warranty protection for a fee.

  5. Conveying Modified Source Versions.

     You may convey a work based on the Program, or the modifications to
     produce it from the Program, in the form of source code under the
     terms of section 4, provided that you also meet all of these
     conditions:

       a. The work must carry prominent notices stating that you
          modified it, and giving a relevant date.

       b. The work must carry prominent notices stating that it is
          released under this License and any conditions added under
          section 7.  This requirement modifies the requirement in
          section 4 to "keep intact all notices".

       c. You must license the entire work, as a whole, under this
          License to anyone who comes into possession of a copy.  This
          License will therefore apply, along with any applicable
          section 7 additional terms, to the whole of the work, and all
          its parts, regardless of how they are packaged.  This License
          gives no permission to license the work in any other way, but
          it does not invalidate such permission if you have separately
          received it.

       d. If the work has interactive user interfaces, each must display
          Appropriate Legal Notices; however, if the Program has
          interactive interfaces that do not display Appropriate Legal
          Notices, your work need not make them do so.

     A compilation of a covered work with other separate and independent
     works, which are not by their nature extensions of the covered
     work, and which are not combined with it such as to form a larger
     program, in or on a volume of a storage or distribution medium, is
     called an "aggregate" if the compilation and its resulting
     copyright are not used to limit the access or legal rights of the
     compilation's users beyond what the individual works permit.
     Inclusion of a covered work in an aggregate does not cause this
     License to apply to the other parts of the aggregate.

  6. Conveying Non-Source Forms.

     You may convey a covered work in object code form under the terms
     of sections 4 and 5, provided that you also convey the
     machine-readable Corresponding Source under the terms of this
     License, in one of these ways:

       a. Convey the object code in, or embodied in, a physical product
          (including a physical distribution medium), accompanied by the
          Corresponding Source fixed on a durable physical medium
          customarily used for software interchange.

       b. Convey the object code in, or embodied in, a physical product
          (including a physical distribution medium), accompanied by a
          written offer, valid for at least three years and valid for as
          long as you offer spare parts or customer support for that
          product model, to give anyone who possesses the object code
          either (1) a copy of the Corresponding Source for all the
          software in the product that is covered by this License, on a
          durable physical medium customarily used for software
          interchange, for a price no more than your reasonable cost of
          physically performing this conveying of source, or (2) access
          to copy the Corresponding Source from a network server at no
          charge.

       c. Convey individual copies of the object code with a copy of the
          written offer to provide the Corresponding Source.  This
          alternative is allowed only occasionally and noncommercially,
          and only if you received the object code with such an offer,
          in accord with subsection 6b.

       d. Convey the object code by offering access from a designated
          place (gratis or for a charge), and offer equivalent access to
          the Corresponding Source in the same way through the same
          place at no further charge.  You need not require recipients
          to copy the Corresponding Source along with the object code.
          If the place to copy the object code is a network server, the
          Corresponding Source may be on a different server (operated by
          you or a third party) that supports equivalent copying
          facilities, provided you maintain clear directions next to the
          object code saying where to find the Corresponding Source.
          Regardless of what server hosts the Corresponding Source, you
          remain obligated to ensure that it is available for as long as
          needed to satisfy these requirements.

       e. Convey the object code using peer-to-peer transmission,
          provided you inform other peers where the object code and
          Corresponding Source of the work are being offered to the
          general public at no charge under subsection 6d.

     A separable portion of the object code, whose source code is
     excluded from the Corresponding Source as a System Library, need
     not be included in conveying the object code work.

     A "User Product" is either (1) a "consumer product", which means
     any tangible personal property which is normally used for personal,
     family, or household purposes, or (2) anything designed or sold for
     incorporation into a dwelling.  In determining whether a product is
     a consumer product, doubtful cases shall be resolved in favor of
     coverage.  For a particular product received by a particular user,
     "normally used" refers to a typical or common use of that class of
     product, regardless of the status of the particular user or of the
     way in which the particular user actually uses, or expects or is
     expected to use, the product.  A product is a consumer product
     regardless of whether the product has substantial commercial,
     industrial or non-consumer uses, unless such uses represent the
     only significant mode of use of the product.

     "Installation Information" for a User Product means any methods,
     procedures, authorization keys, or other information required to
     install and execute modified versions of a covered work in that
     User Product from a modified version of its Corresponding Source.
     The information must suffice to ensure that the continued
     functioning of the modified object code is in no case prevented or
     interfered with solely because modification has been made.

     If you convey an object code work under this section in, or with,
     or specifically for use in, a User Product, and the conveying
     occurs as part of a transaction in which the right of possession
     and use of the User Product is transferred to the recipient in
     perpetuity or for a fixed term (regardless of how the transaction
     is characterized), the Corresponding Source conveyed under this
     section must be accompanied by the Installation Information.  But
     this requirement does not apply if neither you nor any third party
     retains the ability to install modified object code on the User
     Product (for example, the work has been installed in ROM).

     The requirement to provide Installation Information does not
     include a requirement to continue to provide support service,
     warranty, or updates for a work that has been modified or installed
     by the recipient, or for the User Product in which it has been
     modified or installed.  Access to a network may be denied when the
     modification itself materially and adversely affects the operation
     of the network or violates the rules and protocols for
     communication across the network.

     Corresponding Source conveyed, and Installation Information
     provided, in accord with this section must be in a format that is
     publicly documented (and with an implementation available to the
     public in source code form), and must require no special password
     or key for unpacking, reading or copying.

  7. Additional Terms.

     "Additional permissions" are terms that supplement the terms of
     this License by making exceptions from one or more of its
     conditions.  Additional permissions that are applicable to the
     entire Program shall be treated as though they were included in
     this License, to the extent that they are valid under applicable
     law.  If additional permissions apply only to part of the Program,
     that part may be used separately under those permissions, but the
     entire Program remains governed by this License without regard to
     the additional permissions.

     When you convey a copy of a covered work, you may at your option
     remove any additional permissions from that copy, or from any part
     of it.  (Additional permissions may be written to require their own
     removal in certain cases when you modify the work.)  You may place
     additional permissions on material, added by you to a covered work,
     for which you have or can give appropriate copyright permission.

     Notwithstanding any other provision of this License, for material
     you add to a covered work, you may (if authorized by the copyright
     holders of that material) supplement the terms of this License with
     terms:

       a. Disclaiming warranty or limiting liability differently from
          the terms of sections 15 and 16 of this License; or

       b. Requiring preservation of specified reasonable legal notices
          or author attributions in that material or in the Appropriate
          Legal Notices displayed by works containing it; or

       c. Prohibiting misrepresentation of the origin of that material,
          or requiring that modified versions of such material be marked
          in reasonable ways as different from the original version; or

       d. Limiting the use for publicity purposes of names of licensors
          or authors of the material; or

       e. Declining to grant rights under trademark law for use of some
          trade names, trademarks, or service marks; or

       f. Requiring indemnification of licensors and authors of that
          material by anyone who conveys the material (or modified
          versions of it) with contractual assumptions of liability to
          the recipient, for any liability that these contractual
          assumptions directly impose on those licensors and authors.

     All other non-permissive additional terms are considered "further
     restrictions" within the meaning of section 10.  If the Program as
     you received it, or any part of it, contains a notice stating that
     it is governed by this License along with a term that is a further
     restriction, you may remove that term.  If a license document
     contains a further restriction but permits relicensing or conveying
     under this License, you may add to a covered work material governed
     by the terms of that license document, provided that the further
     restriction does not survive such relicensing or conveying.

     If you add terms to a covered work in accord with this section, you
     must place, in the relevant source files, a statement of the
     additional terms that apply to those files, or a notice indicating
     where to find the applicable terms.

     Additional terms, permissive or non-permissive, may be stated in
     the form of a separately written license, or stated as exceptions;
     the above requirements apply either way.

  8. Termination.

     You may not propagate or modify a covered work except as expressly
     provided under this License.  Any attempt otherwise to propagate or
     modify it is void, and will automatically terminate your rights
     under this License (including any patent licenses granted under the
     third paragraph of section 11).

     However, if you cease all violation of this License, then your
     license from a particular copyright holder is reinstated (a)
     provisionally, unless and until the copyright holder explicitly and
     finally terminates your license, and (b) permanently, if the
     copyright holder fails to notify you of the violation by some
     reasonable means prior to 60 days after the cessation.

     Moreover, your license from a particular copyright holder is
     reinstated permanently if the copyright holder notifies you of the
     violation by some reasonable means, this is the first time you have
     received notice of violation of this License (for any work) from
     that copyright holder, and you cure the violation prior to 30 days
     after your receipt of the notice.

     Termination of your rights under this section does not terminate
     the licenses of parties who have received copies or rights from you
     under this License.  If your rights have been terminated and not
     permanently reinstated, you do not qualify to receive new licenses
     for the same material under section 10.

  9. Acceptance Not Required for Having Copies.

     You are not required to accept this License in order to receive or
     run a copy of the Program.  Ancillary propagation of a covered work
     occurring solely as a consequence of using peer-to-peer
     transmission to receive a copy likewise does not require
     acceptance.  However, nothing other than this License grants you
     permission to propagate or modify any covered work.  These actions
     infringe copyright if you do not accept this License.  Therefore,
     by modifying or propagating a covered work, you indicate your
     acceptance of this License to do so.

  10. Automatic Licensing of Downstream Recipients.

     Each time you convey a covered work, the recipient automatically
     receives a license from the original licensors, to run, modify and
     propagate that work, subject to this License.  You are not
     responsible for enforcing compliance by third parties with this
     License.

     An "entity transaction" is a transaction transferring control of an
     organization, or substantially all assets of one, or subdividing an
     organization, or merging organizations.  If propagation of a
     covered work results from an entity transaction, each party to that
     transaction who receives a copy of the work also receives whatever
     licenses to the work the party's predecessor in interest had or
     could give under the previous paragraph, plus a right to possession
     of the Corresponding Source of the work from the predecessor in
     interest, if the predecessor has it or can get it with reasonable
     efforts.

     You may not impose any further restrictions on the exercise of the
     rights granted or affirmed under this License.  For example, you
     may not impose a license fee, royalty, or other charge for exercise
     of rights granted under this License, and you may not initiate
     litigation (including a cross-claim or counterclaim in a lawsuit)
     alleging that any patent claim is infringed by making, using,
     selling, offering for sale, or importing the Program or any portion
     of it.

  11. Patents.

     A "contributor" is a copyright holder who authorizes use under this
     License of the Program or a work on which the Program is based.
     The work thus licensed is called the contributor's "contributor
     version".

     A contributor's "essential patent claims" are all patent claims
     owned or controlled by the contributor, whether already acquired or
     hereafter acquired, that would be infringed by some manner,
     permitted by this License, of making, using, or selling its
     contributor version, but do not include claims that would be
     infringed only as a consequence of further modification of the
     contributor version.  For purposes of this definition, "control"
     includes the right to grant patent sublicenses in a manner
     consistent with the requirements of this License.

     Each contributor grants you a non-exclusive, worldwide,
     royalty-free patent license under the contributor's essential
     patent claims, to make, use, sell, offer for sale, import and
     otherwise run, modify and propagate the contents of its contributor
     version.

     In the following three paragraphs, a "patent license" is any
     express agreement or commitment, however denominated, not to
     enforce a patent (such as an express permission to practice a
     patent or covenant not to sue for patent infringement).  To "grant"
     such a patent license to a party means to make such an agreement or
     commitment not to enforce a patent against the party.

     If you convey a covered work, knowingly relying on a patent
     license, and the Corresponding Source of the work is not available
     for anyone to copy, free of charge and under the terms of this
     License, through a publicly available network server or other
     readily accessible means, then you must either (1) cause the
     Corresponding Source to be so available, or (2) arrange to deprive
     yourself of the benefit of the patent license for this particular
     work, or (3) arrange, in a manner consistent with the requirements
     of this License, to extend the patent license to downstream
     recipients.  "Knowingly relying" means you have actual knowledge
     that, but for the patent license, your conveying the covered work
     in a country, or your recipient's use of the covered work in a
     country, would infringe one or more identifiable patents in that
     country that you have reason to believe are valid.

     If, pursuant to or in connection with a single transaction or
     arrangement, you convey, or propagate by procuring conveyance of, a
     covered work, and grant a patent license to some of the parties
     receiving the covered work authorizing them to use, propagate,
     modify or convey a specific copy of the covered work, then the
     patent license you grant is automatically extended to all
     recipients of the covered work and works based on it.

     A patent license is "discriminatory" if it does not include within
     the scope of its coverage, prohibits the exercise of, or is
     conditioned on the non-exercise of one or more of the rights that
     are specifically granted under this License.  You may not convey a
     covered work if you are a party to an arrangement with a third
     party that is in the business of distributing software, under which
     you make payment to the third party based on the extent of your
     activity of conveying the work, and under which the third party
     grants, to any of the parties who would receive the covered work
     from you, a discriminatory patent license (a) in connection with
     copies of the covered work conveyed by you (or copies made from
     those copies), or (b) primarily for and in connection with specific
     products or compilations that contain the covered work, unless you
     entered into that arrangement, or that patent license was granted,
     prior to 28 March 2007.

     Nothing in this License shall be construed as excluding or limiting
     any implied license or other defenses to infringement that may
     otherwise be available to you under applicable patent law.

  12. No Surrender of Others' Freedom.

     If conditions are imposed on you (whether by court order, agreement
     or otherwise) that contradict the conditions of this License, they
     do not excuse you from the conditions of this License.  If you
     cannot convey a covered work so as to satisfy simultaneously your
     obligations under this License and any other pertinent obligations,
     then as a consequence you may not convey it at all.  For example,
     if you agree to terms that obligate you to collect a royalty for
     further conveying from those to whom you convey the Program, the
     only way you could satisfy both those terms and this License would
     be to refrain entirely from conveying the Program.

  13. Use with the GNU Affero General Public License.

     Notwithstanding any other provision of this License, you have
     permission to link or combine any covered work with a work licensed
     under version 3 of the GNU Affero General Public License into a
     single combined work, and to convey the resulting work.  The terms
     of this License will continue to apply to the part which is the
     covered work, but the special requirements of the GNU Affero
     General Public License, section 13, concerning interaction through
     a network will apply to the combination as such.

  14. Revised Versions of this License.

     The Free Software Foundation may publish revised and/or new
     versions of the GNU General Public License from time to time.  Such
     new versions will be similar in spirit to the present version, but
     may differ in detail to address new problems or concerns.

     Each version is given a distinguishing version number.  If the
     Program specifies that a certain numbered version of the GNU
     General Public License "or any later version" applies to it, you
     have the option of following the terms and conditions either of
     that numbered version or of any later version published by the Free
     Software Foundation.  If the Program does not specify a version
     number of the GNU General Public License, you may choose any
     version ever published by the Free Software Foundation.

     If the Program specifies that a proxy can decide which future
     versions of the GNU General Public License can be used, that
     proxy's public statement of acceptance of a version permanently
     authorizes you to choose that version for the Program.

     Later license versions may give you additional or different
     permissions.  However, no additional obligations are imposed on any
     author or copyright holder as a result of your choosing to follow a
     later version.

  15. Disclaimer of Warranty.

     THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
     APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE
     COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS"
     WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED,
     INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
     MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE
     RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.
     SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
     NECESSARY SERVICING, REPAIR OR CORRECTION.

  16. Limitation of Liability.

     IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
     WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES
     AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR
     DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
     CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
     THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA
     BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
     PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
     PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF
     THE POSSIBILITY OF SUCH DAMAGES.

  17. Interpretation of Sections 15 and 16.

     If the disclaimer of warranty and limitation of liability provided
     above cannot be given local legal effect according to their terms,
     reviewing courts shall apply local law that most closely
     approximates an absolute waiver of all civil liability in
     connection with the Program, unless a warranty or assumption of
     liability accompanies a copy of the Program in return for a fee.

END OF TERMS AND CONDITIONS
===========================

How to Apply These Terms to Your New Programs
=============================================

If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.

   To do so, attach the following notices to the program.  It is safest
to attach them to the start of each source file to most effectively
state the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.

     ONE LINE TO GIVE THE PROGRAM'S NAME AND A BRIEF IDEA OF WHAT IT DOES.
     Copyright (C) YEAR NAME OF AUTHOR

     This program 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.

     This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.

   Also add information on how to contact you by electronic and paper
mail.

   If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:

     PROGRAM Copyright (C) YEAR NAME OF AUTHOR
     This program comes with ABSOLUTELY NO WARRANTY; for details type 'show w'.
     This is free software, and you are welcome to redistribute it
     under certain conditions; type 'show c' for details.

   The hypothetical commands 'show w' and 'show c' should show the
appropriate parts of the General Public License.  Of course, your
program's commands might be different; for a GUI interface, you would
use an "about box".

   You should also get your employer (if you work as a programmer) or
school, if any, to sign a "copyright disclaimer" for the program, if
necessary.  For more information on this, and how to apply and follow
the GNU GPL, see <http://www.gnu.org/licenses/>.

   The GNU General Public License does not permit incorporating your
program into proprietary programs.  If your program is a subroutine
library, you may consider it more useful to permit linking proprietary
applications with the library.  If this is what you want to do, use the
GNU Lesser General Public License instead of this License.  But first,
please read <http://www.gnu.org/philosophy/why-not-lgpl.html>.


Tag Table:

End Tag Table
bbdb-20200102.403/bbdb-mhe.el0000644000175000017500000000742013643253540012664 0ustar  cbcb;;; bbdb-mhe.el --- BBDB interface to mh-e  -*- lexical-binding: t -*-

;; Copyright (C) 2010-2017  Free Software Foundation, Inc.

;; This file is part of the Insidious Big Brother Database (aka BBDB),

;; BBDB 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.

;; BBDB 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 BBDB.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;; This file contains the BBDB interface to mh-e.
;;; See the BBDB info manual for documentation.

;;; Code:

(require 'bbdb)
(require 'bbdb-com)
(require 'bbdb-mua)
(require 'mh-e)
(if (fboundp 'mh-version)
    (require 'mh-comp))              ; For mh-e 4.x
(require 'advice)

;; A simplified `mail-fetch-field'.  We could use instead (like rmail):
;; (mail-header (intern-soft (downcase header)) (mail-header-extract))
;;;###autoload
(defun bbdb/mh-header (header)
  "Find and return the value of HEADER in the current buffer.
Returns the empty string if HEADER is not in the message."
  (let ((case-fold-search t))
    (goto-char (point-min))
    ;; This will be fooled if HEADER appears in the body of the message.
    ;; Also, it fails if HEADER appears more than once.
    (cond ((not (re-search-forward header nil t)) "")
          ((looking-at "[\t ]*$") "")
          (t (re-search-forward "[ \t]*\\([^ \t\n].*\\)$" nil t)
           (let ((start (match-beginning 1)))
             (while (progn (forward-line 1)
                           (looking-at "[ \t]")))
             (backward-char 1)
             (buffer-substring-no-properties start (point)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Use BBDB for interactive spec of MH-E commands

(defadvice mh-send (before mh-bbdb-send act)
  (interactive
   (list (bbdb-completing-read-mails "To: ")
         (bbdb-completing-read-mails "Cc: ")
         (read-string "Subject: "))))

(defadvice mh-send-other-window (before mh-bbdb-send-other act)
  (interactive
   (list (bbdb-completing-read-mails "To: ")
         (bbdb-completing-read-mails "Cc: ")
         (read-string "Subject: "))))

(defadvice mh-forward (before mh-bbdb-forward act)
  (interactive
   (list (bbdb-completing-read-mails "To: ")
         (bbdb-completing-read-mails "Cc: ")
         (if current-prefix-arg
             (mh-read-seq-default "Forward" t)
           (mh-get-msg-num t)))))

(defadvice mh-redistribute (before mh-bbdb-redist act)
  (interactive
   (list (bbdb-completing-read-mails "Redist-To: ")
         (bbdb-completing-read-mails "Redist-Cc: ")
         (mh-get-msg-num t))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;###autoload
(defun bbdb-insinuate-mh ()
  "Call this function to hook BBDB into MH-E.
Do not call this in your init file.  Use `bbdb-initialize'."
  (define-key mh-folder-mode-map ":" 'bbdb-mua-display-sender)
  (define-key mh-folder-mode-map ";" 'bbdb-mua-edit-field-sender)
  ;; Do we need keybindings for more commands?  Suggestions welcome.
  ;; (define-key mh-folder-mode-map ":" 'bbdb-mua-display-records)
  ;; (define-key mh-folder-mode-map "'" 'bbdb-mua-display-recipients)
  ;; (define-key mh-folder-mode-map ";" 'bbdb-mua-edit-field-recipients)
  (when bbdb-complete-mail
      (define-key mh-letter-mode-map "\M-;" 'bbdb-complete-mail)
      (define-key mh-letter-mode-map "\e\t" 'bbdb-complete-mail)))

(provide 'bbdb-mhe)

;;; bbdb-mhe.el ends here
bbdb-20200102.403/bbdb-mua.el0000644000175000017500000014177413643253540012710 0ustar  cbcb;;; bbdb-mua.el --- various MUA functionality for BBDB -*- lexical-binding: t -*-

;; Copyright (C) 2010-2018  Free Software Foundation, Inc.

;; This file is part of the Insidious Big Brother Database (aka BBDB),

;; BBDB 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.

;; BBDB 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 BBDB.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;; This file provides various additional functionality for BBDB
;; See the BBDB info manual for documentation.

;; This file lets you do stuff like
;;
;; o  automatically add some string to some field(s) based on the
;;    contents of header fields of the current message
;; o  only automatically create records when certain header fields
;;    are matched
;; o  do not automatically create records when certain header fields
;;    are matched
;;
;; Read the docstrings; read the texinfo file.

;;; Code:

(require 'bbdb)
(require 'bbdb-com)

(eval-and-compile
  (autoload 'gnus-fetch-original-field "gnus-utils")
  (autoload 'gnus-summary-select-article "gnus-sum")
  (defvar gnus-article-buffer)

  (autoload 'bbdb/vm-header "bbdb-vm")
  (autoload 'vm-follow-summary-cursor "vm-motion")
  (autoload 'vm-select-folder-buffer "vm-macro")
  (autoload 'vm-check-for-killed-summary "vm-misc")
  (autoload 'vm-error-if-folder-empty "vm-misc")

  (autoload 'rmail-get-header "rmail")
  (defvar rmail-buffer)

  (autoload 'bbdb/mh-header "bbdb-mhe")
  (autoload 'mh-show "mh-show")
  (defvar mh-show-buffer)

  (defvar mu4e~view-buffer-name)

  (autoload 'bbdb/wl-header "bbdb-wl")

  (autoload 'message-field-value "message")
  (autoload 'mail-decode-encoded-word-string "mail-parse"))

(defconst bbdb-mua-mode-alist
  '((vm vm-mode vm-virtual-mode vm-summary-mode vm-presentation-mode)
    (gnus gnus-summary-mode gnus-article-mode gnus-tree-mode)
    (rmail rmail-mode rmail-summary-mode)
    (mh mhe-mode mhe-summary-mode mh-folder-mode)
    (mu4e mu4e-view-mode)  ; Tackle `mu4e-headers-mode' later
    (wl wl-summary-mode wl-draft-mode mime-view-mode)
    (message message-mode mu4e-compose-mode notmuch-message-mode)
    (mail mail-mode))
  "Alist of MUA modes supported by BBDB.
Each element is of the form (MUA MODE MODE ...), where MODEs are used by MUA.")

(defun bbdb-mua ()
  "For the current message return the MUA.
Return values include
  gnus      Newsreader Gnus
  rmail     Reading Mail in Emacs
  vm        Viewmail
  mh        Emacs interface to the MH mail system (aka MH-E)
  mu4e      Mu4e
  wl        Wanderlust
  message   Mail and News composition mode that goes with Gnus
  mail      Emacs Mail Mode."
  (let ((mm-alist bbdb-mua-mode-alist)
        elt mua)
    (while (setq elt (pop mm-alist))
      (if (memq major-mode (cdr elt))
          (setq mua (car elt)
                mm-alist nil)))
    (or mua (error "BBDB: MUA `%s' not supported" major-mode))))

;;;###autoload
(defun bbdb-message-header (header)
  "For the current message return the value of HEADER.
MIME encoded headers are decoded.  Return nil if HEADER does not exist."
  ;; RW: If HEADER was allowed to be a regexp and the content of multiple
  ;; matching headers was concatenated as in `message-field-value',
  ;; this would simplify the usage of `bbdb-accept-message-alist' and
  ;; `bbdb-ignore-message-alist'.
  ;; RW: If this function had a remember table, it could look up the value
  ;; of a header if we request the value of the same header multiple times.
  ;; (We would reset the remember table each time we move on to a new message.)
  (let* ((mua (bbdb-mua))
         (val (cond (;; It seems that `gnus-fetch-field' fetches decoded content of
                     ;; `gnus-visible-headers', ignoring `gnus-ignored-headers'.
                     ;; Here we use instead `gnus-fetch-original-field' that fetches
                     ;; the encoded content of `gnus-original-article-buffer'.
                     ;; Decoding makes this possibly a bit slower, but something like
                     ;; `bbdb-select-message' does not get fooled by an apparent
                     ;; absence of some headers.
                     ;; See http://permalink.gmane.org/gmane.emacs.gnus.general/78741
                     (eq mua 'gnus) (gnus-fetch-original-field header))
                    ((eq mua 'vm) (bbdb/vm-header header))
                    ((eq mua 'rmail)
                     (with-current-buffer rmail-buffer
                       (rmail-get-header header)))
                    ((eq mua 'mh) (bbdb/mh-header header))
                    ((eq mua 'mu4e) (message-field-value header))
                    ((eq mua 'wl) (bbdb/wl-header header))
                    ((memq mua '(message mail)) (message-field-value header))
                    (t (error "BBDB/%s: header function undefined" mua)))))
    (if val (mail-decode-encoded-word-string val))))

(defsubst bbdb-message-header-re (header regexp)
  "Return non-nil if REGEXP matches value of HEADER."
  (let ((val (bbdb-message-header header))
        (case-fold-search t)) ; RW: Is this what we want?
    (and val (string-match regexp val))))

;;; Update database

;;;###autoload
(defun bbdb-accept-message (&optional invert)
  "For use with variable `bbdb-mua-update-interactive-p' and friends.
Return the value of variable `bbdb-update-records-p' for messages matching
`bbdb-accept-message-alist'.  If INVERT is non-nil, accept messages
not matching `bbdb-ignore-message-alist'."
  (let ((rest (if invert bbdb-ignore-message-alist
                bbdb-accept-message-alist))
        done elt)
    (if (eq rest t)
        (setq done t)
      (while (and (setq elt (pop rest)) (not done))
        (dolist (header (if (stringp (car elt)) (list (car elt)) (car elt)))
          (if (bbdb-message-header-re header (cdr elt))
              (setq done t)))))
    (if invert (setq done (not done)))
    (if done bbdb-update-records-p)))

;;;###autoload
(defun bbdb-ignore-message (&optional invert)
  "For use with variable `bbdb-mua-update-interactive-p' and friends.
Return the value of variable `bbdb-update-records-p' for messages not matching
`bbdb-ignore-message-alist'.  If INVERT is non-nil, accept messages
matching `bbdb-accept-message-alist'."
  (bbdb-accept-message (not invert)))

;;;###autoload
(defun bbdb-select-message ()
  "For use with variable `bbdb-mua-update-interactive-p' and friends.
Return the value of variable `bbdb-update-records-p' for messages both matching
`bbdb-accept-message-alist' and not matching `bbdb-ignore-message-alist'."
  (and (bbdb-accept-message)
       (bbdb-ignore-message)))

(defun bbdb-get-address-components (&optional header-class ignore-address)
  "Extract mail addresses from a message.
Return list with elements (NAME EMAIL HEADER HEADER-CLASS MUA).
HEADER-CLASS is defined in `bbdb-message-headers'.  If HEADER-CLASS is nil,
use all classes in `bbdb-message-headers'.
If regexp IGNORE-ADDRESS matches NAME or EMAIL of an address, this address
is ignored. If IGNORE-ADDRESS is nil, use value of `bbdb-user-mail-address-re'."
  ;; We do not use `bbdb-message-all-addresses' here because only when we
  ;; have compared the addresses with the records in BBDB do we know which
  ;; address(es) are relevant for us.
  (let ((message-headers (if header-class
                             (list (assoc header-class bbdb-message-headers))
                           bbdb-message-headers))
        (mua (bbdb-mua))
        (ignore-address (or ignore-address bbdb-user-mail-address-re))
        address-list name mail mail-list content)
    (dolist (headers message-headers)
      (dolist (header (cdr headers))
        (when (setq content (bbdb-message-header header))
          ;; Always extract all addresses because we do not know yet which
          ;; address might match IGNORE-ADDRESS.
          (dolist (address (bbdb-extract-address-components content t))
            ;; We canonicalize name and mail as early as possible.
            (setq name (car address)
                  mail (cadr address))
            ;; ignore uninteresting addresses
            (unless (or (and (stringp ignore-address)
                             (or (and name (string-match ignore-address name))
                                 (and mail (string-match ignore-address mail))))
                        (and mail (member-ignore-case mail mail-list)))
              ;; Add each address only once. (Use MAIL-LIST for book keeping.)
              ;; Thus if we care about whether an address gets associated with
              ;; one or another header, the order of elements in
              ;; `bbdb-message-headers' is relevant.  The "most important"
              ;; headers should be first in `bbdb-message-headers'.
              (if mail (push mail mail-list))
              (push (list name mail header (car headers) mua) address-list))))))
    (or (nreverse address-list)
        (and header-class bbdb-message-try-all-headers
             ;; Try again the remaining header classes
             (let ((bbdb-message-headers
                    (remove (assoc header-class bbdb-message-headers)
                            bbdb-message-headers)))
               (bbdb-get-address-components nil ignore-address))))))

;;;###autoload
(defun bbdb-update-records (address-list &optional update-p sort)
  "Return the list of BBDB records matching ADDRESS-LIST.
ADDRESS-LIST is a list of mail addresses.  (It can be extracted from
a mail message using `bbdb-get-address-components'.)
UPDATE-P may take the following values:
 search       Search for existing records matching ADDRESS.
 update       Search for existing records matching ADDRESS;
                update name and mail field if necessary.
 query        Search for existing records matching ADDRESS;
                query for creation of a new record if the record does not exist.
 create or t  Search for existing records matching ADDRESS;
                create a new record if it does not yet exist.
 nil          Do nothing.
 a function   This functions will be called with no arguments.
                It should return one of the above values.

If SORT is non-nil, sort records according to `bbdb-record-lessp'.
Ottherwise, the records are ordered according to ADDRESS-LIST.

Usually this function is called by the wrapper `bbdb-mua-update-records'."
  ;; UPDATE-P allows filtering of complete messages.
  ;; Filtering of individual addresses within an accepted message
  ;; is done by `bbdb-get-address-components' using `bbdb-user-mail-address-re'.
  ;; We resolve UPDATE-P repeatedly.  This is needed, for example,
  ;; with the chain `bbdb-mua-auto-update-p' -> `bbdb-select-message'
  ;; -> `bbdb-update-records-p'.
  (while (and (functionp update-p)
              ;; Bad! `search' is a function in `cl-seq.el'.
              (not (eq update-p 'search)))
    (setq update-p (funcall update-p)))
  (cond ((eq t update-p)
         (setq update-p 'create))
        ((not (memq update-p '(search update query create nil)))
         (error "Illegal value of arg update-p: %s" update-p)))

  (let (;; `bbdb-update-records-p' and `bbdb-offer-to-create' are used here
        ;; as internal variables for communication with `bbdb-query-create'.
        ;; This does not affect the value of the global user variable
        ;; `bbdb-update-records-p'.
        (bbdb-offer-to-create 'start)
        (bbdb-update-records-p update-p)
        address records)

    (when update-p
      (while (setq address (pop address-list))
        (let* ((bbdb-update-records-address address)
               hits
               (task
                (catch 'done
                  (setq hits
                        ;; We put the call of `bbdb-notice-mail-hook'
                        ;; into `bbdb-annotate-message' so that this hook
                        ;; runs only if the user agreed to change a record.
                        (cond ((or bbdb-read-only
                                   (eq bbdb-update-records-p 'search))
                               ;; Search for records having this mail address
                               ;; but do not modify an existing record.
                               ;; This does not run `bbdb-notice-mail-hook'.
                               (bbdb-message-search (car address)
                                                    (cadr address)))
                              ((eq bbdb-update-records-p 'update)
                               (bbdb-annotate-message address 'update))
                              ((eq bbdb-update-records-p 'query)
                               (bbdb-annotate-message
                                address 'bbdb-query-create))
                              ((eq bbdb-update-records-p 'create)
                               (bbdb-annotate-message address 'create))))
                  nil)))
          (cond ((eq task 'quit)
                 (setq address-list nil))
                ((not (eq task 'next))
                 (dolist (hit (delq nil (nreverse hits)))
                   (bbdb-pushnew hit records))))
          (if (and records (not bbdb-message-all-addresses))
              (setq address-list nil))))
      (setq records
            (if sort (sort records 'bbdb-record-lessp)
              ;; Make RECORDS a list ordered like ADDRESS-LIST.
              (nreverse records))))

    ;; `bbdb-message-search' might yield multiple records
    (if (and records (not bbdb-message-all-addresses))
        (setq records (list (car records))))

    (unless bbdb-read-only
      (bbdb-editable)
      (dolist (record records)
        (run-hook-with-args 'bbdb-notice-record-hook record)))

    records))

(defun bbdb-query-create ()
  "Interactive query used by `bbdb-update-records'.
Return t if the record should be created or `nil' otherwise.
Honor previous answers such as `!'."
  (let ((task bbdb-offer-to-create))
    ;; If we have remembered what the user typed previously,
    ;; `bbdb-offer-to-create' holds a character, i.e., a number.
    ;; -- Right now, we only remember "!".
    (when (not (integerp task))
      (let ((prompt (format "%s is not in BBDB; add? (y,!,n,s,q,?) "
                            (or (nth 0 bbdb-update-records-address)
                                (nth 1 bbdb-update-records-address))))
            event)
        (while (not event)
          (setq event (read-key-sequence prompt))
          (setq event (if (stringp event) (aref event 0))))
        (setq task event)
        (message ""))) ; clear the message buffer

    (cond ((eq task ?y)
           t)
          ((eq task ?!)
           (setq bbdb-offer-to-create task)
           t)
          ((or (eq task ?n)
               (eq task ?\s))
           (throw 'done 'next))
          ((or (eq task ?q)
               (eq task ?\a)) ; ?\a = C-g
           (throw 'done 'quit))
          ((eq task ?s)
           (setq bbdb-update-records-p 'search)
           (throw 'done 'next))
          (t ; any other key sequence
           (save-window-excursion
             (let* ((buffer (get-buffer-create " *BBDB Help*"))
                    (window (or (get-buffer-window buffer)
                                (split-window (get-lru-window)))))
               (with-current-buffer buffer
                 (special-mode)
                 (let (buffer-read-only)
                   (erase-buffer)
                   (insert
                    "Your answer controls how BBDB updates/searches for records.

Type ?  for this help.
Type y  to add the current record.
Type !  to add all remaining records.
Type n  to skip the current record. (You might also type space)
Type s  to switch from annotate to search mode.
Type q  to quit updating records.  No more search or annotation is done.")
                   (set-buffer-modified-p nil)
                   (goto-char (point-min)))
                 (set-window-buffer window buffer)
                 (fit-window-to-buffer window)))
             ;; Try again!
             (bbdb-query-create))))))



(defun bbdb-annotate-message (address &optional update-p)
  "Fill the records for message ADDRESS with as much info as possible.
If a record for ADDRESS does not yet exist, UPDATE-P controls whether
a new record is created for ADDRESS.  UPDATE-P may take the values:
 update or nil  Update existing records, never create a new record.
 query          Query interactively whether to create a new record.
 create or t    Create a new record.
 a function     This functions will be called with no arguments.
                  It should return one of the above values.
Return the records matching ADDRESS or nil."
  (let* ((mail (nth 1 address)) ; possibly nil
         (name (unless (equal mail (car address))
                 (car address)))
         (records (bbdb-message-search name mail))
         created-p new-records)
    (if (and (not records) (functionp update-p))
        (setq update-p (funcall update-p)))
    (cond ((eq t update-p) (setq update-p 'create))
          ((not update-p) (setq update-p 'update)))

    ;; Create a new record if nothing else fits.
    ;; In this way, we can fill the slots of the new record with
    ;; the same code that updates the slots of existing records.
    (unless (or records
                (eq update-p 'update)
                (not (or name mail)))
      ;; If there is no name, try to use the mail address as name
      (if (and bbdb-message-mail-as-name mail
               (or (null name)
                   (string= "" name)))
          (setq name (funcall bbdb-message-clean-name-function mail)))
      (if (or (eq update-p 'create)
              (and (eq update-p 'query)
                   (y-or-n-p (format "%s is not in the BBDB.  Add? "
                                     (or name mail)))))
          (setq records (list (bbdb-empty-record))
                created-p t)))

    (dolist (record records)
      (let* ((old-name (bbdb-record-name record))
             (fullname (bbdb-divide-name (or name "")))
             (fname (car fullname))
             (lname (cdr fullname))
             (mail mail) ;; possibly changed below
             (created-p created-p)
             (update-p update-p)
             change-p add-mails add-name ignore-redundant)

        ;; Analyze the name part of the record.
        (cond ((or (not name)
                   ;; The following tests can differ for more complicated names
                   (bbdb-string= name old-name)
                   (and (equal fname (bbdb-record-firstname record)) ; possibly
                        (equal lname (bbdb-record-lastname record))) ; nil
                   (member-ignore-case name (bbdb-record-aka record)))) ; do nothing

              (created-p ; new record
               (bbdb-record-set-field record 'name (cons fname lname)))

              ((not (setq add-name (bbdb-add-job bbdb-add-name record name)))) ; do nothing

              ((numberp add-name)
               (unless bbdb-silent
                 (message "name mismatch: \"%s\" changed to \"%s\""
                          old-name name)
                 (sit-for add-name)))

              ((bbdb-eval-spec add-name
                               (if old-name
                                   (format "Change name \"%s\" to \"%s\"? "
                                           old-name name)
                                 (format "Assign name \"%s\" to address \"%s\"? "
                                         name (car (bbdb-record-mail record)))))
               ;; Keep old-name as AKA?
               (when (and old-name
                          (not (member-ignore-case old-name (bbdb-record-aka record))))
                 (if (bbdb-eval-spec (bbdb-add-job bbdb-add-aka record old-name)
                                     (format "Keep name \"%s\" as an AKA? " old-name))
                     (bbdb-record-set-field
                      record 'aka (cons old-name (bbdb-record-aka record)))
                   (bbdb-remhash old-name record)))
               (bbdb-record-set-field record 'name (cons fname lname))
               (setq change-p 'name))

              ;; make new name an AKA?
              ((and old-name
                    (not (member-ignore-case name (bbdb-record-aka record)))
                    (bbdb-eval-spec (bbdb-add-job bbdb-add-aka record name)
                                    (format "Make \"%s\" an alternate for \"%s\"? "
                                            name old-name)))
               (bbdb-record-set-field
                record 'aka (cons name (bbdb-record-aka record)))
               (setq change-p 'name)))

        ;; Is MAIL redundant compared with the mail addresses
        ;; that are already known for RECORD?
        (if (and mail
                 (setq ignore-redundant
                       (bbdb-add-job bbdb-ignore-redundant-mails record mail)))
            (let ((mails (bbdb-record-mail-canon record))
                  (case-fold-search t) redundant ml re)
              (while (setq ml (pop mails))
                (if (and (setq re (bbdb-mail-redundant-re ml))
                         (string-match re mail))
                    (setq redundant ml mails nil)))
              (if redundant
                  (cond ((numberp ignore-redundant)
                         (unless bbdb-silent
                           (message "%s: redundant mail `%s'"
                                    (bbdb-record-name record) mail)
                           (sit-for ignore-redundant)))
                        ((or (eq t ignore-redundant)
                             bbdb-silent
                             (y-or-n-p (format "Ignore redundant mail %s?" mail)))
                         (setq mail redundant))))))

        ;; Analyze the mail part of the new records
        (cond ((or (not mail) (equal mail "???")
                   (member-ignore-case mail (bbdb-record-mail-canon record)))) ; do nothing

              (created-p ; new record
               (bbdb-record-set-field record 'mail (list mail)))

              ((not (setq add-mails (bbdb-add-job bbdb-add-mails record mail)))) ; do nothing

              ((numberp add-mails)
               (unless bbdb-silent
                 (message "%s: new address `%s'"
                          (bbdb-record-name record) mail)
                 (sit-for add-mails)))

              ((or (eq add-mails t) ; add it automatically
                   bbdb-silent
                   (y-or-n-p (format "Add address \"%s\" to %s? " mail
                                     (bbdb-record-name record)))
                   (and (or (and (functionp update-p)
                                 (progn (setq update-p (funcall update-p)) nil))
                            (memq update-p '(t create))
                            (and (eq update-p 'query)
                                 (y-or-n-p
                                  (format "Create a new record for %s? "
                                          (bbdb-record-name record)))))
                        (progn
                          (setq record (bbdb-empty-record))
                          (bbdb-record-set-name record fname lname)
                          (setq created-p t))))

               (let ((mails (bbdb-record-mail record)))
                 (if ignore-redundant
                     ;; Does the new address MAIL make an old address redundant?
                     (let ((mail-re (bbdb-mail-redundant-re mail))
                           (case-fold-search t) okay redundant)
                       (dolist (ml mails)
                         (if (string-match mail-re ml) ; redundant mail address
                             (push ml redundant)
                           (push ml okay)))
                       (let ((form (format "redundant mail%s %s"
                                           (if (< 1 (length redundant)) "s" "")
                                           (bbdb-concat 'mail (nreverse redundant))))
                             (name (bbdb-record-name record)))
                         (if redundant
                             (cond ((numberp ignore-redundant)
                                    (unless bbdb-silent
                                      (message "%s: %s" name form)
                                      (sit-for ignore-redundant)))
                                   ((or (eq t ignore-redundant)
                                        bbdb-silent
                                        (y-or-n-p (format "Delete %s: " form)))
                                    (if (eq t ignore-redundant)
                                        (message "%s: deleting %s" name form))
                                    (setq mails okay)))))))

                 ;; then modify RECORD
                 (bbdb-record-set-field
                  record 'mail
                  (if (and mails
                           (bbdb-eval-spec (bbdb-add-job bbdb-new-mails-primary
                                                         record mail)
                                           (format "Make \"%s\" the primary address? " mail)))
                      (cons mail mails)
                    (nconc mails (list mail))))
                 (unless change-p (setq change-p t)))))

        (cond (created-p
               (unless bbdb-silent
                 (if (bbdb-record-name record)
                     (message "created %s's record with address \"%s\""
                              (bbdb-record-name record) mail)
                   (message "created record with naked address \"%s\"" mail)))
               (bbdb-change-record record))

              (change-p
               (unless bbdb-silent
                 (cond ((eq change-p 'name)
                        (message "noticed \"%s\"" (bbdb-record-name record)))
                       ((bbdb-record-name record)
                        (message "noticed %s's address \"%s\""
                                 (bbdb-record-name record) mail))
                       (t
                        (message "noticed naked address \"%s\"" mail))))
               (bbdb-change-record record)))

        (run-hook-with-args 'bbdb-notice-mail-hook record)
        (push record new-records)))

    (nreverse new-records)))

(defun bbdb-mua-update-records (&optional header-class update-p sort)
  "Wrapper for `bbdb-update-records'.
HEADER-CLASS is defined in `bbdb-message-headers'.  If it is nil,
use all classes in `bbdb-message-headers'.
UPDATE-P is defined in `bbdb-update-records'.
If SORT is non-nil, sort records according to `bbdb-record-lessp'."
  (let ((mua (bbdb-mua)))
    (save-current-buffer
      (cond ;; VM
       ((eq mua 'vm)
        (vm-select-folder-buffer)
        (vm-check-for-killed-summary)
        (vm-error-if-folder-empty)
        (let ((enable-local-variables t))  ; ...or vm bind this to nil.
          (bbdb-update-records (bbdb-get-address-components header-class)
                               update-p sort)))
       ;; Gnus
       ((eq mua 'gnus)
        (set-buffer gnus-article-buffer)
        (bbdb-update-records (bbdb-get-address-components header-class)
                             update-p sort))
       ;; MH-E
       ((eq mua 'mh)
        (if mh-show-buffer (set-buffer mh-show-buffer))
        (bbdb-update-records (bbdb-get-address-components header-class)
                             update-p sort))
       ;; Rmail
       ((eq mua 'rmail)
        (set-buffer rmail-buffer)
        (bbdb-update-records (bbdb-get-address-components header-class)
                             update-p sort))
       ;; mu4e
       ((eq mua 'mu4e)
        (set-buffer mu4e~view-buffer-name)
        (bbdb-update-records (bbdb-get-address-components header-class)
                             update-p sort))
       ;; Wanderlust
       ((eq mua 'wl)
        (bbdb-update-records (bbdb-get-address-components header-class)
                             update-p sort))
      ;; Message and Mail
       ((memq mua '(message mail))
        (bbdb-update-records (bbdb-get-address-components header-class)
                             update-p sort))))))

(defmacro bbdb-mua-wrapper (&rest body)
  "Perform BODY in a MUA buffer."
  (declare (debug t))
  `(let ((mua (bbdb-mua)))
     ;; Here we replicate BODY multiple times which gets clumsy
     ;; for a larger BODY!
     (cond ((eq mua 'gnus)
            ;; This fails in *Article* buffers, where
            ;; `gnus-article-read-summary-keys' provides an additional wrapper
            (save-current-buffer
              (gnus-summary-select-article) ; sets buffer `gnus-summary-buffer'
              ,@body))
           ((memq mua '(mail message rmail mh vm mu4e wl))
            (cond ((eq mua 'vm) (vm-follow-summary-cursor))
                  ((eq mua 'mh) (mh-show)))
            ;; rmail, mail, message, mu4e and wl do not require any wrapper
            ,@body))))

(defun bbdb-mua-update-interactive-p ()
  "Interactive spec for arg UPDATE-P of `bbdb-mua-display-records' and friends.
If these commands are called without a prefix, the value of their arg
UPDATE-P is the car of the variable `bbdb-mua-update-interactive-p'.
Called with a prefix, the value of UPDATE-P is the cdr of this variable."
  (let ((update-p (if current-prefix-arg
                      (cdr bbdb-mua-update-interactive-p)
                    (car bbdb-mua-update-interactive-p))))
    (if (eq update-p 'read)
        (let ((str (completing-read "Action: " '((query) (search) (create))
                                    nil t)))
          (unless (string= "" str) (intern str))) ; nil otherwise
      update-p)))

(defun bbdb-mua-window-p ()
  "Return lambda function matching the MUA window.
This return value can be used as arg HORIZ-P of `bbdb-display-records'."
  (let ((mm-alist bbdb-mua-mode-alist)
        elt fun)
    (while (setq elt (cdr (pop mm-alist)))
      (if (memq major-mode elt)
          (setq fun `(lambda (window)
                       (with-current-buffer (window-buffer window)
                         (memq major-mode ',elt)))
                mm-alist nil)))
    fun))

;;;###autoload
(defun bbdb-mua-display-records (&optional header-class update-p all)
  "Display the BBDB record(s) for the addresses in this message.
This looks into the headers of a message according to HEADER-CLASS.
Then for the mail addresses found the corresponding BBDB records are displayed.
UPDATE-P determines whether only existing BBDB records are displayed
or whether also new records are created for these mail addresses.

HEADER-CLASS is defined in `bbdb-message-headers'.  If it is nil,
use all classes in `bbdb-message-headers'.
UPDATE-P may take the same values as `bbdb-update-records-p'.
For interactive calls, see function `bbdb-mua-update-interactive-p'.
If ALL is non-nil, bind `bbdb-message-all-addresses' to ALL."
  (interactive (list nil (bbdb-mua-update-interactive-p)))
  (let ((bbdb-pop-up-window-size bbdb-mua-pop-up-window-size)
        (bbdb-message-all-addresses (or all bbdb-message-all-addresses))
        records)
    (bbdb-mua-wrapper
     (setq records (bbdb-mua-update-records header-class update-p t)))
    (if records (bbdb-display-records records nil nil nil (bbdb-mua-window-p)))
    records))

;; The following commands are some frontends for `bbdb-mua-display-records',
;; which is always doing the real work.  In your init file, you can further
;; modify or adapt these simple commands to your liking.

;;;###autoload
(defun bbdb-mua-display-sender (&optional update-p)
  "Display the BBDB record(s) for the sender of this message.
UPDATE-P may take the same values as `bbdb-update-records-p'.
For interactive calls, see function `bbdb-mua-update-interactive-p'."
  (interactive (list (bbdb-mua-update-interactive-p)))
  (bbdb-mua-display-records 'sender update-p))

;;;###autoload
(defun bbdb-mua-display-recipients (&optional update-p)
  "Display the BBDB record(s) for the recipients of this message.
UPDATE-P may take the same values as `bbdb-update-records-p'.
For interactive calls, see function `bbdb-mua-update-interactive-p'."
  (interactive (list (bbdb-mua-update-interactive-p)))
  (bbdb-mua-display-records 'recipients update-p))

;;;###autoload
(defun bbdb-mua-display-all-records (&optional update-p)
  "Display the BBDB record(s) for all addresses in this message.
UPDATE-P may take the same values as `bbdb-update-records-p'.
For interactive calls, see function `bbdb-mua-update-interactive-p'."
  (interactive (list (bbdb-mua-update-interactive-p)))
  (bbdb-mua-display-records nil update-p t))

;;;###autoload
(defun bbdb-mua-display-all-recipients (&optional update-p)
  "Display BBDB records for all recipients of this message.
UPDATE-P may take the same values as `bbdb-update-records-p'.
For interactive calls, see function `bbdb-mua-update-interactive-p'."
  (interactive (list (bbdb-mua-update-interactive-p)))
  (bbdb-mua-display-records 'recipients update-p t))

;; The commands `bbdb-annotate-record' and `bbdb-mua-edit-field'
;; have kind of similar goals, yet they use rather different strategies.
;; `bbdb-annotate-record' is less obtrusive.  It does not display
;; the records it operates on, nor does it display the content
;; of the field before or after adding or replacing the annotation.
;; Hence the user needs to know what she is doing.
;; `bbdb-mua-edit-field' is more explicit:  It displays the records
;; as well as the current content of the field that gets edited.

;; In principle, this function can be used not only with MUAs.
(defun bbdb-annotate-record (record annotation &optional field replace)
  "In RECORD add an ANNOTATION to field FIELD.
FIELD defaults to `bbdb-annotate-field'.
If REPLACE is non-nil, ANNOTATION replaces the content of FIELD.
If ANNOTATION is an empty string and REPLACE is non-nil, delete FIELD."
  (if (memq field '(name firstname lastname phone address xfields))
      (error "Field `%s' illegal" field))
  (setq annotation (bbdb-string-trim annotation))
  (cond ((memq field '(affix organization mail aka))
         (setq annotation (list annotation)))
        ((not field) (setq field bbdb-annotate-field)))
  (bbdb-record-set-field record field annotation (not replace))
  (bbdb-change-record record))

;; FIXME: For interactive calls of the following commands, the arg UPDATE-P
;; should have the same meaning as for `bbdb-mua-display-records',
;; that is, it should use `bbdb-mua-update-interactive-p'.
;; But here the prefix arg is already used in a different way.
;; We could possibly solve this problem if all `bbdb-mua-*' commands
;; used another prefix arg that is consistently used only for
;; `bbdb-mua-update-interactive-p'.
;; Yet this prefix arg must be defined within the key space of the MUA(s).
;; This results in lots of conflicts...
;;
;; Current workaround:
;; These commands use merely the car of `bbdb-mua-update-interactive-p'.
;; If one day someone proposes a smart solution to this problem (suggestions
;; welcome!), this solution will hopefully include the current workaround
;; as a subset of all its features.

(defun bbdb-mua-annotate-field-interactive ()
  "Interactive specification for `bbdb-mua-annotate-sender' and friends."
  (bbdb-editable)
  (let ((field (if (eq 'all-fields bbdb-annotate-field)
                   (intern (completing-read
                            "Field: "
                            (mapcar 'symbol-name
                                    (append '(affix organization mail aka)
                                            bbdb-xfield-label-list))))
                 bbdb-annotate-field)))
    (list (read-string (format "Annotate `%s': " field))
          field current-prefix-arg
          (car bbdb-mua-update-interactive-p))))

;;;###autoload
(defun bbdb-mua-annotate-sender (annotation &optional field replace update-p)
  "Add ANNOTATION to field FIELD of the BBDB record(s) of message sender(s).
FIELD defaults to `bbdb-annotate-field'.
If REPLACE is non-nil, ANNOTATION replaces the content of FIELD.
UPDATE-P may take the same values as `bbdb-update-records-p'.
For interactive calls, use car of `bbdb-mua-update-interactive-p'."
  (interactive (bbdb-mua-annotate-field-interactive))
  (bbdb-mua-wrapper
   (dolist (record (bbdb-mua-update-records 'sender update-p))
     (bbdb-annotate-record record annotation field replace))))

;;;###autoload
(defun bbdb-mua-annotate-recipients (annotation &optional field replace
                                                update-p)
  "Add ANNOTATION to field FIELD of the BBDB records of message recipients.
FIELD defaults to `bbdb-annotate-field'.
If REPLACE is non-nil, ANNOTATION replaces the content of FIELD.
UPDATE-P may take the same values as `bbdb-update-records-p'.
For interactive calls, use car of `bbdb-mua-update-interactive-p'."
  (interactive (bbdb-mua-annotate-field-interactive))
  (bbdb-mua-wrapper
   (dolist (record (bbdb-mua-update-records 'recipients update-p))
     (bbdb-annotate-record record annotation field replace))))

(defun bbdb-mua-edit-field-interactive ()
  "Interactive specification for command `bbdb-mua-edit-field' and friends."
  (bbdb-editable)
  (list (if (eq 'all-fields bbdb-mua-edit-field)
            (intern (completing-read
                     "Field: "
                     (mapcar 'symbol-name
                             (append '(name affix organization aka mail)
                                     bbdb-xfield-label-list))))
          bbdb-mua-edit-field)
        (bbdb-mua-update-interactive-p)))

;;;###autoload
(defun bbdb-mua-edit-field (&optional field update-p header-class)
  "Edit FIELD of the BBDB record(s) of message sender(s) or recipients.
FIELD defaults to value of variable `bbdb-mua-edit-field'.
UPDATE-P may take the same values as `bbdb-update-records-p'.
For interactive calls, see function `bbdb-mua-update-interactive-p'.
HEADER-CLASS is defined in `bbdb-message-headers'.  If it is nil,
use all classes in `bbdb-message-headers'."
  (interactive (bbdb-mua-edit-field-interactive))
  (cond ((memq field '(firstname lastname address phone xfields))
         (error "Field `%s' not editable this way" field))
        ((not field)
         (setq field bbdb-mua-edit-field)))
  (bbdb-mua-wrapper
   (let ((records (bbdb-mua-update-records header-class update-p))
         (bbdb-pop-up-window-size bbdb-mua-pop-up-window-size))
     (when records
       (bbdb-display-records records nil nil nil (bbdb-mua-window-p))
       (dolist (record records)
         (bbdb-edit-field record field))))))

;;;###autoload
(defun bbdb-mua-edit-field-sender (&optional field update-p)
  "Edit FIELD of record corresponding to sender of this message.
FIELD defaults to value of variable `bbdb-mua-edit-field'.
UPDATE-P may take the same values as `bbdb-update-records-p'.
For interactive calls, see function `bbdb-mua-update-interactive-p'."
  (interactive (bbdb-mua-edit-field-interactive))
  (bbdb-mua-edit-field field update-p 'sender))

;;;###autoload
(defun bbdb-mua-edit-field-recipients (&optional field update-p)
  "Edit FIELD of record corresponding to recipient of this message.
FIELD defaults to value of variable `bbdb-mua-edit-field'.
UPDATE-P may take the same values as `bbdb-update-records-p'.
For interactive calls, see function `bbdb-mua-update-interactive-p'."
  (interactive (bbdb-mua-edit-field-interactive))
  (bbdb-mua-edit-field field update-p 'recipients))

;; Functions for noninteractive use in MUA hooks

;;;###autoload
(defun bbdb-mua-auto-update (&optional header-class update-p)
  "Update BBDB automatically based on incoming and outgoing messages.
This looks into the headers of a message according to HEADER-CLASS.
Then for the mail addresses found the corresponding BBDB records are updated.
UPDATE-P determines whether only existing BBDB records are taken
or whether also new records are created for these mail addresses.
Return matching records.

HEADER-CLASS is defined in `bbdb-message-headers'.  If it is nil,
use all classes in `bbdb-message-headers'.
UPDATE-P may take the same values as `bbdb-mua-auto-update-p'.
If UPDATE-P is nil, use `bbdb-mua-auto-update-p' (which see).

If `bbdb-mua-pop-up' is non-nil, BBDB pops up the *BBDB* buffer
along with the MUA window(s), displaying the matching records
using `bbdb-pop-up-layout'.
If this is nil, BBDB is updated silently.

This function is intended for noninteractive use via appropriate MUA hooks.
Call `bbdb-mua-auto-update-init' in your init file to put this function
into the respective MUA hooks.
See `bbdb-mua-display-records' and friends for interactive commands."
  (let* ((bbdb-silent-internal t)
         (records (bbdb-mua-update-records header-class
                                           (or update-p
                                               bbdb-mua-auto-update-p)))
         (bbdb-pop-up-window-size bbdb-mua-pop-up-window-size))
    (if bbdb-mua-pop-up
        (if records
              (bbdb-display-records records bbdb-pop-up-layout
                                    nil nil (bbdb-mua-window-p))
          ;; If there are no records, empty the BBDB window.
          (bbdb-undisplay-records)))
    records))

;; Should the following be replaced by a minor mode??
;; Or should we make this function interactive in some other way?

;;;###autoload
(defun bbdb-mua-auto-update-init (&rest muas)
  "For MUAS add `bbdb-mua-auto-update' to their presentation hook.
If a MUA is not an element of MUAS, `bbdb-mua-auto-update' is removed
from the respective presentation hook.

Call this function in your init file to use the auto update feature with MUAS.
This function is separate from the general function `bbdb-initialize'
as this allows one to initialize the auto update feature for some MUAs only,
for example only for outgoing messages.

See `bbdb-mua-auto-update' for details about the auto update feature."
  (dolist (mua '((message . message-send-hook)
                 (mail . mail-send-hook)
                 (rmail . rmail-show-message-hook)
                 (gnus . gnus-article-prepare-hook)
                 (mh . mh-show-hook)
                 (vm . vm-select-message-hook)
                 (wl . wl-summary-redisplay-hook)))
    (if (memq (car mua) muas)
        (add-hook (cdr mua) 'bbdb-mua-auto-update)
      (remove-hook (cdr mua) 'bbdb-mua-auto-update))))

;;;###autoload
(defun bbdb-auto-notes (record)
  "Automatically annotate RECORD based on the headers of the current message.
See the variables `bbdb-auto-notes-rules', `bbdb-auto-notes-ignore-messages'
and `bbdb-auto-notes-ignore-headers'.
For use as an element of `bbdb-notice-record-hook'."
  ;; This code re-evaluates the annotations each time a message is viewed.
  ;; It would be faster if we could somehow store (permanently?) that we
  ;; have already annotated a message.
  (let ((case-fold-search t))
    (unless (or bbdb-read-only
                ;; check the ignore-messages pattern
                (let ((ignore-messages bbdb-auto-notes-ignore-messages)
                      ignore rule)
                  (while (and (not ignore) (setq rule (pop ignore-messages)))
                    (if (cond ((functionp rule)
                               ;; RULE may use `bbdb-update-records-address'
                               (funcall rule record))
                              ((symbolp rule)
                               (eq rule (nth 4 bbdb-update-records-address)))
                              ((eq 1 (safe-length rule))
                               (bbdb-message-header-re (car rule) (cdr rule)))
                              ((eq 2 (safe-length rule))
                               (and (eq (car rule) (nth 4 bbdb-update-records-address))
                                    (bbdb-message-header-re (nth 1 rule) (nth 2 rule)))))
                        (setq ignore t)))
                  ignore))
      (bbdb-editable)

      ;; For speed-up expanded rules are stored in `bbdb-auto-notes-rules-expanded'.
      (when (and bbdb-auto-notes-rules
                 (not bbdb-auto-notes-rules-expanded))
        (let (expanded mua from-to header)
          (dolist (rule bbdb-auto-notes-rules)
            ;; Which MUA do we want?
            (if (or (stringp (car rule))
                    (stringp (nth 1 rule)))
                (setq mua t)
              (setq mua (if (symbolp (car rule)) (listp (car rule)) (car rule))
                    rule (cdr rule)))
            ;; Which FROM-TO headers do we want?
            (if (stringp (car rule))
                (setq from-to t)
              (setq from-to (car rule)
                    rule (cdr rule)))
            (setq header (car rule))
            (let (string field replace elt-e)
              (dolist (elt (cdr rule))
                (if (consp (setq string (cdr elt)))
                    (setq field (car string) ; (REGEXP FIELD-NAME STRING REPLACE)
                          replace (nth 2 string) ; perhaps nil
                          string (nth 1 string))
                  ;; else it's simple (REGEXP . STRING)
                  (setq field bbdb-default-xfield
                        replace nil))
                (push (list (car elt) field string replace) elt-e))
              (push (append (list mua from-to header) (nreverse elt-e)) expanded)))
          (setq bbdb-auto-notes-rules-expanded (nreverse expanded))))

      (dolist (rule bbdb-auto-notes-rules-expanded)
        (let ((mua (car rule)) (from-to (nth 1 rule)) (header (nth 2 rule))
              hd-val string annotation)
          (when (and (or (eq mua t)
                         (memq (nth 4 bbdb-update-records-address) mua))
                     (or (eq from-to t)
                         (member-ignore-case
                          (nth 2 bbdb-update-records-address) from-to)
                         (memq (nth 3 bbdb-update-records-address) from-to))
                     (setq hd-val (bbdb-message-header header)))
            (dolist (elt (nthcdr 3 rule))
              (when (and (string-match (car elt) hd-val)
                         (let ((ignore (cdr (assoc-string
                                             header
                                             bbdb-auto-notes-ignore-headers t))))
                           (not (and ignore (string-match ignore hd-val)))))
                (setq string (nth 2 elt)
                      annotation
                      (cond ((integerp string)
                             (match-string string hd-val))
                            ((stringp string)
                             (replace-match string nil nil hd-val))
                            ((functionp string)
                             (funcall string hd-val))
                            (t (error "Illegal value: %s" string))))
                (bbdb-annotate-record record annotation
                                      (nth 1 elt) (nth 3 elt))))))))))

;;; Mark BBDB records in the MUA summary buffer

(defun bbdb-mua-summary-unify (address)
  "Unify mail ADDRESS displayed for a message in the MUA Summary buffer.
Typically ADDRESS refers to the value of the From header of a message.
If ADDRESS matches a record in BBDB display a unified name instead of ADDRESS
in the MUA Summary buffer.

Unification uses `bbdb-mua-summary-unification-list' (see there).
The first match in this list becomes the text string displayed
for a message in the MUA Summary buffer instead of ADDRESS.
If variable `bbdb-mua-summary-mark' is non-nil use it to precede known addresses.
Return the unified mail address.

Currently this works with Gnus and VM.  It requires the BBDB insinuation
of these MUAs.  Also, the MUA Summary format string must use
`bbdb-mua-summary-unify-format-letter' (see there)."
  ;; ADDRESS is analyzed as in `bbdb-get-address-components'.
  (let* ((data (bbdb-extract-address-components address))
         (name (car data))
         (mail (cadr data))
         (record (car (bbdb-message-search name mail)))
         (u-list bbdb-mua-summary-unification-list)
         elt val)
    (while (setq elt (pop u-list))
      (setq val (cond ((eq elt 'message-name) name)
                      ((eq elt 'message-mail) mail)
                      ((eq elt 'message-address) address)
                      (record (let ((result (bbdb-record-field record elt)))
                                (if (stringp result) result
                                  (car result)))))) ; RESULT is list.
      (if val (setq u-list nil)))
    (format "%s%s"
            (cond ((not bbdb-mua-summary-mark) "")
                  ((not record) " ")
                  ((functionp bbdb-mua-summary-mark-field)
                   (funcall bbdb-mua-summary-mark-field record))
                  ((bbdb-record-xfield record bbdb-mua-summary-mark-field))
                  (t bbdb-mua-summary-mark))
            (or val name mail address "**UNKNOWN**"))))

(defun bbdb-mua-summary-mark (address)
  "In the MUA Summary buffer mark messages matching a BBDB record.
ADDRESS typically refers to the value of the From header of a message.
If ADDRESS matches a record in BBDB return a mark, \" \" otherwise.
The mark itself is the value of the xfield `bbdb-mua-summary-mark-field'
if this xfield is in the poster's record, and `bbdb-mua-summary-mark' otherwise."
  (if (not bbdb-mua-summary-mark)
      "" ; for consistency
    ;; ADDRESS is analyzed as in `bbdb-get-address-components'.
    (let* ((data (bbdb-extract-address-components address))
           (record (car (bbdb-message-search (car data) (cadr data)))))
      (if record
          (or (when (functionp bbdb-mua-summary-mark-field)
                (funcall bbdb-mua-summary-mark-field record)
                t)
              (bbdb-record-xfield record bbdb-mua-summary-mark-field)
              bbdb-mua-summary-mark)
        " "))))

(provide 'bbdb-mua)

;;; bbdb-mua.el ends here
bbdb-20200102.403/bbdb-pgp.el0000644000175000017500000002430213643253537012705 0ustar  cbcb;;; bbdb-pgp.el --- use BBDB to handle PGP preferences -*- lexical-binding: t -*-

;; Copyright (C) 2013-2017  Free Software Foundation, Inc.

;; This file is part of the Insidious Big Brother Database (aka BBDB),

;; BBDB 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.

;; BBDB 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 BBDB.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;; It is believed that encrypted mail works best if all mail between
;; individuals is encrypted - even concerning matters that are not
;; confidential.  The reasoning is that confidential messages cannot
;; then be easily spotted and decryption efforts concentrated on them.
;; Some people therefore prefer to have all their email encrypted.
;; This package allows you to mark the BBDB entries for those
;; individuals so that messages will be (signed or) encrypted
;; when they are sent.

;;; Usage:
;; Add the xfield pgp-mail (see `bbdb-pgp-field') with the value
;; `sign' or `encrypt' to the BBDB records of the message recipients.
;; If the value is `sign-query' or `encrypt-query', this will query
;; whether to send signed or encrypted messages.
;;
;; Then call `bbdb-pgp' on outgoing message to add MML tags,
;; see info node `(message)security'.  For all message recipients
;; in `bbdb-pgp-headers', this command grabs the action in `bbdb-pgp-field'
;; of their BBDB records.  If this proposes multiple actions,
;; perform the action which appears first in `bbdb-pgp-ranked-actions'.
;; If this proposes no action at all, use `bbdb-pgp-default'.
;; The variable `bbdb-pgp-method' defines the method which is actually used
;; for signing and encrypting, see also `bbdb-pgp-method-alist'.
;;
;; `bbdb-pgp' works with both `mail-mode' and `message-mode' to send
;; signed or encrypted mail.
;;
;; To run `bbdb-pgp' automatically when sending a message,
;; use `bbdb-initialize' with arg `pgp' to add this function
;; to `message-send-hook' and `mail-send-hook'.
;; Yet see info node `(message)Signing and encryption' why you
;; might not want to rely for encryption on a hook function
;; which runs just before the message is sent, that is, you might want
;; to call the command `bbdb-pgp' manually, then call `mml-preview'.
;;
;; A thought: For these hooks we could define a wrapper that calls
;; first `bbdb-pgp', then `mml-preview' for preview.  The wrapper should
;; abort the sending of the message if the preview is not getting
;; the user's approval.  Yet this might require some recursive editing mode
;; so that the user can browse the preview before approving it.
;;
;;; Todo:
;; Spot incoming PGP-signed or encrypted messages and prompt for adding
;; `bbdb-pgp-field' to the senders' BBDB records; similar to how
;; bbdb-sc.el maintains attribution preferences.

;;; Code:

(require 'message)
(require 'bbdb-com)

(defcustom bbdb-pgp-field 'pgp-mail
  "BBDB xfield holding the PGP action.
If the recipient of a message has this xfield in his/her BBDB record,
its value determines whether `bbdb-pgp' signs or encrypts the message.
The value of this xfield should be one of the following symbols:
  sign            Sign the message
  sign-query      Query whether to sign the message
  encrypt         Encrypt the message
  encrypt-query   Query whether to encrypt the message
If the xfield is absent use `bbdb-pgp-default'.
See also info node `(message)security'."
  :type '(symbol :tag "BBDB xfield")
  :group 'bbdb-utilities-pgp)

(defcustom bbdb-pgp-default nil
  "Default action when sending a message and the recipients are not in BBDB.
This should be one of the following symbols:
  nil             Do nothing
  sign            Sign the message
  sign-query      Query whether to sign the message
  encrypt         Encrypt the message
  encrypt-query   Query whether to encrypt the message
See info node `(message)security'."
  :type '(choice
	  (const :tag "Do Nothing" nil)
	  (const :tag "Encrypt" encrypt)
	  (const :tag "Query encryption" encrypt-query)
	  (const :tag "Sign" sign)
	  (const :tag "Query signing" sign-query))
  :group 'bbdb-utilities-pgp)

(defcustom bbdb-pgp-ranked-actions
  '(encrypt-query sign-query encrypt sign)
  "Ranked list of actions when sending a message.
If a message has multiple recipients such that their BBDB records specify
different actions for this message, `bbdb-pgp' will perform the action
which appears first in `bbdb-pgp-ranked-actions'.
This list should include the following four symbols:
  sign            Sign the message
  sign-query      Query whether to sign the message
  encrypt         Encrypt the message
  encrypt-query   Query whether to encrypt the message."
  :type '(repeat (symbol :tag "Action"))
  :group 'bbdb-utilities-pgp)

(defcustom bbdb-pgp-headers '("To" "Cc")
  "Message headers to look at."
  :type '(repeat (string :tag "Message header"))
  :group 'bbdb-utilities-pgp)

(defcustom bbdb-pgp-method 'pgpmime
  "Method for signing and encrypting messages.
It should be one of the keys of `bbdb-pgp-method-alist'.
The default methods include
  pgp       Add MML tags for PGP format
  pgpauto   Add MML tags for PGP-auto format
  pgpmime   Add MML tags for PGP/MIME
  smime     Add MML tags for S/MIME
See info node `(message)security'."
  :type '(choice
	  (const :tag "MML PGP" pgp)
	  (const :tag "MML PGP-auto" pgpauto)
	  (const :tag "MML PGP/MIME" pgpmime)
	  (const :tag "MML S/MIME" smime)
	  (symbol :tag "Custom"))
  :group 'bbdb-utilities-pgp)

(defcustom bbdb-pgp-method-alist
  '((pgp mml-secure-message-sign-pgp
         mml-secure-message-encrypt-pgp)
    (pgpmime mml-secure-message-sign-pgpmime
             mml-secure-message-encrypt-pgpmime)
    (smime mml-secure-message-sign-smime
           mml-secure-message-encrypt-smime)
    (pgpauto mml-secure-message-sign-pgpauto
             mml-secure-message-encrypt-pgpauto))
  "Alist of methods for signing and encrypting a message with `bbdb-pgp'.
Each method is a list (KEY SIGN ENCRYPT).
The symbol KEY identifies the method.  The function SIGN signs the message;
the function ENCRYPT encrypts it.  These functions take no arguments.
The default methods include
  pgp       Add MML tags for PGP format
  pgpauto   Add MML tags for PGP-auto format
  pgpmime   Add MML tags for PGP/MIME
  smime     Add MML tags for S/MIME
See info node `(message)security'."
  :type '(repeat (list (symbol :tag "Key")
                       (symbol :tag "Sign method")
                       (symbol :tag "Encrypt method")))
  :group 'bbdb-utilities-pgp)

;;;###autoload
(defun bbdb-read-xfield-pgp-mail (&optional init)
  "Set `bbdb-pgp-field', requiring match with `bbdb-pgp-ranked-actions'."
  (bbdb-read-string "PGP action: " init
                    (mapcar 'list bbdb-pgp-ranked-actions) t))

;;;###autoload
(defun bbdb-pgp ()
  "Add PGP MML tags to a message according to the recipients' BBDB records.
For all message recipients in `bbdb-pgp-headers', this grabs the action
in `bbdb-pgp-field' of their BBDB records.  If this proposes multiple actions,
perform the action which appears first in `bbdb-pgp-ranked-actions'.
If this proposes no action at all, use `bbdb-pgp-default'.
The variable `bbdb-pgp-method' defines the method which is actually used
for signing and encrypting.

This command works with both `mail-mode' and `message-mode' to send
signed or encrypted mail.

To run this command automatically when sending a message,
use `bbdb-initialize' with arg `pgp' to add this function
to `message-send-hook' and `mail-send-hook'.
Yet see info node `(message)Signing and encryption' why you
might not want to rely for encryption on a hook function
which runs just before the message is sent, that is, you might want
to call the command `bbdb-pgp' manually, then call `mml-preview'."
  (interactive)
  (save-excursion
    (save-restriction
      (widen)
      (message-narrow-to-headers)
      (when mail-aliases
        ;; (sendmail-sync-aliases) ; needed?
        (expand-mail-aliases (point-min) (point-max)))
      (let ((actions
             (or (delq nil
                       (delete-dups
                        (mapcar
                         (lambda (record)
                           (bbdb-record-xfield-intern record bbdb-pgp-field))
                         (delete-dups
                          (apply 'nconc
                                 (mapcar
                                  (lambda (address)
                                    (bbdb-message-search (car address)
                                                         (cadr address)))
                                  (bbdb-extract-address-components
                                   (mapconcat
                                    (lambda (header)
                                      (mail-fetch-field header nil t))
                                    bbdb-pgp-headers ", ")
                                   t)))))))
                 (and bbdb-pgp-default
                      (list bbdb-pgp-default)))))
        (when actions
          (widen) ; after analyzing the headers
          (let ((ranked-actions bbdb-pgp-ranked-actions)
                action)
            (while ranked-actions
              (if (memq (setq action (pop ranked-actions)) actions)
                  (cond ((or (eq action 'sign)
                             (and (eq action 'sign-query)
                                  (y-or-n-p "Sign message? ")))
                         (funcall (nth 1 (assq bbdb-pgp-method
                                               bbdb-pgp-method-alist)))
                         (setq ranked-actions nil))
                        ((or (eq action 'encrypt)
                             (and (eq action 'encrypt-query)
                                  (y-or-n-p "Encrypt message? ")))
                         (funcall (nth 2 (assq bbdb-pgp-method
                                               bbdb-pgp-method-alist)))
                         (setq ranked-actions nil)))))))))))

(provide 'bbdb-pgp)

;;; bbdb-pgp.el ends here
bbdb-20200102.403/bbdb-pkg.el0000644000175000017500000000022113643253537012672 0ustar  cbcb(define-package "bbdb" "20200102.403" "The Insidious Big Brother Database for GNU Emacs" 'nil)
;; Local Variables:
;; no-byte-compile: t
;; End:
bbdb-20200102.403/bbdb-autoloads.el0000644000175000017500000012433713643253540014115 0ustar  cbcb;;; bbdb-autoloads.el --- automatically extracted autoloads
;;
;;; Code:

(add-to-list 'load-path (directory-file-name
                         (or (file-name-directory #$) (car load-path))))


;;;### (autoloads nil "bbdb" "bbdb.el" (0 0 0 0))
;;; Generated autoloads from bbdb.el

(defsubst bbdb-records nil "\
Return a list of all BBDB records; read in and parse the db if necessary.
This function also notices if the corresponding file on disk has been modified." (with-current-buffer (bbdb-buffer) bbdb-records))

(autoload 'bbdb-mode "bbdb" "\
Major mode for viewing and editing the Insidious Big Brother Database.
Letters no longer insert themselves.  Numbers are prefix arguments.
You can move around using the usual cursor motion commands.
\\<bbdb-mode-map>
\\[bbdb-add-mail-alias]	 Add new mail alias to visible records or remove it.
\\[bbdb-edit-field]	 Edit the field on the current line.
\\[bbdb-delete-field-or-record]	 Delete the field on the current line.  If the current line is the
	 first line of a record, then delete the entire record.
\\[bbdb-insert-field]	 Insert a new field into the current record.  Note that this
	 will let you add new fields of your own as well.
\\[bbdb-transpose-fields]	 Swap the field on the current line with the previous field.
\\[bbdb-dial]	 Dial the current phone field.
\\[bbdb-next-record], \\[bbdb-prev-record]	 Move to the next or the previous displayed record, respectively.
\\[bbdb-create]	 Create a new record.
\\[bbdb-toggle-records-layout]	 Toggle whether the current record is displayed in a one-line
	 listing, or a full multi-line listing.
\\[bbdb-do-all-records]\\[bbdb-toggle-records-layout]	 Do that for all displayed records.
\\[bbdb-merge-records]	 Merge the contents of the current record with some other, and then
	 delete the current record.
\\[bbdb-omit-record]	 Remove the current record from the display without deleting it from
	 the database.  This is often a useful thing to do before using one
	 of the `*' commands.
\\[bbdb]	 Search for records in the database (on all fields).
\\[bbdb-search-mail]	 Search for records by mail address.
\\[bbdb-search-organization]	 Search for records by organization.
\\[bbdb-search-xfields]	 Search for records by xfields.
\\[bbdb-search-name]	 Search for records by name.
\\[bbdb-search-changed]	 Display records that have changed since the database was saved.
\\[bbdb-mail]	 Compose mail to the person represented by the current record.
\\[bbdb-do-all-records]\\[bbdb-mail]	 Compose mail to everyone whose record is displayed.
\\[bbdb-save]	 Save the BBDB file to disk.
\\[bbdb-tex]	 Create a TeX listing of the current record.
\\[bbdb-do-all-records]\\[bbdb-tex]	 Do that for all displayed record.
\\[other-window]	 Move to another window.
\\[bbdb-info]	 Read the Info documentation for BBDB.
\\[bbdb-help]	 Display a one line command summary in the echo area.
\\[bbdb-browse-url]	 Visit Web sites listed in the `url' field(s) of the current record.

For address completion using the names and mail addresses in the database:
	 in Mail mode, type \\<mail-mode-map>\\[bbdb-complete-mail].
	 in Message mode, type \\<message-mode-map>\\[bbdb-complete-mail].

Important variables:
	 `bbdb-auto-revert'
	 `bbdb-ignore-redundant-mails'
	 `bbdb-case-fold-search'
	 `bbdb-completion-list'
	 `bbdb-default-area-code'
	 `bbdb-default-domain'
	 `bbdb-layout'
	 `bbdb-file'
	 `bbdb-phone-style'
	 `bbdb-check-auto-save-file'
	 `bbdb-pop-up-layout'
	 `bbdb-pop-up-window-size'
	 `bbdb-add-name'
	 `bbdb-add-aka'
	 `bbdb-add-mails'
	 `bbdb-new-mails-primary'
	 `bbdb-read-only'
	 `bbdb-mua-pop-up'
	 `bbdb-user-mail-address-re'

There are numerous hooks.  M-x apropos ^bbdb.*hook RET

\\{bbdb-mode-map}

\(fn)" t nil)

(autoload 'bbdb-version "bbdb" "\
Return string describing the version of BBDB.
With prefix ARG, insert string at point.

\(fn &optional ARG)" t nil)

(autoload 'bbdb-initialize "bbdb" "\
Initialize BBDB for MUAS and miscellaneous packages.
List MUAS may include the following symbols to initialize the respective
mail/news readers, composers, and miscellaneous packages:
  gnus       Gnus mail/news reader.
  mh-e       MH-E mail reader.
  mu4e       Mu4e mail reader.
  rmail      Rmail mail reader.
  vm         VM mail reader.
  mail       Mail (M-x mail).
  message    Message mode.
  wl         Wanderlust mail reader.

  anniv      Anniversaries in Emacs diary.

  sc         Supercite.  However, this is not the full story.
               See bbdb-sc.el for how to fully hook BBDB into Supercite.

  pgp        PGP support:  this adds `bbdb-pgp' to `message-send-hook'
               and `mail-send-hook' so that `bbdb-pgp' runs automatically
               when a message is sent.
               Yet see info node `(message)Signing and encryption'
               why you might not want to rely for encryption on a hook
               function which runs just before the message is sent,
               that is, you might want to call the command `bbdb-pgp' manually,
               then call `mml-preview'.

See also `bbdb-mua-auto-update-init'.  The latter is a separate function
as this allows one to initialize the auto update feature for some MUAs only,
for example only for outgoing messages.

\(fn &rest MUAS)" nil nil)

(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bbdb" '("bbdb-")))

;;;***

;;;### (autoloads nil "bbdb-anniv" "bbdb-anniv.el" (0 0 0 0))
;;; Generated autoloads from bbdb-anniv.el

(autoload 'bbdb-anniv-diary-entries "bbdb-anniv" "\
Add anniversaries from BBDB records to `diary-list-entries'.
This obeys `calendar-date-style' via `diary-date-forms'.
To enable this feature, put the following into your .emacs:

 (add-hook 'diary-list-entries-hook 'bbdb-anniv-diary-entries)

\(fn)" nil nil)

(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bbdb-anniv" '("bbdb-anniv-")))

;;;***

;;;### (autoloads nil "bbdb-com" "bbdb-com.el" (0 0 0 0))
;;; Generated autoloads from bbdb-com.el

(autoload 'bbdb-do-all-records "bbdb-com" "\
Command prefix for operating on all records currently displayed.
With prefix ARG a positive number, operate on all records.
With prefix ARG a negative number, operate on current record only.
This only works for certain commands.

\(fn &optional ARG)" t nil)

(autoload 'bbdb-do-records "bbdb-com" "\
Return list of records to operate on.
Normally this list includes only the current record.
It includes all currently displayed records if the command prefix \\<bbdb-mode-map>\\[bbdb-do-all-records] is used.
If FULL is non-nil, the list of records includes display information.

\(fn &optional FULL)" nil nil)

(autoload 'bbdb-append-display-p "bbdb-com" "\
Return variable `bbdb-append-display' and reset.

\(fn)" nil nil)

(autoload 'bbdb-append-display "bbdb-com" "\
Toggle appending next searched records in the *BBDB* buffer.
With prefix ARG \\[universal-argument] always append.
With ARG a positive number append for that many times.
With ARG a negative number do not append.

\(fn &optional ARG)" t nil)

(autoload 'bbdb-search-invert "bbdb-com" "\
Toggle inversion of the next search command.
With prefix ARG a positive number, invert next search.
With prefix ARG a negative number, do not invert next search.

\(fn &optional ARG)" t nil)

(autoload 'bbdb "bbdb-com" "\
Display all records in the BBDB matching REGEXP
in either the name(s), organization, address, phone, mail, or xfields.

\(fn REGEXP &optional LAYOUT)" t nil)

(autoload 'bbdb-search-name "bbdb-com" "\
Display all records in the BBDB matching REGEXP in the name
\(or ``alternate'' names).

\(fn REGEXP &optional LAYOUT)" t nil)

(autoload 'bbdb-search-organization "bbdb-com" "\
Display all records in the BBDB matching REGEXP in the organization field.

\(fn REGEXP &optional LAYOUT)" t nil)

(autoload 'bbdb-search-address "bbdb-com" "\
Display all records in the BBDB matching REGEXP in the address fields.

\(fn REGEXP &optional LAYOUT)" t nil)

(autoload 'bbdb-search-mail "bbdb-com" "\
Display all records in the BBDB matching REGEXP in the mail address.

\(fn REGEXP &optional LAYOUT)" t nil)

(autoload 'bbdb-search-phone "bbdb-com" "\
Display all records in the BBDB matching REGEXP in the phones field.

\(fn REGEXP &optional LAYOUT)" t nil)

(autoload 'bbdb-search-xfields "bbdb-com" "\
Display all BBDB records for which xfield FIELD matches REGEXP.

\(fn FIELD REGEXP &optional LAYOUT)" t nil)

(autoload 'bbdb-search-changed "bbdb-com" "\
Display records which have been changed since BBDB was last saved.

\(fn &optional LAYOUT)" t nil)

(autoload 'bbdb-timestamp-older "bbdb-com" "\
Display records with timestamp older than DATE.
DATE must be in yyyy-mm-dd format.

\(fn DATE &optional LAYOUT)" t nil)

(autoload 'bbdb-timestamp-newer "bbdb-com" "\
Display records with timestamp newer than DATE.
DATE must be in yyyy-mm-dd format.

\(fn DATE &optional LAYOUT)" t nil)

(autoload 'bbdb-creation-older "bbdb-com" "\
Display records with creation-date older than DATE.
DATE must be in yyyy-mm-dd format.

\(fn DATE &optional LAYOUT)" t nil)

(autoload 'bbdb-creation-newer "bbdb-com" "\
Display records with creation-date newer than DATE.
DATE must be in yyyy-mm-dd format.

\(fn DATE &optional LAYOUT)" t nil)

(autoload 'bbdb-creation-no-change "bbdb-com" "\
Display records that have the same timestamp and creation-date.

\(fn &optional LAYOUT)" t nil)

(autoload 'bbdb-create "bbdb-com" "\
Add a new RECORD to BBDB.
When called interactively read all relevant info.
Do not call this from a program; call `bbdb-create-internal' instead.

\(fn RECORD)" t nil)

(autoload 'bbdb-create-internal "bbdb-com" "\
Add a new record to the database and return it.

The following keywords are supported in SPEC:
:name VAL          String or a cons cell (FIRST . LAST), the name of the person.
                   An error is thrown if VAL is already in use
                   and `bbdb-allow-duplicates' is nil.
:affix VAL         List of strings.
:aka VAL           List of strings.
                   An error is thrown if an aka in VAL is already in use
                   and `bbdb-allow-duplicates' is nil.
:organization VAL  List of strings.
:mail VAL          String with comma-separated mail address
                   or a list of strings.
                   An error is thrown if a mail address in VAL is already
                   in use and `bbdb-allow-duplicates' is nil.
:phone VAL         List of phone-number objects.  A phone-number is a vector
                   [\"label\" area-code prefix suffix extension-or-nil]
                   or [\"label\" \"phone-number\"]
:address VAL       List of addresses.  An address is a vector of the form
                   [\"label\" (\"line1\" \"line2\" ... ) \"City\"
                   \"State\" \"Postcode\" \"Country\"].
:xfields VAL       Alist associating symbols with strings.
:uuid VAL          String, the uuid.
:creation-date VAL String, the creation date.
:check             If present, throw an error if a field value is not
                   syntactically correct.

\(fn &rest SPEC)" nil nil)

(autoload 'bbdb-insert-field "bbdb-com" "\
For RECORD, add a new FIELD with value VALUE.
Interactively, read FIELD and VALUE; RECORD is the current record.
A non-nil prefix arg is passed on to `bbdb-read-field' as FLAG (see there).

\(fn RECORD FIELD VALUE)" t nil)

(autoload 'bbdb-edit-field "bbdb-com" "\
Edit the contents of FIELD of RECORD.
If point is in the middle of a multi-line field (e.g., address),
then the entire field is edited, not just the current line.
For editing phone numbers or addresses, VALUE must be the phone number
or address that gets edited. An error is thrown when attempting to edit
a phone number or address with VALUE being nil.

- The value of an xfield is a string.  With prefix FLAG the value may be
  any lisp object.

\(fn RECORD FIELD &optional VALUE FLAG)" t nil)

(autoload 'bbdb-transpose-fields "bbdb-com" "\
Transpose previous and current field of a BBDB record.
With numeric prefix ARG, take previous field and move it past ARG fields.
With region active or ARG 0, transpose field point is in and field mark is in.

Both fields must be in the same record, and must be of the same basic type
\(that is, you can use this command to change the order in which phone numbers
or email addresses are listed, but you cannot use it to make an address appear
before a phone number; the order of field types is fixed).

If the current field is the name field, transpose first and last name,
irrespective of the value of ARG.

\(fn ARG)" t nil)

(autoload 'bbdb-delete-field-or-record "bbdb-com" "\
For RECORDS delete FIELD.
If FIELD is the `name' field, delete RECORDS from datanbase.
Interactively, use BBDB prefix \\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records',
and FIELD is the field point is on.
If prefix NOPROMPT is non-nil, do not confirm deletion.

\(fn RECORDS FIELD &optional NOPROMPT)" t nil)

(autoload 'bbdb-delete-records "bbdb-com" "\
Delete RECORDS.
Interactively, use BBDB prefix \\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.
If prefix NOPROMPT is non-nil, do not confirm deletion.

\(fn RECORDS &optional NOPROMPT)" t nil)

(autoload 'bbdb-display-all-records "bbdb-com" "\
Show all records.
If invoked in a *BBDB* buffer point stays on the currently visible record.
Inverse of `bbdb-display-current-record'.

\(fn &optional LAYOUT)" t nil)

(autoload 'bbdb-display-current-record "bbdb-com" "\
Narrow to current record.  Inverse of `bbdb-display-all-records'.

\(fn &optional LAYOUT)" t nil)

(autoload 'bbdb-toggle-records-layout "bbdb-com" "\
Toggle layout of RECORDS (elided or expanded).
Interactively, use BBDB prefix \\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.
With prefix ARG 0, RECORDS are displayed elided.
With any other non-nil ARG, RECORDS are displayed expanded.

\(fn RECORDS &optional ARG)" t nil)

(autoload 'bbdb-display-records-completely "bbdb-com" "\
Display RECORDS using layout `full-multi-line' (i.e., display all fields).
Interactively, use BBDB prefix \\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.

\(fn RECORDS)" t nil)

(autoload 'bbdb-display-records-with-layout "bbdb-com" "\
Display RECORDS using LAYOUT.
Interactively, use BBDB prefix \\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.

\(fn RECORDS LAYOUT)" t nil)

(autoload 'bbdb-omit-record "bbdb-com" "\
Remove current record from the display without deleting it from BBDB.
With prefix N, omit the next N records.  If negative, omit backwards.

\(fn N)" t nil)

(autoload 'bbdb-merge-records "bbdb-com" "\
Merge RECORD1 into RECORD2, then delete RECORD1 and return RECORD2.
If both records have name fields ask which one to use.
Concatenate other fields, ignoring duplicates.
RECORD1 need not be known to BBDB, its hash and cache are ignored.
Update hash and cache for RECORD2.

Interactively, RECORD1 is the current record; prompt for RECORD2.
With prefix, RECORD2 defaults to the first record with the same name.

\(fn RECORD1 RECORD2)" t nil)

(autoload 'bbdb-sort-addresses "bbdb-com" "\
Sort the addresses in RECORDS according to the label.
Interactively, use BBDB prefix \\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.
If UPDATE is non-nil (as in interactive calls) update the database.
Otherwise, this is the caller's responsiblity (for example, when used
in `bbdb-change-hook').

\(fn RECORDS &optional UPDATE)" t nil)

(autoload 'bbdb-sort-phones "bbdb-com" "\
Sort the phones in RECORDS according to the label.
Interactively, use BBDB prefix \\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.
If UPDATE is non-nil (as in interactive calls) update the database.
Otherwise, this is the caller's responsiblity (for example, when used
in `bbdb-change-hook').

\(fn RECORDS &optional UPDATE)" t nil)

(autoload 'bbdb-sort-xfields "bbdb-com" "\
Sort the xfields in RECORDS according to `bbdb-xfields-sort-order'.
Interactively, use BBDB prefix \\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.
If UPDATE is non-nil (as in interactive calls) update the database.
Otherwise, this is the caller's responsiblity (for example, when used
in `bbdb-change-hook').

\(fn RECORDS &optional UPDATE)" t nil)

(autoload 'bbdb-dwim-mail "bbdb-com" "\
Return a string to use as the mail address of RECORD.
The name in the mail address is formatted obeying `bbdb-mail-name-format'
and `bbdb-mail-name'.  However, if both the first name and last name
are constituents of the address as in John.Doe@Some.Host,
and `bbdb-mail-avoid-redundancy' is non-nil, then the address is used as is
and `bbdb-mail-name-format' and `bbdb-mail-name' are ignored.
If `bbdb-mail-avoid-redundancy' is 'mail-only the name is never included.
MAIL may be a mail address to be used for RECORD.
If MAIL is an integer, use the MAILth mail address of RECORD.
If MAIL is nil use the first mail address of RECORD.

\(fn RECORD &optional MAIL)" nil nil)

(autoload 'bbdb-mail "bbdb-com" "\
Compose a mail message to RECORDS (optional: using SUBJECT).
Interactively, use BBDB prefix \\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.
By default, the first mail addresses of RECORDS are used.
If prefix N is a number, use Nth mail address of RECORDS (starting from 1).
If prefix N is C-u (t noninteractively) use all mail addresses of RECORDS.
If VERBOSE is non-nil (as in interactive calls) be verbose.

\(fn RECORDS &optional SUBJECT N VERBOSE)" t nil)

(autoload 'bbdb-completion-predicate "bbdb-com" "\
For use as the third argument to `completing-read'.
Obey `bbdb-completion-list'.

\(fn KEY RECORDS)" nil nil)

(autoload 'bbdb-completing-read-mails "bbdb-com" "\
Like `read-string', but allows `bbdb-complete-mail' style completion.

\(fn PROMPT &optional INIT)" nil nil)

(autoload 'bbdb-complete-mail "bbdb-com" "\
In a mail buffer, complete the user name or mail before point.
Completion happens up to the preceeding colon, comma, or BEG.
Return non-nil if there is a valid completion, else return nil.

Completion behaviour obeys `bbdb-completion-list' (see there).
If what has been typed matches a unique BBDB record, insert an address
formatted by `bbdb-dwim-mail' (see there).  Also, display this record
if `bbdb-completion-display-record' is non-nil,
If what has been typed is a valid completion but does not match
a unique record, display a list of completions.
If the completion is done and `bbdb-complete-mail-allow-cycling' is t
then cycle through the mails for the matching record.  If BBDB
would format a given address different from what we have in the mail buffer,
the first round of cycling reformats the address accordingly, then we cycle
through the mails for the matching record.
With prefix CYCLE-COMPLETION-BUFFER non-nil, display a list of all mails
available for cycling.

Set the variable `bbdb-complete-mail' non-nil for enabling this feature
as part of the MUA insinuation.

\(fn &optional BEG CYCLE-COMPLETION-BUFFER)" t nil)

(define-obsolete-function-alias 'bbdb-complete-name #'bbdb-complete-mail "3.0")

(autoload 'bbdb-mail-aliases "bbdb-com" "\
Define mail aliases for the records in the database.
Define a mail alias for every record that has a `mail-alias' field
which is the contents of that field.
If there are multiple comma-separated words in the `mail-alias' field,
then all of those words will be defined as aliases for that person.

If multiple records in the database have the same mail alias,
then that alias expands to a comma-separated list of the mail addresses
of all of these people.
Add this command to `mail-setup-hook'.

Mail aliases are (re)built only if `bbdb-mail-aliases-need-rebuilt' is non-nil
because the database was newly loaded or it has been edited.
Rebuilding the aliases is enforced if prefix FORCE-REBUILT is t.

\(fn &optional FORCE-REBUILT NOISY)" t nil)

(defsubst bbdb-mail-alias-list (alias) (if (stringp alias) (bbdb-split bbdb-mail-alias-field alias) alias))

(autoload 'bbdb-dial "bbdb-com" "\
Dial the number at point.
If the point is at the beginning of a record, dial the first phone number.
Use rules from `bbdb-dial-local-prefix-alist' unless prefix FORCE-AREA-CODE
is non-nil.  Do not dial the extension.

\(fn PHONE FORCE-AREA-CODE)" t nil)

(autoload 'bbdb-browse-url "bbdb-com" "\
Brwose URLs stored in the `url' field of RECORDS.
Interactively, use BBDB prefix \\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.
Prefix WHICH specifies which URL in field `url' is used (starting from 0).
Default is the first URL.

\(fn RECORDS &optional WHICH)" t nil)

(autoload 'bbdb-grab-url "bbdb-com" "\
Grab URL and store it in RECORD.

\(fn RECORD URL)" t nil)

(autoload 'bbdb-copy-records-as-kill "bbdb-com" "\
Copy RECORDS to kill ring.
Interactively, use BBDB prefix \\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.

\(fn RECORDS)" t nil)

(autoload 'bbdb-copy-fields-as-kill "bbdb-com" "\
For RECORDS copy values of FIELD at point to kill ring.
If FIELD is an address or phone with a label, copy only field values
with the same label.  With numeric prefix NUM, if the value of FIELD
is a list, copy only the NUMth list element.
Interactively, use BBDB prefix \\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.

\(fn RECORDS FIELD &optional NUM)" t nil)

(autoload 'bbdb-info "bbdb-com" "\


\(fn)" t nil)

(autoload 'bbdb-help "bbdb-com" "\


\(fn)" t nil)

(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bbdb-com" '("bbdb-")))

;;;***

;;;### (autoloads nil "bbdb-gnus" "bbdb-gnus.el" (0 0 0 0))
;;; Generated autoloads from bbdb-gnus.el

(autoload 'bbdb-insinuate-gnus "bbdb-gnus" "\
Hook BBDB into Gnus.
Do not call this in your init file.  Use `bbdb-initialize'.

\(fn)" nil nil)

;;;***

;;;### (autoloads nil "bbdb-gnus-aux" "bbdb-gnus-aux.el" (0 0 0 0))
;;; Generated autoloads from bbdb-gnus-aux.el

(autoload 'bbdb/gnus-score-invalidate-alist "bbdb-gnus-aux" "\
This function is called through `bbdb-after-change-hook',
and sets `bbdb/gnus-score-rebuild-alist' to t if the changed
record contains a gnus-score field.

\(fn RECORD)" nil nil)

(autoload 'bbdb/gnus-score "bbdb-gnus-aux" "\
This returns a score alist for Gnus.  A score pair will be made for
every member of the mail field in records which also have a gnus-score
field.  This allows the BBDB to serve as a supplemental global score
file, with the advantage that it can keep up with multiple and changing
addresses better than the traditionally static global scorefile.

\(fn GROUP)" nil nil)

(autoload 'bbdb/gnus-split-method "bbdb-gnus-aux" "\
This function expects to be called in a buffer which contains a mail
message to be spooled, and the buffer should be narrowed to the message
headers.  It returns a list of groups to which the message should be
spooled, using the addresses in the headers and information from BBDB.

\(fn)" nil nil)

(autoload 'bbdb/gnus-nnimap-folder-list-from-bbdb "bbdb-gnus-aux" "\
Return a list of ( \"From\" mail-regexp imap-folder-name) tuples
based on the contents of the bbdb.

The folder-name is the value of the 'imap attribute of the BBDB record;
the mail-regexp consists of all the mail addresses for the BBDB record
concatenated with OR.  Records without an 'imap attribute are ignored.

Here  is an example of a relevant BBDB record:

Uwe Brauer
           mail: oub@mat.ucm.es
           imap: testimap

This function uses `regexp-opt' to generate the mail-regexp which automatically
`regexp-quote's its arguments.  Please note: in order that this will work
with the `nnimap-split-fancy' method you have to use macros, that is your setting
will look like:

\(setq nnimap-split-rule  'nnimap-split-fancy
       nnimap-split-inbox \"INBOX\"
       nnimap-split-fancy
       `(| ,@(bbdb/gnus-nnimap-folder-list-from-bbdb)
            ... ))

Note that `( is the backquote, NOT the quote '(.

\(fn)" nil nil)

(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bbdb-gnus-aux" '("bbdb/gnus-s")))

;;;***

;;;### (autoloads nil "bbdb-ispell" "bbdb-ispell.el" (0 0 0 0))
;;; Generated autoloads from bbdb-ispell.el

(autoload 'bbdb-ispell-export "bbdb-ispell" "\
Export BBDB records to ispell personal dictionaries.

\(fn)" t nil)

(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bbdb-ispell" '("bbdb-ispell-")))

;;;***

;;;### (autoloads nil "bbdb-message" "bbdb-message.el" (0 0 0 0))
;;; Generated autoloads from bbdb-message.el

(autoload 'bbdb-insinuate-message "bbdb-message" "\
Hook BBDB into Message Mode.
Do not call this in your init file.  Use `bbdb-initialize'.

\(fn)" nil nil)

(autoload 'bbdb-insinuate-mail "bbdb-message" "\
Hook BBDB into Mail Mode.
Do not call this in your init file.  Use `bbdb-initialize'.

\(fn)" nil nil)

;;;***

;;;### (autoloads nil "bbdb-mhe" "bbdb-mhe.el" (0 0 0 0))
;;; Generated autoloads from bbdb-mhe.el

(autoload 'bbdb/mh-header "bbdb-mhe" "\
Find and return the value of HEADER in the current buffer.
Returns the empty string if HEADER is not in the message.

\(fn HEADER)" nil nil)

(autoload 'bbdb-insinuate-mh "bbdb-mhe" "\
Call this function to hook BBDB into MH-E.
Do not call this in your init file.  Use `bbdb-initialize'.

\(fn)" nil nil)

;;;***

;;;### (autoloads nil "bbdb-migrate" "bbdb-migrate.el" (0 0 0 0))
;;; Generated autoloads from bbdb-migrate.el

(autoload 'bbdb-migrate "bbdb-migrate" "\
Migrate RECORDS from format OLD to `bbdb-file-format'.

\(fn RECORDS OLD)" nil nil)

(autoload 'bbdb-undocumented-variables "bbdb-migrate" "\
Return list of undocumented variables in NAME-SPACE.
NAME-SPACE defaults to \"bbdb-\".  Use a prefix arg to specify NAME-SPACE
interactively.  If MESSAGE is non-nil (as in interactive calls) display
the list in the message area.

This command may come handy to identify BBDB variables in your init file
that are not used anymore by the current version of BBDB.  Yet this fails
for outdated BBDB variables that are set via your personal `custom-file'.

\(fn &optional NAME-SPACE MESSAGE)" t nil)

(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bbdb-migrate" '("bbdb-migrate-")))

;;;***

;;;### (autoloads nil "bbdb-mu4e" "bbdb-mu4e.el" (0 0 0 0))
;;; Generated autoloads from bbdb-mu4e.el

(autoload 'bbdb-insinuate-mu4e "bbdb-mu4e" "\
Hook BBDB into mu4e.
Do not call this in your init file.  Use `bbdb-initialize'.

\(fn)" nil nil)

;;;***

;;;### (autoloads nil "bbdb-mua" "bbdb-mua.el" (0 0 0 0))
;;; Generated autoloads from bbdb-mua.el

(autoload 'bbdb-message-header "bbdb-mua" "\
For the current message return the value of HEADER.
MIME encoded headers are decoded.  Return nil if HEADER does not exist.

\(fn HEADER)" nil nil)

(autoload 'bbdb-accept-message "bbdb-mua" "\
For use with variable `bbdb-mua-update-interactive-p' and friends.
Return the value of variable `bbdb-update-records-p' for messages matching
`bbdb-accept-message-alist'.  If INVERT is non-nil, accept messages
not matching `bbdb-ignore-message-alist'.

\(fn &optional INVERT)" nil nil)

(autoload 'bbdb-ignore-message "bbdb-mua" "\
For use with variable `bbdb-mua-update-interactive-p' and friends.
Return the value of variable `bbdb-update-records-p' for messages not matching
`bbdb-ignore-message-alist'.  If INVERT is non-nil, accept messages
matching `bbdb-accept-message-alist'.

\(fn &optional INVERT)" nil nil)

(autoload 'bbdb-select-message "bbdb-mua" "\
For use with variable `bbdb-mua-update-interactive-p' and friends.
Return the value of variable `bbdb-update-records-p' for messages both matching
`bbdb-accept-message-alist' and not matching `bbdb-ignore-message-alist'.

\(fn)" nil nil)

(autoload 'bbdb-update-records "bbdb-mua" "\
Return the list of BBDB records matching ADDRESS-LIST.
ADDRESS-LIST is a list of mail addresses.  (It can be extracted from
a mail message using `bbdb-get-address-components'.)
UPDATE-P may take the following values:
 search       Search for existing records matching ADDRESS.
 update       Search for existing records matching ADDRESS;
                update name and mail field if necessary.
 query        Search for existing records matching ADDRESS;
                query for creation of a new record if the record does not exist.
 create or t  Search for existing records matching ADDRESS;
                create a new record if it does not yet exist.
 nil          Do nothing.
 a function   This functions will be called with no arguments.
                It should return one of the above values.

If SORT is non-nil, sort records according to `bbdb-record-lessp'.
Ottherwise, the records are ordered according to ADDRESS-LIST.

Usually this function is called by the wrapper `bbdb-mua-update-records'.

\(fn ADDRESS-LIST &optional UPDATE-P SORT)" nil nil)

(autoload 'bbdb-mua-display-records "bbdb-mua" "\
Display the BBDB record(s) for the addresses in this message.
This looks into the headers of a message according to HEADER-CLASS.
Then for the mail addresses found the corresponding BBDB records are displayed.
UPDATE-P determines whether only existing BBDB records are displayed
or whether also new records are created for these mail addresses.

HEADER-CLASS is defined in `bbdb-message-headers'.  If it is nil,
use all classes in `bbdb-message-headers'.
UPDATE-P may take the same values as `bbdb-update-records-p'.
For interactive calls, see function `bbdb-mua-update-interactive-p'.
If ALL is non-nil, bind `bbdb-message-all-addresses' to ALL.

\(fn &optional HEADER-CLASS UPDATE-P ALL)" t nil)

(autoload 'bbdb-mua-display-sender "bbdb-mua" "\
Display the BBDB record(s) for the sender of this message.
UPDATE-P may take the same values as `bbdb-update-records-p'.
For interactive calls, see function `bbdb-mua-update-interactive-p'.

\(fn &optional UPDATE-P)" t nil)

(autoload 'bbdb-mua-display-recipients "bbdb-mua" "\
Display the BBDB record(s) for the recipients of this message.
UPDATE-P may take the same values as `bbdb-update-records-p'.
For interactive calls, see function `bbdb-mua-update-interactive-p'.

\(fn &optional UPDATE-P)" t nil)

(autoload 'bbdb-mua-display-all-records "bbdb-mua" "\
Display the BBDB record(s) for all addresses in this message.
UPDATE-P may take the same values as `bbdb-update-records-p'.
For interactive calls, see function `bbdb-mua-update-interactive-p'.

\(fn &optional UPDATE-P)" t nil)

(autoload 'bbdb-mua-display-all-recipients "bbdb-mua" "\
Display BBDB records for all recipients of this message.
UPDATE-P may take the same values as `bbdb-update-records-p'.
For interactive calls, see function `bbdb-mua-update-interactive-p'.

\(fn &optional UPDATE-P)" t nil)

(autoload 'bbdb-mua-annotate-sender "bbdb-mua" "\
Add ANNOTATION to field FIELD of the BBDB record(s) of message sender(s).
FIELD defaults to `bbdb-annotate-field'.
If REPLACE is non-nil, ANNOTATION replaces the content of FIELD.
UPDATE-P may take the same values as `bbdb-update-records-p'.
For interactive calls, use car of `bbdb-mua-update-interactive-p'.

\(fn ANNOTATION &optional FIELD REPLACE UPDATE-P)" t nil)

(autoload 'bbdb-mua-annotate-recipients "bbdb-mua" "\
Add ANNOTATION to field FIELD of the BBDB records of message recipients.
FIELD defaults to `bbdb-annotate-field'.
If REPLACE is non-nil, ANNOTATION replaces the content of FIELD.
UPDATE-P may take the same values as `bbdb-update-records-p'.
For interactive calls, use car of `bbdb-mua-update-interactive-p'.

\(fn ANNOTATION &optional FIELD REPLACE UPDATE-P)" t nil)

(autoload 'bbdb-mua-edit-field "bbdb-mua" "\
Edit FIELD of the BBDB record(s) of message sender(s) or recipients.
FIELD defaults to value of variable `bbdb-mua-edit-field'.
UPDATE-P may take the same values as `bbdb-update-records-p'.
For interactive calls, see function `bbdb-mua-update-interactive-p'.
HEADER-CLASS is defined in `bbdb-message-headers'.  If it is nil,
use all classes in `bbdb-message-headers'.

\(fn &optional FIELD UPDATE-P HEADER-CLASS)" t nil)

(autoload 'bbdb-mua-edit-field-sender "bbdb-mua" "\
Edit FIELD of record corresponding to sender of this message.
FIELD defaults to value of variable `bbdb-mua-edit-field'.
UPDATE-P may take the same values as `bbdb-update-records-p'.
For interactive calls, see function `bbdb-mua-update-interactive-p'.

\(fn &optional FIELD UPDATE-P)" t nil)

(autoload 'bbdb-mua-edit-field-recipients "bbdb-mua" "\
Edit FIELD of record corresponding to recipient of this message.
FIELD defaults to value of variable `bbdb-mua-edit-field'.
UPDATE-P may take the same values as `bbdb-update-records-p'.
For interactive calls, see function `bbdb-mua-update-interactive-p'.

\(fn &optional FIELD UPDATE-P)" t nil)

(autoload 'bbdb-mua-auto-update "bbdb-mua" "\
Update BBDB automatically based on incoming and outgoing messages.
This looks into the headers of a message according to HEADER-CLASS.
Then for the mail addresses found the corresponding BBDB records are updated.
UPDATE-P determines whether only existing BBDB records are taken
or whether also new records are created for these mail addresses.
Return matching records.

HEADER-CLASS is defined in `bbdb-message-headers'.  If it is nil,
use all classes in `bbdb-message-headers'.
UPDATE-P may take the same values as `bbdb-mua-auto-update-p'.
If UPDATE-P is nil, use `bbdb-mua-auto-update-p' (which see).

If `bbdb-mua-pop-up' is non-nil, BBDB pops up the *BBDB* buffer
along with the MUA window(s), displaying the matching records
using `bbdb-pop-up-layout'.
If this is nil, BBDB is updated silently.

This function is intended for noninteractive use via appropriate MUA hooks.
Call `bbdb-mua-auto-update-init' in your init file to put this function
into the respective MUA hooks.
See `bbdb-mua-display-records' and friends for interactive commands.

\(fn &optional HEADER-CLASS UPDATE-P)" nil nil)

(autoload 'bbdb-mua-auto-update-init "bbdb-mua" "\
For MUAS add `bbdb-mua-auto-update' to their presentation hook.
If a MUA is not an element of MUAS, `bbdb-mua-auto-update' is removed
from the respective presentation hook.

Call this function in your init file to use the auto update feature with MUAS.
This function is separate from the general function `bbdb-initialize'
as this allows one to initialize the auto update feature for some MUAs only,
for example only for outgoing messages.

See `bbdb-mua-auto-update' for details about the auto update feature.

\(fn &rest MUAS)" nil nil)

(autoload 'bbdb-auto-notes "bbdb-mua" "\
Automatically annotate RECORD based on the headers of the current message.
See the variables `bbdb-auto-notes-rules', `bbdb-auto-notes-ignore-messages'
and `bbdb-auto-notes-ignore-headers'.
For use as an element of `bbdb-notice-record-hook'.

\(fn RECORD)" nil nil)

(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bbdb-mua" '("bbdb-")))

;;;***

;;;### (autoloads nil "bbdb-pgp" "bbdb-pgp.el" (0 0 0 0))
;;; Generated autoloads from bbdb-pgp.el

(autoload 'bbdb-read-xfield-pgp-mail "bbdb-pgp" "\
Set `bbdb-pgp-field', requiring match with `bbdb-pgp-ranked-actions'.

\(fn &optional INIT)" nil nil)

(autoload 'bbdb-pgp "bbdb-pgp" "\
Add PGP MML tags to a message according to the recipients' BBDB records.
For all message recipients in `bbdb-pgp-headers', this grabs the action
in `bbdb-pgp-field' of their BBDB records.  If this proposes multiple actions,
perform the action which appears first in `bbdb-pgp-ranked-actions'.
If this proposes no action at all, use `bbdb-pgp-default'.
The variable `bbdb-pgp-method' defines the method which is actually used
for signing and encrypting.

This command works with both `mail-mode' and `message-mode' to send
signed or encrypted mail.

To run this command automatically when sending a message,
use `bbdb-initialize' with arg `pgp' to add this function
to `message-send-hook' and `mail-send-hook'.
Yet see info node `(message)Signing and encryption' why you
might not want to rely for encryption on a hook function
which runs just before the message is sent, that is, you might want
to call the command `bbdb-pgp' manually, then call `mml-preview'.

\(fn)" t nil)

(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bbdb-pgp" '("bbdb-pgp-")))

;;;***

;;;### (autoloads nil "bbdb-rmail" "bbdb-rmail.el" (0 0 0 0))
;;; Generated autoloads from bbdb-rmail.el

(autoload 'bbdb-insinuate-rmail "bbdb-rmail" "\
Hook BBDB into RMAIL.
Do not call this in your init file.  Use `bbdb-initialize'.

\(fn)" nil nil)

;;;***

;;;### (autoloads nil "bbdb-sc" "bbdb-sc.el" (0 0 0 0))
;;; Generated autoloads from bbdb-sc.el

(autoload 'bbdb-sc-update-from "bbdb-sc" "\
Update the \"from\" field in `sc-mail-info'.
If the \"from\" field in `sc-mail-info' contains only a plain mail address,
complement the \"from\" field in `sc-mail-info' with the sender's name in BBDB.

\(fn)" nil nil)

(autoload 'bbdb-insinuate-sc "bbdb-sc" "\
Hook BBDB into Supercite.
Do not call this in your init file.  Use `bbdb-initialize'.
However, this is not the full story.  See bbdb-sc.el for how to fully hook
BBDB into Supercite.

\(fn)" nil nil)

(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bbdb-sc" '("bbdb-sc-")))

;;;***

;;;### (autoloads nil "bbdb-site" "bbdb-site.el" (0 0 0 0))
;;; Generated autoloads from bbdb-site.el

(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bbdb-site" '("bbdb-")))

;;;***

;;;### (autoloads nil "bbdb-snarf" "bbdb-snarf.el" (0 0 0 0))
;;; Generated autoloads from bbdb-snarf.el

(autoload 'bbdb-snarf-paragraph "bbdb-snarf" "\
Snarf BBDB record from paragraph around position POS using RULE.
The paragraph is the one that contains POS or follows POS.
Interactively POS is the position of point.
RULE defaults to `bbdb-snarf-rule-default'.
See `bbdb-snarf-rule-alist' for details.

\(fn POS &optional RULE)" t nil)

(autoload 'bbdb-snarf-yank "bbdb-snarf" "\
Snarf a BBDB record from latest kill using RULE.
The latest kill may also be a window system selection, see `current-kill'.
RULE defaults to `bbdb-snarf-rule-default'.
See `bbdb-snarf-rule-alist' for details.

\(fn &optional RULE)" t nil)

(autoload 'bbdb-snarf "bbdb-snarf" "\
Snarf a BBDB record in STRING using RULE.  Display and return this record.
Interactively, STRING is the current region.
RULE defaults to `bbdb-snarf-rule-default'.
See `bbdb-snarf-rule-alist' for details.

\(fn STRING &optional RULE)" t nil)

(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bbdb-snarf" '("bbdb-snarf-")))

;;;***

;;;### (autoloads nil "bbdb-tex" "bbdb-tex.el" (0 0 0 0))
;;; Generated autoloads from bbdb-tex.el

(autoload 'bbdb-tex "bbdb-tex" "\
Generate FILE for TeXing RECORDS.
Interactively, use BBDB prefix \\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.
RULE should be an element of `bbdb-tex-alist'.

\(fn RECORDS FILE RULE)" t nil)

(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bbdb-tex" '("bbdb-tex-")))

;;;***

;;;### (autoloads nil "bbdb-vm" "bbdb-vm.el" (0 0 0 0))
;;; Generated autoloads from bbdb-vm.el

(autoload 'bbdb/vm-header "bbdb-vm" "\


\(fn HEADER)" nil nil)

(autoload 'bbdb-insinuate-vm "bbdb-vm" "\
Hook BBDB into VM.
Do not call this in your init file.  Use `bbdb-initialize'.

\(fn)" nil nil)

;;;***

;;;### (autoloads nil "bbdb-vm-aux" "bbdb-vm-aux.el" (0 0 0 0))
;;; Generated autoloads from bbdb-vm-aux.el

(autoload 'vm-summary-function-B "bbdb-vm-aux" "\
For VM message M return the BBDB name of the sender.
Respect `vm-summary-uninteresting-senders'.

\(fn M)" nil nil)

(defvar bbdb/vm-auto-folder-headers '("From:" "To:" "CC:") "\
The headers used by `bbdb/vm-auto-folder'.
The order in this list is the order how matching will be performed.")

(custom-autoload 'bbdb/vm-auto-folder-headers "bbdb-vm-aux" t)

(defvar bbdb/vm-auto-folder-field 'vm-folder "\
The xfield which `bbdb/vm-auto-folder' searches for.")

(custom-autoload 'bbdb/vm-auto-folder-field "bbdb-vm-aux" t)

(defvar bbdb/vm-virtual-folder-field 'vm-virtual "\
The xfield which `bbdb/vm-virtual-folder' searches for.")

(custom-autoload 'bbdb/vm-virtual-folder-field "bbdb-vm-aux" t)

(defvar bbdb/vm-virtual-real-folders nil "\
Real folders used for defining virtual folders.
If nil use `vm-primary-inbox'.")

(custom-autoload 'bbdb/vm-virtual-real-folders "bbdb-vm-aux" t)

(autoload 'bbdb/vm-auto-folder "bbdb-vm-aux" "\
Add entries to `vm-auto-folder-alist' for the records in BBDB.
For each record that has a `vm-folder' xfield, add an element
\(MAIL-REGEXP . FOLDER-NAME) to `vm-auto-folder-alist'.
The element gets added to the sublists of `vm-auto-folder-alist'
specified in `bbdb/vm-auto-folder-headers'.
MAIL-REGEXP matches the mail addresses of the BBDB record.
The value of the `vm-folder' xfield becomes FOLDER-NAME.
The `vm-folder' xfield is defined via `bbdb/vm-auto-folder-field'.

Add this function to `bbdb-before-save-hook' and your .vm.

\(fn)" t nil)

(autoload 'bbdb/vm-virtual-folder "bbdb-vm-aux" "\
Create `vm-virtual-folder-alist' according to the records in BBDB.
For each record that has a `vm-virtual' xfield, add or modify the
corresponding VIRTUAL-FOLDER-NAME element of `vm-virtual-folder-alist'.

  (VIRTUAL-FOLDER-NAME ((FOLDER-NAME ...)
                        (author-or-recipient MAIL-REGEXP)))

VIRTUAL-FOLDER-NAME is the first element of the `vm-virtual' xfield.
FOLDER-NAME ... are either the remaining elements of the `vm-virtual' xfield,
or `bbdb/vm-virtual-real-folders' or `vm-primary-inbox'.
MAIL-REGEXP matches the mail addresses of the BBDB record.
The `vm-virtual' xfield is defined via `bbdb/vm-virtual-folder-field'.

Add this function to `bbdb-before-save-hook' and your .vm.

\(fn)" t nil)

(autoload 'bbdb/vm-auto-add-label "bbdb-vm-aux" "\
Automatically add labels to VM messages.
Add this to `bbdb-notice-record-hook' to check the messages noticed by BBDB.
If the value of `bbdb/vm-auto-add-label-field' in the sender's BBDB record
matches a value in `bbdb/vm-auto-add-label-list' then a VM label will be added
to the message.  Such VM labels can be used, e.g., to mark messages via
`vm-mark-matching-messages' or to define virtual folders via
`vm-create-virtual-folder'

Typically `bbdb/vm-auto-add-label-field' and `bbdb/vm-auto-add-label-list'
refer to mail aliases FOO used with multiple records.  This adds a label FOO
to all incoming messages matching FOO.  Then VM can create a virtual folder
for these messages.  The concept of combining multiple recipients of an
outgoing message in one mail alias thus gets extended to incoming messages
from different senders.

\(fn RECORD)" nil nil)

(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bbdb-vm-aux" '("bbdb/vm-a")))

;;;***

;;;### (autoloads nil "bbdb-wl" "bbdb-wl.el" (0 0 0 0))
;;; Generated autoloads from bbdb-wl.el

(autoload 'bbdb/wl-header "bbdb-wl" "\


\(fn HEADER)" nil nil)

(autoload 'bbdb-insinuate-wl "bbdb-wl" "\
Hook BBDB into Wanderlust.

\(fn)" nil nil)

;;;***

;;;### (autoloads nil nil ("bbdb-pkg.el") (0 0 0 0))

;;;***

;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; bbdb-autoloads.el ends here