Here's a new version of jws' bbdb-copy-record, tweaked so that it can
correctly copy records in a database that mixes both North American
and non-North American phone numbers.
Sorry for those of you who wasted your time trying to help me. I see
that I wasn't clear enough about wanting code that would DETECT a
non-NA phone number and then edit it correctly. I believe the
following block of code does this.
Best,
R
;;;
;;; Bonus Function bbdb-copy-record
;;; author [EMAIL PROTECTED]
;;;
;;; The code was stolen from bbdb-create and bbdb-read-new-record
;;; maybe, it would be a good idea, to replace bbdb-read-new-record by the
;;; new function and have the old behaviour with an optional argument record.
;;;
;;; [goldman:Tue Apr 4 12:37:36 1995] Hacked the code to permit correct
;;; copying of non-NA phone numbers by those of us who have a mix of NA
;;; and non-NA phones in our database.
(define-key bbdb-mode-map "c" 'bbdb-copy-record)
(defun bbdb-copy-record (record)
"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."
(interactive (list (bbdb-modify-record (bbdb-current-record t))))
(bbdb-invoke-hook 'bbdb-create-hook record)
(bbdb-change-record record t)
(bbdb-display-records (list record)))
(defun bbdb-NA-phone-p (bbdb-phone)
(not (stringp (aref bbdb-phone 1))))
(defun bbdb-modify-record (&optional record)
"Take an existing bbdb record and return a new bbdb-record. Doesn't insert
it in to the database or update the hashtables, but does insure 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."))
(let (firstname lastname)
(bbdb-error-retry
(progn
(if current-prefix-arg
(setq firstname (bbdb-read-string
"First Name: "
(if record (bbdb-record-firstname record)))
lastname (bbdb-read-string
"Last Name: "
(if record (bbdb-record-lastname record))))
(let ((names (bbdb-divide-name
(bbdb-read-string "Name: "
(if record
(bbdb-record-name record))))))
(setq firstname (car names)
lastname (nth 1 names))))
(if (string= firstname "") (setq firstname nil))
(if (string= lastname "") (setq lastname nil))
(if (bbdb-gethash (downcase (if (and firstname lastname)
(concat firstname " " lastname)
(or firstname lastname ""))))
(error "%s %s is already in the database"
(or firstname "")
(or lastname "")))))
(let ((company (bbdb-read-string "Company: "
(if record (bbdb-record-company record))))
(net (bbdb-split (bbdb-read-string "Network Address: "
(if record
(mapconcat
(function identity)
(bbdb-record-net record)
", ")))
","))
(addrs (let (L L-tail str addr
(old-addrs (if record (bbdb-record-addresses record))))
(while
(not
(string=
""
(setq str
(bbdb-read-string
"Address Description [RET when no more addrs]: "
(if (not (null old-addrs))
(bbdb-address-location (car old-addrs)))))))
(setq addr (if (null old-addrs)
(make-vector bbdb-address-length nil)
(copy-sequence (car old-addrs))))
(bbdb-record-edit-address addr str)
(setq old-addrs (cdr old-addrs))
(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
(old-phns (if record (bbdb-record-phones record)))
(default-na-phone-flag bbdb-north-american-phone-numbers-p))
(while
(not
(string=
""
(setq str
(bbdb-read-string
"Phone Location [RET when no more phones]: "
(if (not (null old-phns))
(bbdb-phone-location (car old-phns)))))))
(let* ((bbdb-north-american-phone-numbers-p
(if (not (null old-phns))
(bbdb-NA-phone-p (car old-phns))
default-na-phone-flag))
(phonelist
(bbdb-error-retry
(bbdb-parse-phone-number
(read-string "Phone: "
(if (null old-phns)
(and bbdb-default-area-code
(format
"(%03d) "
bbdb-default-area-code))
(bbdb-phone-string
(car old-phns)))))))
(phone (apply 'vector str
(if (= 3 (length phonelist))
(nconc phonelist '(0))
phonelist))))
(setq old-phns (cdr old-phns))
(if L
(progn (setcdr L-tail (cons phone nil))
(setq L-tail (cdr L-tail)))
(setq L (cons phone nil)
L-tail L))))
L))
(notes (bbdb-read-string "Additional Comments: "
(if record (bbdb-record-notes record)))))
(if (string= company "") (setq company nil))
(if (string= notes "") (setq notes nil))
(let ((record
(vector firstname lastname nil company phones addrs net notes
(make-vector bbdb-cache-length nil))))
record))))
homepage: ftp://ftp.src.honeywell.com/pub/www/UNOFFICIAL/goldman/index.html
