Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
xemacs
bbdb
Commits
d3537f8fa990
Commit
b7519568
authored
Jul 23, 2005
by
waider
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
sync with Sourceforge CVS
parent
ebca42237542
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
54 additions
and
3 deletions
+54
-3
lisp/bbdb-merge.el
lisp/bbdb-merge.el
+54
-3
No files found.
lisp/bbdb-merge.el
View file @
d3537f8f
...
...
@@ -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-in
string
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
)
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment