Anonymous avatar Anonymous committed 30ff0b8

sync with Sourceforge CVS

Comments (0)

Files changed (17)

+2005-07-24  Waider        <waider@waider.ie>
+	* Sync to SourceForge CVS
+
 2005-07-24  Norbert Koch  <viteno@xemacs.org>
 
 	* Makefile (VERSION): XEmacs package 1.27 released.
 
 (require 'bbdb)
 ;;(require 'bbdb-snarf) causes recursive compile!
-(defvar bbdb-extract-address-components-func);; bbdb-snarf
-(require 'cl)
+(eval-when-compile
+  (require 'cl)
+  (defvar bbdb-extract-address-components-func)) ;; bbdb-snarf
+
 ;; ARGH. fmh, dammit.
 (require
  (eval-and-compile
 (eval-and-compile
   (if (boundp 'auto-fill-function)
       (fset 'bbdb-auto-fill-function 'auto-fill-function)
-    (fset 'bbdb-auto-fill-function 'auto-fill-hook)))
-
-(eval-when-compile
+    (fset 'bbdb-auto-fill-function 'auto-fill-hook))
+
   (autoload 'mh-send "mh-e")
-  (autoload 'vm-session-initialization "vm-startup.el")
-  (autoload 'vm-mail-internal "vm-reply.el")
+  (autoload 'vm-session-initialization "vm-startup")
+  (autoload 'vm-mail-internal "vm-reply")
   (autoload 'mew-send "mew")
   (autoload 'bbdb-header-start "bbdb-hooks")
   (autoload 'bbdb-extract-field-value "bbdb-hooks")
-  (autoload 'Info-goto-node "info"))
+  (autoload 'bbdb-fontify-buffer "bbdb-gui")
+  (autoload 'Info-goto-node "info")
   ;; this is very unpleasant, but saves me doing a lot of rewriting
   ;; for now. a big cleanup will happen for the next release, maybe.
   ;; NB if emacs 21 or older emacsen or even things you bolt on have
   ;; any of these functions, bad things will happen. Again, FITNR.
-(eval-and-compile
   (if (featurep 'xemacs)
       (progn
         (fset 'bbdb-extent-string 'extent-string)
-        (fset 'bbdb-play-sound 'play-sound)
-        (fset 'bbdb-next-event 'next-event)
         (fset 'bbdb-display-message 'display-message)
         (fset 'bbdb-event-to-character 'event-to-character))
     (fset 'bbdb-extent-string 'ignore)
-    (fset 'bbdb-play-sound 'ignore)
-    (fset 'bbdb-next-event 'ignore)
     (fset 'bbdb-display-message 'ignore)
     (fset 'bbdb-event-to-character 'ignore)))
 
+(defvar bbdb-define-all-aliases-needs-rebuilt nil)
+
 (defcustom bbdb-default-country
   '"Emacs";; what do you mean, it's not a country?
   "*Default country to use if none is specified."
         (list 'not (list 'eq arg 0))
         'bbdb-display-layout))
 
+(defvar bbdb-search-invert nil
+  "Bind this variable to t in order to invert the result of `bbdb-search'.
+
+\(let ((bbdb-search-invert t))
+   \(bbdb-search records foo foo))")
+
+(defun bbdb-search-invert-p ()
+  "Return `bbdb-search-invert' and set it to nil.
+To set it on again, use `bbdb-search-invert-set'."
+  (let ((result bbdb-search-invert))
+    (setq bbdb-search-invert nil)
+    result))
+
+;;;###autoload
+(defun bbdb-search-invert-set ()
+  "Typing \\<bbdb-mode-map>\\[bbdb-search-invert-set] inverts the meaning of the next search command.
+Sets `bbdb-search-invert' to t.
+You will have to call this function again, if you want to
+do repeated inverted searches."
+  (interactive)
+  (setq bbdb-search-invert t)
+  (message (substitute-command-keys
+            "\\<bbdb-mode-map>\\[bbdb-search-invert-set] - ")))
 
 (defmacro bbdb-search (records &optional name company net notes phone)
-  ;; this macro only emits code for those things being searched for;
-  ;; literal nils at compile-time cause no code to be emitted.
+  "Search RECORDS for optional arguments NAME, COMPANY, NET, NOTES, PHONE.
+This macro only emits code for those things being searched for;
+literal nils at compile-time cause no code to be emitted.
+
+If you want to reverse the search, bind `bbdb-search-invert' to t."
   (let (clauses)
     ;; I didn't protect these vars from multiple evaluation because that
     ;; actually generates *less efficient code* in elisp, because the extra
                    nil))
              (case-fold-search bbdb-case-fold-search)
              (records (, records))
+         (invert (bbdb-search-invert-p))
              record)
          (while records
            (setq record (car records))
-           (if (or (,@ clauses))
-               (setq matches (cons record matches)))
-           (setq records (cdr records)))
+       (if (or (and invert
+            (not (or (,@ clauses))))
+           (and (not invert)
+            (or (,@ clauses))))
+           (setq matches (cons record matches)))
+       (setq records (cdr records)))
          (nreverse matches)))))
 
+(defun bbdb-search-prompt (prompt &rest rest)
+  (if (string-match "%m" prompt)
+      (setq prompt (replace-match (if bbdb-search-invert
+                                      "not matching"
+                                    "matching")
+                                  nil nil prompt)))
+  (read-string (apply 'format prompt rest)))
 
 ;;;###autoload
 (defun bbdb (string elidep)
   "Display all entries in the BBDB matching the regexp STRING
 in either the name(s), company, network address, or notes."
-  (interactive "sRegular Expression for General Search: \nP")
-  (let ((bbdb-display-layout (bbdb-grovel-elide-arg elidep))
-        (notes (cons '* string)))
-    (bbdb-display-records
-     (bbdb-search (bbdb-records) string string string notes nil))))
+  (interactive
+   (list (bbdb-search-prompt "Search records %m regexp: ")
+         current-prefix-arg))
+  (let* ((bbdb-display-layout (bbdb-grovel-elide-arg elidep))
+         (notes (cons '* string))
+         (records
+          (bbdb-search (bbdb-records) string string string notes
+                       nil)))
+    (if records
+        (bbdb-display-records records)
+      ;; we could use error here, but it's not really an error.
+      (message "No records matching '%s'" string))))
 
 ;;;###autoload
 (defun bbdb-name (string elidep)
   "Display all entries in the BBDB matching the regexp STRING in the name
 \(or ``alternate'' names\)."
-  (interactive "sRegular Expression for Name Search: \nP")
-  (let ((bbdb-display-layout (bbdb-grovel-elide-arg elidep)))
+  (interactive
+   (list (bbdb-search-prompt "Search records with names %m regexp: ")
+         current-prefix-arg))
+   (let ((bbdb-display-layout (bbdb-grovel-elide-arg elidep)))
     (bbdb-display-records (bbdb-search (bbdb-records) string))))
 
 ;;;###autoload
 (defun bbdb-company (string elidep)
   "Display all entries in BBDB matching STRING in the company field."
-  (interactive "sRegular Expression for Company Search: \nP")
+  (interactive
+   (list (bbdb-search-prompt "Search records with company %m regexp: ")
+         current-prefix-arg))
   (let ((bbdb-display-layout (bbdb-grovel-elide-arg elidep)))
     (bbdb-display-records (bbdb-search (bbdb-records) nil string))))
 
 ;;;###autoload
 (defun bbdb-net (string elidep)
   "Display all entries in BBDB matching regexp STRING in the network address."
-  (interactive "sRegular Expression for Net Address Search: \nP")
+  (interactive
+   (list (bbdb-search-prompt "Search records with net address %m regexp: ")
+         current-prefix-arg))
   (let ((bbdb-display-layout (bbdb-grovel-elide-arg elidep)))
     (bbdb-display-records (bbdb-search (bbdb-records) nil nil string))))
 
 (defun bbdb-notes (which string elidep)
   "Display all entries in BBDB matching STRING in the named notes field."
   (interactive
-   (list (completing-read "Notes field to search (RET for all): "
-                          (append '(("notes")) (bbdb-propnames))
-                          nil t)
-         (if (featurep 'gmhist)
-             (read-with-history-in 'bbdb-notes-field "Regular expression: ")
-           (read-string "Regular Expression: "))
-         current-prefix-arg))
+   (let (field)
+     (list (setq field (completing-read "Notes field to search (RET for all): "
+                                        (append '(("notes")) (bbdb-propnames))
+                                        nil t))
+           (if (featurep 'gmhist)
+               (read-with-history-in 'bbdb-notes-field "Regular expression: ")
+             (bbdb-search-prompt "Search records with %s %m regexp: "
+                                 (if (string= field "")
+                                     "one field"
+                                   field)))
+           current-prefix-arg)))
   (let ((bbdb-display-layout (bbdb-grovel-elide-arg elidep))
         (notes (if (string= which "")
                    (cons '* string)
 
 (defun bbdb-phones (string elidep)
   "Display all entries in BBDB matching the regexp STRING in the phones field."
-  (interactive "sRegular Expression for Phone Search: \nP")
+  (interactive
+   (list (bbdb-search-prompt "Search records with phone %m regexp: ")
+         current-prefix-arg))
   (let ((bbdb-display-layout (bbdb-grovel-elide-arg elidep)))
     (bbdb-display-records
      (bbdb-search (bbdb-records) nil nil nil nil string))))
   "Display all entries in the bbdb database which have been changed since
 the database was last saved."
   (interactive "P")
-  (let ((bbdb-display-layout (bbdb-grovel-elide-arg elidep)))
-    (bbdb-display-records
-     (bbdb-with-db-buffer
-      bbdb-changed-records))))
+  (let ((bbdb-display-layout (bbdb-grovel-elide-arg elidep))
+        (changed-records  (bbdb-with-db-buffer bbdb-changed-records)))
+    (if (bbdb-search-invert-p)
+        (let ((recs (bbdb-records))
+              unchanged-records
+              r)
+          (while recs
+            (setq r (car recs)
+                  recs (cdr recs))
+            (when (not (member r changed-records))
+              (setq changed-records (delete r changed-records)
+                    unchanged-records (cons r unchanged-records))))
+          (bbdb-display-records unchanged-records))
+      (bbdb-display-records changed-records))))
 
 (defun bbdb-display (records)
   "Prompts for and displays a single record (this is faster than searching.)"
 
 (defun bbdb-redisplay-one-record (record &optional record-cons next-record-cons
                                          delete-p)
-  "Regrind one record.  The *BBDB* buffer must be current when this is called."
+  "Regrind one record. The *BBDB* buffer must be current when this is called."
   (bbdb-debug (if (not (eq (not (not delete-p))
                            (not (not (bbdb-record-deleted-p record)))))
                   (error "splorch.")))
   (if (null record-cons) (setq record-cons (assq record bbdb-records)))
   (if (null next-record-cons)
       (setq next-record-cons (car (cdr (memq record-cons bbdb-records)))))
-  (beginning-of-line)
-  (let ((marker (nth 2 record-cons))
-        (next-marker (nth 2 next-record-cons))
-        (buffer-read-only nil))
-    (bbdb-debug
-     (if (null record-cons) (error "doubleplus ungood: record unexists!"))
-     (if (null marker) (error "doubleplus ungood: marker unexists!")))
-    (goto-char marker)
-    (if delete-p nil
-      (bbdb-format-record (car record-cons) (car (cdr record-cons))))
-    (delete-region (point) (or next-marker (point-max)))
-    (goto-char marker)
-    (save-excursion
-      (run-hooks 'bbdb-list-hook))))
+  (if (null record-cons)
+      (bbdb-display-records (list record) nil t)
+    (let ((position (point))
+          (marker (nth 2 record-cons))
+          next-marker
+          (buffer-read-only nil))
+      (bbdb-debug
+       (if (null record-cons) (error "doubleplus ungood: record unexists!"))
+       (if (null marker) (error "doubleplus ungood: marker unexists!")))
+      (beginning-of-line)
+      (goto-char marker)
+      (remove-text-properties marker (or (nth 2 next-record-cons) (point-max))
+                              '(bbdb-field nil))
+      (if delete-p nil
+        (bbdb-format-record (car record-cons) (car (cdr record-cons))))
+      (setq next-marker (or (nth 2 next-record-cons) (point-max)))
+      (delete-region (point) next-marker)
+      (if (< position next-marker)
+          (goto-char position))
+
+      (if (and bbdb-gui (not delete-p))
+          (bbdb-fontify-buffer (list record-cons
+                                     ;; the record ends here
+                                     (list nil nil next-marker))))
+      (save-excursion
+        (run-hooks 'bbdb-list-hook)))))
 
 ;;; Parsing phone numbers
-
-(defconst bbdb-phone-area-regexp "(?[ \t]*\\+?1?[ \t]*[-\(]?[ \t]*[-\(]?[ \t]*\\([2-9][0-9][0-9]\\)[ \t]*)?[- /\.\t]*")
-(defconst bbdb-phone-main-regexp "\\([2-9][0-9][0-9]\\)[ \t]*-?[ \.\t]*\\([0-9][0-9][0-9][0-9]\\)[ \t]*")
+;;; 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.
+
+
+(defconst bbdb-phone-area-regexp "(?[ \t]*\\+?1?[ \t]*[-\(]?[ \t]*[-\(]?[ \t]*\\([2-9][0-9][0-9]\\)[ \t]*)?[-./ \t]*")
+(defconst bbdb-phone-main-regexp "\\([1-9][0-9][0-9]\\)[ \t]*[-.]?[ \t]*\\([0-9][0-9][0-9][0-9]\\)[ \t]*")
+
 (defconst bbdb-phone-ext-regexp  "x?[ \t]*\\([0-9]+\\)[ \t]*")
 
 (defconst bbdb-phone-regexp-1 (concat "^[ \t]*" bbdb-phone-area-regexp bbdb-phone-main-regexp bbdb-phone-ext-regexp "$"))
 code and exchange, and four in the number (if they are present).  An error
 will be signalled if unparsable.  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)
-415 555 1212              -> (415 555 1212)
-1 415 555 1212            -> (415 555 1212)
-5551212                   -> (0 555 1212)
-4155551212                -> (415 555 1212)
-4155551212123             -> (415 555 1212 123)
-5551212x123               -> (0 555 1212 123)
-1234                      -> (0 0 0 1234)
+  ( 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)
+  415 555 1212              -> (415 555 1212)
+  1 415 555 1212            -> (415 555 1212)
+  5551212                   -> (0 555 1212)
+  4155551212                -> (415 555 1212)
+  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\".
 is nil...\)"
 
   (cond ((if number-type
-(eq number-type 'euro)
-(not bbdb-north-american-phone-numbers-p))
-(list (bbdb-string-trim string)))
-((string-match bbdb-phone-regexp-1 string)
- ;; (415) 555-1212 x123
- (list (bbdb-subint string 1) (bbdb-subint string 2)
-       (bbdb-subint string 3) (bbdb-subint string 4)))
-((string-match bbdb-phone-regexp-2 string)
- ;; (415) 555-1212
- (list (bbdb-subint string 1) (bbdb-subint string 2)
-       (bbdb-subint string 3)))
-((string-match bbdb-phone-regexp-3 string)
- ;; 555-1212 x123
- (list 0 (bbdb-subint string 1) (bbdb-subint string 2)
-       (bbdb-subint string 3)))
-((string-match bbdb-phone-regexp-4 string)
- ;; 555-1212
- (list 0 (bbdb-subint string 1) (bbdb-subint string 2)))
-((string-match bbdb-phone-regexp-5 string)
- ;; x123
- (list 0 0 0 (bbdb-subint string 1)))
-(t (error "phone number unparsable."))))
+             (eq number-type 'euro)
+           (not bbdb-north-american-phone-numbers-p))
+         (list (bbdb-string-trim string)))
+        ((string-match bbdb-phone-regexp-1 string)
+         ;; (415) 555-1212 x123
+         (list (bbdb-subint string 1) (bbdb-subint string 2)
+               (bbdb-subint string 3) (bbdb-subint string 4)))
+        ((string-match bbdb-phone-regexp-2 string)
+         ;; (415) 555-1212
+         (list (bbdb-subint string 1) (bbdb-subint string 2)
+               (bbdb-subint string 3)))
+        ((string-match bbdb-phone-regexp-3 string)
+         ;; 555-1212 x123
+         (list 0 (bbdb-subint string 1) (bbdb-subint string 2)
+               (bbdb-subint string 3)))
+        ((string-match bbdb-phone-regexp-4 string)
+         ;; 555-1212
+         (list 0 (bbdb-subint string 1) (bbdb-subint string 2)))
+        ((string-match bbdb-phone-regexp-5 string)
+         ;; x123
+         (list 0 0 0 (bbdb-subint string 1)))
+        (t (error "phone number unparsable."))))
 
 ;;; Parsing other things
 
 Doesn't insert it in to the database or update the hashtables, but does
 ensure that there will not be name collisions."
   (bbdb-records)                        ; make sure database is loaded
-  (if bbdb-readonly-p (error "The Insidious Big Brother Database is read-only."))
+  (if bbdb-readonly-p
+      (error "The Insidious Big Brother Database is read-only."))
   (let (firstname lastname)
     (bbdb-error-retry
      (progn
                   (or firstname "") (or lastname "")))))
     (let ((company (bbdb-read-string "Company: "))
           (net (bbdb-split (bbdb-read-string "Network Address: ") ","))
-          (addrs (let (L L-tail str addr)
-                   (while (not (string= ""
-                                        (setq str (bbdb-read-string "Address Description [RET when no more addrs]: "))))
-                     (setq addr (make-vector bbdb-address-length nil))
-                     (bbdb-record-edit-address addr str)
-                     (if L
-                         (progn (setcdr L-tail (cons addr nil))
-                                (setq L-tail (cdr L-tail)))
-                       (setq L (cons addr nil)
-                             L-tail L)))
-                   L))
-          (phones (let (L L-tail str)
-                    (while (not (string= ""
-                                         (setq str
-                                               (bbdb-read-string "Phone Location [RET when no more phones]: "))))
-                      (let* ((phonelist
-                              (bbdb-error-retry
-                               (bbdb-parse-phone-number
-                                (read-string "Phone: "
-                                             (and (integerp bbdb-default-area-code)
-                                                  (format "(%03d) " bbdb-default-area-code))))))
-                             (phone (apply 'vector str
-                                           (if (= 3 (length phonelist))
-                                               (nconc phonelist '(0))
-                                             phonelist))))
-                        (if L
-                            (progn (setcdr L-tail (cons phone nil))
-                                   (setq L-tail (cdr L-tail)))
+          (addrs
+           (let (L L-tail str addr)
+             (while (not (string=
+                          ""
+                          (setq str
+                                (bbdb-read-string
+                                 "Address Description [RET when no more]: "
+                                 ""
+                                 (mapcar (function (lambda(x) (list x)))
+                                         (bbdb-label-completion-list
+                                          "addresses"))))))
+               (setq addr (make-vector bbdb-address-length nil))
+               (bbdb-record-edit-address addr str)
+               (if L
+                   (progn (setcdr L-tail (cons addr nil))
+                          (setq L-tail (cdr L-tail)))
+                 (setq L (cons addr nil)
+                       L-tail L)))
+             L))
+          (phones
+           (let (L L-tail str)
+             (while (not (string=
+                          ""
+                          (setq str
+                                (bbdb-read-string
+                                 "Phone Location [RET when no more]: "
+                                 ""
+                                 (mapcar (function (lambda(x) (list x)))
+                                         (bbdb-label-completion-list
+                                          "phones"))))))
+               (let* ((phonelist
+                       (bbdb-error-retry
+                        (bbdb-parse-phone-number
+                         (read-string "Phone: "
+                                      (and (integerp bbdb-default-area-code)
+                                           (format "(%03d) "
+                                                   bbdb-default-area-code))))))
+                      (phone (apply 'vector str
+                                    (if (= 3 (length phonelist))
+                                        (nconc phonelist '(0))
+                                      phonelist))))
+                 (if L
+                     (progn (setcdr L-tail (cons phone nil))
+                            (setq L-tail (cdr L-tail)))
                           (setq L (cons phone nil)
                                 L-tail L))))
                     L))
 
 ;;;###autoload
 (defun bbdb-create (record)
-  "Add a new entry to the bbdb database; prompts for all relevant info
+  "Add a new entry to the bbdb database ; prompts for all relevant info
 using the echo area, inserts the new record in the db, sorted alphabetically,
 and offers to save the db file.  DO NOT call this from a program.  Call
 bbdb-create-internal instead."
 NET is a comma-separated list of email addresses, or a list of strings.
 An error is signalled if that name is already in use.
 ADDRS is a list of address objects.  An address is a vector of the form
-[\"location\" (\"line1\" \"line2\" ... ) \"City\" \"State\" \"Zip\" \"Country\"].
+  [\"location\" (\"line1\" \"line2\" ... ) \"City\" \"State\" \"Zip\" \"Country\"].
 PHONES is a list of phone-number objects.  A phone-number is a vector of
 the form
-[\"location\" areacode prefix suffix extension-or-nil]
+  [\"location\" areacode prefix suffix extension-or-nil]
 or
-[\"location\" \"phone-number\"]
+  [\"location\" \"phone-number\"]
 NOTES is a string, or an alist associating symbols with strings."
   (let (firstname lastname aka)
-(while (and (progn
-              (setq name      (and name (bbdb-divide-name name))
-                    firstname (car name)
-                    lastname  (nth 1 name))
-              (bbdb-gethash (bbdb-build-name firstname lastname)))
-            bbdb-no-duplicates-p)
-  (setq name (signal 'error
-                     (list (format "%s %s is already in the database"
-                                   (or firstname "") (or lastname ""))))))
-(and company (bbdb-check-type company stringp))
-(if (stringp net)
-    (setq net (bbdb-split net ",")))
-(if bbdb-no-duplicates-p
-    (let ((rest net))
-      (while rest
-        (while (bbdb-gethash (downcase (car rest)))
-          (setcar rest
-                  (signal 'error (list (format
-                                        "%s is already in the database"
-                                        (car rest))))))
-        (setq rest (cdr rest)))))
-(setq addrs
-      (mapcar
-       (lambda (addr)
-         (while (or (not (vectorp addr))
-                    (/= (length addr) bbdb-address-length))
-           (setq addr (signal 'wrong-type-argument (list 'vectorp addr))))
-         (bbdb-check-type (aref addr 0) stringp) ;;; XXX use bbdb-addresses
-         (bbdb-check-type (aref addr 1) listp)
-         (bbdb-check-type (aref addr 2) stringp)
-         (bbdb-check-type (aref addr 3) stringp)
-         (bbdb-check-type (aref addr 4) stringp)
-         (bbdb-check-type (aref addr 5) stringp)
-         addr)
-       addrs))
-(setq phones
-      (mapcar
-       (lambda (phone)
-         (while (or (not (vectorp phone))
-                    (and (/= (length phone) 2)
-                         (/= (length phone) bbdb-phone-length)))
-           (setq phone
-                 (signal 'wrong-type-argument (list 'vectorp phone))))
-         (bbdb-check-type (aref phone 0) stringp)
-         (if (= 2 (length phone))
-             (bbdb-check-type (aref phone 1) stringp)
-           (bbdb-check-type (aref phone 1) integerp)
-           (bbdb-check-type (aref phone 2) integerp)
-           (bbdb-check-type (aref phone 3) integerp)
-           (and (aref phone 4) (bbdb-check-type (aref phone 4) integerp))
-           (if (eq 0 (aref phone 4)) (aset phone 4 nil)))
-         phone)
-       phones))
-(or (stringp notes)
-    (setq notes
-          (mapcar (lambda (note)
-                    (bbdb-check-type note consp)
-                    (bbdb-check-type (car note) symbolp)
-                    (if (consp (cdr note))
-                        (setq note (cons (car note) (car (cdr note)))))
-                    (bbdb-check-type (cdr note) stringp)
-                    note)
-                  notes)))
-(let ((record
-       (vector firstname lastname aka company phones addrs net notes
-               (make-vector bbdb-cache-length nil))))
-  (bbdb-invoke-hook 'bbdb-create-hook record)
-  (bbdb-change-record record t)
-  record)))
+    (while (and (progn
+                  (setq name      (and name (bbdb-divide-name name))
+                        firstname (car name)
+                        lastname  (nth 1 name))
+                  (bbdb-gethash (bbdb-build-name firstname lastname)))
+                bbdb-no-duplicates-p)
+      (setq name (signal 'error
+                         (list (format "%s %s is already in the database"
+                                       (or firstname "") (or lastname ""))))))
+    (and company (bbdb-check-type company stringp))
+    (if (stringp net)
+        (setq net (bbdb-split net ",")))
+    (if bbdb-no-duplicates-p
+        (let ((rest net))
+          (while rest
+            (while (bbdb-gethash (downcase (car rest)))
+              (setcar rest
+                      (signal 'error (list (format
+                                            "%s is already in the database"
+                                            (car rest))))))
+            (setq rest (cdr rest)))))
+    (setq addrs
+          (mapcar
+           (lambda (addr)
+             (while (or (not (vectorp addr))
+                        (/= (length addr) bbdb-address-length))
+               (setq addr (signal 'wrong-type-argument (list 'vectorp addr))))
+             (bbdb-check-type (aref addr 0) stringp) ;;; XXX use bbdb-addresses
+             (bbdb-check-type (aref addr 1) listp)
+             (bbdb-check-type (aref addr 2) stringp)
+             (bbdb-check-type (aref addr 3) stringp)
+             (bbdb-check-type (aref addr 4) stringp)
+             (bbdb-check-type (aref addr 5) stringp)
+             addr)
+           addrs))
+    (setq phones
+          (mapcar
+           (lambda (phone)
+             (while (or (not (vectorp phone))
+                        (and (/= (length phone) 2)
+                             (/= (length phone) bbdb-phone-length)))
+               (setq phone
+                     (signal 'wrong-type-argument (list 'vectorp phone))))
+             (bbdb-check-type (aref phone 0) stringp)
+             (if (= 2 (length phone))
+                 (bbdb-check-type (aref phone 1) stringp)
+               (bbdb-check-type (aref phone 1) integerp)
+               (bbdb-check-type (aref phone 2) integerp)
+               (bbdb-check-type (aref phone 3) integerp)
+               (and (aref phone 4) (bbdb-check-type (aref phone 4) integerp))
+               (if (eq 0 (aref phone 4)) (aset phone 4 nil)))
+             phone)
+           phones))
+    (or (stringp notes)
+        (setq notes
+              (mapcar (lambda (note)
+                        (bbdb-check-type note consp)
+                        (bbdb-check-type (car note) symbolp)
+                        (if (consp (cdr note))
+                            (setq note (cons (car note) (car (cdr note)))))
+                        (bbdb-check-type (cdr note) stringp)
+                        note)
+                      notes)))
+    (let ((record
+           (vector firstname lastname aka company phones addrs net notes
+                   (make-vector bbdb-cache-length nil))))
+      (bbdb-invoke-hook 'bbdb-create-hook record)
+      (bbdb-change-record record t)
+      record)))
 
 
 ;;; bbdb-mode stuff
 (defun bbdb-current-field (&optional planning-on-modifying)
   (or (bbdb-current-record planning-on-modifying)
       (error "unperson"))
-  (get-text-property (point) 'bbdb-field))
+  (delete 'field-name (get-text-property (point) 'bbdb-field)))
 
 ;;;###autoload
 (defun bbdb-apply-next-command-to-all-records ()
   '(eq last-command 'bbdb-apply-next-command-to-all-records))
 
 
+(defvar bbdb-append-records nil)
+
 ;;;###autoload
-(defun bbdb-insert-new-field (name contents)
+(defun bbdb-append-records-p ()
+  (cond ((eq t bbdb-append-records))
+        ((numberp bbdb-append-records)
+         (setq bbdb-append-records
+               (1- bbdb-append-records))
+         (when (= 0 bbdb-append-records)
+           (when (not bbdb-silent-running)
+             (message "No further search results will be appended.")
+             (sit-for 2))
+           (setq bbdb-append-records nil))
+         t)
+        (bbdb-append-records
+         (setq bbdb-append-records nil)
+         t)
+        (t nil)))
+
+;;;###autoload
+(defun bbdb-append-records (arg)
+  "Typing \\<bbdb-mode-map>\\[bbdb-append-records] \
+in the *BBDB* buffer makes the next search/display command to append
+new records to those in the *BBDB* buffer.
+
+With an prefix arg (C-u) toggle between always append and no append.
+With an prefix arg that is a positive number append will be enabled for that
+many times.
+With any other argument append will be enabled once."
+  (interactive "P")
+  (message (substitute-command-keys
+            "\\<bbdb-mode-map>\\[bbdb-append-records] - "))
+  (setq bbdb-append-records
+        (cond ((and arg (listp arg))
+               (if (not bbdb-silent-running)
+                   (if (not bbdb-append-records)
+                       (message "Always append records.")
+                     (message "Do not append records.")))
+               (not bbdb-append-records))
+              ((and (numberp arg) (< 1 arg))
+               (if (not bbdb-silent-running)
+                   (message "Append records for the next %d times." arg))
+               arg)
+              (t 'once))))
+
+;;;###autoload
+(defun bbdb-insert-new-field (record name contents)
   "Add a new field to the current record; the field type and contents
 are prompted for if not supplied.
 
 \"@mycompany.com\" will be appended to an address that is entered as
 just a username.  A prefix arg of ^U (or a `bbdb-default-domain'
 value of \"\", the default) means do not alter the address."
-
-  (interactive (let ((name "")
+  (interactive (let ((record (or (bbdb-current-record t)
+                                 (error "current record unexists!")))
+                     (name "")
                      (completion-ignore-case t))
                  (while (string= name "")
                    (setq name
                          (downcase
                           (completing-read "Insert Field: "
-                                           (append '(("phone") ("address") ("net")
-                                                     ("AKA") ("notes"))
+                                           (append '(("phone") ("address")
+                                                     ("net") ("AKA") ("notes"))
                                                    (bbdb-propnames))
                                            nil
                                            nil ; used to be t
                                            nil))))
                  (setq name (intern name))
-                 (list name (bbdb-prompt-for-new-field-value name))))
+                 (list record name (bbdb-prompt-for-new-field-value name))))
   (if (null contents)
       (setq contents (bbdb-prompt-for-new-field-value name)))
-  (let ((record (bbdb-current-record t)))
-    (if (null record) (error "current record unexists!"))
-    (cond ((eq name 'phone)
-           (bbdb-record-set-phones record
-                                   (nconc (bbdb-record-phones record) (list contents))))
-          ((eq name 'address)
-           (bbdb-record-set-addresses record
-                                      (nconc (bbdb-record-addresses record) (list contents))))
-          ((eq name 'net)
-           (if (bbdb-record-net record)
-               (error "There already are net addresses!"))
-           (if (stringp contents)
-               (setq contents (bbdb-split contents ",")))
-           ;; first detect any conflicts....
-           (if bbdb-no-duplicates-p
-               (let ((nets contents))
-                 (while nets
-                   (let ((old (bbdb-gethash (downcase (car nets)))))
-                     (if (and old (not (eq old record)))
-                         (error "net address \"%s\" is used by \"%s\""
-                                (car nets)
-                                (or (bbdb-record-name old)
-                                    (car (bbdb-record-net old))))))
-                   (setq nets (cdr nets)))))
-           ;; then store.
-           (let ((nets contents))
-             (while nets
-               (bbdb-puthash (downcase (car nets)) record)
-               (setq nets (cdr nets))))
-           (bbdb-record-set-net record contents))
-          ((eq name 'aka)
-           (if (bbdb-record-aka record)
-               (error "there already are alternate names!"))
-           (if (stringp contents)
-               (setq contents (bbdb-split contents ";")))
-           ;; first detect any conflicts....
-           (if bbdb-no-duplicates-p
-               (let ((aka contents))
-                 (while aka
-                   (let ((old (bbdb-gethash (downcase (car aka)))))
-                     (if (and old (not (eq old record)))
-                         (error "alternate name \"%s\" is used by \"%s\""
-                                (car aka)
-                                (or (bbdb-record-name old)
-                                    (car (bbdb-record-net old))))))
-                   (setq aka (cdr aka)))))
-           ;; then store.
-           (let ((aka contents))
-             (while aka
-               (bbdb-puthash (downcase (car aka)) record)
-               (setq aka (cdr aka))))
-           (bbdb-record-set-aka record contents))
-          ((eq name 'notes)
-           (if (bbdb-record-notes record) (error "there already are notes!"))
-           (bbdb-record-set-notes record contents))
-          ((assoc (symbol-name name) (bbdb-propnames))
-           (if (and (consp (bbdb-record-raw-notes record))
-                    (assq name (bbdb-record-raw-notes record)))
-               (error "there is already a \"%s\" note!" name))
-           (bbdb-record-putprop record name contents))
-          (t (error "doubleplus ungood: unknow how to set slot %s" name)))
-    (bbdb-change-record record nil)
-                                        ;    (bbdb-offer-save)
-    (let ((bbdb-display-layout nil))
-      (bbdb-redisplay-one-record record))))
+
+  (cond ((eq name 'phone)
+         (bbdb-record-set-phones record
+                                 (nconc (bbdb-record-phones record)
+                                        (list contents))))
+        ((eq name 'address)
+         (bbdb-record-set-addresses record
+                                    (nconc (bbdb-record-addresses record)
+                                           (list contents))))
+        ((eq name 'net)
+         (if (bbdb-record-net record)
+             (error "There already are net addresses!"))
+         (if (stringp contents)
+             (setq contents (bbdb-split contents ",")))
+         ;; first detect any conflicts....
+         (if bbdb-no-duplicates-p
+             (let ((nets contents))
+               (while nets
+                 (let ((old (bbdb-gethash (downcase (car nets)))))
+                   (if (and old (not (eq old record)))
+                       (error "net address \"%s\" is used by \"%s\""
+                              (car nets)
+                              (or (bbdb-record-name old)
+                                  (car (bbdb-record-net old))))))
+                 (setq nets (cdr nets)))))
+         ;; then store.
+         (let ((nets contents))
+           (while nets
+             (bbdb-puthash (downcase (car nets)) record)
+             (setq nets (cdr nets))))
+         (bbdb-record-set-net record contents))
+        ((eq name 'aka)
+        (if (bbdb-record-aka record)
+            (error "there already are alternate names!"))
+        (if (stringp contents)
+            (setq contents (bbdb-split contents ";")))
+        ;; first detect any conflicts....
+        (if bbdb-no-duplicates-p
+            (let ((aka contents))
+              (while aka
+                (let ((old (bbdb-gethash (downcase (car aka)))))
+                  (if (and old (not (eq old record)))
+                      (error "alternate name \"%s\" is used by \"%s\""
+                             (car aka)
+                             (or (bbdb-record-name old)
+                                 (car (bbdb-record-net old))))))
+                (setq aka (cdr aka)))))
+        ;; then store.
+        (let ((aka contents))
+          (while aka
+            (bbdb-puthash (downcase (car aka)) record)
+            (setq aka (cdr aka))))
+        (bbdb-record-set-aka record contents))
+        ((eq name 'notes)
+        (if (bbdb-record-notes record) (error "there already are notes!"))
+        (bbdb-record-set-notes record contents))
+        ((assoc (symbol-name name) (bbdb-propnames))
+        (if (and (consp (bbdb-record-raw-notes record))
+                 (assq name (bbdb-record-raw-notes record)))
+            (error "there is already a \"%s\" note!" name))
+        (bbdb-record-putprop record name contents))
+        (t (error "doubleplus ungood: unknow how to set slot %s" name)))
+  (bbdb-change-record record nil)
+;    (bbdb-offer-save)
+  (let ((bbdb-display-layout nil))
+    (bbdb-redisplay-one-record record)))
 
 (defun bbdb-prompt-for-new-field-value (name)
   (cond ((eq name 'net)
 cursor is in the middle of a multi-line field, such as an address or comments
 section, then the entire field is edited, not just the current line."
   (interactive)
+  ;; when at the end of the line take care of it
+  (if (and (eolp) (not (bobp)) (not (bbdb-current-field t)))
+      (backward-char 1))
+
   (let* ((record (bbdb-current-record t))
          (field (bbdb-current-field t))
          need-to-sort)
     (bbdb-change-record record need-to-sort)
     (bbdb-redisplay-one-record record)
     ;; (bbdb-offer-save)
+    (if (and (eq 'property (car field))
+             (or (eq 'mail-alias (caadr field))
+                 (eq 'net (caadr field))))
+        (setq bbdb-define-all-aliases-needs-rebuilt 'edit))
     ))
 
 (defun bbdb-record-edit-name (bbdb-record)
       (bbdb-address-set-country addr country))
     nil))
 
+(defun bbdb-address-edit-continental (addr)
+  "Function to use for address editing.
+The sub-fields are queried using the default order and using the
+default names.  Set `bbdb-address-editing-function' to an alternate
+address editing function if you don't like this function.  It is
+mostly used for US style addresses.
+
+The sub-fields and the prompts used are:
+Street, line n:  (nth n street)
+City:            city
+State:           state
+Zip Code:        zip
+Country:         country"
+  (let* ((str (let ((l) (s) (n 0))
+                (while (not (string= "" (setq s (bbdb-read-string
+                                                 (format "Street, line %d: " (+ 1 n))
+                                                 (nth n (bbdb-address-streets addr))))))
+                  (setq l (append l (list s)))
+                  (setq n (1+ n)))
+                l))
+         (zip (bbdb-error-retry
+               (bbdb-parse-zip-string
+                (bbdb-read-string "Zip Code: " (bbdb-address-zip-string addr)))))
+         (cty (bbdb-read-string "City: " (bbdb-address-city addr)))
+         (ste "")
+         (country (bbdb-read-string "Country: " (or (bbdb-address-country addr)
+                                                    bbdb-default-country))))
+    (bbdb-address-set-streets addr str)
+    (bbdb-address-set-city addr cty)
+    (bbdb-address-set-state addr ste)
+    (bbdb-address-set-zip addr zip)
+    (if (string= "" (concat cty ste zip country (mapconcat 'identity str "")))
+        ;; user didn't enter anything. this causes a display bug. this
+        ;; is a temporary fix. Ideally, we'd simply discard the entire
+        ;; address entry, but that's going to require bigger hacking.
+        (bbdb-address-set-country addr "Emacs")
+      (bbdb-address-set-country addr country))
+    nil))
+
 (defcustom bbdb-address-editing-function 'bbdb-address-edit-default
   "Function to use for address editing.
 The function must accept a BBDB address as parameter and allow the
                                                 (bbdb-label-completion-list
                                                  "addresses"))))))
     (bbdb-address-set-location addr loc))
-  (funcall bbdb-address-editing-function addr))
+  (if current-prefix-arg
+      (bbdb-address-edit-default addr)
+    (funcall bbdb-address-editing-function addr)))
 
 (defun bbdb-record-edit-phone (phone-number &optional location)
   (let ((newl (or location
                   (bbdb-read-string "Location: "
                                     (or (bbdb-phone-location phone-number)
-                                        (bbdb-label-completion-default "phones"))
+                                        (bbdb-label-completion-default
+                                         "phones"))
                                     (mapcar (function (lambda(x) (list x)))
                                             (bbdb-label-completion-list
                                              "phones")))))
       (if bbdb-no-duplicates-p
           (let ((rest newnets))
             (while rest
-              (let ((old (bbdb-gethash (downcase (car rest)))))
-                (if (and old (not (eq old bbdb-record)))
+              (let ((old (delete bbdb-record (bbdb-gethash (downcase (car rest))))))
+                (if old
                     (error "net address \"%s\" is used by \"%s\""
-                           (car rest) (bbdb-record-name old))))
+                           (car rest) (mapconcat (lambda (r) (bbdb-record-name r))
+                                                 old ", "))))
               (setq rest (cdr rest)))))
       ;; then update.
       (let ((rest oldnets))
       (setq records (cdr records)))))
 
 ;;;###autoload
-(defun bbdb-delete-current-record (r &optional noprompt)
-  "Delete the entire bbdb database entry which the cursor is within."
-  (interactive (list (bbdb-current-record t)))
-  (if (or noprompt
-          (bbdb-y-or-n-p (format "delete the entire db entry of %s? "
-                                 (or (bbdb-record-name r)
-                                     (bbdb-record-company r)
-                                     (car (bbdb-record-net r))))))
-      (let* ((record-cons (assq r bbdb-records))
-             (next-record-cons (car (cdr (memq record-cons bbdb-records)))))
-        (bbdb-debug (if (bbdb-record-deleted-p r)
-                        (error "deleting deleted record")))
-        (bbdb-record-set-deleted-p r t)
-        (bbdb-delete-record-internal r)
-        (if (eq record-cons (car bbdb-records))
-            (setq bbdb-records (cdr bbdb-records))
-          (let ((rest bbdb-records))
-            (while (cdr rest)
-              (if (eq record-cons (car (cdr rest)))
-                  (progn
-                    (setcdr rest (cdr (cdr rest)))
-                    (setq rest nil)))
-              (setq rest (cdr rest)))))
-        (bbdb-redisplay-one-record r record-cons next-record-cons t)
-        (bbdb-with-db-buffer
-         (setq bbdb-changed-records (delq r bbdb-changed-records)))
-        ;; (bbdb-offer-save)
-        )))
-
+(defun bbdb-delete-current-record (recs &optional noprompt)
+  "Delete the entire bbdb database entry which the cursor is within.
+Pressing \\<bbdb-mode-map>\\[bbdb-apply-next-command-to-all-records] will
+delete all records listed in the BBDB buffer."
+  (interactive (list (if (bbdb-do-all-records-p)
+                         (mapcar 'car bbdb-records)
+                       (list (bbdb-current-record t)))
+                     current-prefix-arg))
+  (if (not (listp recs))
+      (setq recs (list recs)))
+  (while recs
+    (let ((r (car recs)))
+      (setq recs (cdr recs))
+      (bbdb-debug (if (bbdb-record-deleted-p r)
+                      (error "deleting deleted record")))
+      (if (or noprompt
+              (bbdb-y-or-n-p (format "delete the entire db entry of %s? "
+                                     (or (bbdb-record-name r)
+                                         (bbdb-record-company r)
+                                         (car (bbdb-record-net r))))))
+          (let* ((record-cons (assq r bbdb-records))
+                 (next-record-cons (car (cdr (memq record-cons
+                                                   bbdb-records)))))
+            (bbdb-debug (if (bbdb-record-deleted-p r)
+                            (error "deleting deleted record")))
+            (bbdb-record-set-deleted-p r t)
+            (bbdb-delete-record-internal r)
+            (if (eq record-cons (car bbdb-records))
+                (setq bbdb-records (cdr bbdb-records))
+              (let ((rest bbdb-records))
+                (while (cdr rest)
+                  (if (eq record-cons (car (cdr rest)))
+                      (progn
+                        (setcdr rest (cdr (cdr rest)))
+                        (setq rest nil)))
+                  (setq rest (cdr rest)))))
+            (bbdb-redisplay-one-record r record-cons next-record-cons t)
+            (bbdb-with-db-buffer
+             (setq bbdb-changed-records (delq r bbdb-changed-records)))
+            ;; (bbdb-offer-save)
+            )))))
 
 (defun bbdb-change-records-state-and-redisplay (desired-state records)
   (let (rec)
                  (caar layout-alist))
                 (t
                  (caadr (memq desired-state layout-alist)))))
+    (message "Using %S layout" desired-state)
     (bbdb-change-records-state-and-redisplay desired-state records)))
 
 ;;;###autoload
        (list (assq (bbdb-current-record) bbdb-records)))))
 
 ;;;###autoload
+(defun bbdb-display-record-with-layout (layout &optional records)
+  "Show all the fields of the current record using LAYOUT."
+  (interactive (list (completing-read "Layout: "
+                      (mapcar (lambda (i)
+                        (list (symbol-name (car i))))
+                          bbdb-display-layout-alist))))
+  (when (stringp layout)
+    (setq layout (intern layout)))
+  (when (null records)
+    (setq records bbdb-records))
+  (bbdb-change-records-state-and-redisplay layout records))
+
+;;;###autoload
 (defun bbdb-omit-record (n)
   "Remove the current record from the display without deleting it from the
 database.  With a prefix argument, omit the next N records.  If negative,
   "*Non-nil means always use full name when sending mail, even if same as net."
   :group 'bbdb
   :type '(choice (const :tag "Disallow redundancy" nil)
+                 (const :tag "Return only the net" 'netonly)
                  (const :tag "Allow redundancy" t)))
 
 ;;;###autoload
 constituents of the address, as in John.Doe@SomeHost, or the address is
 already in the form \"Name <foo>\" or \"foo (Name)\", in which case the
 address is used as-is. If `bbdb-dwim-net-address-allow-redundancy' is non-nil,
-the name is always included."
+the name is always included.  If `bbdb-dwim-net-address-allow-redundancy' is
+'netonly the name is never included!"
   (or net (setq net (car (bbdb-record-net record))))
   (or net (error "record unhas network addresses"))
   (let* ((override (bbdb-record-getprop record 'mail-name))
         (while (setq i (string-match "[\\\"]" name i))
           (setq name (concat (substring name 0 i) "\\" (substring name i))
                 i (+ i 2))))
-    (cond ((or (null name)
+    (cond ((eq 'netonly bbdb-dwim-net-address-allow-redundancy)
+           net)
+          ((or (null name)
                (if (not bbdb-dwim-net-address-allow-redundancy)
                    (cond ((and fn ln)
                           (or (string-match
 
 (defun bbdb-send-mail-internal (&optional to subj records)
   (let ((type (or bbdb-send-mail-style
-                  (cond ((featurep 'mh-e) 'mh)
+          ;; In Emacs, `compose-mail' gets whatever you've
+          ;; customized as your preferred `mail-user-agent'.
+                  (cond ((fboundp 'compose-mail) 'compose-mail)
+                        ((featurep 'mh-e) 'mh)
                         ((featurep 'vm) 'vm)
                         ((featurep 'message) 'message)
                         ((featurep 'mew) 'mew)
-                        ((featurep 'compose-mail) 'compose-mail)
+                        ((featurep 'gnus) 'gnus)
                         (t 'mail)))))
     (cond
      ((eq type 'mh)
       (mew-send to nil subj))
      ((eq type 'compose-mail)
       (compose-mail to subj))
+     ((eq type 'gnus)
+      (gnus-msg-mail to subj))
      (t
       (error "bbdb-send-mail-style must be vm, mh, message, compose-mail, or rmail")))))
 
         (end-of-line)
         (while (looking-at "\n[ \t]")
           (forward-char) (end-of-line))
+        (insert ",\n")
+        (indent-relative))
+      (if (eolp)
+          nil
+        (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.
 
     (if (null bbdb-completion-type)
         (setq ok 't)
+
       (if (memq bbdb-completion-type
                 '(name primary-or-name name-or-primary))
-          (setq ok (string= sym (if bbdb-case-fold-search
-                                    (downcase name)
-                                  name))))
+          (setq ok (string= sym (downcase name))))
 
       ;; #### handle AKA, mail-name or mail-alias here?
       (if ok '()
 (defun bbdb-completion-predicate (symbol)
   "For use as the third argument to `completing-read'.
 Obey the semantics of `bbdb-completion-type'."
-  (cond ((null bbdb-completion-type) 't)
-        ((not (boundp symbol)) '())
-        (t (let ((sym  (symbol-name symbol))
-                 (recs (symbol-value symbol))
-                 ok)
-             (while (and recs (not ok))
-               (setq ok   (bbdb-completion-check-record sym (car recs))
-                     recs (cdr recs)))
-             ok))))
+  (cond ((null bbdb-completion-type)
+         t)
+        ((not (boundp symbol))
+         nil)
+        (t
+         (let ((sym  (symbol-name symbol))
+               (recs (symbol-value symbol))
+               ok)
+           (while (and recs (not ok))
+             (setq ok   (bbdb-completion-check-record sym (car recs))
+                   recs (cdr recs)))
+           ok))))
 
 (defun bbdb-completing-read-record (prompt &optional omit-records)
   "Prompt for and return a record from the bbdb.
   (if bbdb-complete-name-saved-window-config
       (progn
         (if (get-buffer-window "*Completions*")
-            (set-window-configuration
-             bbdb-complete-name-saved-window-config))
+            (progn
+              (set-window-configuration
+               bbdb-complete-name-saved-window-config)
+              (bury-buffer "*Completions*"))
+          )
         (setq bbdb-complete-name-saved-window-config nil))))
 
 (defun bbdb-display-completion-list (list &optional callback data)
   :group 'bbdb-mua-specific
   :type 'boolean)
 
-(defcustom bbdb-complete-name-full-completion 5
-  "Show full expanded completion rather than partial matches.
-If t then do it always; if a number then do it if the number of
-completions for a specific match is below that number."
-  :group 'bbdb-mua-specific
-  :type 'boolean)
-
-(defcustom bbdb-complete-name-hooks '(ding)
+(defcustom bbdb-complete-name-hooks nil
   "List of functions called after a sucessful completion."
   :group 'bbdb-mua-specific
   :type 'boolean)
 
+(eval-when-compile (defvar auto-fill-hook))
+
 ;;;###autoload
 (defun bbdb-complete-name (&optional start-pos)
   "Complete the user full-name or net-address before point (up to the
                     (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*")
                     (goto-char (match-end 0))
                     (point))))
-         (typed (downcase (buffer-substring beg end)))
+         (orig (buffer-substring beg end))
+         (typed (downcase orig))
          (pattern (bbdb-string-trim typed))
          (ht (bbdb-hashtable))
-         ;; make a unique set of matching records (yeah-yeah-this-one),
-         ;; a list of possible completion strings (all-the-completions),
-         ;; and a flag to indicate if there's a single matching record
-         ;; or not (only-one-p)
-         (yeah-yeah-this-one nil)
+         ;; make a list of possible completion strings
+         ;; (all-the-completions), and a flag to indicate if there's a
+         ;; single matching record or not (only-one-p)
          (only-one-p t)
          (all-the-completions nil)
          (pred
           (lambda (sym)
-            (and (bbdb-completion-predicate sym)
-                 (let* ((recs (and (boundp sym) (symbol-value sym)))
-                        nets)
-                   (while (and (not nets) recs)
-                     (if (not (setq nets (bbdb-record-net (car recs))))
-                         ()
-                       (if (memq (car recs) yeah-yeah-this-one)
-                           (setq nets '());; already have it...
-                         ;; only zero out only-one-p if we've already
-                         ;; got a matched record
-                         (setq only-one-p (null yeah-yeah-this-one)
-                               yeah-yeah-this-one
-                               (cons (car recs) yeah-yeah-this-one)))
-                       (if (not (memq sym all-the-completions))
-                           (setq all-the-completions
-                                 (cons sym all-the-completions))))
-                     (setq recs (cdr recs)))
-                   nets))))
-         (completion (try-completion pattern ht pred)))
-
-    ;; Danger, Will Robinson! try-completion returns 't' for an exact
-    ;; match. We correct for that here.
-    (if (eq completion t)
-        (setq yeah-yeah-this-one (bbdb-gethash pattern ht)
-              only-one-p (= (length yeah-yeah-this-one) 1)
-              completion pattern
-              all-the-completions (list (intern-soft pattern ht))))
-
-    ;; If there are multiple matches for one record, make sure we're
-    ;; picking the primary email address from that record. BUT respect
-    ;; the setting of bbdb-completion-type.
-    ;; Perhaps ideally the names should be interleaved from multiple
-    ;; records, i.e. pri1 pri2 sec1 sec2 etc. This would make a cond
-    ;; below unnecessary.
-    (and yeah-yeah-this-one
-         only-one-p
-         (memq bbdb-completion-type '(nil net))
-         (let (addrs)
-           (while yeah-yeah-this-one
-             (let ((newaddrs (bbdb-record-net (car yeah-yeah-this-one))))
-               (cond
-                ((or (eq 'net bbdb-completion-type)
-                     (eq nil bbdb-completion-type)))
-                ;; all addresses are acceptable)
-                (t
-                  ;; primaries only
-                  (setq newaddrs (list (car newaddrs)))))
-               (setq addrs (append addrs newaddrs)
-                     yeah-yeah-this-one (cdr yeah-yeah-this-one))))
-           (cond
-            ((= 1 (length addrs))
-             (setq completion (car addrs)))
-            (t
-              (while addrs
-                (if (member (intern-soft (car addrs) ht)
-                            all-the-completions)
-                    (setq completion (car addrs)
-                          addrs nil)
-                  (setq addrs (cdr addrs))))))))
+            (when (bbdb-completion-predicate sym)
+              (if (and only-one-p
+                       all-the-completions
+                       (or
+                        ;; not sure about this. more than one record
+                        ;; attached to the symbol? does that happen?
+                        (> (length (symbol-value sym)) 1)
+                        ;; this is the doozy, though. multiple syms
+                        ;; which all match the same record
+                        (delete t (mapcar (lambda(x)
+                                            (equal (symbol-value x)
+                                                   (symbol-value sym)))
+                                          all-the-completions))))
+                  (setq only-one-p nil))
+              (if (not (memq sym all-the-completions))
+                  (setq all-the-completions (cons sym all-the-completions))))))
+         (completion (try-completion pattern ht pred))
+         (exact-match (eq completion t)))
 
     (cond
      ;; No matches found OR you're trying completion on an
      ;; already-completed record. In the latter case, we might have to
      ;; cycle through the nets for that record.
-     ((null completion)
+     ((or (null completion)
+          (and bbdb-complete-name-allow-cycling
+               exact-match ;; which is a net of the record
+               (member orig
+                       (bbdb-record-net
+                        (car (symbol-value (intern-soft pattern ht)))))))
       ;; Clean up the completion buffer, if it exists
       (bbdb-complete-name-cleanup)
       ;; Check for cycling
                 (throw 'bbdb-cycling-exit nil))
 
             ;; find the record we're working on.
-            (let* ((addr (funcall
-                          bbdb-extract-address-components-func
-                          pattern))
+            (let* ((addr (funcall bbdb-extract-address-components-func orig))
                    (rec
                     (if (listp addr)
                         ;; for now, we're ignoring the case where this
               (or rec
                   (throw 'bbdb-cycling-exit nil))
 
-              (let* ((addrs (bbdb-record-net rec))
-                     (this-addr (or (cadr (member (cadar addr) addrs))
-                                    (nth 0 addrs))))
-                (if (= (length addrs) 1)
-                    ;; no alternatives. don't signal an error.
-                    (throw 'bbdb-cycling-exit t)
-                  ;; replace with new mail address
-                  (delete-region beg end)
-                  (insert (bbdb-dwim-net-address rec this-addr))
-                  (throw 'bbdb-cycling-exit t)))))
+              (if current-prefix-arg
+                  ;; use completion buffer
+                  (let ((standard-output (get-buffer-create "*Completions*")))
+                    ;; a previously existing buffer has to be cleaned first
+                    (save-excursion (set-buffer standard-output)
+                                    (setq buffer-read-only nil)
+                                    (erase-buffer))
+                    (display-completion-list
+                     (mapcar (lambda (n) (bbdb-dwim-net-address rec n))
+                             (bbdb-record-net rec)))
+                    (delete-region beg end)
+                    (switch-to-buffer standard-output))
+                ;; use next address
+                (let* ((addrs (bbdb-record-net rec))
+                       (this-addr (or (cadr (member (car (cdar addr)) addrs))
+                                      (nth 0 addrs))))
+                  (if (= (length addrs) 1)
+                      ;; no alternatives. don't signal an error.
+                      (throw 'bbdb-cycling-exit t)
+                    ;; replace with new mail address
+                    (delete-region beg end)
+                    (insert (bbdb-dwim-net-address rec this-addr))
+                    (run-hooks 'bbdb-complete-name-hooks)
+                    (throw 'bbdb-cycling-exit t))))))
 
           ;; FALL THROUGH
           ;; Check mail aliases
               (message "completion for \"%s\" unfound." pattern)
               (ding)))));; no matches, sorry!
 
-     ;; Perfect match for a single record
-     ((and only-one-p (string= (downcase completion) pattern))
-      (let* ((sym (intern-soft pattern ht))
+     ;; Match for a single record. If cycling is enabled then we don't
+     ;; care too much about the exact-match part.
+     ((and only-one-p (or exact-match bbdb-complete-name-allow-cycling))
+      (let* ((sym (if exact-match (intern-soft pattern ht) (car all-the-completions)))
              (recs (symbol-value sym))
              the-net match-recs lst primary matched)
 
           (when (bbdb-record-net (car recs))
 
             ;; Did we match on name?
-            (if (string= pattern
-                         (downcase (or (bbdb-record-name (car recs)) "")))
-                (setq match-recs (cons (car recs) match-recs)
-                      matched t))
+            (let ((b-r-name (or (bbdb-record-name (car recs)) "")))
+              (if (string= pattern
+                           (substring (downcase b-r-name) 0
+                                      (min (length b-r-name)
+                                           (length pattern))))
+                  (setq match-recs (cons (car recs) match-recs)
+                        matched t)))
 
             ;; Did we match on aka?
             (when (not matched)
               (setq lst (bbdb-record-aka (car recs)))
               (while lst
-                (if (string= pattern (downcase (car lst)))
+                (if (string= pattern (substring (downcase (car lst)) 0
+                                                (min (length (downcase
+                                                              (car
+                                                               lst)))
+                                                     (length pattern))))
                     (setq match-recs (append match-recs (list (car recs)))
                           matched t
                           lst '())
               (setq lst (bbdb-record-net (car recs)))
               (setq primary t) ;; primary wins over secondary...
               (while lst
-                (if (string= pattern (downcase (car lst)))
+                (if (string= pattern (substring (downcase (car lst))
+                                                0 (min (length
+                                                        (downcase (car
+                                                                   lst)))
+                                                       (length pattern))))
                     (setq the-net (car lst)
                           lst     nil
                           match-recs
                           (if primary (cons (car recs) match-recs)
                             (append match-recs (list (car recs))))))
                 (setq lst     (cdr lst)
-                      primary nil)))
-
-            ;; loop to next rec
-            (setq recs    (cdr recs)
-                  matched nil)))
+                      primary nil))))
+
+          ;; loop to next rec
+          (setq recs    (cdr recs)
+                matched nil))
+
+        (unless match-recs
+          (error "only exact matching record unhas net field"))
 
         ;; now replace the text with the expansion
         (delete-region beg end)
         ;; Update the *BBDB* buffer if desired.
         (if bbdb-completion-display-record
             (let ((bbdb-gag-messages t))
+              (bbdb-pop-up-bbdb-buffer)
               (bbdb-display-records-1 match-recs t)))
-        (bbdb-complete-name-cleanup)))
+        (bbdb-complete-name-cleanup)
+
+        ;; call the exact-completion hook
+        (run-hooks 'bbdb-complete-name-hooks)))
 
      ;; Partial match
      ;; note, we can't use the trimmed version of the pattern here or
      ;; we'll recurse infinitely on e.g. common first names
-     ((not (string= typed completion))
+     ((and (stringp completion) (not (string= typed completion)))
       (delete-region beg end)
       (insert completion)
       (setq end (point))
         (while (and (stringp completion)
                     (not (string= completion last))
                     (setq last completion
-                          pattern (downcase (buffer-substring beg end))
+                          pattern (downcase orig)
                           completion (try-completion pattern ht pred)))
           (if (stringp completion)
               (progn (delete-region beg end)
       (or (eq (selected-window) (minibuffer-window))
           (message "Making completion list..."))
 
-      (let ((list))
-        (while yeah-yeah-this-one
-          ;; Build the completion list sanely: Figure out which email
-          ;; address, if any (or many) matched this record, then use
-          ;; that (those) to extend the completion list. If there are
-          ;; no matches in the network addresses, then assume it's
-          ;; something else that matched (company, name, aka) and just
-          ;; add the primary network address. Note that because we're
-          ;; using the original completion list, we (a) save cycles on
-          ;; calculating completions and (b) save cycles on
-          ;; refiltering the list for completion-type.
-          ;;
-          ;; Possible option: allow ALL addresses as completion
-          ;; targets if it matched on name. Right now you get at those
-          ;; by either specifying an email address to complete on, or
-          ;; using completion cycling.
-          (let* ((rec (car yeah-yeah-this-one))
-                 (addrs (bbdb-record-net rec))
-                 (found-match nil));; ick. I hate oneshots.
-            (while addrs
-              (when (member (intern-soft (car addrs) ht)
-                            all-the-completions)
-                (setq found-match t
-                      all-the-completions
-                      (delete (intern-soft (car addrs) ht)
-                              all-the-completions))
-                (add-to-list 'list (bbdb-dwim-net-address rec
-                                                          (car addrs))))
-              (setq addrs (cdr addrs)))
-            (if (not found-match)
-                (add-to-list 'list (bbdb-dwim-net-address
-                                    rec
-                                    (car addrs))))
-            (setq yeah-yeah-this-one (cdr yeah-yeah-this-one))))
+      (let (dwim-completions
+            uniq nets net name akas)
+        ;; Now collect all the dwim-addresses for each completion, but only
+        ;; once for each record!  Add it if the net is part of the completions
+        (bbdb-mapc
+         (lambda (sym)
+           (bbdb-mapc
+            (lambda (rec)
+              (when (not (member rec uniq))
+                (setq uniq (cons rec uniq)
+                      nets (bbdb-record-net rec)
+                      name (downcase (or (bbdb-record-name rec) ""))
+                      akas (mapcar 'downcase (bbdb-record-aka rec)))
+                (while nets
+                  (setq net (car nets))
+                  (when (cond
+                         ;; primary
+                         ((and (member bbdb-completion-type
+                                       '(primary primary-or-name))
+                               (member (intern-soft (downcase net) ht)
+                                       all-the-completions))
+                          (setq nets nil)
+                          t)
+                         ;; name
+                         ((and name (member bbdb-completion-type
+                                            '(nil name primary-or-name))
+                               (let ((cname (symbol-name sym)))
+                                 (or (string= cname name)
+                                     (member cname akas))))
+                          (setq name nil)
+                          t)
+                         ;; net
+                         ((and (member bbdb-completion-type
+                                       '(nil net))
+                               (member (intern-soft (downcase net) ht)
+                                       all-the-completions)))
+                         ;; (name-or-)primary
+                         ((and (member bbdb-completion-type
+                                       '(name-or-primary))
+                               (let ((cname (symbol-name sym)))
+                                 (or (string= cname name)
+                                     (member cname akas))))
+                          (setq nets nil)
+                          t)
+                         )
+                    (setq dwim-completions
+                          (cons (bbdb-dwim-net-address rec net)
+                                dwim-completions))
+                    (if exact-match (setq nets nil)))
+                  (setq nets (cdr nets)))))
+            (symbol-value sym)))
+         all-the-completions)
 
         ;; if, after all that, we've only got one matching record...
-        (if (= 1 (length list))
+        (if (and dwim-completions (null (cdr dwim-completions)))
             (progn
               (delete-region beg end)
-              (insert (car list))
+              (insert (car dwim-completions))
               (message ""))
           ;; otherwise, pop up a completions window
           (if (not (get-buffer-window "*Completions*"))
                            (set-marker (make-marker) end))))
             (with-output-to-temp-buffer "*Completions*"
               (bbdb-display-completion-list
-               list 'bbdb-complete-clicked-name arg)))
+               dwim-completions
+               'bbdb-complete-clicked-name
+               arg)))
           (or (eq (selected-window) (minibuffer-window))
               (message "Making completion list...done"))))))))
 
   :group 'bbdb
   :type 'symbol)
 
+(defcustom bbdb-define-all-aliases-mode 'first
+  "*The type of alias which are created.
+first: Default is to generate an abbrev which is \"alias\" and expands to the
+       primary net.
+star:  Generate an extra alias \"<alias>*\" which expands to all nets of an
+       record.
+all:   Generate an alias all nets (as for 'star) and an alias for each net
+       as \"<alias>n\" where n is the position of the net in the nets of the
+       record."
+  :group 'bbdb
+  :type '(choice (symbol :tag "Only first" first)
+                 (symbol :tag "<alias>* for all nets" star)
+                 (symbol :tag "All aliases" all)))
+
 ;;;###autoload
 (defun bbdb-define-all-aliases ()
   "Define mail aliases for some of the records in the database.
 If multiple entries in the database have the same mail alias, then
 that alias expands to a comma-separated list of the network addresses
 of all of those people."
+  (interactive "")
   (let* ((target (cons bbdb-define-all-aliases-field "."))
+         (use-abbrev-p (fboundp 'define-mail-abbrev))
+         (mail-alias-separator-string (if (boundp 'mail-alias-separator-string)
+                                          mail-alias-separator-string
+                                        ", "))
          (records (bbdb-search (bbdb-records) nil nil nil target))
          result record aliases match)
+
+    (if use-abbrev-p
+        nil
+      ;; clear abbrev-table
+      (setq mail-aliases nil)
+      ;; arrange rebuilt if necessary, this should be done by
+      ;; mail-pre-abbrev-expand-hook, but there is none!
+      (defadvice sendmail-pre-abbrev-expand-hook
+        (before bbdb-rebuilt-all-aliases activate)
+        (bbdb-rebuilt-all-aliases)))
+
+    ;; collect an alist of (alias rec1 [rec2 ...])
     (while records
       (setq record (car records))
       (if (bbdb-record-net record)
                                               bbdb-define-all-aliases-field)
                          ","))
         (if (not bbdb-silent-running)
-            (bbdb-warn "record \"\" unhas network addresses"
-                       (bbdb-record-name record)))
+            (bbdb-warn "record %S has no network address, but the aliases: %s"
+                        (bbdb-record-name record)
+                        (bbdb-record-getprop record
+                                             bbdb-define-all-aliases-field)))
         (setq aliases nil))
 
       (while aliases
           (setq result (cons (list (car aliases) record) result)))
         (setq aliases (cdr aliases)))
       (setq records (cdr records)))
+
+    ;; iterate over the results and create the aliases
     (while result
-      (let ((alias (downcase (car (car result))))
-            (expansion (mapconcat 'bbdb-dwim-net-address (cdr (car result))
-                                  (if (boundp 'mail-alias-separator-string)
-                                      mail-alias-separator-string
-                                    ", ")))
-            (use-abbrev-p (fboundp 'define-mail-abbrev)))
-        (if use-abbrev-p
-            (define-mail-abbrev alias expansion)
-          (define-mail-alias alias expansion))
-        (setq alias (or (intern-soft alias
-                                     (if use-abbrev-p
-                                         mail-abbrevs mail-aliases))
-                        (error "couldn't find the alias we just defined!")))
-        (or (eq (symbol-function alias) 'mail-abbrev-expand-hook)
-            (error "mail-aliases contains unexpected hook %s"
-                   (symbol-function alias)))
-        ;; The abbrev-hook is called with network addresses instead of bbdb
-        ;; records to avoid keeping pointers to records, which would lose if
-        ;; the database was reverted.  It uses -search-simple to convert
-        ;; these to records, which is plenty fast.
-        (fset alias (list 'lambda '()
-                          (list 'bbdb-mail-abbrev-expand-hook
-                                (list 'quote
-                                      (mapcar (lambda (x)
-                                                (car (bbdb-record-net x)))
-                                              (cdr (car result))))))))
-      (setq result (cdr result)))))
-
-(defun bbdb-mail-abbrev-expand-hook (records)
+      (let* ((aliasstem (caar result))
+             (rec (cadar result))
+             (group-alias-p (cddar result))
+             (nets (if (not group-alias-p) (bbdb-record-net rec)))
+             (expansions
+              (if group-alias-p
+                  (mapcar (lambda (r) (bbdb-dwim-net-address r)) (cdar result))
+                (mapcar (lambda (net) (bbdb-dwim-net-address rec net))
+                        (if (eq 'all bbdb-define-all-aliases-mode)
+                            nets
+                          (list (car nets))))))
+             (count 1)
+             alias expansion)
+
+        (if group-alias-p
+            ;; for group aliases we just take all the primary nets and define
+            ;; just one expansion!
+            (setq expansions (list (mapconcat 'identity expansions
+                                              mail-alias-separator-string)))
+          ;; this is an alias for a single person so deal with it according to
+          ;; the bbdb-define-all-aliases-mode
+          (when (or (not (eq 'first bbdb-define-all-aliases-mode))
+                    (setq expansions
+                          (cons (mapconcat 'identity
+                                           (mapcar (lambda (net)
+                                                     (bbdb-dwim-net-address
+                                                      rec net))
+                                                   nets)
+                                           mail-alias-separator-string)
+                                expansions)
+                          count 0))))
+
+        ;; create the aliases for each expansion
+        (while expansions
+          (cond ((= count 0);; all the nets of a record
+                 (setq alias (concat aliasstem "*")))
+                ((= count 1);; expansion as usual
+                 (setq alias aliasstem))
+                (t;; alias# for each net of a record
+                 (setq alias (format "%s%s" aliasstem count))))
+          (setq count (1+ count))
+          (setq expansion (car expansions))
+
+          (if use-abbrev-p
+              (define-mail-abbrev alias expansion)
+            (define-mail-alias alias expansion))
+          (setq alias (or (intern-soft (downcase alias)
+                                       (if use-abbrev-p
+                                           mail-abbrevs mail-aliases))
+                          (error "couldn't find the alias we just defined!")))
+
+          (or (eq (symbol-function alias) 'mail-abbrev-expand-hook)
+              (error "mail-aliases contains unexpected hook %s"
+                     (symbol-function alias)))
+          ;; The abbrev-hook is called with network addresses instead of bbdb
+          ;; records to avoid keeping pointers to records, which would lose if
+          ;; the database was reverted.  It uses -search-simple to convert
+          ;; these to records, which is plenty fast.
+          (fset alias (list 'lambda '()
+                            (list 'bbdb-mail-abbrev-expand-hook
+                                  alias
+                                  (list 'quote
+                                        (mapcar (lambda (x)
+                                                  (car (bbdb-record-net x)))
+                                                (cdr (car result)))))))
+          (setq expansions (cdr expansions))))
+      (setq result (cdr result)))
+
+    (when (not use-abbrev-p)
+      (modify-syntax-entry ?* "w" mail-mode-header-syntax-table)
+      (sendmail-pre-abbrev-expand-hook))))
+
+;; 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
+(defun bbdb-rebuilt-all-aliases ()
+  (let ((needs-rebuilt bbdb-define-all-aliases-needs-rebuilt))
+    (when needs-rebuilt
+      (if (not bbdb-silent-running)
+          (message "Rebuilding aliases due to %s aliases." needs-rebuilt))
+      (setq bbdb-define-all-aliases-needs-rebuilt nil)
+      (bbdb-define-all-aliases))))
+
+(defcustom bbdb-mail-abbrev-expand-hook nil
+  "*Hook or hooks invoked each time an alias is expanded.
+The hook is called with two arguments the alias and the list of records."
+  :group 'bbdb-hooks
+  :type 'hook)
+
+(defun bbdb-mail-abbrev-expand-hook (alias records)
+  (run-hook-with-args 'bbdb-mail-abbrev-expand-hook alias records)
   (mail-abbrev-expand-hook)
   (when bbdb-completion-display-record
-    (bbdb-pop-up-bbdb-buffer bbdb-use-pop-up)
+    (if bbdb-use-pop-up
+        (bbdb-pop-up-bbdb-buffer))
     (let ((bbdb-gag-messages t))
       (bbdb-display-records-1
        (mapcar (lambda (x) (bbdb-search-simple nil x)) records)
       (setq records (cdr records)))
     (if do-all-p
         (bbdb-redisplay-records)
-      (bbdb-redisplay-one-record (bbdb-current-record)))))
-
-
-;;; Sound
-
+      (bbdb-redisplay-one-record (bbdb-current-record))))
+  (setq bbdb-define-all-aliases-needs-rebuilt
+        (if delete
+            'deleted
+          (if (bbdb-record-net (bbdb-current-record))
+              'new
+            nil))))
+
+;;; Dialing numbers from BBDB
 (defcustom bbdb-dial-local-prefix-alist
-  '(((if bbdb-default-area-code (format "(%03d)" bbdb-default-area-code) "")
+  '(((if (integerp bbdb-default-area-code)
+         (format "(%03d)" bbdb-default-area-code)
+       (or bbdb-default-area-code ""))
      ""))
-  "*If this is non-nil, it should be a alist with elements of the form
-(PREFIX-REGEXP . REPLACEMENT)
-e.g. matching prefix which your local phone system (in company) has.
-The first matching one will be replaced by is REPLACEMENT in order to use the
-shorter number for dialing.  This might reduce cost by using a intern
-telephone system."
+  "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-phone-dialing
   :type 'sexp)
 
 (defcustom bbdb-dial-local-prefix nil
-  "*If this is non-nil, it should be a string of digits which your phone
+  "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.)"
+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-phone-dialing
   :type '(choice (const :tag "No digits required" nil)
-                 (integer :tag "Dial this first" 9)))
+                 (string :tag "Dial this first" "9")))
 
 (defcustom bbdb-dial-long-distance-prefix nil
-  "*If this is non-nil, it should be a string of digits which your phone
+  "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."
+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-phone-dialing
   :type '(choice (const :tag "No digits required" nil)
-                 (integer :tag "Dial this first" 1)))
-
-
-(defcustom bbdb-sound-player "/usr/demo/SOUND/play"
+                 (string :tag "Dial this first" "1")))
+
+(defcustom bbdb-sound-player nil
   "The program to be used to play the sounds for the touch-tone digits."
   :group 'bbdb-phone-dialing
-  :type 'file)
+  :type '(choice (const :tag "No External Player" nil)
+                 (file :tag "Sound Player" "/usr/local/bin/play")))
 
 (defcustom bbdb-sound-files
   '["/usr/demo/SOUND/sounds/touchtone.0.au"
   :type 'vector)
 
 (defcustom bbdb-modem-dial nil
-  "Whether to use the modem for dialing.  Actually this is the modem command
-used to dial.  You may set it to a different value in order to initialize your
-modem or the like."
+  "Type of dialing to use.
+If this value is nil, the audio device is used for dialing. Otherwise,
+this string is fed to the modem before the phone number digits."
   :group 'bbdb-phone-dialing
-  :type '(choice (const  :tag "no" nil)
+  :type '(choice (const  :tag "audio" nil)
                  (string :tag "tone dialing" "ATDT ")
                  (string :tag "pulse dialing" "ATDP ")))
 
 (defcustom bbdb-modem-device "/dev/modem"
-  "Whether to use the modem for dialing."
+  "The name of the modem device.
+This is only used if bbdb-modem-dial is set to something other than nil."
   :group 'bbdb-phone-dialing
   :type 'string)
 
-(defvar bbdb-sound-volume) ;; XXX
+(defcustom bbdb-sound-volume 50
+  "The volume to play back dial tones at. The range is 0 to 100.
+This is only used if bbdb-modem-dial is set to nil."
+  :group 'bbdb-phone-dialing
+  :type 'integer)
+
+(defun bbdb-play-sound (num &optional volume)
+  "Play the specified touchtone number NUM at VOLUME.
+Uses external program `bbdb-sound-player' if set, otherwise
+try to use internal sound if available."
+  (if (and (not bbdb-sound-player) (featurep 'native-sound))
+      ;; This requires the sound files to be loaded via bbdb-xemacs.
+      (funcall 'play-sound (intern (format "touchtone%d" num))
+               bbdb-sound-volume)
+    (if (and (not (featurep 'xemacs))
+             ;; We can't tell a priori if Emacs 21 facility will
+             ;; actually work.
+             (condition-case nil
+                 (play-sound (list 'sound
+                                   :file (aref bbdb-sound-files
+                                               (string-to-int num))
+                                   :volume (or volume bbdb-sound-volume)))
+               (error nil)))
+        (if (and bbdb-sound-player
+                 (file-exists-p bbdb-sound-player))
+            (call-process bbdb-sound-player nil nil nil
+                          (aref bbdb-sound-files num))
+          (error "BBDB has no means of playing sound.")))))
+
+(eval-and-compile
+  (if (fboundp 'next-event)
+      (fset 'bbdb-next-event 'next-event)
+    (fset 'bbdb-next-event 'read-event)))
 
 (defun bbdb-dial-number (phone-string)
-  "Play the touchtone corresponding to the numbers in string."
-  (interactive "sTelephonenumber: ")
-  (let ((length (length phone-string))
-        (position 0)
-        (modem-command bbdb-modem-dial)
-        number)
-
-    (while (< position length)
-      (setq number (aref phone-string position))
-      (setq number
-            (cond ((and (<= ?0 number) (>= ?9 number)) (char-to-string number))
-                  ((= ?# number) "10")
-                  ((= ?* number) "11")
-                  ((= ?  number) 1)
-                  (t nil)))
-      (if (stringp number)
-          (cond (bbdb-modem-dial
-                 (if (= 1 (length number))
-                     (setq modem-command (concat modem-command number))))
-                ((and (boundp 'xemacsp) (featurep 'native-sound))
-                 (bbdb-play-sound (intern (concat "touchtone" number))
-                             bbdb-sound-volume))
-                (t
-                 (or (file-exists-p bbdb-sound-player)
-                     (error "no sound player program"))
-                 (call-process bbdb-sound-player nil nil nil
-                               (aref bbdb-sound-files (string-to-int number)))
-                 (sit-for 0)))
-        (if (numberp number)
-            (if bbdb-modem-dial
-                ;; "," is a pause
-                (setq modem-command (concat modem-command ","))
-              (sit-for number))))
-      (setq position (1+ position)))
-
+  "Dial the number specified by PHONE-STRING.
+The number is dialed either by playing touchtones through the audio
+device using bbdb-sound-player, or by sending a dial sequence to
+bbdb-modem-device. # and * are dialed as-is, and a space is treated as
+a pause in the dial sequence."
+  (interactive "sDial number: ")
+  (let ((dialed ""))
+    (mapcar
+     (lambda(d)
+       (if bbdb-modem-dial
+           (setq dialed
+                 (concat dialed
+                         (cond ((eq ?  d) ",")
+                               ((memq d '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?* ?#))
+                                (format "%c" d))
+                               (t ""))))
+         (cond
+          ((eq ?# d)
+           (bbdb-play-sound 10))
+          ((eq ?* d)
+           (bbdb-play-sound 11))
+          ((eq ?  d)
+           ;; if we use sit-for, the user can interrupt!
+           (sleep-for 1)) ;; configurable?
+          ((memq d '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
+           (bbdb-play-sound (- (char-int d) (char-int ?0))))
+          (t)))) phone-string)
+
+    ;; tell the user that we're dialed, if we're using the modem
     (if bbdb-modem-dial
         (with-temp-buffer
-          (insert modem-command ";\r\n")
+          (insert bbdb-modem-dial dialed ";\r\n")
           (write-region (point-min) (point-max) bbdb-modem-device t)
           (message "%s dialed. Pick up the phone now and hit any key ..."
                    phone-string)
           (bbdb-next-event)
           (erase-buffer)
           (insert "ATH\r\n")
-          (write-region (point-min) (point-max) bbdb-modem-device t)
-          ))
-    ))
+          (write-region (point-min) (point-max) bbdb-modem-device t)))))
 
 ;;;###autoload
 (defun bbdb-dial (phone force-area-code)
-  "On an audio-equipped workstation, play the appropriate tones on the
-builtin speaker to dial the phone number corresponding to the current
-line.  If the point is at the beginning of a record, dial the first
-phone number.  Does not dial the extension.  Does not dial the area
-code if it is the same as `bbdb-default-area-code' unless a prefix arg
+  "Dial the number at point.
+If the point is at the beginning of a record, dial the first
+phone number.  Does not dial the extension.  Does not apply the
+transformations from bbdb-dial-local-prefix-alist if a prefix arg
 is given."
-
   (interactive (list (bbdb-current-field)
                      current-prefix-arg))
   (if (eq (car-safe phone) 'name)
-      (setq phone (car (bbdb-record-phones (car (cdr phone))))))
+      (setq phone (car (bbdb-record-phones (bbdb-current-record)))))
   (if (eq (car-safe phone) 'phone)
       (setq phone (car (cdr phone))))
   (or (vectorp phone) (error "not on a phone field"))
       (let ((alist bbdb-dial-local-prefix-alist))
         (while alist
           (if (string-match (concat "^" (eval (caar alist))) number)
-              (setq shortnumber (concat (cadar alist)
+              (setq shortnumber (concat (car (cdar alist))
                                         (substring number (match-end 0)))
                     alist nil))
           (setq alist (cdr alist)))))
+
+    ;; cut off the extension
     (if (string-match "x[0-9]+$" number)
         (setq number (substring number 0 (match-beginning 0))))
+
+    ;; This is terrifically Americanized...
+    ;; Leading 0 => local number (?)
     (if (and (not shortnumber) bbdb-dial-local-prefix
              (string-match "^0" number))
-        (if (not (string-match "^[0-9#* ]+$" bbdb-dial-local-prefix))
-            (error "bbdb-dial-local-prefix contains non-digits")
-          (setq number (concat bbdb-dial-local-prefix number))))
+        (setq number (concat bbdb-dial-local-prefix number)))
+
+    ;; Leading + => long distance/international number
     (if (and (not shortnumber) bbdb-dial-long-distance-prefix
              (string-match "^\+" number))
-        (if (not (string-match "^[0-9#* ]+$" bbdb-dial-long-distance-prefix))
-            (error "bbdb-dial-long-distance-prefix contains non-digits")
-          (setq number (concat bbdb-dial-long-distance-prefix " "
-                               (substring number 1)))))
+        (setq number (concat bbdb-dial-long-distance-prefix " "
+                             (substring number 1))))
+
+    ;; use the short number if it's available
     (setq number (or shortnumber number))
     (if (not bbdb-silent-running)
         (message "Dialing %s" number))
     (bbdb-dial-number number)))
 
-
+
+;; not sure what this is doing here...
 (defun bbdb-get-record (prompt)
   "Get the current record or ask the user.
 To be used in `interactive' like this:
                           (copy-sequence (bbdb-record-finger-host
                                           (car record)))))))
       (setq record (cdr record)))
-    (save-excursion
-      (with-output-to-temp-buffer bbdb-finger-buffer-name
-        (set-buffer bbdb-finger-buffer-name)
-        (make-local-variable 'bbdb-remaining-addrs-to-finger)
-        (setq bbdb-remaining-addrs-to-finger (cdr addrs))
-        (bbdb-finger-internal (car addrs))))))
+    (if (car addrs)
+        (save-excursion
+          (with-output-to-temp-buffer bbdb-finger-buffer-name
+            (set-buffer bbdb-finger-buffer-name)
+            (make-local-variable 'bbdb-remaining-addrs-to-finger)
+            (setq bbdb-remaining-addrs-to-finger (cdr addrs))
+            (bbdb-finger-internal (car addrs))))
+      (error "Nothing to finger!"))))
 
 
 (defun bbdb-remove-duplicate-nets (records)
 (defun bbdb-find-duplicates (&optional fields)
   "Find all records that have duplicate entries for given FIELDS.
 FIELDS should be a list of the symbols `name', `net', and/or `aka'.
-Note that overlap between these fields is noted if either is selected
-(most common case `aka' and `name').  If FIELDS is not given it
+Note that overlap between these fields is noted if either is selected,
+most common case `aka' and `name'.  If FIELDS is not given it
 defaults to all of them.
 
 The results of the search is returned as a list of records."
   (setq fields (or fields '(name net aka)))
   (let ((records (bbdb-records))
-rec hash ret)
-(while records
-  (setq rec (car records))
-
-  (when (and (memq 'name fields)
-             (bbdb-record-name rec)
-             (setq hash (bbdb-gethash (downcase (bbdb-record-name rec))))
-             (> (length hash) 1))
-    (setq ret (append hash ret))
-    (message "BBDB record `%s' causes duplicates, maybe it is equal to a company name."
-             (bbdb-record-name rec))
-    (sit-for 0))
-
-  (if (memq 'net fields)
-      (let ((nets (bbdb-record-net rec)))
-        (while nets
-          (setq hash (bbdb-gethash (downcase (car nets))))
-          (when (> (length hash) 1)
-            (setq ret (append hash ret))
-            (message "BBDB record `%s' has duplicate net `%s'."
-                     (bbdb-record-name rec) (car nets))
-            (sit-for 0))
-          (setq nets (cdr nets)))))
-
-  (if (memq 'aka fields)
-      (let ((aka (bbdb-record-aka rec)))
-        (while aka
-          (setq hash (bbdb-gethash (downcase (car aka))))
-          (when (> (length hash) 1)
-            (setq ret (append hash ret))
-            (message "BBDB record `%s' has duplicate aka `%s'"
-                     (bbdb-record-name rec) (car aka))
-            (sit-for 0))
-          (setq aka (cdr aka)))))
-
-  (setq records (cdr records)))
-
-(reverse (bbdb-remove-memq-duplicates ret))))
+        rec hash ret)
+    (while records
+      (setq rec (car records))
+
+      (when (and (memq 'name fields)
+                 (bbdb-record-name rec)
+                 (setq hash (bbdb-gethash (downcase (bbdb-record-name rec))))
+                 (> (length hash) 1))
+        (setq ret (append hash ret))
+        (message "BBDB record `%s' causes duplicates, maybe it is equal to a company name."
+                 (bbdb-record-name rec))
+        (sit-for 0))
+
+      (if (memq 'net fields)
+          (let ((nets (bbdb-record-net rec)))
+            (while nets
+              (setq hash (bbdb-gethash (downcase (car nets))))
+              (when (> (length hash) 1)
+                (setq ret (append hash ret))
+                (message "BBDB record `%s' has duplicate net `%s'."
+                         (bbdb-record-name rec) (car nets))
+                (sit-for 0))
+              (setq nets (cdr nets)))))
+
+      (if (memq 'aka fields)
+          (let ((aka (bbdb-record-aka rec)))
+            (while aka
+              (setq hash (bbdb-gethash (downcase (car aka))))
+              (when (> (length hash) 1)
+                (setq ret (append hash ret))
+                (message "BBDB record `%s' has duplicate aka `%s'"
+                         (bbdb-record-name rec) (car aka))
+                (sit-for 0))
+              (setq aka (cdr aka)))))
+
+      (setq records (cdr records)))
+    (reverse (bbdb-remove-memq-duplicates ret))))
 
 (defun bbdb-show-duplicates (&optional fields)
   "*Find all records that have duplicate entries for given FIELDS.
 `string-lessp' is used.
 
 Example:
-(bbdb-kill-older \"1997-01-01\")
+        (bbdb-kill-older \"1997-01-01\")
 will delete all records with timestamps older than Jan 1 1997.
 
 Notes:  1. Records without timestamp fields will be ignored
 2. DATE must be in yyyy-mm-dd format."
   (interactive "sKill records with timestamp older than (yyyy-mm-dd): \n")
   (let ((records (bbdb-records)) timestamp
-(fun (or function 'bbdb-delete-record-internal))
-(cmp (or compare 'string-lessp)))
-(while records
-  (if (and (setq timestamp (bbdb-record-getprop (car records) 'timestamp))
-           (funcall cmp timestamp date))
-      (funcall fun (car records)))
-  (setq records (cdr records)))))
+        (fun (or function 'bbdb-delete-record-internal))
+        (cmp (or compare 'string-lessp)))
+    (while records
+      (if (and (setq timestamp (bbdb-record-getprop (car records) 'timestamp))
+               (funcall cmp timestamp date))
+          (funcall fun (car records)))
+      (setq records (cdr records)))))
 
 (defmacro bbdb-compare-records (cmpval field compare)
   "Builds a lambda comparison function that takes one argument, REC.
   :type '(choice (const :tag "Standard location" nil)
                  (file :tag "New location")))
 
-(defvar Info-directory)                 ; v18
 ;;;###autoload
 (defun bbdb-info ()
   (interactive)
   (if bbdb-inside-electric-display
       (bbdb-electric-throw-to-execute '(bbdb-info))
     (let ((file (or bbdb-info-file "bbdb")))
-      (if (file-name-directory file)
-          (let ((Info-directory (file-name-directory file)))
-            (Info-goto-node (format "(%s)Top" file)))
-        (Info-goto-node (format "(%s)Top" file))))))