Commit b7519568 authored by waider's avatar waider

sync with Sourceforge CVS

parent ebca42237542
......@@ -17,7 +17,7 @@ up-to-date and OVERRIDE to decide who gets precedence if two dates
match. DATE can be extracted from a notes if it's an alist with an
element marked timestamp. Set OVERRIDE to 'new to allow the new record
to stomp on existing data, 'old to preserve existing data or nil to
merge both together . If it can't find a record to merge with, it will
merge both together. If it can't find a record to merge with, it will
create a new record. If MERGE-RECORD is set, it's a record discovered
by other means that should be merged with.
......@@ -169,13 +169,24 @@ Returns the Grand Unified Record."
;; your record, sir.
merge-record))
;; fixme this could be a macro, I guess.
;; fixme these could be a macros, I guess.
(defun bbdb-instring( s1 s2 )
;; (and case-fold-search
;; (setq s1 (downcase s1)
;; s2 (downcase s2)))
(catch 'done
(while (>= (length s1) (length s2))
(if (string= s2 (substring s1 0 (length s2)))
(throw 'done t)
(setq s1 (substring s1 1))))
(throw 'done nil)))
(defun bbdb-merge-strings (s1 s2 &optional sep)
"Merge two strings together uniquely.
If s1 doesn't contain s2, return s1+sep+s2."
(cond ((or (null s1) (string-equal s1 "")) s2)
((or (null s2) (string-equal s2 "")) s1)
(t (if (string-match s2 s1) s1
(t (if (bbdb-instring s2 s1) s1
(concat s1 (or sep "") s2)))))
;;;###autoload
......@@ -207,4 +218,44 @@ If s1 doesn't contain s2, return s1+sep+s2."
;; hack
(setq bbdb-buffer (or (get-file-buffer bbdb-file) nil)))
(defun bbdb-add-or-update-phone ( record location phone-string )
"Add or update a phone number in the current record.
Insert into RECORD phone number for LOCATION consisting of
PHONE-STRING. Will automatically overwrite an existing phone entry for
the same location."
(let* ((phone (make-vector (if bbdb-north-american-phone-numbers-p
bbdb-phone-length
2)
nil)))
(if (= 2 (length phone))
(aset phone 1 phone-string)
(let ((newp (bbdb-parse-phone-number phone-string)))
(bbdb-phone-set-area phone (nth 0 newp))
(bbdb-phone-set-exchange phone (nth 1 newp))
(bbdb-phone-set-suffix phone (nth 2 newp))
(bbdb-phone-set-extension phone (or (nth 3 newp) 0))))
(bbdb-phone-set-location phone location)
;; "phone" now contains a suitable record
;; we need to check if this is already in the phones list
(let ((phones (bbdb-record-phones record))
phones-list)
(setq phones-list phones)
(while (car phones-list)
(if (string= (bbdb-phone-location (car phones-list))
location)
(setq phones (delete (car phones-list) phones)))
(setq phones-list (cdr phones-list)))
(bbdb-record-set-phones record
(nconc phones (list phone))))
(bbdb-change-record record nil)
;; update display if record is visible
(and (get-buffer-window bbdb-buffer-name)
(bbdb-display-records (list record)))
nil))
(provide 'bbdb-merge)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment